/* ** Stack and Call structure of Lua ** See Copyright Notice in lua.h */ #define FORBIDDEN_SYMBOL_EXCEPTION_setjmp #define FORBIDDEN_SYMBOL_EXCEPTION_longjmp #define FORBIDDEN_SYMBOL_EXCEPTION_fprintf #define FORBIDDEN_SYMBOL_EXCEPTION_sprintf #define FORBIDDEN_SYMBOL_EXCEPTION_stderr #define FORBIDDEN_SYMBOL_EXCEPTION_exit #define FORBIDDEN_SYMBOL_EXCEPTION_strcpy #ifdef _MSC_VER #pragma warning(disable:4611) #endif #include "engines/grim/lua/ldo.h" #include "engines/grim/lua/lfunc.h" #include "engines/grim/lua/lgc.h" #include "engines/grim/lua/lmem.h" #include "engines/grim/lua/lobject.h" #include "engines/grim/lua/lopcodes.h" #include "engines/grim/lua/lparser.h" #include "engines/grim/lua/lstate.h" #include "engines/grim/lua/ltask.h" #include "engines/grim/lua/ltm.h" #include "engines/grim/lua/lua.h" #include "engines/grim/lua/luadebug.h" #include "engines/grim/lua/lundump.h" #include "engines/grim/lua/lvm.h" #include "engines/grim/lua/lzio.h" #include "common/file.h" #include "common/textconsole.h" namespace Grim { #ifndef STACK_LIMIT #define STACK_LIMIT 6000 #endif // Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... #define EXTRA_STACK 5 /* ** Error messages */ void stderrorim() { fprintf(stderr, "lua error: %s\n", lua_getstring(lua_getparam(1))); } #define STACK_UNIT 256 // Initial size for CallInfo array #define BASIC_CI_SIZE 8 void luaD_init() { ttype(&errorim) = LUA_T_CPROTO; fvalue(&errorim) = stderrorim; } void luaD_checkstack(int32 n) { struct Stack *S = &lua_state->stack; if (S->last-S->top <= n) { StkId top = S->top-S->stack; int32 stacksize = (S->last-S->stack) + 1 + STACK_UNIT + n; S->stack = luaM_reallocvector(S->stack, stacksize, TObject); S->last = S->stack + (stacksize - 1); S->top = S->stack + top; if (stacksize >= STACK_LIMIT) { // stack overflow? if (lua_stackedfunction(100) == LUA_NOOBJECT) // 100 funcs on stack? lua_error("Lua2C - C2Lua overflow"); // doesn't look like a rec. loop else lua_error("stack size overflow"); } } } /* ** Adjust stack. Set top to the given value, pushing NILs if needed. */ void luaD_adjusttop(StkId newtop) { int32 diff = newtop - (lua_state->stack.top - lua_state->stack.stack); if (diff <= 0) lua_state->stack.top += diff; else { luaD_checkstack(diff); while (diff--) ttype(lua_state->stack.top++) = LUA_T_NIL; } } /* ** Open a hole below "nelems" from the lua_state->stack.top. */ void luaD_openstack(int32 nelems) { luaO_memup(lua_state->stack.top - nelems + 1, lua_state->stack.top - nelems, nelems * sizeof(TObject)); incr_top; } void luaD_lineHook(int32 line) { struct C_Lua_Stack oldCLS = lua_state->Cstack; StkId old_top = lua_state->Cstack.lua2C = lua_state->Cstack.base = lua_state->stack.top-lua_state->stack.stack; lua_state->Cstack.num = 0; (*lua_linehook)(line); lua_state->stack.top = lua_state->stack.stack + old_top; lua_state->Cstack = oldCLS; } void luaD_callHook(StkId base, TProtoFunc *tf, int32 isreturn) { if (isreturn) (*lua_callhook)(LUA_NOOBJECT, "(return)", 0); else { TObject *f = lua_state->stack.stack + base - 1; if (tf) (*lua_callhook)(Ref(f), tf->fileName->str, tf->lineDefined); else (*lua_callhook)(Ref(f), "(C)", -1); } } /* ** Call a C function. ** Cstack.num is the number of arguments; Cstack.lua2C points to the ** first argument. Returns an index to the first result from C. */ static StkId callC(lua_CFunction f, StkId base) { struct C_Lua_Stack *CS = &lua_state->Cstack; struct C_Lua_Stack oldCLS = *CS; StkId firstResult; int32 numarg = (lua_state->stack.top - lua_state->stack.stack) - base; CS->num = numarg; CS->lua2C = base; CS->base = base + numarg; // == top - stack if (lua_callhook) luaD_callHook(base, nullptr, 0); lua_state->callLevelCounter++; (*f)(); // do the actual call lua_state->callLevelCounter--; if (lua_callhook) // func may have changed lua_callhook luaD_callHook(base, nullptr, 1); firstResult = CS->base; *CS = oldCLS; return firstResult; } static StkId callCclosure(struct Closure *cl, lua_CFunction f, StkId base) { TObject *pbase; int32 nup = cl->nelems; // number of upvalues luaD_checkstack(nup); pbase = lua_state->stack.stack + base; // care: previous call may change this // open space for upvalues as extra arguments luaO_memup(pbase+nup, pbase, (lua_state->stack.top - pbase) * sizeof(TObject)); // copy upvalues into stack memcpy(pbase, cl->consts + 1, nup * sizeof(TObject)); lua_state->stack.top += nup; return callC(f, base); } void luaD_callTM(TObject *f, int32 nParams, int32 nResults) { luaD_openstack(nParams); *(lua_state->stack.top - nParams - 1) = *f; lua_state->preventBreakCounter++; lua_state->callLevelCounter++; luaD_call((lua_state->stack.top - lua_state->stack.stack) - nParams, nResults); lua_state->callLevelCounter--; lua_state->preventBreakCounter--; } int32 luaD_call(StkId base, int32 nResults) { lua_Task *tmpTask = lua_state->task; if (!lua_state->task || lua_state->callLevelCounter) { lua_Task *t = luaM_new(lua_Task); lua_taskinit(t, lua_state->task, base, nResults); lua_state->task = t; } else { tmpTask = lua_state->prevTask; } while (1) { lua_CFunction function = nullptr; StkId firstResult = 0; TObject *funcObj = lua_state->stack.stack + base - 1; if (ttype(funcObj) == LUA_T_CLOSURE) { Closure *c = clvalue(funcObj); TObject *proto = &(c->consts[0]); ttype(funcObj) = LUA_T_CLMARK; if (ttype(proto) == LUA_T_CPROTO) { function = fvalue(funcObj); firstResult = callCclosure(c, fvalue(proto), base); } else { lua_taskresume(lua_state->task, c, tfvalue(proto), base); firstResult = luaV_execute(lua_state->task); } } else if (ttype(funcObj) == LUA_T_PMARK) { if (!lua_state->task->executed) { TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION); if (ttype(im) == LUA_T_NIL) lua_error("call expression not a function"); luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults); continue; } firstResult = luaV_execute(lua_state->task); } else if (ttype(funcObj) == LUA_T_CMARK) { if (!lua_state->task->executed) { TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION); if (ttype(im) == LUA_T_NIL) lua_error("call expression not a function"); luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults); continue; } } else if (ttype(funcObj) == LUA_T_CLMARK) { Closure *c = clvalue(funcObj); TObject *proto = &(c->consts[0]); if (!lua_state->task->executed) { TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION); if (ttype(im) == LUA_T_NIL) lua_error("call expression not a function"); luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults); continue; } if (ttype(proto) != LUA_T_CPROTO) firstResult = luaV_execute(lua_state->task); } else if (ttype(funcObj) == LUA_T_PROTO) { ttype(funcObj) = LUA_T_PMARK; lua_taskresume(lua_state->task, nullptr, tfvalue(funcObj), base); firstResult = luaV_execute(lua_state->task); } else if (ttype(funcObj) == LUA_T_CPROTO) { ttype(funcObj) = LUA_T_CMARK; function = fvalue(funcObj); firstResult = callC(fvalue(funcObj), base); } else { TObject *im = luaT_getimbyObj(funcObj, IM_FUNCTION); if (ttype(im) == LUA_T_NIL) lua_error("call expression not a function"); luaD_callTM(im, (lua_state->stack.top - lua_state->stack.stack) - (base - 1), nResults); continue; } if (firstResult <= 0) { nResults = lua_state->task->aux; base = -firstResult; lua_Task *t = luaM_new(lua_Task); lua_taskinit(t, lua_state->task, base, nResults); lua_state->task = t; } else { nResults = lua_state->task->initResults; base = lua_state->task->initBase; if (nResults != MULT_RET) luaD_adjusttop(firstResult + nResults); base--; nResults = lua_state->stack.top - (lua_state->stack.stack + firstResult); for (int32 i = 0; i < nResults; i++) *(lua_state->stack.stack + base + i) = *(lua_state->stack.stack + firstResult + i); lua_state->stack.top -= firstResult - base; lua_Task *tmp = lua_state->task; lua_state->task = lua_state->task->next; luaM_free(tmp); if (lua_state->task) { nResults = lua_state->task->initResults; base = lua_state->task->initBase; } if (function == break_here || function == sleep_for) { if (!lua_state->preventBreakCounter) { lua_state->prevTask = tmpTask; return 1; } } } if (lua_state->task == tmpTask) break; } return 0; } static void travstack(struct Stack *S, int32 (*fn)(TObject *)) { for (StkId i = (S->top - 1) - S->stack; i >= 0; i--) fn(S->stack + i); } /* ** Traverse all objects on lua_state->stack.stack, and all other active stacks */ void luaD_travstack(int32(*fn)(TObject *)) { for (LState *t = lua_rootState; t != nullptr; t = t->next) { travstack(&t->stack, fn); } } static void message(const char *s) { TObject im = errorim; if (ttype(&im) != LUA_T_NIL) { lua_pushstring(s); luaD_callTM(&im, 1, 0); } } /* ** Reports an error, and jumps up to the available recover label */ void lua_error(const char *s) { if (s) message(s); if (lua_state->errorJmp) { longjmp(*((jmp_buf *)lua_state->errorJmp), 1); } else { fprintf(stderr, "lua: exit(1). Unable to recover\n"); } exit(1); // exit in both cases, to help compilers with noreturn/longjmp } /* ** Call the function at lua_state->Cstack.base, and incorporate results on ** the Lua2C structure. */ static void do_callinc(int32 nResults) { StkId base = lua_state->Cstack.base; luaD_call(base + 1, nResults); lua_state->Cstack.lua2C = base; // position of the luaM_new results lua_state->Cstack.num = (lua_state->stack.top - lua_state->stack.stack) - base; // number of results lua_state->Cstack.base = base + lua_state->Cstack.num; // incorporate results on lua_state->stack.stack/ } /* ** Execute a protected call. Assumes that function is at lua_state->Cstack.base and ** parameters are on top of it. Leave nResults on the stack. */ int32 luaD_protectedrun(int32 nResults) { jmp_buf myErrorJmp; int32 status; struct C_Lua_Stack oldCLS = lua_state->Cstack; jmp_buf *oldErr = lua_state->errorJmp; lua_state->errorJmp = &myErrorJmp; lua_state->preventBreakCounter++; lua_Task *tmpTask = lua_state->task; if (setjmp(myErrorJmp) == 0) { do_callinc(nResults); status = 0; } else { // an error occurred: restore lua_state->Cstack and lua_state->stack.top lua_state->Cstack = oldCLS; lua_state->stack.top = lua_state->stack.stack + lua_state->Cstack.base; while (tmpTask != lua_state->task) { lua_Task *t = lua_state->task; lua_state->task = lua_state->task->next; luaM_free(t); } status = 1; } lua_state->preventBreakCounter--; lua_state->errorJmp = oldErr; return status; } /* ** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load */ static int32 protectedparser(ZIO *z, int32 bin) { int32 status; TProtoFunc *tf; jmp_buf myErrorJmp; jmp_buf *oldErr = lua_state->errorJmp; lua_state->errorJmp = &myErrorJmp; if (setjmp(myErrorJmp) == 0) { tf = bin ? luaU_undump1(z) : luaY_parser(z); status = 0; } else { tf = nullptr; status = 1; } lua_state->errorJmp = oldErr; if (status) return 1; // error code if (tf == nullptr) return 2; // 'natural' end luaD_adjusttop(lua_state->Cstack.base + 1); // one slot for the pseudo-function lua_state->stack.stack[lua_state->Cstack.base].ttype = LUA_T_PROTO; lua_state->stack.stack[lua_state->Cstack.base].value.tf = tf; luaV_closure(0); return 0; } static int32 do_main(ZIO *z, int32 bin) { int32 status; do { int32 old_blocks = (luaC_checkGC(), nblocks); status = protectedparser(z, bin); if (status == 1) return 1; // error else if (status == 2) return 0; // 'natural' end else { int32 newelems2 = 2 * (nblocks - old_blocks); GCthreshold += newelems2; status = luaD_protectedrun(MULT_RET); GCthreshold -= newelems2; } } while (bin && status == 0); return status; } void luaD_gcIM(TObject *o) { TObject *im = luaT_getimbyObj(o, IM_GC); if (ttype(im) != LUA_T_NIL) { *lua_state->stack.top = *o; incr_top; luaD_callTM(im, 1, 0); } } #define SIZE_PREF 20 // size of string prefix to appear in error messages #define SSIZE_PREF "20" static void build_name (const char *str, char *name, int size) { if (str == nullptr || *str == ID_CHUNK) strcpy(name, "(buffer)"); else { char *temp; snprintf(name, size, "(dostring) >> \"%." SSIZE_PREF "s\"", str); temp = strchr(name, '\n'); if (temp) { // end string after first line *temp = '"'; *(temp + 1) = 0; } } } int32 lua_dostring(const char *str) { return lua_dobuffer(str, strlen(str), nullptr); } int32 lua_dobuffer(const char *buff, int32 size, const char *name) { char newname[SIZE_PREF + 25]; ZIO z; if (!name) { build_name(buff, newname, SIZE_PREF + 25); name = newname; } luaZ_mopen(&z, buff, size, name); int32 status = do_main(&z, buff[0] == ID_CHUNK); return status; } } // end of namespace Grim