2
** $Id: ldebug.c 10334 2005-04-26 22:08:24Z vas $
4
** See Copyright Notice in lua.h
30
static const char *getfuncname (CallInfo *ci, const char **name);
33
#define isLua(ci) (!((ci)->state & CI_C))
36
static int currentpc (CallInfo *ci) {
37
if (!isLua(ci)) return -1; /* function is not a Lua function? */
38
if (ci->state & CI_HASFRAME) /* function has a frame? */
39
ci->u.l.savedpc = *ci->u.l.pc; /* use `pc' from there */
40
/* function's pc is saved */
41
return pcRel(ci->u.l.savedpc, ci_func(ci)->l.p);
45
static int currentline (CallInfo *ci) {
46
int pc = currentpc(ci);
48
return -1; /* only active lua functions have current-line information */
50
return getline(ci_func(ci)->l.p, pc);
54
void luaG_inithooks (lua_State *L) {
56
for (ci = L->ci; ci != L->base_ci; ci--) /* update all `savedpc's */
63
** this function can be called asynchronous (e.g. during a signal)
65
LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
66
if (func == NULL || mask == 0) { /* turn off hooks? */
71
L->basehookcount = count;
73
L->hookmask = cast(lu_byte, mask);
79
LUA_API lua_Hook lua_gethook (lua_State *L) {
84
LUA_API int lua_gethookmask (lua_State *L) {
89
LUA_API int lua_gethookcount (lua_State *L) {
90
return L->basehookcount;
94
LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
98
for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) {
100
if (!(ci->state & CI_C)) /* Lua function? */
101
level -= ci->u.l.tailcalls; /* skip lost tail calls */
103
if (level > 0 || ci == L->base_ci) status = 0; /* there is no such level */
104
else if (level < 0) { /* level is of a lost tail call */
110
ar->i_ci = ci - L->base_ci;
117
static Proto *getluaproto (CallInfo *ci) {
118
return (isLua(ci) ? ci_func(ci)->l.p : NULL);
122
LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
128
ci = L->base_ci + ar->i_ci;
129
fp = getluaproto(ci);
130
if (fp) { /* is a Lua function? */
131
name = luaF_getlocalname(fp, n, currentpc(ci));
133
luaA_pushobject(L, ci->base+(n-1)); /* push value */
140
LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
146
ci = L->base_ci + ar->i_ci;
147
fp = getluaproto(ci);
148
L->top--; /* pop new value */
149
if (fp) { /* is a Lua function? */
150
name = luaF_getlocalname(fp, n, currentpc(ci));
151
if (!name || name[0] == '(') /* `(' starts private locals */
154
setobjs2s(ci->base+(n-1), L->top);
161
static void funcinfo (lua_Debug *ar, StkId func) {
162
Closure *cl = clvalue(func);
165
ar->linedefined = -1;
169
ar->source = getstr(cl->l.p->source);
170
ar->linedefined = cl->l.p->lineDefined;
171
ar->what = (ar->linedefined == 0) ? "main" : "Lua";
173
luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
177
static const char *travglobals (lua_State *L, const TObject *o) {
178
Table *g = hvalue(gt(L));
181
Node *n = gnode(g, i);
182
if (luaO_rawequalObj(o, gval(n)) && ttisstring(gkey(n)))
183
return getstr(tsvalue(gkey(n)));
189
static void info_tailcall (lua_State *L, lua_Debug *ar) {
190
ar->name = ar->namewhat = "";
192
ar->linedefined = ar->currentline = -1;
193
ar->source = "=(tail call)";
194
luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
200
static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
201
StkId f, CallInfo *ci) {
203
for (; *what; what++) {
210
ar->currentline = (ci) ? currentline(ci) : -1;
214
ar->nups = clvalue(f)->c.nupvalues;
218
ar->namewhat = (ci) ? getfuncname(ci, &ar->name) : NULL;
219
if (ar->namewhat == NULL) {
220
/* try to find a global name */
221
if ((ar->name = travglobals(L, f)) != NULL)
222
ar->namewhat = "global";
223
else ar->namewhat = ""; /* not found */
231
default: status = 0; /* invalid option */
238
LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
242
StkId f = L->top - 1;
243
if (!ttisfunction(f))
244
luaG_runerror(L, "value for `lua_getinfo' is not a function");
245
status = auxgetinfo(L, what + 1, ar, f, NULL);
246
L->top--; /* pop function */
248
else if (ar->i_ci != 0) { /* no tail call? */
249
CallInfo *ci = L->base_ci + ar->i_ci;
250
lua_assert(ttisfunction(ci->base - 1));
251
status = auxgetinfo(L, what, ar, ci->base - 1, ci);
254
info_tailcall(L, ar);
255
if (strchr(what, 'f')) incr_top(L);
262
** {======================================================
263
** Symbolic Execution and code checker
264
** =======================================================
267
#define check(x) if (!(x)) return 0;
269
#define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode)
271
#define checkreg(pt,reg) check((reg) < (pt)->maxstacksize)
275
static int precheck (const Proto *pt) {
276
check(pt->maxstacksize <= MAXSTACK);
277
check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0);
278
lua_assert(pt->numparams+pt->is_vararg <= pt->maxstacksize);
279
check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN);
284
static int checkopenop (const Proto *pt, int pc) {
285
Instruction i = pt->code[pc+1];
286
switch (GET_OPCODE(i)) {
290
check(GETARG_B(i) == 0);
293
case OP_SETLISTO: return 1;
294
default: return 0; /* invalid instruction after an open call */
299
static int checkRK (const Proto *pt, int r) {
300
return (r < pt->maxstacksize || (r >= MAXSTACK && r-MAXSTACK < pt->sizek));
304
static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
306
int last; /* stores position of last instruction that changed `reg' */
307
last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */
309
for (pc = 0; pc < lastpc; pc++) {
310
const Instruction i = pt->code[pc];
311
OpCode op = GET_OPCODE(i);
316
switch (getOpMode(op)) {
320
if (testOpMode(op, OpModeBreg)) {
323
else if (testOpMode(op, OpModeBrk))
324
check(checkRK(pt, b));
325
if (testOpMode(op, OpModeCrk))
326
check(checkRK(pt, c));
331
if (testOpMode(op, OpModeK)) check(b < pt->sizek);
339
if (testOpMode(op, OpModesetA)) {
340
if (a == reg) last = pc; /* change register `a' */
342
if (testOpMode(op, OpModeT)) {
343
check(pc+2 < pt->sizecode); /* check skip */
344
check(GET_OPCODE(pt->code[pc+1]) == OP_JMP);
348
check(c == 0 || pc+2 < pt->sizecode); /* check its jump */
352
if (a <= reg && reg <= b)
353
last = pc; /* set registers from `a' to `b' */
363
check(ttisstring(&pt->k[b]));
368
if (reg == a+1) last = pc;
372
/* `c' is a register, and at least two operands */
373
check(c < MAXSTACK && b < c);
378
if (reg >= a) last = pc; /* affect all registers above base */
385
check(0 <= dest && dest < pt->sizecode);
386
/* not full check and jump is forward and do not skip `lastpc'? */
387
if (reg != NO_REG && pc < dest && dest <= lastpc)
388
pc += b; /* do the jump */
396
c--; /* c = num. returns */
397
if (c == LUA_MULTRET) {
398
check(checkopenop(pt, pc));
402
if (reg >= a) last = pc; /* affect all registers above base */
406
b--; /* b = num. returns */
407
if (b > 0) checkreg(pt, a+b-1);
411
checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1);
416
check(b < pt->sizep);
417
nup = pt->p[b]->nups;
418
check(pc + nup < pt->sizecode);
419
for (; nup>0; nup--) {
420
OpCode op1 = GET_OPCODE(pt->code[pc+nup]);
421
check(op1 == OP_GETUPVAL || op1 == OP_MOVE);
428
return pt->code[last];
435
/* }====================================================== */
438
int luaG_checkcode (const Proto *pt) {
439
return luaG_symbexec(pt, pt->sizecode, NO_REG);
443
static const char *kname (Proto *p, int c) {
445
if (c >= 0 && ttisstring(&p->k[c]))
446
return svalue(&p->k[c]);
452
static const char *getobjname (CallInfo *ci, int stackpos, const char **name) {
453
if (isLua(ci)) { /* a Lua function? */
454
Proto *p = ci_func(ci)->l.p;
455
int pc = currentpc(ci);
457
*name = luaF_getlocalname(p, stackpos+1, pc);
458
if (*name) /* is a local? */
460
i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */
461
lua_assert(pc != -1);
462
switch (GET_OPCODE(i)) {
464
int g = GETARG_Bx(i); /* global index */
465
lua_assert(ttisstring(&p->k[g]));
466
*name = svalue(&p->k[g]);
471
int b = GETARG_B(i); /* move from `b' to `a' */
473
return getobjname(ci, b, name); /* get name for `b' */
477
int k = GETARG_C(i); /* key index */
482
int k = GETARG_C(i); /* key index */
489
return NULL; /* no useful name found */
493
static const char *getfuncname (CallInfo *ci, const char **name) {
495
if ((isLua(ci) && ci->u.l.tailcalls > 0) || !isLua(ci - 1))
496
return NULL; /* calling function is not Lua (or is unknown) */
497
ci--; /* calling function */
498
i = ci_func(ci)->l.p->code[currentpc(ci)];
499
if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL)
500
return getobjname(ci, GETARG_A(i), name);
502
return NULL; /* no useful name can be found */
506
/* only ANSI way to check whether a pointer points to an array */
507
static int isinstack (CallInfo *ci, const TObject *o) {
509
for (p = ci->base; p < ci->top; p++)
510
if (o == p) return 1;
515
void luaG_typeerror (lua_State *L, const TObject *o, const char *op) {
516
const char *name = NULL;
517
const char *t = luaT_typenames[ttype(o)];
518
const char *kind = (isinstack(L->ci, o)) ?
519
getobjname(L->ci, o - L->base, &name) : NULL;
521
luaG_runerror(L, "attempt to %s %s `%s' (a %s value)",
524
luaG_runerror(L, "attempt to %s a %s value", op, t);
528
void luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
529
if (ttisstring(p1)) p1 = p2;
530
lua_assert(!ttisstring(p1));
531
luaG_typeerror(L, p1, "concatenate");
535
void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2) {
537
if (luaV_tonumber(p1, &temp) == NULL)
538
p2 = p1; /* first operand is wrong */
539
luaG_typeerror(L, p2, "perform arithmetic on");
543
int luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2) {
544
const char *t1 = luaT_typenames[ttype(p1)];
545
const char *t2 = luaT_typenames[ttype(p2)];
547
luaG_runerror(L, "attempt to compare two %s values", t1);
549
luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
554
static void addinfo (lua_State *L, const char *msg) {
555
CallInfo *ci = L->ci;
556
if (isLua(ci)) { /* is Lua code? */
557
char buff[LUA_IDSIZE]; /* add file:line information */
558
int line = currentline(ci);
559
luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE);
560
luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
565
void luaG_errormsg (lua_State *L) {
566
if (L->errfunc != 0) { /* is there an error handling function? */
567
StkId errfunc = restorestack(L, L->errfunc);
568
if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR);
569
setobjs2s(L->top, L->top - 1); /* move argument */
570
setobjs2s(L->top - 1, errfunc); /* push function */
572
luaD_call(L, L->top - 2, 1); /* call it */
574
luaD_throw(L, LUA_ERRRUN);
578
void luaG_runerror (lua_State *L, const char *fmt, ...) {
581
addinfo(L, luaO_pushvfstring(L, fmt, argp));