still more debug information

ldebug.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.c,v 1.31 2000/08/09 19:16:57 roberto Exp roberto $
+** $Id: ldebug.c,v 1.32 2000/08/10 19:50:47 roberto Exp roberto $
 ** Debug Interface
 ** See Copyright Notice in lua.h
 */
@@ -23,6 +23,8 @@
 #include "luadebug.h"
 
 
+static const char *getfuncname (lua_State *L, StkId f, const char **name);
+
 
 static void setnormalized (TObject *d, const TObject *s) {
   switch (s->ttype) {
@@ -229,7 +231,8 @@ static void lua_getname (lua_State *L, StkId f, lua_Debug *ar) {
 
 int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
   StkId func;
-  if (*what != '>')
+  int isactive = (*what != '>');
+  if (isactive)
     func = ar->_func;
   else {
     what++;  /* skip the '>' */
@@ -237,23 +240,30 @@ int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
   }
   for (; *what; what++) {
     switch (*what) {
-      case 'S':
+      case 'S': {
         lua_funcinfo(ar, func);
         break;
-      case 'l':
+      }
+      case 'l': {
         ar->currentline = lua_currentline(func);
         break;
-      case 'u':
+      }
+      case 'u': {
         ar->nups = lua_nups(func);
         break;
-      case 'n':
+      }
-        lua_getname(L, func, ar);
+      case 'n': {
+        ar->namewhat = getfuncname(L, func, &ar->name);
+        if (ar->namewhat == NULL)
+          lua_getname(L, func, ar);
         break;
-      case 'f':
+      }
+      case 'f': {
         setnormalized(L->top, func);
         incr_top;
         ar->func = lua_pop(L);
         break;
+      }
       default: return 0;  /* invalid option */
     }
   }
@@ -286,10 +296,11 @@ static Instruction luaG_symbexec (const Proto *pt, int lastpc, int stackpos) {
     const Instruction i = code[pc++];
     LUA_ASSERT(0 <= top && top <= pt->maxstacksize, "wrong stack");
     switch (GET_OPCODE(i)) {
-      case OP_RETURN: {
+      case OP_RETURN:
-        LUA_ASSERT(top >= GETARG_U(i), "wrong stack");
+      case OP_TAILCALL:
-        top = GETARG_U(i);
+      case OP_END: {
-        break;
+        LUA_INTERNALERROR("invalid symbolic run");
+        return CREATE_0(OP_END);  /* stop execution */
       }
       case OP_CALL: {
         int nresults = GETARG_B(i);
@@ -298,11 +309,6 @@ static Instruction luaG_symbexec (const Proto *pt, int lastpc, int stackpos) {
         top = pushpc(stack, pc, GETARG_A(i), nresults);
         break;
       }
-      case OP_TAILCALL: {
-        LUA_ASSERT(top >= GETARG_A(i), "wrong stack");
-        top = GETARG_B(i);
-        break;
-      }
       case OP_PUSHNIL: {
         top = pushpc(stack, pc, top, GETARG_U(i));
         break;
@@ -384,6 +390,23 @@ static const char *getobjname (lua_State *L, StkId obj, const char **name) {
 }
 
 
+static const char *getfuncname (lua_State *L, StkId f, const char **name) {
+  StkId func = aux_stackedfunction(L, 0, f);  /* calling function */
+  if (func == NULL || ttype(func) != TAG_LMARK)
+    return NULL;  /* not a Lua function */
+  else {
+    Proto *p = infovalue(func)->func->f.l;
+    Instruction i = p->code[lua_currentpc(func)];
+    switch (GET_OPCODE(i)) {
+      case OP_CALL: case OP_TAILCALL:
+        return getobjname(L, (func+1)+GETARG_A(i), name);
+      default:
+        return NULL;  /* no usefull name found */
+    }
+  }
+}
+
+
 /* }====================================================== */
 
 
@@ -405,3 +428,13 @@ void luaG_binerror (lua_State *L, StkId p1, lua_Type t, const char *op) {
   luaG_typeerror(L, p1, op);
 }
 
+
+void luaG_ordererror (lua_State *L, StkId top) {
+  const char *t1 = lua_type(L, top-2);
+  const char *t2 = lua_type(L, top-1);
+  if (t1[2] == t2[2])
+    luaL_verror(L, "attempt to compare two %.10s values", t1);
+  else
+    luaL_verror(L, "attempt to compare %.10s with %.10s", t1, t2);
+}
+

ldebug.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.h,v 1.3 2000/08/08 18:26:05 roberto Exp roberto $
+** $Id: ldebug.h,v 1.4 2000/08/10 19:50:47 roberto Exp roberto $
 ** Auxiliary functions from Debug Interface module
 ** See Copyright Notice in lua.h
 */
@@ -15,6 +15,7 @@
 void luaG_typeerror (lua_State *L, StkId o, const char *op);
 void luaG_binerror (lua_State *L, StkId p1, lua_Type t, const char *op);
 int luaG_getline (int *lineinfo, int pc, int refline, int *refi);
+void luaG_ordererror (lua_State *L, StkId top);
 
 
 #endif

lobject.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.c,v 1.43 2000/06/30 14:35:17 roberto Exp roberto $
+** $Id: lobject.c,v 1.44 2000/08/09 19:16:57 roberto Exp roberto $
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -12,6 +12,10 @@
 #include "lobject.h"
 
 
+/*
+** you can use the fact that the 3rd letter or each name is always different
+** (e-m-r-b-n-l) to compare and switch these strings
+*/
 const char *const luaO_typenames[] = { /* ORDER LUA_T */
     "userdata", "number", "string", "table", "function", "function", "nil",
     "function", "function"

luadebug.h

@@ -1,5 +1,5 @@
 /*
-** $Id: luadebug.h,v 1.10 2000/03/30 17:19:48 roberto Exp roberto $
+** $Id: luadebug.h,v 1.11 2000/08/08 20:42:07 roberto Exp roberto $
 ** Debugging API
 ** See Copyright Notice in lua.h
 */
@@ -34,7 +34,7 @@ struct lua_Debug {
   const char *what;      /* (S) `Lua' function, `C' function, Lua `main' */
   int currentline;       /* (l) */
   const char *name;      /* (n) */
-  const char *namewhat;  /* (n) global, tag method, local, field */
+  const char *namewhat;  /* (n) `global', `tag method', `local', `field' */
   int nups;              /* (u) number of upvalues */
   lua_Object func;       /* (f) function being executed */
   /* private part */

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.124 2000/08/09 19:16:57 roberto Exp roberto $
+** $Id: lvm.c,v 1.125 2000/08/10 19:50:47 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -279,7 +279,7 @@ int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top)
     *top++ = *l;
     *top++ = *r;
     if (!call_binTM(L, top, IM_LT))
-      lua_error(L, "unexpected type in comparison");
+      luaG_ordererror(L, top-2);
     L->top--;
     return (ttype(L->top) != TAG_NIL);
   }