new algorithm for traversing in GC to avoid deep recursion calls

ldebug.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.c,v 1.26 2000/06/30 14:29:35 roberto Exp roberto $
+** $Id: ldebug.c,v 1.27 2000/06/30 14:35:17 roberto Exp roberto $
 ** Debug Interface
 ** See Copyright Notice in lua.h
 */
@@ -172,25 +172,38 @@ static void lua_funcinfo (lua_Debug *ar, StkId func) {
 }
 
 
-static int checkfunc (lua_State *L, TObject *o) {
-  return luaO_equalObj(o, L->top);
+static const char *travtagmethods (lua_State *L, const TObject *o) {
+  int e;
+  for (e=0; e<IM_N; e++) {
+    int t;
+    for (t=0; t<=L->last_tag; t++)
+      if (luaO_equalObj(o, luaT_getim(L, t,e)))
+        return luaT_eventname[e];
+  }
+  return NULL;
 }
 
 
-static void lua_getobjname (lua_State *L, StkId f, lua_Debug *ar) {
+static const char *travglobals (lua_State *L, const TObject *o) {
   Hash *g = L->gt;
   int i;
-  /* try to find a name for given function */
-  setnormalized(L->top, f); /* to be used by `checkfunc' */
   for (i=0; i<=g->size; i++) {
-    if (ttype(key(node(g,i))) == TAG_STRING && checkfunc(L, val(node(g,i)))) {
-      ar->name = tsvalue(key(node(g,i)))->str;
-      ar->namewhat = "global";
-      return;
-    }
+    if (luaO_equalObj(o, val(node(g, i))) &&
+        ttype(key(node(g, i))) == TAG_STRING) 
+      return tsvalue(key(node(g, i)))->str;
   }
+  return NULL;
+}
+
+
+static void lua_getobjname (lua_State *L, StkId f, lua_Debug *ar) {
+  TObject o;
+  setnormalized(&o, f);
+  /* try to find a name for given function */
+  if ((ar->name = travglobals(L, &o)) != NULL)
+    ar->namewhat = "global";
   /* not found: try tag methods */
-  if ((ar->name = luaT_travtagmethods(L, checkfunc)) != NULL)
+  else if ((ar->name = travtagmethods(L, &o)) != NULL)
     ar->namewhat = "tag-method";
   else ar->namewhat = "";  /* not found at all */
 }

lfunc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.c,v 1.24 2000/06/12 13:52:05 roberto Exp roberto $
+** $Id: lfunc.c,v 1.25 2000/06/26 19:28:31 roberto Exp roberto $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
@@ -25,7 +25,7 @@ Closure *luaF_newclosure (lua_State *L, int nelems) {
                                          (lint32)sizeof(TObject)*(nelems-1));
   c->next = L->rootcl;
   L->rootcl = c;
-  c->marked = 0;
+  c->mark = c;
   c->nupvalues = nelems;
   L->nblocks += gcsizeclosure(L, c);
   return c;

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.58 2000/06/26 19:28:31 roberto Exp roberto $
+** $Id: lgc.c,v 1.59 2000/06/30 14:35:17 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -20,97 +20,94 @@
 #include "ltm.h"
 
 
+typedef struct GCState {
+  Hash *tmark;  /* list of marked tables to be visited */
+  Closure *cmark;  /* list of marked closures to be visited */
+} GCState;
 
 
-static int markobject (lua_State *L, TObject *o);
+
+static int markobject (GCState *st, TObject *o);
 
 
 /* mark a string; marks larger than 1 cannot be changed */
-#define strmark(L, s)    {if ((s)->marked == 0) (s)->marked = 1;}
+#define strmark(s)    {if ((s)->marked == 0) (s)->marked = 1;}
 
 
 
-static void protomark (lua_State *L, Proto *f) {
+static void protomark (Proto *f) {
   if (!f->marked) {
     int i;
     f->marked = 1;
-    strmark(L, f->source);
+    strmark(f->source);
     for (i=0; i<f->nkstr; i++)
-      strmark(L, f->kstr[i]);
+      strmark(f->kstr[i]);
     for (i=0; i<f->nkproto; i++)
-      protomark(L, f->kproto[i]);
+      protomark(f->kproto[i]);
     if (f->locvars) {  /* is there debug information? */
       LocVar *lv;
       for (lv=f->locvars; lv->pc != -1; lv++)  /* mark local-variable names */
-        if (lv->varname) strmark(L, lv->varname);
+        if (lv->varname) strmark(lv->varname);
     }
   }
 }
 
 
-static void closuremark (lua_State *L, Closure *f) {
-  if (!f->marked) {
-    int i = f->nupvalues;
-    f->marked = 1;
-    while (i--)
-      markobject(L, &f->upvalue[i]);
-  }
-}
-
-
-static void tablemark (lua_State *L, Hash *h) {
-  if (!h->marked) {
-    int i;
-    h->marked = 1;
-    for (i=h->size-1; i>=0; i--) {
-      Node *n = node(h,i);
-      if (ttype(key(n)) != TAG_NIL) {
-        if (ttype(val(n)) == TAG_NIL)
-          luaH_remove(h, key(n));  /* dead element; try to remove it */
-        markobject(L, &n->key);
-        markobject(L, &n->val);
-      }
-    }
-  }
-}
-
-
-static void travstack (lua_State *L) {
+static void markstack (lua_State *L, GCState *st) {
   StkId o;
   for (o=L->stack; o<L->top; o++)
-    markobject(L, o);
+    markobject(st, o);
 }
 
 
-static void travlock (lua_State *L) {
+static void marklock (lua_State *L, GCState *st) {
   int i;
   for (i=0; i<L->refSize; i++) {
     if (L->refArray[i].st == LOCK)
-      markobject(L, &L->refArray[i].o);
+      markobject(st, &L->refArray[i].o);
+  }
+}
+
+
+static void marktagmethods (lua_State *L, GCState *st) {
+  int e;
+  for (e=0; e<IM_N; e++) {
+    int t;
+    for (t=0; t<=L->last_tag; t++)
+      markobject(st, luaT_getim(L, t,e));
   }
 }
 
 
-static int markobject (lua_State *L, TObject *o) {
+static int markobject (GCState *st, TObject *o) {
   switch (ttype(o)) {
     case TAG_USERDATA:  case TAG_STRING:
-      strmark(L, tsvalue(o));
-      break;
-    case TAG_TABLE:
-      tablemark(L, hvalue(o));
+      strmark(tsvalue(o));
       break;
-    case TAG_LCLOSURE:
-      protomark(L, clvalue(o)->f.l);
-      closuremark(L, clvalue(o));
+    case TAG_TABLE: {
+      if (!ismarked(hvalue(o))) {
+        hvalue(o)->mark = st->tmark;  /* chain it in list of marked */
+        st->tmark = hvalue(o);
+      }
       break;
+    }
     case TAG_LMARK: {
       Closure *cl = infovalue(o)->func;
-      protomark(L, cl->f.l);
-      closuremark(L, cl);
+      if (!ismarked(cl)) {
+        protomark(cl->f.l);
+        cl->mark = st->cmark;  /* chain it for later traversal */
+        st->cmark = cl;
+      }
       break;
     }
+    case TAG_LCLOSURE:
+      protomark(clvalue(o)->f.l);
+      /* go through */
     case TAG_CCLOSURE:  case TAG_CMARK:
-      closuremark(L, clvalue(o));
+      if (!ismarked(clvalue(o))) {
+        clvalue(o)->mark = st->cmark;  /* chain it for later traversal */
+        st->cmark = clvalue(o);
+      }
       break;
     default: break;  /* numbers, etc */
   }
@@ -118,6 +115,41 @@ static int markobject (lua_State *L, TObject *o) {
 }
 
 
+static void markall (lua_State *L) {
+  GCState st;
+  st.cmark = NULL;
+  st.tmark = L->gt;  /* put table of globals in mark list */
+  L->gt->mark = NULL;
+  marktagmethods(L, &st);  /* mark tag methods */
+  markstack(L, &st); /* mark stack objects */
+  marklock(L, &st); /* mark locked objects */
+  for (;;) {  /* mark tables and closures */
+    if (st.cmark) {
+      int i;
+      Closure *f = st.cmark;  /* get first closure from list */
+      st.cmark = f->mark;  /* remove it from list */
+      for (i=0; i<f->nupvalues; i++)  /* mark its upvalues */
+        markobject(&st, &f->upvalue[i]);
+    }
+    else if (st.tmark) {
+      int i;
+      Hash *h = st.tmark;  /* get first table from list */
+      st.tmark = h->mark;  /* remove it from list */
+      for (i=0; i<h->size; i++) {
+        Node *n = node(h, i);
+        if (ttype(key(n)) != TAG_NIL) {
+          if (ttype(val(n)) == TAG_NIL)
+            luaH_remove(h, key(n));  /* dead element; try to remove it */
+          markobject(&st, &n->key);
+          markobject(&st, &n->val);
+        }
+      }
+    }
+    else break;  /* nothing else to mark */
+  }
+}
+
+
 static void collectproto (lua_State *L) {
   Proto **p = &L->rootproto;
   Proto *next;
@@ -138,8 +170,8 @@ static void collectclosure (lua_State *L) {
   Closure **p = &L->rootcl;
   Closure *next;
   while ((next = *p) != NULL) {
-    if (next->marked) {
-      next->marked = 0;
+    if (ismarked(next)) {
+      next->mark = next;  /* unmark */
       p = &next->next;
     }
     else {
@@ -154,8 +186,8 @@ static void collecttable (lua_State *L) {
   Hash **p = &L->roottable;
   Hash *next;
   while ((next = *p) != NULL) {
-    if (next->marked) {
-      next->marked = 0;
+    if (ismarked(next)) {
+      next->mark = next;  /* unmark */
       p = &next->next;
     }
     else {
@@ -256,14 +288,6 @@ static void callgcTMudata (lua_State *L) {
 }
 
 
-static void markall (lua_State *L) {
-  luaT_travtagmethods(L, markobject);  /* mark tag methods */
-  travstack(L); /* mark stack objects */
-  tablemark(L, L->gt);  /* mark global variables */
-  travlock(L); /* mark locked objects */
-}
-
-
 void luaC_collect (lua_State *L, int all) {
   int oldah = L->allowhooks;
   L->allowhooks = 0;  /* stop debug hooks during GC */

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.69 2000/06/28 20:20:36 roberto Exp roberto $
+** $Id: lobject.h,v 1.70 2000/06/30 14:35:17 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -110,15 +110,15 @@ typedef struct TString {
 ** Function Prototypes
 */
 typedef struct Proto {
-  struct Proto *next;
-  int marked;
-  struct TString **kstr;  /* strings used by the function */
-  int nkstr;  /* size of `kstr' */
   Number *knum;  /* Number numbers used by the function */
   int nknum;  /* size of `knum' */
+  struct TString **kstr;  /* strings used by the function */
+  int nkstr;  /* size of `kstr' */
   struct Proto **kproto;  /* functions defined inside the function */
   int nkproto;  /* size of `kproto' */
   Instruction *code;  /* ends with opcode ENDCODE */
+  struct Proto *next;
+  int marked;
   int *lines;  /* source line that generated each opcode */
   int lineDefined;
   TString  *source;
@@ -139,12 +139,12 @@ typedef struct LocVar {
 ** Closures
 */
 typedef struct Closure {
-  struct Closure *next;
-  int marked;
   union {
     lua_CFunction c;  /* C functions */
     struct Proto *l;  /* Lua functions */
   } f;
+  struct Closure *next;
+  struct Closure *mark;  /* marked closures (point to itself when not marked) */
   int nupvalues;
   TObject upvalue[1];
 } Closure;
@@ -157,15 +157,21 @@ typedef struct Node {
 } Node;
 
 typedef struct Hash {
-  int htag;
   Node *node;
+  int htag;
   int size;
   Node *firstfree;  /* this position is free; all positions after it are full */
   struct Hash *next;
-  int marked;
+  struct Hash *mark;  /* marked tables (point to itself when not marked) */
 } Hash;
 
 
+/* unmarked tables and closures are represented by pointing `mark' to
+** themselves
+*/
+#define ismarked(x)	((x)->mark != (x))
+
+
 /*
 ** informations about a call (for debugging)
 */

lref.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lref.c,v 1.14 2000/06/12 13:52:05 roberto Exp roberto $
+** $Id: lref.c,v 1.15 2000/06/30 14:35:17 roberto Exp roberto $
 ** reference mechanism
 ** See Copyright Notice in lua.h
 */
@@ -81,15 +81,15 @@ void lua_endblock (lua_State *L) {
 
 
 
-static int ismarked (const TObject *o) {
+static int hasmark (const TObject *o) {
   /* valid only for locked objects */
   switch (o->ttype) {
     case TAG_STRING: case TAG_USERDATA:
       return tsvalue(o)->marked;
     case TAG_TABLE:
-      return hvalue(o)->marked;
+      return ismarked(hvalue(o));
     case TAG_LCLOSURE:  case TAG_CCLOSURE:
-      return clvalue(o)->marked;
+      return ismarked(clvalue(o)->mark);
     default:  /* number */
       return 1;
   }
@@ -104,9 +104,9 @@ void luaR_invalidaterefs (lua_State *L) {
   int i;
   for (i=0; i<n; i++) {
     struct Ref *r = &L->refArray[i];
-    if (r->st == HOLD && !ismarked(&r->o))
+    if (r->st == HOLD && !hasmark(&r->o))
       r->st = COLLECTED;
-    LUA_ASSERT((r->st == LOCK && ismarked(&r->o)) ||
+    LUA_ASSERT((r->st == LOCK && hasmark(&r->o)) ||
                 r->st == COLLECTED ||
                 r->st == NONEXT ||
                (r->st < n && VALIDLINK(L, L->refArray[r->st].st, n)),

ltable.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 1.50 2000/06/30 14:35:17 roberto Exp roberto $
+** $Id: ltable.c,v 1.51 2000/08/04 19:38:35 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -127,14 +127,16 @@ int luaH_pos (lua_State *L, const Hash *t, const TObject *key) {
 ** hash, change `key' for a number with the same hash.
 */
 void luaH_remove (Hash *t, TObject *key) {
-  /* do not remove numbers */
-  if (ttype(key) != TAG_NUMBER) {
+  if (ttype(key) == TAG_NUMBER ||
+       (ttype(key) == TAG_STRING && tsvalue(key)->u.s.len <= 30))
+  return;  /* do not remove numbers nor small strings */
+  else {
     /* try to find a number `n' with the same hash as `key' */
     Node *mp = luaH_mainposition(t, key);
     int n = mp - &t->node[0];
     /* make sure `n' is not in `t' */
     while (luaH_getnum(t, n) != &luaO_nilobject) {
-      if (t->size >= MAX_INT-n)
+      if (n >= MAX_INT - t->size)
         return;  /* give up; (to avoid overflow) */
       n += t->size;
     }
@@ -165,7 +167,7 @@ Hash *luaH_new (lua_State *L, int size) {
   t->htag = TagDefault;
   t->next = L->roottable;
   L->roottable = t;
-  t->marked = 0;
+  t->mark = t;
   t->size = 0;
   L->nblocks += gcsize(L, 0);
   t->node = NULL;

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.43 2000/06/12 13:52:05 roberto Exp roberto $
+** $Id: ltm.c,v 1.44 2000/08/04 19:38:35 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -147,16 +147,3 @@ void luaT_settagmethod (lua_State *L, int t, const char *event, TObject *func) {
   *luaT_getim(L, t, e) = temp;
 }
 
-
-const char *luaT_travtagmethods (lua_State *L,
-                         int (*fn)(lua_State *, TObject *)) {  /* ORDER IM */
-  int e;
-  for (e=IM_GETTABLE; e<=IM_FUNCTION; e++) {
-    int t;
-    for (t=0; t<=L->last_tag; t++)
-      if (fn(L, luaT_getim(L, t,e)))
-        return luaT_eventname[e];
-  }
-  return NULL;
-}
-

ltm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.h,v 1.12 2000/03/30 16:41:51 roberto Exp roberto $
+** $Id: ltm.h,v 1.13 2000/05/30 18:54:49 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -52,7 +52,6 @@ void luaT_realtag (lua_State *L, int tag);
 int luaT_effectivetag (lua_State *L, const TObject *o);
 void luaT_settagmethod (lua_State *L, int t, const char *event, TObject *func);
 const TObject *luaT_gettagmethod (lua_State *L, int t, const char *event);
-const char *luaT_travtagmethods (lua_State *L, int (*fn)(lua_State *, TObject *));
 int luaT_validevent (int t, int e);  /* used by compatibility module */