first implementation of yieldable 'pcall'

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 2.72 2009/03/23 14:26:12 roberto Exp roberto $
+** $Id: lapi.c,v 2.73 2009/03/30 18:39:20 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -762,9 +762,9 @@ LUA_API int lua_setfenv (lua_State *L, int idx) {
 
 
 LUA_API int lua_getctx (lua_State *L, int *ctx) {
-  if (L->ci->callstatus & CIST_CTX) {  /* call has ctx? */
-    *ctx = L->ci->u.c.ctx;
-    return LUA_YIELD;
+  if (L->ci->callstatus & CIST_YIELDED) {
+    if (ctx) *ctx = L->ci->u.c.ctx;
+    return L->ci->u.c.status;
   }
   else return LUA_OK;
 }
@@ -782,7 +782,6 @@ LUA_API void lua_callk (lua_State *L, int nargs, int nresults, int ctx,
   if (k != NULL && L->nny == 0) {  /* need to prepare continuation? */
     L->ci->u.c.k = k;  /* save continuation */
     L->ci->u.c.ctx = ctx;  /* save context */
-    L->ci->callstatus |= CIST_CTX;  /* mark that call has context */
     luaD_call(L, func, nresults, 1);  /* do the call */
   }
   else  /* no continuation or no yieldable */
@@ -809,7 +808,8 @@ static void f_call (lua_State *L, void *ud) {
 
 
 
-LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc) {
+LUA_API int lua_pcallk (lua_State *L, int nargs, int nresults, int errfunc,
+                        int ctx, lua_CFunction k) {
   struct CallS c;
   int status;
   ptrdiff_t func;
@@ -824,8 +824,25 @@ LUA_API int lua_pcall (lua_State *L, int nargs, int nresults, int errfunc) {
     func = savestack(L, o);
   }
   c.func = L->top - (nargs+1);  /* function to be called */
-  c.nresults = nresults;
-  status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);
+  if (k == NULL || L->nny > 0) {  /* no continuation or no yieldable? */
+    c.nresults = nresults;  /* do a 'conventional' protected call */
+    status = luaD_pcall(L, f_call, &c, savestack(L, c.func), func);
+  }
+  else {  /* prepare continuation (call is already protected by 'resume') */
+    L->ci->u.c.k = k;  /* save continuation */
+    L->ci->u.c.ctx = ctx;  /* save context */
+    /* save information for error recovery */
+    L->ci->u.c.oldtop = savestack(L, c.func);
+    L->ci->u.c.old_allowhook = L->allowhook;
+    L->ci->u.c.old_errfunc = L->errfunc;
+    L->errfunc = func;
+    /* mark that function may do error recovery */
+    L->ci->callstatus |= CIST_YPCALL;
+    luaD_call(L, c.func, nresults, 1);  /* do the call */
+    L->ci->callstatus &= ~CIST_YPCALL;
+    L->errfunc = L->ci->u.c.old_errfunc;
+    status = LUA_OK;  /* if it is here, there were no errors */
+  }
   adjustresults(L, nresults);
   lua_unlock(L);
   return status;

lbaselib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbaselib.c,v 1.213 2009/03/16 16:30:50 roberto Exp roberto $
+** $Id: lbaselib.c,v 1.214 2009/03/23 14:26:12 roberto Exp roberto $
 ** Basic library
 ** See Copyright Notice in lua.h
 */
@@ -402,10 +402,23 @@ static int luaB_select (lua_State *L) {
 }
 
 
+static int pcallcont (lua_State *L) {
+  int errfunc;  /* call has an error function in bottom of the stack */
+  int status = lua_getctx(L, &errfunc);
+  lua_assert(status != LUA_OK);
+  lua_pushboolean(L, (status == LUA_YIELD));
+  if (errfunc)  /* came from xpcall? */
+    lua_replace(L, 1);  /* put result in place of error function */
+  else  /* came from pcall */
+    lua_insert(L, 1);  /* open space for result */
+  return lua_gettop(L);
+}
+
+
 static int luaB_pcall (lua_State *L) {
   int status;
   luaL_checkany(L, 1);
-  status = lua_pcall(L, lua_gettop(L) - 1, LUA_MULTRET, 0);
+  status = lua_pcallk(L, lua_gettop(L) - 1, LUA_MULTRET, 0, 0, pcallcont);
   lua_pushboolean(L, (status == LUA_OK));
   lua_insert(L, 1);
   return lua_gettop(L);  /* return status + all results */
@@ -420,7 +433,7 @@ static int luaB_xpcall (lua_State *L) {
   lua_pushvalue(L, 2);  /* ...and error handler */
   lua_replace(L, 1);
   lua_replace(L, 2);
-  status = lua_pcall(L, n - 2, LUA_MULTRET, 1);
+  status = lua_pcallk(L, n - 2, LUA_MULTRET, 1, 1, pcallcont);
   lua_pushboolean(L, (status == LUA_OK));
   lua_replace(L, 1);
   return lua_gettop(L);  /* return status + all results */

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 2.56 2009/03/23 14:26:12 roberto Exp roberto $
+** $Id: ldo.c,v 2.57 2009/03/26 12:56:38 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -369,9 +369,14 @@ static void finishCcall (lua_State *L) {
   lua_assert(L->nny == 0);
   /* finish 'luaD_call' */
   G(L)->nCcalls--;
-  /* finish 'lua_callcont' */
+  /* finish 'lua_callk' */
   adjustresults(L, (L->ci + 1)->nresults);
   /* call continuation function */
+  if (!(L->ci->callstatus & CIST_STAT))  /* no call status? */
+    L->ci->u.c.status = LUA_YIELD;  /* 'default' status */
+  lua_assert(L->ci->u.c.status != LUA_OK);
+  L->ci->callstatus = (L->ci->callstatus & ~(CIST_YPCALL | CIST_STAT))
+                    | CIST_YIELDED;
   lua_unlock(L);
   n = (*L->ci->u.c.k)(L);
   lua_lock(L);
@@ -380,7 +385,8 @@ static void finishCcall (lua_State *L) {
 }
 
 
-static void unroll (lua_State *L) {
+static void unroll (lua_State *L, void *ud) {
+  UNUSED(ud);
   for (;;) {
     if (L->ci == L->base_ci)  /* stack is empty? */
       return;  /* coroutine finished normally */
@@ -413,7 +419,7 @@ static void resume (lua_State *L, void *ud) {
       G(L)->nCcalls--;  /* finish 'luaD_call' */
       luaD_poscall(L, firstArg);  /* finish 'luaD_precall' */
     }
-    unroll(L);
+    unroll(L, NULL);
   }
 }
 
@@ -427,6 +433,39 @@ static int resume_error (lua_State *L, const char *msg) {
 }
 
 
+/*
+** check whether thread has a suspended protected call
+*/
+static CallInfo *findpcall (lua_State *L) {
+  CallInfo *ci;
+  for (ci = L->ci; ci > L->base_ci; ci--) {  /* search for first pcall */
+    if (ci->callstatus & CIST_YPCALL)
+      return ci;
+  }
+  return NULL;  /* no pending pcall */
+}
+
+
+static int recover (lua_State *L, int status) {
+  StkId oldtop;
+  CallInfo *ci = findpcall(L);
+  if (ci == NULL) return 0;  /* no recovery point */
+  /* "finish" luaD_pcall */
+  oldtop = restorestack(L, ci->u.c.oldtop);
+  luaF_close(L, oldtop);
+  luaD_seterrorobj(L, status, oldtop);
+  L->ci = ci;
+  L->base = L->ci->base;
+  L->allowhook = ci->u.c.old_allowhook;
+  L->nny = 0;  /* should be zero to be yieldable */
+  restore_stack_limit(L);
+  L->errfunc = ci->u.c.old_errfunc;
+  ci->callstatus |= CIST_STAT;  /* call has error status */
+  ci->u.c.status = status;  /* (here it is) */
+  return 1;  /* continue running the coroutine */
+}
+
+
 LUA_API int lua_resume (lua_State *L, int nargs) {
   int status;
   lua_lock(L);
@@ -437,20 +476,22 @@ LUA_API int lua_resume (lua_State *L, int nargs) {
       return resume_error(L, "cannot resume non-suspended coroutine");
   }
   luai_userstateresume(L, nargs);
-  lua_assert(L->errfunc == 0); 
   if (G(L)->nCcalls >= LUAI_MAXCCALLS)
       return resume_error(L, "C stack overflow");
   ++G(L)->nCcalls;  /* count resume */
   L->nny = 0;  /* allow yields */
   status = luaD_rawrunprotected(L, resume, L->top - nargs);
-  if (status != LUA_OK && status != LUA_YIELD) {  /* error? */
-    L->status = cast_byte(status);  /* mark thread as `dead' */
-    luaD_seterrorobj(L, status, L->top);
-    L->ci->top = L->top;
-  }
-  else {
-    lua_assert(status == L->status);
+  while (status != LUA_OK && status != LUA_YIELD) {  /* error? */
+    if (recover(L, status))  /* recover point? */
+      status = luaD_rawrunprotected(L, unroll, NULL);  /* run continuation */
+    else {  /* unrecoverable error */
+      L->status = cast_byte(status);  /* mark thread as `dead' */
+      luaD_seterrorobj(L, status, L->top);
+      L->ci->top = L->top;
+      break;
+    }
   }
+  lua_assert(status == L->status);
   L->nny = 1;  /* do not allow yields */
   --G(L)->nCcalls;
   lua_unlock(L);

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 2.39 2009/03/10 17:14:37 roberto Exp roberto $
+** $Id: lstate.h,v 2.40 2009/03/23 14:26:12 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -90,6 +90,10 @@ typedef struct CallInfo {
     struct {  /* only for C functions */
       int ctx;  /* context info. in case of yields */
       lua_CFunction k;  /* continuation in case of yields */
+      ptrdiff_t old_errfunc;
+      ptrdiff_t oldtop;
+      lu_byte old_allowhook;
+      lu_byte status;
     } c;
   } u;
 } CallInfo;
@@ -98,11 +102,13 @@ typedef struct CallInfo {
 /*
 ** Bits in CallInfo status
 */
-#define CIST_LUA	1	/* call is running a Lua function */
-#define CIST_HOOKED	2	/* call is running a debug hook */
-#define CIST_REENTRY	4	/* call is running on same invocation of
+#define CIST_LUA	(1<<0)	/* call is running a Lua function */
+#define CIST_HOOKED	(1<<1)	/* call is running a debug hook */
+#define CIST_REENTRY	(1<<2)	/* call is running on same invocation of
                                    luaV_execute of previous call */
-#define CIST_CTX	8	/* call has a ctx value */
+#define CIST_YIELDED	(1<<3)	/* call reentered after suspension */
+#define CIST_YPCALL	(1<<4)	/* call is a yieldable protected call */
+#define CIST_STAT	(1<<5)	/* call has an error status (pcall) */
 
 
 #define curr_func(L)	(clvalue(L->ci->func))

lua.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.233 2009/03/10 17:14:37 roberto Exp roberto $
+** $Id: lua.h,v 1.234 2009/03/23 14:26:12 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** Lua.org, PUC-Rio, Brazil (http://www.lua.org)
 ** See Copyright Notice at the end of this file
@@ -209,7 +209,10 @@ LUA_API void  (lua_callk) (lua_State *L, int nargs, int nresults, int ctx,
 
 LUA_API int   (lua_getctx) (lua_State *L, int *ctx);
 
-LUA_API int   (lua_pcall) (lua_State *L, int nargs, int nresults, int errfunc);
+LUA_API int   (lua_pcallk) (lua_State *L, int nargs, int nresults, int errfunc,
+                            int ctx, lua_CFunction k);
+#define lua_pcall(L,n,r,f)	lua_pcallk(L, (n), (r), (f), 0, NULL)
+
 LUA_API int   (lua_cpcall) (lua_State *L, lua_CFunction func, void *ud);
 LUA_API int   (lua_load) (lua_State *L, lua_Reader reader, void *dt,
                                         const char *chunkname);