lua/src/ldebug.c

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