no-nonsense debug information about tail calls

2003-02-27 08:52:30 -03:00 · 2003-02-27 08:52:30 -03:00 · 92f6e0c1bf
parent 5cd99b82b7
commit 92f6e0c1bf
7 changed files with 102 additions and 74 deletions
--- a/lbaselib.c
+++ b/lbaselib.c
@ -1,5 +1,5 @@
 /*
-** $Id: lbaselib.c,v 1.122 2003/02/24 16:50:41 roberto Exp roberto $
+** $Id: lbaselib.c,v 1.123 2003/02/24 16:54:20 roberto Exp roberto $
 ** Basic library
 ** See Copyright Notice in lua.h
 */
@ -123,6 +123,9 @@ static void getfunc (lua_State *L) {
    if (lua_getstack(L, level, &ar) == 0)
      luaL_argerror(L, 1, "invalid level");
    lua_getinfo(L, "f", &ar);
+    if (lua_isnil(L, -1))
+      luaL_error(L, "cannot get/set environment (tail call at level %d)",
+                    level);
  }
 }

--- a/ldblib.c
+++ b/ldblib.c
@ -1,5 +1,5 @@
 /*
-** $Id: ldblib.c,v 1.76 2002/12/19 11:11:55 roberto Exp roberto $
+** $Id: ldblib.c,v 1.77 2002/12/20 10:26:33 roberto Exp roberto $
 ** Interface from Lua to its debug API
 ** See Copyright Notice in lua.h
 */
