Lua closures are cached for reuse

lfunc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.c,v 2.23 2010/04/29 21:43:36 roberto Exp roberto $
+** $Id: lfunc.c,v 2.24 2010/05/10 18:23:45 roberto Exp roberto $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
@@ -29,9 +29,11 @@ Closure *luaF_newCclosure (lua_State *L, int n) {
 }
 
 
-Closure *luaF_newLclosure (lua_State *L, int n) {
+Closure *luaF_newLclosure (lua_State *L, Proto *p) {
+  int n = p->sizeupvalues;
   Closure *c = &luaC_newobj(L, LUA_TFUNCTION, sizeLclosure(n), NULL, 0)->cl;
   c->l.isC = 0;
+  c->l.p = p;
   c->l.nupvalues = cast_byte(n);
   while (n--) c->l.upvals[n] = NULL;
   return c;
@@ -116,6 +118,7 @@ Proto *luaF_newproto (lua_State *L) {
   f->p = NULL;
   f->sizep = 0;
   f->code = NULL;
+  f->cache = NULL;
   f->sizecode = 0;
   f->lineinfo = NULL;
   f->sizelineinfo = 0;

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 2.96 2010/05/17 20:39:31 roberto Exp roberto $
+** $Id: lgc.c,v 2.97 2010/06/02 18:36:58 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -127,7 +127,7 @@ static int iscleared (const TValue *o, int iskey) {
 ** barrier that moves collector forward, that is, mark the white object
 ** being pointed by a black object.
 */
-void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v) {
+void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v) {
   global_State *g = G(L);
   lua_assert(isblack(o) && iswhite(v) && !isdead(g, v) && !isdead(g, o));
   lua_assert(isgenerational(g) || g->gcstate != GCSpause);
@@ -143,18 +143,31 @@ void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v) {
 
 /*
 ** barrier that moves collector backward, that is, mark the black object
-** pointing to a white object as gray again.
+** pointing to a white object as gray again. (Current implementation
+** only works for tables; access to 'gclist' is not uniform across
+** different types.)
 */
-void luaC_barrierback (lua_State *L, Table *t) {
+void luaC_barrierback_ (lua_State *L, GCObject *o) {
   global_State *g = G(L);
-  GCObject *o = obj2gco(t);
   lua_assert(isblack(o) && !isdead(g, o));
-  black2gray(o);  /* make table gray (again) */
-  t->gclist = g->grayagain;
+  black2gray(o);  /* make object gray (again) */
+  gco2t(o)->gclist = g->grayagain;
   g->grayagain = o;
 }
 
 
+/*
+** barrier for prototypes
+*/
+LUAI_FUNC void luaC_barrierproto_ (lua_State *L, GCObject *p) {
+  global_State *g = G(L);
+  lua_assert(isblack(p));
+  black2gray(p);  /* make object gray (again) */
+  gco2p(p)->gclist = g->clearcache;
+  g->clearcache = p;
+}
+
+
 /*
 ** check color (and invariants) for an upvalue that was closed,
 ** i.e., moved into the 'allgc' list
@@ -299,7 +312,7 @@ static void remarkupvals (global_State *g) {
 static void markroot (lua_State *L) {
   global_State *g = G(L);
   g->gray = g->grayagain = NULL;
-  g->weak = g->allweak = g->ephemeron = NULL;
+  g->weak = g->allweak = g->ephemeron = g->clearcache = NULL;
   markobject(g, g->mainthread);
   markvalue(g, &g->l_registry);
   markmt(g);
@@ -409,8 +422,19 @@ static int traversetable (global_State *g, Table *h) {
 }
 
 
+/*
+** if prototype's cached closure is not marked, erase it so it
+** can be collected
+*/
+static void checkcache (Proto *p) {
+  if (p->cache && iswhite(obj2gco(p->cache)))
+    p->cache = NULL;  /* allow cache to be collected */
+}
+
+
 static int traverseproto (global_State *g, Proto *f) {
   int i;
+  checkcache(f);
   stringmark(f->source);
   for (i = 0; i < f->sizek; i++)  /* mark literals */
     markvalue(g, &f->k[i]);
@@ -533,6 +557,15 @@ static void convergeephemerons (global_State *g) {
 ** =======================================================
 */
 
+/*
+** clear cache field in all prototypes in list 'l'
+*/
+static void clearproto (GCObject *l) {
+  for (; l != NULL; l = gco2p(l)->gclist)
+    checkcache(gco2p(l));
+}
+
+
 /*
 ** clear collected entries from all weaktables in list 'l'
 */
@@ -845,6 +878,7 @@ static void atomic (lua_State *L) {
   cleartable(g->weak);
   cleartable(g->ephemeron);
   cleartable(g->allweak);
+  clearproto(g->clearcache);
   g->sweepstrgc = 0;  /* prepare to sweep strings */
   g->gcstate = GCSsweepstring;
   g->currentwhite = cast_byte(otherwhite(g));  /* flip current white */

lgc.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.h,v 2.40 2010/05/10 16:46:49 roberto Exp roberto $
+** $Id: lgc.h,v 2.41 2010/05/10 18:23:45 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -112,17 +112,20 @@
 
 
 #define luaC_barrier(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p)))  \
-	luaC_barrierf(L,obj2gco(p),gcvalue(v)); }
+	luaC_barrier_(L,obj2gco(p),gcvalue(v)); }
 
-#define luaC_barriert(L,t,v) { if (valiswhite(v) && isblack(obj2gco(t)))  \
-	luaC_barrierback(L,t); }
+#define luaC_barrierback(L,p,v) { if (valiswhite(v) && isblack(obj2gco(p)))  \
+	luaC_barrierback_(L,p); }
 
 #define luaC_objbarrier(L,p,o)  \
 	{ if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) \
-		luaC_barrierf(L,obj2gco(p),obj2gco(o)); }
+		luaC_barrier_(L,obj2gco(p),obj2gco(o)); }
 
-#define luaC_objbarriert(L,t,o)  \
-   { if (iswhite(obj2gco(o)) && isblack(obj2gco(t))) luaC_barrierback(L,t); }
+#define luaC_objbarrierback(L,p,o)  \
+   { if (iswhite(obj2gco(o)) && isblack(obj2gco(p))) luaC_barrierback_(L,p); }
+
+#define luaC_barrierproto(L,p) \
+   { if (isblack(obj2gco(p))) luaC_barrierproto_(L,p); }
 
 LUAI_FUNC void luaC_separateudata (lua_State *L, int all);
 LUAI_FUNC void luaC_freeallobjects (lua_State *L);
@@ -131,8 +134,9 @@ LUAI_FUNC void luaC_runtilstate (lua_State *L, int statesmask);
 LUAI_FUNC void luaC_fullgc (lua_State *L, int isemergency);
 LUAI_FUNC GCObject *luaC_newobj (lua_State *L, int tt, size_t sz,
                                  GCObject **list, int offset);
-LUAI_FUNC void luaC_barrierf (lua_State *L, GCObject *o, GCObject *v);
-LUAI_FUNC void luaC_barrierback (lua_State *L, Table *t);
+LUAI_FUNC void luaC_barrier_ (lua_State *L, GCObject *o, GCObject *v);
+LUAI_FUNC void luaC_barrierback_ (lua_State *L, GCObject *o);
+LUAI_FUNC void luaC_barrierproto_ (lua_State *L, GCObject *p);
 LUAI_FUNC void luaC_checkfinalizer (lua_State *L, Udata *u);
 LUAI_FUNC void luaC_checkupvalcolor (global_State *g, UpVal *uv);
 LUAI_FUNC void luaC_changemode (lua_State *L, int mode);

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 2.39 2010/04/18 13:22:48 roberto Exp roberto $
+** $Id: lobject.h,v 2.40 2010/05/07 18:44:46 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -266,6 +266,7 @@ typedef struct Proto {
   int *lineinfo;  /* map from opcodes to source lines */
   struct LocVar *locvars;  /* information about local variables */
   Upvaldesc *upvalues;  /* upvalue information */
+  union Closure *cache;  /* last created closure with this prototype */
   TString  *source;
   int sizeupvalues;  /* size of 'upvalues' */
   int sizek;  /* size of `k' */

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 2.119 2010/05/12 20:40:35 roberto Exp roberto $
+** $Id: lvm.c,v 2.120 2010/05/13 19:53:05 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -136,7 +136,7 @@ void luaV_settable (lua_State *L, const TValue *t, TValue *key, StkId val) {
       if (!ttisnil(oldval) ||  /* result is not nil? */
           (tm = fasttm(L, h->metatable, TM_NEWINDEX)) == NULL) { /* or no TM? */
         setobj2t(L, oldval, val);
-        luaC_barriert(L, h, val);
+        luaC_barrierback(L, obj2gco(h), val);
         return;
       }
       /* else will try the tag method */
@@ -345,6 +345,49 @@ void luaV_arith (lua_State *L, StkId ra, const TValue *rb,
 }
 
 
+/*
+** check whether cached closure in prototype 'p' may be reused, that is,
+** whether there is a cached closure with the same upvalues needed by
+** new closure to be created.
+*/
+static Closure *getcached (Proto *p, UpVal **encup, StkId base) {
+  Closure *c = p->cache;
+  if (c != NULL) {  /* is there a cached closure? */
+    int nup = p->sizeupvalues;
+    Upvaldesc *uv = p->upvalues;
+    int i;
+    for (i = 0; i < nup; i++) {  /* check whether it has right upvalues */
+      TValue *v = uv[i].instack ? base + uv[i].idx : encup[uv[i].idx]->v;
+      if (c->l.upvals[i]->v != v)
+        return NULL;  /* wrong upvalue; cannot reuse closure */
+    }
+  }
+  return c;  /* return cached closure (or NULL if no cached closure) */
+}
+
+
+/*
+** create a new Lua closure, push it in the stack, and initialize
+** its upvalues
+*/
+static void pushclosure (lua_State *L, Proto *p, UpVal **encup, StkId base,
+                         StkId ra) {
+  int nup = p->sizeupvalues;
+  Upvaldesc *uv = p->upvalues;
+  int i;
+  Closure *ncl = luaF_newLclosure(L, p);
+  setclvalue(L, ra, ncl);  /* anchor new closure in stack */
+  for (i = 0; i < nup; i++) {  /* fill in its upvalues */
+    if (uv[i].instack)  /* upvalue refers to local variable? */
+      ncl->l.upvals[i] = luaF_findupval(L, base + uv[i].idx);
+    else  /* get upvalue from enclosing function */
+      ncl->l.upvals[i] = encup[uv[i].idx];
+  }
+  p->cache = ncl;  /* save it on cache, so it can be reused */
+  luaC_barrierproto(L, obj2gco(p));
+}
+
+
 /*
 ** finish execution of an opcode interrupted by an yield
 */
@@ -721,7 +764,7 @@ void luaV_execute (lua_State *L) {
         for (; n > 0; n--) {
           TValue *val = ra+n;
           setobj2t(L, luaH_setint(L, h, last--), val);
-          luaC_barriert(L, h, val);
+          luaC_barrierback(L, obj2gco(h), val);
         }
         L->top = ci->top;  /* correct top (in case of previous open call) */
       )
@@ -729,19 +772,12 @@ void luaV_execute (lua_State *L) {
         luaF_close(L, ra);
       )
       vmcase(OP_CLOSURE,
-        Proto *p = cl->p->p[GETARG_Bx(i)];  /* prototype for new closure */
-        int nup = p->sizeupvalues;
-        Closure *ncl = luaF_newLclosure(L, nup);
-        Upvaldesc *uv = p->upvalues;
-        int j;
-        ncl->l.p = p;
-        setclvalue(L, ra, ncl);  /* anchor new closure in stack */
-        for (j = 0; j < nup; j++) {  /* fill in upvalues */
-          if (uv[j].instack)  /* upvalue refers to local variable? */
-            ncl->l.upvals[j] = luaF_findupval(L, base + uv[j].idx);
-          else  /* get upvalue from enclosing function */
-            ncl->l.upvals[j] = cl->upvals[uv[j].idx];
-        }
+        Proto *p = cl->p->p[GETARG_Bx(i)];
+        Closure *ncl = getcached(p, cl->upvals, base);  /* cached closure */
+        if (ncl == NULL)  /* no match? */
+          pushclosure(L, p, cl->upvals, base, ra);  /* create a new one */
+        else
+          setclvalue(L, ra, ncl);  /* push cashed closure */
         checkGC(L);
       )
       vmcase(OP_VARARG,