first implementation of unrestricted static scoping

lapi.c

@@ -248,7 +248,7 @@ LUA_API size_t lua_strlen (lua_State *L, int index) {
 
 LUA_API lua_CFunction lua_tocfunction (lua_State *L, int index) {
   StkId o = luaA_indexAcceptable(L, index);
-  return (o == NULL || !iscfunction(o)) ? NULL : clvalue(o)->f.c;
+  return (o == NULL || !iscfunction(o)) ? NULL : clvalue(o)->u.c.f;
 }
 
 
@@ -310,9 +310,16 @@ LUA_API void lua_pushstring (lua_State *L, const l_char *s) {
 
 
 LUA_API void lua_pushcclosure (lua_State *L, lua_CFunction fn, int n) {
+  Closure *cl;
   lua_lock(L);
   api_checknelems(L, n);
-  luaV_Cclosure(L, fn, n);
+  cl = luaF_newCclosure(L, n);
+  cl->u.c.f = fn;
+  L->top -= n;
+  while (n--)
+    setobj(&cl->u.c.upvalue[n], L->top+n);
+  setclvalue(L->top, cl);
+  incr_top;
   lua_unlock(L);
 }
 

lcode.c

@@ -273,6 +273,11 @@ void luaK_dischargevars (FuncState *fs, expdesc *e) {
       e->k = VNONRELOC;
       break;
     }
+    case VUPVAL: {
+      e->u.i.info = luaK_codeABC(fs, OP_GETUPVAL, 0, e->u.i.info, 0);
+      e->k = VRELOCABLE;
+      break;
+    }
     case VGLOBAL: {
       e->u.i.info = luaK_codeABc(fs, OP_GETGLOBAL, 0, e->u.i.info);
       e->k = VRELOCABLE;
@@ -437,6 +442,12 @@ void luaK_storevar (FuncState *fs, expdesc *var, expdesc *exp) {
       luaK_exp2reg(fs, exp, var->u.i.info);
       break;
     }
+    case VUPVAL: {
+      int e = luaK_exp2anyreg(fs, exp);
+      freereg(fs, e);
+      luaK_codeABC(fs, OP_SETUPVAL, e, var->u.i.info, 0);
+      break;
+    }
     case VGLOBAL: {
       int e = luaK_exp2anyreg(fs, exp);
       freereg(fs, e);

ldebug.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldebug.c,v 1.86 2001/06/28 19:58:57 roberto Exp roberto $
+** $Id: ldebug.c,v 1.87 2001/07/03 17:01:34 roberto Exp $
 ** Debug Interface
 ** See Copyright Notice in lua.h
 */
@@ -117,7 +117,7 @@ int luaG_getline (int *lineinfo, int pc, int refline, int *prefi) {
 static int currentpc (CallInfo *ci) {
   lua_assert(isLmark(ci));
   if (ci->pc)
-    return (*ci->pc - ci_func(ci)->f.l->code) - 1;
+    return (*ci->pc - ci_func(ci)->u.l.p->code) - 1;
   else
     return -1;  /* function is not active */
 }
@@ -127,7 +127,7 @@ static int currentline (CallInfo *ci) {
   if (!isLmark(ci))
     return -1;  /* only active lua functions have current-line information */
   else {
-    int *lineinfo = ci_func(ci)->f.l->lineinfo;
+    int *lineinfo = ci_func(ci)->u.l.p->lineinfo;
     return luaG_getline(lineinfo, currentpc(ci), 1, NULL);
   }
 }
@@ -135,7 +135,7 @@ static int currentline (CallInfo *ci) {
 
 
 static Proto *getluaproto (CallInfo *ci) {
-  return (isLmark(ci) ? ci_func(ci)->f.l : NULL);
+  return (isLmark(ci) ? ci_func(ci)->u.l.p : NULL);
 }
 
 
@@ -199,7 +199,7 @@ static void funcinfo (lua_State *L, lua_Debug *ar, StkId func) {
     ar->what = l_s("C");
   }
   else
-    infoLproto(ar, cl->f.l);
+    infoLproto(ar, cl->u.l.p);
   luaO_chunkid(ar->short_src, ar->source, LUA_IDSIZE);
   if (ar->linedefined == 0)
     ar->what = l_s("main");
@@ -323,14 +323,15 @@ static int precheck (const Proto *pt) {
 }
 
 
-static int checkopenop (Instruction i) {
-  OpCode op = GET_OPCODE(i);
-  switch (op) {
+static int checkopenop (const Proto *pt, int pc) {
+  Instruction i = pt->code[pc+1];
+  switch (GET_OPCODE(i)) {
     case OP_CALL:
     case OP_RETURN: {
       check(GETARG_B(i) == NO_REG);
       return 1;
     }
+    case OP_CLOSE: return checkopenop(pt, pc+1);
     case OP_SETLISTO: return 1;
     default: return 0;  /* invalid instruction after an open call */
   }
@@ -382,7 +383,8 @@ static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
           last = pc;  /* set registers from `a' to `b' */
         break;
       }
-      case OP_LOADUPVAL: {
+      case OP_GETUPVAL:
+      case OP_SETUPVAL: {
         check(b < pt->nupvalues);
         break;
       }
@@ -419,7 +421,7 @@ static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
           checkreg(pt, a+b);
         }
         if (c == NO_REG) {
-          check(checkopenop(pt->code[pc+1]));
+          check(checkopenop(pt, pc));
         }
         else if (c != 0)
           checkreg(pt, a+c-1);
@@ -452,7 +454,7 @@ static Instruction luaG_symbexec (const Proto *pt, int lastpc, int reg) {
       }
       case OP_CLOSURE: {
         check(b < pt->sizep);
-        checkreg(pt, a + pt->p[b]->nupvalues - 1);
+        check(pc + pt->p[b]->nupvalues < pt->sizecode);
         break;
       }
       default: break;
@@ -472,7 +474,7 @@ int luaG_checkcode (const Proto *pt) {
 static const l_char *getobjname (lua_State *L, StkId obj, const l_char **name) {
   CallInfo *ci = ci_stack(L, obj);
   if (isLmark(ci)) {  /* an active Lua function? */
-    Proto *p = ci_func(ci)->f.l;
+    Proto *p = ci_func(ci)->u.l.p;
     int pc = currentpc(ci);
     int stackpos = obj - ci->base;
     Instruction i;
@@ -516,7 +518,7 @@ static const l_char *getfuncname (lua_State *L, CallInfo *ci,
   if (ci == &L->basefunc || !isLmark(ci))
     return NULL;  /* not an active Lua function */
   else {
-    Proto *p = ci_func(ci)->f.l;
+    Proto *p = ci_func(ci)->u.l.p;
     int pc = currentpc(ci);
     Instruction i;
     if (pc == -1) return NULL;  /* function is not activated */

ldo.c

@@ -15,6 +15,7 @@
 
 #include "ldebug.h"
 #include "ldo.h"
+#include "lfunc.h"
 #include "lgc.h"
 #include "lmem.h"
 #include "lobject.h"
@@ -122,9 +123,9 @@ static StkId callCclosure (lua_State *L, const struct Closure *cl) {
   int n;
   luaD_checkstack(L, nup+LUA_MINSTACK);  /* ensure minimum stack size */
   for (n=0; n<nup; n++)  /* copy upvalues as extra arguments */
-    setobj(L->top++, &cl->upvalue[n]);
+    setobj(L->top++, &cl->u.c.upvalue[n]);
   lua_unlock(L);
-  n = (*cl->f.c)(L);  /* do the actual call */
+  n = (*cl->u.c.f)(L);  /* do the actual call */
   lua_lock(L);
   return L->top - n;  /* return index of first result */
 }
@@ -209,7 +210,12 @@ struct SParser {  /* data to `f_parser' */
 static void f_parser (lua_State *L, void *ud) {
   struct SParser *p = cast(struct SParser *, ud);
   Proto *tf = p->bin ? luaU_undump(L, p->z) : luaY_parser(L, p->z);
-  luaV_Lclosure(L, tf, 0);
+  Closure *cl = luaF_newLclosure(L, 0);
+  cl->u.l.p = tf;
+  luaF_LConlist(L, cl);
+  setclvalue(L->top, cl);
+  incr_top;
+  
 }
 
 
@@ -286,6 +292,9 @@ struct lua_longjmp {
   jmp_buf b;
   struct lua_longjmp *previous;
   volatile int status;  /* error code */
+  CallInfo *ci;  /* call info of active function that set protection */
+  StkId top;  /* top stack when protection was set */
+  int allowhooks;  /* `allowhook' state when protection was set */
 };
 
 
@@ -325,19 +334,20 @@ void luaD_breakrun (lua_State *L, int errcode) {
 
 
 int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) {
-  CallInfo *oldci = L->ci;
-  StkId oldtop = L->top;
   struct lua_longjmp lj;
-  int allowhooks = L->allowhooks;
+  lj.ci = L->ci;
+  lj.top = L->top;
+  lj.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->ci = oldci;
-    L->top = oldtop;
+    luaF_close(L, lj.top);  /* close eventual pending closures */
+    L->ci = lj.ci;
+    L->top = lj.top;
+    L->allowhooks = lj.allowhooks;
     restore_stack_limit(L);
   }
   L->errorJmp = lj.previous;  /* restore old error handler */

lfunc.c

@@ -12,15 +12,20 @@
 
 #include "lfunc.h"
 #include "lmem.h"
+#include "lobject.h"
 #include "lstate.h"
 
 
-#define sizeclosure(n)	(cast(int, sizeof(Closure)) + \
+#define sizeCclosure(n)	(cast(int, sizeof(Closure)) + \
                          cast(int, sizeof(TObject)*((n)-1)))
 
+#define sizeLclosure(n)	(cast(int, sizeof(Closure)) + \
+                         cast(int, sizeof(TObject *)*((n)-1)))
 
-Closure *luaF_newclosure (lua_State *L, int nelems) {
-  Closure *c = cast(Closure *, luaM_malloc(L, sizeclosure(nelems)));
+
+Closure *luaF_newCclosure (lua_State *L, int nelems) {
+  Closure *c = cast(Closure *, luaM_malloc(L, sizeCclosure(nelems)));
+  c->isC = 1;
   c->next = G(L)->rootcl;
   G(L)->rootcl = c;
   c->mark = c;
@@ -29,6 +34,90 @@ Closure *luaF_newclosure (lua_State *L, int nelems) {
 }
 
 
+Closure *luaF_newLclosure (lua_State *L, int nelems) {
+  Closure *c = cast(Closure *, luaM_malloc(L, sizeLclosure(nelems)));
+  c->isC = 0;
+  c->mark = c;
+  c->u.l.isopen = 0;
+  c->nupvalues = nelems;
+  return c;
+}
+
+
+/*
+** returns the open pointer in a closure that points higher into the stack
+*/
+static StkId uppoint (Closure *cl) {
+  StkId lp = NULL;
+  int i;
+  lua_assert(cl->u.l.isopen);
+  for (i=0; i<cl->nupvalues; i++) {
+    if (!luaF_isclosed(cl, i))
+      if (lp == NULL || cl->u.l.upvals[i] > lp)
+        lp = cl->u.l.upvals[i];
+  }
+  lua_assert(lp != NULL);
+  return lp;
+}
+
+
+void luaF_LConlist (lua_State *L, Closure *cl) {
+  lua_assert(!cl->isC);
+  if (cl->u.l.isopen == 0) {  /* no more open entries? */
+    cl->next = G(L)->rootcl;  /* insert in final list */
+    G(L)->rootcl = cl;
+  }
+  else {  /* insert in list of open closures, ordered by decreasing uppoints */
+    StkId cli = uppoint(cl);
+    Closure **p = &L->opencl;
+    while (*p != NULL && uppoint(*p) > cli) p = &(*p)->next;
+    cl->next = *p;
+    *p = cl;
+  }
+}
+
+
+static int closeCl (lua_State *L, Closure *cl, StkId level) {
+  int got = 0;  /* flag: 1 if some pointer in the closure was corrected */
+  int i;
+  for  (i=0; i<cl->nupvalues; i++) {
+    StkId var;
+    if (!luaF_isclosed(cl, i) && (var=cl->u.l.upvals[i]) >= level) {
+      if (ttype(var) != LUA_TUPVAL) {
+        UpVal *v = luaM_new(L, UpVal);
+        v->val = *var;
+        v->marked = 0;
+        v->next = G(L)->rootupval;
+        G(L)->rootupval = v;
+        setupvalue(var, v);
+      }
+      cl->u.l.upvals[i] = cast(TObject *, vvalue(var));
+      luaF_closeentry(cl, i);
+      got = 1;
+    }
+  }
+  return got;
+}
+
+
+void luaF_close (lua_State *L, StkId level) {
+  Closure *affected = NULL;  /* closures with open pointers >= level */
+  Closure *cl;
+  while ((cl=L->opencl) != NULL) {
+    if (!closeCl(L, cl, level)) break;
+    /* some pointer in `cl' changed; will re-insert it in original list */
+    L->opencl = cl->next;  /* remove from original list */
+    cl->next = affected;
+    affected = cl;  /* insert in affected list */
+  }
+  /* re-insert all affected closures in original list */
+  while ((cl=affected) != NULL) {
+    affected = cl->next;
+    luaF_LConlist(L, cl);
+  }
+}
+
+
 Proto *luaF_newproto (lua_State *L) {
   Proto *f = luaM_new(L, Proto);
   f->k = NULL;
@@ -60,12 +149,13 @@ void luaF_freeproto (lua_State *L, Proto *f) {
   luaM_freearray(L, f->k, f->sizek, TObject);
   luaM_freearray(L, f->p, f->sizep, Proto *);
   luaM_freearray(L, f->lineinfo, f->sizelineinfo, int);
-  luaM_freelem(L, f, Proto);
+  luaM_freelem(L, f);
 }
 
 
 void luaF_freeclosure (lua_State *L, Closure *c) {
-  luaM_free(L, c, sizeclosure(c->nupvalues));
+  int size = (c->isC) ? sizeCclosure(c->nupvalues) : sizeLclosure(c->nupvalues);
+  luaM_free(L, c, size);
 }
 
 

lfunc.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lfunc.h,v 1.14 2000/12/28 12:55:41 roberto Exp roberto $
+** $Id: lfunc.h,v 1.15 2001/02/23 17:17:25 roberto Exp $
 ** Auxiliary functions to manipulate prototypes and closures
 ** See Copyright Notice in lua.h
 */
@@ -11,9 +11,16 @@
 #include "lobject.h"
 
 
+#define luaF_isclosed(c, i)	(!((c)->u.l.isopen & (1 << (i))))
+#define luaF_openentry(c, i)	((c)->u.l.isopen |= (1 << (i)))
+#define luaF_closeentry(c, i)	((c)->u.l.isopen &= ~(1 << (i)))
+
 
 Proto *luaF_newproto (lua_State *L);
-Closure *luaF_newclosure (lua_State *L, int nelems);
+Closure *luaF_newCclosure (lua_State *L, int nelems);
+Closure *luaF_newLclosure (lua_State *L, int nelems);
+void luaF_LConlist (lua_State *L, Closure *cl);
+void luaF_close (lua_State *L, StkId level);
 void luaF_freeproto (lua_State *L, Proto *f);
 void luaF_freeclosure (lua_State *L, Closure *c);
 

lgc.c

@@ -7,6 +7,7 @@
 #define LUA_PRIVATE
 #include "lua.h"
 
+#include "ldebug.h"
 #include "ldo.h"
 #include "lfunc.h"
 #include "lgc.h"
@@ -45,15 +46,12 @@ static void protomark (Proto *f) {
     for (i=0; i<f->sizelocvars; i++)  /* mark local-variable names */
       strmark(f->locvars[i].varname);
   }
+  lua_assert(luaG_checkcode(f));
 }
 
 
 static void markclosure (GCState *st, Closure *cl) {
   if (!ismarked(cl)) {
-    if (!cl->isC) {
-      lua_assert(cl->nupvalues == cl->f.l->nupvalues);
-      protomark(cl->f.l);
-    }
     cl->mark = st->cmark;  /* chain it for later traversal */
     st->cmark = cl;
   }
@@ -84,7 +82,10 @@ static void markobject (GCState *st, TObject *o) {
       marktable(st, hvalue(o));
       break;
     }
-    default: break;  /* numbers, etc */
+    default: {
+      lua_assert(0 <= ttype(o) && ttype(o) <= LUA_TUPVAL);
+      break;
+    }
   }
 }
 
@@ -119,10 +120,26 @@ static void marktagmethods (global_State *G, GCState *st) {
 }
 
 
-static void traverseclosure (GCState *st, Closure *f) {
-  int i;
-  for (i=0; i<f->nupvalues; i++)  /* mark its upvalues */
-    markobject(st, &f->upvalue[i]);
+static void traverseclosure (GCState *st, Closure *cl) {
+  if (cl->isC) {
+    int i;
+    for (i=0; i<cl->nupvalues; i++)  /* mark its upvalues */
+      markobject(st, &cl->u.c.upvalue[i]);
+  }
+  else {
+    int i;
+    lua_assert(cl->nupvalues == cl->u.l.p->nupvalues);
+    protomark(cl->u.l.p);
+    for (i=0; i<cl->nupvalues; i++) {  /* mark its upvalues */
+      if (luaF_isclosed(cl, i)) {
+        UpVal *u = cast(UpVal *, cl->u.l.upvals[i]);
+        if (!u->marked) {
+          u->marked = 1;
+          markobject(st, &u->val);
+        }
+      }
+    }
+  }
 }
 
 
@@ -164,9 +181,9 @@ static void markall (lua_State *L) {
   marktable(&st, G(L)->weakregistry);
   for (;;) {  /* mark tables and closures */
     if (st.cmark) {
-      Closure *f = st.cmark;  /* get first closure from list */
-      st.cmark = f->mark;  /* remove it from list */
-      traverseclosure(&st, f);
+      Closure *cl = st.cmark;  /* get first closure from list */
+      st.cmark = cl->mark;  /* remove it from list */
+      traverseclosure(&st, cl);
     }
     else if (st.tmark) {
       Hash *h = st.tmark;  /* get first table from list */
@@ -232,8 +249,7 @@ static void collectproto (lua_State *L) {
 }
 
 
-static void collectclosure (lua_State *L) {
-  Closure **p = &G(L)->rootcl;
+static void collectclosure (lua_State *L, Closure **p) {
   Closure *curr;
   while ((curr = *p) != NULL) {
     if (ismarked(curr)) {
@@ -248,6 +264,16 @@ static void collectclosure (lua_State *L) {
 }
 
 
+static void collectclosures (lua_State *L) {
+  lua_State *L1 = L;
+  do {  /* for each thread */
+    collectclosure(L1, &L1->opencl);
+    L1 = L1->next;
+  } while (L1 != L);
+  collectclosure(L, &G(L)->rootcl);
+}
+
+
 static void collecttable (lua_State *L) {
   Hash **p = &G(L)->roottable;
   Hash *curr;
@@ -264,6 +290,22 @@ static void collecttable (lua_State *L) {
 }
 
 
+static void collectupval (lua_State *L) {
+  UpVal **v = &G(L)->rootupval;
+  UpVal *curr;
+  while ((curr = *v) != NULL) {
+    if (curr->marked) {
+      curr->marked = 0;
+      v = &curr->next;
+    }
+    else {
+      *v = curr->next;
+      luaM_freelem(L, curr);
+    }
+  }
+}
+
+
 static void collectudata (lua_State *L, int keep) {
   Udata **p = &G(L)->rootudata;
   Udata *curr;
@@ -370,7 +412,8 @@ void luaC_collect (lua_State *L, int all) {
   collectstrings(L, all);
   collecttable(L);
   collectproto(L);
-  collectclosure(L);
+  collectupval(L);
+  collectclosures(L);
 }
 
 

llimits.h

@@ -1,5 +1,5 @@
 /*
-** $Id: llimits.h,v 1.30 2001/06/05 20:01:09 roberto Exp roberto $
+** $Id: llimits.h,v 1.31 2001/08/27 15:16:28 roberto Exp $
 ** Limits, basic types, and some other `installation-dependent' definitions
 ** See Copyright Notice in lua.h
 */
@@ -51,6 +51,9 @@ typedef unsigned long lu_mem;
 /* an integer big enough to count the number of strings in use */
 typedef long ls_nstr;
 
+/* a bitmap with one bit for each upvalue used by a function */
+typedef unsigned long ls_bitup;
+
 
 /* chars used as small naturals (so that `char' is reserved for characteres) */
 typedef unsigned char lu_byte;
@@ -108,7 +111,7 @@ typedef unsigned long Instruction;
 
 /* maximum number of upvalues */
 #ifndef MAXUPVALUES
-#define MAXUPVALUES 32          /* arbitrary limit (<MAXSTACK) */
+#define MAXUPVALUES	(sizeof(ls_bitup)*CHAR_BIT)
 #endif
 
 

lobject.h

@@ -27,15 +27,20 @@
 #endif
 
 
-/* tags for values visible from Lua == first user-created tag */
+/* tags for values visible from Lua */
 #define NUM_TAGS	6
 
 
+/* extra tag: used locally when moving an upvalue from the stack to the heap */
+#define LUA_TUPVAL	6
+
+
 typedef union {
   union TString *ts;
   union Udata *u;
   struct Closure *cl;
   struct Hash *h;
+  struct UpVal *v;
   lua_Number n;		/* LUA_TNUMBER */
 } Value;
 
@@ -53,6 +58,7 @@ typedef struct lua_TObject {
 #define uvalue(o)      ((o)->value.u)
 #define clvalue(o)      ((o)->value.cl)
 #define hvalue(o)       ((o)->value.h)
+#define vvalue(o)	((o)->value.v)
 
 
 /* Macros to set values */
@@ -75,6 +81,9 @@ typedef struct lua_TObject {
 
 #define setnilvalue(obj) ((obj)->tt=LUA_TNIL)
 
+#define setupvalue(obj,x) \
+  { TObject *_o=(obj); _o->tt=LUA_TUPVAL; _o->value.v=(x); }
+
 #define setobj(obj1,obj2) \
   { TObject *o1=(obj1); const TObject *o2=(obj2); \
     o1->tt=o2->tt; o1->value = o2->value; }
@@ -154,25 +163,48 @@ typedef struct LocVar {
 } LocVar;
 
 
+
+/*
+** Upvalues in the heap
+*/
+typedef struct UpVal {
+  TObject val;
+  struct UpVal *next;
+  int marked;
+} UpVal;
+
+
 /*
 ** Closures
 */
 typedef struct Closure {
   int isC;  /* 0 for Lua functions, 1 for C functions */
   int nupvalues;
-  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) */
-  TObject upvalue[1];
+  union {
+    struct {  /* C functions */
+      lua_CFunction f;
+      TObject upvalue[1];
+    } c;
+    struct {  /* Lua functions */
+      struct Proto *p;
+      ls_bitup isopen;  /* bitmap: bit==1 when upvals point to the stack */
+      TObject *upvals[1];  /* may point to the stack or to an UpVal */
+    } l;
+  } u;
 } Closure;
 
 
 #define iscfunction(o)	(ttype(o) == LUA_TFUNCTION && clvalue(o)->isC)
 
 
+
+
+/*
+** Hash Tables
+*/
+
 typedef struct Node {
   struct Node *next;  /* for chaining */
   TObject key;

lopcodes.c

@@ -20,10 +20,11 @@ const l_char *const luaP_opnames[] = {
   l_s("LOADK"),
   l_s("LOADINT"),
   l_s("LOADNIL"),
-  l_s("LOADUPVAL"),
+  l_s("GETUPVAL"),
   l_s("GETGLOBAL"),
   l_s("GETTABLE"),
   l_s("SETGLOBAL"),
+  l_s("SETUPVAL"),
   l_s("SETTABLE"),
   l_s("NEWTABLE"),
   l_s("SELF"),
@@ -54,6 +55,7 @@ const l_char *const luaP_opnames[] = {
   l_s("TFORLOOP"),
   l_s("SETLIST"),
   l_s("SETLISTO"),
+  l_s("CLOSE"),
   l_s("CLOSURE")
 };
 
@@ -69,10 +71,11 @@ const lu_byte luaP_opmodes[NUM_OPCODES] = {
  ,opmode(0,0,0,0, 1,1,iABc)		/* OP_LOADK */
  ,opmode(0,0,0,0, 1,0,iAsBc)		/* OP_LOADINT */
  ,opmode(0,0,1,0, 1,0,iABC)		/* OP_LOADNIL */
- ,opmode(0,0,0,0, 1,0,iABc)		/* OP_LOADUPVAL */
+ ,opmode(0,0,0,0, 1,0,iABC)		/* OP_GETUPVAL */
  ,opmode(0,0,0,0, 1,1,iABc)		/* OP_GETGLOBAL */
  ,opmode(0,0,1,1, 1,0,iABC)		/* OP_GETTABLE */
  ,opmode(0,0,0,0, 0,1,iABc)		/* OP_SETGLOBAL */
+ ,opmode(0,0,0,0, 0,0,iABC)		/* OP_SETUPVAL */
  ,opmode(0,0,1,1, 0,0,iABC)		/* OP_SETTABLE */
  ,opmode(0,0,0,0, 1,0,iABc)		/* OP_NEWTABLE */
  ,opmode(0,0,1,1, 1,0,iABC)		/* OP_SELF */
@@ -103,6 +106,7 @@ const lu_byte luaP_opmodes[NUM_OPCODES] = {
  ,opmode(0,0,0,0, 0,0,iAsBc)		/* OP_TFORLOOP */
  ,opmode(0,0,0,0, 0,0,iABc)		/* OP_SETLIST */
  ,opmode(0,0,0,0, 0,0,iABc)		/* OP_SETLISTO */
+ ,opmode(0,0,0,0, 0,0,iABC)		/* OP_CLOSE */
  ,opmode(0,0,0,0, 1,0,iABc)		/* OP_CLOSURE */
 };
 

lopcodes.h

@@ -131,12 +131,13 @@ OP_MOVE,/*	A B	R(A) := R(B)					*/
 OP_LOADK,/*	A Bc	R(A) := Kst(Bc)					*/
 OP_LOADINT,/*	A sBc	R(A) := (Number)sBc				*/
 OP_LOADNIL,/*	A B	R(A) := ... := R(B) := nil			*/
-OP_LOADUPVAL,/*	A Bc	R(A) := UpValue[Bc]				*/
+OP_GETUPVAL,/*	A B	R(A) := UpValue[B]				*/
 
 OP_GETGLOBAL,/*	A Bc	R(A) := Gbl[Kst(Bc)]				*/
 OP_GETTABLE,/*	A B C	R(A) := R(B)[R/K(C)]				*/
 
 OP_SETGLOBAL,/*	A Bc	Gbl[Kst(Bc)] := R(A)				*/
+OP_SETUPVAL,/*	A B	UpValue[B] := R(A)				*/
 OP_SETTABLE,/*	A B C	R(B)[R/K(C)] := R(A)				*/
 
 OP_NEWTABLE,/*	A Bc	R(A) := {} (size = Bc)				*/
@@ -180,6 +181,7 @@ OP_TFORLOOP,/*	A sBc							*/
 OP_SETLIST,/*	A Bc	R(A)[Bc-Bc%FPF+i] := R(A+i), 1 <= i <= Bc%FPF+1	*/
 OP_SETLISTO,/*	A Bc							*/
 
+OP_CLOSE,/*	A 	close all variables in the stack up to (>=) R(A)*/
 OP_CLOSURE /*	A Bc	R(A) := closure(KPROTO[Bc], R(A), ... ,R(A+n))	*/
 } OpCode;
 

lparser.c

@@ -41,6 +41,7 @@ typedef struct Constdesc {
 typedef struct Breaklabel {
   struct Breaklabel *previous;  /* chain */
   int breaklist;  /* list of jumps out of this loop */
+  int nactloc;  /* # of active local variables outside the breakable structure */
 } Breaklabel;
 
 
@@ -163,13 +164,29 @@ static void new_localvar (LexState *ls, TString *name, int n) {
 
 static void adjustlocalvars (LexState *ls, int nvars) {
   FuncState *fs = ls->fs;
-  while (nvars--)
-    fs->f->locvars[fs->actloc[fs->nactloc++]].startpc = fs->pc;
+  while (nvars--) {
+    fs->f->locvars[fs->actloc[fs->nactloc]].startpc = fs->pc;
+    resetbit(fs->wasup, fs->nactloc);
+    fs->nactloc++;
+  }
+}
+
+
+static void closelevel (LexState *ls, int level) {
+  FuncState *fs = ls->fs;
+  int i;
+  for (i=level; i<fs->nactloc; i++)
+    if (testbit(fs->wasup, i)) {
+      luaK_codeABC(fs, OP_CLOSE, level, 0, 0);
+      return;
+    }
+  return;  /* nothing to close */
 }
 
 
 static void removelocalvars (LexState *ls, int nvars) {
   FuncState *fs = ls->fs;
+  closelevel(ls, fs->nactloc - nvars);
   while (nvars--)
     fs->f->locvars[fs->actloc[--fs->nactloc]].endpc = fs->pc;
 }
@@ -180,68 +197,47 @@ static void new_localvarstr (LexState *ls, const l_char *name, int n) {
 }
 
 
-static int search_local (LexState *ls, TString *n, expdesc *var) {
-  FuncState *fs;
-  int level = 0;
-  for (fs=ls->fs; fs; fs=fs->prev) {
-    int i;
-    for (i=fs->nactloc-1; i >= 0; i--) {
-      if (n == fs->f->locvars[fs->actloc[i]].varname) {
-        init_exp(var, VLOCAL, i);
-        return level;
-      }
-    }
-    level++;  /* `var' not found; check outer level */
-  }
-  init_exp(var, VGLOBAL, 0);  /* not found in any level; must be global */
-  return -1;
-}
-
-
-static void singlevar (LexState *ls, TString *n, expdesc *var) {
-  int level = search_local(ls, n, var);
-  if (level >= 1)  /* neither local (0) nor global (-1)? */
-    luaX_syntaxerror(ls, l_s("cannot access a variable in outer function"),
-                         getstr(n));
-  else if (level == -1)  /* global? */
-    var->u.i.info = luaK_stringk(ls->fs, n);
-}
-
-
-static int indexupvalue (LexState *ls, expdesc *v) {
-  FuncState *fs = ls->fs;
+static int indexupvalue (FuncState *fs, expdesc *v) {
   int i;
   for (i=0; i<fs->f->nupvalues; i++) {
     if (fs->upvalues[i].k == v->k && fs->upvalues[i].u.i.info == v->u.i.info)
       return i;
   }
   /* new one */
-  luaX_checklimit(ls, fs->f->nupvalues+1, MAXUPVALUES, l_s("upvalues"));
+  luaX_checklimit(fs->ls, fs->f->nupvalues+1, MAXUPVALUES, l_s("upvalues"));
   fs->upvalues[fs->f->nupvalues] = *v;
   return fs->f->nupvalues++;
 }
 
 
-static void codeupvalue (LexState *ls, expdesc *v, TString *n) {
-  FuncState *fs = ls->fs;
-  int level;
-  level = search_local(ls, n, v);
-  if (level == -1) {  /* global? */
-    if (fs->prev == NULL)
-      luaX_syntaxerror(ls, l_s("cannot access an upvalue at top level"),
-                       getstr(n));
-    v->u.i.info = luaK_stringk(fs->prev, n);
-  }
-  else if (level != 1) {
-    luaX_syntaxerror(ls,
-         l_s("upvalue must be global or local to immediately outer function"),
-         getstr(n));
+static void singlevar (FuncState *fs, TString *n, expdesc *var, int baselevel) {
+  if (fs == NULL)
+    init_exp(var, VGLOBAL, 0);  /* not local in any level; global variable */
+  else {  /* look up at current level */
+    int i;
+    for (i=fs->nactloc-1; i >= 0; i--) {
+      if (n == fs->f->locvars[fs->actloc[i]].varname) {
+        if (!baselevel)
+          setbit(fs->wasup, i);  /* will be upvalue in some other level */
+        init_exp(var, VLOCAL, i);
+        return;
+      }
+    }
+    /* not found at current level; try upper one */
+    singlevar(fs->prev, n, var, 0);
+    if (var->k == VGLOBAL) {
+      if (baselevel)
+        var->u.i.info = luaK_stringk(fs, n);  /* info points to global name */
+    }
+    else {  /* local variable in some upper level? */
+      var->u.i.info = indexupvalue(fs, var);
+      var->k = VUPVAL;  /* upvalue in this level */
+    }
   }
-  init_exp(v, VRELOCABLE,
-              luaK_codeABc(fs, OP_LOADUPVAL, 0, indexupvalue(ls, v)));
 }
 
 
+
 static void adjust_assign (LexState *ls, int nvars, int nexps, expdesc *e) {
   FuncState *fs = ls->fs;
   int extra = nvars - nexps;
@@ -278,6 +274,7 @@ static void code_params (LexState *ls, int nparams, short dots) {
 
 static void enterbreak (FuncState *fs, Breaklabel *bl) {
   bl->breaklist = NO_JUMP;
+  bl->nactloc = fs->nactloc;
   bl->previous = fs->bl;
   fs->bl = bl;
 }
@@ -286,6 +283,7 @@ static void enterbreak (FuncState *fs, Breaklabel *bl) {
 static void leavebreak (FuncState *fs, Breaklabel *bl) {
   fs->bl = bl->previous;
   luaK_patchlist(fs, bl->breaklist, luaK_getlabel(fs));
+  lua_assert(bl->nactloc == fs->nactloc);
 }
 
 
@@ -293,16 +291,14 @@ static void pushclosure (LexState *ls, FuncState *func, expdesc *v) {
   FuncState *fs = ls->fs;
   Proto *f = fs->f;
   int i;
-  int reg = fs->freereg;
-  for (i=0; i<func->f->nupvalues; i++)
-    luaK_exp2nextreg(fs, &func->upvalues[i]);
   luaM_growvector(ls->L, f->p, fs->np, f->sizep, Proto *,
                   MAXARG_Bc, l_s("constant table overflow"));
   f->p[fs->np++] = func->f;
-  fs->freereg = reg;  /* CLOSURE will consume those values */
-  init_exp(v, VNONRELOC, reg);
-  luaK_reserveregs(fs, 1);
-  luaK_codeABc(fs, OP_CLOSURE, v->u.i.info, fs->np-1);
+  init_exp(v, VRELOCABLE, luaK_codeABc(fs, OP_CLOSURE, 0, fs->np-1));
+  for (i=0; i<func->f->nupvalues; i++) {
+    luaK_exp2nextreg(fs, &func->upvalues[i]);
+    fs->freereg--;  /* CLOSURE will use these values */
+  }
 }
 
 
@@ -337,9 +333,9 @@ static void close_func (LexState *ls) {
   lua_State *L = ls->L;
   FuncState *fs = ls->fs;
   Proto *f = fs->f;
+  removelocalvars(ls, fs->nactloc);
   luaK_codeABC(fs, OP_RETURN, 0, 0, 0);  /* final return */
   luaK_getlabel(fs);  /* close eventual list of pending jumps */
-  removelocalvars(ls, fs->nactloc);
   lua_assert(G(L)->roottable == fs->h);
   G(L)->roottable = fs->h->next;
   luaH_free(L, fs->h);
@@ -644,16 +640,18 @@ static void primaryexp (LexState *ls, expdesc *v) {
       return;
     }
     case TK_NAME: {
-      singlevar(ls, str_checkname(ls), v);
+      singlevar(ls->fs, str_checkname(ls), v, 1);
       next(ls);
       return;
     }
-    case l_c('%'): {
+    case l_c('%'): {  /* for compatibility only */
       next(ls);  /* skip `%' */
-      codeupvalue(ls, v, str_checkname(ls));
+      singlevar(ls->fs, str_checkname(ls), v, 1);
+      check_condition(ls, v->k == VUPVAL, l_s("global upvalues are deprecated"));
       next(ls);
-      break;
+      return;
     }
+
     default: {
       luaK_error(ls, l_s("unexpected symbol"));
       return;
@@ -812,7 +810,7 @@ static void block (LexState *ls) {
 */
 struct LHS_assign {
   struct LHS_assign *prev;
-  expdesc v;  /* variable (global, local, or indexed) */
+  expdesc v;  /* variable (global, local, upvalue, or indexed) */
 };
 
 
@@ -847,9 +845,8 @@ static void check_conflict (LexState *ls, struct LHS_assign *lh, expdesc *v) {
 
 static void assignment (LexState *ls, struct LHS_assign *lh, int nvars) {
   expdesc e;
-  check_condition(ls, lh->v.k == VLOCAL || lh->v.k == VGLOBAL ||
-                      lh->v.k == VINDEXED,
-                      l_s("syntax error"));
+  check_condition(ls, VLOCAL <= lh->v.k && lh->v.k <= VINDEXED,
+                      l_s("syntax error!!"));
   if (ls->t.token == l_c(',')) {  /* assignment -> `,' simpleexp assignment */
     struct LHS_assign nv;
     nv.prev = lh;
@@ -1054,7 +1051,7 @@ static void localstat (LexState *ls) {
 static int funcname (LexState *ls, expdesc *v) {
   /* funcname -> NAME {field} [`:' NAME] */
   int needself = 0;
-  singlevar(ls, str_checkname(ls), v);
+  singlevar(ls->fs, str_checkname(ls), v, 1);
   next(ls);  /* skip var name */
   while (ls->t.token == l_c('.')) {
     luaY_field(ls, v);
@@ -1102,25 +1099,19 @@ static void retstat (LexState *ls) {
   if (block_follow(ls->t.token) || ls->t.token == l_c(';'))
     first = nret = 0;  /* return no values */
   else {
-    int n = explist1(ls, &e);  /* optional return values */
+    explist1(ls, &e);  /* optional return values */
     if (e.k == VCALL) {
       luaK_setcallreturns(fs, &e, LUA_MULTRET);
       first = fs->nactloc;
       nret = NO_REG;  /* return all values */
     }
     else {
-      if (n == 1) {  /* only one value? */
-        luaK_exp2anyreg(fs, &e);
-        first = e.u.i.info;
-        nret = 1;  /* return only this value */
-      }
-      else {
-        luaK_exp2nextreg(fs, &e);  /* values must go to the `stack' */
-        first = fs->nactloc;
-        nret = fs->freereg - first;  /* return all `active' values */
-      }
+      luaK_exp2nextreg(fs, &e);  /* values must go to the `stack' */
+      first = fs->nactloc;
+      nret = fs->freereg - first;  /* return all `active' values */
     }
   }
+  closelevel(ls, 0);
   luaK_codeABC(fs, OP_RETURN, first, nret, 0);
   fs->freereg = fs->nactloc;  /* removes all temp values */
 }
@@ -1133,8 +1124,8 @@ static void breakstat (LexState *ls) {
   if (!bl)
     luaK_error(ls, l_s("no loop to break"));
   next(ls);  /* skip BREAK */
+  closelevel(ls, bl->nactloc);
   luaK_concat(fs, &bl->breaklist, luaK_jump(fs));
-  /* correct stack for compiler and symbolic execution */
 }
 
 

lparser.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lparser.h,v 1.33 2001/08/10 20:53:03 roberto Exp roberto $
+** $Id: lparser.h,v 1.34 2001/08/27 15:16:28 roberto Exp $
 ** Lua Parser
 ** See Copyright Notice in lua.h
 */
@@ -7,11 +7,24 @@
 #ifndef lparser_h
 #define lparser_h
 
+#include "llimits.h"
 #include "lobject.h"
 #include "ltable.h"
 #include "lzio.h"
 
 
+
+/* small implementation of bit arrays */
+
+#define BPW	(CHAR_BIT*sizeof(unsigned int))  /* bits per word */
+
+#define words2bits(b)	(((b)-1)/BPW + 1)
+
+#define setbit(a, b)	((a)[(b)/BPW] |= (1 << (b)%BPW))
+#define resetbit(a, b)	((a)[(b)/BPW] &= ~((1 << (b)%BPW)))
+#define testbit(a, b)	((a)[(b)/BPW] & (1 << (b)%BPW))
+
+
 /*
 ** Expression descriptor
 */
@@ -21,8 +34,9 @@ typedef enum {
   VNIL,
   VNUMBER,	/* n = value */
   VK,		/* info = index of constant in `k' */
-  VGLOBAL,	/* info = index of global name in `k' */
   VLOCAL,	/* info = local register */
+  VUPVAL,       /* info = index of upvalue in `upvalues' */
+  VGLOBAL,	/* info = index of global name in `k' */
   VINDEXED,	/* info = table register; aux = index register (or `k') */
   VRELOCABLE,	/* info = instruction pc */
   VNONRELOC,	/* info = result register */
@@ -63,6 +77,8 @@ typedef struct FuncState {
   struct Breaklabel *bl;  /* chain of breakable blocks */
   expdesc upvalues[MAXUPVALUES];  /* upvalues */
   int actloc[MAXLOCALS];  /* local-variable stack (indices to locvars) */
+  unsigned int wasup[words2bits(MAXLOCALS)];  /* bit array to mark whether a
+                             local variable was used as upvalue at some level */
 } FuncState;
 
 

lstate.c

@@ -58,6 +58,7 @@ static void f_luaopen (lua_State *L, void *ud) {
     G(L)->rootcl = NULL;
     G(L)->roottable = NULL;
     G(L)->rootudata = NULL;
+    G(L)->rootupval = NULL;
     G(L)->TMtable = NULL;
     G(L)->sizeTM = 0;
     G(L)->ntag = 0;
@@ -91,6 +92,7 @@ LUA_API lua_State *lua_newthread (lua_State *OL, int stacksize) {
     L->errorJmp = NULL;
     L->callhook = NULL;
     L->linehook = NULL;
+    L->opencl = NULL;
     L->allowhooks = 1;
     L->next = L->previous = L;
     so.stacksize = stacksize;
@@ -122,10 +124,10 @@ static void close_state (lua_State *L, lua_State *OL) {
     luaS_freeall(L);
     luaM_freearray(L, G(L)->TMtable, G(L)->sizeTM, struct TM);
     luaM_freearray(L, G(L)->Mbuffer, G(L)->Mbuffsize, l_char);
-    luaM_freelem(NULL, L->G, global_State);
+    luaM_freelem(NULL, L->G);
   }
   luaM_freearray(OL, L->stack, L->stacksize, TObject);
-  luaM_freelem(OL, L, lua_State);
+  luaM_freelem(OL, L);
 }
 
 LUA_API void lua_close (lua_State *L) {

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.57 2001/06/06 18:00:19 roberto Exp roberto $
+** $Id: lstate.h,v 1.58 2001/06/15 19:16:41 roberto Exp $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -56,10 +56,6 @@ typedef struct stringtable {
 typedef struct global_State {
   void *Mbuffer;  /* global buffer */
   size_t Mbuffsize;  /* size of Mbuffer */
-  Proto *rootproto;  /* list of all prototypes */
-  Closure *rootcl;  /* list of all closures */
-  Hash *roottable;  /* list of all tables */
-  Udata *rootudata;   /* list of all userdata */
   stringtable strt;  /* hash table for strings */
   Hash *type2tag;  /* hash table from type names to tags */
   Hash *registry;  /* (strong) registry table */
@@ -69,6 +65,11 @@ typedef struct global_State {
   int ntag;  /* number of tags in TMtable */
   lu_mem GCthreshold;
   lu_mem nblocks;  /* number of `bytes' currently allocated */
+  Proto *rootproto;  /* list of all prototypes */
+  Closure *rootcl;  /* list of all closed closures */
+  Hash *roottable;  /* list of all tables */
+  Udata *rootudata;   /* list of all userdata */
+  UpVal *rootupval;  /* list of all up values */
 } global_State;
 
 
@@ -88,6 +89,7 @@ struct lua_State {
   lua_Hook linehook;
   int allowhooks;
   struct lua_longjmp *errorJmp;  /* current error recover point */
+  Closure *opencl;  /* list of closures still pointing to this stack */
   lua_State *next;  /* circular double linked list of states */
   lua_State *previous;
   CallInfo basefunc;

ltests.c

@@ -165,7 +165,7 @@ static int listcode (lua_State *L) {
   Proto *p;
   luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
                  1, l_s("Lua function expected"));
-  p = clvalue(luaA_index(L, 1))->f.l;
+  p = clvalue(luaA_index(L, 1))->u.l.p;
   lua_newtable(L);
   setnameval(L, l_s("maxstack"), p->maxstacksize);
   setnameval(L, l_s("numparams"), p->numparams);
@@ -184,7 +184,7 @@ static int listk (lua_State *L) {
   int i;
   luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
                  1, l_s("Lua function expected"));
-  p = clvalue(luaA_index(L, 1))->f.l;
+  p = clvalue(luaA_index(L, 1))->u.l.p;
   lua_newtable(L);
   for (i=0; i<p->sizek; i++) {
     lua_pushnumber(L, i+1);
@@ -202,7 +202,7 @@ static int listlocals (lua_State *L) {
   const l_char *name;
   luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1),
                  1, l_s("Lua function expected"));
-  p = clvalue(luaA_index(L, 1))->f.l;
+  p = clvalue(luaA_index(L, 1))->u.l.p;
   while ((name = luaF_getlocalname(p, ++i, pc)) != NULL)
     lua_pushstring(L, name);
   return i-1;

lvm.c

@@ -64,8 +64,8 @@ int luaV_tostring (lua_State *L, TObject *obj) {
 
 static void traceexec (lua_State *L, lua_Hook linehook) {
   CallInfo *ci = L->ci;
-  int *lineinfo = ci_func(ci)->f.l->lineinfo;
-  int pc = (*ci->pc - ci_func(ci)->f.l->code) - 1;
+  int *lineinfo = ci_func(ci)->u.l.p->lineinfo;
+  int pc = (*ci->pc - ci_func(ci)->u.l.p->code) - 1;
   int newline;
   if (pc == 0) {  /* may be first time? */
     ci->line = 1;
@@ -82,30 +82,6 @@ static void traceexec (lua_State *L, lua_Hook linehook) {
 }
 
 
-static Closure *luaV_closure (lua_State *L, int nelems) {
-  Closure *c = luaF_newclosure(L, nelems);
-  L->top -= nelems;
-  while (nelems--)
-    setobj(&c->upvalue[nelems], L->top+nelems);
-  setclvalue(L->top, c);
-  incr_top;
-  return c;
-}
-
-
-void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems) {
-  Closure *cl = luaV_closure(L, nelems);
-  cl->f.c = c;
-  cl->isC = 1;
-}
-
-
-void luaV_Lclosure (lua_State *L, Proto *l, int nelems) {
-  Closure *cl = luaV_closure(L, nelems);
-  cl->f.l = l;
-  cl->isC = 0;
-}
-
 
 /* maximum stack used by a call to a tag method (func + args) */
 #define MAXSTACK_TM	4
@@ -376,7 +352,7 @@ static void adjust_varargs (lua_State *L, StkId base, int nfixargs) {
 ** Returns n such that the the results are between [n,top).
 */
 StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
-  const Proto *const tf = cl->f.l;
+  const Proto *const tf = cl->u.l.p;
   const Instruction *pc;
   lua_Hook linehook;
   if (tf->is_vararg)  /* varargs? */
@@ -406,10 +382,6 @@ StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
         setnvalue(ra, (lua_Number)GETARG_sBc(i));
         break;
       }
-      case OP_LOADUPVAL: {
-        setobj(ra, cl->upvalue+GETARG_Bc(i));
-        break;
-      }
       case OP_LOADNIL: {
         TObject *rb = RB(i);
         do {
@@ -417,6 +389,12 @@ StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
         } while (rb >= ra);
         break;
       }
+      case OP_GETUPVAL: {
+        int b = GETARG_B(i);
+        lua_assert(luaF_isclosed(cl, b) || cl->u.l.upvals[b] < base);
+        setobj(ra, cl->u.l.upvals[b]);
+        break;
+      }
       case OP_GETGLOBAL: {
         lua_assert(ttype(KBc(i)) == LUA_TSTRING);
         luaV_getglobal(L, tsvalue(KBc(i)), ra);
@@ -431,6 +409,12 @@ StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
         luaV_setglobal(L, tsvalue(KBc(i)), ra);
         break;
       }
+      case OP_SETUPVAL: {
+        int b = GETARG_B(i);
+        lua_assert(luaF_isclosed(cl, b) || cl->u.l.upvals[b] < base);
+        setobj(cl->u.l.upvals[b], ra);
+        break;
+      }
       case OP_SETTABLE: {
         luaV_settable(L, RB(i), RKC(i), ra);
         break;
@@ -646,13 +630,34 @@ StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) {
           luaH_setnum(L, h, bc+n, ra+n);
         break;
       }
+      case OP_CLOSE: {
+        luaF_close(L, ra);
+        break;
+      }
       case OP_CLOSURE: {
-        Proto *p = tf->p[GETARG_Bc(i)];
-        int nup = p->nupvalues;
-        luaV_checkGC(L, ra+nup);
-        L->top = ra+nup;
-        luaV_Lclosure(L, p, nup);
-        L->top = base + tf->maxstacksize;
+        Proto *p;
+        Closure *ncl;
+        int nup, j;
+        luaV_checkGC(L, L->top);
+        p = tf->p[GETARG_Bc(i)];
+        nup = p->nupvalues;
+        ncl = luaF_newLclosure(L, nup);
+        ncl->u.l.p = p;
+        for (j=0; j<nup; j++, pc++) {
+          if (GET_OPCODE(*pc) == OP_GETUPVAL) {
+            int n = GETARG_B(*pc);
+            if (!luaF_isclosed(cl, n))
+              luaF_openentry(ncl, j);
+            ncl->u.l.upvals[j] = cl->u.l.upvals[n];
+          }
+          else {
+            lua_assert(GET_OPCODE(*pc) == OP_MOVE);
+            luaF_openentry(ncl, j);
+            ncl->u.l.upvals[j] = base + GETARG_B(*pc);
+          }
+        }
+        luaF_LConlist(L, ncl);
+        setclvalue(ra, ncl);
         break;
       }
     }

lvm.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.h,v 1.29 2001/02/07 18:13:49 roberto Exp roberto $
+** $Id: lvm.h,v 1.30 2001/06/05 18:17:01 roberto Exp $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -23,8 +23,6 @@ void luaV_settable (lua_State *L, StkId t, TObject *key, StkId val);
 void luaV_getglobal (lua_State *L, TString *s, StkId res);
 void luaV_setglobal (lua_State *L, TString *s, StkId val);
 StkId luaV_execute (lua_State *L, const Closure *cl, StkId base);
-void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems);
-void luaV_Lclosure (lua_State *L, Proto *l, int nelems);
 int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r);
 void luaV_strconc (lua_State *L, int total, StkId top);