1/*
2** $Id: ldebug.c,v 2.90.1.3 2013/05/16 16:04:15 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
330static int filterpc (int pc, int jmptarget) {
331  if (pc < jmptarget)  /* is code conditional (inside a jump)? */
332    return -1;  /* cannot know who sets that register */
333  else return pc;  /* current position sets that register */
334}
335
336
337/*
338** try to find last instruction before 'lastpc' that modified register 'reg'
339*/
340static int findsetreg (Proto *p, int lastpc, int reg) {
341  int pc;
342  int setreg = -1;  /* keep last instruction that changed 'reg' */
343  int jmptarget = 0;  /* any code before this address is conditional */
344  for (pc = 0; pc < lastpc; pc++) {
345    Instruction i = p->code[pc];
346    OpCode op = GET_OPCODE(i);
347    int a = GETARG_A(i);
348    switch (op) {
349      case OP_LOADNIL: {
350        int b = GETARG_B(i);
351        if (a <= reg && reg <= a + b)  /* set registers from 'a' to 'a+b' */
352          setreg = filterpc(pc, jmptarget);
353        break;
354      }
355      case OP_TFORCALL: {
356        if (reg >= a + 2)  /* affect all regs above its base */
357          setreg = filterpc(pc, jmptarget);
358        break;
359      }
360      case OP_CALL:
361      case OP_TAILCALL: {
362        if (reg >= a)  /* affect all registers above base */
363          setreg = filterpc(pc, jmptarget);
364        break;
365      }
366      case OP_JMP: {
367        int b = GETARG_sBx(i);
368        int dest = pc + 1 + b;
369        /* jump is forward and do not skip `lastpc'? */
370        if (pc < dest && dest <= lastpc) {
371          if (dest > jmptarget)
372            jmptarget = dest;  /* update 'jmptarget' */
373        }
374        break;
375      }
376      case OP_TEST: {
377        if (reg == a)  /* jumped code can change 'a' */
378          setreg = filterpc(pc, jmptarget);
379        break;
380      }
381      default:
382        if (testAMode(op) && reg == a)  /* any instruction that set A */
383          setreg = filterpc(pc, jmptarget);
384        break;
385    }
386  }
387  return setreg;
388}
389
390
391static const char *getobjname (Proto *p, int lastpc, int reg,
392                               const char **name) {
393  int pc;
394  *name = luaF_getlocalname(p, reg + 1, lastpc);
395  if (*name)  /* is a local? */
396    return "local";
397  /* else try symbolic execution */
398  pc = findsetreg(p, lastpc, reg);
399  if (pc != -1) {  /* could find instruction? */
400    Instruction i = p->code[pc];
401    OpCode op = GET_OPCODE(i);
402    switch (op) {
403      case OP_MOVE: {
404        int b = GETARG_B(i);  /* move from 'b' to 'a' */
405        if (b < GETARG_A(i))
406          return getobjname(p, pc, b, name);  /* get name for 'b' */
407        break;
408      }
409      case OP_GETTABUP:
410      case OP_GETTABLE: {
411        int k = GETARG_C(i);  /* key index */
412        int t = GETARG_B(i);  /* table index */
413        const char *vn = (op == OP_GETTABLE)  /* name of indexed variable */
414                         ? luaF_getlocalname(p, t + 1, pc)
415                         : upvalname(p, t);
416        kname(p, pc, k, name);
417        return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field";
418      }
419      case OP_GETUPVAL: {
420        *name = upvalname(p, GETARG_B(i));
421        return "upvalue";
422      }
423      case OP_LOADK:
424      case OP_LOADKX: {
425        int b = (op == OP_LOADK) ? GETARG_Bx(i)
426                                 : GETARG_Ax(p->code[pc + 1]);
427        if (ttisstring(&p->k[b])) {
428          *name = svalue(&p->k[b]);
429          return "constant";
430        }
431        break;
432      }
433      case OP_SELF: {
434        int k = GETARG_C(i);  /* key index */
435        kname(p, pc, k, name);
436        return "method";
437      }
438      default: break;  /* go through to return NULL */
439    }
440  }
441  return NULL;  /* could not find reasonable name */
442}
443
444
445static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
446  TMS tm;
447  Proto *p = ci_func(ci)->p;  /* calling function */
448  int pc = currentpc(ci);  /* calling instruction index */
449  Instruction i = p->code[pc];  /* calling instruction */
450  switch (GET_OPCODE(i)) {
451    case OP_CALL:
452    case OP_TAILCALL:  /* get function name */
453      return getobjname(p, pc, GETARG_A(i), name);
454    case OP_TFORCALL: {  /* for iterator */
455      *name = "for iterator";
456       return "for iterator";
457    }
458    /* all other instructions can call only through metamethods */
459    case OP_SELF:
460    case OP_GETTABUP:
461    case OP_GETTABLE: tm = TM_INDEX; break;
462    case OP_SETTABUP:
463    case OP_SETTABLE: tm = TM_NEWINDEX; break;
464    case OP_EQ: tm = TM_EQ; break;
465    case OP_ADD: tm = TM_ADD; break;
466    case OP_SUB: tm = TM_SUB; break;
467    case OP_MUL: tm = TM_MUL; break;
468    case OP_DIV: tm = TM_DIV; break;
469    case OP_MOD: tm = TM_MOD; break;
470    case OP_POW: tm = TM_POW; break;
471    case OP_UNM: tm = TM_UNM; break;
472    case OP_LEN: tm = TM_LEN; break;
473    case OP_LT: tm = TM_LT; break;
474    case OP_LE: tm = TM_LE; break;
475    case OP_CONCAT: tm = TM_CONCAT; break;
476    default:
477      return NULL;  /* else no useful name can be found */
478  }
479  *name = getstr(G(L)->tmname[tm]);
480  return "metamethod";
481}
482
483/* }====================================================== */
484
485
486
487/*
488** only ANSI way to check whether a pointer points to an array
489** (used only for error messages, so efficiency is not a big concern)
490*/
491static int isinstack (CallInfo *ci, const TValue *o) {
492  StkId p;
493  for (p = ci->u.l.base; p < ci->top; p++)
494    if (o == p) return 1;
495  return 0;
496}
497
498
499static const char *getupvalname (CallInfo *ci, const TValue *o,
500                                 const char **name) {
501  LClosure *c = ci_func(ci);
502  int i;
503  for (i = 0; i < c->nupvalues; i++) {
504    if (c->upvals[i]->v == o) {
505      *name = upvalname(c->p, i);
506      return "upvalue";
507    }
508  }
509  return NULL;
510}
511
512
513l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
514  CallInfo *ci = L->ci;
515  const char *name = NULL;
516  const char *t = objtypename(o);
517  const char *kind = NULL;
518  if (isLua(ci)) {
519    kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
520    if (!kind && isinstack(ci, o))  /* no? try a register */
521      kind = getobjname(ci_func(ci)->p, currentpc(ci),
522                        cast_int(o - ci->u.l.base), &name);
523  }
524  if (kind)
525    luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)",
526                op, kind, name, t);
527  else
528    luaG_runerror(L, "attempt to %s a %s value", op, t);
529}
530
531
532l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
533  if (ttisstring(p1) || ttisnumber(p1)) p1 = p2;
534  lua_assert(!ttisstring(p1) && !ttisnumber(p1));
535  luaG_typeerror(L, p1, "concatenate");
536}
537
538
539l_noret luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) {
540  TValue temp;
541  if (luaV_tonumber(p1, &temp) == NULL)
542    p2 = p1;  /* first operand is wrong */
543  luaG_typeerror(L, p2, "perform arithmetic on");
544}
545
546
547l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
548  const char *t1 = objtypename(p1);
549  const char *t2 = objtypename(p2);
550  if (t1 == t2)
551    luaG_runerror(L, "attempt to compare two %s values", t1);
552  else
553    luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
554}
555
556
557static void addinfo (lua_State *L, const char *msg) {
558  CallInfo *ci = L->ci;
559  if (isLua(ci)) {  /* is Lua code? */
560    char buff[LUA_IDSIZE];  /* add file:line information */
561    int line = currentline(ci);
562    TString *src = ci_func(ci)->p->source;
563    if (src)
564      luaO_chunkid(buff, getstr(src), LUA_IDSIZE);
565    else {  /* no source available; use "?" instead */
566      buff[0] = '?'; buff[1] = '\0';
567    }
568    luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
569  }
570}
571
572
573l_noret luaG_errormsg (lua_State *L) {
574  if (L->errfunc != 0) {  /* is there an error handling function? */
575    StkId errfunc = restorestack(L, L->errfunc);
576    if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR);
577    setobjs2s(L, L->top, L->top - 1);  /* move argument */
578    setobjs2s(L, L->top - 1, errfunc);  /* push function */
579    L->top++;
580    luaD_call(L, L->top - 2, 1, 0);  /* call it */
581  }
582  luaD_throw(L, LUA_ERRRUN);
583}
584
585
586l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
587  va_list argp;
588  va_start(argp, fmt);
589  addinfo(L, luaO_pushvfstring(L, fmt, argp));
590  va_end(argp);
591  luaG_errormsg(L);
592}
593
594