lua/ldebug.c

/*
** $Id: ldebug.c,v 1.64 2001/02/16 17:58:27 roberto Exp roberto $
** Debug Interface
** See Copyright Notice in lua.h
*/


#include <stdlib.h>

#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 "luadebug.h"



static const char *getfuncname (lua_State *L, StkId f, const char **name);


static void setnormalized (TObject *d, const TObject *s) {
  if (ttype(s) == LUA_TMARK) {
    setclvalue(d, infovalue(s)->func);
  }
  else setobj(d, s);
}


static int isLmark (StkId o) {
  return (o && ttype(o) == LUA_TMARK && !infovalue(o)->func->isC);
}


LUA_API lua_Hook lua_setcallhook (lua_State *L, lua_Hook func) {
  lua_Hook oldhook;
  LUA_LOCK(L);
  oldhook = L->callhook;
  L->callhook = func;
  LUA_UNLOCK(L);
  return oldhook;
}


LUA_API lua_Hook lua_setlinehook (lua_State *L, lua_Hook func) {
  lua_Hook oldhook;
  LUA_LOCK(L);
  oldhook = L->linehook;
  L->linehook = func;
  LUA_UNLOCK(L);
  return oldhook;
}


static StkId aux_stackedfunction (lua_State *L, int level, StkId top) {
  int i;
  for (i = (top-1) - L->stack; i>=0; i--) {
    if (is_T_MARK(&L->stack[i])) {
      if (level == 0)
        return L->stack+i;
      level--;
    }
  }
  return NULL;
}


LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
  StkId f;
  int status;
  LUA_LOCK(L);
  f = aux_stackedfunction(L, level, L->top);
  if (f == NULL) status = 0;  /* there is no such level */
  else {
    ar->_func = f;
    status = 1;
  }
  LUA_UNLOCK(L);
  return status;
}


static int nups (StkId f) {
  switch (ttype(f)) {
    case LUA_TFUNCTION:
      return clvalue(f)->nupvalues;
    case LUA_TMARK:
      return infovalue(f)->func->nupvalues;
    default:
      return 0;
  }
}


int luaG_getline (int *lineinfo, int pc, int refline, int *prefi) {
  int refi;
  if (lineinfo == NULL || pc == -1)
    return -1;  /* no line info or function is not active */
  refi = prefi ? *prefi : 0;
  if (lineinfo[refi] < 0)
    refline += -lineinfo[refi++];
  lua_assert(lineinfo[refi] >= 0);
  while (lineinfo[refi] > pc) {
    refline--;
    refi--;
    if (lineinfo[refi] < 0)
      refline -= -lineinfo[refi--];
    lua_assert(lineinfo[refi] >= 0);
  }
  for (;;) {
    int nextline = refline + 1;
    int nextref = refi + 1;
    if (lineinfo[nextref] < 0)
      nextline += -lineinfo[nextref++];
    lua_assert(lineinfo[nextref] >= 0);
    if (lineinfo[nextref] > pc)
      break;
    refline = nextline;
    refi = nextref;
  }
  if (prefi) *prefi = refi;
  return refline;
}


static int currentpc (StkId f) {
  CallInfo *ci = infovalue(f);
  lua_assert(isLmark(f));
  if (ci->pc)
    return (*ci->pc - ci->func->f.l->code) - 1;
  else
    return -1;  /* function is not active */
}


static int currentline (StkId f) {
  if (!isLmark(f))
    return -1;  /* only active lua functions have current-line information */
  else {
    CallInfo *ci = infovalue(f);
    int *lineinfo = ci->func->f.l->lineinfo;
    return luaG_getline(lineinfo, currentpc(f), 1, NULL);
  }
}



static Proto *getluaproto (StkId f) {
  return (isLmark(f) ?  infovalue(f)->func->f.l : NULL);
}


LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
  const char *name;
  StkId f;
  Proto *fp;
  LUA_LOCK(L);
  name = NULL;
  f = ar->_func;
  fp = getluaproto(f);
  if (fp) {  /* `f' is a Lua function? */
    name = luaF_getlocalname(fp, n, currentpc(f));
    if (name)
      luaA_pushobject(L, (f+1)+(n-1));  /* push value */
  }
  LUA_UNLOCK(L);
  return name;
}


LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
  const char *name;
  StkId f;
  Proto *fp;
  LUA_LOCK(L);
  name = NULL;
  f = ar->_func;
  fp = getluaproto(f);
  L->top--;  /* pop new value */
  if (fp) {  /* `f' is a Lua function? */
    name = luaF_getlocalname(fp, n, currentpc(f));
    if (!name || name[0] == '(')  /* `(' starts private locals */
      name = NULL;
    else
      setobj((f+1)+(n-1), L->top);
  }
  LUA_UNLOCK(L);
  return name;
}


static void infoLproto (lua_Debug *ar, Proto *f) {
  ar->source = getstr(f->source);
  ar->linedefined = f->lineDefined;
  ar->what = "Lua";
}


static void funcinfo (lua_State *L, lua_Debug *ar, StkId func) {
  Closure *cl = NULL;
  switch (ttype(func)) {
    case LUA_TFUNCTION:
      cl = clvalue(func);
      break;
    case LUA_TMARK:
      cl = infovalue(func)->func;
      break;
    default:
      luaD_error(L, "value for `lua_getinfo' is not a function");
  }
  if (cl->isC) {
    ar->source = "=C";
    ar->linedefined = -1;
    ar->what = "C";
  }
  else
    infoLproto(ar, cl->f.l);
  luaO_chunkid(ar->short_src, ar->source, sizeof(ar->short_src));
  if (ar->linedefined == 0)
    ar->what = "main";
}


static const char *travtagmethods (global_State *G, const TObject *o) {
  if (ttype(o) == LUA_TFUNCTION) {
    int e;
    for (e=0; e<TM_N; e++) {
      int t;
      for (t=0; t<G->ntag; t++)
        if (clvalue(o) == luaT_gettm(G, t, e))
          return luaT_eventname[e];
    }
  }
  return NULL;
}


static const char *travglobals (lua_State *L, const TObject *o) {
  Hash *g = L->gt;
  int i;
  for (i=0; i<g->size; i++) {
    if (luaO_equalObj(o, val(node(g, i))) &&
        ttype_key(node(g, i)) == LUA_TSTRING)
      return getstr(tsvalue_key(node(g, i)));
  }
  return NULL;
}


static void getname (lua_State *L, StkId f, lua_Debug *ar) {
  TObject o;
  setnormalized(&o, f);
  /* try to find a name for given function */
  if ((ar->name = travglobals(L, &o)) != NULL)
    ar->namewhat = "global";
  /* not found: try tag methods */
  else if ((ar->name = travtagmethods(G(L), &o)) != NULL)
    ar->namewhat = "tag-method";
  else ar->namewhat = "";  /* not found at all */
}


LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
  StkId func;
  int isactive;
  int status = 1;
  LUA_LOCK(L);
  isactive = (*what != '>');
  if (isactive)
    func = ar->_func;
  else {
    what++;  /* skip the '>' */
    func = L->top - 1;
  }
  for (; *what; what++) {
    switch (*what) {
      case 'S': {
        funcinfo(L, ar, func);
        break;
      }
      case 'l': {
        ar->currentline = currentline(func);
        break;
      }
      case 'u': {
        ar->nups = nups(func);
        break;
      }
      case 'n': {
        ar->namewhat = (isactive) ? getfuncname(L, func, &ar->name) : NULL;
        if (ar->namewhat == NULL)
          getname(L, func, ar);
        break;
      }
      case 'f': {
        setnormalized(L->top, func);
        incr_top;  /* push function */
        break;
      }
      default: status = 0;  /* invalid option */
    }
  }
  if (!isactive) L->top--;  /* pop function */
  LUA_UNLOCK(L);
  return status;
}


/*
** {======================================================
** Symbolic Execution and code checker
** =======================================================
*/

#define check(x)		if (!(x)) return 0;


static int checklineinfo (const Proto *pt) {
  int *lineinfo = pt->lineinfo;
  if (lineinfo == NULL) return 1;
  check(pt->sizelineinfo >= 2 && lineinfo[pt->sizelineinfo-1] == MAX_INT);
  if (*lineinfo < 0) lineinfo++;
  check(*lineinfo == 0);
  return 1;
}


static int precheck (const Proto *pt) {
  check(checklineinfo(pt));
  check(pt->maxstacksize <= MAXSTACK);
  check(pt->numparams+pt->is_vararg <= pt->maxstacksize);
  check(GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN);
  return 1;
}


/* value for non-initialized entries in array stacklevel */
#define SL_EMPTY	255

#define checkjump(pt,sl,top,pc)	if (!checkjump_aux(pt,sl,top,pc)) return 0;

