lua-users home
lua-l archive

[Date Prev][Date Next][Thread Prev][Thread Next] [Date Index] [Thread Index]


alex.mania wrote:
As unwind_protect, try finallys, RAII all seems to be the topic of the week I
thought I'd try my hand at implementing such a thing in to the parser/vm....
I am yet to migrate over to Lua 5.1.3, and have a few other patches on my copy of
Lua, so I had to copy the changed code over to a 5.1.3 before making the diff.
Hopefully I haven't left any code out...Would appreciate
feedback on whether this is the case.

Some parts of that patch got in the wrong place. Attached is an updated patch that compiles and runs. However, there still were some warnings, which I hadn't looked into:

gcc -O2 -Wall -DLUA_USE_LINUX   -c -o lparser.o lparser.c
lparser.c: In function `chunk':
lparser.c:1270: warning: 'prev' might be used uninitialized in this function

gcc -O2 -Wall -DLUA_USE_LINUX   -c -o lvm.o lvm.c
lvm.c: In function `luaV_execute':
lvm.c:776: warning: initialization makes integer from pointer without a cast

Other than that, thanks for posting the patch. This is the type of solution to exceptions/RAII I've been advocating for Lua. My one comment is that the guard may need to see the exception object (similar to a catch):

  guard e do
    error("failure in foo: " .. e)
  end

diff -ur lua-5.1.3/src/lcode.c lua-5.1.3-patched/src/lcode.c
--- lua-5.1.3/src/lcode.c	2007-12-28 10:32:23.000000000 -0500
+++ lua-5.1.3-patched/src/lcode.c	2008-02-11 20:23:27.500000000 -0500
@@ -23,6 +23,7 @@
 #include "lparser.h"
 #include "ltable.h"
 
+static int addk (FuncState *fs, TValue *k, TValue *v);
 
 #define hasjumps(e)	((e)->t != (e)->f)
 
@@ -66,8 +67,8 @@
 }
 
 
-void luaK_ret (FuncState *fs, int first, int nret) {
-  luaK_codeABC(fs, OP_RETURN, first, nret+1, 0);
+void luaK_ret (FuncState *fs, int first, int nret, int opcode) {
+  luaK_codeABC(fs, opcode, first, nret+1, 0);
 }
 
 
@@ -79,10 +80,19 @@
 
 static void fixjump (FuncState *fs, int pc, int dest) {
   Instruction *jmp = &fs->f->code[pc];
-  int offset = dest-(pc+1);
+  int offset;
+  if (GET_OPCODE(*jmp) == NUM_OPCODES) {
+	TValue o; /* convert jump to a LOADK to set flow */
+	o.tt = LUA_TTRYFLOW;
+	o.value.p = cast(void *, dest-(fs->f->lineinfo[pc]+1));
+	fs->f->lineinfo[pc] = fs->f->lineinfo[pc+1]; /* correct line number */
+	*jmp = CREATE_ABx(OP_LOADK, GETARG_A(*jmp), addk(fs, &o, &o));
+	return;
+  }
+  offset = dest-(pc+1);
   lua_assert(dest != NO_JUMP);
   if (abs(offset) > MAXARG_sBx)
-    luaX_syntaxerror(fs->ls, "control structure too long");
+	luaX_syntaxerror(fs->ls, "control structure too long");
   SETARG_sBx(*jmp, offset);
 }
 
@@ -818,8 +828,8 @@
 
 
 int luaK_codeABx (FuncState *fs, OpCode o, int a, unsigned int bc) {
-  lua_assert(getOpMode(o) == iABx || getOpMode(o) == iAsBx);
-  lua_assert(getCMode(o) == OpArgN);
+  lua_assert(o == NUM_OPCODES || getOpMode(o) == iABx || getOpMode(o) == iAsBx);
+  lua_assert(o == NUM_OPCODES || getCMode(o) == OpArgN);
   return luaK_code(fs, CREATE_ABx(o, a, bc), fs->ls->lastline);
 }
 
diff -ur lua-5.1.3/src/lcode.h lua-5.1.3-patched/src/lcode.h
--- lua-5.1.3/src/lcode.h	2007-12-27 08:02:25.000000000 -0500
+++ lua-5.1.3-patched/src/lcode.h	2008-02-11 20:05:45.187500000 -0500
@@ -62,7 +62,7 @@
 LUAI_FUNC void luaK_setreturns (FuncState *fs, expdesc *e, int nresults);
 LUAI_FUNC void luaK_setoneret (FuncState *fs, expdesc *e);
 LUAI_FUNC int luaK_jump (FuncState *fs);
-LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret);
+LUAI_FUNC void luaK_ret (FuncState *fs, int first, int nret, int opcode);
 LUAI_FUNC void luaK_patchlist (FuncState *fs, int list, int target);
 LUAI_FUNC void luaK_patchtohere (FuncState *fs, int list);
 LUAI_FUNC void luaK_concat (FuncState *fs, int *l1, int l2);
