From 3ca9af51a4f060cf2178901a67a21f8269af3224 Mon Sep 17 00:00:00 2001
From: Roberto Ierusalimschy <roberto@inf.puc-rio.br>
Date: Tue, 11 Jul 2006 12:53:29 -0300
Subject: [PATCH] emergency garbage collector (core forces a GC when allocation
 fails)

---
 lapi.c    | 44 +++++++++-----------------------
 lapi.h    |  8 +++---
 ldebug.c  | 17 ++++++++-----
 ldo.c     | 21 ++++++++-------
 ldo.h     |  4 +--
 lgc.c     | 76 +++++++++++++++++++++++++++++++++----------------------
 lgc.h     |  4 +--
 llex.c    |  7 +++--
 lmem.c    | 25 +++++++++++++-----
 lobject.c | 12 ++++-----
 lparser.c | 26 +++++++++++--------
 lstate.c  | 21 ++++++++++-----
 lstate.h  |  4 +--
 lstring.c |  9 +++----
 ltable.c  | 16 +++++-------
 ltable.h  |  5 ++--
 ltests.c  | 19 +++++++++-----
 lvm.c     | 23 +++++++++--------
 makefile  |  2 +-
 19 files changed, 190 insertions(+), 153 deletions(-)

diff --git a/lapi.c b/lapi.c
index 0fa66eb4..e992d27e 100644
--- a/lapi.c
+++ b/lapi.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 2.54 2006/06/02 15:34:00 roberto Exp roberto $
+** $Id: lapi.c,v 2.55 2006/06/07 12:37:17 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -42,9 +42,6 @@ const char lua_ident[] =
 
 #define api_checkvalidindex(L, i)	api_check(L, (i) != luaO_nilobject)
 
