text: /*
  ** $Id: ldebug.c,v 2.29.1.6 2008/05/08 16:56:26 roberto Exp $
  ** Debug Interface
  ** See Copyright Notice in lua.h
  */
  
  
  #define ldebug_c
  #define LUA_CORE
  
  #include "lua.h"
  #include <string.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"
  
  
  
  static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name);
  
  
  static int currentpc (lua_State *L, CallInfo *ci) {
    if (!isLua(ci)) return -1;  /* function is not a Lua function? */
    if (ci == L->ci)
      ci->savedpc = L->savedpc;
    return pcRel(ci->savedpc, ci_func(ci)->l.p);
  }
  
  
  static int currentline (lua_State *L, CallInfo *ci) {
    int pc = currentpc(L, ci);
    if (pc < 0)
      return -1;  /* only active lua functions have current-line information */
    else
      return getline(ci_func(ci)->l.p, pc);
  }
  
  
  /*
  ** 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;
    }
    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;
    lua_lock(L);
    for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) {
      level--;
      if (f_isLua(ci))  /* Lua function? */
        level -= ci->tailcalls;  /* skip lost tail calls */
    }
    if (level == 0 && ci > L->base_ci) {  /* level found? */
      status = 1;
      ar->i_ci = cast_int(ci - L->base_ci);
    }
    else if (level < 0) {  /* level is of a lost tail call? */
      status = 1;
      ar->i_ci = 0;
    }
    else status = 0;  /* no such level */
    lua_unlock(L);
    return status;
  }
  
  
  static Proto *getluaproto (CallInfo *ci) {
    return (isLua(ci) ? ci_func(ci)->l.p : NULL);
  }
  
  
  static const char *findlocal (lua_State *L, CallInfo *ci, int n) {
    const char *name;
    Proto *fp = getluaproto(ci);
    if (fp && (name = luaF_getlocalname(fp, n, currentpc(L, ci))) != NULL)
      return name;  /* is a local variable in a Lua function */
    else {
      StkId limit = (ci == L->ci) ? L->top : (ci+1)->func;
      if (limit - ci->base >= n && n > 0)  /* is 'n' inside 'ci' stack? */
        return "(*temporary)";
      else
        return NULL;
    }
  }
  
  
  LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
    CallInfo *ci = L->base_ci + ar->i_ci;
    const char *name = findlocal(L, ci, n);
    lua_lock(L);
    if (name)
        luaA_pushobject(L, ci->base + (n - 1));
    lua_unlock(L);
    return name;
  }
  
  
  LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
    CallInfo *ci = L->base_ci + ar->i_ci;
    const char *name = findlocal(L, ci, n);
    lua_lock(L);
    if (name)
        setobjs2s(L, ci->base + (n - 1), L->top - 1);
    L->top--;  /* pop value */
    lua_unlock(L);
    return name;
  }
  
  
  static void funcinfo (lua_Debug *ar, Closure *cl, void *plight) {
    if (plight || cl->c.isC) {
      ar->source = "=[C]";
      ar->linedefined = -1;
      ar->lastlinedefined = -1;
      ar->what = "C";
    }
    else {
      ar->source = getstr(cl->l.p->source);
      ar->linedefined = cl->l.p->linedefined;
      ar->lastlinedefined = cl->l.p->lastlinedefined;
      ar->what = (ar->linedefined == 0) ? "main" : "Lua";
    }
    luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
  }
  
  
  static void info_tailcall (lua_Debug *ar) {
    ar->name = ar->namewhat = "";
    ar->what = "tail";
    ar->lastlinedefined = ar->linedefined = ar->currentline = -1;
    ar->source = "=(tail call)";
    luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
    ar->nups = 0;
  }
  
  
   static void collectvalidlines (lua_State *L, Closure *f) {
     if (f == NULL || f->c.isC) {
       setnilvalue(L->top);
     }
     else {
    #  define INFO_FILL_BYTE   0x7F
  #  define INFO_DELTA_MASK  0x80
  #  define INFO_SIGN_MASK   0x40
  #  define INFO_DELTA_6BITS 0x3F
  #  define INFO_DELTA_7BITS 0x7F
  #  define INFO_MAX_LINECNT  126
  
       Table *t = luaH_new(L, 0, 0);
  #ifdef LUA_OPTIMIZE_DEBUG
      int line = 0;
      unsigned char *p = f->l.p->packedlineinfo;
      if (p) {
        for (; *p && *p != INFO_FILL_BYTE; ) {
          if (*p & INFO_DELTA_MASK) { /* line delta */
            int delta = *p & INFO_DELTA_6BITS;
            unsigned char sign = *p++ & INFO_SIGN_MASK;
            int shift;
            for (shift = 6; *p & INFO_DELTA_MASK; p++, shift += 7) {
              delta += (*p & INFO_DELTA_7BITS)<<shift;
            }
            line += sign ? -delta : delta+2;
          } else {
            line++;
          }
         p++;
         setbvalue(luaH_setnum(L, t, line), 1);
        }
      }
  #else
       int *lineinfo = f->l.p->lineinfo;
       int i;
       for (i=0; i<f->l.p->sizelineinfo; i++)
         setbvalue(luaH_setnum(L, t, lineinfo[i]), 1);
  #endif
       sethvalue(L, L->top, t);
     }
     incr_top(L);
   }
  
  #ifdef LUA_OPTIMIZE_DEBUG
  /*
   * This may seem expensive but this is only accessed frequently in traceexec
   * and the while loop will be executed roughly half the number of non-blank
   * source lines in the Lua function and these tend to be short.
   */
  int luaG_getline (const Proto *f, int pc) {
    int line = 0, thispc = 0, nextpc;
    unsigned char *p;
  
    for (p = f->packedlineinfo; *p && *p != INFO_FILL_BYTE;) {
      if (*p & INFO_DELTA_MASK) { /* line delta */
        int delta = *p & INFO_DELTA_6BITS;
        unsigned char sign = *p++ & INFO_SIGN_MASK;
        int shift;
        for (shift = 6; *p & INFO_DELTA_MASK; p++, shift += 7) {
          delta += (*p & INFO_DELTA_7BITS)<<shift;
        }
        line += sign ? -delta : delta+2;
      } else {
        line++;
      }
      lua_assert(*p<127);
      nextpc = thispc + *p++;
      if (thispc <= pc && pc < nextpc) {
        return line;
      }
      thispc = nextpc;
    }
    lua_assert(0);
    return 0;
  }
  
  static int stripdebug (lua_State *L, Proto *f, int level) {
    int len = 0, sizepackedlineinfo;
    TString* dummy;
    switch (level) {
      case 3:
        sizepackedlineinfo = strlen(cast(char *, f->packedlineinfo))+1;
        f->packedlineinfo = luaM_freearray(L, f->packedlineinfo, sizepackedlineinfo, unsigned char);
        len += sizepackedlineinfo;
      case 2:
        len += f->sizelocvars * (sizeof(struct LocVar) + sizeof(dummy->tsv) + sizeof(struct LocVar *));
        f->locvars = luaM_freearray(L, f->locvars, f->sizelocvars, struct LocVar);
        f->upvalues = luaM_freearray(L, f->upvalues, f->sizeupvalues, TString *);
        len += f->sizelocvars * (sizeof(struct LocVar) + sizeof(dummy->tsv) + sizeof(struct LocVar *)) +
               f->sizeupvalues * (sizeof(dummy->tsv) + sizeof(TString *));
        f->sizelocvars = 0;
        f->sizeupvalues = 0;
    }
    return len;
  }
  
  /* This is a recursive function so it's stack size has been kept to a minimum! */
  LUA_API int luaG_stripdebug (lua_State *L, Proto *f, int level, int recv){
    int len = 0, i;
    if (recv != 0 && f->sizep != 0) {
      for(i=0;i<f->sizep;i++) len += luaG_stripdebug(L, f->p[i], level, recv);
    }
    len += stripdebug (L, f, level);
    return len;
  }
  #endif
  
  
  static int auxgetinfo (lua_State *L, const char *what, lua_Debug *ar,
                      Closure *f, void *plight, CallInfo *ci) {
    int status = 1;
    if (plight == NULL && f == NULL) {
      info_tailcall(ar);
      return status;
    }
    for (; *what; what++) {
      switch (*what) {
        case 'S': {
          funcinfo(ar, f, plight);
          break;
        }
        case 'l': {
          ar->currentline = (ci) ? currentline(L, ci) : -1;
          break;
        }
        case 'u': {
          ar->nups = f ? f->c.nupvalues : 0;
          break;
        }
        case 'n': {
          ar->namewhat = (ci) ? getfuncname(L, ci, &ar->name) : 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 *f = NULL;
    CallInfo *ci = NULL;
    void *plight = NULL;
    lua_lock(L);
    if (*what == '>') {
      StkId func = L->top - 1;
      luai_apicheck(L, ttisfunction(func));
      what++;  /* skip the '>' */
      if (ttislightfunction(func))
        plight = fvalue(func);
      else
        f = clvalue(func);
      L->top--;  /* pop function */
    }
    else if (ar->i_ci != 0) {  /* no tail call? */
      ci = L->base_ci + ar->i_ci;
      lua_assert(ttisfunction(ci->func));
      if (ttislightfunction(ci->func))
        plight = fvalue(ci->func);
      else
        f = clvalue(ci->func);
    }
    status = auxgetinfo(L, what, ar, f, plight, ci);
    if (strchr(what, 'f')) {
      if (f != NULL)
        setclvalue(L, L->top, f)
      else if (plight != NULL)
        setfvalue(L->top, plight)
      else
        setnilvalue(L->top);
      incr_top(L);
    }
    if (strchr(what, 'L'))
      collectvalidlines(L, f);
    lua_unlock(L);
    return status;
  }
  
  
  /*
  ** {======================================================
  ** Symbolic Execution and code checker
  ** =======================================================
  */
  
  #define check(x)		if (!(x)) return 0;
  
  #define checkjump(pt,pc)	check(0 <= pc && pc < pt->sizecode)
  
  #define checkreg(pt,reg)	check((reg) < (pt)->maxstacksize)
  
  
  
  static int precheck (const Proto *pt) {
    check(pt->maxstacksize <= MAXSTACK);
    check(pt->numparams+(pt->is_vararg & VARARG_HASARG) <= pt->maxstacksize);
    check(!(pt->is_vararg & VARARG_NEEDSARG) ||
                (pt->is_vararg & VARARG_HASARG));
    check(pt->sizeupvalues <= pt->nups);
  #ifndef LUA_OPTIMIZE_DEBUG
    check(pt->sizelineinfo == pt->sizecode || pt->sizelineinfo == 0);
  #endif
    check(pt->sizecode > 0 && GET_OPCODE(pt->code[pt->sizecode-1]) == OP_RETURN);
    return 1;
  }
  
  
  #define checkopenop(pt,pc)	luaG_checkopenop((pt)->code[(pc)+1])
  
  int luaG_checkopenop (Instruction i) {
    switch (GET_OPCODE(i)) {
      case OP_CALL:
      case OP_TAILCALL:
      case OP_RETURN:
      case OP_SETLIST: {
        check(GETARG_B(i) == 0);
        return 1;
      }
      default: return 0;  /* invalid instruction after an open call */
    }
  }
  
  
  static int checkArgMode (const Proto *pt, int r, enum OpArgMask mode) {
    switch (mode) {
      case OpArgN: check(r == 0); break;
      case OpArgU: break;
      case OpArgR: checkreg(pt, r); break;
      case OpArgK:
        check(ISK(r) ? INDEXK(r) < pt->sizek : r < pt->maxstacksize);
        break;
    }
    return 1;
  }
  
  
  static Instruction symbexec (const Proto *pt, int lastpc, int reg) {
    int pc;
    int last;  /* stores position of last instruction that changed `reg' */
    last = pt->sizecode-1;  /* points to final return (a `neutral' instruction) */
    check(precheck(pt));
    for (pc = 0; pc < lastpc; pc++) {
      Instruction i = pt->code[pc];
      OpCode op = GET_OPCODE(i);
      int a = GETARG_A(i);
      int b = 0;
      int c = 0;
      check(op < NUM_OPCODES);
      checkreg(pt, a);
      switch (getOpMode(op)) {
        case iABC: {
          b = GETARG_B(i);
          c = GETARG_C(i);
          check(checkArgMode(pt, b, getBMode(op)));
          check(checkArgMode(pt, c, getCMode(op)));
          break;
        }
        case iABx: {
          b = GETARG_Bx(i);
          if (getBMode(op) == OpArgK) check(b < pt->sizek);
          break;
        }
        case iAsBx: {
          b = GETARG_sBx(i);
          if (getBMode(op) == OpArgR) {
            int dest = pc+1+b;
            check(0 <= dest && dest < pt->sizecode);
            if (dest > 0) {
              int j;
              /* check that it does not jump to a setlist count; this
                 is tricky, because the count from a previous setlist may
                 have the same value of an invalid setlist; so, we must
                 go all the way back to the first of them (if any) */
              for (j = 0; j < dest; j++) {
                Instruction d = pt->code[dest-1-j];
                if (!(GET_OPCODE(d) == OP_SETLIST && GETARG_C(d) == 0)) break;
              }
              /* if 'j' is even, previous value is not a setlist (even if
                 it looks like one) */
              check((j&1) == 0);
            }
          }
          break;
        }
      }
      if (testAMode(op)) {
        if (a == reg) last = pc;  /* change register `a' */
      }
      if (testTMode(op)) {
        check(pc+2 < pt->sizecode);  /* check skip */
        check(GET_OPCODE(pt->code[pc+1]) == OP_JMP);
      }
      switch (op) {
        case OP_LOADBOOL: {
          if (c == 1) {  /* does it jump? */
            check(pc+2 < pt->sizecode);  /* check its jump */
            check(GET_OPCODE(pt->code[pc+1]) != OP_SETLIST ||
                  GETARG_C(pt->code[pc+1]) != 0);
          }
          break;
        }
        case OP_LOADNIL: {
          if (a <= reg && reg <= b)
            last = pc;  /* set registers from `a' to `b' */
          break;
        }
        case OP_GETUPVAL:
        case OP_SETUPVAL: {
          check(b < pt->nups);
          break;
        }
        case OP_GETGLOBAL:
        case OP_SETGLOBAL: {
          check(ttisstring(&pt->k[b]));
          break;
        }
        case OP_SELF: {
          checkreg(pt, a+1);
          if (reg == a+1) last = pc;
          break;
        }
        case OP_CONCAT: {
          check(b < c);  /* at least two operands */
          break;
        }
        case OP_TFORLOOP: {
          check(c >= 1);  /* at least one result (control variable) */
          checkreg(pt, a+2+c);  /* space for results */
          if (reg >= a+2) last = pc;  /* affect all regs above its base */
          break;
        }
        case OP_FORLOOP:
        case OP_FORPREP:
          checkreg(pt, a+3);
          /* go through */
        case OP_JMP: {
          int dest = pc+1+b;
          /* not full check and jump is forward and do not skip `lastpc'? */
          if (reg != NO_REG && pc < dest && dest <= lastpc)
            pc += b;  /* do the jump */
          break;
        }
        case OP_CALL:
        case OP_TAILCALL: {
          if (b != 0) {
            checkreg(pt, a+b-1);
          }
          c--;  /* c = num. returns */
          if (c == LUA_MULTRET) {
            check(checkopenop(pt, pc));
          }
          else if (c != 0)
            checkreg(pt, a+c-1);
          if (reg >= a) last = pc;  /* affect all registers above base */
          break;
        }
        case OP_RETURN: {
          b--;  /* b = num. returns */
          if (b > 0) checkreg(pt, a+b-1);
          break;
        }
        case OP_SETLIST: {
          if (b > 0) checkreg(pt, a + b);
          if (c == 0) {
            pc++;
            check(pc < pt->sizecode - 1);
          }
          break;
        }
        case OP_CLOSURE: {
          int nup, j;
          check(b < pt->sizep);
          nup = pt->p[b]->nups;
          check(pc + nup < pt->sizecode);
          for (j = 1; j <= nup; j++) {
            OpCode op1 = GET_OPCODE(pt->code[pc + j]);
            check(op1 == OP_GETUPVAL || op1 == OP_MOVE);
          }
          if (reg != NO_REG)  /* tracing? */
            pc += nup;  /* do not 'execute' these pseudo-instructions */
          break;
        }
        case OP_VARARG: {
          check((pt->is_vararg & VARARG_ISVARARG) &&
               !(pt->is_vararg & VARARG_NEEDSARG));
          b--;
          if (b == LUA_MULTRET) check(checkopenop(pt, pc));
          checkreg(pt, a+b-1);
          break;
        }
        default: break;
      }
    }
    return pt->code[last];
  }
  
  #undef check
  #undef checkjump
  #undef checkreg
  
  /* }====================================================== */
  
  
  int luaG_checkcode (const Proto *pt) {
    return (symbexec(pt, pt->sizecode, NO_REG) != 0);
  }
  
  
  static const char *kname (Proto *p, int c) {
    if (ISK(c) && ttisstring(&p->k[INDEXK(c)]))
      return svalue(&p->k[INDEXK(c)]);
    else
      return "?";
  }
  
  
  static const char *getobjname (lua_State *L, CallInfo *ci, int stackpos,
                                 const char **name) {
    if (isLua(ci)) {  /* a Lua function? */
      Proto *p = ci_func(ci)->l.p;
      int pc = currentpc(L, ci);
      Instruction i;
      *name = luaF_getlocalname(p, stackpos+1, pc);
      if (*name)  /* is a local? */
        return "local";
      i = symbexec(p, pc, stackpos);  /* try symbolic execution */
      lua_assert(pc != -1);
      switch (GET_OPCODE(i)) {
        case OP_GETGLOBAL: {
          int g = GETARG_Bx(i);  /* global index */
          lua_assert(ttisstring(&p->k[g]));
          *name = svalue(&p->k[g]);
          return "global";
        }
        case OP_MOVE: {
          int a = GETARG_A(i);
          int b = GETARG_B(i);  /* move from `b' to `a' */
          if (b < a)
            return getobjname(L, ci, b, name);  /* get name for `b' */
          break;
        }
        case OP_GETTABLE: {
          int k = GETARG_C(i);  /* key index */
          *name = kname(p, k);
          return "field";
        }
        case OP_GETUPVAL: {
          int u = GETARG_B(i);  /* upvalue index */
          *name = p->upvalues ? getstr(p->upvalues[u]) : "?";
          return "upvalue";
        }
        case OP_SELF: {
          int k = GETARG_C(i);  /* key index */
          *name = kname(p, k);
          return "method";
        }
        default: break;
      }
    }
    return NULL;  /* no useful name found */
  }
  
  
  static const char *getfuncname (lua_State *L, CallInfo *ci, const char **name) {
    Instruction i;
    if ((isLua(ci) && ci->tailcalls > 0) || !isLua(ci - 1))
      return NULL;  /* calling function is not Lua (or is unknown) */
    ci--;  /* calling function */
    i = ci_func(ci)->l.p->code[currentpc(L, ci)];
    if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL ||
        GET_OPCODE(i) == OP_TFORLOOP)
      return getobjname(L, ci, GETARG_A(i), name);
    else
      return NULL;  /* no useful name can be found */
  }
  
  
  /* only ANSI way to check whether a pointer points to an array */
  static int isinstack (CallInfo *ci, const TValue *o) {
    StkId p;
    for (p = ci->base; p < ci->top; p++)
      if (o == p) return 1;
    return 0;
  }
  
  
  void luaG_typeerror (lua_State *L, const TValue *o, const char *op) {
    const char *name = NULL;
    const char *t = luaT_typenames[ttype(o)];
    const char *kind = (isinstack(L->ci, o)) ?
                           getobjname(L, L->ci, cast_int(o - L->base), &name) :
                           NULL;
    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);
  }
  
  
  void luaG_concaterror (lua_State *L, StkId p1, StkId p2) {
    if (ttisstring(p1) || ttisnumber(p1)) p1 = p2;
    lua_assert(!ttisstring(p1) && !ttisnumber(p1));
    luaG_typeerror(L, p1, "concatenate");
  }
  
  
  void 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");
  }
  
  
  int luaG_ordererror (lua_State *L, const TValue *p1, const TValue *p2) {
    const char *t1 = luaT_typenames[ttype(p1)];
    const char *t2 = luaT_typenames[ttype(p2)];
    if (t1[2] == t2[2])
      luaG_runerror(L, "attempt to compare two %s values", t1);
    else
      luaG_runerror(L, "attempt to compare %s with %s", t1, t2);
    return 0;
  }
  
  
  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(L, ci);
      luaO_chunkid(buff, getstr(getluaproto(ci)->source), LUA_IDSIZE);
      luaO_pushfstring(L, "%s:%d: %s", buff, line, msg);
    }
  }
  
  
  void 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 */
      incr_top(L);
      luaD_call(L, L->top - 2, 1);  /* call it */
    }
    luaD_throw(L, LUA_ERRRUN);
  }
  
  
  void 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);
  }
  
  