keep control of stack top in Lua functions concentrated in 'luaV_execute'

ldebug.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.c,v 2.149 2017/12/15 13:07:10 roberto Exp roberto $
+** $Id: ldebug.c,v 2.150 2017/12/20 14:58:05 roberto Exp roberto $
 ** Debug Interface
 ** See Copyright Notice in lua.h
 */
@@ -737,8 +737,6 @@ l_noret luaG_runerror (lua_State *L, const char *fmt, ...) {
   const char *msg;
   va_list argp;
   luaC_checkGC(L);  /* error message uses memory */
-  if (isLuacode(ci))
-    L->top = ci->top;  /* prepare top */
   va_start(argp, fmt);
   msg = luaO_pushvfstring(L, fmt, argp);  /* format message */
   va_end(argp);
@@ -762,7 +760,6 @@ static int changedline (Proto *p, int oldpc, int newpc) {
 
 
 void luaG_traceexec (lua_State *L) {
-  ptrdiff_t oldtop = savestack(L, L->top);
   CallInfo *ci = L->ci;
   lu_byte mask = L->hookmask;
   int counthook = (--L->hookcount == 0 && (mask & LUA_MASKCOUNT));
@@ -774,7 +771,8 @@ void luaG_traceexec (lua_State *L) {
     ci->callstatus &= ~CIST_HOOKYIELD;  /* erase mark */
     return;  /* do not call hook again (VM yielded, so it did not move) */
   }
-  L->top = ci->top;  /* prepare top */
+  if (!isIT(*(ci->u.l.savedpc - 1)))
+    L->top = ci->top;  /* prepare top */
   if (counthook)
     luaD_hook(L, LUA_HOOKCOUNT, -1);  /* call count hook */
   if (mask & LUA_MASKLINE) {
@@ -789,7 +787,6 @@ void luaG_traceexec (lua_State *L) {
     }
     L->oldpc = npc;
   }
-  L->top = restorestack(L, oldtop);
   if (L->status == LUA_YIELD) {  /* did hook yield? */
     if (counthook)
       L->hookcount = 1;  /* undo decrement to zero */

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 2.242 2017/12/08 17:28:25 roberto Exp roberto $
+** $Id: lgc.c,v 2.243 2017/12/20 14:58:05 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -571,21 +571,16 @@ static int traverseLclosure (global_State *g, LClosure *cl) {
 
 /*
 ** Traverse a thread, marking the elements in the stack up to its top
-** and cleaning the rest of the stack in the last traversal.
+** and cleaning the rest of the stack in the final traversal.
 ** That ensures that the entire stack have valid (non-dead) objects.
-** In an emergency collection running Lua code, 'L->top' may not be
-** update. In that case, traverse at least up to 'ci->top'.
 */
 static int traversethread (global_State *g, lua_State *th) {
   StkId o = th->stack;
-  StkId top = th->top;
   if (o == NULL)
     return 1;  /* stack not completely built yet */
   lua_assert(g->gcstate == GCSatomic ||
              th->openupval == NULL || isintwups(th));
-  if (g->gcemergency && isLuacode(th->ci) && top < th->ci->top)
-    top = th->ci->top;
-  for (; o < top; o++)  /* mark live elements in the stack */
+  for (; o < th->top; o++)  /* mark live elements in the stack */
     markvalue(g, s2v(o));
   if (g->gcstate == GCSatomic) {  /* final traversal? */
     StkId lim = th->stack + th->stacksize;  /* real end of stack */

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 2.54 2017/12/19 16:40:17 roberto Exp roberto $
+** $Id: ltm.c,v 2.55 2017/12/20 14:58:05 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -101,7 +101,7 @@ const char *luaT_objtypename (lua_State *L, const TValue *o) {
 
 void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
                   const TValue *p2, const TValue *p3) {
-  StkId func = (isLuacode(L->ci)) ? L->ci->top : L->top;
+  StkId func = L->top;
   setobj2s(L, func, f);  /* push function (assume EXTRA_STACK) */
   setobj2s(L, func + 1, p1);  /* 1st argument */
   setobj2s(L, func + 2, p2);  /* 2nd argument */
@@ -115,8 +115,8 @@ void luaT_callTM (lua_State *L, const TValue *f, const TValue *p1,
 }
 
 
-static void reallycallTMres (lua_State *L, const TValue *f, const TValue *p1,
-                             const TValue *p2, StkId res) {
+void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1,
+                     const TValue *p2, StkId res) {
   ptrdiff_t result = savestack(L, res);
   StkId func = L->top;
   setobj2s(L, func, f);  /* push function (assume EXTRA_STACK) */
@@ -133,29 +133,19 @@ static void reallycallTMres (lua_State *L, const TValue *f, const TValue *p1,
 }
 
 
-void luaT_callTMres (lua_State *L, const TValue *f, const TValue *p1,
-                     const TValue *p2, StkId res) {
-  if (isLuacode(L->ci))
-    L->top = L->ci->top;  /* prepare top */
-  reallycallTMres(L, f, p1, p2, res);
-}
-
-
 static int callbinTM (lua_State *L, const TValue *p1, const TValue *p2,
                       StkId res, TMS event) {
   const TValue *tm = luaT_gettmbyobj(L, p1, event);  /* try first operand */
   if (ttisnil(tm))
     tm = luaT_gettmbyobj(L, p2, event);  /* try second operand */
   if (ttisnil(tm)) return 0;
-  reallycallTMres(L, tm, p1, p2, res);
+  luaT_callTMres(L, tm, p1, p2, res);
   return 1;
 }
 
 
 void luaT_trybinTM (lua_State *L, const TValue *p1, const TValue *p2,
                     StkId res, TMS event) {
-  if (event != TM_CONCAT && isLuacode(L->ci))
-    L->top = L->ci->top;  /* prepare top */
   if (!callbinTM(L, p1, p2, res, event)) {
     switch (event) {
       case TM_CONCAT:
@@ -195,8 +185,6 @@ void luaT_trybiniTM (lua_State *L, const TValue *p1, int i2,
 
 int luaT_callorderTM (lua_State *L, const TValue *p1, const TValue *p2,
                       TMS event) {
-  if (isLuacode(L->ci))
-    L->top = L->ci->top;  /* prepare top */
   if (callbinTM(L, p1, p2, L->top, event))  /* try original event */
     return !l_isfalse(s2v(L->top));
   else if (event == TM_LE) {

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 2.328 2017/12/20 14:58:05 roberto Exp roberto $
+** $Id: lvm.c,v 2.329 2017/12/22 14:16:46 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -464,8 +464,6 @@ int luaV_equalobj (lua_State *L, const TValue *t1, const TValue *t2) {
   }
   if (tm == NULL)  /* no TM? */
     return 0;  /* objects are different */
-  if (isLuacode(L->ci))
-    L->top = L->ci->top;  /* prepare top */
   luaT_callTMres(L, tm, t1, t2, L->top);  /* call TM */
   return !l_isfalse(s2v(L->top));
 }
@@ -780,20 +778,29 @@ void luaV_finishOp (lua_State *L) {
 #define donextjump(ci)	{ i = *pc; dojump(ci, i, 1); }
 
 /*
-** Whenever code can raise errors (including memory errors), the global
-** 'pc' must be correct to report occasional errors.
+** Correct global 'pc'.
 */
 #define savepc(L)	(ci->u.l.savedpc = pc)
 
 
+/*
+** Whenever code can raise errors, the global 'pc' and the global
+** 'top' must be correct to report occasional errors.
+*/
+#define savestate(L,ci)		(savepc(L), L->top = ci->top)
+
+
 /*
 ** Protect code that, in general, can raise errors, reallocate the
 ** stack, and change the hooks.
 */
-#define Protect(exp)  (savepc(L), (exp), updatetrap(ci))
+#define Protect(exp)  (savestate(L,ci), (exp), updatetrap(ci))
+
+/* special version that does not change the top */
+#define ProtectNT(exp)  (savepc(L), (exp), updatetrap(ci))
 
 /*
-** Protect code that will return.
+** Protect code that will finish the loop (returns).
 */
 #define halfProtect(exp)  (savepc(L), (exp))
 
@@ -842,6 +849,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
     vmfetch();
     lua_assert(base == ci->func + 1);
     lua_assert(base <= L->top && L->top < L->stack + L->stacksize);
+    lua_assert(ci->top < L->stack + L->stacksize);
     vmdispatch (GET_OPCODE(i)) {
       vmcase(OP_MOVE) {
         setobjs2s(L, ra, RB(i));
@@ -1000,10 +1008,11 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         int b = GETARG_B(i);
         int c = GETARG_C(i);
         Table *t;
-        t = luaH_new(L);
+        L->top = ci->top;  /* correct top in case of GC */
+        t = luaH_new(L);  /* memory allocation */
         sethvalue2s(L, ra, t);
         if (b != 0 || c != 0)
-          luaH_resize(L, t, luaO_fb2int(b), luaO_fb2int(c));
+          luaH_resize(L, t, luaO_fb2int(b), luaO_fb2int(c));  /* idem */
         checkGC(L, ra + 1);
         vmbreak;
       }
@@ -1371,7 +1380,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         int c = GETARG_C(i);
         StkId rb;
         L->top = base + c + 1;  /* mark the end of concat operands */
-        Protect(luaV_concat(L, c - b + 1));
+        ProtectNT(luaV_concat(L, c - b + 1));
         if (trap) {  /* 'luaV_concat' may move the stack */
           updatebase(ci);
           ra = RA(i);
@@ -1481,7 +1490,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         if (b != 0)  /* fixed number of arguments? */
           L->top = ra + b;  /* top signals number of arguments */
         /* else previous instruction set top */
-        Protect(luaD_call(L, ra, nresults));
+        ProtectNT(luaD_call(L, ra, nresults));
         vmbreak;
       }
       vmcase(OP_TAILCALL) {
@@ -1493,12 +1502,12 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         lua_assert(GETARG_C(i) - 1 == LUA_MULTRET);
         if (!ttisfunction(vra)) {  /* not a function? */
           /* try to get '__call' metamethod */
-          Protect(ra = luaD_tryfuncTM(L, ra));
+          ProtectNT(ra = luaD_tryfuncTM(L, ra));
           vra = s2v(ra);
           b++;  /* there is now one extra argument */
         }
         if (!ttisLclosure(vra)) {  /* C function? */
-          Protect(luaD_call(L, ra, LUA_MULTRET));  /* call it */
+          ProtectNT(luaD_call(L, ra, LUA_MULTRET));  /* call it */
           /* next instruction will do the return */
         }
         else {  /* tail call */
@@ -1568,7 +1577,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         lua_Integer ilimit, initv;
         int stopnow;
         if (!forlimit(plimit, &ilimit, 1, &stopnow)) {
-            savepc(L);  /* for the error message */
+            savestate(L, ci);  /* for the error message */
             luaG_runerror(L, "'for' limit must be a number");
         }
         initv = (stopnow ? 0 : ivalue(init));
@@ -1618,7 +1627,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         }
         else {  /* try making all values floats */
           lua_Number ninit; lua_Number nlimit; lua_Number nstep;
-          savepc(L);  /* in case of errors */
+          savestate(L, ci);  /* in case of errors */
           if (!tonumber(plimit, &nlimit))
             luaG_runerror(L, "'for' limit must be a number");
           setfltvalue(plimit, nlimit);
@@ -1659,7 +1668,10 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         int c = GETARG_C(i);
         unsigned int last;
         Table *h;
-        if (n == 0) n = cast_int(L->top - ra) - 1;
+        if (n == 0)
+          n = cast_int(L->top - ra) - 1;
+        else
+          L->top = ci->top;  /* correct top in case of GC */
         if (c == 0) {
           c = GETARG_Ax(*pc); pc++;
         }
@@ -1679,7 +1691,7 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         Proto *p = cl->p->p[GETARG_Bx(i)];
         LClosure *ncl = getcached(p, cl->upvals, base);  /* cached closure */
         if (ncl == NULL) {  /* no match? */
-          savepc(L);  /* in case of allocation errors */
+          savestate(L, ci);  /* in case of allocation errors */
           pushclosure(L, p, cl->upvals, base, ra);  /* create a new one */
         }
         else