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.
diff --git a/lcode.c b/lcode.c
index d00038d..e84b85a 100644
--- a/lcode.c
+++ b/lcode.c
@@ -1673,13 +1673,13 @@
     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 0d68d36..2349aae 100644
--- a/ldo.c
+++ b/ldo.c
@@ -91,8 +91,7 @@
 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 e8429e1..39b3ab7 100644
--- a/lgc.c
+++ b/lgc.c
@@ -293,7 +293,8 @@
       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 @@
       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 c775f10..da4cf7b 100644
--- a/ljumptab.h
+++ b/ljumptab.h
@@ -74,6 +74,7 @@
 &&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 ddcf609..ea3511d 100644
--- a/lobject.h
+++ b/lobject.h
@@ -588,6 +588,10 @@
 } 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 95347b2..f6915be 100644
--- a/lopcodes.c
+++ b/lopcodes.c
@@ -68,6 +68,7 @@
  ,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 9442a33..4d14400 100644
--- a/lopcodes.h
+++ b/lopcodes.h
@@ -251,6 +251,7 @@
 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 c40eaea..304d3b6 100644
--- a/lopnames.h
+++ b/lopnames.h
@@ -59,6 +59,7 @@
   "LEN",
   "CONCAT",
   "CLOSE",
+  "TBC",
   "JMP",
   "EQ",
   "LT",
diff --git a/lparser.c b/lparser.c
index 32500b0..84abeb9 100644
--- a/lparser.c
+++ b/lparser.c
@@ -255,6 +255,7 @@
   while (bl->nactvar > level)
     bl = bl->previous;
   bl->upval = 1;
+  fs->needclose = 1;
 }
 
 
@@ -547,6 +548,7 @@
   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 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 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 e158c9d..1b94a97 100644
--- a/lparser.h
+++ b/lparser.h
@@ -133,6 +133,7 @@
   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 5461b29..f08c235 100644
--- a/lstate.h
+++ b/lstate.h
@@ -267,7 +267,8 @@
 #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 bc71d93..ff96254 100644
--- a/ltests.c
+++ b/ltests.c
@@ -357,7 +357,8 @@
       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 @@
 
 
 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 dd6a660..fdd99a4 100644
--- a/lvm.c
+++ b/lvm.c
@@ -1455,6 +1455,12 @@
         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 6bd6ebf..ad48448 100644
--- a/testes/code.lua
+++ b/testes/code.lua
@@ -64,8 +64,12 @@
 
 
 -- 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 14e49a7..20ecae4 100644
--- a/testes/locals.lua
+++ b/testes/locals.lua
@@ -173,6 +173,15 @@
 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