diff -urN lua/include/lua.h lua-4.0-yield/include/lua.h --- lua/include/lua.h Tue Oct 31 07:44:07 2000 +++ lua-4.0-yield/include/lua.h Fri Dec 28 10:13:27 2001 @@ -49,7 +49,8 @@ #define LUA_MINSTACK 20 -/* error codes for lua_do* */ +/* return codes for lua_do* */ +#define LUA_YIELD -1 #define LUA_ERRRUN 1 #define LUA_ERRFILE 2 #define LUA_ERRSYNTAX 3 @@ -159,6 +160,8 @@ LUA_API int lua_dofile (lua_State *L, const char *filename); LUA_API int lua_dostring (lua_State *L, const char *str); LUA_API int lua_dobuffer (lua_State *L, const char *buff, size_t size, const char *name); +LUA_API int lua_yield (lua_State *L); +LUA_API int lua_resume (lua_State *L); /* ** Garbage-collection functions diff -urN lua/src/ldo.c lua-4.0-yield/src/ldo.c --- lua/src/ldo.c Mon Oct 30 07:38:50 2000 +++ lua-4.0-yield/src/ldo.c Wed Jan 16 17:50:48 2002 @@ -154,10 +154,89 @@ ** The number of results is nResults, unless nResults=LUA_MULTRET. */ void luaD_call (lua_State *L, StkId func, int nResults) { - lua_Hook callhook; - StkId firstResult; - CallInfo ci; + L->callcount++; /* yield patch: recursion protection for yield() */ + if (luaD_prolog(L, func, nResults) == 0) { + L->callinfostack->mustreturn = 1; /* yield patch: tell VM this frame must return */ + luaV_execute(L); + } + L->callcount--; +} + +/* +** yield patch: Push a fresh CallInfo structure onto L->callinfostack. +*/ +static void pushcallinfo (lua_State* L) +{ + CallInfo* ci = L->callinfofreelist; + if (ci == NULL) { + /* allocate a new CallInfo struct. */ + ci = luaM_malloc(L, sizeof(CallInfo)); + } else { + L->callinfofreelist = ci->prev; + } + ci->prev = L->callinfostack; + L->callinfostack = ci; +} + +/* +** yield patch: Pop the top CallInfo struct off L->callinfostack. +*/ +static void popcallinfo (lua_State* L) +{ + CallInfo* ci = L->callinfostack; + LUA_ASSERT(ci, "popcallinfo(): callinfo stack is empty"); + if (ci) { + L->callinfostack = ci->prev; + + /* add the popped struct to the callinfofreelist, so it can be reused easily. */ + ci->prev = L->callinfofreelist; + L->callinfofreelist = ci; + } +} + + +static void luaV_pack (lua_State *L, StkId firstelem) { + int i; + Hash *htab = luaH_new(L, 0); + for (i=0; firstelem+itop; i++) + *luaH_setint(L, htab, i+1) = *(firstelem+i); + /* store counter in field `n' */ + luaH_setstrnum(L, htab, luaS_new(L, "n"), i); + L->top = firstelem; /* remove elements from the stack */ + ttype(L->top) = LUA_TTABLE; + hvalue(L->top) = htab; + incr_top; +} + + +static void adjust_varargs (lua_State *L, StkId base, int nfixargs) { + int nvararg = (L->top-base) - nfixargs; + if (nvararg < 0) + luaD_adjusttop(L, base, nfixargs); + luaV_pack(L, base+nfixargs); +} + + +/* +** yield patch: Function-call prolog. Function is at func, args are +** between (func,top). Initialize the given CallInfo structure, to +** use for activating luaV_execute(). +** +** Returns 1 if we handled the call directly in this function -- +** happens when the function turns out to be a C function. Caller +** _should not_ follow this with luaV_execute(). Returns 0 if +** luaV_execute should be called. +*/ +int luaD_prolog (lua_State *L, StkId func, int nResults) { + CallInfo* ci; Closure *cl; + + pushcallinfo(L); + ci = L->callinfostack; + ci->funcid = func; + ci->nResults = nResults; + ci->mustreturn = 0; + if (ttype(func) != LUA_TFUNCTION) { /* `func' is not a function; check the `function' tag method */ Closure *tm = luaT_gettmbyObj(L, func, TM_FUNCTION); @@ -168,33 +247,72 @@ ttype(func) = LUA_TFUNCTION; } cl = clvalue(func); - ci.func = cl; - infovalue(func) = &ci; + ci->func = cl; + infovalue(func) = ci; ttype(func) = LUA_TMARK; - callhook = L->callhook; - if (callhook) - luaD_callHook(L, func, callhook, "call"); - firstResult = (cl->isC ? callCclosure(L, cl, func+1) : - luaV_execute(L, cl, func+1)); - if (callhook) /* same hook that was active at entry */ - luaD_callHook(L, func, callhook, "return"); - LUA_ASSERT(ttype(func) == LUA_TMARK, "invalid tag"); - /* move results to `func' (to erase parameters and function) */ - if (nResults == LUA_MULTRET) { - while (firstResult < L->top) /* copy all results */ - *func++ = *firstResult++; - L->top = func; + ci->callhook = L->callhook; + if (ci->callhook) + luaD_callHook(L, func, ci->callhook, "call"); + + if (ci->func->isC) { + /* go ahead and call the C function. Could cause recursion into the VM. */ + ci->savedpc = NULL; + ci->firstResult = callCclosure(L, ci->func, func+1); + luaD_epilog(L); + return 1; + } + else { + /* Lua function. Set up the callinfo, for entering the VM. */ + + /* yield patch: from the start of luaV_execute */ + const Proto *const tf = ci->func->f.l; + ci->linehook = L->linehook; + ci->savedpc = tf->code; + ci->pc = &ci->savedpc; + ci->base = func+1; + luaD_checkstack(L, tf->maxstacksize+EXTRA_STACK); + if (tf->is_vararg) /* varargs? */ + adjust_varargs(L, ci->base, tf->numparams); + else + luaD_adjusttop(L, ci->base, tf->numparams); + /* now we're ready to call luaV_execute */ + return 0; + } +} + + +/* +** yield patch: cleanup and return from a function call. Do callhook, and +** copy function results to the proper place on the stack. Pop +** the callinfostack. +*/ +void luaD_epilog (lua_State *L) { + CallInfo* ci = L->callinfostack; + LUA_ASSERT(ci, "no valid CallInfo for luaD_epilog"); + if (ci->callhook) /* same hook that was active at entry */ + luaD_callHook(L, ci->funcid, ci->callhook, "return"); + LUA_ASSERT(ttype(ci->funcid) == LUA_TMARK, "invalid tag"); + + /* move results to `funcid' (to erase parameters and function) */ + if (ci->nResults == LUA_MULTRET) { + StkId func = ci->funcid; + while (ci->firstResult < L->top) /* copy all results */ + *func++ = *(ci->firstResult)++; + L->top = func; } else { /* copy at most `nResults' */ - for (; nResults> 0 && firstResult < L->top; nResults--) - *func++ = *firstResult++; + StkId func = ci->funcid; + for (; ci->nResults> 0 && ci->firstResult < L->top; ci->nResults--) + *func++ = *ci->firstResult++; L->top = func; - for (; nResults> 0; nResults--) { /* if there are not enough results */ + for (; ci->nResults> 0; ci->nResults--) { /* if there are not enough results */ ttype(L->top) = LUA_TNIL; /* adjust the stack */ incr_top; /* must check stack space */ } } luaC_checkGC(L); + + popcallinfo(L); /* L->callinfostack = L->callinfostack->prev; and also save the old callinfo on the callinfofreelist */ } @@ -216,10 +334,17 @@ StkId func = L->top - (nargs+1); /* function to be called */ struct CallS c; int status; + /* yield patch: remove stale callinfo, since the caller didn't call lua_resume() on this lua_State */ + /* if (L->callcount == 0) { */ + while (L->callinfostack) + popcallinfo(L); +/* } */ c.func = func; c.nresults = nresults; status = luaD_runprotected(L, f_call, &c); - if (status != 0) /* an error occurred? */ + if (status != 0 && status != LUA_YIELD) { /* an error occurred? */ /* yield patch: change to accommodate LUA_YIELD, was (status != 0) */ L->top = func; /* remove parameters from the stack */ + } + return status; } @@ -314,6 +439,23 @@ } +/* yield patch */ +static void f_resume (lua_State* L, void* dummy) { + if (L->callinfostack == NULL) + lua_error(L, "invalid lua_resume()"); /* L was not exited via "yield()" */ + L->callcount = 1; /* simulate the initial call to luaD_call that happens with lua_do* */ + luaV_execute(L); + LUA_ASSERT(L->callcount == 1, "invalid callcount in f_resume"); + L->callcount = 0; +} + + +LUA_API int lua_resume (lua_State *L) { + int status = luaD_runprotected(L, f_resume, NULL); + return status; +} + + /* ** {====================================================== ** Error-recover functions (based on long jumps) @@ -362,16 +504,44 @@ int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) { + CallInfo* baseci = L->callinfostack; /* yield patch */ + int oldcallcount = L->callcount; /* yield patch */ StkId oldCbase = L->Cbase; StkId oldtop = L->top; struct lua_longjmp lj; int allowhooks = L->allowhooks; + /* yield patch */ + if (L->callinfostack) { + /* Resuming; use stashed values for allowhooks, oldCbase, oldtop. */ + LUA_ASSERT(L->yield_oldCbase, "yield patch: problem in luaD_runprotected."); + LUA_ASSERT(L->yield_oldtop, "yield patch: problem in luaD_runprotected."); + oldCbase = L->yield_oldCbase; + oldtop = L->yield_oldtop; + allowhooks = L->yield_allowhooks; + } lj.status = 0; lj.previous = L->errorJmp; /* chain new error handler */ L->errorJmp = &lj; if (setjmp(lj.b) == 0) (*f)(L, ud); - else { /* an error occurred: restore the state */ + else if (lj.status == LUA_YIELD) { + /* yield patch: Script yielded. */ + LUA_ASSERT(L->callinfostack, "yield patch: runprotected exited with LUA_YIELD, but callinfostack is 0!"); + /* Save the allowhooks, oldCbase, and oldtop values, for restoration + by a future exit from lua_resume(). */ + L->yield_oldCbase = oldCbase; + L->yield_oldtop = oldtop; + L->yield_allowhooks = allowhooks; + } + else if (lj.status != LUA_YIELD) { /* an error occurred: restore the state */ /* yield patch: don't cleanup if we're about to yield! */ + while (L->callinfostack && L->callinfostack != baseci) /* yield patch: unwind the callinfo stack, to the point where we started */ + popcallinfo(L); + L->callcount = oldcallcount; /* yield patch */ + /* yield patch: What if this fn was called from lua_resume? + These restores will be wrong. + + TODO: restore to the values of the original run_protected, that + was yielded out of. */ L->allowhooks = allowhooks; L->Cbase = oldCbase; L->top = oldtop; @@ -383,3 +553,22 @@ /* }====================================================== */ +LUA_API int lua_yield (lua_State *L) { + if (L->callcount == 1) { /* one original call to luaD_call, which we will unwind via longjmp(). */ + L->callcount = 0; + + /* unwind L's stack to remove this invocation of lua_yield */ + L->top = L->Cbase - 1; + L->Cbase = L->stack; + popcallinfo(L); + + /* non-local exit, to original C caller */ + luaD_breakrun(L, LUA_YIELD); + } + else { + /* can't unwind through C functions. */ + /* Print warning message, and don't yield. */ + message(L, "lua_yield: Can't yield from inside recursive call to luaD_call!"); + } + return 0; +} diff -urN lua/src/ldo.h lua-4.0-yield/src/ldo.h --- lua/src/ldo.h Fri Oct 6 08:45:25 2000 +++ lua-4.0-yield/src/ldo.h Fri Dec 28 10:16:00 2001 @@ -26,8 +26,11 @@ void luaD_callTM (lua_State *L, Closure *f, int nParams, int nResults); void luaD_checkstack (lua_State *L, int n); +/* yield patch */ +int luaD_prolog (lua_State *L, StkId func, int nResults); +void luaD_epilog (lua_State *L); + void luaD_breakrun (lua_State *L, int errcode); int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud); - #endif diff -urN lua/src/lib/lbaselib.c lua-4.0-yield/src/lib/lbaselib.c --- lua/src/lib/lbaselib.c Mon Nov 6 08:45:18 2000 +++ lua-4.0-yield/src/lib/lbaselib.c Fri Dec 28 10:15:49 2001 @@ -535,6 +535,12 @@ return 0; } +/* yield patch */ +static int luaB_yield (lua_State *L) { + return lua_yield(L); +} + + /* }====================================================== */ @@ -637,7 +643,8 @@ {"getn", luaB_getn}, {"sort", luaB_sort}, {"tinsert", luaB_tinsert}, - {"tremove", luaB_tremove} + {"tremove", luaB_tremove}, + {"yield", luaB_yield} }; diff -urN lua/src/lobject.h lua-4.0-yield/src/lobject.h --- lua/src/lobject.h Mon Oct 30 12:49:19 2000 +++ lua-4.0-yield/src/lobject.h Fri Dec 28 10:19:49 2001 @@ -172,16 +172,7 @@ #define ismarked(x) ((x)->mark != (x)) -/* -** informations about a call (for debugging) -*/ -typedef struct CallInfo { - struct Closure *func; /* function being called */ - const Instruction **pc; /* current pc of called function */ - int lastpc; /* last pc traced */ - int line; /* current line */ - int refi; /* current index in `lineinfo' */ -} CallInfo; +/* yield patch: moved CallInfo definition to lstate.h */ extern const TObject luaO_nilobject; diff -urN lua/src/lstate.c lua-4.0-yield/src/lstate.c --- lua/src/lstate.c Mon Oct 30 11:29:59 2000 +++ lua-4.0-yield/src/lstate.c Wed Jan 16 17:48:08 2002 @@ -86,6 +86,12 @@ L->callhook = NULL; L->linehook = NULL; L->allowhooks = 1; + L->callinfostack = NULL; /* yield patch */ + L->callcount = 0; /* yield patch */ + L->yield_oldCbase = NULL; + L->yield_oldtop = NULL; + L->yield_allowhooks = 1; + L->callinfofreelist = NULL; /* yield patch */ L->errorJmp = NULL; if (luaD_runprotected(L, f_luaopen, &stacksize) != 0) { /* memory allocation error: free partial state */ diff -urN lua/src/lstate.h lua-4.0-yield/src/lstate.h --- lua/src/lstate.h Thu Oct 5 09:00:17 2000 +++ lua-4.0-yield/src/lstate.h Wed Jan 16 17:46:54 2002 @@ -43,6 +43,37 @@ +/* +** information about a call (for debugging) +** yield patch: added members to help unwind luaV_execute()'s recursion in OP_CALL/OP_TAILCALL. +*/ +typedef struct CallInfo { + struct Closure *func; /* function being called */ + const Instruction **pc; /* current pc of called function */ + int lastpc; /* last pc traced */ + int line; /* current line */ + int refi; /* current index in `lineinfo' */ + + /* yield patch */ + /* locals & args from luaV_execute -- must set these up before calling luaV_execute() */ + StkId base; + const Instruction* savedpc; + TString **const kstr; + lua_Hook linehook; + int mustreturn; /* flag that tells luaV_execute() when it must return */ + + /* locals & args from luaD_call */ + int nResults; /* passed from luaD_prolog() to luaD_epilog */ + StkId funcid; /* passed from luaD_prolog() to luaD_epilog */ + lua_Hook callhook; /* passed from luaD_prolog() to luaD_epilog */ + StkId firstResult; /* return value from luaV_execute to luaD_epilog */ + + /* link, to form a stack. */ + struct CallInfo* prev; + +} CallInfo; + + struct lua_State { /* thread-specific state */ StkId top; /* first free slot in the stack */ @@ -53,6 +84,11 @@ struct lua_longjmp *errorJmp; /* current error recover point */ char *Mbuffer; /* global buffer */ size_t Mbuffsize; /* size of Mbuffer */ + CallInfo* callinfostack; + int callcount; /* yield patch: recursion count for luaD_call(). Use this to prevent trying to unwind past more than one luaD_call() */ + StkId yield_oldCbase; /* yield patch: stash for luaD_runprotected. */ + StkId yield_oldtop; /* yield patch: stash for luaD_runprotected. */ + int yield_allowhooks; /* yield patch: stash for luaD_runprotected. */ /* global state */ Proto *rootproto; /* list of all prototypes */ Closure *rootcl; /* list of all closures */ @@ -70,6 +106,7 @@ lua_Hook callhook; lua_Hook linehook; int allowhooks; + CallInfo* callinfofreelist; /* yield patch: stash unused callinfo structs here, so we don't have to constantly alloc/dealloc. */ }; diff -urN lua/src/lua/lua.c lua-4.0-yield/src/lua/lua.c --- lua/src/lua/lua.c Fri Oct 20 12:36:32 2000 +++ lua-4.0-yield/src/lua/lua.c Fri Dec 28 10:21:27 2001 @@ -85,6 +85,11 @@ handler h = lreset(); int top = lua_gettop(L); res = f(L, name); /* dostring | dofile */ + /* yield patch: resume if the execution exited via yield() */ + while (res == LUA_YIELD) { + fprintf(stderr, "yielded, now resuming...\n"); + res = lua_resume(L); + } lua_settop(L, top); /* remove eventual results */ signal(SIGINT, h); /* restore old action */ /* Lua gives no message in such cases, so lua.c provides one */ diff -urN lua/src/lvm.c lua-4.0-yield/src/lvm.c --- lua/src/lvm.c Thu Oct 26 08:47:05 2000 +++ lua-4.0-yield/src/lvm.c Wed Jan 16 19:17:32 2002 @@ -319,74 +319,89 @@ } -static void luaV_pack (lua_State *L, StkId firstelem) { - int i; - Hash *htab = luaH_new(L, 0); - for (i=0; firstelem+itop; i++) - *luaH_setint(L, htab, i+1) = *(firstelem+i); - /* store counter in field `n' */ - luaH_setstrnum(L, htab, luaS_new(L, "n"), i); - L->top = firstelem; /* remove elements from the stack */ - ttype(L->top) = LUA_TTABLE; - hvalue(L->top) = htab; - incr_top; -} - - -static void adjust_varargs (lua_State *L, StkId base, int nfixargs) { - int nvararg = (L->top-base) - nfixargs; - if (nvararg < 0) - luaD_adjusttop(L, base, nfixargs); - luaV_pack(L, base+nfixargs); -} - - - #define dojump(pc, i) { int d = GETARG_S(i); pc += d; } +/* yield patch: many changes here */ /* ** Executes the given Lua function. Parameters are between [base,top). ** Returns n such that the the results are between [n,top). */ -StkId luaV_execute (lua_State *L, const Closure *cl, StkId base) { - const Proto *const tf = cl->f.l; +void luaV_execute (lua_State *L) /* yield patch: get args from, and pass return value to, L->callinfostack */ +{ + CallInfo* ci; + + const Proto * tf; StkId top; /* keep top local, for performance */ - const Instruction *pc = tf->code; - TString **const kstr = tf->kstr; - const lua_Hook linehook = L->linehook; - infovalue(base-1)->pc = &pc; - luaD_checkstack(L, tf->maxstacksize+EXTRA_STACK); - if (tf->is_vararg) /* varargs? */ - adjust_varargs(L, base, tf->numparams); - else - luaD_adjusttop(L, base, tf->numparams); + const Instruction *pc; + TString ** kstr; + StkId base; + + reinit: + ci = L->callinfostack; + tf = ci->func->f.l; + kstr = tf->kstr; + pc = ci->savedpc; + ci->pc = &pc; top = L->top; + base = ci->base; + /* main loop of interpreter */ for (;;) { const Instruction i = *pc++; - if (linehook) - traceexec(L, base, top, linehook); + if (ci->linehook) { + ci->savedpc = pc; /* yield patch: for the benefit of the debugger */ + traceexec(L, base, top, ci->linehook); + } switch (GET_OPCODE(i)) { case OP_END: { + int mustreturn = ci->mustreturn; L->top = top; - return top; + ci->savedpc = pc; + ci->firstResult = top; + luaD_epilog(L); + if (mustreturn) + return; + goto reinit; + break; } case OP_RETURN: { + int mustreturn = ci->mustreturn; L->top = top; - return base+GETARG_U(i); + ci->savedpc = pc; /* necessary? */ + ci->firstResult = base+GETARG_U(i); + luaD_epilog(L); + if (mustreturn) + return; + goto reinit; + break; } case OP_CALL: { int nres = GETARG_B(i); if (nres == MULT_RET) nres = LUA_MULTRET; + /* save locals */ L->top = top; - luaD_call(L, base+GETARG_A(i), nres); - top = L->top; + ci->savedpc = pc; + luaD_prolog(L, base+GETARG_A(i), nres); + goto reinit; break; } case OP_TAILCALL: { + /* + ** yield patch: OP_TAILCALL seemed confusing at first, but it's + ** actually not bad. It's equivalent to: + ** + ** unwind this activation, but don't actually return yet; + ** call next function; + */ + int nres = ci->nResults; L->top = top; - luaD_call(L, base+GETARG_A(i), LUA_MULTRET); - return base+GETARG_B(i); + ci->savedpc = pc; + ci->firstResult = base+GETARG_A(i); /* these "results" are actually the next function and its args */ + ci->nResults = LUA_MULTRET; /* copy all the args for the next function */ + luaD_epilog(L); /* unwind this function's activation, and set up for the next one */ + luaD_prolog(L, base-1, nres); /* call the next function */ + goto reinit; + break; } case OP_PUSHNIL: { int n = GETARG_U(i); @@ -425,7 +440,7 @@ break; } case OP_PUSHUPVALUE: { - *top++ = cl->upvalue[GETARG_U(i)]; + *top++ = ci->func->upvalue[GETARG_U(i)]; break; } case OP_GETLOCAL: { diff -urN lua/src/lvm.h lua-4.0-yield/src/lvm.h --- lua/src/lvm.h Thu Oct 5 08:14:08 2000 +++ lua-4.0-yield/src/lvm.h Sat Jan 5 23:19:51 2002 @@ -23,7 +23,7 @@ void luaV_settable (lua_State *L, StkId t, StkId key); const TObject *luaV_getglobal (lua_State *L, TString *s); void luaV_setglobal (lua_State *L, TString *s); -StkId luaV_execute (lua_State *L, const Closure *cl, StkId base); +void luaV_execute (lua_State *L); /* yield patch */ void luaV_Cclosure (lua_State *L, lua_CFunction c, int nelems); void luaV_Lclosure (lua_State *L, Proto *l, int nelems); int luaV_lessthan (lua_State *L, const TObject *l, const TObject *r, StkId top); diff -urN lua/test/yield.lua lua-4.0-yield/test/yield.lua --- lua/test/yield.lua Wed Dec 31 19:00:00 1969 +++ lua-4.0-yield/test/yield.lua Fri Dec 28 10:22:49 2001 @@ -0,0 +1,72 @@ +-- test the yield patch. The yield patch adds a yield() function, +-- which suspends script execution in a restartable state (via the API +-- function lua_resume(L)). The yield patch also implements true tail +-- recursion for the OP_TAILCALL opcode. + + +function donothing_tailrec(x) + return x +end + +function donothing_rec1(x) + return donothing_tailrec(x) +end + +function donothing_rec2(x) + for i = 1,1000 do + donothing_rec1(x) + end + return donothing_rec1(x) +end + +function donothing_rec3(x) + for i = 1,1000 do + donothing_rec2(x) + + -- exit script execution, returning LUA_YIELD to the caller. + -- The caller can resume the script via lua_resume(L). + yield() + end + return donothing_rec2(x) +end + +c = clock() +r = donothing_rec3(10) +t = clock() - c +print("time = " .. t .. ", result = " .. r); + + +count = 0 + +function increment_tailrec(ct) +-- stupid recursive function to increment 'count' + if ct <= 0 then + return 0 + else + count = count + 1 + return increment_tailrec(ct-1) -- for some reason, we must return a value for OP_TAILCALL to be generated. + end +end + + +function test(x) + count = 0 + increment_tailrec(x) + if count == x then + print("success --> count = " .. x); + else + print("failure --> count = " .. count .. " but x = " .. x); + end +end + + +-- The yield patch also implements proper tail recursion for the +-- OP_TAILCALL opcode. In unpatched Lua 4.0, one of the following +-- calls will probably cause a stack overflow error. +test(1) +test(10) +test(100) +test(1000) +test(10000) +test(100000) +test(1000000)

AltStyle によって変換されたページ (->オリジナル) /