1/*
2** $Id: ldebug.c,v 2.90 2012/08/16 17:34:28 roberto Exp $
3** Debug Interface
4** See Copyright Notice in lua.h
5*/
6
7
8#include <stdarg.h>
9#include <stddef.h>
10#include <string.h>
11
12
13#define ldebug_c
14#define LUA_CORE
15
16#include "lua.h"
17
18#include "lapi.h"
19#include "lcode.h"
20#include "ldebug.h"
21#include "ldo.h"
22#include "lfunc.h"
23#include "lobject.h"
24#include "lopcodes.h"
25#include "lstate.h"
26#include "lstring.h"
27#include "ltable.h"
28#include "ltm.h"
29#include "lvm.h"
30
31
32
33#define noLuaClosure(f)		((f) == NULL || (f)->c.tt == LUA_TCCL)
34
35
36static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);
37
38
39static int currentpc (CallInfo *ci) {
40  lua_assert(isLua(ci));
41  return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
42}
43
44
45static int currentline (CallInfo *ci) {
46  return getfuncline(ci_func(ci)->p, currentpc(ci));
47}
48
49
50/*
51** this function can be called asynchronous (e.g. during a signal)
52*/
53LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
54  if (func == NULL || mask == 0) {  /* turn off hooks? */
55    mask = 0;
56    func = NULL;
57  }
58  if (isLua(L->ci))
59    L->oldpc = L->ci->u.l.savedpc;
60  L->hook = func;
61  L->basehookcount = count;
62  resethookcount(L);
63  L->hookmask = cast_byte(mask);
64  return 1;
65}
66
67
68LUA_API lua_Hook lua_gethook (lua_State *L) {
69  return L->hook;
70}
71
72
73LUA_API int lua_gethookmask (lua_State *L) {
74  return L->hookmask;
75}
76
77
78LUA_API int lua_gethookcount (lua_State *L) {
79  return L->basehookcount;
80}
81
82
83LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
84  int status;
85  CallInfo *ci;
86  if (level < 0) return 0;  /* invalid (negative) level */
87  lua_lock(L);
88  for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
89    level--;
90  if (level == 0 && ci != &L->base_ci) {  /* level found? */
91    status = 1;
92    ar->i_ci = ci;
93  }
94  else status = 0;  /* no such level */
95  lua_unlock(L);
96  return status;
97}
98
99
100static const char *upvalname (Proto *p, int uv) {
101  TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
102  if (s == NULL) return "?";
103  else return getstr(s);
104}
105
106
107static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
108  int nparams = clLvalue(ci->func)->p->numparams;
109  if (n >= ci->u.l.base - ci->func - nparams)
110    return NULL;  /* no such vararg */
111  else {
112    *pos = ci->func + nparams + n;
113    return "(*vararg)";  /* generic name for any vararg */
114  }
115}
116
117
118static const char *findlocal (lua_State *L, CallInfo *ci, int n,
119                              StkId *pos) {
120  const char *name = NULL;
121  StkId base;
122  if (isLua(ci)) {
123    if (n < 0)  /* access to vararg values? */
124      return findvararg(ci, -n, pos);
125    else {
126      base = ci->u.l.base;
127      name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
128    }
129  }
130  else
131    base = ci->func + 1;
132  if (name == NULL) {  /* no 'standard' name? */
133    StkId limit = (ci == L->ci) ? L->top : ci->next->func;
134    if (limit - base >= n && n > 0)  /* is 'n' inside 'ci' stack? */
135      name = "(*temporary)";  /* generic name for any valid slot */
136    else
137      return NULL;  /* no name */
138  }
139  *pos = base + (n - 1);
140  return name;
141}
142
143
144LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
145  const char *name;
146  lua_lock(L);
147  if (ar == NULL) {  /* information about non-active function? */
148    if (!isLfunction(L->top - 1))  /* not a Lua function? */
149      name = NULL;
150    else  /* consider live variables at function start (parameters) */
151      name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0);
152  }
153  else {  /* active function; get information through 'ar' */
154    StkId pos = 0;  /* to avoid warnings */
155    name = findlocal(L, ar->i_ci, n, &pos);
156    if (name) {
157      setobj2s(L, L->top, pos);
158      api_incr_top(L);
159    }
160  }
161  lua_unlock(L);
162  return name;
163}
164
165
166LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
167  StkId pos = 0;  /* to avoid warnings */
168  const char *name = findlocal(L, ar->i_ci, n, &pos);
169  lua_lock(L);
170  if (name)
171    setobjs2s(L, pos, L->top - 1);
172  L->top--;  /* pop value */
173  lua_unlock(L);
174  return name;
175}
176
177
178static void funcinfo (lua_Debug *ar, Closure *cl) {
179  if (noLuaClosure(cl)) {
180    ar->source = "=[C]";
181    ar->linedefined = -1;
182    ar->lastlinedefined = -1;
183    ar->what = "C";
184  }
185  else {
186    Proto *p = cl->l.p;
187    ar->source = p->source ? getstr(p->source) : "=?";
188    ar->linedefined = p->linedefined;
189    ar->lastlinedefined = p->lastlinedefined;
190    ar->what = (ar->linedefined == 0) ? "main" : "Lua";
191  }
192  luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
193}
194
195
196static void collectvalidlines (lua_State *L, Closure *f) {
197  if (noLuaClosure(f)) {
198    setnilvalue(L->top);
199    api_incr_top(L);
200  }
201  else {
202    int i;
203    TValue v;
204    int *lineinfo = f->l.p->lineinfo;
205    Table *t = luaH_new(L);  /* new table to store active lines */
206    sethvalue(L, L->top, t);  /* push it on stack */
207    api_incr_top(L);
208    setbvalue(&v, 1);  /* boolean 'true' to be the value of all indices */
209    for (i = 0; i < f->l.p->sizelineinfo; i++)  /* for all lines with code */
210      luaH_setint(L, t, lineinfo[i], &v);  /* table[line] = true */
211  }
212}
213
214
215static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
216                       Closure *f, CallInfo *ci) {
217  int status = 1;
218  for (; *what; what++) {
219    switch (*what) {
220      case 'S': {
221        funcinfo(ar, f);
222        break;
223      }
224      case 'l': {
225        ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1;
226        break;
227      }
228      case 'u': {
229        ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
230        if (noLuaClosure(f)) {
231          ar->isvararg = 1;
232          ar->nparams = 0;
233        }
234        else {
235          ar->isvararg = f->l.p->is_vararg;
236          ar->nparams = f->l.p->numparams;
237        }
238        break;
239      }
240      case 't': {
241        ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
242        break;
243      }
244      case 'n': {
245        /* calling function is a known Lua function? */
246        if (ci && !(ci->callstatus & CIST_TAIL) && isLua(ci->previous))
247          ar->namewhat = getfuncname(L, ci->previous, &ar->name);
248        else
249          ar->namewhat = NULL;
250        if (ar->namewhat == NULL) {
251          ar->namewhat = "";  /* not found */
252          ar->name = NULL;
253        }
254        break;
255      }
256      case 'L':
257      case 'f':  /* handled by lua_getinfo */
258        break;
259      default: status = 0;  /* invalid option */
260    }
261  }
262  return status;
263}
264
265
266LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
267  int status;
268  Closure *cl;
269  CallInfo *ci;
270  StkId func;
271  lua_lock(L);
272  if (*what == '>') {
273    ci = NULL;
274    func = L->top - 1;
275    api_check(L, ttisfunction(func), "function expected");
276    what++;  /* skip the '>' */
277    L->top--;  /* pop function */
278  }
279  else {
280    ci = ar->i_ci;
281    func = ci->func;
282    lua_assert(ttisfunction(ci->func));
283  }
284  cl = ttisclosure(func) ? clvalue(func) : NULL;
285  status = auxgetinfo(L, what, ar, cl, ci);
286  if (strchr(what, 'f')) {
287    setobjs2s(L, L->top, func);
288    api_incr_top(L);
289  }
290  if (strchr(what, 'L'))
291    collectvalidlines(L, cl);
292  lua_unlock(L);
293  return status;
294}
295
296
297/*
298** {======================================================
299** Symbolic Execution
300** =======================================================
301*/
302
303static const char *getobjname (Proto *p, int lastpc, int reg,
304                               const char **name);
305
306
307/*
308** find a "name" for the RK value 'c'
309*/
310static void kname (Proto *p, int pc, int c, const char **name) {
311  if (ISK(c)) {  /* is 'c' a constant? */
312    TValue *kvalue = &p->k[INDEXK(c)];
313    if (ttisstring(kvalue)) {  /* literal constant? */
314      *name = svalue(kvalue);  /* it is its own name */
315      return;
316    }
317    /* else no reasonable name found */
318  }
319  else {  /* 'c' is a register */
320    const char *what = getobjname(p, pc, c, name); /* search for 'c' */
321    if (what && *what == 'c') {  /* found a constant name? */
322      return;  /* 'name' already filled */
323    }
324    /* else no reasonable name found */
325  }
326  *name = "?";  /* no reasonable name found */
327}
328
329
330/*
331** try to find last instruction before 'lastpc' that modified register 'reg'
332*/
333static int findsetreg (Proto *p, int lastpc, int reg) {
334  int pc;
335  int setreg = -1;  /* keep last instruction that changed 'reg' */
336  for (pc = 0; pc < lastpc; pc++) {
337    Instruction i = p->code[pc];
338    OpCode op = GET_OPCODE(i);
339    int a = GETARG_A(i);
340    switch (op) {
341      case OP_LOADNIL: {
342        int b = GETARG_B(i);
343        if (a <= reg && reg <= a + b)  /* set registers from 'a' to 'a+b' */
344          setreg = pc;
345        break;
346      }
347      case OP_TFORCALL: {
348        if (reg >= a + 2) setreg = pc;  /* affect all regs above its base */
349        break;
350      }
351      case OP_CALL:
352      case OP_TAILCALL: {
353        if (reg >= a) setreg = pc;  /* affect all registers above base */
354        break;
355      }
356      case OP_JMP: {
357        int b = GETARG_sBx(i);
358        int dest = pc + 1 + b;
359        /* jump is forward and do not skip `lastpc'? */
360        if (pc < dest && dest <= lastpc)
361          pc += b;  /* do the jump */
362        break;
363      }
364      case OP_TEST: {
365        if (reg == a) setreg = pc;  /* jumped code can change 'a' */
366        break;
367      }
368      default:
369        if (testAMode(op) && reg == a)  /* any instruction that set A */
370          setreg = pc;
371        break;
372    }
373  }
374  return setreg;
375}
376
377
378static const char *getobjname (Proto *p, int lastpc, int reg,
379                               const char **name) {
380  int pc;
381  *name = luaF_getlocalname(p, reg + 1, lastpc);
382  if (*name)  /* is a local? */
383    return "local";
384  /* else try symbolic execution */
385  pc = findsetreg(p, lastpc, reg);
386  if (pc != -1) {  /* could find instruction? */
387    Instruction i = p->code[pc];
388    OpCode op = GET_OPCODE(i);
389    switch (op) {
390      case OP_MOVE: {
391        int b = GETARG_B(i);  /* move from 'b' to 'a' */
392        if (b < GETARG_A(i))
393          return getobjname(p, pc, b, name);  /* get name for 'b' */
394        break;
395      }
396      case OP_GETTABUP:
397      case OP_GETTABLE: {
398        int k = GETARG_C(i);  /* key index */
399        int t = GETARG_B(i);  /* table index */
400        const char *vn = (op == OP_GETTABLE)  /* name of indexed variable */
401                         ? luaF_getlocalname(p, t + 1, pc)
402                         : upvalname(p, t);
403        kname(p, pc, k, name);
404        return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field";
405      }
406      case OP_GETUPVAL: {
407        *name = upvalname(p, GETARG_B(i));
408        return "upvalue";
409      }
410      case OP_LOADK:
411      case OP_LOADKX: {
412        int b = (op == OP_LOADK) ? GETARG_Bx(i)
413                                 : GETARG_Ax(p->code[pc + 1]);
414        if (ttisstring(&p->k[b])) {
415          *name = svalue(&p->k[b]);
416          return "constant";
417        }
418        break;
419      }
420      case OP_SELF: {
421        int k = GETARG_C(i);  /* key index */
422        kname(p, pc, k, name);
423        return "method";
424      }
425      default: break;  /* go through to return NULL */
426    }
427  }
428  return NULL;  /* could not find reasonable name */
429}
430
431
432static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
433  TMS tm;
434  Proto *p = ci_func(ci)->p;  /* calling function */
435  int pc = currentpc(ci);  /* calling instruction index */
436  Instruction i = p->code[pc];  /* calling instruction */
437  switch (GET_OPCODE(i)) {
438    case OP_CALL:
439    case OP_TAILCALL:  /* get function name */
440      return getobjname(p, pc, GETARG_A(i), name);
441    case OP_TFORCALL: {  /* for iterator */
442      *name = "for iterator";
443       return "for iterator";
444    }
445    /* all other instructions can call only through metamethods */
446    case OP_SELF:
447    case OP_GETTABUP:
448    case OP_GETTABLE: tm = TM_INDEX; break;
449    case OP_SETTABUP:
450    case OP_SETTABLE: tm = TM_NEWINDEX; break;
451    case OP_EQ: tm = TM_EQ; break;
452    case OP_ADD: tm = TM_ADD; break;
453    case OP_SUB: tm = TM_SUB; break;
454    case OP_MUL: tm = TM_MUL; break;
455    case OP_DIV: tm = TM_DIV; break;
456    case OP_MOD: tm = TM_MOD; break;
457    case OP_POW: tm = TM_POW; break;
458    case OP_UNM: tm = TM_UNM; break;
459    case OP_LEN: tm = TM_LEN; break;
460    case OP_LT: tm = TM_LT; break;
461    case OP_LE: tm = TM_LE; break;
462    case OP_CONCAT: tm = TM_CONCAT; break;
463    default:
464      return NULL;  /* else no useful name can be found */
465  }
466  *name = getstr(G(L)->tmname[tm]);
467  return "metamethod";
468}
469
470/* }====================================================== */
471
472
473
474/*
475** only ANSI way to check whether a pointer points to an array
476** (used only for error messages, so efficiency is not a big concern)
477*/
478static int isinstack (CallInfo *ci, const TValue *o) {
479  StkId p;
480  for (p = ci->u.l.base; p < ci->top; p++)
481    if (o == p) return 1;
482  return 0;
483}
484
485
486static const char *getupvalname (CallInfo *ci, const TValue *o,
487                                 const char **name) {
488  LClosure *c = ci_func(ci);
489  int i;
490  for (i = 0; i < c->nupvalues; i++) {
491    if (c->upvals[i]->v == o) {
492      *name = upvalname(c->p, i);
493      return "upvalue";
494    }
495  }
496  return NULL;
497}
498
499
500l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
501  CallInfo *ci = L->ci;
502  const char *name = NULL;
503  const char *t = objtypename(o);
504  const char *kind = NULL;
505  if (isLua(ci)) {
506    kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
507    if (!kind && isinstack(ci, o))  /* no? try a register */
508      kind = getobjname(ci_func(ci)->p, currentpc(ci),
509                        cast_int(o - ci->u.l.base), &name);
510  }
511  if (kind)
512    luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)",
513                op, kind, name, t);
514  else
515    luaG_runerror(L, "attempt to %s a %s value", op, t);
516}
517
518
519l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
520  if (ttisstring(p1) || ttisnumber(p1)) p1 = p2;
521  lua_assert(!ttisstring(p1) && !ttisnumber(p2));
522  luaG_typeerror(L, p1, "concatenate");
523}
524
525
526l_noret luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) {
527  TValue temp;
528  if (luaV_tonumber(p1, &temp) == NULL)
529    p2 = p1;  /* first operand is wrong */
530  luaG_typeerror(L, p2, "perform arithmetic on");
531}
532
533
534l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
535  const char *t1 = objtypename(p1);
536  const char *t2 = objtypename(p2);
537  if (t1 == t2)
538    luaG_runerror(L, "attempt to compare two %s values", t1);
539  else
540    luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
541}
542
543
544static void addinfo (lua_State *L, const char *msg) {
545  CallInfo *ci = L->ci;
546  if (isLua(ci)) {  /* is Lua code? */
547    char buff[LUA_IDSIZE];  /* add file:line information */
548    int line = currentline(ci);
549    TString *src = ci_func(ci)->p->source;
550    if (src)
551      luaO_chunkid(buff, getstr(src), LUA_IDSIZE);
552    else {  /* no source available; use "?" instead */
553      buff[0] = '?'; buff[1] = '\0';
554    }
555    luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
556  }
557}
558
559
560l_noret luaG_errormsg (lua_State *L) {
561  if (L->errfunc != 0) {  /* is there an error handling function? */
562    StkId errfunc = restorestack(L, L->errfunc);
563    if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR);
564    setobjs2s(L, L->top, L->top - 1);  /* move argument */
565    setobjs2s(L, L->top - 1, errfunc);  /* push function */
566    L->top++;
567    luaD_call(L, L->top - 2, 1, 0);  /* call it */
568  }
569  luaD_throw(L, LUA_ERRRUN);
570}
571
572
573l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
574  va_list argp;
575  va_start(argp, fmt);
576  addinfo(L, luaO_pushvfstring(L, fmt, argp));
577  va_end(argp);
578  luaG_errormsg(L);
579}
580
581