first implementation of unrestricted static scoping

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);
 }