optimization: closures without upvalues don't need to be closures

lbuiltin.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbuiltin.c,v 1.15 1997/12/09 13:35:19 roberto Exp roberto $
+** $Id: lbuiltin.c,v 1.16 1997/12/11 17:21:11 roberto Exp roberto $
 ** Built-in functions
 ** See Copyright Notice in lua.h
 */
@@ -140,10 +140,18 @@ static char *to_string (lua_Object obj)
       sprintf(buff, "table: %p", (void *)o->value.a);
       return buff;
     }
-    case LUA_T_FUNCTION: {
+    case LUA_T_CLOSURE: {
       sprintf(buff, "function: %p", (void *)o->value.cl);
       return buff;
     }
+    case LUA_T_PROTO: {
+      sprintf(buff, "function: %p", (void *)o->value.tf);
+      return buff;
+    }
+    case LUA_T_CPROTO: {
+      sprintf(buff, "function: %p", (void *)o->value.f);
+      return buff;
+    }
     case LUA_T_USERDATA: {
       sprintf(buff, "userdata: %p", o->value.ts->u.d.v);
       return buff;
@@ -372,6 +380,20 @@ static void mem_query (void)
 }
 
 
+static void countlist (void)
+{
+  char *s = luaL_check_string(1);
+  GCnode *l = (s[0]=='t') ? L->roottable.next : (s[0]=='c') ? L->rootcl.next :
+              (s[0]=='p') ? L->rootproto.next : L->rootglobal.next;
+  int i=0;
+  while (l) {
+    i++;
+    l = l->next;
+  }
+  lua_pushnumber(i);
+}
+
+
 static void testC (void)
 {
 #define getnum(s)	((*s++) - '0')
@@ -433,6 +455,7 @@ static struct luaL_reg int_funcs[] = {
 #ifdef DEBUG
   {"testC", testC},
   {"totalmem", mem_query},
+  {"count", countlist},
 #endif
   {"assert", luaI_assert},
   {"call", luaI_call},

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.13 1997/11/27 18:25:14 roberto Exp roberto $
+** $Id: ldo.c,v 1.14 1997/12/09 13:35:19 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -44,13 +44,6 @@ static void stderrorim (void)
 }
 
 
-static void initCfunc (TObject *o, lua_CFunction f)
-{
-  ttype(o) = LUA_T_CPROTO;
-  fvalue(o) = f;
-  luaF_simpleclosure(o);
-}
-
 
 #define STACK_UNIT	128
 
@@ -60,7 +53,8 @@ void luaD_init (void)
   L->stack.stack = luaM_newvector(STACK_UNIT, TObject);
   L->stack.top = L->stack.stack;
   L->stack.last = L->stack.stack+(STACK_UNIT-1);
-  initCfunc(&L->errorim, stderrorim);
+  ttype(&L->errorim) = LUA_T_CPROTO;
+  fvalue(&L->errorim) = stderrorim;
 }
 
 
@@ -122,7 +116,7 @@ void luaD_lineHook (int line)
 }
 
 
