diff -urN lua/include/lua.h lua_sleep/include/lua.h --- lua/include/lua.h Tue Oct 31 21:44:07 2000 +++ lua_sleep/include/lua.h Fri Dec 14 14:59:21 2001 @@ -49,7 +49,8 @@ #define LUA_MINSTACK 20 -/* error codes for lua_do* */ +/* return codes for lua_do* */ +#define LUA_SLEEP -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_sleep (lua_State *L); +LUA_API int lua_resume (lua_State *L); /* ** Garbage-collection functions diff -urN lua/src/ldo.c lua_sleep/src/ldo.c --- lua/src/ldo.c Mon Oct 30 21:38:50 2000 +++ lua_sleep/src/ldo.c Fri Dec 14 14:59:21 2001 @@ -154,10 +154,87 @@ ** 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++; /* tulrich: recursion protection for sleep() */ + if (luaD_prolog(L, func, nResults) == 0) { + luaV_execute(L); + } + L->callcount--; +} + +/* +** tulrich: 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; +} + +/* +** tulrich: 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); +} + + +/* +** tulrich: 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; + 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 +245,71 @@ 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->firstResult = callCclosure(L, ci->func, func+1); + luaD_epilog(L); + return 1; + } + else { + /* Lua function. Set up the callinfo, for entering the VM. */ + + /* tulrich: from the start of luaV_execute */ + const Proto *const tf = ci->func->f.l; + ci->linehook = L->linehook; + ci->currentpc = tf->code; + ci->pc = &ci->currentpc; + 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; + } +} + + +/* +** tulrich: 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 +331,17 @@ StkId func = L->top - (nargs+1); /* function to be called */ struct CallS c; int status; + /* tulrich: 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_SLEEP) { /* an error occurred? */ /* tulrich change to accommodate LUA_SLEEP, was (status != 0) */ L->top = func; /* remove parameters from the stack */ + } + return status; } @@ -314,6 +436,21 @@ } +/* tulrich */ +static void f_resume (lua_State* L, void* dummy) { + if (L->callinfostack == NULL) + lua_error(L, "invalid lua_resume()"); /* L was not exited via "sleep()" */ + L->callcount = 1; /* simulate the initial call to luaD_call that happens with lua_do* */ + luaV_execute(L); +} + + +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,6 +499,8 @@ int luaD_runprotected (lua_State *L, void (*f)(lua_State *, void *), void *ud) { + CallInfo* baseci = L->callinfostack; /* tulrich */ + int oldcallcount = L->callcount; /* tulrich */ StkId oldCbase = L->Cbase; StkId oldtop = L->top; struct lua_longjmp lj; @@ -371,7 +510,10 @@ L->errorJmp = &lj; if (setjmp(lj.b) == 0) (*f)(L, ud); - else { /* an error occurred: restore the state */ + else if (lj.status != LUA_SLEEP) { /* an error occurred: restore the state */ /* tulrich: don't cleanup if we're about to sleep! */ + while (L->callinfostack != baseci) /* tulrich: unwind the callinfo stack, to the point where we started */ + popcallinfo(L); + L->callcount = oldcallcount; /* tulrich */ L->allowhooks = allowhooks; L->Cbase = oldCbase; L->top = oldtop; @@ -382,4 +524,49 @@ } /* }====================================================== */ + +LUA_API int lua_sleep (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_sleep */ + L->top = L->Cbase - 1; + L->Cbase = L->stack; + popcallinfo(L); + + /* non-local exit, to original C caller */ + luaD_breakrun(L, LUA_SLEEP); + } + else { + /* can't unwind through C functions. */ + /* Print warning message, and don't sleep. */ + message(L, "lua_sleep: Can't sleep from inside recursive call to luaD_call!"); + } + return 0; +} + + + +#if 0 +/* tulrich: for debugging */ +/* show some info about the VM state. */ +void dumpdebug (lua_State *L, const char* label) +{ + StkId id; + int i; + CallInfo* ci = L->callinfostack; + printf("%s nres=%2d", label, ci->nResults); + id = L->stack; + for (i = 0; i < 5 && id < L->top; i++) { + if (id == ci->base) { + printf(" _"); + } else { + printf(" "); + } + printf("%2d", ttype(id)); + id++; + } + printf("\n"); +} +#endif diff -urN lua/src/ldo.h lua_sleep/src/ldo.h --- lua/src/ldo.h Fri Oct 6 21:45:25 2000 +++ lua_sleep/src/ldo.h Fri Dec 14 14:59:21 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); +/* tulrich */ +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_sleep/src/lib/lbaselib.c --- lua/src/lib/lbaselib.c Mon Nov 6 22:45:18 2000 +++ lua_sleep/src/lib/lbaselib.c Fri Dec 14 14:59:21 2001 @@ -535,6 +535,12 @@ return 0; } +/* tulrich */ +static int luaB_sleep (lua_State *L) { + return lua_sleep(L); +} + + /* }====================================================== */ @@ -637,7 +643,8 @@ {"getn", luaB_getn}, {"sort", luaB_sort}, {"tinsert", luaB_tinsert}, - {"tremove", luaB_tremove} + {"tremove", luaB_tremove}, + {"sleep", luaB_sleep} }; diff -urN lua/src/lobject.h lua_sleep/src/lobject.h --- lua/src/lobject.h Tue Oct 31 02:49:19 2000 +++ lua_sleep/src/lobject.h Fri Dec 14 14:59:21 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; +/* tulrich: moved CallInfo definition to lstate.h */ extern const TObject luaO_nilobject; diff -urN lua/src/lstate.c lua_sleep/src/lstate.c --- lua/src/lstate.c Tue Oct 31 01:29:59 2000 +++ lua_sleep/src/lstate.c Fri Dec 14 14:59:21 2001 @@ -86,6 +86,9 @@ L->callhook = NULL; L->linehook = NULL; L->allowhooks = 1; + L->callinfostack = NULL; /* tulrich */ + L->callcount = 0; /* tulrich */ + L->callinfofreelist = NULL; /* tulrich */ L->errorJmp = NULL; if (luaD_runprotected(L, f_luaopen, &stacksize) != 0) { /* memory allocation error: free partial state */ diff -urN lua/src/lstate.h lua_sleep/src/lstate.h --- lua/src/lstate.h Thu Oct 5 22:00:17 2000 +++ lua_sleep/src/lstate.h Fri Dec 14 14:59:21 2001 @@ -43,6 +43,36 @@ +/* +** information about a call (for debugging) +** tulrich: 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' */ + + /* tulrich */ + /* locals & args from luaV_execute -- must set these up before calling luaV_execute() */ + StkId base; + const Instruction* currentpc; + TString **const kstr; + lua_Hook linehook; + + /* 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 +83,8 @@ struct lua_longjmp *errorJmp; /* current error recover point */ char *Mbuffer; /* global buffer */ size_t Mbuffsize; /* size of Mbuffer */ + CallInfo* callinfostack; + int callcount; /* tulrich: recursion count for luaD_call(). Use this to prevent trying to unwind past more than one luaD_call() */ /* global state */ Proto *rootproto; /* list of all prototypes */ Closure *rootcl; /* list of all closures */ @@ -70,6 +102,7 @@ lua_Hook callhook; lua_Hook linehook; int allowhooks; + CallInfo* callinfofreelist; /* tulrich: stash unused callinfo structs here, so we don't have to constantly alloc/dealloc. */ }; diff -urN lua/src/lua/lua.c lua_sleep/src/lua/lua.c --- lua/src/lua/lua.c Sat Oct 21 01:36:32 2000 +++ lua_sleep/src/lua/lua.c Fri Dec 14 14:59:21 2001 @@ -85,6 +85,11 @@ handler h = lreset(); int top = lua_gettop(L); res = f(L, name); /* dostring | dofile */ + /* tulrich: resume if the execution exited via sleep */ + while (res == LUA_SLEEP) { + fprintf(stderr, "slept, 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_sleep/src/lvm.c --- lua/src/lvm.c Thu Oct 26 21:47:05 2000 +++ lua_sleep/src/lvm.c Fri Dec 14 14:59:21 2001 @@ -319,74 +319,94 @@ } -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); -} - +/* +** tulrich: this code is repeated a few times in luaV_execute(). It +** can't be turned into a function because it operates on local +** variables. It _can_ be implemented with a goto, but that's +** possibly bad for the C optimizer, and probably more confusing to +** read. +*/ +#define RESTORE_LOCALS \ + ci = L->callinfostack; \ + if (ci == NULL || ci->func->isC) \ + return; \ + tf = ci->func->f.l; \ + kstr = tf->kstr; \ + pc = ci->currentpc; \ + top = L->top; \ + base = ci->base; #define dojump(pc, i) { int d = GETARG_S(i); pc += d; } +/* tulrich: 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) /* tulrich: 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); - top = L->top; + const Instruction *pc; + TString ** kstr; + StkId base; + + RESTORE_LOCALS; + /* main loop of interpreter */ for (;;) { const Instruction i = *pc++; - if (linehook) - traceexec(L, base, top, linehook); + if (ci->linehook) { + ci->currentpc = pc; /* tulrich: for the benefit of the debugger */ + traceexec(L, base, top, ci->linehook); + } switch (GET_OPCODE(i)) { case OP_END: { L->top = top; - return top; + ci->currentpc = pc; + ci->firstResult = top; + luaD_epilog(L); + RESTORE_LOCALS; + break; } case OP_RETURN: { L->top = top; - return base+GETARG_U(i); + ci->currentpc = pc; + ci->firstResult = base+GETARG_U(i); + luaD_epilog(L); + RESTORE_LOCALS; + 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->currentpc = pc; + luaD_prolog(L, base+GETARG_A(i), nres); + RESTORE_LOCALS; break; } case OP_TAILCALL: { + /* + ** tulrich: 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->currentpc = 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 */ + RESTORE_LOCALS; + break; } case OP_PUSHNIL: { int n = GETARG_U(i); @@ -425,7 +445,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_sleep/src/lvm.h --- lua/src/lvm.h Thu Oct 5 21:14:08 2000 +++ lua_sleep/src/lvm.h Fri Dec 14 14:59:21 2001 @@ -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); /* tulrich */ 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/sleep.lua lua_sleep/test/sleep.lua --- lua/test/sleep.lua Thu Jan 1 09:00:00 1970 +++ lua_sleep/test/sleep.lua Fri Dec 14 14:59:21 2001 @@ -0,0 +1,72 @@ +-- test the sleep patch. The sleep patch adds a sleep() function, +-- which suspends script execution in a restartable state (via the API +-- function lua_resume(L)). The sleep 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_SLEEP to the caller. + -- The caller can resume the script via lua_resume(L). + sleep() + 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 sleep 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 によって変換されたページ (->オリジナル) /