diff -ur lua-5.1.3/src/ldebug.c lua-5.1.3-patched/src/ldebug.c
--- lua-5.1.3/src/ldebug.c	2007-12-28 10:32:23.000000000 -0500
+++ lua-5.1.3-patched/src/ldebug.c	2008-02-11 20:05:45.265625000 -0500
@@ -292,6 +292,8 @@
     case OP_CALL:
     case OP_TAILCALL:
     case OP_RETURN:
+    case OP_LOADK: /* unfortunately loadk can occur between a vararg exp */
+    case OP_TRYRETURN: /* and a tryreturn. */
     case OP_SETLIST: {
       check(GETARG_B(i) == 0);
       return 1;
diff -ur lua-5.1.3/src/ldo.c lua-5.1.3-patched/src/ldo.c
--- lua-5.1.3/src/ldo.c	2008-01-18 17:31:22.000000000 -0500
+++ lua-5.1.3-patched/src/ldo.c	2008-02-11 20:05:45.359375000 -0500
@@ -291,7 +291,7 @@
     ci->top = L->base + p->maxstacksize;
     lua_assert(ci->top <= L->stack_last);
     L->savedpc = p->code;  /* starting point */
-    ci->tailcalls = 0;
+    ci->actresults = ci->tailcalls = 0;
     ci->nresults = nresults;
     for (st = L->top; st < ci->top; st++)
       setnilvalue(st);
@@ -360,6 +360,42 @@
 }
 
 
+void luaD_tryreturn (lua_State *L, StkId ra, int b) {
+  GCObject *up;
+  int wanted = L->ci->nresults;
+  int actresults = cast_int(L->top-ra);
+  int a;
+  StkId base;
+  if (b != 0) /* returning less than are on stack? */
+    actresults = b-1;
+  if (wanted >= 0 && wanted < actresults)
+    actresults = wanted; /* caller wants less results? */
+  if (!actresults) return;
+  a = cast_int(ra-L->base);
+  luaD_checkstack(L, actresults);
+  /* move existing stack up, and place returns  */
+  /* just after where the varargs currently sit */
+  base = L->base;
+  for (up = L->openupval; up != NULL; up = up->gch.next) {
+    if (gco2uv(up)->v < base) break;
+    gco2uv(up)->v += actresults;
+  }
+  memmove(base + actresults, base, sizeof(TValue)*(L->top-base));
+  memcpy(base, base + actresults + a, sizeof(TValue)*actresults);
+  L->ci->base = L->base = base + actresults;
+  L->top = (L->ci->top += actresults);
+  L->ci->actresults = actresults;
+}
+
+
+void cstackoverflow (lua_State *L) {
+  if (L->nCcalls == LUAI_MAXCCALLS)
+    luaG_runerror(L, "C stack overflow");
+  else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3)))
+    luaD_throw(L, LUA_ERRERR);  /* error while handing stack error */
+}
+
+
 /*
 ** Call a function (C or Lua). The function to be called is at *func.
 ** The arguments are on the stack, right after the function.
@@ -367,12 +403,8 @@
 ** function position.
 */ 
 void luaD_call (lua_State *L, StkId func, int nResults) {
-  if (++L->nCcalls >= LUAI_MAXCCALLS) {
-    if (L->nCcalls == LUAI_MAXCCALLS)
-      luaG_runerror(L, "C stack overflow");
-    else if (L->nCcalls >= (LUAI_MAXCCALLS + (LUAI_MAXCCALLS>>3)))
-      luaD_throw(L, LUA_ERRERR);  /* error while handing stack error */
-  }
+  if (++L->nCcalls >= LUAI_MAXCCALLS)
+    cstackoverflow(L);
   if (luaD_precall(L, func, nResults) == PCRLUA)  /* is a Lua function? */
     luaV_execute(L, 1);  /* call it */
   L->nCcalls--;
@@ -380,6 +412,14 @@
 }
 
 
