?login_element?

Subversion Repositories NedoOS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. /*
  2. ** $Id: ldebug.c $
  3. ** Debug Interface
  4. ** See Copyright Notice in lua.h
  5. */
  6.  
  7. #define ldebug_c
  8. #define LUA_CORE
  9.  
  10. #include "lprefix.h"
  11.  
  12.  
  13. #include <stdarg.h>
  14. #include <stddef.h>
  15. #include <string.h>
  16.  
  17. #include "lua.h"
  18.  
  19. #include "lapi.h"
  20. #include "lcode.h"
  21. #include "ldebug.h"
  22. #include "ldo.h"
  23. #include "lfunc.h"
  24. #include "lobject.h"
  25. #include "lopcodes.h"
  26. #include "lstate.h"
  27. #include "lstring.h"
  28. #include "ltable.h"
  29. #include "ltm.h"
  30. #include "lvm.h"
  31.  
  32.  
  33.  
  34. #define noLuaClosure(f)         ((f) == NULL || (f)->c.tt == LUA_VCCL)
  35.  
  36.  
  37. static const char *funcnamefromcall (lua_State *L, CallInfo *ci,
  38.                                                    const char **name);
  39.  
  40.  
  41. static int currentpc (CallInfo *ci) {
  42.   lua_assert(isLua(ci));
  43.   return pcRel(ci->u.l.savedpc, ci_func(ci)->p);
  44. }
  45.  
  46.  
  47. /*
  48. ** Get a "base line" to find the line corresponding to an instruction.
  49. ** Base lines are regularly placed at MAXIWTHABS intervals, so usually
  50. ** an integer division gets the right place. When the source file has
  51. ** large sequences of empty/comment lines, it may need extra entries,
  52. ** so the original estimate needs a correction.
  53. ** If the original estimate is -1, the initial 'if' ensures that the
  54. ** 'while' will run at least once.
  55. ** The assertion that the estimate is a lower bound for the correct base
  56. ** is valid as long as the debug info has been generated with the same
  57. ** value for MAXIWTHABS or smaller. (Previous releases use a little
  58. ** smaller value.)
  59. */
  60. static int getbaseline (const Proto *f, int pc, int *basepc) {
  61.   if (f->sizeabslineinfo == 0 || pc < f->abslineinfo[0].pc) {
  62.     *basepc = -1;  /* start from the beginning */
  63.     return f->linedefined;
  64.   }
  65.   else {
  66.     int i = cast_uint(pc) / MAXIWTHABS - 1;  /* get an estimate */
  67.     /* estimate must be a lower bound of the correct base */
  68.     lua_assert(i < 0 ||
  69.               (i < f->sizeabslineinfo && f->abslineinfo[i].pc <= pc));
  70.     while (i + 1 < f->sizeabslineinfo && pc >= f->abslineinfo[i + 1].pc)
  71.       i++;  /* low estimate; adjust it */
  72.     *basepc = f->abslineinfo[i].pc;
  73.     return f->abslineinfo[i].line;
  74.   }
  75. }
  76.  
  77.  
  78. /*
  79. ** Get the line corresponding to instruction 'pc' in function 'f';
  80. ** first gets a base line and from there does the increments until
  81. ** the desired instruction.
  82. */
  83. int luaG_getfuncline (const Proto *f, int pc) {
  84.   if (f->lineinfo == NULL)  /* no debug information? */
  85.     return -1;
  86.   else {
  87.     int basepc;
  88.     int baseline = getbaseline(f, pc, &basepc);
  89.     while (basepc++ < pc) {  /* walk until given instruction */
  90.       lua_assert(f->lineinfo[basepc] != ABSLINEINFO);
  91.       baseline += f->lineinfo[basepc];  /* correct line */
  92.     }
  93.     return baseline;
  94.   }
  95. }
  96.  
  97.  
  98. static int getcurrentline (CallInfo *ci) {
  99.   return luaG_getfuncline(ci_func(ci)->p, currentpc(ci));
  100. }
  101.  
  102.  
  103. /*
  104. ** Set 'trap' for all active Lua frames.
  105. ** This function can be called during a signal, under "reasonable"
  106. ** assumptions. A new 'ci' is completely linked in the list before it
  107. ** becomes part of the "active" list, and we assume that pointers are
  108. ** atomic; see comment in next function.
  109. ** (A compiler doing interprocedural optimizations could, theoretically,
  110. ** reorder memory writes in such a way that the list could be
  111. ** temporarily broken while inserting a new element. We simply assume it
  112. ** has no good reasons to do that.)
  113. */
  114. static void settraps (CallInfo *ci) {
  115.   for (; ci != NULL; ci = ci->previous)
  116.     if (isLua(ci))
  117.       ci->u.l.trap = 1;
  118. }
  119.  
  120.  
  121. /*
  122. ** This function can be called during a signal, under "reasonable"
  123. ** assumptions.
  124. ** Fields 'basehookcount' and 'hookcount' (set by 'resethookcount')
  125. ** are for debug only, and it is no problem if they get arbitrary
  126. ** values (causes at most one wrong hook call). 'hookmask' is an atomic
  127. ** value. We assume that pointers are atomic too (e.g., gcc ensures that
  128. ** for all platforms where it runs). Moreover, 'hook' is always checked
  129. ** before being called (see 'luaD_hook').
  130. */
  131. LUA_API void lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {
  132.   if (func == NULL || mask == 0) {  /* turn off hooks? */
  133.     mask = 0;
  134.     func = NULL;
  135.   }
  136.   L->hook = func;
  137.   L->basehookcount = count;
  138.   resethookcount(L);
  139.   L->hookmask = cast_byte(mask);
  140.   if (mask)
  141.     settraps(L->ci);  /* to trace inside 'luaV_execute' */
  142. }
  143.  
  144.  
  145. LUA_API lua_Hook lua_gethook (lua_State *L) {
  146.   return L->hook;
  147. }
  148.  
  149.  
  150. LUA_API int lua_gethookmask (lua_State *L) {
  151.   return L->hookmask;
  152. }
  153.  
  154.  
  155. LUA_API int lua_gethookcount (lua_State *L) {
  156.   return L->basehookcount;
  157. }
  158.  
  159.  
  160. LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
  161.   int status;
  162.   CallInfo *ci;
  163.   if (level < 0) return 0;  /* invalid (negative) level */
  164.   lua_lock(L);
  165.   for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)
  166.     level--;
  167.   if (level == 0 && ci != &L->base_ci) {  /* level found? */
  168.     status = 1;
  169.     ar->i_ci = ci;
  170.   }
  171.   else status = 0;  /* no such level */
  172.   lua_unlock(L);
  173.   return status;
  174. }
  175.  
  176.  
  177. static const char *upvalname (const Proto *p, int uv) {
  178.   TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);
  179.   if (s == NULL) return "?";
  180.   else return getstr(s);
  181. }
  182.  
  183.  
  184. static const char *findvararg (CallInfo *ci, int n, StkId *pos) {
  185.   if (clLvalue(s2v(ci->func))->p->is_vararg) {
  186.     int nextra = ci->u.l.nextraargs;
  187.     if (n >= -nextra) {  /* 'n' is negative */
  188.       *pos = ci->func - nextra - (n + 1);
  189.       return "(vararg)";  /* generic name for any vararg */
  190.     }
  191.   }
  192.   return NULL;  /* no such vararg */
  193. }
  194.  
  195.  
  196. const char *luaG_findlocal (lua_State *L, CallInfo *ci, int n, StkId *pos) {
  197.   StkId base = ci->func + 1;
  198.   const char *name = NULL;
  199.   if (isLua(ci)) {
  200.     if (n < 0)  /* access to vararg values? */
  201.       return findvararg(ci, n, pos);
  202.     else
  203.       name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));
  204.   }
  205.   if (name == NULL) {  /* no 'standard' name? */
  206.     StkId limit = (ci == L->ci) ? L->top : ci->next->func;
  207.     if (limit - base >= n && n > 0) {  /* is 'n' inside 'ci' stack? */
  208.       /* generic name for any valid slot */
  209.       name = isLua(ci) ? "(temporary)" : "(C temporary)";
  210.     }
  211.     else
  212.       return NULL;  /* no name */
  213.   }
  214.   if (pos)
  215.     *pos = base + (n - 1);
  216.   return name;
  217. }
  218.  
  219.  
  220. LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
  221.   const char *name;
  222.   lua_lock(L);
  223.   if (ar == NULL) {  /* information about non-active function? */
  224.     if (!isLfunction(s2v(L->top - 1)))  /* not a Lua function? */
  225.       name = NULL;
  226.     else  /* consider live variables at function start (parameters) */
  227.       name = luaF_getlocalname(clLvalue(s2v(L->top - 1))->p, n, 0);
  228.   }
  229.   else {  /* active function; get information through 'ar' */
  230.     StkId pos = NULL;  /* to avoid warnings */
  231.     name = luaG_findlocal(L, ar->i_ci, n, &pos);
  232.     if (name) {
  233.       setobjs2s(L, L->top, pos);
  234.       api_incr_top(L);
  235.     }
  236.   }
  237.   lua_unlock(L);
  238.   return name;
  239. }
  240.  
  241.  
  242. LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
  243.   StkId pos = NULL;  /* to avoid warnings */
  244.   const char *name;
  245.   lua_lock(L);
  246.   name = luaG_findlocal(L, ar->i_ci, n, &pos);
  247.   if (name) {
  248.     setobjs2s(L, pos, L->top - 1);
  249.     L->top--;  /* pop value */
  250.   }
  251.   lua_unlock(L);
  252.   return name;
  253. }
  254.  
  255.  
  256. static void funcinfo (lua_Debug *ar, Closure *cl) {
  257.   if (noLuaClosure(cl)) {
  258.     ar->source = "=[C]";
  259.     ar->srclen = LL("=[C]");
  260.     ar->linedefined = -1;
  261.     ar->lastlinedefined = -1;
  262.     ar->what = "C";
  263.   }
  264.   else {
  265.     const Proto *p = cl->l.p;
  266.     if (p->source) {
  267.       ar->source = getstr(p->source);
  268.       ar->srclen = tsslen(p->source);
  269.     }
  270.     else {
  271.       ar->source = "=?";
  272.       ar->srclen = LL("=?");
  273.     }
  274.     ar->linedefined = p->linedefined;
  275.     ar->lastlinedefined = p->lastlinedefined;
  276.     ar->what = (ar->linedefined == 0) ? "main" : "Lua";
  277.   }
  278.   luaO_chunkid(ar->short_src, ar->source, ar->srclen);
  279. }
  280.  
  281.  
  282. static int nextline (const Proto *p, int currentline, int pc) {
  283.   if (p->lineinfo[pc] != ABSLINEINFO)
  284.     return currentline + p->lineinfo[pc];
  285.   else
  286.     return luaG_getfuncline(p, pc);
  287. }
  288.  
  289.  
  290. static void collectvalidlines (lua_State *L, Closure *f) {
  291.   if (noLuaClosure(f)) {
  292.     setnilvalue(s2v(L->top));
  293.     api_incr_top(L);
  294.   }
  295.   else {
  296.     int i;
  297.     TValue v;
  298.     const Proto *p = f->l.p;
  299.     int currentline = p->linedefined;
  300.     Table *t = luaH_new(L);  /* new table to store active lines */
  301.     sethvalue2s(L, L->top, t);  /* push it on stack */
  302.     api_incr_top(L);
  303.     setbtvalue(&v);  /* boolean 'true' to be the value of all indices */
  304.     if (!p->is_vararg)  /* regular function? */
  305.       i = 0;  /* consider all instructions */
  306.     else {  /* vararg function */
  307.       lua_assert(GET_OPCODE(p->code[0]) == OP_VARARGPREP);
  308.       currentline = nextline(p, currentline, 0);
  309.       i = 1;  /* skip first instruction (OP_VARARGPREP) */
  310.     }
  311.     for (; i < p->sizelineinfo; i++) {  /* for each instruction */
  312.       currentline = nextline(p, currentline, i);  /* get its line */
  313.       luaH_setint(L, t, currentline, &v);  /* table[line] = true */
  314.     }
  315.   }
  316. }
  317.  
  318.  
  319. static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
  320.   /* calling function is a known function? */
  321.   if (ci != NULL && !(ci->callstatus & CIST_TAIL))
  322.     return funcnamefromcall(L, ci->previous, name);
  323.   else return NULL;  /* no way to find a name */
  324. }
  325.  
  326.  
  327. static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
  328.                        Closure *f, CallInfo *ci) {
  329.   int status = 1;
  330.   for (; *what; what++) {
  331.     switch (*what) {
  332.       case 'S': {
  333.         funcinfo(ar, f);
  334.         break;
  335.       }
  336.       case 'l': {
  337.         ar->currentline = (ci && isLua(ci)) ? getcurrentline(ci) : -1;
  338.         break;
  339.       }
  340.       case 'u': {
  341.         ar->nups = (f == NULL) ? 0 : f->c.nupvalues;
  342.         if (noLuaClosure(f)) {
  343.           ar->isvararg = 1;
  344.           ar->nparams = 0;
  345.         }
  346.         else {
  347.           ar->isvararg = f->l.p->is_vararg;
  348.           ar->nparams = f->l.p->numparams;
  349.         }
  350.         break;
  351.       }
  352.       case 't': {
  353.         ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;
  354.         break;
  355.       }
  356.       case 'n': {
  357.         ar->namewhat = getfuncname(L, ci, &ar->name);
  358.         if (ar->namewhat == NULL) {
  359.           ar->namewhat = "";  /* not found */
  360.           ar->name = NULL;
  361.         }
  362.         break;
  363.       }
  364.       case 'r': {
  365.         if (ci == NULL || !(ci->callstatus & CIST_TRAN))
  366.           ar->ftransfer = ar->ntransfer = 0;
  367.         else {
  368.           ar->ftransfer = ci->u2.transferinfo.ftransfer;
  369.           ar->ntransfer = ci->u2.transferinfo.ntransfer;
  370.         }
  371.         break;
  372.       }
  373.       case 'L':
  374.       case 'f':  /* handled by lua_getinfo */
  375.         break;
  376.       default: status = 0;  /* invalid option */
  377.     }
  378.   }
  379.   return status;
  380. }
  381.  
  382.  
  383. LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
  384.   int status;
  385.   Closure *cl;
  386.   CallInfo *ci;
  387.   TValue *func;
  388.   lua_lock(L);
  389.   if (*what == '>') {
  390.     ci = NULL;
  391.     func = s2v(L->top - 1);
  392.     api_check(L, ttisfunction(func), "function expected");
  393.     what++;  /* skip the '>' */
  394.     L->top--;  /* pop function */
  395.   }
  396.   else {
  397.     ci = ar->i_ci;
  398.     func = s2v(ci->func);
  399.     lua_assert(ttisfunction(func));
  400.   }
  401.   cl = ttisclosure(func) ? clvalue(func) : NULL;
  402.   status = auxgetinfo(L, what, ar, cl, ci);
  403.   if (strchr(what, 'f')) {
  404.     setobj2s(L, L->top, func);
  405.     api_incr_top(L);
  406.   }
  407.   if (strchr(what, 'L'))
  408.     collectvalidlines(L, cl);
  409.   lua_unlock(L);
  410.   return status;
  411. }
  412.  
  413.  
  414. /*
  415. ** {======================================================
  416. ** Symbolic Execution
  417. ** =======================================================
  418. */
  419.  
  420. static const char *getobjname (const Proto *p, int lastpc, int reg,
  421.                                const char **name);
  422.  
  423.  
  424. /*
  425. ** Find a "name" for the constant 'c'.
  426. */
  427. static void kname (const Proto *p, int c, const char **name) {
  428.   TValue *kvalue = &p->k[c];
  429.   *name = (ttisstring(kvalue)) ? svalue(kvalue) : "?";
  430. }
  431.  
  432.  
  433. /*
  434. ** Find a "name" for the register 'c'.
  435. */
  436. static void rname (const Proto *p, int pc, int c, const char **name) {
  437.   const char *what = getobjname(p, pc, c, name); /* search for 'c' */
  438.   if (!(what && *what == 'c'))  /* did not find a constant name? */
  439.     *name = "?";
  440. }
  441.  
  442.  
  443. /*
  444. ** Find a "name" for a 'C' value in an RK instruction.
  445. */
  446. static void rkname (const Proto *p, int pc, Instruction i, const char **name) {
  447.   int c = GETARG_C(i);  /* key index */
  448.   if (GETARG_k(i))  /* is 'c' a constant? */
  449.     kname(p, c, name);
  450.   else  /* 'c' is a register */
  451.     rname(p, pc, c, name);
  452. }
  453.  
  454.  
  455. static int filterpc (int pc, int jmptarget) {
  456.   if (pc < jmptarget)  /* is code conditional (inside a jump)? */
  457.     return -1;  /* cannot know who sets that register */
  458.   else return pc;  /* current position sets that register */
  459. }
  460.  
  461.  
  462. /*
  463. ** Try to find last instruction before 'lastpc' that modified register 'reg'.
  464. */
  465. static int findsetreg (const Proto *p, int lastpc, int reg) {
  466.   int pc;
  467.   int setreg = -1;  /* keep last instruction that changed 'reg' */
  468.   int jmptarget = 0;  /* any code before this address is conditional */
  469.   if (testMMMode(GET_OPCODE(p->code[lastpc])))
  470.     lastpc--;  /* previous instruction was not actually executed */
  471.   for (pc = 0; pc < lastpc; pc++) {
  472.     Instruction i = p->code[pc];
  473.     OpCode op = GET_OPCODE(i);
  474.     int a = GETARG_A(i);
  475.     int change;  /* true if current instruction changed 'reg' */
  476.     switch (op) {
  477.       case OP_LOADNIL: {  /* set registers from 'a' to 'a+b' */
  478.         int b = GETARG_B(i);
  479.         change = (a <= reg && reg <= a + b);
  480.         break;
  481.       }
  482.       case OP_TFORCALL: {  /* affect all regs above its base */
  483.         change = (reg >= a + 2);
  484.         break;
  485.       }
  486.       case OP_CALL:
  487.       case OP_TAILCALL: {  /* affect all registers above base */
  488.         change = (reg >= a);
  489.         break;
  490.       }
  491.       case OP_JMP: {  /* doesn't change registers, but changes 'jmptarget' */
  492.         int b = GETARG_sJ(i);
  493.         int dest = pc + 1 + b;
  494.         /* jump does not skip 'lastpc' and is larger than current one? */
  495.         if (dest <= lastpc && dest > jmptarget)
  496.           jmptarget = dest;  /* update 'jmptarget' */
  497.         change = 0;
  498.         break;
  499.       }
  500.       default:  /* any instruction that sets A */
  501.         change = (testAMode(op) && reg == a);
  502.         break;
  503.     }
  504.     if (change)
  505.       setreg = filterpc(pc, jmptarget);
  506.   }
  507.   return setreg;
  508. }
  509.  
  510.  
  511. /*
  512. ** Check whether table being indexed by instruction 'i' is the
  513. ** environment '_ENV'
  514. */
  515. static const char *gxf (const Proto *p, int pc, Instruction i, int isup) {
  516.   int t = GETARG_B(i);  /* table index */
  517.   const char *name;  /* name of indexed variable */
  518.   if (isup)  /* is an upvalue? */
  519.     name = upvalname(p, t);
  520.   else
  521.     getobjname(p, pc, t, &name);
  522.   return (name && strcmp(name, LUA_ENV) == 0) ? "global" : "field";
  523. }
  524.  
  525.  
  526. static const char *getobjname (const Proto *p, int lastpc, int reg,
  527.                                const char **name) {
  528.   int pc;
  529.   *name = luaF_getlocalname(p, reg + 1, lastpc);
  530.   if (*name)  /* is a local? */
  531.     return "local";
  532.   /* else try symbolic execution */
  533.   pc = findsetreg(p, lastpc, reg);
  534.   if (pc != -1) {  /* could find instruction? */
  535.     Instruction i = p->code[pc];
  536.     OpCode op = GET_OPCODE(i);
  537.     switch (op) {
  538.       case OP_MOVE: {
  539.         int b = GETARG_B(i);  /* move from 'b' to 'a' */
  540.         if (b < GETARG_A(i))
  541.           return getobjname(p, pc, b, name);  /* get name for 'b' */
  542.         break;
  543.       }
  544.       case OP_GETTABUP: {
  545.         int k = GETARG_C(i);  /* key index */
  546.         kname(p, k, name);
  547.         return gxf(p, pc, i, 1);
  548.       }
  549.       case OP_GETTABLE: {
  550.         int k = GETARG_C(i);  /* key index */
  551.         rname(p, pc, k, name);
  552.         return gxf(p, pc, i, 0);
  553.       }
  554.       case OP_GETI: {
  555.         *name = "integer index";
  556.         return "field";
  557.       }
  558.       case OP_GETFIELD: {
  559.         int k = GETARG_C(i);  /* key index */
  560.         kname(p, k, name);
  561.         return gxf(p, pc, i, 0);
  562.       }
  563.       case OP_GETUPVAL: {
  564.         *name = upvalname(p, GETARG_B(i));
  565.         return "upvalue";
  566.       }
  567.       case OP_LOADK:
  568.       case OP_LOADKX: {
  569.         int b = (op == OP_LOADK) ? GETARG_Bx(i)
  570.                                  : GETARG_Ax(p->code[pc + 1]);
  571.         if (ttisstring(&p->k[b])) {
  572.           *name = svalue(&p->k[b]);
  573.           return "constant";
  574.         }
  575.         break;
  576.       }
  577.       case OP_SELF: {
  578.         rkname(p, pc, i, name);
  579.         return "method";
  580.       }
  581.       default: break;  /* go through to return NULL */
  582.     }
  583.   }
  584.   return NULL;  /* could not find reasonable name */
  585. }
  586.  
  587.  
  588. /*
  589. ** Try to find a name for a function based on the code that called it.
  590. ** (Only works when function was called by a Lua function.)
  591. ** Returns what the name is (e.g., "for iterator", "method",
  592. ** "metamethod") and sets '*name' to point to the name.
  593. */
  594. static const char *funcnamefromcode (lua_State *L, const Proto *p,
  595.                                      int pc, const char **name) {
  596.   TMS tm = (TMS)0;  /* (initial value avoids warnings) */
  597.   Instruction i = p->code[pc];  /* calling instruction */
  598.   switch (GET_OPCODE(i)) {
  599.     case OP_CALL:
  600.     case OP_TAILCALL:
  601.       return getobjname(p, pc, GETARG_A(i), name);  /* get function name */
  602.     case OP_TFORCALL: {  /* for iterator */
  603.       *name = "for iterator";
  604.        return "for iterator";
  605.     }
  606.     /* other instructions can do calls through metamethods */
  607.     case OP_SELF: case OP_GETTABUP: case OP_GETTABLE:
  608.     case OP_GETI: case OP_GETFIELD:
  609.       tm = TM_INDEX;
  610.       break;
  611.     case OP_SETTABUP: case OP_SETTABLE: case OP_SETI: case OP_SETFIELD:
  612.       tm = TM_NEWINDEX;
  613.       break;
  614.     case OP_MMBIN: case OP_MMBINI: case OP_MMBINK: {
  615.       tm = cast(TMS, GETARG_C(i));
  616.       break;
  617.     }
  618.     case OP_UNM: tm = TM_UNM; break;
  619.     case OP_BNOT: tm = TM_BNOT; break;
  620.     case OP_LEN: tm = TM_LEN; break;
  621.     case OP_CONCAT: tm = TM_CONCAT; break;
  622.     case OP_EQ: tm = TM_EQ; break;
  623.     /* no cases for OP_EQI and OP_EQK, as they don't call metamethods */
  624.     case OP_LT: case OP_LTI: case OP_GTI: tm = TM_LT; break;
  625.     case OP_LE: case OP_LEI: case OP_GEI: tm = TM_LE; break;
  626.     case OP_CLOSE: case OP_RETURN: tm = TM_CLOSE; break;
  627.     default:
  628.       return NULL;  /* cannot find a reasonable name */
  629.   }
  630.   *name = getstr(G(L)->tmname[tm]) + 2;
  631.   return "metamethod";
  632. }
  633.  
  634.  
  635. /*
  636. ** Try to find a name for a function based on how it was called.
  637. */
  638. static const char *funcnamefromcall (lua_State *L, CallInfo *ci,
  639.                                                    const char **name) {
  640.   if (ci->callstatus & CIST_HOOKED) {  /* was it called inside a hook? */
  641.     *name = "?";
  642.     return "hook";
  643.   }
  644.   else if (ci->callstatus & CIST_FIN) {  /* was it called as a finalizer? */
  645.     *name = "__gc";
  646.     return "metamethod";  /* report it as such */
  647.   }
  648.   else if (isLua(ci))
  649.     return funcnamefromcode(L, ci_func(ci)->p, currentpc(ci), name);
  650.   else
  651.     return NULL;
  652. }
  653.  
  654. /* }====================================================== */
  655.  
  656.  
  657.  
  658. /*
  659. ** Check whether pointer 'o' points to some value in the stack
  660. ** frame of the current function. Because 'o' may not point to a
  661. ** value in this stack, we cannot compare it with the region
  662. ** boundaries (undefined behaviour in ISO C).
  663. */
  664. static int isinstack (CallInfo *ci, const TValue *o) {
  665.   StkId pos;
  666.   for (pos = ci->func + 1; pos < ci->top; pos++) {
  667.     if (o == s2v(pos))
  668.       return 1;
  669.   }
  670.   return 0;  /* not found */
  671. }
  672.  
  673.  
  674. /*
  675. ** Checks whether value 'o' came from an upvalue. (That can only happen
  676. ** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on
  677. ** upvalues.)
  678. */
  679. static const char *getupvalname (CallInfo *ci, const TValue *o,
  680.                                  const char **name) {
  681.   LClosure *c = ci_func(ci);
  682.   int i;
  683.   for (i = 0; i < c->nupvalues; i++) {
  684.     if (c->upvals[i]->v == o) {
  685.       *name = upvalname(c->p, i);
  686.       return "upvalue";
  687.     }
  688.   }
  689.   return NULL;
  690. }
  691.  
  692.  
  693. static const char *formatvarinfo (lua_State *L, const char *kind,
  694.                                                 const char *name) {
  695.   if (kind == NULL)
  696.     return "";  /* no information */
  697.   else
  698.     return luaO_pushfstring(L, " (%s '%s')", kind, name);
  699. }
  700.  
  701. /*
  702. ** Build a string with a "description" for the value 'o', such as
  703. ** "variable 'x'" or "upvalue 'y'".
  704. */
  705. static const char *varinfo (lua_State *L, const TValue *o) {
  706.   CallInfo *ci = L->ci;
  707.   const char *name = NULL;  /* to avoid warnings */
  708.   const char *kind = NULL;
  709.   if (isLua(ci)) {
  710.     kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
  711.     if (!kind && isinstack(ci, o))  /* no? try a register */
  712.       kind = getobjname(ci_func(ci)->p, currentpc(ci),
  713.                         cast_int(cast(StkId, o) - (ci->func + 1)), &name);
  714.   }
  715.   return formatvarinfo(L, kind, name);
  716. }
  717.  
  718.  
  719. /*
  720. ** Raise a type error
  721. */
  722. static l_noret typeerror (lua_State *L, const TValue *o, const char *op,
  723.                           const char *extra) {
  724.   const char *t = luaT_objtypename(L, o);
  725.   luaG_runerror(L, "attempt to %s a %s value%s", op, t, extra);
  726. }
  727.  
  728.  
  729. /*
  730. ** Raise a type error with "standard" information about the faulty
  731. ** object 'o' (using 'varinfo').
  732. */
  733. l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
  734.   typeerror(L, o, op, varinfo(L, o));
  735. }
  736.  
  737.  
  738. /*
  739. ** Raise an error for calling a non-callable object. Try to find a name
  740. ** for the object based on how it was called ('funcnamefromcall'); if it
  741. ** cannot get a name there, try 'varinfo'.
  742. */
  743. l_noret luaG_callerror (lua_State *L, const TValue *o) {
  744.   CallInfo *ci = L->ci;
  745.   const char *name = NULL;  /* to avoid warnings */
  746.   const char *kind = funcnamefromcall(L, ci, &name);
  747.   const char *extra = kind ? formatvarinfo(L, kind, name) : varinfo(L, o);
  748.   typeerror(L, o, "call", extra);
  749. }
  750.  
  751.  
  752. l_noret luaG_forerror (lua_State *L, const TValue *o, const char *what) {
  753.   luaG_runerror(L, "bad 'for' %s (number expected, got %s)",
  754.                    what, luaT_objtypename(L, o));
  755. }
  756.  
  757.  
  758. l_noret luaG_concaterror (lua_State *L, const TValue *p1, const TValue *p2) {
  759.   if (ttisstring(p1) || cvt2str(p1)) p1 = p2;
  760.   luaG_typeerror(L, p1, "concatenate");
  761. }
  762.  
  763.  
  764. l_noret luaG_opinterror (lua_State *L, const TValue *p1,
  765.                          const TValue *p2, const char *msg) {
  766.   if (!ttisnumber(p1))  /* first operand is wrong? */
  767.     p2 = p1;  /* now second is wrong */
  768.   luaG_typeerror(L, p2, msg);
  769. }
  770.  
  771.  
  772. /*
  773. ** Error when both values are convertible to numbers, but not to integers
  774. */
  775. l_noret luaG_tointerror (lua_State *L, const TValue *p1, const TValue *p2) {
  776.   lua_Integer temp;
  777.   if (!luaV_tointegerns(p1, &temp, LUA_FLOORN2I))
  778.     p2 = p1;
  779.   luaG_runerror(L, "number%s has no integer representation", varinfo(L, p2));
  780. }
  781.  
  782.  
  783. l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
  784.   const char *t1 = luaT_objtypename(L, p1);
  785.   const char *t2 = luaT_objtypename(L, p2);
  786.   if (strcmp(t1, t2) == 0)
  787.     luaG_runerror(L, "attempt to compare two %s values", t1);
  788.   else
  789.     luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
  790. }
  791.  
  792.  
  793. /* add src:line information to 'msg' */
  794. const char *luaG_addinfo (lua_State *L, const char *msg, TString *src,
  795.                                         int line) {
  796.   char buff[LUA_IDSIZE];
  797.   if (src)
  798.     luaO_chunkid(buff, getstr(src), tsslen(src));
  799.   else {  /* no source available; use "?" instead */
  800.     buff[0] = '?'; buff[1] = '\0';
  801.   }
  802.   return luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
  803. }
  804.  
  805.  
  806. l_noret luaG_errormsg (lua_State *L) {
  807.   if (L->errfunc != 0) {  /* is there an error handling function? */
  808.     StkId errfunc = restorestack(L, L->errfunc);
  809.     lua_assert(ttisfunction(s2v(errfunc)));
  810.     setobjs2s(L, L->top, L->top - 1);  /* move argument */
  811.     setobjs2s(L, L->top - 1, errfunc);  /* push function */
  812.     L->top++;  /* assume EXTRA_STACK */
  813.     luaD_callnoyield(L, L->top - 2, 1);  /* call it */
  814.   }
  815.   luaD_throw(L, LUA_ERRRUN);
  816. }
  817.  
  818.  
  819. l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
  820.   CallInfo *ci = L->ci;
  821.   const char *msg;
  822.   va_list argp;
  823.   luaC_checkGC(L);  /* error message uses memory */
  824.   va_start(argp, fmt);
  825.   msg = luaO_pushvfstring(L, fmt, argp);  /* format message */
  826.   va_end(argp);
  827.   if (isLua(ci))  /* if Lua function, add source:line information */
  828.     luaG_addinfo(L, msg, ci_func(ci)->p->source, getcurrentline(ci));
  829.   luaG_errormsg(L);
  830. }
  831.  
  832.  
  833. /*
  834. ** Check whether new instruction 'newpc' is in a different line from
  835. ** previous instruction 'oldpc'. More often than not, 'newpc' is only
  836. ** one or a few instructions after 'oldpc' (it must be after, see
  837. ** caller), so try to avoid calling 'luaG_getfuncline'. If they are
  838. ** too far apart, there is a good chance of a ABSLINEINFO in the way,
  839. ** so it goes directly to 'luaG_getfuncline'.
  840. */
  841. static int changedline (const Proto *p, int oldpc, int newpc) {
  842.   if (p->lineinfo == NULL)  /* no debug information? */
  843.     return 0;
  844.   if (newpc - oldpc < MAXIWTHABS / 2) {  /* not too far apart? */
  845.     int delta = 0;  /* line diference */
  846.     int pc = oldpc;
  847.     for (;;) {
  848.       int lineinfo = p->lineinfo[++pc];
  849.       if (lineinfo == ABSLINEINFO)
  850.         break;  /* cannot compute delta; fall through */
  851.       delta += lineinfo;
  852.       if (pc == newpc)
  853.         return (delta != 0);  /* delta computed successfully */
  854.     }
  855.   }
  856.   /* either instructions are too far apart or there is an absolute line
  857.      info in the way; compute line difference explicitly */
  858.   return (luaG_getfuncline(p, oldpc) != luaG_getfuncline(p, newpc));
  859. }
  860.  
  861.  
  862. /*
  863. ** Traces the execution of a Lua function. Called before the execution
  864. ** of each opcode, when debug is on. 'L->oldpc' stores the last
  865. ** instruction traced, to detect line changes. When entering a new
  866. ** function, 'npci' will be zero and will test as a new line whatever
  867. ** the value of 'oldpc'.  Some exceptional conditions may return to
  868. ** a function without setting 'oldpc'. In that case, 'oldpc' may be
  869. ** invalid; if so, use zero as a valid value. (A wrong but valid 'oldpc'
  870. ** at most causes an extra call to a line hook.)
  871. ** This function is not "Protected" when called, so it should correct
  872. ** 'L->top' before calling anything that can run the GC.
  873. */
  874. int luaG_traceexec (lua_State *L, const Instruction *pc) {
  875.   CallInfo *ci = L->ci;
  876.   lu_byte mask = L->hookmask;
  877.   const Proto *p = ci_func(ci)->p;
  878.   int counthook;
  879.   if (!(mask & (LUA_MASKLINE | LUA_MASKCOUNT))) {  /* no hooks? */
  880.     ci->u.l.trap = 0;  /* don't need to stop again */
  881.     return 0;  /* turn off 'trap' */
  882.   }
  883.   pc++;  /* reference is always next instruction */
  884.   ci->u.l.savedpc = pc;  /* save 'pc' */
  885.   counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
  886.   if (counthook)
  887.     resethookcount(L);  /* reset count */
  888.   else if (!(mask & LUA_MASKLINE))
  889.     return 1;  /* no line hook and count != 0; nothing to be done now */
  890.   if (ci->callstatus & CIST_HOOKYIELD) {  /* called hook last time? */
  891.     ci->callstatus &= ~CIST_HOOKYIELD;  /* erase mark */
  892.     return 1;  /* do not call hook again (VM yielded, so it did not move) */
  893.   }
  894.   if (!isIT(*(ci->u.l.savedpc - 1)))  /* top not being used? */
  895.     L->top = ci->top;  /* correct top */
  896.   if (counthook)
  897.     luaD_hook(L, LUA_HOOKCOUNT, -1, 0, 0);  /* call count hook */
  898.   if (mask & LUA_MASKLINE) {
  899.     /* 'L->oldpc' may be invalid; use zero in this case */
  900.     int oldpc = (L->oldpc < p->sizecode) ? L->oldpc : 0;
  901.     int npci = pcRel(pc, p);
  902.     if (npci <= oldpc ||  /* call hook when jump back (loop), */
  903.         changedline(p, oldpc, npci)) {  /* or when enter new line */
  904.       int newline = luaG_getfuncline(p, npci);
  905.       luaD_hook(L, LUA_HOOKLINE, newline, 0, 0);  /* call line hook */
  906.     }
  907.     L->oldpc = npci;  /* 'pc' of last call to line hook */
  908.   }
  909.   if (L->status == LUA_YIELD) {  /* did hook yield? */
  910.     if (counthook)
  911.       L->hookcount = 1;  /* undo decrement to zero */
  912.     ci->u.l.savedpc--;  /* undo increment (resume will increment it again) */
  913.     ci->callstatus |= CIST_HOOKYIELD;  /* mark that it yielded */
  914.     luaD_throw(L, LUA_YIELD);
  915.   }
  916.   return 1;  /* keep 'trap' on */
  917. }
  918.  
  919.