/*** $Id: ldebug.c,v 2.89 2012/01/20 22:05:50 roberto Exp $** Debug Interface** See Copyright Notice in lua.h*/  #include <stdarg.h>#include <stddef.h>#include <string.h>  #define ldebug_c#define LUA_CORE #include "lua.h" #include "lapi.h"#include "lcode.h"#include "ldebug.h"#include "ldo.h"#include "lfunc.h"#include "lobject.h"#include "lopcodes.h"#include "lstate.h"#include "lstring.h"#include "ltable.h"#include "ltm.h"#include "lvm.h"   #define noLuaClosure(f)		((f) == NULL || (f)->c.tt == LUA_TCCL)  static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);  static int currentpc (CallInfo *ci) {  lua_assert(isLua(ci));  return pcRel(ci->u.l.savedpc, ci_func(ci)->p);}  static int currentline (CallInfo *ci) {  return getfuncline(ci_func(ci)->p, currentpc(ci));}  /*** this function can be called asynchronous (e.g. during a signal)*/LUA_API int lua_sethook (lua_State *L, lua_Hook func, int mask, int count) {  if (func == NULL || mask == 0) {  /* turn off hooks? */    mask = 0;    func = NULL;  }  if (isLua(L->ci))    L->oldpc = L->ci->u.l.savedpc;  L->hook = func;  L->basehookcount = count;  resethookcount(L);  L->hookmask = cast_byte(mask);  return 1;}  LUA_API lua_Hook lua_gethook (lua_State *L) {  return L->hook;}  LUA_API int lua_gethookmask (lua_State *L) {  return L->hookmask;}  LUA_API int lua_gethookcount (lua_State *L) {  return L->basehookcount;}  LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {  int status;  CallInfo *ci;  if (level < 0) return 0;  /* invalid (negative) level */  lua_lock(L);  for (ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous)    level--;  if (level == 0 && ci != &L->base_ci) {  /* level found? */    status = 1;    ar->i_ci = ci;  }  else status = 0;  /* no such level */  lua_unlock(L);  return status;}  static const char *upvalname (Proto *p, int uv) {  TString *s = check_exp(uv < p->sizeupvalues, p->upvalues[uv].name);  if (s == NULL) return "?";  else return getstr(s);}  static const char *findvararg (CallInfo *ci, int n, StkId *pos) {  int nparams = clLvalue(ci->func)->p->numparams;  if (n >= ci->u.l.base - ci->func - nparams)    return NULL;  /* no such vararg */  else {    *pos = ci->func + nparams + n;    return "(*vararg)";  /* generic name for any vararg */  }}  static const char *findlocal (lua_State *L, CallInfo *ci, int n,                              StkId *pos) {  const char *name = NULL;  StkId base;  if (isLua(ci)) {    if (n < 0)  /* access to vararg values? */      return findvararg(ci, -n, pos);    else {      base = ci->u.l.base;      name = luaF_getlocalname(ci_func(ci)->p, n, currentpc(ci));    }  }  else    base = ci->func + 1;  if (name == NULL) {  /* no 'standard' name? */    StkId limit = (ci == L->ci) ? L->top : ci->next->func;    if (limit - base >= n && n > 0)  /* is 'n' inside 'ci' stack? */      name = "(*temporary)";  /* generic name for any valid slot */    else      return NULL;  /* no name */  }  *pos = base + (n - 1);  return name;}  LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {  const char *name;  lua_lock(L);  if (ar == NULL) {  /* information about non-active function? */    if (!isLfunction(L->top - 1))  /* not a Lua function? */      name = NULL;    else  /* consider live variables at function start (parameters) */      name = luaF_getlocalname(clLvalue(L->top - 1)->p, n, 0);  }  else {  /* active function; get information through 'ar' */    StkId pos = 0;  /* to avoid warnings */    name = findlocal(L, ar->i_ci, n, &pos);    if (name) {      setobj2s(L, L->top, pos);      api_incr_top(L);    }  }  lua_unlock(L);  return name;}  LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {  StkId pos = 0;  /* to avoid warnings */  const char *name = findlocal(L, ar->i_ci, n, &pos);  lua_lock(L);  if (name)    setobjs2s(L, pos, L->top - 1);  L->top--;  /* pop value */  lua_unlock(L);  return name;}  static void funcinfo (lua_Debug *ar, Closure *cl) {  if (noLuaClosure(cl)) {    ar->source = "=[C]";    ar->linedefined = -1;    ar->lastlinedefined = -1;    ar->what = "C";  }  else {    Proto *p = cl->l.p;    ar->source = p->source ? getstr(p->source) : "=?";    ar->linedefined = p->linedefined;    ar->lastlinedefined = p->lastlinedefined;    ar->what = (ar->linedefined == 0) ? "main" : "Lua";  }  luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);}  static void collectvalidlines (lua_State *L, Closure *f) {  if (noLuaClosure(f)) {    setnilvalue(L->top);    incr_top(L);  }  else {    int i;    TValue v;    int *lineinfo = f->l.p->lineinfo;    Table *t = luaH_new(L);  /* new table to store active lines */    sethvalue(L, L->top, t);  /* push it on stack */    incr_top(L);    setbvalue(&v, 1);  /* boolean 'true' to be the value of all indices */    for (i = 0; i < f->l.p->sizelineinfo; i++)  /* for all lines with code */      luaH_setint(L, t, lineinfo[i], &v);  /* table[line] = true */  }}  static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,                       Closure *f, CallInfo *ci) {  int status = 1;  for (; *what; what++) {    switch (*what) {      case 'S': {        funcinfo(ar, f);        break;      }      case 'l': {        ar->currentline = (ci && isLua(ci)) ? currentline(ci) : -1;        break;      }      case 'u': {        ar->nups = (f == NULL) ? 0 : f->c.nupvalues;        if (noLuaClosure(f)) {          ar->isvararg = 1;          ar->nparams = 0;        }        else {          ar->isvararg = f->l.p->is_vararg;          ar->nparams = f->l.p->numparams;        }        break;      }      case 't': {        ar->istailcall = (ci) ? ci->callstatus & CIST_TAIL : 0;        break;      }      case 'n': {        /* calling function is a known Lua function? */        if (ci && !(ci->callstatus & CIST_TAIL) && isLua(ci->previous))          ar->namewhat = getfuncname(L, ci->previous, &ar->name);        else          ar->namewhat = NULL;        if (ar->namewhat == NULL) {          ar->namewhat = "";  /* not found */          ar->name = NULL;        }        break;      }      case 'L':      case 'f':  /* handled by lua_getinfo */        break;      default: status = 0;  /* invalid option */    }  }  return status;}  LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {  int status;  Closure *cl;  CallInfo *ci;  StkId func;  lua_lock(L);  if (*what == '>') {    ci = NULL;    func = L->top - 1;    api_check(L, ttisfunction(func), "function expected");    what++;  /* skip the '>' */    L->top--;  /* pop function */  }  else {    ci = ar->i_ci;    func = ci->func;    lua_assert(ttisfunction(ci->func));  }  cl = ttisclosure(func) ? clvalue(func) : NULL;  status = auxgetinfo(L, what, ar, cl, ci);  if (strchr(what, 'f')) {    setobjs2s(L, L->top, func);    incr_top(L);  }  if (strchr(what, 'L'))    collectvalidlines(L, cl);  lua_unlock(L);  return status;}  /*** {======================================================** Symbolic Execution** =======================================================*/ static const char *getobjname (Proto *p, int lastpc, int reg,                               const char **name);  /*** find a "name" for the RK value 'c'*/static void kname (Proto *p, int pc, int c, const char **name) {  if (ISK(c)) {  /* is 'c' a constant? */    TValue *kvalue = &p->k[INDEXK(c)];    if (ttisstring(kvalue)) {  /* literal constant? */      *name = svalue(kvalue);  /* it is its own name */      return;    }    /* else no reasonable name found */  }  else {  /* 'c' is a register */    const char *what = getobjname(p, pc, c, name); /* search for 'c' */    if (what && *what == 'c') {  /* found a constant name? */      return;  /* 'name' already filled */    }    /* else no reasonable name found */  }  *name = "?";  /* no reasonable name found */}  /*** try to find last instruction before 'lastpc' that modified register 'reg'*/static int findsetreg (Proto *p, int lastpc, int reg) {  int pc;  int setreg = -1;  /* keep last instruction that changed 'reg' */  for (pc = 0; pc < lastpc; pc++) {    Instruction i = p->code[pc];    OpCode op = GET_OPCODE(i);    int a = GETARG_A(i);    switch (op) {      case OP_LOADNIL: {        int b = GETARG_B(i);        if (a <= reg && reg <= a + b)  /* set registers from 'a' to 'a+b' */          setreg = pc;        break;      }      case OP_TFORCALL: {        if (reg >= a + 2) setreg = pc;  /* affect all regs above its base */        break;      }      case OP_CALL:      case OP_TAILCALL: {        if (reg >= a) setreg = pc;  /* affect all registers above base */        break;      }      case OP_JMP: {        int b = GETARG_sBx(i);        int dest = pc + 1 + b;        /* jump is forward and do not skip `lastpc'? */        if (pc < dest && dest <= lastpc)          pc += b;  /* do the jump */        break;      }      case OP_TEST: {        if (reg == a) setreg = pc;  /* jumped code can change 'a' */        break;      }      default:        if (testAMode(op) && reg == a)  /* any instruction that set A */          setreg = pc;        break;    }  }  return setreg;}  static const char *getobjname (Proto *p, int lastpc, int reg,                               const char **name) {  int pc;  *name = luaF_getlocalname(p, reg + 1, lastpc);  if (*name)  /* is a local? */    return "local";  /* else try symbolic execution */  pc = findsetreg(p, lastpc, reg);  if (pc != -1) {  /* could find instruction? */    Instruction i = p->code[pc];    OpCode op = GET_OPCODE(i);    switch (op) {      case OP_MOVE: {        int b = GETARG_B(i);  /* move from 'b' to 'a' */        if (b < GETARG_A(i))          return getobjname(p, pc, b, name);  /* get name for 'b' */        break;      }      case OP_GETTABUP:      case OP_GETTABLE: {        int k = GETARG_C(i);  /* key index */        int t = GETARG_B(i);  /* table index */        const char *vn = (op == OP_GETTABLE)  /* name of indexed variable */                         ? luaF_getlocalname(p, t + 1, pc)                         : upvalname(p, t);        kname(p, pc, k, name);        return (vn && strcmp(vn, LUA_ENV) == 0) ? "global" : "field";      }      case OP_GETUPVAL: {        *name = upvalname(p, GETARG_B(i));        return "upvalue";      }      case OP_LOADK:      case OP_LOADKX: {        int b = (op == OP_LOADK) ? GETARG_Bx(i)                                 : GETARG_Ax(p->code[pc + 1]);        if (ttisstring(&p->k[b])) {          *name = svalue(&p->k[b]);          return "constant";        }        break;      }      case OP_SELF: {        int k = GETARG_C(i);  /* key index */        kname(p, pc, k, name);        return "method";      }      default: break;  /* go through to return NULL */    }  }  return NULL;  /* could not find reasonable name */}  static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {  TMS tm;  Proto *p = ci_func(ci)->p;  /* calling function */  int pc = currentpc(ci);  /* calling instruction index */  Instruction i = p->code[pc];  /* calling instruction */  switch (GET_OPCODE(i)) {    case OP_CALL:    case OP_TAILCALL:  /* get function name */      return getobjname(p, pc, GETARG_A(i), name);    case OP_TFORCALL: {  /* for iterator */      *name = "for iterator";       return "for iterator";    }    /* all other instructions can call only through metamethods */    case OP_SELF:    case OP_GETTABUP:    case OP_GETTABLE: tm = TM_INDEX; break;    case OP_SETTABUP:    case OP_SETTABLE: tm = TM_NEWINDEX; break;    case OP_EQ: tm = TM_EQ; break;    case OP_ADD: tm = TM_ADD; break;    case OP_SUB: tm = TM_SUB; break;    case OP_MUL: tm = TM_MUL; break;    case OP_DIV: tm = TM_DIV; break;    case OP_MOD: tm = TM_MOD; break;    case OP_POW: tm = TM_POW; break;    case OP_UNM: tm = TM_UNM; break;    case OP_LEN: tm = TM_LEN; break;    case OP_LT: tm = TM_LT; break;    case OP_LE: tm = TM_LE; break;    case OP_CONCAT: tm = TM_CONCAT; break;    default:      return NULL;  /* else no useful name can be found */  }  *name = getstr(G(L)->tmname[tm]);  return "metamethod";} /* }====================================================== */   /*** only ANSI way to check whether a pointer points to an array** (used only for error messages, so efficiency is not a big concern)*/static int isinstack (CallInfo *ci, const TValue *o) {  StkId p;  for (p = ci->u.l.base; p < ci->top; p++)    if (o == p) return 1;  return 0;}  static const char *getupvalname (CallInfo *ci, const TValue *o,                                 const char **name) {  LClosure *c = ci_func(ci);  int i;  for (i = 0; i < c->nupvalues; i++) {    if (c->upvals[i]->v == o) {      *name = upvalname(c->p, i);      return "upvalue";    }  }  return NULL;}  l_noret luaG_typeerror (lua_State *L, const TValue *o, const char *op) {

Lines 1–500 of 580. Load more