new API for garbage collector

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.100 2000/09/27 12:51:39 roberto Exp roberto $
+** $Id: lapi.c,v 1.101 2000/09/29 12:42:13 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -155,7 +155,6 @@ double lua_tonumber (lua_State *L, int index) {
 }
 
 const char *lua_tostring (lua_State *L, int index) {
-  luaC_checkGC(L);  /* `tostring' may create a new string */
   access(L, index, (tostring(L, o) == 0), NULL, svalue(o));
 }
 
@@ -203,7 +202,6 @@ void lua_pushnumber (lua_State *L, double n) {
 
 
 void lua_pushlstring (lua_State *L, const char *s, size_t len) {
-  luaC_checkGC(L);
   tsvalue(L->top) = luaS_newlstr(L, s, len);
   ttype(L->top) = TAG_STRING;
   api_incr_top(L);
@@ -219,13 +217,11 @@ void lua_pushstring (lua_State *L, const char *s) {
 
 
 void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
-  luaC_checkGC(L);
   luaV_Cclosure(L, fn, n);
 }
 
 
 void lua_pushusertag (lua_State *L, void *u, int tag) {  /* ORDER LUA_T */
-  luaC_checkGC(L);
   if (tag != LUA_ANYTAG && tag != TAG_USERDATA && tag < NUM_TAGS)
     luaO_verror(L, "invalid tag for a userdata (%d)", tag);
   tsvalue(L->top) = luaS_createudata(L, u, tag);
@@ -292,7 +288,6 @@ int lua_getref (lua_State *L, int ref) {
 
 
 void lua_newtable (lua_State *L) {
-  luaC_checkGC(L);
   hvalue(L->top) = luaH_new(L, 0);
   ttype(L->top) = TAG_TABLE;
   api_incr_top(L);
@@ -376,6 +371,31 @@ void lua_rawcall (lua_State *L, int nargs, int nresults) {
 }
 
 
+/*
+** Garbage-collection functions
+*/
+
+/* GC values are expressed in Kbytes: #bytes/2^10 */
+#define GCscale(x)		((int)((x)>>10))
+#define GCunscale(x)		((unsigned long)(x)<<10)
+
+int lua_getgcthreshold (lua_State *L) {
+  return GCscale(L->GCthreshold);
+}
+
+int lua_getgccount (lua_State *L) {
+  return GCscale(L->nblocks);
+}
+
+void lua_setgcthreshold (lua_State *L, int newthreshold) {
+  if (newthreshold > GCscale(ULONG_MAX))
+    L->GCthreshold = ULONG_MAX;
+  else
+    L->GCthreshold = GCunscale(newthreshold);
+  luaC_checkGC(L);
+}
+
+
 /*
 ** miscellaneous functions
 */
@@ -449,5 +469,6 @@ void lua_concat (lua_State *L, int n) {
   StkId top = L->top;
   luaV_strconc(L, n, top);
   L->top = top-(n-1);
+  luaC_checkGC(L);
 }
 

lbaselib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbaselib.c,v 1.5 2000/09/14 14:09:31 roberto Exp roberto $
+** $Id: lbaselib.c,v 1.6 2000/09/20 12:54:17 roberto Exp roberto $
 ** Basic library
 ** See Copyright Notice in lua.h
 */
@@ -183,10 +183,8 @@ static int luaB_settagmethod (lua_State *L) {
   const char *event = luaL_check_string(L, 2);
   luaL_arg_check(L, lua_isfunction(L, 3) || lua_isnil(L, 3), 3,
                  "function or nil expected");
-  lua_pushnil(L);  /* to get its tag */
-  if (strcmp(event, "gc") == 0 && tag != lua_tag(L, -1))
+  if (strcmp(event, "gc") == 0)
     lua_error(L, "deprecated use: cannot set the `gc' tag method from Lua");
-  lua_pop(L, 1);  /* remove the nil */
   lua_settagmethod(L, tag, event);
   return 1;
 }
@@ -197,9 +195,16 @@ static int luaB_gettagmethod (lua_State *L) {
 }
 
 
+static int luaB_gcinfo (lua_State *L) {
+  lua_pushnumber(L, lua_getgccount(L));
+  lua_pushnumber(L, lua_getgcthreshold(L));
+  return 2;
+}
+
+
 static int luaB_collectgarbage (lua_State *L) {
-  lua_pushnumber(L, lua_collectgarbage(L, luaL_opt_int(L, 1, 0)));
-  return 1;
+  lua_setgcthreshold(L, luaL_opt_int(L, 1, 0));
+  return 0;
 }
 
 
@@ -601,6 +606,7 @@ static const struct luaL_reg base_funcs[] = {
   {"error", luaB_error},
   {"foreach", luaB_foreach},
   {"foreachi", luaB_foreachi},
+  {"gcinfo", luaB_gcinfo},
   {"getglobal", luaB_getglobal},
   {"gettagmethod", luaB_gettagmethod},
   {"globals", luaB_globals},

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.97 2000/09/25 16:22:42 roberto Exp roberto $
+** $Id: ldo.c,v 1.98 2000/09/29 12:42:13 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -197,6 +197,7 @@ void luaD_call (lua_State *L, StkId func, int nResults) {
     nResults--;
   }
   L->top = func;
+  luaC_checkGC(L);
 }
 
 
@@ -366,12 +367,14 @@ int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) {
   StkId oldCbase = L->Cbase;
   StkId oldtop = L->top;
   struct lua_longjmp lj;
+  int allowhooks = L->allowhooks;
   lj.status = 0;
   lj.previous = L->errorJmp;  /* chain new error handler */
   L->errorJmp = &lj;
   if (setjmp(lj.b) == 0)
     (*f)(L, ud);
   else {  /* an error occurred: restore the state */
+    L->allowhooks = allowhooks;
     L->Cbase = oldCbase;
     L->top = oldtop;
     restore_stack_limit(L);

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.67 2000/09/25 14:52:10 roberto Exp roberto $
+** $Id: lgc.c,v 1.68 2000/09/29 12:42:13 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -235,18 +235,13 @@ static void checktab (lua_State *L, stringtable *tb) {
 }
 
 
-/*
-** collect all elements with `marked' <= `limit'.
-** with limit=0, that means all unmarked elements;
-** with limit=MAX_INT, that means all elements.
-*/
-static void collectstringtab (lua_State *L, int limit) {
+static void collectstrings (lua_State *L, int all) {
   int i;
   for (i=0; i<L->strt.size; i++) {  /* for each list */
     TString **p = &L->strt.hash[i];
     TString *next;
     while ((next = *p) != NULL) {
-      if ((int)next->marked > limit) {  /* preserve? */
+      if (next->marked && !all) {  /* preserve? */
         if (next->marked < FIXMARK)  /* does not change FIXMARKs */
           next->marked = 0;
         p = &next->nexthash;
@@ -263,14 +258,14 @@ static void collectstringtab (lua_State *L, int limit) {
 }
 
 
-static void collectudatatab (lua_State *L, int all) {
+static void collectudata (lua_State *L, int all) {
   int i;
   for (i=0; i<L->udt.size; i++) {  /* for each list */
     TString **p = &L->udt.hash[i];
     TString *next;
     while ((next = *p) != NULL) {
       LUA_ASSERT(next->marked <= 1, "udata cannot be fixed");
-      if ((int)next->marked > all) {  /* preserve? */
+      if (next->marked && !all) {  /* preserve? */
         next->marked = 0;
         p = &next->nexthash;
       } 
@@ -289,14 +284,28 @@ static void collectudatatab (lua_State *L, int all) {
 }
 
 
+#define MINBUFFER	256
+static void checkMbuffer (lua_State *L) {
+  if (L->Mbuffsize > MINBUFFER*2) {  /* is buffer too big? */
+    size_t newsize = L->Mbuffsize/2;  /* still larger than MINBUFFER */
+    L->nblocks += (newsize - L->Mbuffsize)*sizeof(char);
+    L->Mbuffsize = newsize;
+    luaM_reallocvector(L, L->Mbuffer, newsize, char);
+  }
+}
+
+
 static void callgcTM (lua_State *L, const TObject *o) {
   const TObject *im = luaT_getimbyObj(L, o, IM_GC);
   if (ttype(im) != TAG_NIL) {
+    int oldah = L->allowhooks;
+    L->allowhooks = 0;  /* stop debug hooks during GC tag methods */
     luaD_checkstack(L, 2);
     *(L->top) = *im;
     *(L->top+1) = *o;
     L->top += 2;
     luaD_call(L, L->top-2, 0);
+    L->allowhooks = oldah;  /* restore hooks */
   }
 }
 
@@ -305,56 +314,41 @@ static void callgcTMudata (lua_State *L) {
   int tag;
   TObject o;
   ttype(&o) = TAG_USERDATA;
-  for (tag=L->last_tag; tag>=0; tag--) {
-    TString *udata = L->IMtable[tag].collected;
-    L->IMtable[tag].collected = NULL;
-    while (udata) {
-      TString *next = udata->nexthash;
+  L->GCthreshold = 2*L->nblocks;  /* avoid GC during tag methods */
+  for (tag=L->last_tag; tag>=0; tag--) {  /* for each tag (in reverse order) */
+    TString *udata;
+    while ((udata = L->IMtable[tag].collected) != NULL) {
+      L->IMtable[tag].collected = udata->nexthash;  /* remove it from list */
       tsvalue(&o) = udata;
       callgcTM(L, &o);
       luaM_free(L, udata);
-      udata = next;
     }
   }
 }
 
 
 void luaC_collect (lua_State *L, int all) {
-  int oldah = L->allowhooks;
-  L->allowhooks = 0;  /* stop debug hooks during GC */
-  L->GCthreshold *= 4;  /* to avoid GC during GC */
-  collectudatatab(L, all);
+  collectudata(L, all);
   callgcTMudata(L);
-  collectstringtab(L, all?MAX_INT:0);
+  collectstrings(L, all);
   collecttable(L);
   collectproto(L);
   collectclosure(L);
-  L->allowhooks = oldah;  /* restore hooks */
 }
 
 
-#define MINBUFFER	256
-
-long lua_collectgarbage (lua_State *L, long limit) {
-  unsigned long recovered = L->nblocks;  /* to subtract `nblocks' after gc */
+static void luaC_collectgarbage (lua_State *L) {
   markall(L);
-  invalidaterefs(L);
+  invalidaterefs(L);  /* check unlocked references */
   luaC_collect(L, 0);
-  recovered = recovered - L->nblocks;
-  L->GCthreshold = (limit == 0) ? 2*L->nblocks : L->nblocks+limit;
-  if (L->Mbuffsize > MINBUFFER*2) {  /* is buffer too big? */
-    size_t diff = L->Mbuffsize/2;
-    L->Mbuffsize -= diff;  /* still larger than MINBUFFER */
-    L->nblocks -= diff*sizeof(char);
-    luaM_reallocvector(L, L->Mbuffer, L->Mbuffsize, char);
-  }
+  checkMbuffer(L);
+  L->GCthreshold = 2*L->nblocks;  /* set new threshold */
   callgcTM(L, &luaO_nilobject);
-  return recovered;
 }
 
 
 void luaC_checkGC (lua_State *L) {
   if (L->nblocks >= L->GCthreshold)
-    lua_collectgarbage(L, 0);
+    luaC_collectgarbage(L);
 }
 

lgc.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.h,v 1.6 1999/10/04 17:51:04 roberto Exp roberto $
+** $Id: lgc.h,v 1.7 1999/11/22 13:12:07 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -11,8 +11,8 @@
 #include "lobject.h"
 
 
-void luaC_checkGC (lua_State *L);
 void luaC_collect (lua_State *L, int all);
+void luaC_checkGC (lua_State *L);
 
 
 #endif

ltests.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltests.c,v 1.44 2000/09/25 16:22:42 roberto Exp roberto $
+** $Id: ltests.c,v 1.45 2000/09/29 12:42:13 roberto Exp roberto $
 ** Internal Module for Debugging of the Lua Implementation
 ** See Copyright Notice in lua.h
 */
@@ -166,8 +166,7 @@ static int mem_query (lua_State *L) {
     lua_pushnumber(L, memdebug_total);
     lua_pushnumber(L, memdebug_numblocks);
     lua_pushnumber(L, memdebug_maxmem);
-lua_pushnumber(L, L->nblocks);
-    return 4;
+    return 3;
   }
   else {
     memdebug_memlimit = luaL_check_int(L, 1);

lua.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.69 2000/09/14 14:09:31 roberto Exp roberto $
+** $Id: lua.h,v 1.70 2000/09/18 19:39:18 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** TeCGraf: Grupo de Tecnologia em Computacao Grafica, PUC-Rio, Brazil
 ** e-mail: [email protected]
@@ -134,6 +134,12 @@ int            lua_dostring (lua_State *L, const char *str);
 int            lua_dobuffer (lua_State *L, const char *buff, size_t size,
                              const char *name);
 
+/*
+** Garbage-collection functions
+*/
+int            lua_getgcthreshold (lua_State *L);
+int            lua_getgccount (lua_State *L);
+void           lua_setgcthreshold (lua_State *L, int newthreshold);
 
 /*
 ** miscellaneous functions
@@ -146,8 +152,6 @@ void           lua_error (lua_State *L, const char *s);
 
 void	       lua_unref (lua_State *L, int ref);
 
-long	       lua_collectgarbage (lua_State *L, long limit);
-
 int            lua_next (lua_State *L, int index);
 int            lua_getn (lua_State *L, int index);
 

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.136 2000/09/20 17:57:08 roberto Exp roberto $
+** $Id: lvm.c,v 1.137 2000/09/25 14:48:42 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -351,10 +351,8 @@ StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
   lua_Hook linehook = L->linehook;
   infovalue(base-1)->pc = &pc;
   luaD_checkstack(L, tf->maxstacksize+EXTRA_STACK);
-  if (tf->is_vararg) {  /* varargs? */
+  if (tf->is_vararg)  /* varargs? */
     adjust_varargs(L, base, tf->numparams);
-    luaC_checkGC(L);
-  }
   else
     luaD_adjusttop(L, base, tf->numparams);
   top = L->top;