new API for coroutines

lapi.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lapi.c,v 1.214 2002/10/25 20:05:28 roberto Exp roberto $
+** $Id: lapi.c,v 1.215 2002/10/25 21:31:28 roberto Exp roberto $
 ** Lua API
 ** See Copyright Notice in lua.h
 */
@@ -105,6 +105,19 @@ LUA_API int lua_checkstack (lua_State *L, int size) {
 }
 
 
+LUA_API void lua_movethread (lua_State *from, lua_State *to, int n) {
+  int i;
+  lua_lock(to);
+  api_checknelems(from, n);
+  from->top -= n;
+  for (i = 0; i < n; i++) {
+    setobj(to->top, from->top + i);
+    api_incr_top(to);
+  }
+  lua_unlock(to);
+}
+
+
 LUA_API lua_CFunction lua_atpanic (lua_State *L, lua_CFunction panicf) {
   lua_CFunction old;
   lua_lock(L);

lbaselib.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lbaselib.c,v 1.102 2002/10/25 21:31:28 roberto Exp roberto $
+** $Id: lbaselib.c,v 1.103 2002/10/25 21:36:54 roberto Exp roberto $
 ** Basic library
 ** See Copyright Notice in lua.h
 */
@@ -557,12 +557,23 @@ static const luaL_reg base_funcs[] = {
 ** =======================================================
 */
 
-
-static int luaB_auxresume (lua_State *L, lua_State *co) {
+static int auxresume (lua_State *L, lua_State *co, int narg) {
   int status;
-  int oldtop = lua_gettop(L);
-  status = lua_resume(L, co);
-  return (status != 0) ? -1 : lua_gettop(L) - oldtop;
+  if (!lua_checkstack(co, narg))
+    luaL_error(L, "too many arguments to resume");
+  lua_movethread(L, co, narg);
+  status = lua_resume(co, narg);
+  if (status == 0) {
+    int nres = lua_gettop(co);
+    if (!lua_checkstack(L, narg))
+      luaL_error(L, "too many results to resume");
+    lua_movethread(co, L, nres);  /* move yielded values */
+    return nres;
+  }
+  else {
+    lua_movethread(co, L, 1);  /* move error message */
+    return -1;  /* error flag */
+  }
 }
 
 
@@ -570,7 +581,7 @@ static int luaB_coresume (lua_State *L) {
   lua_State *co = lua_tothread(L, 1);
   int r;
   luaL_arg_check(L, co, 1, "coroutine/thread expected");
-  r = luaB_auxresume(L, co);
+  r = auxresume(L, co, lua_gettop(L) - 1);
   if (r < 0) {
     lua_pushboolean(L, 0);
     lua_insert(L, -2);
@@ -585,28 +596,19 @@ static int luaB_coresume (lua_State *L) {
 
 
 static int luaB_auxwrap (lua_State *L) {
-  int r = luaB_auxresume(L, lua_tothread(L, lua_upvalueindex(1)));
-  if (r < 0) lua_error(L);
+  lua_State *co = lua_tothread(L, lua_upvalueindex(1));
+  int r = auxresume(L, co, lua_gettop(L));
+  if (r < 0) lua_error(L);  /* propagate error */
   return r;
 }
 
 
 static int luaB_cocreate (lua_State *L) {
-  lua_State *NL;
-  int ref;
-  int i;
-  int n = lua_gettop(L);
+  lua_State *NL = lua_newthread(L);
   luaL_arg_check(L, lua_isfunction(L, 1) && !lua_iscfunction(L, 1), 1,
     "Lua function expected");
-  NL = lua_newthread(L);
-  /* move function and arguments from L to NL */
-  for (i = 1; i <= n; i++) {
-    lua_pushvalue(L, i);
-    ref = lua_ref(L, 1);
-    lua_getref(NL, ref);
-    lua_unref(L, ref);
-  }
-  lua_cobegin(NL, n-1);
+  lua_pushvalue(L, 1);  /* move function to top */
+  lua_movethread(L, NL, 1);  /* move function from L to NL */
   return 1;
 }
 

ldo.c

@@ -1,5 +1,5 @@
 /*
-** $Id: ldo.c,v 1.196 2002/10/09 13:42:01 roberto Exp roberto $
+** $Id: ldo.c,v 1.197 2002/10/25 20:05:28 roberto Exp roberto $
 ** Stack and Call structure of Lua
 ** See Copyright Notice in lua.h
 */
@@ -44,22 +44,23 @@ struct lua_longjmp {
 };
 
 
-static void seterrorobj (lua_State *L, int errcode) {
+static void seterrorobj (lua_State *L, int errcode, StkId oldtop) {
   switch (errcode) {
     case LUA_ERRMEM: {
-      setsvalue(L->top, luaS_new(L, MEMERRMSG));
+      setsvalue(oldtop, luaS_new(L, MEMERRMSG));
       break;
     }
     case LUA_ERRERR: {
-      setsvalue(L->top, luaS_new(L, "error in error handling"));
+      setsvalue(oldtop, luaS_new(L, "error in error handling"));
       break;
     }
     case LUA_ERRSYNTAX:
     case LUA_ERRRUN: {
-      return;  /* error message already on top */
+      setobj(oldtop, L->top - 1);  /* error message on current top */
+      break;
     }
   }
-  L->top++;
+  L->top = oldtop + 1;
 }
 
 
@@ -298,67 +299,46 @@ void luaD_call (lua_State *L, StkId func, int nResults) {
 }
 
 
-LUA_API void lua_cobegin (lua_State *L, int nargs) {
-  lua_lock(L);
-  luaD_precall(L, L->top - (nargs+1));
-  lua_unlock(L);
-}
-
-
-static void move_results (lua_State *L, TObject *from, TObject *to) {
-  while (from < to) {
-    setobj(L->top, from);
-    from++;
-    incr_top(L);
-  }
-}
-
-
 static void resume (lua_State *L, void *ud) {
   StkId firstResult;
+  int nargs = *cast(int *, ud);
   CallInfo *ci = L->ci;
-  if (ci->state & CI_C) {  /* not first time (i.e. inside a yield)? */
+  if (ci == L->base_ci) {  /* no activation record? */
+    if (nargs >= L->top - L->ci->base)
+      luaG_runerror(L, "cannot resume dead coroutine");
+    luaD_precall(L, L->top - (nargs + 1));  /* start coroutine */
+  }
+  else if (ci->state && CI_YIELD) {  /* inside a yield? */
     /* finish interrupted execution of `OP_CALL' */
     int nresults;
     lua_assert((ci-1)->state & CI_SAVEDPC);
     lua_assert(GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_CALL ||
                GET_OPCODE(*((ci-1)->u.l.savedpc - 1)) == OP_TAILCALL);
     nresults = GETARG_C(*((ci-1)->u.l.savedpc - 1)) - 1;
-    luaD_poscall(L, nresults, L->top);  /* complete it */
+    luaD_poscall(L, nresults, L->top - nargs);  /* complete it */
     if (nresults >= 0) L->top = L->ci->top;
   }
+  else
+    luaG_runerror(L, "cannot resume non-suspended coroutine");
   firstResult = luaV_execute(L);
-  if (firstResult == NULL)   /* yield? */
-    *cast(int *, ud) = L->ci->u.c.yield_results;
-  else {  /* return */
-    *cast(int *, ud) = L->top - firstResult;
+  if (firstResult != NULL)   /* return? */
     luaD_poscall(L, LUA_MULTRET, firstResult);  /* finalize this coroutine */
-  }
 }
 
 
-LUA_API int lua_resume (lua_State *L, lua_State *co) {
-  CallInfo *ci;
-  int numres;
+LUA_API int lua_resume (lua_State *L, int nargs) {
   int status;
+  int old_allowhooks;
   lua_lock(L);
-  ci = co->ci;
-  if (ci == co->base_ci) {  /* no activation record? ?? */
-    luaO_pushfstring(L, "cannot resume dead thread");
-    status = LUA_ERRRUN;
-  }
-  else if (co->errorJmp != NULL) {  /* ?? */
-    luaO_pushfstring(L, "cannot resume active thread");
-    status = LUA_ERRRUN;
-  }
-  else {
-    status = luaD_rawrunprotected(co, resume, &numres);
-    if (status == 0)  
-      move_results(L, co->top - numres, co->top);
-    else {
-      setobj(L->top++, co->top - 1);  /* move error message to other stack */
-      co->ci = co->base_ci;  /* `kill' thread */
-    }
+  old_allowhooks = allowhook(L);
+  lua_assert(L->errfunc == 0);
+  status = luaD_rawrunprotected(L, resume, &nargs);
+  if (status != 0) {
+    L->ci = L->base_ci;  /* `kill' thread (??) */
+    seterrorobj(L, status, L->ci->base);
+    luaF_close(L, L->top);  /* close eventual pending closures */
+    setallowhook(L, old_allowhooks);
+    restore_stack_limit(L);
   }
   lua_unlock(L);
   return status;
@@ -372,7 +352,12 @@ LUA_API int lua_yield (lua_State *L, int nresults) {
   if ((ci-1)->state & CI_C)
     luaG_runerror(L, "cannot yield a C function");
   lua_assert(ci->state & CI_C);  /* current function is not Lua */
-  ci->u.c.yield_results = nresults;
+  if (L->top - nresults > ci->base) {  /* is there garbage in the stack? */
+    int i;
+    for (i=0; i<nresults; i++)  /* move down results */
+      setobj(ci->base + i, L->top - nresults + i);
+    L->top = ci->base + nresults;
+  }
   lua_unlock(L);
   return -1;
 }
@@ -405,12 +390,8 @@ int luaD_pcall (lua_State *L, int nargs, int nresults, ptrdiff_t errfunc) {
   c.nresults = nresults;
   status = luaD_rawrunprotected(L, &f_call, &c);
   if (status != 0) {  /* an error occurred? */
-    StkId err;  /* error msg. position */
-    seterrorobj(L, status);
-    err = L->top - 1;
-    /* remove parameters and func from the stack */
-    L->top = restorestack(L, old_top) - (nargs+1);
-    setobj(L->top++, err);  /* copy error message to corrected top */
+    StkId oldtop = restorestack(L, old_top) - (nargs+1);
+    seterrorobj(L, status, oldtop);
     luaF_close(L, L->top);  /* close eventual pending closures */
     L->ci = restoreci(L, old_ci);
     setallowhook(L, old_allowhooks);
@@ -461,9 +442,7 @@ int luaD_protectedparser (lua_State *L, ZIO *z, int bin) {
   }
   else {  /* error */
     StkId oldtop = restorestack(L, oldtopr);
-    seterrorobj(L, status);
-    setobj(oldtop, L->top - 1);  /* copy error message to old top */
-    L->top = oldtop+1;
+    seterrorobj(L, status, oldtop);
   }
   return status;
 }

lstate.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lstate.h,v 1.98 2002/10/22 17:58:14 roberto Exp roberto $
+** $Id: lstate.h,v 1.99 2002/10/25 20:05:28 roberto Exp roberto $
 ** Global State
 ** See Copyright Notice in lua.h
 */
@@ -83,7 +83,7 @@ typedef struct CallInfo {
       StkId *pb;  /* points to `base' variable in `luaV_execute' */
     } l;
     struct {  /* for C functions */
-      int yield_results;
+      int dummy;  /* just to avoid an empty struct */
     } c;
   } u;
 } CallInfo;
@@ -99,6 +99,7 @@ typedef struct CallInfo {
    `pc' is being used by the other, and therefore CI_SAVEDPC is 1 too) */
 #define CI_CALLING	4
 #define CI_SAVEDPC	8  /* 1 if `savedpc' is updated */
+#define CI_YIELD	16  /* 1 if thread is suspended */
 
 
 #define ci_func(ci)	(clvalue((ci)->base - 1))

lua.h

@@ -1,5 +1,5 @@
 /*
-** $Id: lua.h,v 1.160 2002/10/25 20:05:28 roberto Exp roberto $
+** $Id: lua.h,v 1.161 2002/10/25 21:31:28 roberto Exp roberto $
 ** Lua - An Extensible Extension Language
 ** Tecgraf: Computer Graphics Technology Group, PUC-Rio, Brazil
 ** http://www.lua.org	mailto:[email protected]
@@ -123,6 +123,8 @@ LUA_API void  lua_insert (lua_State *L, int idx);
 LUA_API void  lua_replace (lua_State *L, int idx);
 LUA_API int   lua_checkstack (lua_State *L, int sz);
 
+LUA_API void  lua_movethread (lua_State *from, lua_State *to, int n);
+
 
 /*
 ** access functions (stack -> C)
@@ -201,9 +203,8 @@ LUA_API int lua_dump (lua_State *L, lua_Chunkwriter writer, void *data);
 /*
 ** coroutine functions
 */
-LUA_API void lua_cobegin (lua_State *L, int nargs);
 LUA_API int  lua_yield (lua_State *L, int nresults);
-LUA_API int  lua_resume (lua_State *L, lua_State *co);
+LUA_API int  lua_resume (lua_State *L, int narg);
 
 /*
 ** Garbage-collection functions

lvm.c

@@ -1,5 +1,5 @@
 /*
-** $Id: lvm.c,v 1.257 2002/10/08 18:46:08 roberto Exp roberto $
+** $Id: lvm.c,v 1.258 2002/10/25 20:05:28 roberto Exp roberto $
 ** Lua virtual machine
 ** See Copyright Notice in lua.h
 */
@@ -592,6 +592,7 @@ StkId luaV_execute (lua_State *L) {
           if (firstResult > L->top) {  /* yield? */
             (L->ci - 1)->u.l.savedpc = pc;
             (L->ci - 1)->state = CI_SAVEDPC;
+            L->ci->state |= CI_YIELD;
             return NULL;
           }
           /* it was a C function (`precall' called it); adjust results */