static int checkjump_aux (const Proto *pt, lu_byte *sl, int top, int pc) {
  check(0 <= pc && pc < pt->sizecode);
  if (sl == NULL) return 1;  /* not full checking */
  if (sl[pc] == SL_EMPTY)
    sl[pc] = top;
  else
    check(sl[pc] == top);
  return 1;
}


static Instruction luaG_symbexec (lua_State *L, const Proto *pt,
                                  int lastpc, int stackpos) {
  int stack[MAXSTACK];  /* stores last instruction that changed a stack entry */
  lu_byte *sl = NULL;
  int top;
  int pc;
  if (stackpos < 0) {  /* full check? */
    int i;
    sl = (lu_byte *)luaO_openspace(L, pt->sizecode);
    for (i=0; i<pt->sizecode; i++)  /* initialize stack-level array */
      sl[i] = SL_EMPTY;
    check(precheck(pt));
  }
  top = pt->numparams;
  pc = 0;
  if (pt->is_vararg)  /* varargs? */
    top++;  /* `arg' */
  if (sl) sl[0] = top;
  while (pc < lastpc) {
    const Instruction i = pt->code[pc++];
    OpCode op = GET_OPCODE(i);
    int arg1 = 0;
    int arg2 = 0;
    int push, pop;
    check(op < NUM_OPCODES);
    push = (int)luaK_opproperties[op].push;
    pop = (int)luaK_opproperties[op].pop;
    switch ((enum Mode)luaK_opproperties[op].mode) {
      case iO: break;
      case iU: arg1 = GETARG_U(i); check(arg1 >= 0); break;
      case iS: arg1 = GETARG_S(i); break;
      case iAB:
        arg1 = GETARG_A(i); arg2 = GETARG_B(i); check(arg1 >= 0); break;
    }
    switch (op) {
      case OP_RETURN: {
        check(arg1 <= top);
        pop = top-arg1;
        break;
      }
      case OP_CALL: {
        if (arg2 == MULT_RET) arg2 = 1;
        check(arg1 < top);
        pop = top-arg1;
        push = arg2;
        break;
      }
      case OP_TAILCALL: {
        check(arg1 < top && arg2 <= top);
        pop = top-arg2;
        break;
      }
      case OP_PUSHNIL: {
        check(arg1 > 0);
        push = arg1;
        break;
      }
      case OP_POP: {
        pop = arg1;
        break;
      }
      case OP_PUSHSTRING:
      case OP_GETGLOBAL:
      case OP_GETDOTTED:
      case OP_PUSHSELF:
      case OP_SETGLOBAL: {
        check(arg1 < pt->sizekstr);
        break;
      }
      case OP_PUSHNUM:
      case OP_PUSHNEGNUM: {
        check(arg1 < pt->sizeknum);
        break;
      }
      case OP_PUSHUPVALUE: {
        /* ?? */
        break;
      }
      case OP_GETLOCAL:
      case OP_GETINDEXED:
      case OP_SETLOCAL: {
        check(arg1 < top);
        break;
      }
      case OP_SETTABLE: {
        check(3 <= arg1 && arg1 <= top);
        pop = arg2;
        break;
      }
      case OP_SETLIST: {
        pop = arg2;
        check(top-pop >= 1);  /* there must be a table below the list */
        break;
      }
      case OP_SETMAP: {
        pop = 2*arg1;
        check(top-pop >= 1);
        break;
      }
      case OP_CONCAT: {
        pop = arg1;
        break;
      }
      case OP_CLOSURE: {
        /* ?? */
        pop = arg2;
        break;
      }
      case OP_JMPNE:
      case OP_JMPEQ:
      case OP_JMPLT:
      case OP_JMPLE:
      case OP_JMPGT:
      case OP_JMPGE:
      case OP_JMPT:
      case OP_JMPF:
      case OP_JMP: {
        checkjump(pt, sl, top-pop, pc+arg1);
        break;
      }
      case OP_FORLOOP:
      case OP_LFORLOOP:
      case OP_JMPONT:
      case OP_JMPONF: {
        int newpc = pc+arg1;
        checkjump(pt, sl, top, newpc);
        /* jump is forward and do not skip `lastpc' and not full check? */
        if (pc < newpc && newpc <= lastpc && stackpos >= 0) {
          stack[top-1] = pc-1;  /* value comes from `and'/`or' */
          pc = newpc;  /* do the jump */
          pop = 0;  /* do not pop */
        }
        break;
      }
      case OP_PUSHNILJMP: {
        check(GET_OPCODE(pt->code[pc]) == OP_PUSHINT); /* only valid sequence */
        break;
      }
      case OP_FORPREP: {
        int endfor = pc-arg1-1;  /* jump is `negative' here */
        check(top >= 3);
        checkjump(pt, sl, top+push, endfor);
        check(GET_OPCODE(pt->code[endfor]) == OP_FORLOOP);
        check(GETARG_S(pt->code[endfor]) == arg1);
        break;
      }
      case OP_LFORPREP: {
        int endfor = pc-arg1-1;  /* jump is `negative' here */
        check(top >= 1);
        checkjump(pt, sl, top+push, endfor);
        check(GET_OPCODE(pt->code[endfor]) == OP_LFORLOOP);
        check(GETARG_S(pt->code[endfor]) == arg1);
        break;
      }
      case OP_PUSHINT:
      case OP_GETTABLE:
      case OP_CREATETABLE:
      case OP_ADD:
      case OP_ADDI:
      case OP_SUB:
      case OP_MULT:
      case OP_DIV:
      case OP_POW:
      case OP_MINUS:
      case OP_NOT: {
        break;
      }
    }
    top -= pop;
    check(0 <= top && top+push <= pt->maxstacksize);
    while (push--) stack[top++] = pc-1;
    checkjump(pt, sl, top, pc);
  }
  return (stackpos >= 0) ? pt->code[stack[stackpos]] : 1;
}

