new way to control hooks inside hooks (now the control is done inside Lua)

ldblib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldblib.c,v 1.7 1999/11/22 13:12:07 roberto Exp roberto $
+** $Id: ldblib.c,v 1.8 1999/11/22 17:39:51 roberto Exp roberto $
 ** Interface from Lua to its debug API
 ** See Copyright Notice in lua.h
 */
@@ -144,32 +144,28 @@ static void setlocal (lua_State *L) {
 
 
 
-static int linehook = -1;  /* Lua reference to line hook function */
-static int callhook = -1;  /* Lua reference to call hook function */
+static int linehook = LUA_NOREF;  /* Lua reference to line hook function */
+static int callhook = LUA_NOREF;  /* Lua reference to call hook function */
 
 
-static void dohook (lua_State *L, int ref) {
-  lua_LHFunction oldlinehook = lua_setlinehook(L, NULL);
-  lua_CHFunction oldcallhook = lua_setcallhook(L, NULL);
-  lua_callfunction(L, lua_getref(L, ref));
-  lua_setlinehook(L, oldlinehook);
-  lua_setcallhook(L, oldcallhook);
-}
-
 
 static void linef (lua_State *L, int line) {
-  lua_pushnumber(L, line);
-  dohook(L, linehook);
+  if (linehook != LUA_NOREF) {
+    lua_pushnumber(L, line);
+    lua_callfunction(L, lua_getref(L, linehook));
+  }
 }
 
 
-static void callf (lua_State *L, lua_Function func, const char *file, int line) {
-  if (func != LUA_NOOBJECT) {
-    lua_pushobject(L, func);
-    lua_pushstring(L, file);
-    lua_pushnumber(L, line);
+static void callf (lua_State *L, lua_Function f, const char *file, int line) {
+  if (callhook != LUA_NOREF) {
+    if (f != LUA_NOOBJECT) {
+      lua_pushobject(L, f);
+      lua_pushstring(L, file);
+      lua_pushnumber(L, line);
+    }
+    lua_callfunction(L, lua_getref(L, callhook));
   }
-  dohook(L, callhook);
 }
 
 
@@ -177,7 +173,7 @@ static void setcallhook (lua_State *L) {
   lua_Object f = lua_getparam(L, 1);
   lua_unref(L, callhook);
   if (f == LUA_NOOBJECT) {
-    callhook = -1;
+    callhook = LUA_NOREF;
     lua_setcallhook(L, NULL);
   }
   else {
@@ -192,7 +188,7 @@ static void setlinehook (lua_State *L) {
   lua_Object f = lua_getparam(L, 1);
   lua_unref(L, linehook);
   if (f == LUA_NOOBJECT) {
-    linehook = -1;
+    linehook = LUA_NOREF;
     lua_setlinehook(L, NULL);
   }
   else {

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.57 1999/12/06 11:43:58 roberto Exp roberto $
+** $Id: ldo.c,v 1.58 1999/12/06 12:03:45 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -99,30 +99,43 @@ void luaD_openstack (lua_State *L, StkId pos) {
 
 
 void luaD_lineHook (lua_State *L, int line) {
-  struct C_Lua_Stack oldCLS = L->Cstack;
-  StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->top;
-  L->Cstack.num = 0;
-  (*L->linehook)(L, line);
-  L->top = old_top;
-  L->Cstack = oldCLS;
+  if (L->allowhooks) {
+    struct C_Lua_Stack oldCLS = L->Cstack;
+    StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->top;
+    L->Cstack.num = 0;
+    L->allowhooks = 0;  /* cannot call hooks inside a hook */
+    (*L->linehook)(L, line);
+    L->allowhooks = 1;
+    L->top = old_top;
+    L->Cstack = oldCLS;
+  }
 }
 
 
-void luaD_callHook (lua_State *L, StkId base, const TProtoFunc *tf,
-                    int isreturn) {
-  struct C_Lua_Stack oldCLS = L->Cstack;
-  StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->top;
-  L->Cstack.num = 0;
-  if (isreturn)
-    (*L->callhook)(L, LUA_NOOBJECT, "(return)", 0);
-  else {
-    TObject *f = base-1;
-    if (tf)
-      v 1.3 1997/10/16, f, tf->source->str, tf->lineDefined);
-    else (*L->callhook)(L, f, "(C)", -1);
+static void luaD_callHook (lua_State *L, StkId func, lua_CHFunction callhook,
+                           int isreturn) {
+  if (L->allowhooks) {
+    struct C_Lua_Stack oldCLS = L->Cstack;
+    StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->top;
+    L->Cstack.num = 0;
+    L->allowhooks = 0;  /* cannot call hooks inside a hook */
+    if (isreturn)
+      callhook(L, LUA_NOOBJECT, "(return)", 0);
+    else {
+      if (ttype(func) == LUA_T_PROTO)
+        callhook(L, func, tfvalue(func)->source->str,
+                          tfvalue(func)->lineDefined);
+      else if (ttype(func) == LUA_T_CLOSURE &&
+               ttype(clvalue(func)->consts) == LUA_T_PROTO)
+        callhook(L, func, tfvalue(protovalue(func))->source->str,
+                          tfvalue(protovalue(func))->lineDefined);
+      else
+        callhook(L, func, "(C)", -1);
+    }
+    L->allowhooks = 1;
+    L->top = old_top;
+    L->Cstack = oldCLS;
   }
-  L->top = old_top;
-  L->Cstack = oldCLS;
 }
 
 
@@ -138,11 +151,7 @@ static StkId callC (lua_State *L, lua_CFunction f, StkId base) {
   L->Cstack.num = numarg;
   L->Cstack.lua2C = base;
   L->Cstack.base = L->top;
-  if (L->callhook)
-    luaD_callHook(L, base, NULL, 0);
   (*f)(L);  /* do the actual call */
-  if (L->callhook)  /* test again: `func' may change callhook */
-    luaD_callHook(L, base, NULL, 1);
   firstResult = L->Cstack.base;
   L->Cstack = oldCLS;
   return firstResult;
@@ -179,6 +188,10 @@ void luaD_callTM (lua_State *L, const TObject *f, int nParams, int nResults) {
 */ 
 void luaD_call (lua_State *L, StkId func, int nResults) {
   StkId firstResult;
+  lua_CHFunction callhook = L->callhook;
+  if (callhook)
+    luaD_callHook(L, func, callhook, 0);
+  retry:  /* for `function' tag method */
   switch (ttype(func)) {
     case LUA_T_CPROTO:
       ttype(func) = LUA_T_CMARK;
@@ -197,15 +210,17 @@ void luaD_call (lua_State *L, StkId func, int nResults) {
                        luaV_execute(L, c, tfvalue(proto), func+1);
       break;
     }
-    default: { /* `func' is not a function */
-      /* Check the tag method for invalid functions */
+    default: { /* `func' is not a function; check the `function' tag method */
       const TObject *im = luaT_getimbyObj(L, func, IM_FUNCTION);
       if (ttype(im) == LUA_T_NIL)
         lua_error(L, "call expression not a function");
-      luaD_callTM(L, im, L->top-func, nResults);
-      return;
+      luaD_openstack(L, func);
+      *func = *im;  /* tag method is the new function to be called */
+      goto retry;  /* retry the call (without calling callhook again) */
     }
   }
+  if (callhook)  /* same hook that was used at entry */
+    luaD_callHook(L, NULL, callhook, 1);  /* `return' hook */
   /* adjust the number of results */
   if (nResults == MULT_RET)
     nResults = L->top - firstResult;

ldo.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.h,v 1.13 1999/12/02 16:24:45 roberto Exp roberto $
+** $Id: ldo.h,v 1.14 1999/12/06 11:41:28 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -27,8 +27,6 @@ void luaD_init (lua_State *L, int stacksize);
 void luaD_adjusttop (lua_State *L, StkId base, int extra);
 void luaD_openstack (lua_State *L, StkId pos);
 void luaD_lineHook (lua_State *L, int line);
-void luaD_callHook (lua_State *L, StkId base, const TProtoFunc *tf,
-                    int isreturn);
 void luaD_call (lua_State *L, StkId func, int nResults);
 void luaD_callTM (lua_State *L, const TObject *f, int nParams, int nResults);
 int luaD_protectedrun (lua_State *L);

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.35 1999/12/01 19:50:08 roberto Exp roberto $
+** $Id: lgc.c,v 1.36 1999/12/14 18:31:20 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -240,12 +240,15 @@ static void markall (lua_State *L) {
 
 
 void luaC_collect (lua_State *L, int all) {
+  int oldah = L->allowhooks;
+  L->allowhooks = 0;  /* stop debug hooks during GC */
   L->GCthreshold *= 4;  /* to avoid GC during GC */
   tableTM(L);  /* call TM for tables (if LUA_COMPAT_GC) */
   collecttable(L);
   collectstring(L, all?MAX_INT:1);
   collectproto(L);
   collectclosure(L);
+  L->allowhooks = oldah;  /* restore hooks */
 }
 
 

lstate.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.c,v 1.21 1999/12/06 12:03:45 roberto Exp roberto $
+** $Id: lstate.c,v 1.22 1999/12/07 11:42:54 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -38,9 +38,6 @@ static lua_State *newstate_aux (int stacksize, int put_builtin) {
   L->Mbuffnext = 0;
   L->Cblocks = NULL;
   L->numCblocks = 0;
-  L->debug = 0;
-  L->callhook = NULL;
-  L->linehook = NULL;
   L->rootproto = NULL;
   L->rootcl = NULL;
   L->rootglobal = NULL;
@@ -51,6 +48,10 @@ static lua_State *newstate_aux (int stacksize, int put_builtin) {
   L->refFree = NONEXT;
   L->nblocks = 0;
   L->GCthreshold = MAX_INT;  /* to avoid GC during pre-definitions */
+  L->debug = 0;
+  L->callhook = NULL;
+  L->linehook = NULL;
+  L->allowhooks = 1;
   luaD_init(L, stacksize);
   luaS_init(L);
   luaX_init(L);

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.24 1999/12/01 19:50:08 roberto Exp roberto $
+** $Id: lstate.h,v 1.25 1999/12/06 11:41:28 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -62,9 +62,6 @@ struct lua_State {
   int Mbuffnext;  /* next position to fill in Mbuffer */
   struct C_Lua_Stack *Cblocks;
   int numCblocks;  /* number of nested Cblocks */
-  int debug;
-  lua_CHFunction callhook;
-  lua_LHFunction linehook;
   /* global state */
   TProtoFunc *rootproto;  /* list of all prototypes */
   Closure *rootcl;  /* list of all closures */
@@ -78,6 +75,10 @@ struct lua_State {
   int refFree;  /* list of free positions in refArray */
   unsigned long GCthreshold;
   unsigned long nblocks;  /* number of 'blocks' currently allocated */
+  int debug;
+  lua_CHFunction callhook;
+  lua_LHFunction linehook;
+  int allowhooks;
 };
 
 

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.72 1999/12/09 20:01:48 roberto Exp roberto $
+** $Id: lvm.c,v 1.73 1999/12/14 18:31:20 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -294,8 +294,6 @@ StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf,
   register StkId top;  /* keep top local, for performance */
   register const Byte *pc = tf->code;
   const TObject *consts = tf->consts;
-  if (L->callhook)
-    luaD_callHook(L, base, tf, 0);
   luaD_checkstack(L, (*pc++)+EXTRA_STACK);
   if (*pc < ZEROVARARG)
     luaD_adjusttop(L, base, *(pc++));
@@ -310,12 +308,11 @@ StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf,
     switch ((OpCode)*pc++) {
 
       case ENDCODE:
-        top = base;
-        goto ret;
+        return L->top;  /* no results */
 
       case RETCODE:
-        base += *pc++;
-        goto ret;
+        L->top = top;
+        return base+(*pc++);
 
       case CALL: aux = *pc++;
         L->top = top;
@@ -326,9 +323,7 @@ StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf,
       case TAILCALL: aux = *pc++;
         L->top = top;
         luaD_call(L, base+(*pc++), MULT_RET);
-        top = L->top;
-        base += aux;
-        goto ret;
+        return base+aux;
 
       case PUSHNIL: aux = *pc++;
         do {
@@ -608,9 +603,5 @@ StkId luaV_execute (lua_State *L, const Closure *cl, const TProtoFunc *tf,
         goto switchentry;  /* do not reset "aux" */
 
     }
-  } ret:
-  L->top = top;
-  if (L->callhook)
-    luaD_callHook(L, 0, NULL, 1);
-  return base;
+  }
 }