+void luaD_tryenter (lua_State *L, void *ud) {
+  if (++L->nCcalls >= LUAI_MAXCCALLS)
+    cstackoverflow(L);
+  luaV_execute(L, 1);
+  L->nCcalls--;
+}
+
+
 static void resume (lua_State *L, void *ud) {
   StkId firstArg = cast(StkId, ud);
   CallInfo *ci = L->ci;
@@ -457,16 +497,20 @@
   int status;
   unsigned short oldnCcalls = L->nCcalls;
   ptrdiff_t old_ci = saveci(L, L->ci);
+  lu_byte oldactresults = L->ci->actresults;
   lu_byte old_allowhooks = L->allowhook;
   ptrdiff_t old_errfunc = L->errfunc;
   L->errfunc = ef;
   status = luaD_rawrunprotected(L, func, u);
   if (status != 0) {  /* an error occurred? */
+    CallInfo *oldci = restoreci(L, old_ci);
     StkId oldtop = restorestack(L, old_top);
+    if ((func == &luaD_tryenter) && (!ci_func(oldci)->c.isC))
+      oldtop += oldci->actresults - oldactresults;
     luaF_close(L, oldtop);  /* close eventual pending closures */
     luaD_seterrorobj(L, status, oldtop);
     L->nCcalls = oldnCcalls;
-    L->ci = restoreci(L, old_ci);
+    L->ci = oldci;
     L->base = L->ci->base;
     L->savedpc = L->ci->savedpc;
     L->allowhook = old_allowhooks;
diff -ur lua-5.1.3/src/ldo.h lua-5.1.3-patched/src/ldo.h
--- lua-5.1.3/src/ldo.h	2007-12-27 08:02:25.000000000 -0500
+++ lua-5.1.3-patched/src/ldo.h	2008-02-11 20:05:45.390625000 -0500
@@ -41,9 +41,11 @@
 LUAI_FUNC void luaD_callhook (lua_State *L, int event, int line);
 LUAI_FUNC int luaD_precall (lua_State *L, StkId func, int nresults);
 LUAI_FUNC void luaD_call (lua_State *L, StkId func, int nResults);
+LUAI_FUNC void luaD_tryenter(lua_State *L, void *ud);
 LUAI_FUNC int luaD_pcall (lua_State *L, Pfunc func, void *u,
                                         ptrdiff_t oldtop, ptrdiff_t ef);
 LUAI_FUNC int luaD_poscall (lua_State *L, StkId firstResult);
+LUAI_FUNC void luaD_tryreturn (lua_State *L, StkId ra, int b);
 LUAI_FUNC void luaD_reallocCI (lua_State *L, int newsize);
 LUAI_FUNC void luaD_reallocstack (lua_State *L, int newsize);
 LUAI_FUNC void luaD_growstack (lua_State *L, int n);
diff -ur lua-5.1.3/src/llex.c lua-5.1.3-patched/src/llex.c
--- lua-5.1.3/src/llex.c	2007-12-27 08:02:25.000000000 -0500
+++ lua-5.1.3-patched/src/llex.c	2008-02-11 20:36:19.031250000 -0500
@@ -36,9 +36,10 @@
 /* ORDER RESERVED */
 const char *const luaX_tokens [] = {
     "and", "break", "do", "else", "elseif",
-    "end", "false", "for", "function", "if",
-    "in", "local", "nil", "not", "or", "repeat",
-    "return", "then", "true", "until", "while",
+    "end", "false", "finalize", "for", 
+    "function", "guard", "if", "in", "local", 
+    "nil", "not", "or", "repeat", "return", 
+    "then", "true", "until", "while",
     "..", "...", "==", ">=", "<=", "~=",
     "<number>", "<name>", "<string>", "<eof>",
     NULL
diff -ur lua-5.1.3/src/llex.h lua-5.1.3-patched/src/llex.h
--- lua-5.1.3/src/llex.h	2007-12-27 08:02:25.000000000 -0500
+++ lua-5.1.3-patched/src/llex.h	2008-02-11 20:05:45.500000000 -0500
@@ -24,7 +24,8 @@
 enum RESERVED {
   /* terminal symbols denoted by reserved words */
   TK_AND = FIRST_RESERVED, TK_BREAK,
-  TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE, TK_FOR, TK_FUNCTION,
+  TK_DO, TK_ELSE, TK_ELSEIF, TK_END, TK_FALSE,
+  TK_FINALIZE, TK_FOR, TK_FUNCTION, TK_GUARD,
   TK_IF, TK_IN, TK_LOCAL, TK_NIL, TK_NOT, TK_OR, TK_REPEAT,
   TK_RETURN, TK_THEN, TK_TRUE, TK_UNTIL, TK_WHILE,
   /* other terminal symbols */
diff -ur lua-5.1.3/src/lopcodes.c lua-5.1.3-patched/src/lopcodes.c
--- lua-5.1.3/src/lopcodes.c	2007-12-27 08:02:25.000000000 -0500
+++ lua-5.1.3-patched/src/lopcodes.c	2008-02-11 20:05:45.531250000 -0500
@@ -51,6 +51,10 @@
   "SETLIST",
   "CLOSE",
   "CLOSURE",
+  "TRYENTER",
+  "TRYRETURN",
+  "TRYRESUME",
+  "TRYCLOSE",
   "VARARG",
   NULL
 };
@@ -97,6 +101,10 @@
  ,opmode(0, 0, OpArgU, OpArgU, iABC)		/* OP_SETLIST */
  ,opmode(0, 0, OpArgN, OpArgN, iABC)		/* OP_CLOSE */
  ,opmode(0, 1, OpArgU, OpArgN, iABx)		/* OP_CLOSURE */
+ ,opmode(0, 1, OpArgU, OpArgN, iAsBx)       /* OP_TRYENTER */
+ ,opmode(0, 1, OpArgU, OpArgU, iABC)        /* OP_TRYRETURN */
+ ,opmode(0, 1, OpArgU, OpArgN, iAsBx)       /* OP_TRYRESUME */
+ ,opmode(0, 0, OpArgN, OpArgN, iABC)        /* OP_TRYCLOSE */
  ,opmode(0, 1, OpArgU, OpArgN, iABC)		/* OP_VARARG */
 };
 
diff -ur lua-5.1.3/src/lopcodes.h lua-5.1.3-patched/src/lopcodes.h
--- lua-5.1.3/src/lopcodes.h	2007-12-27 08:02:25.000000000 -0500
+++ lua-5.1.3-patched/src/lopcodes.h	2008-02-11 20:05:45.593750000 -0500
@@ -204,6 +204,11 @@
 OP_CLOSE,/*	A 	close all variables in the stack up to (>=) R(A)*/
 OP_CLOSURE,/*	A Bx	R(A) := closure(KPROTO[Bx], R(A), ... ,R(A+n))	*/
 
+OP_TRYENTER,/*    A sBx   Start protected vm on pc + sBx (store err at A) */
+OP_TRYRETURN,/*  A B C  C ? return saved results : save returns */
+OP_TRYRESUME,/*  A sBx  Rethrow error, continue break flow, or jump sBx */
+OP_TRYCLOSE,/*    Close a protected vm */
+
 OP_VARARG/*	A B	R(A), R(A+1), ..., R(A+B-1) = vararg		*/
 } OpCode;
 
diff -ur lua-5.1.3/src/lparser.c lua-5.1.3-patched/src/lparser.c
--- lua-5.1.3/src/lparser.c	2007-12-28 10:32:23.000000000 -0500
+++ lua-5.1.3-patched/src/lparser.c	2008-02-11 20:35:05.312500000 -0500
@@ -39,12 +39,23 @@
 */
 typedef struct BlockCnt {
   struct BlockCnt *previous;  /* chain */
+  struct GuardControl *gc;
   int breaklist;  /* list of jumps out of this loop */
   lu_byte nactvar;  /* # active locals outside the breakable structure */
   lu_byte upval;  /* true if some variable in the block is an upvalue */
   lu_byte isbreakable;  /* true if `block' is a loop */
 } BlockCnt;
 
+static void g_setresume (FuncState *fs, struct GuardControl *gc, int *list);
+struct GuardControl {
+  int statereg;     /* first register saving the state */
+  int pcresume;     /* pc of the TRYRESUME opcode */
+  int jdobreak;     /* list of jumps to the -actual- break */
+  int jdoreturn;    /* list of jumps to the -actual- return */
+  lu_byte isguard;  /* is it a guard or a finalize? */
+  lu_byte inguard;  /* if in guard, cannot return or break */
+  BlockCnt bl;
+};
 
 
 /*
@@ -288,6 +299,7 @@
   bl->nactvar = fs->nactvar;
   bl->upval = 0;
   bl->previous = fs->bl;
+  bl->gc = NULL;
   fs->bl = bl;
   lua_assert(fs->freereg == fs->nactvar);
 }
@@ -358,7 +370,7 @@
   FuncState *fs = ls->fs;
   Proto *f = fs->f;
   removevars(ls, 0);
-  luaK_ret(fs, 0, 0);  /* final return */
+  luaK_ret(fs, 0, 0, OP_RETURN);  /* final return */
   luaM_reallocvector(L, f->code, f->sizecode, fs->pc, Instruction);
   f->sizecode = fs->pc;
   luaM_reallocvector(L, f->lineinfo, f->sizelineinfo, fs->pc, int);
@@ -974,13 +986,28 @@
 
 static void breakstat (LexState *ls) {
   FuncState *fs = ls->fs;
-  BlockCnt *bl = fs->bl;
+  BlockCnt *bl = fs->bl, *loop;
   int upval = 0;
   while (bl && !bl->isbreakable) {
+    struct GuardControl *gc = bl->gc;
     upval |= bl->upval;
+    if (gc) {
+      if (gc->inguard)
+        luaX_lexerror(ls, gc->isguard
+          ? "cannot break out of a guard"
+          : "cannot break out of a finalize", 0);
+      if (!gc->isguard) {
+        g_setresume(fs, gc, &gc->jdobreak);
+        luaK_codeABC(fs, OP_TRYCLOSE, 0, 0, 0);
+        return; /* no need for jump */
+      }
+      luaK_codeABC(fs, OP_TRYCLOSE, 0, 0, 0);
+    }
     bl = bl->previous;
   }
-  if (!bl)
+  /* must not close upvalues or trys if there is a finalize block */
+  for (loop = bl; loop && !loop->isbreakable; loop = loop->previous);
+  if (!loop)
     luaX_syntaxerror(ls, "no loop to break");
   if (upval)
     luaK_codeABC(fs, OP_CLOSE, bl->nactvar, 0, 0);
@@ -1162,6 +1189,109 @@
 }
 
 
+/* set flow for after the finalize block (eg, to continue breaking) */
+static void g_setresume (FuncState *fs, struct GuardControl *gc, int *list) {
+  int pc = luaK_codeAsBx(fs, NUM_OPCODES, gc->statereg, NO_JUMP);
+  luaK_concat(fs, list, pc);
+  fs->f->lineinfo[pc] = gc->pcresume;
+}
+
+/* reads in the guard/finalize block */
+static void g_guard (FuncState *fs, struct GuardControl *gc, int line) {
+  int pctryenter;
+  int isguard = gc->isguard;
+  LexState *ls = fs->ls;
+  luaX_next(ls); /* skip "guard"/"finalize" */
+  gc->statereg = fs->freereg;
+  gc->jdobreak = NO_JUMP;  /* only used for finalizers */
+  gc->jdoreturn = NO_JUMP;
+  new_localvarliteral(ls, "(guard flow control)", 0);
+  new_localvarliteral(ls, "(guard error obj)", 1);
+  adjustlocalvars(ls, 2);
+  luaK_reserveregs(fs, 2);
+  pctryenter = luaK_codeAsBx(fs, OP_TRYENTER, gc->statereg, NO_JUMP);
+  if (isguard) /* unless there's an error, guards jump over the block */
+    luaK_jump(fs);
+  enterblock(fs, &gc->bl, 0); /* scope of variables inside block */
+  gc->bl.gc = gc;
+  gc->inguard = 1; /* returns/breaks not allowed */
+  block(ls);
+  check_match(ls, TK_END, isguard ? TK_GUARD : TK_FINALIZE, line);
+  leaveblock(fs);
+  gc->pcresume = luaK_codeAsBx(fs, OP_TRYRESUME, gc->statereg, NO_JUMP);
+  luaK_patchtohere(fs, pctryenter); /* set jump targets */
+  /* read in protected block*/
+  enterblock(fs, &gc->bl, 0); /* so that variables are closed correctly */
+  gc->bl.gc = gc;
+  gc->inguard = 0;
+  block(ls);
+  leaveblock(fs);
+  luaK_codeABC(fs, OP_TRYCLOSE, 0, 0, 0);
+  if (isguard) {
+    luaK_patchtohere(fs, pctryenter+1);
+    SETARG_Bx(fs->f->code[pctryenter], /* need to negate, to indicate a guard */
+      MAXARG_sBx-(GETARG_Bx(fs->f->code[pctryenter])-MAXARG_sBx));
+  }
+}
+
+static void guardstat (LexState *ls, int line) {
+  FuncState *fs = ls->fs;
+  struct GuardControl gc;
+  gc.isguard = 1;
+  g_guard(fs, &gc, line);
+}
+
+static void finalizestat (LexState *ls, int line) {
+  FuncState *fs = ls->fs;
+  struct GuardControl gc;
+  gc.isguard = 0;
+  g_guard(fs, &gc, line);
+  /* set jump target for any breaks */
+  if (gc.jdobreak != NO_JUMP) {
+    BlockCnt *bl = fs->bl;
+    while (!bl->isbreakable) {
+      if (bl->upval || bl->gc) {
+        /* close additional values/guards before jumping out of loop */
+        luaK_patchtohere(fs, gc.jdobreak);
+        breakstat(ls);
+        break;
+      }
+      bl = bl->previous;
+      lua_assert(bl); /* breaks should have been checked for validity */
+    }
+    if (bl->isbreakable) /* nothing to close, just concat lists */
+      luaK_concat(fs, &bl->breaklist, gc.jdobreak);
+  }
+  /* set jump target for any returns
+  ** at this point, tryreturn has placed any returns between the varargs
+  ** and the local variables */
+  if (gc.jdoreturn != NO_JUMP) {
+    int upval = 0;
+    BlockCnt *bl = fs->bl, *prev;
+    luaK_patchtohere(fs, gc.jdoreturn);
+    while (bl) {
+      if (bl->gc) {
+        if (!bl->gc->isguard) { /* need to chain to another finalizer */
+          if (upval) /* need to close upvalues from previous block */
+            luaK_codeABC(fs, OP_CLOSE, prev->nactvar, 0, 0);
+          g_setresume(fs, bl->gc, &bl->gc->jdoreturn);
+          luaK_codeABC(fs, OP_TRYCLOSE, 0, 0, 0);
+          goto chained; /* don't return; we're chaining two finalizers */
+        }
+        luaK_codeABC(fs, OP_TRYCLOSE, 0, 0, 0);
+      }
+      upval |= bl->upval;
+      prev = bl;
+      bl = bl->previous;
+    }
+    luaK_codeABC(fs, OP_TRYRETURN, 0, 0, 1); /* real return */
+  }
+  chained: /* it's a nested finalizer, don't actually return */
+  /* set jump target for normal program flow (no breaks/returns) */
+  luaK_patchtohere(fs, gc.pcresume);
+}
+
+
 static void localfunc (LexState *ls) {
   expdesc v, b;
   FuncState *fs = ls->fs;
@@ -1240,6 +1370,19 @@
   FuncState *fs = ls->fs;
   expdesc e;
   int first, nret;  /* registers with returned values */
+  BlockCnt *bl = fs->bl, *finalizer = NULL, *prev = NULL;
+  int upval = 0;
+  while (bl) { /* are tailcalls allowed? */
+    if (bl->gc) {
+      if (bl->gc->inguard)
+        luaX_lexerror(ls, bl->gc->isguard
+          ? "cannot return from inside a guard"
+          : "cannot return from inside a finalizer", 0);
+      if (!finalizer && !bl->gc->isguard)
+        finalizer = bl;
+    }
+    bl = bl->previous;
+  }
   luaX_next(ls);  /* skip RETURN */
   if (block_follow(ls->t.token) || ls->t.token == ';')
     first = nret = 0;  /* return no values */
@@ -1247,7 +1390,7 @@
     nret = explist1(ls, &e);  /* optional return values */
     if (hasmultret(e.k)) {
       luaK_setmultret(fs, &e);
-      if (e.k == VCALL && nret == 1) {  /* tail call? */
+      if (e.k == VCALL && nret == 1 && !finalizer) {  /* tail call? */
         SET_OPCODE(getcode(fs,&e), OP_TAILCALL);
         lua_assert(GETARG_A(getcode(fs,&e)) == fs->nactvar);
       }
@@ -1264,7 +1407,26 @@
       }
     }
   }
-  luaK_ret(fs, first, nret);
+  bl = fs->bl;
+  while (bl) {
+    struct GuardControl *gc = bl->gc;
+    if (gc) {
+      if (bl == finalizer) {
+        if (upval)
+          luaK_codeABC(fs, OP_CLOSE, prev->nactvar, 0, 0);
+        g_setresume(fs, gc, &gc->jdoreturn);
+        lua_assert(nret < MAXARG_B); /* MAXARG_B indicates a real return */
+        luaK_ret(fs, first, nret, OP_TRYRETURN);
+        return;
+      }
+      luaK_codeABC(fs, OP_TRYCLOSE, 0, 0, 0);
+    }
+    upval |= bl->upval;
+    prev = bl;
+    bl = bl->previous;
+  }
+  lua_assert(!finalizer);
+  luaK_ret(fs, first, nret, OP_RETURN);
 }
 
 