-void luaD_callHook (StkId base, lua_Type type, int isreturn)
+void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn)
 {
   struct C_Lua_Stack oldCLS = L->Cstack;
   StkId old_top = L->Cstack.lua2C = L->Cstack.base = L->stack.top-L->stack.stack;
@@ -131,9 +125,8 @@ void luaD_callHook (StkId base, lua_Type type, int isreturn)
     (*lua_callhook)(LUA_NOOBJECT, "(return)", 0);
   else {
     TObject *f = L->stack.stack+base-1;
-    if (type == LUA_T_PROTO)
-      (*lua_callhook)(Ref(f), tfvalue(protovalue(f))->fileName->str,
-                              tfvalue(protovalue(f))->lineDefined);
+    if (tf)
+      (*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined);
     else
       (*lua_callhook)(Ref(f), "(C)", -1);
   }
@@ -147,13 +140,13 @@ void luaD_callHook (StkId base, lua_Type type, int isreturn)
 ** Cstack.num is the number of arguments; Cstack.lua2C points to the
 ** first argument. Returns an index to the first result from C.
 */
-static StkId callC (struct Closure *cl, StkId base)
+static StkId callC (struct Closure *cl, lua_CFunction f, StkId base)
 {
   struct C_Lua_Stack *CS = &L->Cstack;
   struct C_Lua_Stack oldCLS = *CS;
   StkId firstResult;
   int numarg = (L->stack.top-L->stack.stack) - base;
-  if (cl->nelems > 0) {  /* are there upvalues? */
+  if (cl) {  /* are there upvalues? */
     int i;
     luaD_checkstack(cl->nelems);
     for (i=1; i<=numarg; i++)  /* open space */
@@ -167,10 +160,10 @@ static StkId callC (struct Closure *cl, StkId base)
   CS->lua2C = base;
   CS->base = base+numarg;  /* == top-stack */
   if (lua_callhook)
-    luaD_callHook(base, LUA_T_CPROTO, 0);
-  (*(fvalue(cl->consts)))();  /* do the actual call */
+    luaD_callHook(base, NULL, 0);
+  (*f)();  /* do the actual call */
   if (lua_callhook)  /* func may have changed lua_callhook */
-    luaD_callHook(base, LUA_T_CPROTO, 1);
+    luaD_callHook(base, NULL, 1);
   firstResult = CS->base;
   *CS = oldCLS;
   return firstResult;
@@ -196,19 +189,32 @@ void luaD_call (StkId base, int nResults)
   StkId firstResult;
   TObject *func = L->stack.stack+base-1;
   int i;
-  if (ttype(func) == LUA_T_FUNCTION) {
-    TObject *proto = protovalue(func);
-    ttype(func) = LUA_T_MARK;
-    firstResult = (ttype(proto) == LUA_T_CPROTO) ? callC(clvalue(func), base)
-                                         : luaV_execute(func->value.cl, base);
-  }
-  else { /* func is not a function */
-    /* Check the tag method for invalid functions */
-    TObject *im = luaT_getimbyObj(func, IM_FUNCTION);
-    if (ttype(im) == LUA_T_NIL)
-      lua_error("call expression not a function");
-    luaD_callTM(im, (L->stack.top-L->stack.stack)-(base-1), nResults);
-    return;
+  switch (ttype(func)) {
+    case LUA_T_CPROTO:
+      ttype(func) = LUA_T_CMARK;
+      firstResult = callC(NULL, fvalue(func), base);
+      break;
+    case LUA_T_PROTO:
+      ttype(func) = LUA_T_PMARK;
+      firstResult = luaV_execute(NULL, tfvalue(func), base);
+      break;
+    case LUA_T_CLOSURE: {
+      Closure *c = clvalue(func);
+      TObject *proto = &(c->consts[0]);
+      ttype(func) = LUA_T_CLMARK;
+      firstResult = (ttype(proto) == LUA_T_CPROTO) ?
+                       callC(c, fvalue(proto), base) :
+                       luaV_execute(c, tfvalue(proto), base);
+      break;
+    }
+    default: { /* func is not a function */
+      /* Check the tag method for invalid functions */
+      TObject *im = luaT_getimbyObj(func, IM_FUNCTION);
+      if (ttype(im) == LUA_T_NIL)
+        lua_error("call expression not a function");
+      luaD_callTM(im, (L->stack.top-L->stack.stack)-(base-1), nResults);
+      return;
+    }
   }
   /* adjust the number of results */
   if (nResults != MULT_RET)

ldo.h

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.h,v 1.2 1997/11/04 15:27:53 roberto Exp roberto $
+** $Id: ldo.h,v 1.3 1997/11/19 17:29:23 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -34,7 +34,7 @@ void luaD_init (void);
 void luaD_adjusttop (StkId newtop);
 void luaD_openstack (int nelems);
 void luaD_lineHook (int line);
-void luaD_callHook (StkId base, lua_Type type, int isreturn);
+void luaD_callHook (StkId base, TProtoFunc *tf, int isreturn);
 void luaD_call (StkId base, int nResults);
 void luaD_callTM (TObject *f, int nParams, int nResults);
 int luaD_protectedrun (int nResults);

lfunc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.c,v 1.6 1997/11/19 17:29:23 roberto Exp roberto $
+** $Id: lfunc.c,v 1.7 1997/12/09 13:35:19 roberto Exp roberto $
 ** Auxiliar functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
@@ -26,15 +26,6 @@ Closure *luaF_newclosure (int nelems)
 }
 
 
-void luaF_simpleclosure (TObject *o)
-{
-  Closure *c = luaF_newclosure(0);
-  c->consts[0] = *o;
-  ttype(o) = LUA_T_FUNCTION;
-  clvalue(o) = c;
-}
-
-
 TProtoFunc *luaF_newproto (void)
 {
   TProtoFunc *f = luaM_new(TProtoFunc);

lfunc.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.h,v 1.3 1997/10/24 17:17:24 roberto Exp roberto $
+** $Id: lfunc.h,v 1.4 1997/11/19 17:29:23 roberto Exp roberto $
 ** Lua Function structures
 ** See Copyright Notice in lua.h
 */
@@ -16,7 +16,6 @@ TProtoFunc *luaF_newproto (void);
 Closure *luaF_newclosure (int nelems);
 void luaF_freeproto (TProtoFunc *l);
 void luaF_freeclosure (Closure *l);
-void luaF_simpleclosure (TObject *o);
 
 char *luaF_getlocalname (TProtoFunc *func, int local_number, int line);
 

lgc.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lgc.c,v 1.11 1997/12/09 13:35:19 roberto Exp roberto $
+** $Id: lgc.c,v 1.12 1997/12/11 14:48:46 roberto Exp roberto $
 ** Garbage Collector
 ** See Copyright Notice in lua.h
 */
@@ -87,13 +87,15 @@ static int ismarked (TObject *o)
   switch (o->ttype) {
     case LUA_T_STRING: case LUA_T_USERDATA:
       return o->value.ts->head.marked;
-    case LUA_T_FUNCTION:
+    case LUA_T_CLOSURE:
       return o->value.cl->head.marked;
+    case LUA_T_PROTO:
+      return o->value.tf->head.marked;
     case LUA_T_ARRAY:
       return o->value.a->head.marked;
 #ifdef DEBUG
-    case LUA_T_LINE: case LUA_T_MARK:
-    case LUA_T_PROTO: case LUA_T_CPROTO:
+    case LUA_T_LINE: case LUA_T_CLMARK:
+    case LUA_T_CMARK: case LUA_T_PMARK:
       lua_error("internal error");
 #endif
     default:  /* nil, number or cproto */
@@ -180,7 +182,7 @@ static void protomark (TProtoFunc *f)
 }
 
 
-static void funcmark (Closure *f)
+static void closuremark (Closure *f)
 {
   if (!f->head.marked) {
     int i;
@@ -227,10 +229,10 @@ static int markobject (TObject *o)
     case LUA_T_ARRAY:
       hashmark(avalue(o));
       break;
-    case LUA_T_FUNCTION:  case LUA_T_MARK:
-      funcmark(o->value.cl);
+    case LUA_T_CLOSURE:  case LUA_T_CLMARK:
+      closuremark(o->value.cl);
       break;
-    case LUA_T_PROTO:
+    case LUA_T_PROTO: case LUA_T_PMARK:
       protomark(o->value.tf);
       break;
     default: break;  /* numbers, cprotos, etc */

lobject.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.c,v 1.6 1997/11/03 20:45:23 roberto Exp roberto $
+** $Id: lobject.c,v 1.7 1997/11/19 17:29:23 roberto Exp roberto $
 ** Some generic functions over Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -12,8 +12,8 @@
 
 
 char *luaO_typenames[] = { /* ORDER LUA_T */
-    "userdata", "number", "string", "table", "prototype", "cprototype",
-    "nil", "function", "mark", "cmark", "line", NULL
+    "userdata", "number", "string", "table", "function", "function",
+    "nil", "function", "mark", "mark", "mark", "line", NULL
 };
 
 
@@ -48,7 +48,9 @@ int luaO_equalObj (TObject *t1, TObject *t2)
     case LUA_T_NUMBER: return nvalue(t1) == nvalue(t2);
     case LUA_T_STRING: case LUA_T_USERDATA: return svalue(t1) == svalue(t2);
     case LUA_T_ARRAY: return avalue(t1) == avalue(t2);
-    case LUA_T_FUNCTION: return t1->value.cl == t2->value.cl;
+    case LUA_T_CLOSURE: return t1->value.cl == t2->value.cl;
+    case LUA_T_PROTO: return tfvalue(t1)  == tfvalue(t2);
+    case LUA_T_CPROTO: return fvalue(t1)  == fvalue(t2);
     default:
      lua_error("internal error in `lua_equalObj'");
      return 0; /* UNREACHEABLE */

lobject.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lobject.h,v 1.9 1997/11/19 17:29:23 roberto Exp roberto $
+** $Id: lobject.h,v 1.10 1997/11/27 18:25:06 roberto Exp roberto $
 ** Type definitions for Lua objects
 ** See Copyright Notice in lua.h
 */
@@ -42,9 +42,11 @@ typedef enum {
   LUA_T_PROTO    = -4,  /* fixed tag for functions */
   LUA_T_CPROTO   = -5,  /* fixed tag for Cfunctions */
   LUA_T_NIL      = -6,  /* last "pre-defined" tag */
-  LUA_T_FUNCTION = -7,
-  LUA_T_MARK     = -8,
-  LUA_T_LINE     = -10
+  LUA_T_CLOSURE  = -7,
+  LUA_T_CLMARK   = -8,  /* mark for closures */
+  LUA_T_PMARK    = -9,  /* mark for Lua prototypes */
+  LUA_T_CMARK    = -10, /* mark for C prototypes */
+  LUA_T_LINE     = -11
 } lua_Type;
 
 #define NUM_TYPES 11
@@ -52,11 +54,11 @@ typedef enum {
 
 
 typedef union {
-  lua_CFunction f;  /* LUA_T_CPROTO */
+  lua_CFunction f;  /* LUA_T_CPROTO, LUA_T_CMARK */
   real n;  /* LUA_T_NUMBER */
   struct TaggedString *ts;  /* LUA_T_STRING, LUA_T_USERDATA */
-  struct TProtoFunc *tf;  /* LUA_T_PROTO */
-  struct Closure *cl;  /* LUA_T_FUNCTION, LUA_T_MARK */
+  struct TProtoFunc *tf;  /* LUA_T_PROTO, LUA_T_PMARK */
+  struct Closure *cl;  /* LUA_T_CLOSURE, LUA_T_CLMARK */
   struct Hash *a;  /* LUA_T_ARRAY */
   int i;  /* LUA_T_LINE */
 } Value;
@@ -133,6 +135,7 @@ typedef struct LocVar {
 
 #define protovalue(o)	((o)->value.cl->consts)
 
+
 /*
 ** Closures
 */

ltable.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltable.c,v 1.7 1997/11/21 19:00:46 roberto Exp roberto $
+** $Id: ltable.c,v 1.8 1997/12/09 13:35:19 roberto Exp roberto $
 ** Lua tables (hash)
 ** See Copyright Notice in lua.h
 */
@@ -36,9 +36,15 @@ static long int hashindex (TObject *ref)
     case LUA_T_STRING: case LUA_T_USERDATA:
       h = (IntPoint)tsvalue(ref);
       break;
-    case LUA_T_FUNCTION:
+    case LUA_T_CLOSURE:
       h = (IntPoint)clvalue(ref);
       break;
+    case LUA_T_PROTO:
+      h = (IntPoint)tfvalue(ref);
+      break;
+    case LUA_T_CPROTO:
+      h = (IntPoint)fvalue(ref);
+      break;
     case LUA_T_ARRAY:
       h = (IntPoint)avalue(ref);
       break;

ltm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ltm.c,v 1.10 1997/12/11 14:48:46 roberto Exp roberto $
+** $Id: ltm.c,v 1.11 1997/12/11 17:21:11 roberto Exp roberto $
 ** Tag methods
 ** See Copyright Notice in lua.h
 */
@@ -112,16 +112,17 @@ int luaT_efectivetag (TObject *o)
 {
   int t;
   switch (t = ttype(o)) {
+    case LUA_T_ARRAY:
+      return o->value.a->htag;
     case LUA_T_USERDATA: {
       int tag = o->value.ts->u.d.tag;
       return (tag >= 0) ? LUA_T_USERDATA : tag;
     }
-    case LUA_T_ARRAY:
-      return o->value.a->htag;
-    case LUA_T_FUNCTION: case LUA_T_MARK:
+    case LUA_T_CLOSURE:
       return o->value.cl->consts[0].ttype;
 #ifdef DEBUG
-     case LUA_T_LINE: case LUA_T_PROTO: case LUA_T_CPROTO:
+    case LUA_T_PMARK: case LUA_T_CMARK:
+    case LUA_T_CLMARK: case LUA_T_LINE:
       lua_error("internal error");
 #endif
     default:

lua.stx

@@ -1,6 +1,6 @@
 %{
 /*
-** $Id: lua.stx,v 1.21 1997/12/09 13:35:19 roberto Exp roberto $
+** $Id: lua.stx,v 1.22 1997/12/09 16:01:08 roberto Exp roberto $
 ** Syntax analizer and code generator
 ** See Copyright Notice in lua.h
 */
@@ -555,10 +555,14 @@ static void func_onstack (TProtoFunc *f)
   int c = next_constant(L->currState);
   ttype(&L->currState->f->consts[c]) = LUA_T_PROTO;
   L->currState->f->consts[c].value.tf = (L->currState+1)->f;
-  for (i=0; i<nupvalues; i++)
-    lua_pushvar((L->currState+1)->upvalues[i]);
-  code_constant(c);
-  code_oparg(CLOSURE, 2, nupvalues, -nupvalues);
+  if (nupvalues == 0)
+    code_constant(c);
+  else {
+    for (i=0; i<nupvalues; i++)
+      lua_pushvar((L->currState+1)->upvalues[i]);
+    code_constant(c);
+    code_oparg(CLOSURE, 2, nupvalues, -nupvalues);
+  }
 }
 
 

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.15 1997/11/21 19:00:46 roberto Exp roberto $
+** $Id: lvm.c,v 1.16 1997/12/09 13:35:19 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -79,13 +79,15 @@ int luaV_tostring (TObject *obj)
 
 void luaV_closure (int nelems)
 {
-  struct Stack *S = &L->stack;
-  Closure *c = luaF_newclosure(nelems);
-  c->consts[0] = *(S->top-1);
-  memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject));
-  S->top -= nelems;
-  ttype(S->top-1) = LUA_T_FUNCTION;
-  (S->top-1)->value.cl = c;
+  if (nelems > 0) {
+    struct Stack *S = &L->stack;
+    Closure *c = luaF_newclosure(nelems);
+    c->consts[0] = *(S->top-1);
+    memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject));
+    S->top -= nelems;
+    ttype(S->top-1) = LUA_T_CLOSURE;
+    (S->top-1)->value.cl = c;
+  }
 }
 
 
@@ -279,13 +281,13 @@ static void adjust_varargs (StkId first_extra_arg)
 ** [stack+base,top). Returns n such that the the results are between
 ** [stack+n,top).
 */
-StkId luaV_execute (Closure *cl, StkId base)
+StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
 {
   struct Stack *S = &L->stack;  /* to optimize */
-  Byte *pc = cl->consts[0].value.tf->code;
-  TObject *consts = cl->consts[0].value.tf->consts;
+  Byte *pc = tf->code;
+  TObject *consts = tf->consts;
   if (lua_callhook)
-    luaD_callHook(base, LUA_T_PROTO, 0);
+    luaD_callHook(base, tf, 0);
   luaD_checkstack((*pc++)+EXTRA_STACK);
   while (1) {
     int aux;
@@ -679,7 +681,7 @@ StkId luaV_execute (Closure *cl, StkId base)
         /* goes through */
       case RETCODE:
         if (lua_callhook)
-          luaD_callHook(base, LUA_T_PROTO, 1);
+          luaD_callHook(base, NULL, 1);
         return (base + ((aux==RETCODE) ? *pc : 0));
 
       case SETLINEW:

lvm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.h,v 1.2 1997/09/26 15:02:26 roberto Exp roberto $
+** $Id: lvm.h,v 1.3 1997/10/16 10:59:34 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -23,7 +23,7 @@ void luaV_gettable (void);
 void luaV_settable (TObject *t, int mode);
 void luaV_getglobal (TaggedString *ts);
 void luaV_setglobal (TaggedString *ts);
-StkId luaV_execute (Closure *func, StkId base);
+StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base);
 void luaV_closure (int nelems);
 
 #endif