src/ldebug.c

   1 /*
   2 ** $Id: ldebug.c,v 1.150 2003/03/19 21:24:04 roberto Exp $
   3 ** Debug Interface
   4 ** See Copyright Notice in lua.h
   5 */
   6
   7
   8 #include <stdlib.h>
   9 #include <string.h>
  10
  11 #define ldebug_c
  12
  13 #include "lua.h"
  14
  15 #include "lapi.h"
  16 #include "lcode.h"
  17 #include "ldebug.h"
  18 #include "ldo.h"
  19 #include "lfunc.h"
  20 #include "lobject.h"
  21 #include "lopcodes.h"
  22 #include "lstate.h"
  23 #include "lstring.h"
  24 #include "ltable.h"
  25 #include "ltm.h"
  26 #include "lvm.h"
  27
  28
  29
  30 static const char *getfuncname (CallInfo *ci, const char **name);
  31
  32
  33 #define isLua(ci)       (!((ci)->state & CI_C))
  34
  35
  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);
  42 }
  43
  44
  45 static int currentline (CallInfo *ci) {
  46   int pc = currentpc(ci);
  47   if (pc < 0)
  48     return -1;  /* only active lua functions have current-line information */
  49   else
  50     return getline(ci_func(ci)->l.p, pc);
  51 }
  52
  53
  54 void luaG_inithooks (lua_State *L) {
  55   CallInfo *ci;
  56   for (ci = L->ci; ci != L->base_ci; ci--)  /* update all `savedpc's */
  57     currentpc(ci);
  58   L->hookinit = 1;
  59 }
  60
  61
  62 /*
  63 ** this function can be called asynchronous (e.g. during a signal)
  64 */
  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? */
  67     mask = 0;
  68     func = NULL;
  69   }
  70   L->hook = func;
  71   L->basehookcount = count;
  72   resethookcount(L);
  73   L->hookmask = cast(lu_byte, mask);
  74   L->hookinit = 0;
  75   return 1;
  76 }
  77
  78
  79 LUA_API lua_Hook lua_gethook (lua_State *L) {
  80   return L->hook;
  81 }
  82
  83
  84 LUA_API int lua_gethookmask (lua_State *L) {
  85   return L->hookmask;
  86 }
  87
  88
  89 LUA_API int lua_gethookcount (lua_State *L) {
  90   return L->basehookcount;
  91 }
  92
  93
  94 LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
  95   int status;
  96   CallInfo *ci;
  97   lua_lock(L);
  98   for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) {
  99     level--;
 100     if (!(ci->state & CI_C))  /* Lua function? */
 101       level -= ci->u.l.tailcalls;  /* skip lost tail calls */
 102   }
 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 */
 105     status = 1;
 106     ar->i_ci = 0;
 107   }
 108   else {
 109     status = 1;
 110     ar->i_ci = ci - L->base_ci;
 111   }
 112   lua_unlock(L);
 113   return status;
 114 }
 115
 116
 117 static Proto *getluaproto (CallInfo *ci) {
 118   return (isLua(ci) ? ci_func(ci)->l.p : NULL);
 119 }
 120
 121
 122 LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
 123   const char *name;
 124   CallInfo *ci;
 125   Proto *fp;
 126   lua_lock(L);
 127   name = NULL;
 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));
 132     if (name)
 133       luaA_pushobject(L, ci->base+(n-1));  /* push value */
 134   }
 135   lua_unlock(L);
 136   return name;
 137 }
 138
 139
 140 LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
 141   const char *name;
 142   CallInfo *ci;
 143   Proto *fp;
 144   lua_lock(L);
 145   name = NULL;
 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 */
 152       name = NULL;
 153     else
 154       setobjs2s(ci->base+(n-1), L->top);
 155   }
 156   lua_unlock(L);
 157   return name;
 158 }
 159
 160
 161 static void funcinfo (lua_Debug *ar, StkId func) {
 162   Closure *cl = clvalue(func);
 163   if (cl->c.isC) {
 164     ar->source = "=[C]";
 165     ar->linedefined = -1;
 166     ar->what = "C";
 167   }
 168   else {
 169     ar->source = getstr(cl->l.p->source);
 170     ar->linedefined = cl->l.p->lineDefined;
 171     ar->what = (ar->linedefined == 0) ? "main" : "Lua";
 172   }
 173   luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
 174 }
 175
 176
 177 static const char *travglobals (lua_State *L, const TObject *o) {
 178   Table *g = hvalue(gt(L));
 179   int i = sizenode(g);
 180   while (i--) {
 181     Node *n = gnode(g, i);
 182     if (luaO_rawequalObj(o, gval(n)) && ttisstring(gkey(n)))
 183       return getstr(tsvalue(gkey(n)));
 184   }
 185   return NULL;
 186 }
 187
 188
 189 static void info_tailcall (lua_State *L, lua_Debug *ar) {
 190   ar->name = ar->namewhat = "";
 191   ar->what = "tail";
 192   ar->linedefined = ar->currentline = -1;
 193   ar->source = "=(tail call)";
 194   luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
 195   ar->nups = 0;
 196   setnilvalue(L->top);
 197 }
 198
 199
 200 static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
 201                     StkId f, CallInfo *ci) {
 202   int status = 1;
 203   for (; *what; what++) {
 204     switch (*what) {
 205       case 'S': {
 206         funcinfo(ar, f);
 207         break;
 208       }
 209       case 'l': {
 210         ar->currentline = (ci) ? currentline(ci) : -1;
 211         break;
 212       }
 213       case 'u': {
 214         ar->nups = clvalue(f)->c.nupvalues;
 215         break;
 216       }
 217       case 'n': {
 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 */
 224         }
 225         break;
 226       }
 227       case 'f': {
 228         setobj2s(L->top, f);
 229         break;
 230       }
 231       default: status = 0;  /* invalid option */
 232     }
 233   }
 234   return status;
 235 }
 236
 237
 238 LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
 239   int status = 1;
 240   lua_lock(L);
 241   if (*what == '>') {
 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 */
 247   }
 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);
 252   }
 253   else
 254     info_tailcall(L, ar);
 255   if (strchr(what, 'f')) incr_top(L);
 256   lua_unlock(L);
 257   return status;
 258 }
 259
 260
 261 /*
 262 ** {======================================================
 263 ** Symbolic Execution and code checker
 264 ** =======================================================
 265 */
 266
 267 #define check(x)                if (!(x)) return 0;
 268
 269 #define checkjump(pt,pc)        check(0 <= pc && pc < pt->sizecode)
 270
 271 #define checkreg(pt,reg)        check((reg) < (pt)->maxstacksize)
 272
 273
 274
 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);
 280   return 1;
 281 }
 282
 283
 284 static int checkopenop (const Proto *pt, int pc) {
 285   Instruction i = pt->code[pc+1];
 286   switch (GET_OPCODE(i)) {
 287     case OP_CALL:
 288     case OP_TAILCALL:
 289     case OP_RETURN: {
 290       check(GETARG_B(i) == 0);
 291       return 1;
 292     }
 293     case OP_SETLISTO: return 1;
 294     default: return 0;  /* invalid instruction after an open call */
 295   }
 296 }
 297
 298
 299 static int checkRK (const Proto *pt, int r) {
 300   return (r < pt->maxstacksize || (r >= MAXSTACK && r-MAXSTACK < pt->sizek));
 301 }
 302
 303
 304 static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
 305   int pc;
 306   int last;  /* stores position of last instruction that changed `reg' */
 307   last = pt->sizecode-1;  /* points to final return (a `neutral' instruction) */
 308   check(precheck(pt));
 309   for (pc = 0; pc < lastpc; pc++) {
 310     const Instruction i = pt->code[pc];
 311     OpCode op = GET_OPCODE(i);
 312     int a = GETARG_A(i);
 313     int b = 0;
 314     int c = 0;
 315     checkreg(pt, a);
 316     switch (getOpMode(op)) {
 317       case iABC: {
 318         b = GETARG_B(i);
 319         c = GETARG_C(i);
 320         if (testOpMode(op, OpModeBreg)) {
 321           checkreg(pt, b);
 322         }
 323         else if (testOpMode(op, OpModeBrk))
 324           check(checkRK(pt, b));
 325         if (testOpMode(op, OpModeCrk))
 326           check(checkRK(pt, c));
 327         break;
 328       }
 329       case iABx: {
 330         b = GETARG_Bx(i);
 331         if (testOpMode(op, OpModeK)) check(b < pt->sizek);
 332         break;
 333       }
 334       case iAsBx: {
 335         b = GETARG_sBx(i);
 336         break;
 337       }
 338     }
 339     if (testOpMode(op, OpModesetA)) {
 340       if (a == reg) last = pc;  /* change register `a' */
 341     }
 342     if (testOpMode(op, OpModeT)) {
 343       check(pc+2 < pt->sizecode);  /* check skip */
 344       check(GET_OPCODE(pt->code[pc+1]) == OP_JMP);
 345     }
 346     switch (op) {
 347       case OP_LOADBOOL: {
 348         check(c == 0 || pc+2 < pt->sizecode);  /* check its jump */
 349         break;
 350       }
 351       case OP_LOADNIL: {
 352         if (a <= reg && reg <= b)
 353           last = pc;  /* set registers from `a' to `b' */
 354         break;
 355       }
 356       case OP_GETUPVAL:
 357       case OP_SETUPVAL: {
 358         check(b < pt->nups);
 359         break;
 360       }
 361       case OP_GETGLOBAL:
 362       case OP_SETGLOBAL: {
 363         check(ttisstring(&pt->k[b]));
 364         break;
 365       }
 366       case OP_SELF: {
 367         checkreg(pt, a+1);
 368         if (reg == a+1) last = pc;
 369         break;
 370       }
 371       case OP_CONCAT: {
 372         /* `c' is a register, and at least two operands */
 373         check(c < MAXSTACK && b < c);
 374         break;
 375       }
 376       case OP_TFORLOOP:
 377         checkreg(pt, a+c+5);
 378         if (reg >= a) last = pc;  /* affect all registers above base */
 379         /* go through */
 380       case OP_FORLOOP:
 381         checkreg(pt, a+2);
 382         /* go through */
 383       case OP_JMP: {
 384         int dest = pc+1+b;
 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 */
 389         break;
 390       }
 391       case OP_CALL:
 392       case OP_TAILCALL: {
 393         if (b != 0) {
 394           checkreg(pt, a+b-1);
 395         }
 396         c--;  /* c = num. returns */
 397         if (c == LUA_MULTRET) {
 398           check(checkopenop(pt, pc));
 399         }
 400         else if (c != 0)
 401           checkreg(pt, a+c-1);
 402         if (reg >= a) last = pc;  /* affect all registers above base */
 403         break;
 404       }
 405       case OP_RETURN: {
 406         b--;  /* b = num. returns */
 407         if (b > 0) checkreg(pt, a+b-1);
 408         break;
 409       }
 410       case OP_SETLIST: {
 411         checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1);
 412         break;
 413       }
 414       case OP_CLOSURE: {
 415         int nup;
 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);
 422         }
 423         break;
 424       }
 425       default: break;
 426     }
 427   }
 428   return pt->code[last];
 429 }
 430
 431 #undef check
 432 #undef checkjump
 433 #undef checkreg
 434
 435 /* }====================================================== */
 436
 437
 438 int luaG_checkcode (const Proto *pt) {
 439   return luaG_symbexec(pt, pt->sizecode, NO_REG);
 440 }
 441
 442
 443 static const char *kname (Proto *p, int c) {
 444   c = c - MAXSTACK;
 445   if (c >= 0 && ttisstring(&p->k[c]))
 446     return svalue(&p->k[c]);
 447   else
 448     return "?";
 449 }
 450
 451
 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);
 456     Instruction i;
 457     *name = luaF_getlocalname(p, stackpos+1, pc);
 458     if (*name)  /* is a local? */
 459       return "local";
 460     i = luaG_symbexec(p, pc, stackpos);  /* try symbolic execution */
 461     lua_assert(pc != -1);
 462     switch (GET_OPCODE(i)) {
 463       case OP_GETGLOBAL: {
 464         int g = GETARG_Bx(i);  /* global index */
 465         lua_assert(ttisstring(&p->k[g]));
 466         *name = svalue(&p->k[g]);
 467         return "global";
 468       }
 469       case OP_MOVE: {
 470         int a = GETARG_A(i);
 471         int b = GETARG_B(i);  /* move from `b' to `a' */
 472         if (b < a)
 473           return getobjname(ci, b, name);  /* get name for `b' */
 474         break;
 475       }
 476       case OP_GETTABLE: {
 477         int k = GETARG_C(i);  /* key index */
 478         *name = kname(p, k);
 479         return "field";
 480       }
 481       case OP_SELF: {
 482         int k = GETARG_C(i);  /* key index */
 483         *name = kname(p, k);
 484         return "method";
 485       }
 486       default: break;
 487     }
 488   }
 489   return NULL;  /* no useful name found */
 490 }
 491
 492
 493 static const char *getfuncname (CallInfo *ci, const char **name) {
 494   Instruction i;
 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);
 501   else
 502     return NULL;  /* no useful name can be found */
 503 }
 504
 505
 506 /* only ANSI way to check whether a pointer points to an array */
 507 static int isinstack (CallInfo *ci, const TObject *o) {
 508   StkId p;
 509   for (p = ci->base; p < ci->top; p++)
 510     if (o == p) return 1;
 511   return 0;
 512 }
 513
 514
 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;
 520   if (kind)
 521     luaG_runerror(L, "attempt to %s %s `%s' (a %s value)",
 522                 op, kind, name, t);
 523   else
 524     luaG_runerror(L, "attempt to %s a %s value", op, t);
 525 }
 526
 527
 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");
 532 }
 533
 534
 535 void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2) {
 536   TObject temp;
 537   if (luaV_tonumber(p1, &temp) == NULL)
 538     p2 = p1;  /* first operand is wrong */
 539   luaG_typeerror(L, p2, "perform arithmetic on");
 540 }
 541
 542
 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)];
 546   if (t1[2] == t2[2])
 547     luaG_runerror(L, "attempt to compare two %s values", t1);
 548   else
 549     luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
 550   return 0;
 551 }
 552
 553
 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);
 561   }
 562 }
 563
 564
 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 */
 571     incr_top(L);
 572     luaD_call(L, L->top - 2, 1);  /* call it */
 573   }
 574   luaD_throw(L, LUA_ERRRUN);
 575 }
 576
 577
 578 void luaG_runerror (lua_State *L, const char *fmt, ...) {
 579   va_list argp;
 580   va_start(argp, fmt);
 581   addinfo(L, luaO_pushvfstring(L, fmt, argp));
 582   va_end(argp);
 583   luaG_errormsg(L);
 584 }
 585