[proxmark3-svn] / liblua / ldebug.c

/*
** $Id: ldebug.c,v 2.90 2012/08/16 17:34:28 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);
    api_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 */
    api_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);
    api_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) {
  CallInfo *ci = L->ci;
  const char *name = NULL;
  const char *t = objtypename(o);
  const char *kind = NULL;
  if (isLua(ci)) {
    kind = getupvalname(ci, o, &name);  /* check whether 'o' is an upvalue */
    if (!kind && isinstack(ci, o))  /* no? try a register */
      kind = getobjname(ci_func(ci)->p, currentpc(ci),
                        cast_int(o - ci->u.l.base), &name);
  }
  if (kind)
    luaG_runerror(L, "attempt to %s %s " LUA_QS " (a %s value)",
                op, kind, name, t);
  else
    luaG_runerror(L, "attempt to %s a %s value", op, t);
}


l_noret luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
  if (ttisstring(p1) || ttisnumber(p1)) p1 = p2;
  lua_assert(!ttisstring(p1) && !ttisnumber(p2));
  luaG_typeerror(L, p1, "concatenate");
}


l_noret luaG_aritherror (lua_State *L, const TValue *p1, const TValue *p2) {
  TValue temp;
  if (luaV_tonumber(p1, &temp) == NULL)
    p2 = p1;  /* first operand is wrong */
  luaG_typeerror(L, p2, "perform arithmetic on");
}


l_noret luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
  const char *t1 = objtypename(p1);
  const char *t2 = objtypename(p2);
  if (t1 == t2)
    luaG_runerror(L, "attempt to compare two %s values", t1);
  else
    luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
}


static void addinfo (lua_State *L, const char *msg) {
  CallInfo *ci = L->ci;
  if (isLua(ci)) {  /* is Lua code? */
    char buff[LUA_IDSIZE];  /* add file:line information */
    int line = currentline(ci);
    TString *src = ci_func(ci)->p->source;
    if (src)
      luaO_chunkid(buff, getstr(src), LUA_IDSIZE);
    else {  /* no source available; use "?" instead */
      buff[0] = '?'; buff[1] = '\0';
    }
    luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
  }
}


l_noret luaG_errormsg (lua_State *L) {
  if (L->errfunc != 0) {  /* is there an error handling function? */
    StkId errfunc = restorestack(L, L->errfunc);
    if (!ttisfunction(errfunc)) luaD_throw(L, LUA_ERRERR);
    setobjs2s(L, L->top, L->top - 1);  /* move argument */
    setobjs2s(L, L->top - 1, errfunc);  /* push function */
    L->top++;
    luaD_call(L, L->top - 2, 1, 0);  /* call it */
  }
  luaD_throw(L, LUA_ERRRUN);
}


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