-#define api_incr_top(L)   {api_check(L, L->top < L->ci->top); L->top++;}
-
-
 
 static TValue *index2adr (lua_State *L, int idx) {
   if (idx > 0) {
@@ -86,12 +83,6 @@ static Table *getcurrenv (lua_State *L) {
 }
 
 
-void luaA_pushobject (lua_State *L, const TValue *o) {
-  setobj2s(L, L->top, o);
-  api_incr_top(L);
-}
-
-
 LUA_API int lua_checkstack (lua_State *L, int size) {
   int res;
   lua_lock(L);
@@ -133,19 +124,6 @@ LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
 }
 
 
-LUA_API lua_State *lua_newthread (lua_State *L) {
-  lua_State *L1;
-  lua_lock(L);
-  luaC_checkGC(L);
-  L1 = luaE_newthread(L);
-  setthvalue(L, L->top, L1);
-  api_incr_top(L);
-  lua_unlock(L);
-  luai_userstatethread(L, L1);
-  return L1;
-}
-
-
 
 /*
 ** basic stack manipulation
@@ -539,13 +517,12 @@ LUA_API void lua_gettable (lua_State *L, int idx) {
 
 LUA_API void lua_getfield (lua_State *L, int idx, const char *k) {
   StkId t;
-  TValue key;
   lua_lock(L);
   t = index2adr(L, idx);
   api_checkvalidindex(L, t);
-  setsvalue(L, &key, luaS_new(L, k));
-  luaV_gettable(L, t, &key, L->top);
+  setsvalue2s(L, L->top, luaS_new(L, k));
   api_incr_top(L);
+  luaV_gettable(L, t, L->top - 1, L->top - 1);
   lua_unlock(L);
 }
 
@@ -572,10 +549,14 @@ LUA_API void lua_rawgeti (lua_State *L, int idx, int n) {
 
 
 LUA_API void lua_createtable (lua_State *L, int narray, int nrec) {
+  Table *t;
   lua_lock(L);
   luaC_checkGC(L);
-  sethvalue(L, L->top, luaH_new(L, narray, nrec));
+  t = luaH_new(L);
+  sethvalue(L, L->top, t);
   api_incr_top(L);
+  if (narray > 0 || nrec > 0)
+    luaH_resize(L, t, narray, nrec);
   lua_unlock(L);
 }
 
@@ -652,14 +633,13 @@ LUA_API void lua_settable (lua_State *L, int idx) {
 
 LUA_API void lua_setfield (lua_State *L, int idx, const char *k) {
   StkId t;
-  TValue key;
   lua_lock(L);
   api_checknelems(L, 1);
   t = index2adr(L, idx);
   api_checkvalidindex(L, t);
-  setsvalue(L, &key, luaS_new(L, k));
-  luaV_settable(L, t, &key, L->top - 1);
-  L->top--;  /* pop value */
+  setsvalue2s(L, L->top++, luaS_new(L, k));
+  luaV_settable(L, t, L->top - 1, L->top - 2);
+  L->top -= 2;  /* pop value and key */
   lua_unlock(L);
 }
 
@@ -907,7 +887,7 @@ LUA_API int lua_gc (lua_State *L, int what, int data) {
       break;
     }
     case LUA_GCCOLLECT: {
-      luaC_fullgc(L);
+      luaC_fullgc(L, 0);
       break;
     }
     case LUA_GCCOUNT: {
diff --git a/lapi.h b/lapi.h
index bb522de5..b9ca73bf 100644
--- a/lapi.h
+++ b/lapi.h
@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.h,v 2.1 2003/12/10 12:13:36 roberto Exp roberto $
+** $Id: lapi.h,v 2.2 2005/04/25 19:24:10 roberto Exp roberto $
 ** Auxiliary functions from Lua API
 ** See Copyright Notice in lua.h
 */
@@ -8,9 +8,9 @@
 #define lapi_h
 
 
-#include "lobject.h"
+#include "llimits.h"
+#include "lstate.h"
 
-
-LUAI_FUNC void luaA_pushobject (lua_State *L, const TValue *o);
+#define api_incr_top(L)   {L->top++; api_check(L, L->top <= L->ci->top);}
 
 #endif
diff --git a/ldebug.c b/ldebug.c
index 4fa42ac9..66a32f37 100644
--- a/ldebug.c
+++ b/ldebug.c
@@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.c,v 2.28 2005/11/01 16:08:52 roberto Exp roberto $
+** $Id: ldebug.c,v 2.29 2005/12/22 16:19:56 roberto Exp roberto $
 ** Debug Interface
 ** See Copyright Notice in lua.h
 */
@@ -128,8 +128,10 @@ LUA_API const char *lua_getlocal (lua_State *L, const lua_Debug *ar, int n) {
   CallInfo *ci = L->base_ci + ar->i_ci;
   const char *name = findlocal(L, ci, n);
   lua_lock(L);
-  if (name)
-      luaA_pushobject(L, ci->base + (n - 1));
+  if (name) {
+    setobj2s(L, L->top, ci->base + (n - 1));
+    api_incr_top(L);
+  }
   lua_unlock(L);
   return name;
 }
@@ -177,16 +179,17 @@ static void info_tailcall (lua_Debug *ar) {
 static void collectvalidlines (lua_State *L, Closure *f) {
   if (f == NULL || f->c.isC) {
     setnilvalue(L->top);
+    incr_top(L);
   }
   else {
-    Table *t = luaH_new(L, 0, 0);
-    int *lineinfo = f->l.p->lineinfo;
     int i;
+    int *lineinfo = f->l.p->lineinfo;
+    Table *t = luaH_new(L);
+    sethvalue(L, L->top, t); 
+    incr_top(L);
     for (i=0; i<f->l.p->sizelineinfo; i++)
       setbvalue(luaH_setnum(L, t, lineinfo[i]), 1);
-    sethvalue(L, L->top, t); 
   }
-  incr_top(L);
 }
 
 
diff --git a/ldo.c b/ldo.c
index d7a587e9..6ce1e519 100644
--- a/ldo.c
+++ b/ldo.c
@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 2.37 2005/12/22 16:19:56 roberto Exp roberto $
+** $Id: ldo.c,v 2.38 2006/06/05 19:36:14 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -81,7 +81,7 @@ static void restore_stack_limit (lua_State *L) {
 static void resetstack (lua_State *L, int status) {
   L->ci = L->base_ci;
   L->base = L->ci->base;
-  luaF_close(L, L->base);  /* close eventual pending closures */
+  luaF_close(L, L->base);  /* close possible pending closures */
   luaD_seterrorobj(L, status, L->base);
   L->nCcalls = 0;
   L->allowhook = 1;
@@ -217,11 +217,13 @@ static StkId adjust_varargs (lua_State *L, Proto *p, int actual) {
     int nvar = actual - nfixargs;  /* number of extra arguments */
     lua_assert(p->is_vararg & VARARG_HASARG);
     luaC_checkGC(L);
-    htab = luaH_new(L, nvar, 1);  /* create `arg' table */
+    htab = luaH_new(L);  /* create `arg' table */
+    sethvalue(L, L->top++, htab);
     for (i=0; i<nvar; i++)  /* put extra arguments into `arg' table */
-      setobj2n(L, luaH_setnum(L, htab, i+1), L->top - nvar + i);
+      setobj2n(L, luaH_setnum(L, htab, i+1), L->top - nvar + i - 1);
     /* store counter in field `n' */
     setnvalue(luaH_setstr(L, htab, luaS_newliteral(L, "n")), cast_num(nvar));
+    L->top--;
   }
 #endif
   /* move fixed parameters to final position */
@@ -332,7 +334,7 @@ static StkId callrethooks (lua_State *L, StkId firstResult) {
   ptrdiff_t fr = savestack(L, firstResult);  /* next call may change stack */
   luaD_callhook(L, LUA_HOOKRET, -1);
   if (f_isLua(L->ci)) {  /* Lua function? */
-    while (L->ci->tailcalls--)  /* call hook for eventual tail calls */
+    while (L->ci->tailcalls--)  /* call hook for possible tail calls */
       luaD_callhook(L, LUA_HOOKTAILRET, -1);
   }
   return restorestack(L, fr);
@@ -461,7 +463,7 @@ int luaD_pcall (lua_State *L, Pfunc func, void *u,
   status = luaD_rawrunprotected(L, func, u);
   if (status != 0) {  /* an error occurred? */
     StkId oldtop = restorestack(L, old_top);
-    luaF_close(L, oldtop);  /* close eventual pending closures */
+    luaF_close(L, oldtop);  /* close possible pending closures */
     luaD_seterrorobj(L, status, oldtop);
     L->nCcalls = oldnCcalls;
     L->ci = restoreci(L, old_ci);
@@ -494,12 +496,13 @@ static void f_parser (lua_State *L, void *ud) {
   luaC_checkGC(L);
   tf = ((c == LUA_SIGNATURE[0]) ? luaU_undump : luaY_parser)(L, p->z,
                                                              &p->buff, p->name);
+  setptvalue2s(L, L->top, tf);
+  incr_top(L);
   cl = luaF_newLclosure(L, tf->nups, hvalue(gt(L)));
   cl->l.p = tf;
-  for (i = 0; i < tf->nups; i++)  /* initialize eventual upvalues */
+  setclvalue(L, L->top - 1, cl);
+  for (i = 0; i < tf->nups; i++)  /* initialize upvalues */
     cl->l.upvals[i] = luaF_newupval(L);
-  setclvalue(L, L->top, cl);
-  incr_top(L);
 }
 
 
diff --git a/ldo.h b/ldo.h
index 5aa65480..f7e0ce09 100644
--- a/ldo.h
+++ b/ldo.h
@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.h,v 2.6 2005/08/22 19:58:29 roberto Exp roberto $
+** $Id: ldo.h,v 2.7 2005/08/24 16:15:49 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -19,7 +19,7 @@
   else condhardstacktests(luaD_reallocstack(L, L->stacksize - EXTRA_STACK - 1));
 
 
-#define incr_top(L) {luaD_checkstack(L,1); L->top++;}
+#define incr_top(L) {L->top++; luaD_checkstack(L,0);}
 
 #define savestack(L,p)		((char *)(p) - (char *)L->stack)
 #define restorestack(L,n)	((TValue *)((char *)L->stack + (n)))
diff --git a/lgc.c b/lgc.c
index 935d8c1b..93316741 100644
--- a/lgc.c
+++ b/lgc.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 2.37 2005/12/22 16:19:56 roberto Exp roberto $
+** $Id: lgc.c,v 2.38 2006/05/24 14:34:06 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -52,7 +52,7 @@
 #define markvalue(g,o) { checkconsistency(o); \
   if (iscollectable(o) && iswhite(gcvalue(o))) reallymarkobject(g,gcvalue(o)); }
 
-#define markobject(g,t) { if (iswhite(obj2gco(t))) \
+#define markobject(g,t) { if ((t) && iswhite(obj2gco(t))) \
 		reallymarkobject(g, obj2gco(t)); }
 
 
@@ -76,7 +76,7 @@ static void reallymarkobject (global_State *g, GCObject *o) {
     case LUA_TUSERDATA: {
       Table *mt = gco2u(o)->metatable;
       gray2black(o);  /* udata are never gray */
-      if (mt) markobject(g, mt);
+      markobject(g, mt);
       markobject(g, gco2u(o)->env);
       return;
     }
@@ -160,8 +160,7 @@ static int traversetable (global_State *g, Table *h) {
   int weakkey = 0;
   int weakvalue = 0;
   const TValue *mode;
-  if (h->metatable)
-    markobject(g, h->metatable);
+  markobject(g, h->metatable);
   mode = gfasttm(g, h->metatable, TM_MODE);
   if (mode && ttisstring(mode)) {  /* is there a weak mode? */
     weakkey = (strchr(svalue(mode), 'k') != NULL);
@@ -209,10 +208,8 @@ static void traverseproto (global_State *g, Proto *f) {
     if (f->upvalues[i])
       stringmark(f->upvalues[i]);
   }
-  for (i=0; i<f->sizep; i++) {  /* mark nested protos */
-    if (f->p[i])
-      markobject(g, f->p[i]);
-  }
+  for (i=0; i<f->sizep; i++)  /* mark nested protos */
+    markobject(g, f->p[i]);
   for (i=0; i<f->sizelocvars; i++) {  /* mark local-variable names */
     if (f->locvars[i].varname)
       stringmark(f->locvars[i].varname);
@@ -256,6 +253,8 @@ static void checkstacksizes (lua_State *L, StkId max) {
 static void traversestack (global_State *g, lua_State *l) {
   StkId o, lim;
   CallInfo *ci;
+  if (l->stack == NULL || l->base_ci == NULL)
+    return;  /* stack not completely built yet */
   markvalue(g, gt(l));
   lim = l->top;
   for (ci = l->base_ci; ci <= l->ci; ci++) {
@@ -266,7 +265,8 @@ static void traversestack (global_State *g, lua_State *l) {
     markvalue(g, o);
   for (; o <= lim; o++)
     setnilvalue(o);
-  checkstacksizes(l, lim);
+  if (!g->emergencygc)  /* cannot change stack in emergency... */
+    checkstacksizes(l, lim);  /* ...(interpreter does not expect that change) */
 }
 
 
@@ -442,11 +442,9 @@ static void checkSizes (lua_State *L) {
 }
 
 
-static void GCTM (lua_State *L) {
-  global_State *g = G(L);
+static Udata *udata2finalize (global_State *g) {
   GCObject *o = g->tmudata->gch.next;  /* get first element */
   Udata *udata = rawgco2u(o);
-  const TValue *tm;
   /* remove udata from `tmudata' */
   if (o == g->tmudata)  /* last element? */
     g->tmudata = NULL;
@@ -455,7 +453,14 @@ static void GCTM (lua_State *L) {
   udata->uv.next = g->mainthread->next;  /* return it to `root' list */
   g->mainthread->next = o;
   makewhite(g, o);
-  tm = fasttm(L, udata->uv.metatable, TM_GC);
+  return udata;
+}
+
+
+static void GCTM (lua_State *L) {
+  global_State *g = G(L);
+  Udata *udata = udata2finalize(g);
+  const TValue *tm = fasttm(L, udata->uv.metatable, TM_GC);
   if (tm != NULL) {
     lu_byte oldah = L->allowhook;
     lu_mem oldt = g->GCthreshold;
@@ -475,8 +480,17 @@ static void GCTM (lua_State *L) {
 ** Call all GC tag methods
 */
 void luaC_callGCTM (lua_State *L) {
-  while (G(L)->tmudata)
+  global_State *g = G(L);
+  GCObject *last = g->tmudata;
+  GCObject *curr;
+  if (last == NULL) return;  /* empty list? */
+  do {
+    curr = g->tmudata->gch.next;  /* element to be collected */
     GCTM(L);
+  } while (curr != last);  /* go only until original last */
+  /* do not finalize new udata created during previous finalizations  */
+  while (g->tmudata)
+    udata2finalize(g);  /* simply remove them from list */
 }
 
 
@@ -493,7 +507,7 @@ void luaC_freeall (lua_State *L) {
 static void markmt (global_State *g) {
   int i;
   for (i=0; i<NUM_TAGS; i++)
-    if (g->mt[i]) markobject(g, g->mt[i]);
+    markobject(g, g->mt[i]);
 }
 
 
@@ -553,6 +567,10 @@ static void atomic (lua_State *L) {
 }
 
 
+#define correctestimate(g,s)  {lu_mem old = g->totalbytes; s; \
+          lua_assert(old >= g->totalbytes); g->estimate -= old - g->totalbytes;}
+     
+
 static l_mem singlestep (lua_State *L) {
   global_State *g = G(L);
   /*lua_checkmemory(L);*/
@@ -570,23 +588,15 @@ static l_mem singlestep (lua_State *L) {
       }
     }
     case GCSsweepstring: {
-      lu_mem old = g->totalbytes;
-      sweepwholelist(L, &g->strt.hash[g->sweepstrgc++]);
+      correctestimate(g, sweepwholelist(L, &g->strt.hash[g->sweepstrgc++]));
       if (g->sweepstrgc >= g->strt.size)  /* nothing more to sweep? */
         g->gcstate = GCSsweep;  /* end sweep-string phase */
-      lua_assert(old >= g->totalbytes);
-      g->estimate -= old - g->totalbytes;
       return GCSWEEPCOST;
     }
     case GCSsweep: {
-      lu_mem old = g->totalbytes;
-      g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX);
-      if (*g->sweepgc == NULL) {  /* nothing more to sweep? */
-        checkSizes(L);
+      correctestimate(g, g->sweepgc = sweeplist(L, g->sweepgc, GCSWEEPMAX));
+      if (*g->sweepgc == NULL)  /* nothing more to sweep? */
         g->gcstate = GCSfinalize;  /* end sweep phase */
-      }
-      lua_assert(old >= g->totalbytes);
-      g->estimate -= old - g->totalbytes;
       return GCSWEEPMAX*GCSWEEPCOST;
     }
     case GCSfinalize: {
@@ -597,6 +607,7 @@ static l_mem singlestep (lua_State *L) {
         return GCFINALIZECOST;
       }
       else {
+        correctestimate(g, checkSizes(L));
         g->gcstate = GCSpause;  /* end collection */
         g->gcdept = 0;
         return 0;
@@ -610,6 +621,7 @@ static l_mem singlestep (lua_State *L) {
 void luaC_step (lua_State *L) {
   global_State *g = G(L);
   l_mem lim = (GCSTEPSIZE/100) * g->gcstepmul;
+  lua_assert(!g->emergencygc);
   if (lim == 0)
     lim = (MAX_LUMEM-1)/2;  /* no limit */
   g->gcdept += g->totalbytes - g->GCthreshold;
@@ -633,8 +645,10 @@ void luaC_step (lua_State *L) {
 }
 
 
-void luaC_fullgc (lua_State *L) {
+void luaC_fullgc (lua_State *L, int isemergency) {
+  int stopstate;
   global_State *g = G(L);
+  g->emergencygc = isemergency;
   if (g->gcstate <= GCSpropagate) {
     /* reset sweep marks to sweep all elements (returning them to white) */
     g->sweepstrgc = 0;
@@ -652,10 +666,12 @@ void luaC_fullgc (lua_State *L) {
     singlestep(L);
   }
   markroot(L);
-  while (g->gcstate != GCSpause) {
+  /* do not run finalizers during emergency GC */
+  stopstate = isemergency ? GCSfinalize : GCSpause;
+  while (g->gcstate != stopstate)
     singlestep(L);
-  }
   setthreshold(g);
+  g->emergencygc = 0;
 }
 
 
diff --git a/lgc.h b/lgc.h
index 6079c03d..bc220345 100644
--- a/lgc.h
+++ b/lgc.h
@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.h,v 2.14 2005/06/07 18:53:45 roberto Exp roberto $
+** $Id: lgc.h,v 2.15 2005/08/24 16:15:49 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -100,7 +100,7 @@ LUAI_FUNC size_t luaC_separateudata (lua_State *L, int all);
 LUAI_FUNC void luaC_callGCTM (lua_State *L);
 LUAI_FUNC void luaC_freeall (lua_State *L);
 LUAI_FUNC void luaC_step (lua_State *L);
-LUAI_FUNC void luaC_fullgc (lua_State *L);
+LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
 LUAI_FUNC void luaC_link (lua_State *L, GCObject *o, lu_byte tt);
 LUAI_FUNC void luaC_linkupval (lua_State *L, UpVal *uv);
 LUAI_FUNC void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v);
diff --git a/llex.c b/llex.c
index 6a8c158e..056bbbdb 100644
--- a/llex.c
+++ b/llex.c
@@ -1,5 +1,5 @@
 /*
-** $Id: llex.c,v 2.19 2006/02/06 18:28:16 roberto Exp roberto $
+** $Id: llex.c,v 2.20 2006/03/09 18:14:31 roberto Exp roberto $
 ** Lexical Analyzer
 ** See Copyright Notice in lua.h
 */
@@ -116,10 +116,13 @@ void luaX_syntaxerror (LexState *ls, const char *msg) {
 
 TString *luaX_newstring (LexState *ls, const char *str, size_t l) {
   lua_State *L = ls->L;
+  TValue *o;  /* entry for `str' */
   TString *ts = luaS_newlstr(L, str, l);
-  TValue *o = luaH_setstr(L, ls->fs->h, ts);  /* entry for `str' */
+  setsvalue2s(L, L->top++, ts);  /* anchor string */
+  o = luaH_setstr(L, ls->fs->h, ts);
   if (ttisnil(o))
     setbvalue(o, 1);  /* make sure `str' will not be collected */
+  L->top--;
   return ts;
 }
 
diff --git a/lmem.c b/lmem.c
index 1a3e25c4..fb383d3e 100644
--- a/lmem.c
+++ b/lmem.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lmem.c,v 1.69 2005/02/23 17:30:22 roberto Exp roberto $
+** $Id: lmem.c,v 1.70 2005/12/26 13:35:47 roberto Exp roberto $
 ** Interface to Memory Manager
 ** See Copyright Notice in lua.h
 */
@@ -14,6 +14,7 @@
 
 #include "ldebug.h"
 #include "ldo.h"
+#include "lgc.h"
 #include "lmem.h"
 #include "lobject.h"
 #include "lstate.h"
@@ -74,13 +75,25 @@ void *luaM_toobig (lua_State *L) {
 ** generic allocation routine.
 */
 void *luaM_realloc_ (lua_State *L, void *block, size_t osize, size_t nsize) {
+  void *newblock;
   global_State *g = G(L);
   lua_assert((osize == 0) == (block == NULL));
-  block = (*g->frealloc)(g->ud, block, osize, nsize);
-  if (block == NULL && nsize > 0)
-    luaD_throw(L, LUA_ERRMEM);
-  lua_assert((nsize == 0) == (block == NULL));
+#if defined(HARDMEMTESTS)
+  if (nsize > osize && g->GCthreshold != MAX_LUMEM)
+    luaC_fullgc(L, 1);  /* force a GC whenever possible */
+#endif
+  newblock = (*g->frealloc)(g->ud, block, osize, nsize);
+  if (newblock == NULL && nsize > 0) {
+    lua_assert(nsize > osize);  /* cannot fail when shrinking a block */
+    if (g->GCthreshold != MAX_LUMEM) {
+      luaC_fullgc(L, 1);  /* try to free some memory... */
+      newblock = (*g->frealloc)(g->ud, block, osize, nsize);  /* try again */
+    }
+    if (newblock == NULL)
+      luaD_throw(L, LUA_ERRMEM);
+  }
+  lua_assert((nsize == 0) == (newblock == NULL));
   g->totalbytes = (g->totalbytes - osize) + nsize;
-  return block;
+  return newblock;
 }
 
diff --git a/lobject.c b/lobject.c
index a7ee87a6..2d8475b3 100644
--- a/lobject.c
+++ b/lobject.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.c,v 2.21 2006/01/10 12:50:00 roberto Exp roberto $
+** $Id: lobject.c,v 2.22 2006/02/10 17:43:52 roberto Exp roberto $
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -34,20 +34,20 @@ const TValue luaO_nilobject_ = {{NULL}, LUA_TNIL};
 */
 int luaO_int2fb (unsigned int x) {
   int e = 0;  /* expoent */
-  while (x >= 16) {
+  if (x < 8) return x;
+  while (x >= 0x10) {
     x = (x+1) >> 1;
     e++;
   }
-  if (x < 8) return x;
-  else return ((e+1) << 3) | (cast_int(x) - 8);
+  return ((e+1) << 3) | (cast_int(x) - 8);
 }
 
 
 /* converts back */
 int luaO_fb2int (int x) {
-  int e = (x >> 3) & 31;
+  int e = (x >> 3) & 0x1f;
   if (e == 0) return x;
-  else return ((x & 7)+8) << (e - 1);
+  else return ((x & 7) + 8) << (e - 1);
 }
 
 
diff --git a/lparser.c b/lparser.c
index d10fcb59..07511fdf 100644
--- a/lparser.c
+++ b/lparser.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lparser.c,v 2.42 2006/06/05 15:57:59 roberto Exp roberto $
+** $Id: lparser.c,v 2.43 2006/06/22 16:12:59 roberto Exp roberto $
 ** Lua Parser
 ** See Copyright Notice in lua.h
 */
@@ -308,7 +308,7 @@ static void leaveblock (FuncState *fs) {
 
 
 static void pushclosure (LexState *ls, FuncState *func, expdesc *v) {
-  FuncState *fs = ls->fs;
+  FuncState *fs = ls->fs->prev;
   Proto *f = fs->f;
   int oldsize = f->sizep;
   int i;
@@ -327,8 +327,7 @@ static void pushclosure (LexState *ls, FuncState *func, expdesc *v) {
 
 static void open_func (LexState *ls, FuncState *fs) {
   lua_State *L = ls->L;
-  Proto *f = luaF_newproto(L);
-  fs->f = f;
+  Proto *f;
   fs->prev = ls->fs;  /* linked list of funcstates */
   fs->ls = ls;
   fs->L = L;
@@ -342,12 +341,15 @@ static void open_func (LexState *ls, FuncState *fs) {
   fs->nlocvars = 0;
   fs->nactvar = 0;
   fs->bl = NULL;
-  f->source = ls->source;
-  f->maxstacksize = 2;  /* registers 0/1 are always valid */
-  fs->h = luaH_new(L, 0, 0);
-  /* anchor table of constants and prototype (to avoid being collected) */
+  fs->h = luaH_new(L);
+  /* anchor table of constants (to avoid being collected) */
   sethvalue2s(L, L->top, fs->h);
   incr_top(L);
+  f = luaF_newproto(L);
+  fs->f = f;
+  f->source = ls->source;
+  f->maxstacksize = 2;  /* registers 0/1 are always valid */
+  /* anchor prototype (to avoid being collected) */
   setptvalue2s(L, L->top, f);
   incr_top(L);
 }
@@ -383,14 +385,18 @@ static void close_func (LexState *ls) {
 Proto *luaY_parser (lua_State *L, ZIO *z, Mbuffer *buff, const char *name) {
   struct LexState lexstate;
   struct FuncState funcstate;
+  TString *tname = luaS_new(L, name);
+  setsvalue2s(L, L->top, tname);  /* protect name */
+  incr_top(L);
   lexstate.buff = buff;
-  luaX_setinput(L, &lexstate, z, luaS_new(L, name));
+  luaX_setinput(L, &lexstate, z, tname);
   open_func(&lexstate, &funcstate);
   funcstate.f->is_vararg = VARARG_ISVARARG;  /* main func. is always vararg */
   luaX_next(&lexstate);  /* read first token */
   chunk(&lexstate);
   check(&lexstate, TK_EOS);
   close_func(&lexstate);
+  L->top--;
   lua_assert(funcstate.prev == NULL);
   lua_assert(funcstate.f->nups == 0);
   lua_assert(lexstate.fs == NULL);
@@ -588,8 +594,8 @@ static void body (LexState *ls, expdesc *e, int needself, int line) {
   chunk(ls);
   new_fs.f->lastlinedefined = ls->linenumber;
   check_match(ls, TK_END, TK_FUNCTION, line);
-  close_func(ls);
   pushclosure(ls, &new_fs, e);
+  close_func(ls);
 }
 
 
diff --git a/lstate.c b/lstate.c
index 8da02ed5..c9aebcba 100644
--- a/lstate.c
+++ b/lstate.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.c,v 2.35 2005/10/06 20:46:25 roberto Exp roberto $
+** $Id: lstate.c,v 2.36 2006/05/24 14:15:50 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -12,6 +12,7 @@
 
 #include "lua.h"
 
+#include "lapi.h"
 #include "ldebug.h"
 #include "ldo.h"
 #include "lfunc.h"
@@ -71,8 +72,8 @@ static void f_luaopen (lua_State *L, void *ud) {
   global_State *g = G(L);
   UNUSED(ud);
   stack_init(L, L);  /* init stack */
-  sethvalue(L, gt(L), luaH_new(L, 0, 2));  /* table of globals */
-  sethvalue(L, registry(L), luaH_new(L, 0, 2));  /* registry */
+  sethvalue(L, gt(L), luaH_new(L));  /* table of globals */
+  sethvalue(L, registry(L), luaH_new(L));  /* registry */
   luaS_resize(L, MINSTRTABSIZE);  /* initial size of string table */
   luaT_init(L);
   luaX_init(L);
@@ -116,9 +117,14 @@ static void close_state (lua_State *L) {
 }
 
 
-lua_State *luaE_newthread (lua_State *L) {
-  lua_State *L1 = tostate(luaM_malloc(L, state_size(lua_State)));
+LUA_API lua_State *lua_newthread (lua_State *L) {
+  lua_State *L1;
+  lua_lock(L);
+  luaC_checkGC(L);
+  L1 = tostate(luaM_malloc(L, state_size(lua_State)));
   luaC_link(L, obj2gco(L1), LUA_TTHREAD);
+  setthvalue(L, L->top, L1);
+  api_incr_top(L);
   preinit_state(L1, G(L));
   stack_init(L1, L);  /* init stack */
   setobj2n(L, gt(L1), gt(L));  /* share table of globals */
@@ -127,6 +133,8 @@ lua_State *luaE_newthread (lua_State *L) {
   L1->hook = L->hook;
   resethookcount(L1);
   lua_assert(iswhite(obj2gco(L1)));
+  lua_unlock(L);
+  luai_userstatethread(L, L1);
   return L1;
 }
 
@@ -152,6 +160,7 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   L->tt = LUA_TTHREAD;
   g->currentwhite = bit2mask(WHITE0BIT, FIXEDBIT);
   L->marked = luaC_white(g);
+  g->emergencygc = 0;
   set2bits(L->marked, FIXEDBIT, SFIXEDBIT);
   preinit_state(L, g);
   g->frealloc = f;
@@ -159,7 +168,7 @@ LUA_API lua_State *lua_newstate (lua_Alloc f, void *ud) {
   g->mainthread = L;
   g->uvhead.u.l.prev = &g->uvhead;
   g->uvhead.u.l.next = &g->uvhead;
-  g->GCthreshold = 0;  /* mark it as unfinished state */
+  g->GCthreshold = MAX_LUMEM;  /* no GC while building state */
   g->strt.size = 0;
   g->strt.nuse = 0;
   g->strt.hash = NULL;
diff --git a/lstate.h b/lstate.h
index 1ed893b4..89fc82d1 100644
--- a/lstate.h
+++ b/lstate.h
@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 2.23 2005/07/09 13:22:34 roberto Exp roberto $
+** $Id: lstate.h,v 2.24 2006/02/06 18:27:59 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -71,6 +71,7 @@ typedef struct global_State {
   void *ud;         /* auxiliary data to `frealloc' */
   lu_byte currentwhite;
   lu_byte gcstate;  /* state of garbage collector */
+  lu_byte emergencygc;  /* true when collect was trigged by alloc error */
   int sweepstrgc;  /* position of sweep in `strt' */
   GCObject *rootgc;  /* list of all collectable objects */
   GCObject **sweepgc;  /* position of sweep in `rootgc' */
@@ -161,7 +162,6 @@ union GCObject {
 #define obj2gco(v)	(cast(GCObject *, (v)))
 
 
-LUAI_FUNC lua_State *luaE_newthread (lua_State *L);
 LUAI_FUNC void luaE_freethread (lua_State *L, lua_State *L1);
 
 #endif
diff --git a/lstring.c b/lstring.c
index 08dbe87f..dc1a780d 100644
--- a/lstring.c
+++ b/lstring.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lstring.c,v 2.7 2005/02/18 12:40:02 roberto Exp roberto $
+** $Id: lstring.c,v 2.8 2005/12/22 16:19:56 roberto Exp roberto $
 ** String table (keeps all strings handled by Lua)
 ** See Copyright Notice in lua.h
 */
@@ -50,9 +50,11 @@ void luaS_resize (lua_State *L, int newsize) {
 static TString *newlstr (lua_State *L, const char *str, size_t l,
                                        unsigned int h) {
   TString *ts;
-  stringtable *tb;
+  stringtable *tb = &G(L)->strt;
   if (l+1 > (MAX_SIZET - sizeof(TString))/sizeof(char))
     luaM_toobig(L);
+  if (tb->nuse >= cast(lu_int32, tb->size) && tb->size <= MAX_INT/2)
+    luaS_resize(L, tb->size*2);  /* too crowded */
   ts = cast(TString *, luaM_malloc(L, (l+1)*sizeof(char)+sizeof(TString)));
   ts->tsv.len = l;
   ts->tsv.hash = h;
@@ -61,13 +63,10 @@ static TString *newlstr (lua_State *L, const char *str, size_t l,
   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.next = tb->hash[h];  /* chain new entry */
   tb->hash[h] = obj2gco(ts);
   tb->nuse++;
-  if (tb->nuse > cast(lu_int32, tb->size) && tb->size <= MAX_INT/2)
-    luaS_resize(L, tb->size*2);  /* too crowded */
   return ts;
 }
 
diff --git a/ltable.c b/ltable.c
index b68d1486..b3ad833c 100644
--- a/ltable.c
+++ b/ltable.c
@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 2.31 2006/01/10 13:13:06 roberto Exp roberto $
+** $Id: ltable.c,v 2.32 2006/01/18 11:49:02 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -294,7 +294,7 @@ static void setnodevector (lua_State *L, Table *t, int size) {
 }
 
 
-static void resize (lua_State *L, Table *t, int nasize, int nhsize) {
+void luaH_resize (lua_State *L, Table *t, int nasize, int nhsize) {
   int i;
   int oldasize = t->sizearray;
   int oldhsize = t->lsizenode;
@@ -326,7 +326,7 @@ static void resize (lua_State *L, Table *t, int nasize, int nhsize) {
 
 void luaH_resizearray (lua_State *L, Table *t, int nasize) {
   int nsize = (t->node == dummynode) ? 0 : sizenode(t);
-  resize(L, t, nasize, nsize);
+  luaH_resize(L, t, nasize, nsize);
 }
 
 
@@ -345,7 +345,7 @@ static void rehash (lua_State *L, Table *t, const TValue *ek) {
   /* compute new size for array part */
   na = computesizes(nums, &nasize);
   /* resize the table to new computed sizes */
-  resize(L, t, nasize, totaluse - na);
+  luaH_resize(L, t, nasize, totaluse - na);
 }
 
 
@@ -355,18 +355,14 @@ static void rehash (lua_State *L, Table *t, const TValue *ek) {
 */
 
 
-Table *luaH_new (lua_State *L, int narray, int nhash) {
+Table *luaH_new (lua_State *L) {
   Table *t = luaM_new(L, Table);
   luaC_link(L, obj2gco(t), LUA_TTABLE);
   t->metatable = NULL;
   t->flags = cast_byte(~0);
-  /* temporary values (kept only if some malloc fails) */
   t->array = NULL;
   t->sizearray = 0;
-  t->lsizenode = 0;
-  t->node = cast(Node *, dummynode);
-  setarrayvector(L, t, narray);
-  setnodevector(L, t, nhash);
+  setnodevector(L, t, 0);
   return t;
 }
 
diff --git a/ltable.h b/ltable.h
index e87597fd..60569fd0 100644
--- a/ltable.h
+++ b/ltable.h
@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.h,v 2.9 2006/01/10 12:51:53 roberto Exp roberto $
+** $Id: ltable.h,v 2.10 2006/01/10 13:13:06 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -24,7 +24,8 @@ LUAI_FUNC const TValue *luaH_getstr (Table *t, TString *key);
 LUAI_FUNC TValue *luaH_setstr (lua_State *L, Table *t, TString *key);
 LUAI_FUNC const TValue *luaH_get (Table *t, const TValue *key);
 LUAI_FUNC TValue *luaH_set (lua_State *L, Table *t, const TValue *key);
-LUAI_FUNC Table *luaH_new (lua_State *L, int narray, int lnhash);
+LUAI_FUNC Table *luaH_new (lua_State *L);
+LUAI_FUNC void luaH_resize (lua_State *L, Table *t, int nasize, int nhsize);
 LUAI_FUNC void luaH_resizearray (lua_State *L, Table *t, int nasize);
 LUAI_FUNC void luaH_free (lua_State *L, Table *t);
 LUAI_FUNC int luaH_next (lua_State *L, Table *t, StkId key);
diff --git a/ltests.c b/ltests.c
index 7ae9ba6f..151e1f4c 100644
--- a/ltests.c
+++ b/ltests.c
@@ -1,5 +1,5 @@
 /*
-** $Id: ltests.c,v 2.36 2006/01/10 13:13:06 roberto Exp roberto $
+** $Id: ltests.c,v 2.37 2006/06/05 19:35:57 roberto Exp roberto $
 ** Internal Module for Debugging of the Lua Implementation
 ** See Copyright Notice in lua.h
 */
@@ -55,6 +55,12 @@ static void setnameval (lua_State *L, const char *name, int val) {
 }
 
 
+static void pushobject (lua_State *L, const TValue *o) {
+  setobj2s(L, L->top, o);
+  api_incr_top(L);
+}
+
+
 /*
 ** {======================================================================
 ** Controlled version for realloc.
@@ -108,7 +114,8 @@ static void freeblock (Memcontrol *mc, void *block, size_t size) {
 
 void *debug_realloc (void *ud, void *block, size_t oldsize, size_t size) {
   Memcontrol *mc = cast(Memcontrol *, ud);
-  lua_assert(oldsize == 0 || checkblocksize(block, oldsize));
+  lua_assert((oldsize == 0) ? block == NULL :
+                              block && checkblocksize(block, oldsize));
   if (mc->memlimit == 0) {  /* first time? */
     char *limit = getenv("MEMLIMIT");  /* initialize memory limit */
     mc->memlimit = limit ? strtoul(limit, NULL, 10) : ULONG_MAX;
@@ -447,7 +454,7 @@ static int listk (lua_State *L) {
   p = clvalue(obj_at(L, 1))->l.p;
   lua_createtable(L, p->sizek, 0);
   for (i=0; i<p->sizek; i++) {
-    luaA_pushobject(L, p->k+i);
+    pushobject(L, p->k+i);
     lua_rawseti(L, -2, i+1);
   }
   return 1;
@@ -573,18 +580,18 @@ static int table_query (lua_State *L) {
   }
   else if (i < t->sizearray) {
     lua_pushinteger(L, i);
-    luaA_pushobject(L, &t->array[i]);
+    pushobject(L, &t->array[i]);
     lua_pushnil(L); 
   }
   else if ((i -= t->sizearray) < sizenode(t)) {
     if (!ttisnil(gval(gnode(t, i))) ||
         ttisnil(gkey(gnode(t, i))) ||
         ttisnumber(gkey(gnode(t, i)))) {
-      luaA_pushobject(L, key2tval(gnode(t, i)));
+      pushobject(L, key2tval(gnode(t, i)));
     }
     else
       lua_pushliteral(L, "<undef>");
-    luaA_pushobject(L, gval(gnode(t, i)));
+    pushobject(L, gval(gnode(t, i)));
     if (gnext(&t->node[i]))
       lua_pushinteger(L, gnext(&t->node[i]) - t->node);
     else
diff --git a/lvm.c b/lvm.c
index 6c92567f..50ffdfdc 100644
--- a/lvm.c
+++ b/lvm.c
@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 2.62 2006/01/23 19:51:43 roberto Exp roberto $
+** $Id: lvm.c,v 2.63 2006/06/05 15:58:59 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -85,8 +85,8 @@ static void callTMres (lua_State *L, StkId res, const TValue *f,
   setobj2s(L, L->top, f);  /* push function */
   setobj2s(L, L->top+1, p1);  /* 1st argument */
   setobj2s(L, L->top+2, p2);  /* 2nd argument */
-  luaD_checkstack(L, 3);
   L->top += 3;
+  luaD_checkstack(L, 0);
   luaD_call(L, L->top - 3, 1);
   res = restorestack(L, result);
   L->top--;
@@ -101,8 +101,8 @@ static void callTM (lua_State *L, const TValue *f, const TValue *p1,
   setobj2s(L, L->top+1, p1);  /* 1st argument */
   setobj2s(L, L->top+2, p2);  /* 2nd argument */
   setobj2s(L, L->top+3, p3);  /* 3th argument */
-  luaD_checkstack(L, 4);
   L->top += 4;
+  luaD_checkstack(L, 0);
   luaD_call(L, L->top - 4, 0);
 }
 
@@ -455,9 +455,12 @@ void luaV_execute (lua_State *L, int nexeccalls) {
         continue;
       }
       case OP_NEWTABLE: {
-        int b = GETARG_B(i);
-        int c = GETARG_C(i);
-        sethvalue(L, ra, luaH_new(L, luaO_fb2int(b), luaO_fb2int(c)));
+        int asize = luaO_fb2int(GETARG_B(i));
+        int nsize = luaO_fb2int(GETARG_C(i));
+        Table *t = luaH_new(L);
+        sethvalue(L, ra, t);
+        if (asize > 0 || nsize > 0)
+          luaH_resize(L, t, asize, nsize);
         Protect(luaC_checkGC(L));
         continue;
       }
@@ -695,10 +698,7 @@ void luaV_execute (lua_State *L, int nexeccalls) {
         int c = GETARG_C(i);
         int last;
         Table *h;
-        if (n == 0) {
-          n = cast_int(L->top - ra) - 1;
-          L->top = L->ci->top;
-        }
+        if (n == 0) n = cast_int(L->top - ra) - 1;
         if (c == 0) c = cast_int(*pc++);
         runtime_check(L, ttistable(ra));
         h = hvalue(ra);
@@ -710,6 +710,7 @@ void luaV_execute (lua_State *L, int nexeccalls) {
           setobj2t(L, luaH_setnum(L, h, last--), val);
           luaC_barriert(L, h, val);
         }
+        L->top = L->ci->top;  /* correct top (in case of previous open call) */
         continue;
       }
       case OP_CLOSE: {
@@ -724,6 +725,7 @@ void luaV_execute (lua_State *L, int nexeccalls) {
         nup = p->nups;
         ncl = luaF_newLclosure(L, nup, cl->env);
         ncl->l.p = p;
+        setclvalue(L, ra, ncl);
         for (j=0; j<nup; j++, pc++) {
           if (GET_OPCODE(*pc) == OP_GETUPVAL)
             ncl->l.upvals[j] = cl->upvals[GETARG_B(*pc)];
@@ -732,7 +734,6 @@ void luaV_execute (lua_State *L, int nexeccalls) {
             ncl->l.upvals[j] = luaF_findupval(L, base + GETARG_B(*pc));
           }
         }
-        setclvalue(L, ra, ncl);
         Protect(luaC_checkGC(L));
         continue;
       }
diff --git a/makefile b/makefile
index d57ecbad..c157b46f 100644
--- a/makefile
+++ b/makefile
@@ -9,7 +9,7 @@ CWARNS= -pedantic -Waggregate-return -Wcast-align \
         -Wsign-compare -Wstrict-prototypes -Wundef -Wwrite-strings
 # -Wcast-qual
 
-# -DEXTERNMEMCHECK -DHARDSTACKTESTS
+# -DEXTERNMEMCHECK -DHARDSTACKTESTS -DHARDMEMTESTS
 # -g -DLUA_USER_H='"ltests.h"'
 # -fomit-frame-pointer #-pg -malign-double
 TESTS= -g -DLUA_USER_H='"ltests.h"'