Re: PATCH: fixes bug with calling garbage collector from custom lua_Alloc

["Robert G. Jakabosky" <bobby@...>]

Updated patch 'emergency_gc-5.1.3.patch' attached.  Also I have started a wiki 
page for this patch:
http://lua-users.org/wiki/EmergencyGarbageCollector

That page has a link to the latest patch and test lua_memlimit.c program.

On Monday 05, Robert G. Jakabosky wrote:
> On Monday 05, Bogdan Marinescu wrote:
> > important to you, this is definetely the way to go. But it still has
> > some bugs, as can be seen from the table ('factorial.lua' doesn't run
> > in 'a' mode). According to Robert, this happens because his patch
> > doesn't yet handle closures.
>
> Right now I am having a lot of problems with the upvalues for closures
> being collected when they should be.  Fixing closures will make the patch
> much more complex.
Closures are fixed now.  'factorial.lua' and 'sieve.lua' both work now.  The 
code changes need to fix closures turned out to be much simpler then I 
though.  I was just making things way to complex.

This new patch adds a flag field to global_State.  The flag is used to protect 
luaC_step & luaC_fullgc from recursive calls.  There was going to be more 
then one flag, but it turned out they were not needed.

-- 
Robert G. Jakabosky

diff --git a/src/lapi.c b/src/lapi.c
index 9a39513..24e6675 100644
--- a/src/lapi.c
+++ b/src/lapi.c
@@ -656,14 +656,14 @@ LUA_API void lua_settable (lua_State *L, int idx) {
 
 LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {
   StkId t;
-  TValue key;
   lua_lock(L);
   api_checknelems(L, 1);
   t = index2adr(L, idx);
   api_checkvalidindex(L, t);
-  setsvalue(L, &key, luaS_new(L, k));
-  luaV_settable(L, t, &key, L->top - 1);
-  L->top--;  /* pop value */
+  setsvalue2s(L, L->top, luaS_new(L, k));
+  api_incr_top(L);
+  luaV_settable(L, t, L->top - 1, L->top - 2);
+  L->top -= 2;  /* pop key and value */
   lua_unlock(L);
 }
 
@@ -903,11 +903,11 @@ LUA_API int lua_gc (lua_State *L, int what, int data) {
   g = G(L);
   switch (what) {
     case LUA_GCSTOP: {
-      g->GCthreshold = MAX_LUMEM;
+      set_block_gc(L);
       break;
     }
     case LUA_GCRESTART: {
-      g->GCthreshold = g->totalbytes;
+      unset_block_gc(L);
       break;
     }
     case LUA_GCCOLLECT: {
@@ -924,6 +924,7 @@ LUA_API int lua_gc (lua_State *L, int what, int data) {
       break;
     }
     case LUA_GCSTEP: {
+      if(is_block_gc(L)) break;
       lu_mem a = (cast(lu_mem, data) << 10);
       if (a <= g->totalbytes)
         g->GCthreshold = g->totalbytes - a;
diff --git a/src/ldo.c b/src/ldo.c
index 8de05f7..4c32b93 100644
--- a/src/ldo.c
+++ b/src/ldo.c
@@ -494,6 +494,7 @@ static void f_parser (lua_State *L, void *ud) {
   struct SParser *p = cast(struct SParser *, ud);
   int c = luaZ_lookahead(p->z);
   luaC_checkGC(L);
+  set_block_gc(L);  /* stop collector during parsing */
   tf = ((c == LUA_SIGNATURE[0]) ? luaU_undump : luaY_parser)(L, p->z,
                                                              &p->buff, p->name);
   cl = luaF_newLclosure(L, tf->nups, hvalue(gt(L)));
@@ -502,6 +503,7 @@ static void f_parser (lua_State *L, void *ud) {
     cl->l.upvals[i] = luaF_newupval(L);
   setclvalue(L, L->top, cl);
   incr_top(L);
+  unset_block_gc(L);
 }
 
 
diff --git a/src/lgc.c b/src/lgc.c
index d9e0b78..11f3876 100644
--- a/src/lgc.c
+++ b/src/lgc.c
@@ -232,8 +232,10 @@ static void traverseclosure (global_State *g, Closure *cl) {
     int i;
     lua_assert(cl->l.nupvalues == cl->l.p->nups);
     markobject(g, cl->l.p);
-    for (i=0; i<cl->l.nupvalues; i++)  /* mark its upvalues */
-      markobject(g, cl->l.upvals[i]);
+    for (i=0; i<cl->l.nupvalues; i++) { /* mark its upvalues */
+      if(cl->l.upvals[i])
+        markobject(g, cl->l.upvals[i]);
+    }
   }
 }
 
@@ -258,6 +260,7 @@ static void traversestack (global_State *g, lua_State *l) {
   CallInfo *ci;
   markvalue(g, gt(l));
   lim = l->top;
+  if(l->stack == NULL) return; /* no stack to traverse */
   for (ci = l->base_ci; ci <= l->ci; ci++) {
     lua_assert(ci->top <= l->stack_last);
     if (lim < ci->top) lim = ci->top;
@@ -419,8 +422,6 @@ static GCObject **sweeplist (lua_State *L, GCObject **p, lu_mem count) {
     else {  /* must erase `curr' */
       lua_assert(isdead(g, curr) || deadmask == bitmask(SFIXEDBIT));
       *p = curr->gch.next;
-      if (curr == g->rootgc)  /* is the first element of the list? */
-        g->rootgc = curr->gch.next;  /* adjust first */
       freeobj(L, curr);
     }
   }
@@ -437,7 +438,10 @@ static void checkSizes (lua_State *L) {
   /* check size of buffer */
   if (luaZ_sizebuffer(&g->buff) > LUA_MINBUFFER*2) {  /* buffer too big? */
     size_t newsize = luaZ_sizebuffer(&g->buff) / 2;
-    luaZ_resizebuffer(L, &g->buff, newsize);
+    /* make sure newsize is larger then the buffer's in use size. */
+    newsize = (luaZ_bufflen(&g->buff) > newsize) ? luaZ_bufflen(&g->buff) : newsize;
+    if(newsize < luaZ_sizebuffer(&g->buff))
+      luaZ_resizebuffer(L, &g->buff, newsize);
   }
 }
 
@@ -609,6 +613,8 @@ static l_mem singlestep (lua_State *L) {
 
 void luaC_step (lua_State *L) {
   global_State *g = G(L);
+  if(is_block_gc(L)) return;
+  set_block_gc(L);
   l_mem lim = (GCSTEPSIZE/100) * g->gcstepmul;
   if (lim == 0)
     lim = (MAX_LUMEM-1)/2;  /* no limit */
@@ -630,11 +636,14 @@ void luaC_step (lua_State *L) {
     lua_assert(g->totalbytes >= g->estimate);
     setthreshold(g);
   }
+  unset_block_gc(L);
 }
 
 
 void luaC_fullgc (lua_State *L) {
   global_State *g = G(L);
+  if(is_block_gc(L)) return;
+  set_block_gc(L);
   if (g->gcstate <= GCSpropagate) {
     /* reset sweep marks to sweep all elements (returning them to white) */
     g->sweepstrgc = 0;
@@ -656,6 +665,7 @@ void luaC_fullgc (lua_State *L) {
     singlestep(L);
   }
   setthreshold(g);
+  unset_block_gc(L);
 }
 
 
diff --git a/src/lgc.h b/src/lgc.h
index 5a8dc60..cae6117 100644
--- a/src/lgc.h
+++ b/src/lgc.h
@@ -37,6 +37,18 @@
 #define test2bits(x,b1,b2)	testbits(x, (bit2mask(b1, b2)))
 
 
+/*
+** Possible Garbage Collector flags.
+** Layout for bit use in 'gsflags' field in global_State structure.
+** bit 0 - Protect GC from recursive calls.
+*/
+#define GCFlagsNone		0
+#define GCBlockGCBit	0
+
+
+#define is_block_gc(L) testbit(G(L)->gcflags, GCBlockGCBit)
+#define set_block_gc(L) l_setbit(G(L)->gcflags, GCBlockGCBit)
+#define unset_block_gc(L) resetbit(G(L)->gcflags, GCBlockGCBit)
 
 /*
 ** Layout for bit use in `marked' field:
diff --git a/src/lstate.c b/src/lstate.c
index 4313b83..2be54a7 100644
--- a/src/lstate.c
+++ b/src/lstate.c
@@ -119,6 +119,8 @@ static void close_state (lua_State *L) {
 lua_State *luaE_newthread (lua_State *L) {
   lua_State *L1 = tostate(luaM_malloc(L, state_size(lua_State)));
   luaC_link(L, obj2gco(L1), LUA_TTHREAD);
+  setthvalue(L, L->top, L1); /* put thread on stack */
+  incr_top(L);
   preinit_state(L1, G(L));
   stack_init(L1, L);  /* init stack */
   setobj2n(L, gt(L1), gt(L));  /* share table of globals */
@@ -127,6 +129,7 @@ lua_State *luaE_newthread (lua_State *L) {
   L1->hook = L->hook;
   resethookcount(L1);
   lua_assert(iswhite(obj2gco(L1)));
+  L->top--; /* remove thread from stack */
   return L1;
 }
 
@@ -167,6 +170,7 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   luaZ_initbuffer(L, &g->buff);
   g->panic = NULL;
   g->gcstate = GCSpause;
+  g->gcflags = GCFlagsNone;
   g->rootgc = obj2gco(L);
   g->sweepstrgc = 0;
   g->sweepgc = &g->rootgc;
diff --git a/src/lstate.h b/src/lstate.h
index 3bc575b..9de3195 100644
--- a/src/lstate.h
+++ b/src/lstate.h
@@ -71,6 +71,7 @@ typedef struct global_State {
   void *ud;         /* auxiliary data to `frealloc' */
   lu_byte currentwhite;
   lu_byte gcstate;  /* state of garbage collector */
+  lu_byte gcflags;  /* flags for the garbage collector */
   int sweepstrgc;  /* position of sweep in `strt' */
   GCObject *rootgc;  /* list of all collectable objects */
   GCObject **sweepgc;  /* position of sweep in `rootgc' */
diff --git a/src/lstring.c b/src/lstring.c
index 4911315..a84cfab 100644
--- a/src/lstring.c
+++ b/src/lstring.c
@@ -53,6 +53,9 @@ static TString *newlstr (lua_State *L, const char *str, size_t l,
   stringtable *tb;
   if (l+1 > (MAX_SIZET - sizeof(TString))/sizeof(char))
     luaM_toobig(L);
+  tb = &G(L)->strt;
+  if ((tb->nuse + 1) > cast(lu_int32, tb->size) && tb->size <= MAX_INT/2)
+    luaS_resize(L, tb->size*2);  /* too crowded */
   ts = cast(TString *, luaM_malloc(L, (l+1)*sizeof(char)+sizeof(TString)));
   ts->tsv.len = l;
   ts->tsv.hash = h;
@@ -61,13 +64,10 @@ static TString *newlstr (lua_State *L, const char *str, size_t l,
   ts->tsv.reserved = 0;
   memcpy(ts+1, str, l*sizeof(char));
   ((char *)(ts+1))[l] = '\0';  /* ending 0 */
-  tb = &G(L)->strt;
   h = lmod(h, tb->size);
   ts->tsv.next = tb->hash[h];  /* chain new entry */
   tb->hash[h] = obj2gco(ts);
   tb->nuse++;
-  if (tb->nuse > cast(lu_int32, tb->size) && tb->size <= MAX_INT/2)
-    luaS_resize(L, tb->size*2);  /* too crowded */
   return ts;
 }
 
diff --git a/src/ltable.c b/src/ltable.c
index ec84f4f..31162fe 100644
--- a/src/ltable.c
+++ b/src/ltable.c
@@ -358,6 +358,8 @@ static void rehash (lua_State *L, Table *t, const TValue *ek) {
 Table *luaH_new (lua_State *L, int narray, int nhash) {
   Table *t = luaM_new(L, Table);
   luaC_link(L, obj2gco(t), LUA_TTABLE);
+  sethvalue2s(L, L->top, t); /* put table on stack */
+  incr_top(L);
   t->metatable = NULL;
   t->flags = cast_byte(~0);
   /* temporary values (kept only if some malloc fails) */
@@ -367,6 +369,7 @@ Table *luaH_new (lua_State *L, int narray, int nhash) {
   t->node = cast(Node *, dummynode);
   setarrayvector(L, t, narray);
   setnodevector(L, t, nhash);
+  L->top--; /* remove table from stack */
   return t;
 }
 
diff --git a/src/lvm.c b/src/lvm.c
index ee3256a..8b5085b 100644
--- a/src/lvm.c
+++ b/src/lvm.c
@@ -295,6 +295,7 @@ void luaV_concat (lua_State *L, int total, int last) {
         if (l >= MAX_SIZET - tl) luaG_runerror(L, "string length overflow");
         tl += l;
       }
+      G(L)->buff.n = tl;
       buffer = luaZ_openspace(L, &G(L)->buff, tl);
       tl = 0;
       for (i=n; i>0; i--) {  /* concat all strings */
@@ -303,6 +304,7 @@ void luaV_concat (lua_State *L, int total, int last) {
         tl += l;
       }
       setsvalue2s(L, top-n, luaS_newlstr(L, buffer, tl));
+      luaZ_resetbuffer(&G(L)->buff);
     }
     total -= n-1;  /* got `n' strings to create 1 new */
     last -= n-1;
@@ -723,6 +725,7 @@ void luaV_execute (lua_State *L, int nexeccalls) {
         p = cl->p->p[GETARG_Bx(i)];
         nup = p->nups;
         ncl = luaF_newLclosure(L, nup, cl->env);
+        setclvalue(L, ra, ncl);
         ncl->l.p = p;
         for (j=0; j<nup; j++, pc++) {
           if (GET_OPCODE(*pc) == OP_GETUPVAL)
@@ -732,7 +735,6 @@ void luaV_execute (lua_State *L, int nexeccalls) {
             ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc));
           }
         }
-        setclvalue(L, ra, ncl);
         Protect(luaC_checkGC(L));
         continue;
       }