First version of incremental GC

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.249 2003/10/20 17:42:41 roberto Exp roberto $
+** $Id: lapi.c,v 1.250 2003/12/01 18:22:56 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -193,7 +193,7 @@ LUA_API void lua_replace (lua_State *L, int idx) {
   api_checknelems(L, 1);
   o = luaA_index(L, idx);
   api_checkvalidindex(L, o);
-  setobj(o, L->top - 1);  /* write barrier */
+  setobj(o, L->top - 1);  /* write barrier???? */
   L->top--;
   lua_unlock(L);
 }
@@ -615,7 +615,8 @@ LUA_API void lua_rawset (lua_State *L, int idx) {
   api_checknelems(L, 2);
   t = luaA_index(L, idx);
   api_check(L, ttistable(t));
-  setobj2t(luaH_set(L, hvalue(t), L->top-2), L->top-1);  /* write barrier */
+  setobj2t(luaH_set(L, hvalue(t), L->top-2), L->top-1);
+  luaC_barrier(L, hvalue(t), L->top-1);
   L->top -= 2;
   lua_unlock(L);
 }
@@ -627,7 +628,8 @@ LUA_API void lua_rawseti (lua_State *L, int idx, int n) {
   api_checknelems(L, 1);
   o = luaA_index(L, idx);
   api_check(L, ttistable(o));
-  setobj2t(luaH_setnum(L, hvalue(o), n), L->top-1);  /* write barrier */
+  setobj2t(luaH_setnum(L, hvalue(o), n), L->top-1);
+  luaC_barrier(L, hvalue(o), L->top-1);
   L->top--;
   lua_unlock(L);
 }
