new structure for collectable objects, sharing a common header

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.210 2002/08/07 14:24:24 roberto Exp roberto $
+** $Id: lapi.c,v 1.211 2002/08/08 20:08:41 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -211,6 +211,12 @@ LUA_API int lua_isstring (lua_State *L, int index) {
 }
 
 
+LUA_API int lua_isuserdata (lua_State *L, int index) {
+  const TObject *o = luaA_indexAcceptable(L, index);
+  return (o != NULL && (ttisuserdata(o) || ttislightuserdata(o)));
+}
+
+
 LUA_API int lua_rawequal (lua_State *L, int index1, int index2) {
   StkId o1 = luaA_indexAcceptable(L, index1);
   StkId o2 = luaA_indexAcceptable(L, index2);

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.191 2002/08/07 19:22:39 roberto Exp roberto $
+** $Id: ldo.c,v 1.192 2002/08/07 20:55:00 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -101,10 +101,10 @@ static void restore_stack_limit (lua_State *L) {
 
 static void correctstack (lua_State *L, TObject *oldstack) {
   CallInfo *ci;
-  UpVal *up;
+  GCObject *up;
   L->top = (L->top - oldstack) + L->stack;
-  for (up = L->openupval; up != NULL; up = up->next)
-    up->v = (up->v - oldstack) + L->stack;
+  for (up = L->openupval; up != NULL; up = up->gch.next)
+    (&up->uv)->v = ((&up->uv)->v - oldstack) + L->stack;
   for (ci = L->base_ci; ci <= L->ci; ci++) {
     ci->base = (ci->base - oldstack) + L->stack;
     ci->top = (ci->top - oldstack) + L->stack;

lfunc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.c,v 1.57 2002/06/20 20:41:46 roberto Exp roberto $
+** $Id: lfunc.c,v 1.58 2002/08/16 14:45:55 roberto Exp roberto $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
@@ -10,6 +10,7 @@
 #include "lua.h"
 
 #include "lfunc.h"
+#include "lgc.h"
 #include "lmem.h"
 #include "lobject.h"
 #include "lstate.h"
@@ -25,10 +26,8 @@
 
 Closure *luaF_newCclosure (lua_State *L, int nelems) {
   Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));
+  luaC_link(L, cast(GCObject *, c), LUA_TFUNCTION);
   c->c.isC = 1;
-  c->c.next = G(L)->rootcl;
-  G(L)->rootcl = c;
-  c->c.marked = 0;
   c->c.nupvalues = cast(lu_byte, nelems);
   return c;
 }
@@ -36,10 +35,8 @@ Closure *luaF_newCclosure (lua_State *L, int nelems) {
 
 Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *gt) {
   Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));
+  luaC_link(L, cast(GCObject *, c), LUA_TFUNCTION);
   c->l.isC = 0;
-  c->c.next = G(L)->rootcl;
-  G(L)->rootcl = c;
-  c->l.marked = 0;
   c->l.g = *gt;
   c->l.nupvalues = cast(lu_byte, nelems);
   return c;
@@ -47,37 +44,36 @@ Closure *luaF_newLclosure (lua_State *L, int nelems, TObject *gt) {
 
 
 UpVal *luaF_findupval (lua_State *L, StkId level) {
-  UpVal **pp = &L->openupval;
-  UpVal *p;
-  while ((p = *pp) != NULL && p->v >= level) {
-    if (p->v == level) return p;
-    pp = &p->next;
+  GCObject **pp = &L->openupval;
+  GCObject *p;
+  UpVal *v;
+  while ((p = *pp) != NULL && (&p->uv)->v >= level) {
+    if ((&p->uv)->v == level) return &p->uv;
+    pp = &p->gch.next;
   }
-  p = luaM_new(L, UpVal);  /* not found: create a new one */
-  p->marked = 1;  /* open upvalues should not be collected */
-  p->v = level;  /* current value lives in the stack */
-  p->next = *pp;  /* chain it in the proper position */
-  *pp = p;
-  return p;
+  v = luaM_new(L, UpVal);  /* not found: create a new one */
+  v->marked = 1;  /* open upvalues should not be collected */
+  v->v = level;  /* current value lives in the stack */
+  v->next = *pp;  /* chain it in the proper position */
+  *pp = cast(GCObject *, v);
+  return v;
 }
 
 
 void luaF_close (lua_State *L, StkId level) {
   UpVal *p;
-  while ((p = L->openupval) != NULL && p->v >= level) {
-    lua_assert(p->marked);
-    p->marked = 0;
+  while ((p = &(L->openupval)->uv) != NULL && p->v >= level) {
     setobj(&p->value, p->v);  /* save current value */
     p->v = &p->value;  /* now current value lives here */
     L->openupval = p->next;  /* remove from `open' list */
-    p->next = G(L)->rootupval;  /* chain in `closed' list */
-    G(L)->rootupval = p;
+    luaC_link(L, cast(GCObject *, p), LUA_TUPVAL);
   }
 }
 
 
 Proto *luaF_newproto (lua_State *L) {
   Proto *f = luaM_new(L, Proto);
+  luaC_link(L, cast(GCObject *, f), LUA_TPROTO);
   f->k = NULL;
   f->sizek = 0;
   f->p = NULL;
@@ -88,14 +84,11 @@ Proto *luaF_newproto (lua_State *L) {
   f->numparams = 0;
   f->is_vararg = 0;
   f->maxstacksize = 0;
-  f->marked = 0;
   f->lineinfo = NULL;
   f->sizelocvars = 0;
   f->locvars = NULL;
   f->lineDefined = 0;
   f->source = NULL;
-  f->next = G(L)->rootproto;  /* chain in list of protos */
-  G(L)->rootproto = f;
   return f;
 }
 

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.146 2002/08/16 14:45:55 roberto Exp roberto $
+** $Id: lgc.c,v 1.147 2002/08/16 20:00:28 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -34,28 +34,24 @@ typedef struct GCState {
 #define resetbit(x,b)	((x) &= cast(lu_byte, ~(1<<(b))))
 #define testbit(x,b)	((x) & (1<<(b)))
 
+#define mark(x)		setbit((x)->gch.marked, 0)
+#define unmark(x)	resetbit((x)->gch.marked, 0)
+#define ismarked(x)	((x)->gch.marked & ((1<<4)|1))
 
 #define strmark(s)	setbit((s)->tsv.marked, 0)
 #define strunmark(s)	resetbit((s)->tsv.marked, 0)
 
 
+#define isfinalized(u)		(!testbit((u)->uv.marked, 1))
+#define markfinalized(u)	resetbit((u)->uv.marked, 1)
 
-/* mark tricks for userdata */
-#define isudmarked(u)	testbit(u->uv.marked, 0)
-#define markud(u)	setbit(u->uv.marked, 0)
-#define unmarkud(u)	resetbit(u->uv.marked, 0)
 
-#define isfinalized(u)		testbit(u->uv.marked, 1)
-#define markfinalized(u)	setbit(u->uv.marked, 1)
+static void reallymarkobject (GCState *st, GCObject *o);
 
+#define markobject(st,o) \
+	if (iscollectable(o)) reallymarkobject(st,(o)->value.gc)
 
-#define ismarkable(o)	(!((1 << ttype(o)) & \
-	((1 << LUA_TNIL)     | (1 << LUA_TNUMBER) | \
-	 (1 << LUA_TBOOLEAN) | (1 << LUA_TLIGHTUSERDATA))))
-
-static void reallymarkobject (GCState *st, TObject *o);
-
-#define markobject(st,o)	if (ismarkable(o)) reallymarkobject(st,o)
+#define marktable(st,t) reallymarkobject(st, cast(GCObject *, (t)))
 
 
 static void markproto (Proto *f) {
@@ -76,63 +72,46 @@ static void markproto (Proto *f) {
 }
 
 
-static void marktable (GCState *st, Table *h) {
-  if (!h->marked) {
-    h->marked = 1;
-    h->gclist = st->tmark;  /* chain it for later traversal */
-    st->tmark = h;
-  }
-}
-
 
 static void markclosure (GCState *st, Closure *cl) {
-  if (!cl->c.marked) {
-    cl->c.marked = 1;
-    if (cl->c.isC) {
-      int i;
-      for (i=0; i<cl->c.nupvalues; i++)  /* mark its upvalues */
-        markobject(st, &cl->c.upvalue[i]);
-    }
-    else {
-      int i;
-      lua_assert(cl->l.nupvalues == cl->l.p->nupvalues);
-      marktable(st, hvalue(&cl->l.g));
-      markproto(cl->l.p);
-      for (i=0; i<cl->l.nupvalues; i++) {  /* mark its upvalues */
-        UpVal *u = cl->l.upvals[i];
-        if (!u->marked) {
-          markobject(st, &u->value);
-          u->marked = 1;
-        }
+  if (cl->c.isC) {
+    int i;
+    for (i=0; i<cl->c.nupvalues; i++)  /* mark its upvalues */
+      markobject(st, &cl->c.upvalue[i]);
+  }
+  else {
+    int i;
+    lua_assert(cl->l.nupvalues == cl->l.p->nupvalues);
+    marktable(st, hvalue(&cl->l.g));
+    markproto(cl->l.p);
+    for (i=0; i<cl->l.nupvalues; i++) {  /* mark its upvalues */
+      UpVal *u = cl->l.upvals[i];
+      if (!u->marked) {
+        markobject(st, &u->value);
+        u->marked = 1;
       }
     }
   }
 }
 
 
-static void markudata (GCState *st, Udata *u) {
-  markud(u);
-  marktable(st, u->uv.metatable);
-}
-
-
-static void reallymarkobject (GCState *st, TObject *o) {
-  switch (ttype(o)) {
-    case LUA_TSTRING:
-      strmark(tsvalue(o));
-      break;
-    case LUA_TUSERDATA:
-      if (!isudmarked(uvalue(o)))
-        markudata(st, uvalue(o));
+static void reallymarkobject (GCState *st, GCObject *o) {
+  if (ismarked(o)) return;
+  mark(o);
+  switch (o->gch.tt) {
+    case LUA_TFUNCTION: {
+      markclosure(st, &o->cl);
       break;
-    case LUA_TFUNCTION:
-      markclosure(st, clvalue(o));
+    }
+    case LUA_TUSERDATA: {
+      marktable(st, (&o->u)->uv.metatable);
       break;
+    }
     case LUA_TTABLE: {
-      marktable(st, hvalue(o));
+      (&o->h)->gclist = st->tmark;  /* chain it for later traversal */
+      st->tmark = &o->h;
       break;
     }
-    default: lua_assert(0);  /* should not be called with other types */
   }
 }
 
@@ -177,22 +156,29 @@ static void traversestacks (GCState *st) {
 
 
 static void marktmu (GCState *st) {
-  Udata *u;
-  for (u = G(st->L)->tmudata; u; u = u->uv.next)
-    markudata(st, u);
+  GCObject *u;
+  for (u = G(st->L)->tmudata; u; u = u->uv.next) {
+    mark(u);
+    marktable(st, (&u->u)->uv.metatable);
+  }
 }
 
 
 /* move `dead' udata that need finalization to list `tmudata' */
 static void separateudata (lua_State *L) {
-  Udata **p = &G(L)->rootudata;
-  Udata *curr;
-  Udata *collected = NULL;  /* to collect udata with gc event */
-  Udata **lastcollected = &collected;
+  GCObject **p = &G(L)->rootudata;
+  GCObject *curr;
+  GCObject *collected = NULL;  /* to collect udata with gc event */
+  GCObject **lastcollected = &collected;
   while ((curr = *p) != NULL) {
-    if (isudmarked(curr) || isfinalized(curr) ||
-        (fasttm(L, curr->uv.metatable, TM_GC) == NULL))
+    lua_assert(curr->gch.tt == LUA_TUSERDATA);
+    if (ismarked(curr) || isfinalized(&curr->u))
+      p = &curr->uv.next;  /* don't bother with them */
+
+    else if (fasttm(L, (&curr->u)->uv.metatable, TM_GC) == NULL) {
+      markfinalized(&curr->u);  /* don't need finalization */
       p = &curr->uv.next;
+    }
     else {  /* must call its gc method */
       *p = curr->uv.next;
       curr->uv.next = NULL;  /* link `curr' at the end of `collected' list */
@@ -208,7 +194,7 @@ static void separateudata (lua_State *L) {
 
 static void removekey (Node *n) {
   setnilvalue(val(n));  /* remove corresponding value ... */
-  if (ismarkable(key(n)))
+  if (iscollectable(key(n)))
     setttype(key(n), LUA_TNONE);  /* dead key; remove it */
 }
 
@@ -251,20 +237,10 @@ static void propagatemarks (GCState *st) {
 }
 
 
-static int ismarked (const TObject *o) {
-  switch (ttype(o)) {
-    case LUA_TUSERDATA:
-      return isudmarked(uvalue(o));
-    case LUA_TTABLE:
-      return hvalue(o)->marked;
-    case LUA_TFUNCTION:
-      return clvalue(o)->c.marked;
-    case LUA_TSTRING:
-      strmark(tsvalue(o));  /* strings are `values', so are never weak */
-      /* go through */
-    default:  /* number, nil, boolean, udataval */
-      return 1;
-  }
+static int valismarked (const TObject *o) {
+  if (ttisstring(o))
+    strmark(tsvalue(o));  /* strings are `values', so are never weak */
+  return !iscollectable(o) || testbit(o->value.gc->gch.marked, 0);
 }
 
 
@@ -279,7 +255,7 @@ static void cleartablekeys (GCState *st) {
       int i = sizenode(h);
       while (i--) {
         Node *n = node(h, i);
-        if (!ismarked(key(n)))  /* key was collected? */
+        if (!valismarked(key(n)))  /* key was collected? */
           removekey(n);  /* remove entry from table */
       }
     }
@@ -297,13 +273,13 @@ static void cleartablevalues (GCState *st) {
       int i = sizearray(h);
       while (i--) {
         TObject *o = &h->array[i];
-        if (!ismarked(o))  /* value was collected? */
+        if (!valismarked(o))  /* value was collected? */
           setnilvalue(o);  /* remove value */
       }
       i = sizenode(h);
       while (i--) {
         Node *n = node(h, i);
-        if (!ismarked(val(n)))  /* value was collected? */
+        if (!valismarked(val(n)))  /* value was collected? */
           removekey(n);  /* remove entry from table */
       }
     }
@@ -311,103 +287,47 @@ static void cleartablevalues (GCState *st) {
 }
 
 
-static void sweepproto (lua_State *L) {
-  Proto **p = &G(L)->rootproto;
-  Proto *curr;
-  while ((curr = *p) != NULL) {
-    if (curr->marked) {
-      curr->marked = 0;
-      p = &curr->next;
-    }
-    else {
-      *p = curr->next;
-      luaF_freeproto(L, curr);
-    }
-  }
-}
-
-
-static void sweepclosures (lua_State *L) {
-  Closure **p = &G(L)->rootcl;
-  Closure *curr;
-  while ((curr = *p) != NULL) {
-    if (curr->c.marked) {
-      curr->c.marked = 0;
-      p = &curr->c.next;
-    }
-    else {
-      *p = curr->c.next;
-      luaF_freeclosure(L, curr);
-    }
-  }
-}
-
-
-static void sweepupval (lua_State *L) {
-  UpVal **v = &G(L)->rootupval;
-  UpVal *curr;
-  while ((curr = *v) != NULL) {
-    if (curr->marked) {
-      curr->marked = 0;  /* unmark */
-      v = &curr->next;  /* next */
-    }
-    else {
-      *v = curr->next;  /* next */
-      luaM_freelem(L, curr);
-    }
-  }
-}
-
-
-static void sweeptable (lua_State *L) {
-  Table **p = &G(L)->roottable;
-  Table *curr;
-  while ((curr = *p) != NULL) {
-    if (curr->marked) {
-      curr->marked = 0;
-      p = &curr->next;
+static void freeobj (lua_State *L, GCObject *o) {
+  switch (o->gch.tt) {
+    case LUA_TPROTO: luaF_freeproto(L, &o->p); break;
+    case LUA_TFUNCTION: luaF_freeclosure(L, &o->cl); break;
+    case LUA_TUPVAL: luaM_freelem(L, &o->uv); break;
+    case LUA_TTABLE: luaH_free(L, &o->h); break;
+    case LUA_TSTRING: {
+      luaM_free(L, o, sizestring((&o->ts)->tsv.len));
+      break;
     }
-    else {
-      *p = curr->next;
-      luaH_free(L, curr);
+    case LUA_TUSERDATA: {
+      luaM_free(L, o, sizeudata((&o->u)->uv.len));
+      break;
     }
+    default: lua_assert(0);
   }
 }
 
 
-
-static void sweepudata (lua_State *L) {
-  Udata **p = &G(L)->rootudata;
-  Udata *curr;
+static int sweeplist (lua_State *L, GCObject **p, int limit) {
+  GCObject *curr;
+  int count = 0;  /* number of collected items */
   while ((curr = *p) != NULL) {
-    if (isudmarked(curr)) {
-      unmarkud(curr);
-      p = &curr->uv.next;
+    if (curr->gch.marked > limit) {
+      unmark(curr);
+      p = &curr->gch.next;
     }
     else {
-      *p = curr->uv.next;
-      luaM_free(L, curr, sizeudata(curr->uv.len));
+      count++;
+      *p = curr->gch.next;
+      freeobj(L, curr);
     }
   }
+  return count;
 }
 
 
 static void sweepstrings (lua_State *L, int all) {
   int i;
   for (i=0; i<G(L)->strt.size; i++) {  /* for each list */
-    TString **p = &G(L)->strt.hash[i];
-    TString *curr;
-    while ((curr = *p) != NULL) {
-      if (curr->tsv.marked && !all) {  /* preserve? */
-        strunmark(curr);
-        p = &curr->tsv.nexthash;
-      } 
-      else {  /* collect */
-        *p = curr->tsv.nexthash;
-        G(L)->strt.nuse--;
-        luaM_free(L, curr, sizestring(curr->tsv.len));
-      }
-    }
+    G(L)->strt.nuse -= sweeplist(L, &G(L)->strt.hash[i], all);
   }
   if (G(L)->strt.nuse < cast(ls_nstr, G(L)->strt.size/4) &&
       G(L)->strt.size > MINSTRTABSIZE*2)
@@ -442,14 +362,14 @@ static void callGCTM (lua_State *L) {
   setallowhook(L, 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) {
-    Udata *udata = G(L)->tmudata;
+    GCObject *udata = G(L)->tmudata;
     G(L)->tmudata = udata->uv.next;  /* remove udata from `tmudata' */
     udata->uv.next = G(L)->rootudata;  /* return it to `root' list */
     G(L)->rootudata = udata;
-    setuvalue(L->top - 1, udata);  /* keep a reference to it */
-    unmarkud(udata);
-    markfinalized(udata);
-    do1gcTM(L, udata);
+    setuvalue(L->top - 1, &udata->u);  /* keep a reference to it */
+    unmark(udata);
+    markfinalized(&udata->u);
+    do1gcTM(L, &udata->u);
   }
   L->top--;
   setallowhook(L, oldah);  /* restore hooks */
@@ -463,12 +383,10 @@ void luaC_callallgcTM (lua_State *L) {
 
 
 void luaC_sweep (lua_State *L, int all) {
-  sweepudata(L);
+  if (all) all = 256;  /* larger than any mark */
+  sweeplist(L, &G(L)->rootudata, all);
   sweepstrings(L, all);
-  sweeptable(L);
-  sweepproto(L);
-  sweepupval(L);
-  sweepclosures(L);
+  sweeplist(L, &G(L)->rootgc, all);
 }
 
 
@@ -482,7 +400,8 @@ void luaC_collectgarbage (lua_State *L) {
   cleartablevalues(&st);
   separateudata(L);  /* separate userdata to be preserved */
   marktmu(&st);  /* mark `preserved' userdata */
-  propagatemarks(&st);  /* remark */
+  propagatemarks(&st);  /* remark, to propagate `preserveness' */
+  cleartablevalues(&st);  /* again, for eventual weak preserved tables */ 
   cleartablekeys(&st);
   luaC_sweep(L, 0);
   checkMbuffer(L);
@@ -490,3 +409,11 @@ void luaC_collectgarbage (lua_State *L) {
   callGCTM(L);
 }
 
+
+void luaC_link (lua_State *L, GCObject *o, int tt) {
+  o->gch.next = G(L)->rootgc;
+  G(L)->rootgc = o;
+  o->gch.marked = 0;
+  o->gch.tt = tt;
+}
+

lgc.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.h,v 1.14 2001/12/10 22:11:23 roberto Exp roberto $
+** $Id: lgc.h,v 1.15 2002/08/16 20:00:28 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -18,6 +18,7 @@
 void luaC_callallgcTM (lua_State *L);
 void luaC_sweep (lua_State *L, int all);
 void luaC_collectgarbage (lua_State *L);
+void luaC_link (lua_State *L, GCObject *o, int tt);
 
 
 #endif

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.142 2002/08/06 17:06:56 roberto Exp roberto $
+** $Id: lobject.h,v 1.143 2002/08/16 14:45:55 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -13,20 +13,42 @@
 
 
 /* tags for values visible from Lua */
-#define NUM_TAGS	LUA_TFUNCTION
+#define NUM_TAGS	LUA_TUSERDATA
 
 
+/*
+** Extra tags for non-values
+*/
+#define LUA_TPROTO	(NUM_TAGS+1)
+#define LUA_TUPVAL	(NUM_TAGS+2)
+
+
+/*
+** Common header for all collectable objects
+*/
+typedef struct GCheader {
+  union GCObject *next;  /* pointer to next object */
+  lu_byte tt;  /* object type */
+  lu_byte marked;  /* GC informations */
+} GCheader;
+
+
+
+
+/*
+** Union of all Lua values
+*/
 typedef union {
+  union GCObject *gc;
   void *p;
-  union TString *ts;
-  union Udata *u;
-  union Closure *cl;
-  struct Table *h;
   lua_Number n;
   int b;
 } Value;
 
 
+/*
+** Lua values (or `tagged objects')
+*/
 typedef struct lua_TObject {
   int tt;
   Value value;
@@ -47,10 +69,10 @@ typedef struct lua_TObject {
 #define ttype(o)	((o)->tt)
 #define pvalue(o)	check_exp(ttislightuserdata(o), (o)->value.p)
 #define nvalue(o)	check_exp(ttisnumber(o), (o)->value.n)
-#define tsvalue(o)	check_exp(ttisstring(o), (o)->value.ts)
-#define uvalue(o)	check_exp(ttisuserdata(o), (o)->value.u)
-#define clvalue(o)	check_exp(ttisfunction(o), (o)->value.cl)
-#define hvalue(o)	check_exp(ttistable(o), (o)->value.h)
+#define tsvalue(o)	check_exp(ttisstring(o), &(o)->value.gc->ts)
+#define uvalue(o)	check_exp(ttisuserdata(o), &(o)->value.gc->u)
+#define clvalue(o)	check_exp(ttisfunction(o), &(o)->value.gc->cl)
+#define hvalue(o)	check_exp(ttistable(o), &(o)->value.gc->h)
 #define bvalue(o)	check_exp(ttisboolean(o), (o)->value.b)
 
 #define l_isfalse(o)	(ttisnil(o) || (ttisboolean(o) && bvalue(o) == 0))
@@ -69,26 +91,43 @@ typedef struct lua_TObject {
   { TObject *i_o=(obj); i_o->tt=LUA_TBOOLEAN; i_o->value.b=(x); }
 
 #define setsvalue(obj,x) \
-  { TObject *i_o=(obj); i_o->tt=LUA_TSTRING; i_o->value.ts=(x); }
+  { TObject *i_o=(obj); i_o->tt=LUA_TSTRING; \
+    i_o->value.gc=cast(GCObject *, (x)); \
+    lua_assert(i_o->value.gc->gch.tt == LUA_TSTRING); }
 
 #define setuvalue(obj,x) \
-  { TObject *i_o=(obj); i_o->tt=LUA_TUSERDATA; i_o->value.u=(x); }
+  { TObject *i_o=(obj); i_o->tt=LUA_TUSERDATA; \
+    i_o->value.gc=cast(GCObject *, (x)); \
+    lua_assert(i_o->value.gc->gch.tt == LUA_TUSERDATA); }
 
 #define setclvalue(obj,x) \
-  { TObject *i_o=(obj); i_o->tt=LUA_TFUNCTION; i_o->value.cl=(x); }
+  { TObject *i_o=(obj); i_o->tt=LUA_TFUNCTION; \
+    i_o->value.gc=cast(GCObject *, (x)); \
+    lua_assert(i_o->value.gc->gch.tt == LUA_TFUNCTION); }
 
 #define sethvalue(obj,x) \
-  { TObject *i_o=(obj); i_o->tt=LUA_TTABLE; i_o->value.h=(x); }
+  { TObject *i_o=(obj); i_o->tt=LUA_TTABLE; \
+    i_o->value.gc=cast(GCObject *, (x)); \
+    lua_assert(i_o->value.gc->gch.tt == LUA_TTABLE); }
 
 #define setnilvalue(obj) ((obj)->tt=LUA_TNIL)
 
+
+#define checkconsistency(obj) \
+  lua_assert(!iscollectable(obj) || (ttype(obj) == (obj)->value.gc->gch.tt))
+
+
 #define setobj(obj1,obj2) \
   { const TObject *o2=(obj2); TObject *o1=(obj1); \
+    checkconsistency(o2); \
     o1->tt=o2->tt; o1->value = o2->value; }
 
 #define setttype(obj, tt) (ttype(obj) = (tt))
 
 
+#define iscollectable(o)	(ttype(o) >= LUA_TSTRING)
+
+
 
 typedef TObject *StkId;  /* index to stack elements */
 
@@ -99,11 +138,12 @@ typedef TObject *StkId;  /* index to stack elements */
 typedef union TString {
   union L_Umaxalign dummy;  /* ensures maximum alignment for strings */
   struct {
+    union GCObject *next;  /* pointer to next object */
+    lu_byte tt;  /* object type */
+    lu_byte marked;  /* GC informations */
+    lu_byte reserved;
     lu_hash hash;
     size_t len;
-    union TString *nexthash;  /* chain for hash table */
-    lu_byte marked;
-    lu_byte reserved;
   } tsv;
 } TString;
 
@@ -116,10 +156,11 @@ typedef union TString {
 typedef union Udata {
   union L_Umaxalign dummy;  /* ensures maximum alignment for `local' udata */
   struct {
+    union GCObject *next;  /* pointer to next object */
+    lu_byte tt;  /* object type */
+    lu_byte marked;  /* GC informations */
     struct Table *metatable;
-    union Udata *next;  /* chain for list of all udata */
     size_t len;
-    lu_byte marked;
   } uv;
 } Udata;
 
@@ -130,10 +171,12 @@ typedef union Udata {
 ** Function Prototypes
 */
 typedef struct Proto {
+  union GCObject *next;  /* pointer to next object */
+  lu_byte tt;  /* object type */
+  lu_byte marked;  /* GC informations */
   TObject *k;  /* constants used by the function */
   Instruction *code;
   struct Proto **p;  /* functions defined inside the function */
-  struct Proto *next;
   int *lineinfo;  /* map from opcodes to source lines */
   struct LocVar *locvars;  /* information about local variables */
   TString  *source;
@@ -146,7 +189,6 @@ typedef struct Proto {
   lu_byte numparams;
   lu_byte is_vararg;
   lu_byte maxstacksize;
-  lu_byte marked;
 } Proto;
 
 
@@ -163,10 +205,11 @@ typedef struct LocVar {
 */
 
 typedef struct UpVal {
+  union GCObject *next;  /* pointer to next object */
+  lu_byte tt;  /* object type */
+  lu_byte marked;  /* GC informations */
   TObject *v;  /* points to stack or to its own value */
-  struct UpVal *next;
   TObject value;  /* the value (when closed) */
-  lu_byte marked;
 } UpVal;
 
 
@@ -175,20 +218,22 @@ typedef struct UpVal {
 */
 
 typedef struct CClosure {
+  union GCObject *next;  /* pointer to next object */
+  lu_byte tt;  /* object type */
+  lu_byte marked;  /* GC informations */
   lu_byte isC;  /* 0 for Lua functions, 1 for C functions */
   lu_byte nupvalues;
-  lu_byte marked;
-  union Closure *next;
   lua_CFunction f;
   TObject upvalue[1];
 } CClosure;
 
 
 typedef struct LClosure {
+  union GCObject *next;  /* pointer to next object */
+  lu_byte tt;  /* object type */
+  lu_byte marked;  /* GC informations */
   lu_byte isC;
-  lu_byte nupvalues;
-  lu_byte marked;
-  union Closure *next;  /* first four fields must be equal to CClosure!! */
+  lu_byte nupvalues;  /* first five fields must be equal to CClosure!! */
   struct Proto *p;
   TObject g;  /* global table for this closure */
   UpVal *upvals[1];
@@ -217,17 +262,18 @@ typedef struct Node {
 
 
 typedef struct Table {
+  union GCObject *next;  /* pointer to next object */
+  lu_byte tt;  /* object type */
+  lu_byte marked;  /* GC informations */
+  lu_byte flags;  /* 1<<p means tagmethod(p) is not present */ 
+  lu_byte mode;
+  lu_byte lsizenode;  /* log2 of size of `node' array */
   struct Table *metatable;
   TObject *array;  /* array part */
   Node *node;
   Node *firstfree;  /* this position is free; all positions after it are full */
-  struct Table *next;
   struct Table *gclist;
   int sizearray;  /* size of `array' array */
-  lu_byte flags;  /* 1<<p means tagmethod(p) is not present */ 
-  lu_byte lsizenode;  /* log2 of size of `node' array */
-  lu_byte mode;
-  lu_byte marked;
 } Table;
 
 /* bit masks for `mode' */
@@ -247,6 +293,19 @@ typedef struct Table {
 #define sizearray(t)	((t)->sizearray)
 
 
+/*
+** Union of all collectable objects
+*/
+typedef union GCObject {
+  GCheader gch;
+  union TString ts;
+  union Udata u;
+  union Closure cl;
+  struct Table h;
+  struct Proto p;
+  struct UpVal uv;
+} GCObject;
+
 
 extern const TObject luaO_nilobject;
 

lparser.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lparser.c,v 1.192 2002/08/20 20:03:05 roberto Exp roberto $
+** $Id: lparser.c,v 1.193 2002/08/22 19:51:08 roberto Exp roberto $
 ** Lua Parser
 ** See Copyright Notice in lua.h
 */
@@ -336,9 +336,6 @@ static void close_func (LexState *ls) {
   Proto *f = fs->f;
   removevars(ls, 0);
   luaK_codeABC(fs, OP_RETURN, 0, 1, 0);  /* final return */
-  lua_assert(G(L)->roottable == fs->h);
-  G(L)->roottable = fs->h->next;
-  luaH_free(L, fs->h);
   luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction);
   luaM_reallocvector(L, f->lineinfo, f->sizecode, fs->pc, int);
   f->sizecode = fs->pc;

lstate.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.c,v 1.103 2002/08/07 19:22:39 roberto Exp roberto $
+** $Id: lstate.c,v 1.104 2002/08/16 20:00:28 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -64,10 +64,7 @@ static void f_luaopen (lua_State *L, void *ud) {
   G(L)->Mbuffer = NULL;
   G(L)->Mbuffsize = 0;
   G(L)->panic = &default_panic;
-  G(L)->rootproto = NULL;
-  G(L)->rootcl = NULL;
-  G(L)->roottable = NULL;
-  G(L)->rootupval = NULL;
+  G(L)->rootgc = NULL;
   G(L)->rootudata = NULL;
   G(L)->tmudata = NULL;
   setnilvalue(key(G(L)->dummynode));
@@ -76,7 +73,7 @@ static void f_luaopen (lua_State *L, void *ud) {
   G(L)->nblocks = sizeof(lua_State) + sizeof(global_State);
   stack_init(L, L);  /* init stack */
   /* create default meta table with a dummy table, and then close the loop */
-  sethvalue(defaultmeta(L), NULL);
+  defaultmeta(L)->tt = LUA_TTABLE;
   sethvalue(defaultmeta(L), luaH_new(L, 0, 4));
   hvalue(defaultmeta(L))->metatable = hvalue(defaultmeta(L));
   sethvalue(gt(L), luaH_new(L, 0, 4));  /* table of globals */
@@ -160,11 +157,8 @@ static void close_state (lua_State *L) {
   luaF_close(L, L->stack);  /* close all upvalues for this thread */
   if (G(L)) {  /* close global state */
     luaC_sweep(L, 1);  /* collect all elements */
-    lua_assert(G(L)->rootproto == NULL);
+    lua_assert(G(L)->rootgc == NULL);
     lua_assert(G(L)->rootudata == NULL);
-    lua_assert(G(L)->rootcl == NULL);
-    lua_assert(G(L)->rootupval == NULL);
-    lua_assert(G(L)->roottable == NULL);
     luaS_freeall(L);
     luaM_freearray(L, G(L)->Mbuffer, G(L)->Mbuffsize, char);
     luaM_freelem(NULL, L->l_G);

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.93 2002/08/07 19:22:39 roberto Exp roberto $
+** $Id: lstate.h,v 1.94 2002/08/12 17:23:12 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -75,7 +75,7 @@ struct lua_longjmp;  /* defined in ldo.c */
 
 
 typedef struct stringtable {
-  TString **hash;
+  GCObject **hash;
   ls_nstr nuse;  /* number of elements */
   int size;
 } stringtable;
@@ -121,12 +121,9 @@ typedef struct CallInfo {
 */
 typedef struct global_State {
   stringtable strt;  /* hash table for strings */
-  Proto *rootproto;  /* list of all prototypes */
-  Closure *rootcl;  /* list of all closures */
-  Table *roottable;  /* list of all tables */
-  UpVal *rootupval;  /* list of closed up values */
-  Udata *rootudata;   /* list of all userdata */
-  Udata *tmudata;  /* list of userdata to be GC */
+  GCObject *rootgc;  /* list of (almost) all collectable objects */
+  GCObject *rootudata;   /* (separated) list of all userdata */
+  GCObject *tmudata;  /* list of userdata to be GC */
   void *Mbuffer;  /* global buffer */
   size_t Mbuffsize;  /* size of Mbuffer */
   lu_mem GCthreshold;
@@ -154,7 +151,7 @@ struct lua_State {
   unsigned long hookmask;
   ls_count hookcount;
   lua_Hook hook;
-  UpVal *openupval;  /* list of open upvalues in this stack */
+  GCObject *openupval;  /* list of open upvalues in this stack */
   struct lua_longjmp *errorJmp;  /* current error recover point */
   ptrdiff_t errfunc;  /* current error handling function (stack index) */
   lua_State *next;  /* circular double linked list of states */

lstring.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lstring.c,v 1.74 2002/04/05 18:54:31 roberto Exp roberto $
+** $Id: lstring.c,v 1.75 2002/08/16 14:45:55 roberto Exp roberto $
 ** String table (keeps all strings handled by Lua)
 ** See Copyright Notice in lua.h
 */
@@ -23,19 +23,19 @@ void luaS_freeall (lua_State *L) {
 
 
 void luaS_resize (lua_State *L, int newsize) {
-  TString **newhash = luaM_newvector(L, newsize, TString *);
+  GCObject **newhash = luaM_newvector(L, newsize, GCObject *);
   stringtable *tb = &G(L)->strt;
   int i;
   for (i=0; i<newsize; i++) newhash[i] = NULL;
   /* rehash */
   for (i=0; i<tb->size; i++) {
-    TString *p = tb->hash[i];
+    GCObject *p = tb->hash[i];
     while (p) {  /* for each node in the list */
-      TString *next = p->tsv.nexthash;  /* save next */
-      lu_hash h = p->tsv.hash;
+      GCObject *next = p->gch.next;  /* save next */
+      lu_hash h = (&p->ts)->tsv.hash;
       int h1 = lmod(h, newsize);  /* new position */
       lua_assert(cast(int, h%newsize) == lmod(h, newsize));
-      p->tsv.nexthash = newhash[h1];  /* chain it in new position */
+      p->gch.next = newhash[h1];  /* chain it */
       newhash[h1] = p;
       p = next;
     }
@@ -49,17 +49,17 @@ void luaS_resize (lua_State *L, int newsize) {
 static TString *newlstr (lua_State *L, const char *str, size_t l, lu_hash h) {
   TString *ts = cast(TString *, luaM_malloc(L, sizestring(l)));
   stringtable *tb;
-  ts->tsv.nexthash = NULL;
   ts->tsv.len = l;
   ts->tsv.hash = h;
   ts->tsv.marked = 0;
+  ts->tsv.tt = LUA_TSTRING;
   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.nexthash = tb->hash[h];  /* chain new entry */
-  tb->hash[h] = ts;
+  ts->tsv.next = tb->hash[h];  /* chain new entry */
+  tb->hash[h] = cast(GCObject *, ts);
   tb->nuse++;
   if (tb->nuse > cast(ls_nstr, tb->size) && tb->size <= MAX_INT/2)
     luaS_resize(L, tb->size*2);  /* too crowded */
@@ -68,7 +68,7 @@ static TString *newlstr (lua_State *L, const char *str, size_t l, lu_hash h) {
 
 
 TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
-  TString *ts;
+  GCObject *ts;
   lu_hash h = (lu_hash)l;  /* seed */
   size_t step = (l>>5)+1;  /* if string is too long, don't hash all its chars */
   size_t l1;
@@ -76,9 +76,9 @@ TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
     h = h ^ ((h<<5)+(h>>2)+(unsigned char)(str[l1-1]));
   for (ts = G(L)->strt.hash[lmod(h, G(L)->strt.size)];
        ts != NULL;
-       ts = ts->tsv.nexthash) {
-    if (ts->tsv.len == l && (memcmp(str, getstr(ts), l) == 0))
-      return ts;
+       ts = ts->gch.next) {
+    if ((&ts->ts)->tsv.len == l && (memcmp(str, getstr(&ts->ts), l) == 0))
+      return &ts->ts;
   }
   return newlstr(L, str, l, h);  /* not found */
 }
@@ -87,12 +87,13 @@ TString *luaS_newlstr (lua_State *L, const char *str, size_t l) {
 Udata *luaS_newudata (lua_State *L, size_t s) {
   Udata *u;
   u = cast(Udata *, luaM_malloc(L, sizeudata(s)));
-  u->uv.marked = 0;
+  u->uv.marked = (1<<1);  /* is not finalized */
+  u->uv.tt = LUA_TUSERDATA;
   u->uv.len = s;
   u->uv.metatable = hvalue(defaultmeta(L));
   /* chain it on udata list */
   u->uv.next = G(L)->rootudata;
-  G(L)->rootudata = u;
+  G(L)->rootudata = cast(GCObject *, u);
   return u;
 }
 

ltable.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 1.116 2002/08/06 17:06:56 roberto Exp roberto $
+** $Id: ltable.c,v 1.117 2002/08/16 14:45:55 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -27,6 +27,7 @@
 
 #include "ldebug.h"
 #include "ldo.h"
+#include "lgc.h"
 #include "lmem.h"
 #include "lobject.h"
 #include "lstate.h"
@@ -304,11 +305,9 @@ static void rehash (lua_State *L, Table *t) {
 
 Table *luaH_new (lua_State *L, int narray, int lnhash) {
   Table *t = luaM_new(L, Table);
+  luaC_link(L, cast(GCObject *, t), LUA_TTABLE);
   t->metatable = hvalue(defaultmeta(L));
-  t->next = G(L)->roottable;
-  G(L)->roottable = t;
   t->flags = cast(lu_byte, ~0);
-  t->marked = 0;
   t->mode = 0;
   /* temporary values (kept only if some malloc fails) */
   t->array = NULL;

ltests.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltests.c,v 1.132 2002/08/06 15:32:22 roberto Exp roberto $
+** $Id: ltests.c,v 1.133 2002/08/06 18:01:50 roberto Exp roberto $
 ** Internal Module for Debugging of the Lua Implementation
 ** See Copyright Notice in lua.h
 */
@@ -324,10 +324,10 @@ static int string_query (lua_State *L) {
     return 2;
   }
   else if (s < tb->size) {
-    TString *ts;
+    GCObject *ts;
     int n = 0;
-    for (ts = tb->hash[s]; ts; ts = ts->tsv.nexthash) {
-      setsvalue(L->top, ts);
+    for (ts = tb->hash[s]; ts; ts = ts->gch.next) {
+      setsvalue(L->top, &ts->ts);
       incr_top(L);
       n++;
     }

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.99 2002/08/05 14:09:06 roberto Exp roberto $
+** $Id: ltm.c,v 1.100 2002/08/06 17:06:56 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -18,8 +18,8 @@
 
 
 const char *const luaT_typenames[] = {
-  "nil", "number", "string", "boolean", "table",
-  "function", "userdata", "userdata"
+  "nil", "boolean", "userdata", "number",
+  "string", "table", "function", "userdata"
 };
 
 

lua.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.153 2002/08/06 18:54:18 roberto Exp roberto $
+** $Id: lua.h,v 1.154 2002/08/12 17:23:12 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** Tecgraf: Computer Graphics Technology Group, PUC-Rio, Brazil
 ** http://www.lua.org	mailto:[email protected]
@@ -63,13 +63,13 @@ typedef const char * (*lua_Chunkreader) (lua_State *L, void *ud, size_t *size);
 #define LUA_TNONE	(-1)
 
 #define LUA_TNIL	0
-#define LUA_TNUMBER	1
-#define LUA_TSTRING	2
-#define LUA_TBOOLEAN	3
-#define LUA_TTABLE	4
-#define LUA_TFUNCTION	5
-#define LUA_TUSERDATA	6
-#define LUA_TLIGHTUSERDATA	7
+#define LUA_TBOOLEAN	1
+#define LUA_TLIGHTUSERDATA	2
+#define LUA_TNUMBER	3
+#define LUA_TSTRING	4
+#define LUA_TTABLE	5
+#define LUA_TFUNCTION	6
+#define LUA_TUSERDATA	7
 
 
 /* minimum Lua stack available to a C function */
@@ -127,6 +127,7 @@ LUA_API int   lua_checkstack (lua_State *L, int size);
 LUA_API int             lua_isnumber (lua_State *L, int index);
 LUA_API int             lua_isstring (lua_State *L, int index);
 LUA_API int             lua_iscfunction (lua_State *L, int index);
+LUA_API int             lua_isuserdata (lua_State *L, int index);
 LUA_API int             lua_type (lua_State *L, int index);
 LUA_API const char     *lua_typename (lua_State *L, int type);
 
@@ -240,7 +241,6 @@ LUA_API void *lua_newuserdata (lua_State *L, size_t size);
 
 #define lua_isfunction(L,n)	(lua_type(L,n) == LUA_TFUNCTION)
 #define lua_istable(L,n)	(lua_type(L,n) == LUA_TTABLE)
-#define lua_isuserdata(L,n)	(lua_type(L,n) >= LUA_TUSERDATA)
 #define lua_islightuserdata(L,n)	(lua_type(L,n) == LUA_TLIGHTUSERDATA)
 #define lua_isnil(L,n)		(lua_type(L,n) == LUA_TNIL)
 #define lua_isboolean(L,n)	(lua_type(L,n) == LUA_TBOOLEAN)