@@ -1297,6 +1459,14 @@
       funcstat(ls, line);  /* stat -> funcstat */
       return 0;
     }
+    case TK_FINALIZE: {
+      finalizestat(ls, ls->linenumber);
+      return 0;
+    }
+    case TK_GUARD: {
+      guardstat(ls, ls->linenumber);
+      return 0;
+    }
     case TK_LOCAL: {  /* stat -> localstat */
       luaX_next(ls);  /* skip LOCAL */
       if (testnext(ls, TK_FUNCTION))  /* local function? */
diff -ur lua-5.1.3/src/lstate.h lua-5.1.3-patched/src/lstate.h
--- lua-5.1.3/src/lstate.h	2008-01-03 10:20:39.000000000 -0500
+++ lua-5.1.3-patched/src/lstate.h	2008-02-11 20:05:45.796875000 -0500
@@ -51,6 +51,7 @@
   StkId	top;  /* top for this function */
   const Instruction *savedpc;
   int nresults;  /* expected number of results from this function */
+  int actresults; /* number of returned values (for finalizers) */
   int tailcalls;  /* number of tail calls lost under this entry */
 } CallInfo;
 
diff -ur lua-5.1.3/src/lua.h lua-5.1.3-patched/src/lua.h
--- lua-5.1.3/src/lua.h	2008-01-03 10:41:15.000000000 -0500
+++ lua-5.1.3-patched/src/lua.h	2008-02-11 20:05:45.859375000 -0500
@@ -81,6 +81,11 @@
 #define LUA_TUSERDATA		7
 #define LUA_TTHREAD		8
 