@@ -649,11 +651,15 @@ LUA_API int lua_setmetatable (lua_State *L, int objindex) {
   }
   switch (ttype(obj)) {
     case LUA_TTABLE: {
-      hvalue(obj)->metatable = mt;  /* write barrier */
+      hvalue(obj)->metatable = mt;
+      if (mt)
+        luaC_objbarrier(L, hvalue(obj), mt);
       break;
     }
     case LUA_TUSERDATA: {
-      uvalue(obj)->uv.metatable = mt;  /* write barrier */
+      uvalue(obj)->uv.metatable = mt;
+      if (mt)
+        luaC_objbarrier(L, uvalue(obj), mt);
       break;
     }
     default: {
@@ -907,10 +913,8 @@ LUA_API void *lua_newuserdata (lua_State *L, size_t size) {
 
 
 
-static const char *aux_upvalue (lua_State *L, int funcindex, int n,
-                                TObject **val) {
+static const char *aux_upvalue (lua_State *L, StkId fi, int n, TObject **val) {
   Closure *f;
-  StkId fi = luaA_index(L, funcindex);
   if (!ttisfunction(fi)) return NULL;
   f = clvalue(fi);
   if (f->c.isC) {
@@ -931,7 +935,7 @@ LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {
   const char *name;
   TObject *val;
   lua_lock(L);
-  name = aux_upvalue(L, funcindex, n, &val);
+  name = aux_upvalue(L, luaA_index(L, funcindex), n, &val);
   if (name) {
     setobj2s(L->top, val);
     api_incr_top(L);
@@ -944,12 +948,15 @@ LUA_API const char *lua_getupvalue (lua_State *L, int funcindex, int n) {
 LUA_API const char *lua_setupvalue (lua_State *L, int funcindex, int n) {
   const char *name;
   TObject *val;
+  StkId fi;
   lua_lock(L);
+  fi = luaA_index(L, funcindex);
   api_checknelems(L, 1);
-  name = aux_upvalue(L, funcindex, n, &val);
+  name = aux_upvalue(L, fi, n, &val);
   if (name) {
     L->top--;
-    setobj(val, L->top);  /* write barrier */
+    setobj(val, L->top);
+    luaC_barrier(L, clvalue(fi), L->top);
   }
   lua_unlock(L);
   return name;

lcode.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lcode.c,v 1.119 2003/08/27 21:01:44 roberto Exp roberto $
+** $Id: lcode.c,v 1.120 2003/11/19 19:59:18 roberto Exp roberto $
 ** Code generator for Lua
 ** See Copyright Notice in lua.h
 */
@@ -14,6 +14,7 @@
 #include "lcode.h"
 #include "ldebug.h"
 #include "ldo.h"
+#include "lgc.h"
 #include "llex.h"
 #include "lmem.h"
 #include "lobject.h"
@@ -219,7 +220,8 @@ static int addk (FuncState *fs, TObject *k, TObject *v) {
     luaM_growvector(fs->L, f->k, fs->nk, f->sizek, TObject,
                     MAXARG_Bx, "constant table overflow");
     while (oldsize < f->sizek) setnilvalue(&f->k[oldsize++]);
-    setobj(&f->k[fs->nk], v);  /* write barrier */
+    setobj(&f->k[fs->nk], v);
+    luaC_barrier(fs->L, f, v);
     return fs->nk++;
   }
 }

lfunc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.c,v 1.72 2003/11/24 18:50:36 roberto Exp roberto $
+** $Id: lfunc.c,v 1.73 2003/12/03 20:03:07 roberto Exp roberto $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
@@ -68,7 +68,8 @@ UpVal *luaF_findupval (lua_State *L, StkId level) {
 void luaF_close (lua_State *L, StkId level) {
   UpVal *uv;
   while ((uv = ngcotouv(L->openupval)) != NULL && uv->v >= level) {
-    setobj(&uv->value, uv->v);  /* save current value (write barrier) */
+    setobj(&uv->value, uv->v);
+    luaC_barrier(L, uv, uv->v);
     uv->v = &uv->value;  /* now current value lives here */
     L->openupval = uv->next;  /* remove from `open' list */
     luaC_link(L, valtogco(uv), LUA_TUPVAL);

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.185 2003/12/04 17:22:42 roberto Exp roberto $
+** $Id: lgc.c,v 1.186 2003/12/04 18:52:23 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -25,12 +25,8 @@
 #define GCSTEPSIZE	(20*sizeof(TObject))
 
 
-#define otherwhite(g)	(g->currentwhite ^ bit2mask(WHITE0BIT, WHITE1BIT))
-
-#define isblack(x)	testbit((x)->gch.marked, BLACKBIT)
 #define gray2black(x)	setbit((x)->gch.marked, BLACKBIT)
 
-#define iswhite(x)	test2bits((x)->gch.marked, WHITE0BIT, WHITE1BIT)
 #define maskmarks \
 	cast(lu_byte, ~(bitmask(BLACKBIT)|bit2mask(WHITE0BIT, WHITE1BIT)))
 #define makewhite(g,x)	\
@@ -47,7 +43,6 @@
 #define markfinalized(u)	setbit((u)->uv.marked, FINALIZEDBIT)
 
 
-
 #define KEYWEAK         bitmask(KEYWEAKBIT)
 #define VALUEWEAK       bitmask(VALUEWEAKBIT)
 
@@ -110,7 +105,7 @@ static size_t objsize (GCObject *o) {
 
 static void reallymarkobject (global_State *g, GCObject *o) {
   lua_assert(iswhite(o));
-  lua_assert(!(o->gch.marked & otherwhite(g)));
+  lua_assert(!isdead(g, o));
   white2gray(o);
   switch (o->gch.tt) {
     case LUA_TSTRING: {
@@ -118,6 +113,7 @@ static void reallymarkobject (global_State *g, GCObject *o) {
     }
     case LUA_TUSERDATA: {
       Table *mt = gcotou(o)->uv.metatable;
+      gray2black(o);  /* udata are never gray */
       if (mt) markobject(g, mt);
       return;
     }
@@ -442,7 +438,6 @@ static GCObject **sweeplist (lua_State *L, GCObject **p, int all,
   int dead = otherwhite(g);
   while ((curr = *p) != NULL) {
     int mark = curr->gch.marked;
-    lua_assert(all || !(mark & g->currentwhite));
     lim -= objsize(curr);
     if (!all && (!(mark & dead) || testbit(mark, FIXEDBIT))) {
       makewhite(g, curr);
@@ -469,9 +464,9 @@ static l_mem sweepstrings (lua_State *L, int all, l_mem lim) {
     while ((curr = *p) != NULL) {
       int mark = curr->gch.marked;
       lu_mem size = sizestring(gcotots(curr)->tsv.len);
-      lua_assert(all || !(mark & g->currentwhite));
       if (!all && (!(mark & dead) || testbit(mark, FIXEDBIT))) {
         makewhite(g, curr);
+        lua_assert(iswhite(curr) && !isdead(g, curr));
         p = &curr->gch.next;
       }
       else {
@@ -499,8 +494,6 @@ static void checkSizes (lua_State *L) {
     size_t newsize = luaZ_sizebuffer(&g->buff) / 2;
     luaZ_resizebuffer(L, &g->buff, newsize);
   }
-  lua_assert(g->nblocks > g->GCthreshold);
-  g->GCthreshold = 2*G(L)->nblocks - g->GCthreshold;  /* new threshold */
 }
 
 
@@ -562,11 +555,13 @@ static void markroot (lua_State *L) {
 
 static void atomic (lua_State *L) {
   global_State *g = G(L);
+  /* there may be some gray elements due to the write barrier */
+  propagatemarks(g, MAXLMEM);  /* traverse them */
   lua_assert(g->gray == NULL);
   g->gray = g->grayagain;
   g->grayagain = NULL;
   propagatemarks(g, MAXLMEM);
-  g->GCthreshold = luaC_separateudata(L);  /* separate userdata to be preserved */
+  luaC_separateudata(L);  /* separate userdata to be preserved */
   marktmu(g);  /* mark `preserved' userdata */
   propagatemarks(g, MAXLMEM);  /* remark, to propagate `preserveness' */
   cleartable(g->weak);  /* remove collected objects from weak tables */
@@ -597,30 +592,48 @@ static void sweepstep (lua_State *L) {
   global_State *g = G(L);
   l_mem lim = GCSTEPSIZE;
   g->sweepgc = sweeplist(L, g->sweepgc, 0, &lim);
-  if (lim == GCSTEPSIZE)  /* nothing more to sweep? */
+  if (lim == GCSTEPSIZE) {  /* nothing more to sweep? */
     g->gcstate = GCSfinalize;  /* end sweep phase */
+    checkSizes(L);
+  }
 }
 
 
-void luaC_collectgarbage (lua_State *L) {
+void luaC_step (lua_State *L) {
   global_State *g = G(L);
-  /* GCSroot */
-  markroot(L);
-  /* GCSpropagate */
-  while (g->gcstate == GCSpropagate)
-    propagatemarks(g, GCSTEPSIZE);
-  /* atomic */
-  atomic(L);
-  /* GCSsweepstring */
-  while (g->gcstate == GCSsweepstring)
-    sweepstringstep(L);
-  /* GCSsweep */
-  while (g->gcstate == GCSsweep)
-    sweepstep(L);
-  /* GCSfinalize */
-  checkSizes(L);
-  while (g->gcstate == GCSfinalize)
-    GCTM(L);
+  switch (g->gcstate) {
+    case GCSroot:
+      markroot(L);
+      break;
+    case GCSpropagate:
+      propagatemarks(g, GCSTEPSIZE);
+      break;
+    case GCSatomic:
+      atomic(L);
+      break;
+    case GCSsweepstring:
+      sweepstringstep(L);
+      break;
+    case GCSsweep:
+      sweepstep(L);
+      break;
+    case GCSfinalize:
+      GCTM(L);
+      break;
+    default: lua_assert(0);
+  }
+  g->GCthreshold = g->nblocks + GCSTEPSIZE;
+}
+
+
+void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v) {
+  global_State *g = G(L);
+  lua_assert(isblack(o) && iswhite(v));
+  lua_assert(!isdead(g, v) && !isdead(g, o));
+  if (g->gcstate > GCSatomic)  /* sweeping phases? */
+    black2gray(o);  /* just mark as gray to avoid other barriers */
+  else  /* breaking invariant! */
+    reallymarkobject(g, v);  /* restore it */
 }
 
 

lgc.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.h,v 1.26 2003/12/03 20:03:07 roberto Exp roberto $
+** $Id: lgc.h,v 1.27 2003/12/04 17:22:42 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -58,18 +58,37 @@
 #define FIXEDBIT	5
 
 
+#define iswhite(x)      test2bits((x)->gch.marked, WHITE0BIT, WHITE1BIT)
+#define isblack(x)      testbit((x)->gch.marked, BLACKBIT)
+
+
+#define otherwhite(g)	(g->currentwhite ^ bit2mask(WHITE0BIT, WHITE1BIT))
+#define isdead(g,v)	((v)->gch.marked & otherwhite(g))
+
+#define changewhite(x)	((x)->gch.marked ^= bit2mask(WHITE0BIT, WHITE1BIT))
+
+#define valiswhite(x)	(iscollectable(x) && iswhite(gcvalue(x)))
+
 #define luaC_white(g)	cast(lu_byte, (g)->currentwhite)
 
 
 #define luaC_checkGC(L) { if (G(L)->nblocks >= G(L)->GCthreshold) \
-	luaC_collectgarbage(L); }
+	luaC_step(L); }
+
+
+#define luaC_barrier(L,p,v) { if (valiswhite(v) && isblack(valtogco(p)))  \
+	luaC_barrierf(L,valtogco(p),gcvalue(v)); }
 
+#define luaC_objbarrier(L,p,o)  \
+	{ if (iswhite(valtogco(o)) && isblack(valtogco(p))) \
+		luaC_barrierf(L,valtogco(p),valtogco(o)); }
 
 size_t luaC_separateudata (lua_State *L);
 void luaC_callGCTM (lua_State *L);
 void luaC_sweepall (lua_State *L);
-void luaC_collectgarbage (lua_State *L);
+void luaC_step (lua_State *L);
 void luaC_link (lua_State *L, GCObject *o, lu_byte tt);
+void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v);
 
 
 #endif

lparser.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lparser.c,v 1.220 2003/10/03 16:04:24 roberto Exp roberto $
+** $Id: lparser.c,v 1.221 2003/10/09 17:56:23 roberto Exp roberto $
 ** Lua Parser
 ** See Copyright Notice in lua.h
 */
@@ -151,7 +151,8 @@ static int luaI_registerlocalvar (LexState *ls, TString *varname) {
   luaM_growvector(ls->L, f->locvars, fs->nlocvars, f->sizelocvars,
                   LocVar, USHRT_MAX, "too many local variables");
   while (oldsize < f->sizelocvars) f->locvars[oldsize++].varname = NULL;
-  f->locvars[fs->nlocvars].varname = varname;  /* write barrier */
+  f->locvars[fs->nlocvars].varname = varname;
+  luaC_objbarrier(ls->L, f, varname);
   return fs->nlocvars++;
 }
 
@@ -199,7 +200,8 @@ static int indexupvalue (FuncState *fs, TString *name, expdesc *v) {
   luaM_growvector(fs->L, f->upvalues, f->nups, f->sizeupvalues,
                   TString *, MAX_INT, "");
   while (oldsize < f->sizeupvalues) f->upvalues[oldsize++] = NULL;
-  f->upvalues[f->nups] = name;  /* write barrier */
+  f->upvalues[f->nups] = name;
+  luaC_objbarrier(fs->L, f, name);
   lua_assert(v->k == VLOCAL || v->k == VUPVAL);
   fs->upvalues[f->nups].k = cast(lu_byte, v->k);
   fs->upvalues[f->nups].info = cast(lu_byte, v->info);
@@ -307,7 +309,8 @@ static void pushclosure (LexState *ls, FuncState *func, expdesc *v) {
   luaM_growvector(ls->L, f->p, fs->np, f->sizep, Proto *,
                   MAXARG_Bx, "constant table overflow");
   while (oldsize < f->sizep) f->p[oldsize++] = NULL;
-  f->p[fs->np++] = func->f;  /* write barrier */
+  f->p[fs->np++] = func->f;
+  luaC_objbarrier(ls->L, f, func->f);
   init_exp(v, VRELOCABLE, luaK_codeABx(fs, OP_CLOSURE, 0, fs->np-1));
   for (i=0; i<func->f->nups; i++) {
     OpCode o = (func->upvalues[i].k == VLOCAL) ? OP_MOVE : OP_GETUPVAL;

lstring.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstring.c,v 1.83 2003/12/03 20:03:07 roberto Exp roberto $
+** $Id: lstring.c,v 1.84 2003/12/04 17:22:42 roberto Exp roberto $
 ** String table (keeps all strings handled by Lua)
 ** See Copyright Notice in lua.h
 */
@@ -84,8 +84,11 @@ TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
        o != NULL;
        o = o->gch.next) {
     TString *ts = gcotots(o);
-    if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0))
+    if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0)) {
+      /* string may be dead */
+      if (isdead(G(L), o)) changewhite(o);
       return ts;
+    }
   }
   return newlstr(L, str, l, h);  /* not found */
 }

ltable.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 1.136 2003/11/27 18:05:14 roberto Exp roberto $
+** $Id: ltable.c,v 1.137 2003/12/01 18:22:56 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -398,7 +398,8 @@ static TObject *newkey (lua_State *L, Table *t, const TObject *key) {
       mp = n;
     }
   }
-  setobj2t(gkey(mp), key);  /* write barrier */
+  setobj2t(gkey(mp), key);
+  luaC_barrier(L, t, key);
   lua_assert(ttisnil(gval(mp)));
   for (;;) {  /* correct `firstfree' */
     if (ttisnil(gkey(t->firstfree)))

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.289 2003/07/16 20:49:02 roberto Exp roberto $
+** $Id: lvm.c,v 1.290 2003/10/27 19:14:31 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -151,7 +151,8 @@ void luaV_settable (lua_State *L, const TObject *t, TObject *key, StkId val) {
       TObject *oldval = luaH_set(L, h, key); /* do a primitive set */
       if (!ttisnil(oldval) ||  /* result is no nil? */
           (tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */
-        setobj2t(oldval, val);  /* write barrier */
+        setobj2t(oldval, val);
+        luaC_barrier(L, h, val);
         return;
       }
       /* else will try the tag method */
@@ -454,8 +455,9 @@ StkId luaV_execute (lua_State *L, int nexeccalls) {
         break;
       }
       case OP_SETUPVAL: {
-        int b = GETARG_B(i);
-        setobj(cl->upvals[b]->v, ra);  /* write barrier */
+        UpVal *uv = cl->upvals[GETARG_B(i)];
+        setobj(uv->v, ra);
+        luaC_barrier(L, uv, ra);
         break;
       }
       case OP_SETTABLE: {
@@ -713,8 +715,11 @@ StkId luaV_execute (lua_State *L, int nexeccalls) {
           L->top = L->ci->top;
         }
         bc &= ~(LFIELDS_PER_FLUSH-1);  /* bc = bc - bc%FPF */
-        for (; n > 0; n--)
-          setobj2t(luaH_setnum(L, h, bc+n), ra+n);  /* write barrier */
+        for (; n > 0; n--) {
+          TObject *val = ra+n;
+          setobj2t(luaH_setnum(L, h, bc+n), val);
+          luaC_barrier(L, h, val);
+        }
         break;
       }
       case OP_CLOSE: {