no-nonsense debug information about tail calls

7 files changed, 101 insertions, 73 deletions

diff --git a/lbaselib.c b/lbaselib.c
index 7bf69c8f..9bb71492 100644
--- 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);
   }
 }
 
diff --git a/ldblib.c b/ldblib.c
index bef81bdd..9bffa2c8 100644
--- 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);
diff --git a/ldebug.c b/ldebug.c
index 39b27810..e308e080 100644
--- 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 */
+  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 {
-    ar->i_ci = ci;
     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 */
 }
 
 
diff --git a/ldo.c b/ldo.c
index 057d5b30..253be07a 100644
--- 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 */
diff --git a/lstate.h b/lstate.h
index 2e184839..6f8e4e6c 100644
--- 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 */
diff --git a/lua.h b/lua.h
index ed5bb614..b198d3d5 100644
--- 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 */
diff --git a/lvm.c b/lvm.c
index c66bbc8a..66d08e3f 100644
--- 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;