5 files changed, 216 insertions, 76 deletions

diff --git a/lgc.c b/lgc.c
index b60b9d3a..cb9fa289 100644
--- a/lgc.c
+++ b/lgc.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.179 2003/11/18 14:55:11 roberto Exp roberto $
+** $Id: lgc.c,v 1.180 2003/11/19 19:41:57 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -22,6 +22,9 @@
 #include "ltm.h"
 
 
+#define GCSTEPSIZE      (20*sizeof(TObject))
+
+
 
 #define isblack(x)      testbit((x)->gch.marked, BLACKBIT)
 #define gray2black(x)   ((x)->gch.marked++)
@@ -40,6 +43,9 @@
 #define markfinalized(u)        setbit((u)->uv.marked, FINALIZEDBIT)
 
 
+#define maskbf  bit2mask(BLACKBIT, FIXEDBIT)
+
+
 #define KEYWEAK         bitmask(KEYWEAKBIT)
 #define VALUEWEAK       bitmask(VALUEWEAKBIT)
 
@@ -57,6 +63,49 @@
 
 
 
+/*
+** computes the size of a collectible object
+*/
+static size_t objsize (GCObject *o) {
+  switch (o->gch.tt) {
+    case LUA_TSTRING: {
+      TString *ts = gcotots(o);
+      return sizestring(ts->tsv.len);
+    }
+    case LUA_TUSERDATA: {
+      Udata *u = gcotou(o);
+      return sizeudata(u->uv.len);
+    }
+    case LUA_TTABLE: {
+      Table *h = gcotoh(o);
+      return sizeof(Table) + sizeof(TObject) * h->sizearray +
+                             sizeof(Node) * sizenode(h);
+    }
+    case LUA_TUPVAL:
+      return sizeof(UpVal);
+    case LUA_TFUNCTION: {
+      Closure *cl = gcotocl(o);
+      return (cl->c.isC) ? sizeCclosure(cl->c.nupvalues) :
+                           sizeLclosure(cl->l.nupvalues);
+    }
+    case LUA_TTHREAD: {
+      lua_State *th = gcototh(o);
+      return sizeof(lua_State) + sizeof(TObject) * th->stacksize +
+             sizeof(CallInfo) * th->size_ci;
+    }
+    case LUA_TPROTO: {
+      Proto *p = gcotop(o);
+      return sizeof(Proto) + sizeof(Instruction) * p->sizecode +
+             sizeof(Proto *) * p->sizep + sizeof(TObject) * p->sizek + 
+             sizeof(int) * p->sizelineinfo + sizeof(LocVar) * p->sizelocvars +
+             sizeof(TString *) * p->sizeupvalues;
+    }
+  }
+  lua_assert(0);
+  return 0;  /* to avoid warnings */
+}
+
+
 static void reallymarkobject (global_State *g, GCObject *o) {
   lua_assert(iswhite(o));
   switch (o->gch.tt) {
@@ -248,44 +297,53 @@ static void traversestack (global_State *g, lua_State *L1) {
 }
 
 
-static void propagatemarks (global_State *g) {
-  while (g->gray) {  /* traverse marked objects */
-    lua_assert(isgray(g->gray));
-    gray2black(g->gray);
-    switch (g->gray->gch.tt) {
+/*
+** traverse a given `quantity' of gray objects,
+** turning them to black. Returns extra `quantity' traversed.
+*/
+static l_mem propagatemarks (global_State *g, l_mem lim) {
+  GCObject *o;
+  while ((o = g->gray) != NULL) {
+    lua_assert(isgray(o));
+    gray2black(o);
+    switch (o->gch.tt) {
       case LUA_TTABLE: {
-        Table *h = gcotoh(g->gray);
+        Table *h = gcotoh(o);
         g->gray = h->gclist;
         traversetable(g, h);
         break;
       }
       case LUA_TFUNCTION: {
-        Closure *cl = gcotocl(g->gray);
+        Closure *cl = gcotocl(o);
         g->gray = cl->c.gclist;
         traverseclosure(g, cl);
         break;
       }
       case LUA_TTHREAD: {
-        lua_State *th = gcototh(g->gray);
+        lua_State *th = gcototh(o);
         g->gray = th->gclist;
         traversestack(g, th);
         break;
       }
       case LUA_TPROTO: {
-        Proto *p = gcotop(g->gray);
+        Proto *p = gcotop(o);
         g->gray = p->gclist;
         traverseproto(g, p);
         break;
       }
       case LUA_TUPVAL: {
-        UpVal *uv = gcotouv(g->gray);
+        UpVal *uv = gcotouv(o);
         g->gray = uv->gclist;
         markvalue(g, &uv->value);
         break;
       }
       default: lua_assert(0);
     }
+    lim -= objsize(o);
+    if (lim <= 0) return lim;
   }
+  g->gcstate = GCSatomic;
+  return lim;
 }
 
 
@@ -366,116 +424,164 @@ static void freeobj (lua_State *L, GCObject *o) {
 }
 
 
-static int sweeplist (lua_State *L, GCObject **p, int mask) {
+static GCObject **sweeplist (lua_State *L, GCObject **p, int mask,
+                             l_mem *plim) {
   GCObject *curr;
-  int count = 0;  /* number of collected items */
+  l_mem lim = *plim;
   while ((curr = *p) != NULL) {
     lua_assert(!isgray(curr));
     if (curr->gch.marked & mask) {
+      lim -= objsize(curr);
       makewhite(curr);
       p = &curr->gch.next;
     }
     else {
-      count++;
       *p = curr->gch.next;
       freeobj(L, curr);
     }
+    if (lim <= 0) break;
   }
-  return count;
+  *plim = lim;
+  return p;
 }
 
 
 static void sweepstrings (lua_State *L, int mask) {
   int i;
-  for (i=0; i<G(L)->strt.size; i++) {  /* for each list */
-    G(L)->strt.nuse -= sweeplist(L, &G(L)->strt.hash[i], mask);
+  global_State *g = G(L);
+  for (i = 0; i < g->strt.size; i++) {  /* for each list */
+    GCObject *curr;
+    GCObject **p = &G(L)->strt.hash[i];
+    while ((curr = *p) != NULL) {
+      lua_assert(!isgray(curr) && curr->gch.tt == LUA_TSTRING);
+      if (curr->gch.marked & mask) {
+        makewhite(curr);
+        p = &curr->gch.next;
+      }
+      else {
+        g->strt.nuse--;
+        *p = curr->gch.next;
+        luaM_free(L, curr, sizestring(gcotots(curr)->tsv.len));
+      }
+    }
   }
 }
 
 
-static void checkSizes (lua_State *L, size_t deadmem) {
+static void checkSizes (lua_State *L) {
+  global_State *g = G(L);
   /* check size of string hash */
-  if (G(L)->strt.nuse < cast(lu_int32, G(L)->strt.size/4) &&
-      G(L)->strt.size > MINSTRTABSIZE*2)
-    luaS_resize(L, G(L)->strt.size/2);  /* table is too big */
+  if (g->strt.nuse < cast(lu_int32, G(L)->strt.size/4) &&
+      g->strt.size > MINSTRTABSIZE*2)
+    luaS_resize(L, g->strt.size/2);  /* table is too big */
   /* check size of buffer */
-  if (luaZ_sizebuffer(&G(L)->buff) > LUA_MINBUFFER*2) {  /* buffer too big? */
-    size_t newsize = luaZ_sizebuffer(&G(L)->buff) / 2;
-    luaZ_resizebuffer(L, &G(L)->buff, newsize);
+  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);
   }
-  lua_assert(G(L)->nblocks > deadmem);
-  G(L)->GCthreshold = 2*G(L)->nblocks - deadmem;  /* new threshold */
+  lua_assert(g->nblocks > g->GCthreshold);
+  g->GCthreshold = 2*G(L)->nblocks - g->GCthreshold;  /* new threshold */
 }
 
 
-static void do1gcTM (lua_State *L, Udata *udata) {
-  const TObject *tm = fasttm(L, udata->uv.metatable, TM_GC);
-  if (tm != NULL) {
-    setobj2s(L->top, tm);
-    setuvalue(L->top+1, udata);
-    L->top += 2;
-    luaD_call(L, L->top - 2, 0);
+static void GCTM (lua_State *L) {
+  global_State *g = G(L);
+  if (g->tmudata == NULL)
+    g->gcstate = GCSroot;  /* will restart GC */
+  else {
+    GCObject *o = g->tmudata;
+    Udata *udata = gcotou(o);
+    const TObject *tm;
+    g->tmudata = udata->uv.next;  /* remove udata from `tmudata' */
+    udata->uv.next = g->rootudata;  /* return it to `root' list */
+    g->rootudata = o;
+    makewhite(o);
+    tm = fasttm(L, udata->uv.metatable, TM_GC);
+    if (tm != NULL) {
+      lu_byte oldah = L->allowhook;
+      L->allowhook = 0;  /* stop debug hooks during GC tag method */
+      setobj2s(L->top, tm);
+      setuvalue(L->top+1, udata);
+      L->top += 2;
+      luaD_call(L, L->top - 2, 0);
+      L->allowhook = oldah;  /* restore hooks */
+    }
   }
 }
 
 
+/*
+** Call all GC tag methods
+*/
 void luaC_callGCTM (lua_State *L) {
-  lu_byte oldah = L->allowhook;
-  L->allowhook = 0;  /* stop debug hooks during GC tag methods */
-  L->top++;  /* reserve space to keep udata while runs its gc method */
-  while (G(L)->tmudata != NULL) {
-    GCObject *o = G(L)->tmudata;
-    Udata *udata = gcotou(o);
-    G(L)->tmudata = udata->uv.next;  /* remove udata from `tmudata' */
-    udata->uv.next = G(L)->rootudata;  /* return it to `root' list */
-    G(L)->rootudata = o;
-    setuvalue(L->top - 1, udata);  /* keep a reference to it */
-    makewhite(o);
-    do1gcTM(L, udata);
-  }
-  L->top--;
-  L->allowhook = oldah;  /* restore hooks */
+  while (G(L)->tmudata)
+    GCTM(L);
 }
 
 
-void luaC_sweep (lua_State *L, int all) {
-  int mask = (all) ? 0 : bit2mask(BLACKBIT, FIXEDBIT);
-  sweeplist(L, &G(L)->rootudata, mask);
-  sweepstrings(L, mask);
-  sweeplist(L, &G(L)->rootgc, mask);
+void luaC_sweepall (lua_State *L) {
+  l_mem dummy = MAXLMEM;
+  sweepstrings(L, 0);
+  sweeplist(L, &G(L)->rootudata, 0, &dummy);
+  sweeplist(L, &G(L)->rootgc, 0, &dummy);
 }
 
 
 /* mark root set */
-static void markroot (global_State *g, lua_State *L) {
+static void markroot (lua_State *L) {
+  global_State *g = G(L);
+  lua_assert(g->gray == NULL);
+  g->weak = NULL;
+  makewhite(valtogco(g->mainthread));
+  markobject(g, g->mainthread);
   markvalue(g, defaultmeta(L));
   markvalue(g, registry(L));
-  traversestack(g, g->mainthread);
   if (L != g->mainthread)  /* another thread is running? */
     markobject(g, L);  /* cannot collect it */
+  g->gcstate = GCSpropagate;
 }
 
 
-static size_t mark (lua_State *L) {
-  size_t deadmem;
+static void atomic (lua_State *L) {
   global_State *g = G(L);
-  lua_assert(g->gray == NULL);
-  g->weak = NULL;
-  markroot(g, L);
-  propagatemarks(g);  /* mark all reachable objects */
-  deadmem = luaC_separateudata(L);  /* separate userdata to be preserved */
+  g->GCthreshold = luaC_separateudata(L);  /* separate userdata to be preserved */
   marktmu(g);  /* mark `preserved' userdata */
-  propagatemarks(g);  /* remark, to propagate `preserveness' */
+  propagatemarks(g, MAXLMEM);  /* remark, to propagate `preserveness' */
   cleartable(g->weak);  /* remove collected objects from weak tables */
-  return deadmem;
+  g->sweepgc = &g->rootgc;
+  g->sweepudata = &g->rootudata;
+  sweepstrings(L, maskbf);
+  g->gcstate = GCSsweep;
+}
+
+
+static void sweepstep (lua_State *L) {
+  global_State *g = G(L);
+  l_mem lim = GCSTEPSIZE;
+  g->sweepudata = sweeplist(L, g->sweepudata, maskbf, &lim);
+  g->sweepgc = sweeplist(L, g->sweepgc, maskbf, &lim);
+  if (lim == GCSTEPSIZE) {  /* nothing more to sweep? */
+    g->gcstate = GCSfinalize;  /* end sweep phase */
+  }
 }
 
 
 void luaC_collectgarbage (lua_State *L) {
-  size_t deadmem = mark(L);
-  luaC_sweep(L, 0);
-  checkSizes(L, deadmem);
-  luaC_callGCTM(L);
+  global_State *g = G(L);
+  /* GCSroot */
+  markroot(L);
+  /* GCSpropagate */
+  while (g->gcstate == GCSpropagate)
+    propagatemarks(g, GCSTEPSIZE);
+  /* atomic */
+  atomic(L);
+  /* GCSsweep */
+  while (g->gcstate == GCSsweep)
+    sweepstep(L);
+  /* GCSfinalize */
+  checkSizes(L);
+  while (g->gcstate == GCSfinalize)
+    GCTM(L);
 }
 
 
diff --git a/lgc.h b/lgc.h
index 64b208f9..663da4df 100644
--- a/lgc.h
+++ b/lgc.h
@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.h,v 1.23 2003/11/18 14:55:11 roberto Exp roberto $
+** $Id: lgc.h,v 1.24 2003/11/19 19:41:57 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -12,6 +12,16 @@
 
 
 /*
+** Possible states of the Garbage Collector
+*/
+#define GCSroot         0
+#define GCSpropagate    1
+#define GCSatomic       2
+#define GCSsweep        3
+#define GCSfinalize     4
+
+
+/*
  * ** some userful bit tricks
  * */
 #define resetbits(x,m)  ((x) &= cast(lu_byte, ~(m)))
@@ -53,7 +63,7 @@
 
 size_t luaC_separateudata (lua_State *L);
 void luaC_callGCTM (lua_State *L);
-void luaC_sweep (lua_State *L, int all);
+void luaC_sweepall (lua_State *L);
 void luaC_collectgarbage (lua_State *L);
 void luaC_link (lua_State *L, GCObject *o, lu_byte tt);
 
diff --git a/llimits.h b/llimits.h
index 44151c8d..7c634f67 100644
--- a/llimits.h
+++ b/llimits.h
@@ -1,5 +1,5 @@
 /*
-** $Id: llimits.h,v 1.55 2003/05/14 21:01:53 roberto Exp roberto $
+** $Id: llimits.h,v 1.56 2003/07/29 19:26:34 roberto Exp roberto $
 ** Limits, basic types, and some other `installation-dependent' definitions
 ** See Copyright Notice in lua.h
 */
@@ -50,12 +50,32 @@ typedef LUA_UINT32 lu_int32;
 
 
 /*
+** a signed integer with at least 32 bits
+*/
+#ifndef LUA_INT32
+#define LUA_INT32       long
+#define LUA_MAXINT32    LONG_MAX
+#endif
+
+typedef LUA_INT32 l_int32;
+
+
+/*
 ** an unsigned integer big enough to count the total memory used by Lua;
 ** it should be at least as large as `size_t'
 */
 typedef lu_int32 lu_mem;
 
 
+/*
+** a signed integer big enough to count the total memory used by Lua;
+** it should be at least as large as `size_t'
+*/
+typedef l_int32 l_mem;
+#define MAXLMEM LUA_MAXINT32
+
+
+
 /* chars used as small naturals (so that `char' is reserved for characters) */
 typedef unsigned char lu_byte;
 
diff --git a/lstate.c b/lstate.c
index 459ac2d7..49c71719 100644
--- a/lstate.c
+++ b/lstate.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.c,v 1.127 2003/10/02 20:31:17 roberto Exp roberto $
+** $Id: lstate.c,v 1.128 2003/11/18 14:55:11 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -112,7 +112,7 @@ static void preinit_state (lua_State *L) {
 static void close_state (lua_State *L) {
   global_State *g = G(L);
   luaF_close(L, L->stack);  /* close all upvalues for this thread */
-  luaC_sweep(L, 1);  /* collect all elements */
+  luaC_sweepall(L);  /* collect all elements */
   lua_assert(g->rootgc == NULL);
   lua_assert(g->rootudata == NULL);
   luaS_freeall(L);
@@ -165,6 +165,7 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   setnilvalue(registry(L));
   luaZ_initbuffer(L, &g->buff);
   g->panic = NULL;
+  g->gcstate = 0;
   g->rootgc = NULL;
   g->rootudata = NULL;
   g->gray = NULL;
diff --git a/lstate.h b/lstate.h
index 864e19c9..ed46fb1f 100644
--- a/lstate.h
+++ b/lstate.h
@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.112 2003/10/02 20:31:17 roberto Exp roberto $
+** $Id: lstate.h,v 1.113 2003/11/18 14:55:11 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -98,13 +98,16 @@ typedef struct CallInfo {
 */
 typedef struct global_State {
   stringtable strt;  /* hash table for strings */
+  lua_Alloc realloc;  /* function to reallocate memory */
+  void *ud;         /* auxiliary data to `realloc' */
   GCObject *rootgc;  /* list of (almost) all collectable objects */
   GCObject *rootudata;   /* (separated) list of all userdata */
+  GCObject **sweepgc;  /* position of sweep in `rootgc' */
+  GCObject **sweepudata;  /* position of sweep in `rootudata' */
   GCObject *gray;  /* list of gray objects */
   GCObject *weak;  /* list of weak tables (to be cleared) */
   GCObject *tmudata;  /* list of userdata to be GC */
-  lua_Alloc realloc;  /* function to reallocate memory */
-  void *ud;         /* auxiliary data to `realloc' */
+  int gcstate;  /* state of garbage collector */
   Mbuffer buff;  /* temporary buffer for string concatentation */
   lu_mem GCthreshold;
   lu_mem nblocks;  /* number of `bytes' currently allocated */