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.

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 */
         }

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, G(L)->memerrmsg); /* reuse preregistered msg. */
-      setsvalue2s(L, oldtop, memerrmsg); /* reuse preregistered msg. */
       break;
     }
     case LUA_ERRERR: {

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:

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,

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
 

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 */

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++		*/

lopnames.h

@@ -59,6 +59,7 @@ static const char *const opnames[] = {
   "LEN",
   "CONCAT",
   "CLOSE",
+  "TBC",
   "JMP",
   "EQ",
   "LT",

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;

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;
 
 

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))
 
 
 /*

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),
+      sprintf(buff, "%-12s%4d %4d", name, GETARG_A(i), GETARG_Bx(i));
-                                                       GETARG_Bx(i));
       break;
     case iAsBx:
-      sprintf(buff+strlen(buff), "%-12s%4d %4d", name, GETARG_A(i),
+      sprintf(buff, "%-12s%4d %4d", name, GETARG_A(i), GETARG_sBx(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),
+      sprintf(buff, "%-12s%4d (%1d)", name, GETARG_sJ(i), !!GETARG_m(i));
-                                                         !!GETARG_m(i));
       break;
   }
-  return buff;
+  return obuff;
 }
 
 

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;

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')
 
 

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