@ -137,7 +137,8 @@ static const char KEY_HOOK = 'h';


 static void hookf (lua_State *L, lua_Debug *ar) {
-  static const char *const hooknames[] = {"call", "return", "line", "count"};
+  static const char *const hooknames[] =
+    {"call", "return", "line", "count", "tail return"};
  lua_pushlightuserdata(L, (void *)&KEY_HOOK);
  lua_rawget(L, LUA_REGISTRYINDEX);
  if (lua_isfunction(L, -1)) {
@ -259,8 +260,8 @@ static int errorfb (lua_State *L) {
      default: {
        if (*ar.what == 'm')  /* main? */
          lua_pushfstring(L, " in main chunk");
-        else if (*ar.what == 'C')  /* C function? */
-          lua_pushfstring(L, "%s", ar.short_src);
+        else if (*ar.what == 'C' || *ar.what == 't')
+          lua_pushliteral(L, " ?");  /* C function or tail call */
        else
          lua_pushfstring(L, " in function <%s:%d>",
                             ar.short_src, ar.linedefined);
--- a/ldebug.c
+++ b/ldebug.c
@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.c,v 1.144 2003/02/11 10:46:24 roberto Exp roberto $
+** $Id: ldebug.c,v 1.145 2003/02/19 10:28:58 roberto Exp roberto $
 ** Debug Interface
 ** See Copyright Notice in lua.h
 */
@ -93,13 +93,21 @@ LUA_API int lua_gethookcount (lua_State *L) {

 LUA_API int lua_getstack (lua_State *L, int level, lua_Debug *ar) {
  int status;
-  int ci;
+  CallInfo *ci;
  lua_lock(L);
-  ci = (L->ci - L->base_ci) - level;
-  if (ci <= 0) status = 0;  /* there is no such level */
-  else {
-    ar->i_ci = ci;
+  for (ci = L->ci; level > 0 && ci > L->base_ci; ci--) {
+    level--;
+    if (!(ci->state & CI_C))  /* Lua function? */
+      level -= ci->u.l.tailcalls;  /* skip lost tail calls */
+  }
+  if (level > 0 || ci == L->base_ci) status = 0;  /* there is no such level */
+  else if (level < 0) {  /* level is of a lost tail call */
    status = 1;
+    ar->i_ci = 0;
+  }
+  else {
+    status = 1;
+    ar->i_ci = ci - L->base_ci;
  }
  lua_unlock(L);
  return status;
@ -150,31 +158,19 @@ LUA_API const char *lua_setlocal (lua_State *L, const lua_Debug *ar, int n) {
 }


-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;
-  if (ttisfunction(func))
-    cl = clvalue(func);
-  else {
-    luaG_runerror(L, "value for `lua_getinfo' is not a function");
-    cl = NULL;  /* to avoid warnings */
-  }
+  Closure *cl = clvalue(func);
  if (cl->c.isC) {
    ar->source = "=[C]";
    ar->linedefined = -1;
    ar->what = "C";
  }
-  else
-    infoLproto(ar, cl->l.p);
+  else {
+    ar->source = getstr(cl->l.p->source);
+    ar->linedefined = cl->l.p->lineDefined;
+    ar->what = (ar->linedefined == 0) ? "main" : "Lua";
+  }
  luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
-  if (ar->linedefined == 0)
-    ar->what = "main";
 }


@ -190,29 +186,20 @@ static const char *travglobals (lua_State *L, const TObject *o) {
 }


-static void getname (lua_State *L, const TObject *f, lua_Debug *ar) {
-  /* try to find a name for given function */
-  if ((ar->name = travglobals(L, f)) != NULL)
-    ar->namewhat = "global";
-  else ar->namewhat = "";  /* not found */
+static void info_tailcall (lua_State *L, lua_Debug *ar) {
+  ar->name = ar->namewhat = "";
+  ar->what = "tail";
+  ar->linedefined = ar->currentline = -1;
+  ar->source = "=(tail call)";
+  luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
+  ar->nups = 0;
+  setnilvalue(L->top);
 }


-
-LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
-  StkId f;
-  CallInfo *ci;
+static int getinfo (lua_State *L, const char *what, lua_Debug *ar,
+                    StkId f, CallInfo *ci) {
  int status = 1;
-  lua_lock(L);
-  if (*what != '>') {  /* function is active? */
-    ci = L->base_ci + ar->i_ci;
-    f = ci->base - 1;
-  }
-  else {
-    what++;  /* skip the `>' */
-    ci = NULL;
-    f = L->top - 1;
-  }
  for (; *what; what++) {
    switch (*what) {
      case 'S': {
@ -224,25 +211,48 @@ LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
        break;
      }
      case 'u': {
-        ar->nups = (ttisfunction(f)) ? clvalue(f)->c.nupvalues : 0;
+        ar->nups = clvalue(f)->c.nupvalues;
        break;
      }
      case 'n': {
        ar->namewhat = (ci) ? getfuncname(ci, &ar->name) : NULL;
-        if (ar->namewhat == NULL)
-          getname(L, f, ar);
+        if (ar->namewhat == NULL) {
+          /* try to find a global name */
+          if ((ar->name = travglobals(L, f)) != NULL)
+            ar->namewhat = "global";
+          else ar->namewhat = "";  /* not found */
+        }
        break;
      }
      case 'f': {
        setobj2s(L->top, f);
-        status = 2;
        break;
      }
      default: status = 0;  /* invalid option */
    }
  }
-  if (!ci) L->top--;  /* pop function */
-  if (status == 2) incr_top(L);
+  return status;
+}
+
+
+LUA_API int lua_getinfo (lua_State *L, const char *what, lua_Debug *ar) {
+  int status = 1;
+  lua_lock(L);
+  if (*what == '>') {
+    StkId f = L->top - 1;
+    if (!ttisfunction(f))
+      luaG_runerror(L, "value for `lua_getinfo' is not a function");
+    status = getinfo(L, what + 1, ar, f, NULL);
+    L->top--;  /* pop function */
+  }
+  else if (ar->i_ci != 0) {  /* no tail call? */
+    CallInfo *ci = L->base_ci + ar->i_ci;
+    lua_assert(ttisfunction(ci->base - 1));
+    status = getinfo(L, what, ar, ci->base - 1, ci);
+  }
+  else
+    info_tailcall(L, ar);
+  if (strchr(what, 'f')) incr_top(L);
  lua_unlock(L);
  return status;
 }
@ -480,18 +490,16 @@ static const char *getobjname (CallInfo *ci, int stackpos, const char **name) {
 }


-static Instruction getcurrentinstr (CallInfo *ci) {
-  return (!isLua(ci)) ? (Instruction)(-1) :
-                        ci_func(ci)->l.p->code[currentpc(ci)];
-}
-
-
 static const char *getfuncname (CallInfo *ci, const char **name) {
  Instruction i;
+  if ((isLua(ci) && ci->u.l.tailcalls > 0) || !isLua(ci - 1))
+    return NULL;  /* calling function is not Lua (or is unknown) */
  ci--;  /* calling function */
-  i = getcurrentinstr(ci);
-  return (GET_OPCODE(i) == OP_CALL ? getobjname(ci, GETARG_A(i), name)
-                                   : NULL);  /* no useful name found */
+  i = ci_func(ci)->l.p->code[currentpc(ci)];
+  if (GET_OPCODE(i) == OP_CALL || GET_OPCODE(i) == OP_TAILCALL)
+    return getobjname(ci, GETARG_A(i), name);
+  else
+    return NULL;  /* no useful name can be found */
 }


--- a/ldo.c
+++ b/ldo.c
@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.212 2003/01/23 11:31:38 roberto Exp roberto $
+** $Id: ldo.c,v 1.213 2003/02/13 16:08:47 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@ -31,6 +31,7 @@



+
 /*
 ** {======================================================
 ** Error-recovery functions (based on long jumps)
@ -161,7 +162,10 @@ void luaD_callhook (lua_State *L, int event, int line) {
    lua_Debug ar;
    ar.event = event;
    ar.currentline = line;
-    ar.i_ci = L->ci - L->base_ci;
+    if (event == LUA_HOOKTAILRET)
+      ar.i_ci = 0;  /* tail call; no debug information about it */
+    else
+      ar.i_ci = L->ci - L->base_ci;
    luaD_checkstack(L, LUA_MINSTACK);  /* ensure minimum stack size */
    L->ci->top = L->top + LUA_MINSTACK;
    L->allowhook = 0;  /* cannot call hooks inside a hook */
@ -232,6 +236,7 @@ StkId luaD_precall (lua_State *L, StkId func) {
    L->base = L->ci->base = restorestack(L, funcr) + 1;
    ci->top = L->base + p->maxstacksize;
    ci->u.l.savedpc = p->code;  /* starting point */
+    ci->u.l.tailcalls = 0;
    ci->state = CI_SAVEDPC;
    while (L->top < ci->top)
      setnilvalue(L->top++);
@ -261,13 +266,21 @@ StkId luaD_precall (lua_State *L, StkId func) {
 }


+static StkId callrethooks (lua_State *L, StkId firstResult) {
+  ptrdiff_t fr = savestack(L, firstResult);  /* next call may change stack */
+  luaD_callhook(L, LUA_HOOKRET, -1);
+  if (!(L->ci->state & CI_C)) {  /* Lua function? */
+    while (L->ci->u.l.tailcalls--)  /* call hook for eventual tail calls */
+      luaD_callhook(L, LUA_HOOKTAILRET, -1);
+  }
+  return restorestack(L, fr);
+}
+
+
 void luaD_poscall (lua_State *L, int wanted, StkId firstResult) { 
  StkId res;
-  if (L->hookmask & LUA_MASKRET) {
-    ptrdiff_t fr = savestack(L, firstResult);  /* next call may change stack */
-    luaD_callhook(L, LUA_HOOKRET, -1);
-    firstResult = restorestack(L, fr);
-  }
+  if (L->hookmask & LUA_MASKRET)
+    firstResult = callrethooks(L, firstResult);
  res = L->base - 1;  /* res == final position of 1st result */
  L->ci--;
  L->base = L->ci->base;  /* restore base */
--- a/lstate.h
+++ b/lstate.h
@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.107 2002/11/22 18:01:46 roberto Exp roberto $
+** $Id: lstate.h,v 1.108 2002/11/25 17:47:13 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@ -80,6 +80,7 @@ typedef struct CallInfo {
    struct {  /* for Lua functions */
      const Instruction *savedpc;
      const Instruction **pc;  /* points to `pc' variable in `luaV_execute' */
+      int tailcalls;  /* number of tail calls lost under this entry */
    } l;
    struct {  /* for C functions */
      int dummy;  /* just to avoid an empty struct */
--- a/lua.h
+++ b/lua.h
@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.172 2003/02/18 16:13:15 roberto Exp roberto $
+** $Id: lua.h,v 1.173 2003/02/24 16:54:20 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** Tecgraf: Computer Graphics Technology Group, PUC-Rio, Brazil
 ** http://www.lua.org	mailto:info@lua.org
@ -317,6 +317,7 @@ LUA_API int lua_pushupvalues (lua_State *L);
 #define LUA_HOOKRET	1
 #define LUA_HOOKLINE	2
 #define LUA_HOOKCOUNT	3
+#define LUA_HOOKTAILRET 4


 /*
@ -351,7 +352,7 @@ struct lua_Debug {
  int event;
  const char *name;	/* (n) */
  const char *namewhat;	/* (n) `global', `local', `field', `method' */
-  const char *what;	/* (S) `Lua' function, `C' function, Lua `main' */
+  const char *what;	/* (S) `Lua', `C', `main', `tail' */
  const char *source;	/* (S) */
  int currentline;	/* (l) */
  int nups;		/* (u) number of upvalues */
--- a/lvm.c
+++ b/lvm.c
@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.275 2003/02/11 10:46:24 roberto Exp roberto $
+** $Id: lvm.c,v 1.276 2003/02/18 16:02:56 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@ -648,6 +648,7 @@ StkId luaV_execute (lua_State *L) {
            (L->ci - 1)->top = L->top = base+aux;  /* correct top */
            lua_assert(L->ci->state & CI_SAVEDPC);
            (L->ci - 1)->u.l.savedpc = L->ci->u.l.savedpc;
+            (L->ci - 1)->u.l.tailcalls++;  /* one more call lost */
            (L->ci - 1)->state = CI_SAVEDPC;
            L->ci--;  /* remove new frame */
            L->base = L->ci->base;