Towards "to closed" local variables

Start of the implementation of "scoped variables" or "to be closed"
variables, local variables whose '__close' (or themselves) are called
when they go out of scope. This commit implements the syntax, the
opcode, and the creation of the corresponding upvalue, but it still
does not call the finalizations when the variable goes out of scope
(the most important part).

Currently, the syntax is 'local scoped name = exp', but that will
probably change.

15 files changed, 81 insertions, 22 deletions

diff --git a/lcode.c b/lcode.c
index d00038dd..e84b85ac 100644
--- a/lcode.c
+++ b/lcode.c
@@ -1673,13 +1673,13 @@ void luaK_finish (FuncState *fs) {
     lua_assert(i == 0 || isOT(*(pc - 1)) == isIT(*pc));
     switch (GET_OPCODE(*pc)) {
       case OP_RETURN0: case OP_RETURN1: {
-        if (p->sizep == 0 && !p->is_vararg)
+        if (!(fs->needclose || p->is_vararg))
           break;  /* no extra work */
         /* else use OP_RETURN to do the extra work */
         SET_OPCODE(*pc, OP_RETURN);
       }  /* FALLTHROUGH */
       case OP_RETURN: case OP_TAILCALL: {
-        if (p->sizep > 0 || p->is_vararg) {
+        if (fs->needclose || p->is_vararg) {
           SETARG_C(*pc, p->is_vararg ? p->numparams + 1 : 0);
           SETARG_k(*pc, 1);  /* signal that there is extra work */
         }
diff --git a/ldo.c b/ldo.c
index 0d68d36c..2349aaed 100644
--- a/ldo.c
+++ b/ldo.c
@@ -91,8 +91,7 @@ struct lua_longjmp {
 static void seterrorobj (lua_State *L, int errcode, StkId oldtop) {
   switch (errcode) {
     case LUA_ERRMEM: {  /* memory error? */
-      TString *memerrmsg = luaS_newliteral(L, MEMERRMSG);
-      setsvalue2s(L, oldtop, memerrmsg); /* reuse preregistered msg. */
+      setsvalue2s(L, oldtop, G(L)->memerrmsg); /* reuse preregistered msg. */
       break;
     }
     case LUA_ERRERR: {
diff --git a/lgc.c b/lgc.c
index e8429e1b..39b3ab73 100644
--- a/lgc.c
+++ b/lgc.c
@@ -293,7 +293,8 @@ static void reallymarkobject (global_State *g, GCObject *o) {
       gray2black(o);
       break;
     }
-    case LUA_TUPVAL: {
+    case LUA_TUPVAL:
+    case LUA_TUPVALTBC: {
       UpVal *uv = gco2upv(o);
       if (!upisopen(uv))  /* open upvalues are kept gray */
         gray2black(o);
@@ -760,6 +761,7 @@ static void freeobj (lua_State *L, GCObject *o) {
       luaF_freeproto(L, gco2p(o));
       break;
     case LUA_TUPVAL:
+    case LUA_TUPVALTBC:
       freeupval(L, gco2upv(o));
       break;
     case LUA_TLCL:
diff --git a/ljumptab.h b/ljumptab.h
index c775f10a..da4cf7b7 100644
--- a/ljumptab.h
+++ b/ljumptab.h
@@ -74,6 +74,7 @@ static void *disptab[] = {
 &&L_OP_LEN,
 &&L_OP_CONCAT,
 &&L_OP_CLOSE,
+&&L_OP_TBC,
 &&L_OP_JMP,
 &&L_OP_EQ,
 &&L_OP_LT,
diff --git a/lobject.h b/lobject.h
index ddcf609c..ea3511de 100644
--- a/lobject.h
+++ b/lobject.h
@@ -588,6 +588,10 @@ typedef struct UpVal {
 } UpVal;
 
 
+/* variant for "To Be Closed" upvalues */
+#define LUA_TUPVALTBC   (LUA_TUPVAL | (1 << 4))
+
+
 #define ClosureHeader \
         CommonHeader; lu_byte nupvalues; GCObject *gclist
 
diff --git a/lopcodes.c b/lopcodes.c
index 95347b27..f6915beb 100644
--- a/lopcodes.c
+++ b/lopcodes.c
@@ -68,6 +68,7 @@ LUAI_DDEF const lu_byte luaP_opmodes[NUM_OPCODES] = {
  ,opmode(0, 0, 0, 1, iABC)              /* OP_LEN */
  ,opmode(0, 0, 0, 1, iABC)              /* OP_CONCAT */
  ,opmode(0, 0, 0, 0, iABC)              /* OP_CLOSE */
+ ,opmode(0, 0, 0, 0, iABC)              /* OP_TBC */
  ,opmode(0, 0, 0, 0, isJ)               /* OP_JMP */
  ,opmode(0, 0, 1, 0, iABC)              /* OP_EQ */
  ,opmode(0, 0, 1, 0, iABC)              /* OP_LT */
diff --git a/lopcodes.h b/lopcodes.h
index 9442a336..4d144000 100644
--- a/lopcodes.h
+++ b/lopcodes.h
@@ -251,6 +251,7 @@ OP_LEN,/*	A B	R(A) := length of R(B)				*/
 OP_CONCAT,/*    A B     R(A) := R(A).. ... ..R(A + B - 1)               */
 
 OP_CLOSE,/*     A       close all upvalues >= R(A)                      */
+OP_TBC,/*       A       mark variable A "to be closed"                  */
 OP_JMP,/*       k sJ    pc += sJ  (k is used in code generation)        */
 OP_EQ,/*        A B     if ((R(A) == R(B)) ~= k) then pc++              */
 OP_LT,/*        A B     if ((R(A) <  R(B)) ~= k) then pc++              */
diff --git a/lopnames.h b/lopnames.h
index c40eaeae..304d3b6c 100644
--- a/lopnames.h
+++ b/lopnames.h
@@ -59,6 +59,7 @@ static const char *const opnames[] = {
   "LEN",
   "CONCAT",
   "CLOSE",
+  "TBC",
   "JMP",
   "EQ",
   "LT",
diff --git a/lparser.c b/lparser.c
index 32500b02..84abeb90 100644
--- a/lparser.c
+++ b/lparser.c
@@ -255,6 +255,7 @@ static void markupval (FuncState *fs, int level) {
   while (bl->nactvar > level)
     bl = bl->previous;
   bl->upval = 1;
+  fs->needclose = 1;
 }
 
 
@@ -547,6 +548,7 @@ static void open_func (LexState *ls, FuncState *fs, BlockCnt *bl) {
   fs->nups = 0;
   fs->nlocvars = 0;
   fs->nactvar = 0;
+  fs->needclose = 0;
   fs->firstlocal = ls->dyd->actvar.n;
   fs->bl = NULL;
   f->source = ls->source;
@@ -1509,15 +1511,16 @@ static void localfunc (LexState *ls) {
 }
 
 
-static void localstat (LexState *ls) {
+static void commonlocalstat (LexState *ls, TString *firstvar) {
   /* stat -> LOCAL NAME {',' NAME} ['=' explist] */
-  int nvars = 0;
+  int nvars = 1;
   int nexps;
   expdesc e;
-  do {
+  new_localvar(ls, firstvar);
+  while (testnext(ls, ',')) {
     new_localvar(ls, str_checkname(ls));
     nvars++;
-  } while (testnext(ls, ','));
+  }
   if (testnext(ls, '='))
     nexps = explist(ls, &e);
   else {
@@ -1529,6 +1532,29 @@ static void localstat (LexState *ls) {
 }
 
 
+static void scopedlocalstat (LexState *ls) {
+  FuncState *fs = ls->fs;
+  new_localvar(ls, str_checkname(ls));
+  checknext(ls, '=');
+  luaK_codeABC(fs, OP_TBC, fs->nactvar, 0, 0);
+  markupval(fs, fs->nactvar);
+  exp1(ls, 0);
+  adjustlocalvars(ls, 1);
+}
+
+
+static void localstat (LexState *ls) {
+  /* stat -> LOCAL NAME {',' NAME} ['=' explist]
+           | LOCAL SCOPED NAME '=' exp */
+  TString *firstvar = str_checkname(ls);
+  if (ls->t.token == TK_NAME &&
+      eqshrstr(firstvar, luaS_newliteral(ls->L, "scoped")))
+    scopedlocalstat(ls);
+  else
+    commonlocalstat(ls, firstvar);
+}
+
+
 static int funcname (LexState *ls, expdesc *v) {
   /* funcname -> NAME {fieldsel} [':' NAME] */
   int ismethod = 0;
diff --git a/lparser.h b/lparser.h
index e158c9d9..1b94a97a 100644
--- a/lparser.h
+++ b/lparser.h
@@ -133,6 +133,7 @@ typedef struct FuncState {
   lu_byte nups;  /* number of upvalues */
   lu_byte freereg;  /* first free register */
   lu_byte iwthabs;  /* instructions issued since last absolute line info */
+  lu_byte needclose;  /* function needs to close upvalues when returning */
 } FuncState;
 
 
diff --git a/lstate.h b/lstate.h
index 5461b291..f08c2355 100644
--- a/lstate.h
+++ b/lstate.h
@@ -267,7 +267,8 @@ union GCUnion {
 #define gco2t(o)  check_exp((o)->tt == LUA_TTABLE, &((cast_u(o))->h))
 #define gco2p(o)  check_exp((o)->tt == LUA_TPROTO, &((cast_u(o))->p))
 #define gco2th(o)  check_exp((o)->tt == LUA_TTHREAD, &((cast_u(o))->th))
-#define gco2upv(o)  check_exp((o)->tt == LUA_TUPVAL, &((cast_u(o))->upv))
+#define gco2upv(o)  \
+        check_exp(novariant((o)->tt) == LUA_TUPVAL, &((cast_u(o))->upv))
 
 
 /*
diff --git a/ltests.c b/ltests.c
index bc71d937..ff962543 100644
--- a/ltests.c
+++ b/ltests.c
@@ -357,7 +357,8 @@ static void checkrefs (global_State *g, GCObject *o) {
       checkudata(g, gco2u(o));
       break;
     }
-    case LUA_TUPVAL: {
+    case LUA_TUPVAL:
+    case LUA_TUPVALTBC: {
       checkvalref(g, o, gco2upv(o)->v);
       break;
     }
@@ -522,35 +523,37 @@ int lua_checkmemory (lua_State *L) {
 
 
 static char *buildop (Proto *p, int pc, char *buff) {
+  char *obuff = buff;
   Instruction i = p->code[pc];
   OpCode o = GET_OPCODE(i);
   const char *name = opnames[o];
   int line = luaG_getfuncline(p, pc);
   int lineinfo = (p->lineinfo != NULL) ? p->lineinfo[pc] : 0;
-  sprintf(buff, "(%2d - %4d) %4d - ", lineinfo, line, pc);
+  if (lineinfo == ABSLINEINFO)
+    buff += sprintf(buff, "(__");
+  else
+    buff += sprintf(buff, "(%2d", lineinfo);
+  buff += sprintf(buff, " - %4d) %4d - ", line, pc);
   switch (getOpMode(o)) {
     case iABC:
-      sprintf(buff+strlen(buff), "%-12s%4d %4d %4d%s", name,
+      sprintf(buff, "%-12s%4d %4d %4d%s", name,
               GETARG_A(i), GETARG_B(i), GETARG_C(i),
               GETARG_k(i) ? " (k)" : "");
       break;
     case iABx:
-      sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i),
-                                                       GETARG_Bx(i));
+      sprintf(buff, "%-12s%4d %4d", name, GETARG_A(i), GETARG_Bx(i));
       break;
     case iAsBx:
-      sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i),
-                                                       GETARG_sBx(i));
+      sprintf(buff, "%-12s%4d %4d", name, GETARG_A(i), GETARG_sBx(i));
       break;
     case iAx:
-      sprintf(buff+strlen(buff), "%-12s%4d", name, GETARG_Ax(i));
+      sprintf(buff, "%-12s%4d", name, GETARG_Ax(i));
       break;
     case isJ:
-      sprintf(buff+strlen(buff), "%-12s%4d (%1d)", name, GETARG_sJ(i),
-                                                         !!GETARG_m(i));
+      sprintf(buff, "%-12s%4d (%1d)", name, GETARG_sJ(i), !!GETARG_m(i));
       break;
   }
-  return buff;
+  return obuff;
 }
 
 
diff --git a/lvm.c b/lvm.c
index dd6a660b..fdd99a42 100644
--- a/lvm.c
+++ b/lvm.c
@@ -1455,6 +1455,12 @@ void luaV_execute (lua_State *L, CallInfo *ci) {
         luaF_close(L, ra);
         vmbreak;
       }
+      vmcase(OP_TBC) {
+        UpVal *up = luaF_findupval(L, ra);  /* create new upvalue */
+        up->tt = LUA_TUPVALTBC;  /* mark it to be closed */
+        setnilvalue(s2v(ra));  /* intialize it with nil */
+        vmbreak;
+      }
       vmcase(OP_JMP) {
         dojump(ci, i, 0);
         vmbreak;
diff --git a/testes/code.lua b/testes/code.lua
index 6bd6ebfa..ad484485 100644
--- a/testes/code.lua
+++ b/testes/code.lua
@@ -64,8 +64,12 @@ end
 
 
 -- some basic instructions
-check(function ()
+check(function ()   -- function does not create upvalues
   (function () end){f()}
+end, 'CLOSURE', 'NEWTABLE', 'GETTABUP', 'CALL', 'SETLIST', 'CALL', 'RETURN0')
+
+check(function (x)   -- function creates upvalues
+  (function () return x end){f()}
 end, 'CLOSURE', 'NEWTABLE', 'GETTABUP', 'CALL', 'SETLIST', 'CALL', 'RETURN')
 
 
diff --git a/testes/locals.lua b/testes/locals.lua
index 14e49a7c..20ecae4b 100644
--- a/testes/locals.lua
+++ b/testes/locals.lua
@@ -173,6 +173,15 @@ end
 assert(x==20)
 
 
+-- tests for to-be-closed variables
+do
+  local scoped x = 3
+  local a
+  local scoped y = 5
+  assert(x == 3 and y == 5)
+end
+
+
 print('OK')
 
 return 5,f