rpm
4.5
|
00001 /* 00002 ** $Id: ldebug.c,v 1.1 2004/03/16 21:58:30 niemeyer Exp $ 00003 ** Debug Interface 00004 ** See Copyright Notice in lua.h 00005 */ 00006 00007 00008 #include <stdlib.h> 00009 #include <string.h> 00010 00011 #define ldebug_c 00012 00013 #include "lua.h" 00014 00015 #include "lapi.h" 00016 #include "lcode.h" 00017 #include "ldebug.h" 00018 #include "ldo.h" 00019 #include "lfunc.h" 00020 #include "lobject.h" 00021 #include "lopcodes.h" 00022 #include "lstate.h" 00023 #include "lstring.h" 00024 #include "ltable.h" 00025 #include "ltm.h" 00026 #include "lvm.h" 00027 00028 00029 00030 /*@null@*/ 00031 static const char *getfuncname (CallInfo *ci, const char **name) 00032 /*@modifies ci, *name @*/; 00033 00034 00035 #define isLua(ci) (!((ci)->state & CI_C)) 00036 00037 00038 static int currentpc (CallInfo *ci) 00039 /*@modifies ci @*/ 00040 { 00041 if (!isLua(ci)) return -1; /* function is not a Lua function? */ 00042 if (ci->state & CI_HASFRAME) /* function has a frame? */ 00043 ci->u.l.savedpc = *ci->u.l.pc; /* use `pc' from there */ 00044 /* function's pc is saved */ 00045 return pcRel(ci->u.l.savedpc, ci_func(ci)->l.p); 00046 } 00047 00048 00049 static int currentline (CallInfo *ci) 00050 /*@modifies ci @*/ 00051 { 00052 int pc = currentpc(ci); 00053 if (pc < 0) 00054 return -1; /* only active lua functions have current-line information */ 00055 else 00056 return getline(ci_func(ci)->l.p, pc); 00057 } 00058 00059 00060 void luaG_inithooks (lua_State *L) { 00061 CallInfo *ci; 00062 for (ci = L->ci; ci != L->base_ci; ci--) /* update all `savedpc's */ 00063 currentpc(ci); 00064 L->hookinit = 1; 00065 } 00066 00067 00068 /* 00069 ** this function can be called asynchronous (e.g. during a signal) 00070 */ 00071 LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) { 00072 if (func == NULL || mask == 0) { /* turn off hooks? */ 00073 mask = 0; 00074 func = NULL; 00075 } 00076 L->hook = func; 00077 L->basehookcount = count; 00078 resethookcount(L); 00079 L->hookmask = cast(lu_byte, mask); 00080 L->hookinit = 0; 00081 return 1; 00082 } 00083 00084 00085 LUA_API lua_Hook lua_gethook (lua_State *L) { 00086 return L->hook; 00087 } 00088 00089 00090 LUA_API int lua_gethookmask (lua_State *L) { 00091 return L->hookmask; 00092 } 00093 00094 00095 LUA_API int lua_gethookcount (lua_State *L) { 00096 return L->basehookcount; 00097 } 00098 00099 00100 LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) { 00101 int status; 00102 CallInfo *ci; 00103 lua_lock(L); 00104 for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) { 00105 level--; 00106 if (!(ci->state & CI_C)) /* Lua function? */ 00107 level -= ci->u.l.tailcalls; /* skip lost tail calls */ 00108 } 00109 if (level > 0 || ci == L->base_ci) status = 0; /* there is no such level */ 00110 else if (level < 0) { /* level is of a lost tail call */ 00111 status = 1; 00112 ar->i_ci = 0; 00113 } 00114 else { 00115 status = 1; 00116 ar->i_ci = ci - L->base_ci; 00117 } 00118 lua_unlock(L); 00119 return status; 00120 } 00121 00122 00123 /*@null@*/ 00124 static Proto *getluaproto (CallInfo *ci) 00125 /*@*/ 00126 { 00127 return (isLua(ci) ? ci_func(ci)->l.p : NULL); 00128 } 00129 00130 00131 LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) { 00132 const char *name; 00133 CallInfo *ci; 00134 Proto *fp; 00135 lua_lock(L); 00136 name = NULL; 00137 ci = L->base_ci + ar->i_ci; 00138 fp = getluaproto(ci); 00139 if (fp) { /* is a Lua function? */ 00140 name = luaF_getlocalname(fp, n, currentpc(ci)); 00141 if (name) 00142 luaA_pushobject(L, ci->base+(n-1)); /* push value */ 00143 } 00144 lua_unlock(L); 00145 return name; 00146 } 00147 00148 00149 LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) { 00150 const char *name; 00151 CallInfo *ci; 00152 Proto *fp; 00153 lua_lock(L); 00154 name = NULL; 00155 ci = L->base_ci + ar->i_ci; 00156 fp = getluaproto(ci); 00157 L->top--; /* pop new value */ 00158 if (fp) { /* is a Lua function? */ 00159 name = luaF_getlocalname(fp, n, currentpc(ci)); 00160 if (!name || name[0] == '(') /* `(' starts private locals */ 00161 name = NULL; 00162 else 00163 setobjs2s(ci->base+(n-1), L->top); 00164 } 00165 lua_unlock(L); 00166 return name; 00167 } 00168 00169 00170 static void funcinfo (lua_Debug *ar, StkId func) 00171 /*@modifies ar @*/ 00172 { 00173 Closure *cl = clvalue(func); 00174 if (cl->c.isC) { 00175 ar->source = "=[C]"; 00176 ar->linedefined = -1; 00177 ar->what = "C"; 00178 } 00179 else { 00180 ar->source = getstr(cl->l.p->source); 00181 ar->linedefined = cl->l.p->lineDefined; 00182 ar->what = (ar->linedefined == 0) ? "main" : "Lua"; 00183 } 00184 luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); 00185 } 00186 00187 00188 /*@null@*/ 00189 static const char *travglobals (lua_State *L, const TObject *o) 00190 /*@*/ 00191 { 00192 Table *g = hvalue(gt(L)); 00193 int i = sizenode(g); 00194 while (i--) { 00195 Node *n = gnode(g, i); 00196 if (luaO_rawequalObj(o, gval(n)) && ttisstring(gkey(n))) 00197 return getstr(tsvalue(gkey(n))); 00198 } 00199 return NULL; 00200 } 00201 00202 00203 static void info_tailcall (lua_State *L, lua_Debug *ar) 00204 /*@modifies L, ar @*/ 00205 { 00206 ar->name = ar->namewhat = ""; 00207 ar->what = "tail"; 00208 ar->linedefined = ar->currentline = -1; 00209 ar->source = "=(tail call)"; 00210 luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE); 00211 ar->nups = 0; 00212 setnilvalue(L->top); 00213 } 00214 00215 00216 static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar, 00217 StkId f, /*@null@*/ CallInfo *ci) 00218 /*@modifies L, ar, ci @*/ 00219 { 00220 int status = 1; 00221 for (; *what; what++) { 00222 switch (*what) { 00223 case 'S': { 00224 funcinfo(ar, f); 00225 break; 00226 } 00227 case 'l': { 00228 ar->currentline = (ci) ? currentline(ci) : -1; 00229 break; 00230 } 00231 case 'u': { 00232 ar->nups = clvalue(f)->c.nupvalues; 00233 break; 00234 } 00235 case 'n': { 00236 /*@-modobserver@*/ 00237 ar->namewhat = (ci) ? getfuncname(ci, &ar->name) : NULL; 00238 /*@=modobserver@*/ 00239 if (ar->namewhat == NULL) { 00240 /* try to find a global name */ 00241 if ((ar->name = travglobals(L, f)) != NULL) 00242 ar->namewhat = "global"; 00243 else ar->namewhat = ""; /* not found */ 00244 } 00245 break; 00246 } 00247 case 'f': { 00248 setobj2s(L->top, f); 00249 break; 00250 } 00251 default: status = 0; /* invalid option */ 00252 } 00253 } 00254 return status; 00255 } 00256 00257 00258 LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) { 00259 int status = 1; 00260 lua_lock(L); 00261 if (*what == '>') { 00262 StkId f = L->top - 1; 00263 if (!ttisfunction(f)) 00264 luaG_runerror(L, "value for `lua_getinfo' is not a function"); 00265 status = auxgetinfo(L, what + 1, ar, f, NULL); 00266 L->top--; /* pop function */ 00267 } 00268 else if (ar->i_ci != 0) { /* no tail call? */ 00269 CallInfo *ci = L->base_ci + ar->i_ci; 00270 lua_assert(ttisfunction(ci->base - 1)); 00271 status = auxgetinfo(L, what, ar, ci->base - 1, ci); 00272 } 00273 else 00274 info_tailcall(L, ar); 00275 if (strchr(what, 'f')) incr_top(L); 00276 lua_unlock(L); 00277 return status; 00278 } 00279 00280 00281 /* 00282 ** {====================================================== 00283 ** Symbolic Execution and code checker 00284 ** ======================================================= 00285 */ 00286 00287 #define check(x) if (!(x)) return 0; 00288 00289 #define checkjump(pt,pc) check(0 <= pc && pc < pt->sizecode) 00290 00291 #define checkreg(pt,reg) check((reg) < (pt)->maxstacksize) 00292 00293 00294 00295 static int precheck (const Proto *pt) 00296 /*@*/ 00297 { 00298 check(pt->maxstacksize <= MAXSTACK); 00299 check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0); 00300 lua_assert(pt->numparams+pt->is_vararg <= pt->maxstacksize); 00301 check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN); 00302 return 1; 00303 } 00304 00305 00306 static int checkopenop (const Proto *pt, int pc) 00307 /*@*/ 00308 { 00309 Instruction i = pt->code[pc+1]; 00310 switch (GET_OPCODE(i)) { 00311 case OP_CALL: 00312 case OP_TAILCALL: 00313 case OP_RETURN: { 00314 check(GETARG_B(i) == 0); 00315 return 1; 00316 } 00317 case OP_SETLISTO: return 1; 00318 default: return 0; /* invalid instruction after an open call */ 00319 } 00320 } 00321 00322 00323 static int checkRK (const Proto *pt, int r) 00324 /*@*/ 00325 { 00326 return (r < pt->maxstacksize || (r >= MAXSTACK && r-MAXSTACK < pt->sizek)); 00327 } 00328 00329 00330 static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) 00331 /*@*/ 00332 { 00333 int pc; 00334 int last; /* stores position of last instruction that changed `reg' */ 00335 last = pt->sizecode-1; /* points to final return (a `neutral' instruction) */ 00336 check(precheck(pt)); 00337 for (pc = 0; pc < lastpc; pc++) { 00338 const Instruction i = pt->code[pc]; 00339 OpCode op = GET_OPCODE(i); 00340 int a = GETARG_A(i); 00341 int b = 0; 00342 int c = 0; 00343 checkreg(pt, a); 00344 switch (getOpMode(op)) { 00345 case iABC: { 00346 b = GETARG_B(i); 00347 c = GETARG_C(i); 00348 if (testOpMode(op, OpModeBreg)) { 00349 checkreg(pt, b); 00350 } 00351 else if (testOpMode(op, OpModeBrk)) 00352 check(checkRK(pt, b)); 00353 if (testOpMode(op, OpModeCrk)) 00354 check(checkRK(pt, c)); 00355 break; 00356 } 00357 case iABx: { 00358 b = GETARG_Bx(i); 00359 if (testOpMode(op, OpModeK)) check(b < pt->sizek); 00360 break; 00361 } 00362 case iAsBx: { 00363 b = GETARG_sBx(i); 00364 break; 00365 } 00366 } 00367 if (testOpMode(op, OpModesetA)) { 00368 if (a == reg) last = pc; /* change register `a' */ 00369 } 00370 if (testOpMode(op, OpModeT)) { 00371 check(pc+2 < pt->sizecode); /* check skip */ 00372 check(GET_OPCODE(pt->code[pc+1]) == OP_JMP); 00373 } 00374 switch (op) { 00375 case OP_LOADBOOL: { 00376 check(c == 0 || pc+2 < pt->sizecode); /* check its jump */ 00377 break; 00378 } 00379 case OP_LOADNIL: { 00380 if (a <= reg && reg <= b) 00381 last = pc; /* set registers from `a' to `b' */ 00382 break; 00383 } 00384 case OP_GETUPVAL: 00385 case OP_SETUPVAL: { 00386 check(b < pt->nups); 00387 break; 00388 } 00389 case OP_GETGLOBAL: 00390 case OP_SETGLOBAL: { 00391 check(ttisstring(&pt->k[b])); 00392 break; 00393 } 00394 case OP_SELF: { 00395 checkreg(pt, a+1); 00396 if (reg == a+1) last = pc; 00397 break; 00398 } 00399 case OP_CONCAT: { 00400 /* `c' is a register, and at least two operands */ 00401 check(c < MAXSTACK && b < c); 00402 break; 00403 } 00404 case OP_TFORLOOP: 00405 checkreg(pt, a+c+5); 00406 if (reg >= a) last = pc; /* affect all registers above base */ 00407 /* go through */ 00408 case OP_FORLOOP: 00409 checkreg(pt, a+2); 00410 /* go through */ 00411 case OP_JMP: { 00412 int dest = pc+1+b; 00413 check(0 <= dest && dest < pt->sizecode); 00414 /* not full check and jump is forward and do not skip `lastpc'? */ 00415 if (reg != NO_REG && pc < dest && dest <= lastpc) 00416 pc += b; /* do the jump */ 00417 break; 00418 } 00419 case OP_CALL: 00420 case OP_TAILCALL: { 00421 if (b != 0) { 00422 checkreg(pt, a+b-1); 00423 } 00424 c--; /* c = num. returns */ 00425 if (c == LUA_MULTRET) { 00426 check(checkopenop(pt, pc)); 00427 } 00428 else if (c != 0) 00429 checkreg(pt, a+c-1); 00430 if (reg >= a) last = pc; /* affect all registers above base */ 00431 break; 00432 } 00433 case OP_RETURN: { 00434 b--; /* b = num. returns */ 00435 if (b > 0) checkreg(pt, a+b-1); 00436 break; 00437 } 00438 case OP_SETLIST: { 00439 checkreg(pt, a + (b&(LFIELDS_PER_FLUSH-1)) + 1); 00440 break; 00441 } 00442 case OP_CLOSURE: { 00443 int nup; 00444 check(b < pt->sizep); 00445 nup = pt->p[b]->nups; 00446 check(pc + nup < pt->sizecode); 00447 for (; nup>0; nup--) { 00448 OpCode op1 = GET_OPCODE(pt->code[pc+nup]); 00449 check(op1 == OP_GETUPVAL || op1 == OP_MOVE); 00450 } 00451 break; 00452 } 00453 default: break; 00454 } 00455 } 00456 return pt->code[last]; 00457 } 00458 00459 #undef check 00460 #undef checkjump 00461 #undef checkreg 00462 00463 /* }====================================================== */ 00464 00465 00466 int luaG_checkcode (const Proto *pt) { 00467 return luaG_symbexec(pt, pt->sizecode, NO_REG); 00468 } 00469 00470 00471 /*@observer@*/ 00472 static const char *kname (Proto *p, int c) 00473 /*@*/ 00474 { 00475 c = c - MAXSTACK; 00476 if (c >= 0 && ttisstring(&p->k[c])) 00477 return svalue(&p->k[c]); 00478 else 00479 return "?"; 00480 } 00481 00482 00483 /*@observer@*/ /*@null@*/ 00484 static const char *getobjname (CallInfo *ci, int stackpos, const char **name) 00485 /*@modifies ci, *name @*/ 00486 { 00487 if (isLua(ci)) { /* a Lua function? */ 00488 Proto *p = ci_func(ci)->l.p; 00489 int pc = currentpc(ci); 00490 Instruction i; 00491 /*@-observertrans -dependenttrans @*/ 00492 *name = luaF_getlocalname(p, stackpos+1, pc); 00493 /*@=observertrans =dependenttrans @*/ 00494 if (*name) /* is a local? */ 00495 return "local"; 00496 i = luaG_symbexec(p, pc, stackpos); /* try symbolic execution */ 00497 lua_assert(pc != -1); 00498 switch (GET_OPCODE(i)) { 00499 case OP_GETGLOBAL: { 00500 int g = GETARG_Bx(i); /* global index */ 00501 lua_assert(ttisstring(&p->k[g])); 00502 *name = svalue(&p->k[g]); 00503 return "global"; 00504 } 00505 case OP_MOVE: { 00506 int a = GETARG_A(i); 00507 int b = GETARG_B(i); /* move from `b' to `a' */ 00508 if (b < a) 00509 return getobjname(ci, b, name); /* get name for `b' */ 00510 break; 00511 } 00512 case OP_GETTABLE: { 00513 int k = GETARG_C(i); /* key index */ 00514 /*@-observertrans -dependenttrans @*/ 00515 *name = kname(p, k); 00516 /*@=observertrans =dependenttrans @*/ 00517 return "field"; 00518 } 00519 case OP_SELF: { 00520 int k = GETARG_C(i); /* key index */ 00521 /*@-observertrans -dependenttrans @*/ 00522 *name = kname(p, k); 00523 /*@=observertrans =dependenttrans @*/ 00524 return "method"; 00525 } 00526 default: break; 00527 } 00528 } 00529 return NULL; /* no useful name found */ 00530 } 00531 00532 00533 /*@observer@*/ /*@null@*/ 00534 static const char *getfuncname (CallInfo *ci, const char **name) 00535 /*@modifies ci, *name @*/ 00536 { 00537 Instruction i; 00538 if ((isLua(ci) && ci->u.l.tailcalls > 0) || !isLua(ci - 1)) 00539 return NULL; /* calling function is not Lua (or is unknown) */ 00540 ci--; /* calling function */ 00541 i = ci_func(ci)->l.p->code[currentpc(ci)]; 00542 if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL) 00543 return getobjname(ci, GETARG_A(i), name); 00544 else 00545 return NULL; /* no useful name can be found */ 00546 } 00547 00548 00549 /* only ANSI way to check whether a pointer points to an array */ 00550 static int isinstack (CallInfo *ci, const TObject *o) 00551 /*@*/ 00552 { 00553 StkId p; 00554 for (p = ci->base; p < ci->top; p++) 00555 if (o == p) return 1; 00556 return 0; 00557 } 00558 00559 00560 void luaG_typeerror (lua_State *L, const TObject *o, const char *op) 00561 /*@*/ 00562 { 00563 const char *name = NULL; 00564 const char *t = luaT_typenames[ttype(o)]; 00565 const char *kind = (isinstack(L->ci, o)) ? 00566 getobjname(L->ci, o - L->base, &name) : NULL; 00567 if (kind) 00568 luaG_runerror(L, "attempt to %s %s `%s' (a %s value)", 00569 op, kind, name, t); 00570 else 00571 luaG_runerror(L, "attempt to %s a %s value", op, t); 00572 } 00573 00574 00575 void luaG_concaterror (lua_State *L, StkId p1, StkId p2) { 00576 if (ttisstring(p1)) p1 = p2; 00577 lua_assert(!ttisstring(p1)); 00578 luaG_typeerror(L, p1, "concatenate"); 00579 } 00580 00581 00582 void luaG_aritherror (lua_State *L, const TObject *p1, const TObject *p2) { 00583 TObject temp; 00584 if (luaV_tonumber(p1, &temp) == NULL) 00585 p2 = p1; /* first operand is wrong */ 00586 luaG_typeerror(L, p2, "perform arithmetic on"); 00587 } 00588 00589 00590 int luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2) { 00591 const char *t1 = luaT_typenames[ttype(p1)]; 00592 const char *t2 = luaT_typenames[ttype(p2)]; 00593 if (t1[2] == t2[2]) 00594 luaG_runerror(L, "attempt to compare two %s values", t1); 00595 else 00596 luaG_runerror(L, "attempt to compare %s with %s", t1, t2); 00597 return 0; 00598 } 00599 00600 00601 static void addinfo (lua_State *L, const char *msg) 00602 /*@modifies L @*/ 00603 { 00604 CallInfo *ci = L->ci; 00605 if (isLua(ci)) { /* is Lua code? */ 00606 char buff[LUA_IDSIZE]; /* add file:line information */ 00607 int line = currentline(ci); 00608 luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE); 00609 luaO_pushfstring(L, "%s:%d: %s", buff, line, msg); 00610 } 00611 } 00612 00613 00614 void luaG_errormsg (lua_State *L) { 00615 if (L->errfunc != 0) { /* is there an error handling function? */ 00616 StkId errfunc = restorestack(L, L->errfunc); 00617 if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR); 00618 setobjs2s(L->top, L->top - 1); /* move argument */ 00619 setobjs2s(L->top - 1, errfunc); /* push function */ 00620 incr_top(L); 00621 luaD_call(L, L->top - 2, 1); /* call it */ 00622 } 00623 luaD_throw(L, LUA_ERRRUN); 00624 } 00625 00626 00627 void luaG_runerror (lua_State *L, const char *fmt, ...) { 00628 va_list argp; 00629 va_start(argp, fmt); 00630 addinfo(L, luaO_pushvfstring(L, fmt, argp)); 00631 va_end(argp); 00632 luaG_errormsg(L); 00633 } 00634