+/* finalizers store flow control information on the stack
+** in the form of lightuserdata. If prefered, the tag can
+** be set as LUA_TNUMBER to prevent a way of generating lightuserdata
+** from within lua (via inspecting the stack) */
+#define LUA_TTRYFLOW        (LUA_TLIGHTUSERDATA)
 
 
 /* minimum Lua stack available to a C function */
diff -ur lua-5.1.3/src/lvm.c lua-5.1.3-patched/src/lvm.c
--- lua-5.1.3/src/lvm.c	2007-12-28 10:32:23.000000000 -0500
+++ lua-5.1.3-patched/src/lvm.c	2008-02-11 20:25:21.640625000 -0500
@@ -635,6 +635,7 @@
       case OP_RETURN: {
         int b = GETARG_B(i);
         if (b != 0) L->top = ra+b-1;
+	  finallyreturn:
         if (L->openupval) luaF_close(L, base);
         L->savedpc = pc;
         b = luaD_poscall(L, ra);
@@ -736,20 +737,75 @@
         Protect(luaC_checkGC(L));
         continue;
       }
+      case OP_TRYENTER: {
+        int errcode, isguard = 0;
+        int delta = GETARG_sBx(i);
+        if (delta < 0) { /* indicates a guard */
+          delta = -delta;
+          isguard = 1;
+        }
+        ra->value.p = cast(void *, 0);
+        ra->tt = LUA_TTRYFLOW;
+        L->savedpc = pc+delta;
+        errcode = luaD_pcall(L, &luaD_tryenter, NULL,
+          savestack(L, ra+1), 0);
+        base = L->base;
+        if (errcode == 0) continue;
+        L->top = L->ci->top; /* restore top */
+        ra = RA(i);
+        ra->tt = LUA_TNIL; /* set tryresume to rethrow */
+        ra->value.p = cast(void *, errcode);
+        if (isguard) pc++; /* skip jmp instruction */
+        continue;
+      }
+      case OP_TRYRETURN: {
+        if (GETARG_C(i)) { /* return previously stored values */
+          int actresults = L->ci->actresults;
+          L->top = L->ci->top = base;
+          L->ci->base = L->base = ra = base - actresults;
+          goto finallyreturn;
+        } else { /* move to beneath local vars */
+          luaD_tryreturn(L, ra, GETARG_B(i));
+          return;
+        }
+      }
+      /* runtime checks are required in case of stack modification */
+      /* believe checks to be ANSI c.. */
+      case OP_TRYRESUME: {
+        if (ra->tt == LUA_TTRYFLOW) {
+          int offset = ra->value.p;
+          const Instruction *code = cl->p->code;
+          if (((offset > 0) && ((code+cl->p->sizecode)-pc > offset))
+           || ((offset < 0) && (pc-code <= -offset)))
+            pc += offset;
+          else
+            pc += GETARG_sBx(i);
+          continue;
+        } else { /* rethrow error */
+          L->top = ra+2;
+          luaD_throw(L, cast_int(ra->value.p));
+        }
+      }
+      case OP_TRYCLOSE: {
+        return;
+      }
       case OP_VARARG: {
         int b = GETARG_B(i) - 1;
         int j;
         CallInfo *ci = L->ci;
-        int n = cast_int(ci->base - ci->func) - cl->p->numparams - 1;
+        int n = cast_int(ci->base - ci->func) -
+          cl->p->numparams - ci->actresults - 1;
+        StkId base;
         if (b == LUA_MULTRET) {
           Protect(luaD_checkstack(L, n));
           ra = RA(i);  /* previous call may change the stack */
           b = n;
           L->top = ra + n;
         }
+        base = ci->base - ci->actresults;
         for (j = 0; j < b; j++) {
           if (j < n) {
-            setobjs2s(L, ra + j, ci->base - n + j);
+            setobjs2s(L, ra + j, base - n + j);
           }
           else {
             setnilvalue(ra + j);