/* }====================================================== */


int luaG_checkcode (lua_State *L, const Proto *pt) {
  return luaG_symbexec(L, pt, pt->sizecode-1, -1);
}


static const char *getobjname (lua_State *L, StkId obj, const char **name) {
  StkId func = aux_stackedfunction(L, 0, obj);
  if (!isLmark(func))
    return NULL;  /* not an active Lua function */
  else {
    Proto *p = infovalue(func)->func->f.l;
    int pc = currentpc(func);
    int stackpos = obj - (func+1);  /* func+1 == function base */
    Instruction i = luaG_symbexec(L, p, pc, stackpos);
    lua_assert(pc != -1);
    switch (GET_OPCODE(i)) {
      case OP_GETGLOBAL: {
        *name = getstr(p->kstr[GETARG_U(i)]);
        return "global";
      }
      case OP_GETLOCAL: {
        *name = luaF_getlocalname(p, GETARG_U(i)+1, pc);
        lua_assert(*name);
        return "local";
      }
      case OP_PUSHSELF:
      case OP_GETDOTTED: {
        *name = getstr(p->kstr[GETARG_U(i)]);
        return "field";
      }
      default:
        return NULL;  /* no useful name found */
    }
  }
}


static const char *getfuncname (lua_State *L, StkId f, const char **name) {
  StkId func = aux_stackedfunction(L, 0, f);  /* calling function */
  if (!isLmark(func))
    return NULL;  /* not an active Lua function */
  else {
    Proto *p = infovalue(func)->func->f.l;
    int pc = currentpc(func);
    Instruction i;
    if (pc == -1) return NULL;  /* function is not activated */
    i = p->code[pc];
    switch (GET_OPCODE(i)) {
      case OP_CALL: case OP_TAILCALL:
        return getobjname(L, (func+1)+GETARG_A(i), name);
      default:
        return NULL;  /* no useful name found */
    }
  }
}


void luaG_typeerror (lua_State *L, StkId o, const char *op) {
  const char *name;
  const char *kind = getobjname(L, o, &name);
  const char *t = luaT_typename(G(L), o);
  if (kind)
    luaO_verror(L, "attempt to %.30s %.20s `%.40s' (a %.10s value)",
                op, kind, name, t);
  else
    luaO_verror(L, "attempt to %.30s a %.10s value", op, t);
}


void luaG_binerror (lua_State *L, StkId p1, int t, const char *op) {
  if (ttype(p1) == t) p1++;
  lua_assert(ttype(p1) != t);
  luaG_typeerror(L, p1, op);
}


void luaG_ordererror (lua_State *L, const TObject *p1, const TObject *p2) {
  const char *t1 = luaT_typename(G(L), p1);
  const char *t2 = luaT_typename(G(L), p2);
  if (t1[2] == t2[2])
    luaO_verror(L, "attempt to compare two %.10s values", t1);
  else
    luaO_verror(L, "attempt to compare %.10s with %.10s", t1, t2);
}