diff --git a/ldo.c b/ldo.c new file mode 100644 index 00000000..b272b819 --- /dev/null +++ b/ldo.c @@ -0,0 +1,415 @@ +/* +** $Id: $ +** Stack and Call structure of Lua +** See Copyright Notice in lua.h +*/ + + +#include +#include +#include + +#include "ldo.h" +#include "lgc.h" +#include "lmem.h" +#include "lobject.h" +#include "lparser.h" +#include "ltm.h" +#include "lua.h" +#include "luadebug.h" +#include "lundump.h" +#include "lvm.h" +#include "lzio.h" + + + +#ifndef STACK_LIMIT +#define STACK_LIMIT 6000 +#endif + + +static TObject initial_stack; + +struct Stack luaD_stack = {&initial_stack+1, &initial_stack, &initial_stack}; + + +struct C_Lua_Stack luaD_Cstack = {0, 0, 0}; + +static jmp_buf *errorJmp = NULL; /* current error recover point */ + + + + + +#define STACK_EXTRA 32 + +static void initstack (int n) +{ + int maxstack = STACK_EXTRA+n; + luaD_stack.stack = luaM_newvector(maxstack, TObject); + luaD_stack.last = luaD_stack.stack+(maxstack-1); + luaD_stack.top = luaD_stack.stack; + *(luaD_stack.top++) = initial_stack; +} + + +void luaD_checkstack (int n) +{ + if (luaD_stack.stack == &initial_stack) + initstack(n); + else if (luaD_stack.last-luaD_stack.top <= n) { + static int limit = STACK_LIMIT; + StkId top = luaD_stack.top-luaD_stack.stack; + int stacksize = (luaD_stack.last-luaD_stack.stack)+1+STACK_EXTRA+n; + luaD_stack.stack = luaM_reallocvector(luaD_stack.stack, stacksize,TObject); + luaD_stack.last = luaD_stack.stack+(stacksize-1); + luaD_stack.top = luaD_stack.stack + top; + if (stacksize >= limit) { + limit = stacksize+STACK_EXTRA; /* extra space to run error handler */ + if (lua_stackedfunction(100) == LUA_NOOBJECT) { + /* less than 100 functions on the stack: cannot be recursive loop */ + lua_error("Lua2C - C2Lua overflow"); + } + else + lua_error(stackEM); + } + } +} + + + +/* +** Adjust stack. Set top to the given value, pushing NILs if needed. +*/ +void luaD_adjusttop (StkId newtop) +{ + int diff = newtop-(luaD_stack.top-luaD_stack.stack); + if (diff <= 0) + luaD_stack.top += diff; + else { + luaD_checkstack(diff); + while (diff--) + ttype(luaD_stack.top++) = LUA_T_NIL; + } +} + + +/* +** Open a hole below "nelems" from the luaD_stack.top. +*/ +void luaD_openstack (int nelems) +{ + int i; + for (i=0; ivalue.tf->fileName->str, + f->value.tf->lineDefined); + else + (*lua_callhook)(Ref(f), "(C)", -1); + } + luaD_stack.top = luaD_stack.stack+old_top; + luaD_Cstack = oldCLS; +} + + +/* +** Call a C function. luaD_Cstack.base will point to the luaD_stack.top of the luaD_stack.stack, +** and luaD_Cstack.num is the number of parameters. Returns an index +** to the first result from C. +*/ +static StkId callC (lua_CFunction func, StkId base) +{ + struct C_Lua_Stack oldCLS = luaD_Cstack; + StkId firstResult; + luaD_Cstack.num = (luaD_stack.top-luaD_stack.stack) - base; + /* incorporate parameters on the luaD_stack.stack */ + luaD_Cstack.lua2C = base; + luaD_Cstack.base = base+luaD_Cstack.num; /* == luaD_stack.top-luaD_stack.stack */ + if (lua_callhook) + luaD_callHook(base, LUA_T_CMARK, 0); + (*func)(); + if (lua_callhook) /* func may have changed lua_callhook */ + luaD_callHook(base, LUA_T_CMARK, 1); + firstResult = luaD_Cstack.base; + luaD_Cstack = oldCLS; + return firstResult; +} + + +void luaD_callTM (TObject *f, int nParams, int nResults) +{ + luaD_openstack(nParams); + *(luaD_stack.top-nParams-1) = *f; + luaD_call((luaD_stack.top-luaD_stack.stack)-nParams, nResults); +} + + +/* +** Call a function (C or Lua). The parameters must be on the luaD_stack.stack, +** between [luaD_stack.stack+base,luaD_stack.top). The function to be called is at luaD_stack.stack+base-1. +** When returns, the results are on the luaD_stack.stack, between [luaD_stack.stack+base-1,luaD_stack.top). +** The number of results is nResults, unless nResults=MULT_RET. +*/ +void luaD_call (StkId base, int nResults) +{ + StkId firstResult; + TObject *func = luaD_stack.stack+base-1; + int i; + if (ttype(func) == LUA_T_CFUNCTION) { + ttype(func) = LUA_T_CMARK; + firstResult = callC(fvalue(func), base); + } + else if (ttype(func) == LUA_T_FUNCTION) { + ttype(func) = LUA_T_MARK; + firstResult = luaV_execute(func->value.cl, base); + } + else { /* func is not a function */ + /* Check the tag method for invalid functions */ + TObject *im = luaT_getimbyObj(func, IM_FUNCTION); + if (ttype(im) == LUA_T_NIL) + lua_error("call expression not a function"); + luaD_callTM(im, (luaD_stack.top-luaD_stack.stack)-(base-1), nResults); + return; + } + /* adjust the number of results */ + if (nResults != MULT_RET) + luaD_adjusttop(firstResult+nResults); + /* move results to base-1 (to erase parameters and function) */ + base--; + nResults = luaD_stack.top - (luaD_stack.stack+firstResult); /* actual number of results */ + for (i=0; i=0; i--) + fn (luaD_stack.stack+i); +} + + +/* +** Error messages +*/ + +static void auxerrorim (char *form) +{ + lua_Object s = lua_getparam(1); + if (lua_isstring(s)) + fprintf(stderr, form, lua_getstring(s)); +} + + +static void emergencyerrorf (void) +{ + auxerrorim("THERE WAS AN ERROR INSIDE AN ERROR METHOD:\n%s\n"); +} + + +static void stderrorim (void) +{ + auxerrorim("lua: %s\n"); +} + + +TObject luaD_errorim = {LUA_T_CFUNCTION, {stderrorim}}; + + +static void message (char *s) +{ + TObject im = luaD_errorim; + if (ttype(&im) != LUA_T_NIL) { + luaD_errorim.ttype = LUA_T_CFUNCTION; + luaD_errorim.value.f = emergencyerrorf; + lua_pushstring(s); + luaD_callTM(&im, 1, 0); + luaD_errorim = im; + } +} + +/* +** Reports an error, and jumps up to the available recover label +*/ +void lua_error (char *s) +{ + if (s) message(s); + if (errorJmp) + longjmp(*errorJmp, 1); + else { + fprintf (stderr, "lua: exit(1). Unable to recover\n"); + exit(1); + } +} + +/* +** Call the function at luaD_Cstack.base, and incorporate results on +** the Lua2C structure. +*/ +static void do_callinc (int nResults) +{ + StkId base = luaD_Cstack.base; + luaD_call(base+1, nResults); + luaD_Cstack.lua2C = base; /* position of the luaM_new results */ + luaD_Cstack.num = (luaD_stack.top-luaD_stack.stack) - base; /* number of results */ + luaD_Cstack.base = base + luaD_Cstack.num; /* incorporate results on luaD_stack.stack */ +} + + +/* +** Execute a protected call. Assumes that function is at luaD_Cstack.base and +** parameters are on luaD_stack.top of it. Leave nResults on the luaD_stack.stack. +*/ +int luaD_protectedrun (int nResults) +{ + jmp_buf myErrorJmp; + int status; + struct C_Lua_Stack oldCLS = luaD_Cstack; + jmp_buf *oldErr = errorJmp; + errorJmp = &myErrorJmp; + if (setjmp(myErrorJmp) == 0) { + do_callinc(nResults); + status = 0; + } + else { /* an error occurred: restore luaD_Cstack and luaD_stack.top */ + luaD_Cstack = oldCLS; + luaD_stack.top = luaD_stack.stack+luaD_Cstack.base; + status = 1; + } + errorJmp = oldErr; + return status; +} + + +/* +** returns 0 = chunk loaded; 1 = error; 2 = no more chunks to load +*/ +static int protectedparser (ZIO *z, char *chunkname, int bin) +{ + int status; + TProtoFunc *tf; + jmp_buf myErrorJmp; + jmp_buf *oldErr = errorJmp; + errorJmp = &myErrorJmp; + if (setjmp(myErrorJmp) == 0) { + tf = bin ? luaU_undump1(z, chunkname) : luaY_parser(z, chunkname); + status = 0; + } + else { + tf = NULL; + status = 1; + } + errorJmp = oldErr; + if (status) return 1; /* error code */ + if (tf == NULL) return 2; /* 'natural' end */ + luaD_adjusttop(luaD_Cstack.base+1); /* one slot for the pseudo-function */ + luaD_stack.stack[luaD_Cstack.base].ttype = LUA_T_PROTO; + luaD_stack.stack[luaD_Cstack.base].value.tf = tf; + luaV_closure(); + return 0; +} + + +static int do_main (ZIO *z, char *chunkname, int bin) +{ + int status; + do { + long old_entities = (luaC_checkGC(), luaO_nentities); + status = protectedparser(z, chunkname, bin); + if (status == 1) return 1; /* error */ + else if (status == 2) return 0; /* 'natural' end */ + else { + long newelems2 = 2*(luaO_nentities-old_entities); + luaC_threshold += newelems2; + status = luaD_protectedrun(MULT_RET); + luaC_threshold -= 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) { + *luaD_stack.top = *o; + incr_top; + luaD_callTM(im, 1, 0); + } +} + + +int lua_dofile (char *filename) +{ + ZIO z; + int status; + int c; + int bin; + FILE *f = (filename == NULL) ? stdin : fopen(filename, "r"); + if (f == NULL) + return 2; + if (filename == NULL) + filename = "(stdin)"; + c = fgetc(f); + ungetc(c, f); + bin = (c == ID_CHUNK); + if (bin) + f = freopen(filename, "rb", f); /* set binary mode */ + luaZ_Fopen(&z, f); + status = do_main(&z, filename, bin); + if (f != stdin) + fclose(f); + return status; +} + + +#define SIZE_PREF 20 /* size of string prefix to appear in error messages */ + + +int lua_dostring (char *str) +{ + int status; + char buff[SIZE_PREF+25]; + char *temp; + ZIO z; + if (str == NULL) return 1; + sprintf(buff, "(dostring) >> %.20s", str); + temp = strchr(buff, '\n'); + if (temp) *temp = 0; /* end string after first line */ + luaZ_sopen(&z, str); + status = do_main(&z, buff, 0); + return status; +} + diff --git a/ldo.h b/ldo.h new file mode 100644 index 00000000..edcd1b93 --- /dev/null +++ b/ldo.h @@ -0,0 +1,62 @@ +/* +** $Id: $ +** Stack and Call structure of Lua +** See Copyright Notice in lua.h +*/ + +#ifndef ldo_h +#define ldo_h + + +#include "lobject.h" + + +typedef int StkId; /* index to luaD_stack.stack elements */ + +#define MULT_RET 255 + + +extern struct Stack { + TObject *last; + TObject *stack; + TObject *top; +} luaD_stack; + + +extern struct C_Lua_Stack { + StkId base; /* when Lua calls C or C calls Lua, points to */ + /* the first slot after the last parameter. */ + StkId lua2C; /* points to first element of "array" lua2C */ + int num; /* size of "array" lua2C */ +} luaD_Cstack; + + +extern TObject luaD_errorim; + + +/* +** macro to increment stack top. +** There must be always an empty slot at the luaD_stack.top +*/ +#define incr_top { if (luaD_stack.top >= luaD_stack.last) luaD_checkstack(1); \ + luaD_stack.top++; } + + +/* macros to convert from lua_Object to (TObject *) and back */ + +#define Address(lo) ((lo)+luaD_stack.stack-1) +#define Ref(st) ((st)-luaD_stack.stack+1) + +void luaD_adjusttop (StkId newtop); +void luaD_openstack (int nelems); +void luaD_lineHook (int line); +void luaD_callHook (StkId base, lua_Type type, int isreturn); +void luaD_call (StkId base, int nResults); +void luaD_callTM (TObject *f, int nParams, int nResults); +int luaD_protectedrun (int nResults); +void luaD_gcIM (TObject *o); +void luaD_travstack (int (*fn)(TObject *)); +void luaD_checkstack (int n); + + +#endif diff --git a/opcode.c b/opcode.c deleted file mode 100644 index e569d284..00000000 --- a/opcode.c +++ /dev/null @@ -1,1484 +0,0 @@ -/* -** opcode.c -** TecCGraf - PUC-Rio -*/ - -char *rcs_opcode="$Id: opcode.c,v 4.21 1997/07/31 19:37:37 roberto Exp roberto $"; - -#include -#include -#include -#include - -#include "lualoc.h" -#include "luadebug.h" -#include "luamem.h" -#include "opcode.h" -#include "hash.h" -#include "inout.h" -#include "table.h" -#include "lua.h" -#include "fallback.h" -#include "auxlib.h" -#include "lex.h" - -#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0)) -#define tostring(o) ((ttype(o) != LUA_T_STRING) && (lua_tostring(o) != 0)) - - -#define get_word(w,pc) {w=*pc+(*(pc+1)<<8); pc+=2;} - - -#define STACK_SIZE 128 - -#ifndef STACK_LIMIT -#define STACK_LIMIT 6000 -#endif - -typedef int StkId; /* index to stack elements */ - -static TObject initial_stack; - -static TObject *stackLimit = &initial_stack+1; -static TObject *stack = &initial_stack; -static TObject *top = &initial_stack; - - -/* macros to convert from lua_Object to (TObject *) and back */ - -#define Address(lo) ((lo)+stack-1) -#define Ref(st) ((st)-stack+1) - - -/* macro to increment stack top. There must be always an empty slot in -* the stack -*/ -#define incr_top if (++top >= stackLimit) growstack() - -struct C_Lua_Stack { - StkId base; /* when Lua calls C or C calls Lua, points to */ - /* the first slot after the last parameter. */ - StkId lua2C; /* points to first element of "array" lua2C */ - int num; /* size of "array" lua2C */ -}; - -static struct C_Lua_Stack CLS_current = {0, 0, 0}; - -static jmp_buf *errorJmp = NULL; /* current error recover point */ - - -/* Hooks */ -lua_LHFunction lua_linehook = NULL; -lua_CHFunction lua_callhook = NULL; - - -static StkId lua_execute (TFunc *func, StkId base); -static void do_call (StkId base, int nResults); - - - -TObject *luaI_Address (lua_Object o) -{ - return Address(o); -} - - -/* -** Init stack -*/ -static void lua_initstack (void) -{ - Long maxstack = STACK_SIZE; - stack = newvector(maxstack, TObject); - stackLimit = stack+maxstack; - top = stack; - *(top++) = initial_stack; -} - - -/* -** Check stack overflow and, if necessary, realloc vector -*/ -#define lua_checkstack(nt) if ((nt) >= stackLimit) growstack() - -static void growstack (void) -{ - if (stack == &initial_stack) - lua_initstack(); - else - { - static int limit = STACK_LIMIT; - StkId t = top-stack; - Long stacksize = stackLimit - stack; - stacksize = growvector(&stack, stacksize, TObject, stackEM, limit+100); - stackLimit = stack+stacksize; - top = stack + t; - if (stacksize >= limit) - { - limit = stacksize; - lua_error(stackEM); - } - } -} - - -/* -** Concatenate two given strings. Return the new string pointer. -*/ -static char *lua_strconc (char *l, char *r) -{ - size_t nl = strlen(l); - char *buffer = luaI_buffer(nl+strlen(r)+1); - strcpy(buffer, l); - strcpy(buffer+nl, r); - return buffer; -} - - -/* -** Convert, if possible, to a number object. -** Return 0 if success, not 0 if error. -*/ -static int lua_tonumber (TObject *obj) -{ - double t; - char c; - if (ttype(obj) != LUA_T_STRING) - return 1; - else if (sscanf(svalue(obj), "%lf %c",&t, &c) == 1) { - nvalue(obj) = (real)t; - ttype(obj) = LUA_T_NUMBER; - return 0; - } - else - return 2; -} - - -/* -** Convert, if possible, to a string ttype -** Return 0 in success or not 0 on error. -*/ -static int lua_tostring (TObject *obj) -{ - if (ttype(obj) != LUA_T_NUMBER) - return 1; - else { - char s[60]; - real f = nvalue(obj); - int i; - if ((real)(-MAX_INT) <= f && f <= (real)MAX_INT && (real)(i=(int)f) == f) - sprintf (s, "%d", i); - else - sprintf (s, "%g", (double)nvalue(obj)); - tsvalue(obj) = luaI_createstring(s); - ttype(obj) = LUA_T_STRING; - return 0; - } -} - - -/* -** Adjust stack. Set top to the given value, pushing NILs if needed. -*/ -static void adjust_top_aux (StkId newtop) -{ - TObject *nt; - lua_checkstack(stack+newtop); - nt = stack+newtop; /* warning: previous call may change stack */ - while (top < nt) ttype(top++) = LUA_T_NIL; -} - - -#define adjust_top(newtop) { if (newtop <= top-stack) \ - top = stack+newtop; \ - else adjust_top_aux(newtop); } - -#define adjustC(nParams) adjust_top(CLS_current.base+nParams) - - -static void checkCparams (int nParams) -{ - if (top-stack < CLS_current.base+nParams) - lua_error("API error - wrong number of arguments in C2lua stack"); -} - - -/* -** Open a hole below "nelems" from the top. -*/ -static void open_stack (int nelems) -{ - int i; - for (i=0; ivalue.tf->fileName->str, - f->value.tf->lineDefined); - else - (*lua_callhook)(Ref(f), "(C)", -1); - } - top = stack+old_top; - CLS_current = oldCLS; -} - - -/* -** Call a C function. CLS_current.base will point to the top of the stack, -** and CLS_current.num is the number of parameters. Returns an index -** to the first result from C. -*/ -static StkId callC (lua_CFunction func, StkId base) -{ - struct C_Lua_Stack oldCLS = CLS_current; - StkId firstResult; - CLS_current.num = (top-stack) - base; - /* incorporate parameters on the stack */ - CLS_current.lua2C = base; - CLS_current.base = base+CLS_current.num; /* == top-stack */ - if (lua_callhook) - callHook(base, LUA_T_CMARK, 0); - (*func)(); - if (lua_callhook) /* func may have changed lua_callhook */ - callHook(base, LUA_T_CMARK, 1); - firstResult = CLS_current.base; - CLS_current = oldCLS; - return firstResult; -} - -static void callIM (TObject *f, int nParams, int nResults) -{ - open_stack(nParams); - *(top-nParams-1) = *f; - do_call((top-stack)-nParams, nResults); -} - - -/* -** Call a function (C or Lua). The parameters must be on the stack, -** between [stack+base,top). The function to be called is at stack+base-1. -** When returns, the results are on the stack, between [stack+base-1,top). -** The number of results is nResults, unless nResults=MULT_RET. -*/ -static void do_call (StkId base, int nResults) -{ - StkId firstResult; - TObject *func = stack+base-1; - int i; - if (ttype(func) == LUA_T_CFUNCTION) { - ttype(func) = LUA_T_CMARK; - firstResult = callC(fvalue(func), base); - } - else if (ttype(func) == LUA_T_FUNCTION) { - ttype(func) = LUA_T_MARK; - firstResult = lua_execute(func->value.tf, base); - } - else { /* func is not a function */ - /* Check the tag method for invalid functions */ - TObject *im = luaI_getimbyObj(func, IM_FUNCTION); - if (ttype(im) == LUA_T_NIL) - lua_error("call expression not a function"); - open_stack((top-stack)-(base-1)); - stack[base-1] = *im; - do_call(base, nResults); - return; - } - /* adjust the number of results */ - if (nResults != MULT_RET) - adjust_top(firstResult+nResults); - /* move results to base-1 (to erase parameters and function) */ - base--; - nResults = top - (stack+firstResult); /* actual number of results */ - for (i=0; ivalue.a->htag; - im = luaI_getim(tg, IM_GETTABLE); - if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */ - TObject *h = lua_hashget(avalue(top-2), top-1); - if (h != NULL && ttype(h) != LUA_T_NIL) { - --top; - *(top-1) = *h; - } - else if (ttype(im=luaI_getim(tg, IM_INDEX)) != LUA_T_NIL) - callIM(im, 2, 1); - else { - --top; - ttype(top-1) = LUA_T_NIL; - } - return; - } - /* else it has a "gettable" method, go through to next command */ - } - /* object is not a table, or it has a "gettable" method */ - if (ttype(im) != LUA_T_NIL) - callIM(im, 2, 1); - else - lua_error("indexed expression not a table"); -} - - -lua_Object lua_rawgettable (void) -{ - checkCparams(2); - if (ttype(top-2) != LUA_T_ARRAY) - lua_error("indexed expression not a table in raw gettable"); - else { - TObject *h = lua_hashget(avalue(top-2), top-1); - --top; - if (h != NULL) - *(top-1) = *h; - else - ttype(top-1) = LUA_T_NIL; - } - return put_luaObjectonTop(); -} - - -/* -** Function to store indexed based on values at the top -** mode = 0: raw store (without internal methods) -** mode = 1: normal store (with internal methods) -** mode = 2: "deep stack" store (with internal methods) -*/ -static void storesubscript (TObject *t, int mode) -{ - TObject *im = (mode == 0) ? NULL : luaI_getimbyObj(t, IM_SETTABLE); - if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) { - TObject *h = lua_hashdefine(avalue(t), t+1); - *h = *(top-1); - top -= (mode == 2) ? 1 : 3; - } - else { /* object is not a table, and/or has a specific "settable" method */ - if (im && ttype(im) != LUA_T_NIL) { - if (mode == 2) { - lua_checkstack(top+2); - *(top+1) = *(top-1); - *(top) = *(t+1); - *(top-1) = *t; - top += 2; - } - callIM(im, 3, 0); - } - else - lua_error("indexed expression not a table"); - } -} - - -static void getglobal (Word n) -{ - TObject *value = &lua_table[n].object; - TObject *im = luaI_getimbyObj(value, IM_GETGLOBAL); - if (ttype(im) == LUA_T_NIL) { /* default behavior */ - *top = *value; - incr_top; - } - else { - ttype(top) = LUA_T_STRING; - tsvalue(top) = lua_table[n].varname; - incr_top; - *top = *value; - incr_top; - callIM(im, 2, 1); - } -} - -/* -** Traverse all objects on stack -*/ -void lua_travstack (int (*fn)(TObject *)) -{ - StkId i; - for (i = (top-1)-stack; i>=0; i--) - fn (stack+i); -} - - -/* -** Error messages and debug functions -*/ - - -static void auxerrorim (char *form) -{ - lua_Object s = lua_getparam(1); - if (lua_isstring(s)) - fprintf(stderr, form, lua_getstring(s)); -} - - -static void emergencyerrorf (void) -{ - auxerrorim("WARNING - THERE WAS AN ERROR INSIDE AN ERROR METHOD:\n%s\n"); -} - - -static void stderrorim (void) -{ - auxerrorim("lua: %s\n"); -} - - -TObject luaI_errorim = {LUA_T_CFUNCTION, {stderrorim}}; - - -static void lua_message (char *s) -{ - TObject im = luaI_errorim; - if (ttype(&im) != LUA_T_NIL) { - luaI_errorim.ttype = LUA_T_CFUNCTION; - luaI_errorim.value.f = emergencyerrorf; - lua_pushstring(s); - callIM(&im, 1, 0); - luaI_errorim = im; - } -} - -/* -** Reports an error, and jumps up to the available recover label -*/ -void lua_error (char *s) -{ - if (s) lua_message(s); - if (errorJmp) - longjmp(*errorJmp, 1); - else - { - fprintf (stderr, "lua: exit(1). Unable to recover\n"); - exit(1); - } -} - - -lua_Function lua_stackedfunction (int level) -{ - StkId i; - for (i = (top-1)-stack; i>=0; i--) - if (stack[i].ttype == LUA_T_MARK || stack[i].ttype == LUA_T_CMARK) - if (level-- == 0) - return Ref(stack+i); - return LUA_NOOBJECT; -} - - -int lua_currentline (lua_Function func) -{ - TObject *f = Address(func); - return (f+1 < top && (f+1)->ttype == LUA_T_LINE) ? (f+1)->value.i : -1; -} - - -lua_Object lua_getlocal (lua_Function func, int local_number, char **name) -{ - TObject *f = luaI_Address(func); - /* check whether func is a Lua function */ - if (ttype(f) != LUA_T_MARK && ttype(f) != LUA_T_FUNCTION) - return LUA_NOOBJECT; - *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func)); - if (*name) - { - /* if "*name", there must be a LUA_T_LINE */ - /* therefore, f+2 points to function base */ - return Ref((f+2)+(local_number-1)); - } - else - return LUA_NOOBJECT; -} - -int lua_setlocal (lua_Function func, int local_number) -{ - TObject *f = Address(func); - char *name = luaI_getlocalname(f->value.tf, local_number, lua_currentline(func)); - checkCparams(1); - --top; - if (name) - { - /* if "name", there must be a LUA_T_LINE */ - /* therefore, f+2 points to function base */ - *((f+2)+(local_number-1)) = *top; - return 1; - } - else - return 0; -} - -/* -** Call the function at CLS_current.base, and incorporate results on -** the Lua2C structure. -*/ -static void do_callinc (int nResults) -{ - StkId base = CLS_current.base; - do_call(base+1, nResults); - CLS_current.lua2C = base; /* position of the new results */ - CLS_current.num = (top-stack) - base; /* number of results */ - CLS_current.base = base + CLS_current.num; /* incorporate results on stack */ -} - - -static void do_unprotectedrun (lua_CFunction f, int nParams, int nResults) -{ - StkId base = (top-stack)-nParams; - open_stack(nParams); - stack[base].ttype = LUA_T_CFUNCTION; - stack[base].value.f = f; - do_call(base+1, nResults); -} - - -/* -** Execute a protected call. Assumes that function is at CLS_current.base and -** parameters are on top of it. Leave nResults on the stack. -*/ -static int do_protectedrun (int nResults) -{ - jmp_buf myErrorJmp; - int status; - struct C_Lua_Stack oldCLS = CLS_current; - jmp_buf *oldErr = errorJmp; - errorJmp = &myErrorJmp; - if (setjmp(myErrorJmp) == 0) { - do_callinc(nResults); - status = 0; - } - else { /* an error occurred: restore CLS_current and top */ - CLS_current = oldCLS; - top = stack+CLS_current.base; - status = 1; - } - errorJmp = oldErr; - return status; -} - -int luaI_dorun (TFunc *tf) -{ - int status; - adjustC(1); /* one slot for the pseudo-function */ - stack[CLS_current.base].ttype = LUA_T_FUNCTION; - stack[CLS_current.base].value.tf = tf; - status = do_protectedrun(MULT_RET); - return status; -} - - -int lua_domain (void) -{ - int status; - TFunc *tf = new(TFunc); - jmp_buf myErrorJmp; - jmp_buf *oldErr = errorJmp; - errorJmp = &myErrorJmp; - luaI_initTFunc(tf); - adjustC(1); /* one slot for the pseudo-function */ - stack[CLS_current.base].ttype = LUA_T_FUNCTION; - stack[CLS_current.base].value.tf = tf; - if (setjmp(myErrorJmp) == 0) { - lua_parse(tf); - status = 0; - } - else { - adjustC(0); /* erase extra slot */ - status = 1; - } - if (status == 0) - status = do_protectedrun(MULT_RET); - errorJmp = oldErr; - return status; -} - -/* -** Execute the given lua function. Return 0 on success or 1 on error. -*/ -int lua_callfunction (lua_Object function) -{ - if (function == LUA_NOOBJECT) - return 1; - else - { - open_stack((top-stack)-CLS_current.base); - stack[CLS_current.base] = *Address(function); - return do_protectedrun (MULT_RET); - } -} - - -lua_Object lua_gettagmethod (int tag, char *event) -{ - lua_pushnumber(tag); - lua_pushstring(event); - do_unprotectedrun(luaI_gettagmethod, 2, 1); - return put_luaObjectonTop(); -} - -lua_Object lua_settagmethod (int tag, char *event) -{ - TObject newmethod; - checkCparams(1); - newmethod = *(--top); - lua_pushnumber(tag); - lua_pushstring(event); - *top = newmethod; incr_top; - do_unprotectedrun(luaI_settagmethod, 3, 1); - return put_luaObjectonTop(); -} - -lua_Object lua_seterrormethod (void) -{ - checkCparams(1); - do_unprotectedrun(luaI_seterrormethod, 1, 1); - return put_luaObjectonTop(); -} - - -/* -** API: receives on the stack the table and the index. -** returns the value. -*/ -lua_Object lua_gettable (void) -{ - checkCparams(2); - pushsubscript(); - return put_luaObjectonTop(); -} - - -#define MAX_C_BLOCKS 10 - -static int numCblocks = 0; -static struct C_Lua_Stack Cblocks[MAX_C_BLOCKS]; - -/* -** API: starts a new block -*/ -void lua_beginblock (void) -{ - if (numCblocks >= MAX_C_BLOCKS) - lua_error("`lua_beginblock': too many nested blocks"); - Cblocks[numCblocks] = CLS_current; - numCblocks++; -} - -/* -** API: ends a block -*/ -void lua_endblock (void) -{ - --numCblocks; - CLS_current = Cblocks[numCblocks]; - adjustC(0); -} - -void lua_settag (int tag) -{ - checkCparams(1); - luaI_settag(tag, --top); -} - -/* -** API: receives on the stack the table, the index, and the new value. -*/ -void lua_settable (void) -{ - checkCparams(3); - storesubscript(top-3, 1); -} - -void lua_rawsettable (void) -{ - checkCparams(3); - storesubscript(top-3, 0); -} - -/* -** API: creates a new table -*/ -lua_Object lua_createtable (void) -{ - TObject o; - avalue(&o) = lua_createarray(0); - ttype(&o) = LUA_T_ARRAY; - return put_luaObject(&o); -} - -/* -** Get a parameter, returning the object handle or LUA_NOOBJECT on error. -** 'number' must be 1 to get the first parameter. -*/ -lua_Object lua_lua2C (int number) -{ - if (number <= 0 || number > CLS_current.num) return LUA_NOOBJECT; - /* Ref(stack+(CLS_current.lua2C+number-1)) == - stack+(CLS_current.lua2C+number-1)-stack+1 == */ - return CLS_current.lua2C+number; -} - -int lua_isnil (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_NIL); -} - -int lua_istable (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_ARRAY); -} - -int lua_isuserdata (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (ttype(Address(o)) == LUA_T_USERDATA); -} - -int lua_iscfunction (lua_Object o) -{ - int t = lua_tag(o); - return (t == LUA_T_CMARK) || (t == LUA_T_CFUNCTION); -} - -int lua_isnumber (lua_Object o) -{ - return (o!= LUA_NOOBJECT) && (tonumber(Address(o)) == 0); -} - -int lua_isstring (lua_Object o) -{ - int t = lua_tag(o); - return (t == LUA_T_STRING) || (t == LUA_T_NUMBER); -} - -int lua_isfunction (lua_Object o) -{ - int t = lua_tag(o); - return (t == LUA_T_FUNCTION) || (t == LUA_T_CFUNCTION) || - (t == LUA_T_MARK) || (t == LUA_T_CMARK); -} - -/* -** Given an object handle, return its number value. On error, return 0.0. -*/ -real lua_getnumber (lua_Object object) -{ - if (object == LUA_NOOBJECT) return 0.0; - if (tonumber (Address(object))) return 0.0; - else return (nvalue(Address(object))); -} - -/* -** Given an object handle, return its string pointer. On error, return NULL. -*/ -char *lua_getstring (lua_Object object) -{ - if (object == LUA_NOOBJECT || tostring (Address(object))) - return NULL; - else return (svalue(Address(object))); -} - - -void *lua_getuserdata (lua_Object object) -{ - if (object == LUA_NOOBJECT || ttype(Address(object)) != LUA_T_USERDATA) - return NULL; - else return tsvalue(Address(object))->u.v; -} - - -/* -** Given an object handle, return its cfuntion pointer. On error, return NULL. -*/ -lua_CFunction lua_getcfunction (lua_Object object) -{ - if (object == LUA_NOOBJECT || ((ttype(Address(object)) != LUA_T_CFUNCTION) && - (ttype(Address(object)) != LUA_T_CMARK))) - return NULL; - else return (fvalue(Address(object))); -} - - -lua_Object lua_getref (int ref) -{ - TObject *o = luaI_getref(ref); - if (o == NULL) - return LUA_NOOBJECT; - return put_luaObject(o); -} - - -int lua_ref (int lock) -{ - checkCparams(1); - return luaI_ref(--top, lock); -} - - - -/* -** Get a global object. -*/ -lua_Object lua_getglobal (char *name) -{ - getglobal(luaI_findsymbolbyname(name)); - return put_luaObjectonTop(); -} - - -lua_Object lua_rawgetglobal (char *name) -{ - return put_luaObject(&lua_table[luaI_findsymbolbyname(name)].object); -} - - -/* -** Store top of the stack at a global variable array field. -*/ -static void setglobal (Word n) -{ - TObject *oldvalue = &lua_table[n].object; - TObject *im = luaI_getimbyObj(oldvalue, IM_SETGLOBAL); - if (ttype(im) == LUA_T_NIL) /* default behavior */ - s_object(n) = *(--top); - else { - TObject newvalue = *(top-1); - ttype(top-1) = LUA_T_STRING; - tsvalue(top-1) = lua_table[n].varname; - *top = *oldvalue; - incr_top; - *top = newvalue; - incr_top; - callIM(im, 3, 0); - } -} - - -void lua_setglobal (char *name) -{ - checkCparams(1); - setglobal(luaI_findsymbolbyname(name)); -} - -void lua_rawsetglobal (char *name) -{ - Word n = luaI_findsymbolbyname(name); - checkCparams(1); - s_object(n) = *(--top); -} - -/* -** Push a nil object -*/ -void lua_pushnil (void) -{ - ttype(top) = LUA_T_NIL; - incr_top; -} - -/* -** Push an object (ttype=number) to stack. -*/ -void lua_pushnumber (real n) -{ - ttype(top) = LUA_T_NUMBER; nvalue(top) = n; - incr_top; -} - -/* -** Push an object (ttype=string) to stack. -*/ -void lua_pushstring (char *s) -{ - if (s == NULL) - ttype(top) = LUA_T_NIL; - else - { - tsvalue(top) = luaI_createstring(s); - ttype(top) = LUA_T_STRING; - } - incr_top; -} - - -/* -** Push an object (ttype=cfunction) to stack. -*/ -void lua_pushcfunction (lua_CFunction fn) -{ - ttype(top) = LUA_T_CFUNCTION; fvalue(top) = fn; - incr_top; -} - - - -void lua_pushusertag (void *u, int tag) -{ - if (tag < 0 && tag != LUA_ANYTAG) - luaI_realtag(tag); /* error if tag is not valid */ - tsvalue(top) = luaI_createudata(u, tag); - ttype(top) = LUA_T_USERDATA; - incr_top; -} - -/* -** Push an object on the stack. -*/ -void luaI_pushobject (TObject *o) -{ - *top = *o; - incr_top; -} - -/* -** Push a lua_Object on stack. -*/ -void lua_pushobject (lua_Object o) -{ - if (o == LUA_NOOBJECT) - lua_error("API error - attempt to push a NOOBJECT"); - *top = *Address(o); - if (ttype(top) == LUA_T_MARK) ttype(top) = LUA_T_FUNCTION; - else if (ttype(top) == LUA_T_CMARK) ttype(top) = LUA_T_CFUNCTION; - incr_top; -} - -int lua_tag (lua_Object lo) -{ - if (lo == LUA_NOOBJECT) return LUA_T_NIL; - else { - TObject *o = Address(lo); - lua_Type t = ttype(o); - if (t == LUA_T_USERDATA) - return o->value.ts->tag; - else if (t == LUA_T_ARRAY) - return o->value.a->htag; - else return t; - } -} - - -void luaI_gcIM (TObject *o) -{ - TObject *im = luaI_getimbyObj(o, IM_GC); - if (ttype(im) != LUA_T_NIL) { - *top = *o; - incr_top; - callIM(im, 1, 0); - } -} - - -static void call_binTM (IMS event, char *msg) -{ - TObject *im = luaI_getimbyObj(top-2, event); /* try first operand */ - if (ttype(im) == LUA_T_NIL) { - im = luaI_getimbyObj(top-1, event); /* try second operand */ - if (ttype(im) == LUA_T_NIL) { - im = luaI_getim(0, event); /* try a 'global' i.m. */ - if (ttype(im) == LUA_T_NIL) - lua_error(msg); - } - } - lua_pushstring(luaI_eventname[event]); - callIM(im, 3, 1); -} - - -static void call_arith (IMS event) -{ - call_binTM(event, "unexpected type at arithmetic operation"); -} - - -static void comparison (lua_Type ttype_less, lua_Type ttype_equal, - lua_Type ttype_great, IMS op) -{ - TObject *l = top-2; - TObject *r = top-1; - int result; - if (ttype(l) == LUA_T_NUMBER && ttype(r) == LUA_T_NUMBER) - result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1; - else if (ttype(l) == LUA_T_STRING && ttype(r) == LUA_T_STRING) - result = strcoll(svalue(l), svalue(r)); - else { - call_binTM(op, "unexpected type at comparison"); - return; - } - top--; - nvalue(top-1) = 1; - ttype(top-1) = (result < 0) ? ttype_less : - (result == 0) ? ttype_equal : ttype_great; -} - - -static void adjust_varargs (StkId first_extra_arg) -{ - TObject arg; - TObject *firstelem = stack+first_extra_arg; - int nvararg = top-firstelem; - int i; - if (nvararg < 0) nvararg = 0; - avalue(&arg) = lua_createarray(nvararg+1); /* +1 for field 'n' */ - ttype(&arg) = LUA_T_ARRAY; - for (i=0; icode; - if (lua_callhook) - callHook (base, LUA_T_MARK, 0); - while (1) - { - OpCode opcode; - switch (opcode = (OpCode)*pc++) - { - case PUSHNIL: ttype(top) = LUA_T_NIL; incr_top; break; - - case PUSH0: case PUSH1: case PUSH2: - ttype(top) = LUA_T_NUMBER; - nvalue(top) = opcode-PUSH0; - incr_top; - break; - - case PUSHBYTE: - ttype(top) = LUA_T_NUMBER; nvalue(top) = *pc++; incr_top; break; - - case PUSHWORD: - { - Word w; - get_word(w,pc); - ttype(top) = LUA_T_NUMBER; nvalue(top) = w; - incr_top; - } - break; - - case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: - case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5: - case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8: - case PUSHLOCAL9: - *top = *((stack+base) + (int)(opcode-PUSHLOCAL0)); incr_top; break; - - case PUSHLOCAL: *top = *((stack+base) + (*pc++)); incr_top; break; - - case PUSHGLOBAL: - { - Word w; - get_word(w,pc); - getglobal(w); - } - break; - - case PUSHINDEXED: - pushsubscript(); - break; - - case PUSHSELF: - { - TObject receiver = *(top-1); - Word w; - get_word(w,pc); - *top = func->consts[w]; - incr_top; - pushsubscript(); - *top = receiver; - incr_top; - break; - } - - case PUSHCONSTANTB: { - *top = func->consts[*pc++]; - incr_top; - break; - } - - case PUSHCONSTANT: { - Word w; - get_word(w,pc); - *top = func->consts[w]; - incr_top; - break; - } - - case STORELOCAL0: case STORELOCAL1: case STORELOCAL2: - case STORELOCAL3: case STORELOCAL4: case STORELOCAL5: - case STORELOCAL6: case STORELOCAL7: case STORELOCAL8: - case STORELOCAL9: - *((stack+base) + (int)(opcode-STORELOCAL0)) = *(--top); - break; - - case STORELOCAL: *((stack+base) + (*pc++)) = *(--top); break; - - case STOREGLOBAL: - { - Word w; - get_word(w,pc); - setglobal(w); - } - break; - - case STOREINDEXED0: - storesubscript(top-3, 1); - break; - - case STOREINDEXED: { - int n = *pc++; - storesubscript(top-3-n, 2); - break; - } - - case STORELIST0: - case STORELIST: - { - int m, n; - TObject *arr; - if (opcode == STORELIST0) m = 0; - else m = *(pc++) * FIELDS_PER_FLUSH; - n = *(pc++); - arr = top-n-1; - while (n) - { - ttype(top) = LUA_T_NUMBER; nvalue(top) = n+m; - *(lua_hashdefine (avalue(arr), top)) = *(top-1); - top--; - n--; - } - } - break; - - case STOREMAP: { - int n = *(pc++); - TObject *arr = top-(2*n)-1; - while (n--) { - *(lua_hashdefine (avalue(arr), top-2)) = *(top-1); - top-=2; - } - } - break; - - case ADJUST0: - adjust_top(base); - break; - - case ADJUST: { - StkId newtop = base + *(pc++); - adjust_top(newtop); - break; - } - - case VARARGS: - adjust_varargs(base + *(pc++)); - break; - - case CREATEARRAY: - { - Word size; - get_word(size,pc); - avalue(top) = lua_createarray(size); - ttype(top) = LUA_T_ARRAY; - incr_top; - } - break; - - case EQOP: - { - int res = lua_equalObj(top-2, top-1); - --top; - ttype(top-1) = res ? LUA_T_NUMBER : LUA_T_NIL; - nvalue(top-1) = 1; - } - break; - - case LTOP: - comparison(LUA_T_NUMBER, LUA_T_NIL, LUA_T_NIL, IM_LT); - break; - - case LEOP: - comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, IM_LE); - break; - - case GTOP: - comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, IM_GT); - break; - - case GEOP: - comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, IM_GE); - break; - - case ADDOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_ADD); - else - { - nvalue(l) += nvalue(r); - --top; - } - } - break; - - case SUBOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_SUB); - else - { - nvalue(l) -= nvalue(r); - --top; - } - } - break; - - case MULTOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_MUL); - else - { - nvalue(l) *= nvalue(r); - --top; - } - } - break; - - case DIVOP: - { - TObject *l = top-2; - TObject *r = top-1; - if (tonumber(r) || tonumber(l)) - call_arith(IM_DIV); - else - { - nvalue(l) /= nvalue(r); - --top; - } - } - break; - - case POWOP: - call_arith(IM_POW); - break; - - case CONCOP: { - TObject *l = top-2; - TObject *r = top-1; - if (tostring(l) || tostring(r)) - call_binTM(IM_CONCAT, "unexpected type for concatenation"); - else { - tsvalue(l) = luaI_createstring(lua_strconc(svalue(l),svalue(r))); - --top; - } - } - break; - - case MINUSOP: - if (tonumber(top-1)) - { - ttype(top) = LUA_T_NIL; - incr_top; - call_arith(IM_UNM); - } - else - nvalue(top-1) = - nvalue(top-1); - break; - - case NOTOP: - ttype(top-1) = (ttype(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL; - nvalue(top-1) = 1; - break; - - case ONTJMP: - { - Word w; - get_word(w,pc); - if (ttype(top-1) != LUA_T_NIL) pc += w; - else top--; - } - break; - - case ONFJMP: - { - Word w; - get_word(w,pc); - if (ttype(top-1) == LUA_T_NIL) pc += w; - else top--; - } - break; - - case JMP: - { - Word w; - get_word(w,pc); - pc += w; - } - break; - - case UPJMP: - { - Word w; - get_word(w,pc); - pc -= w; - } - break; - - case IFFJMP: - { - Word w; - get_word(w,pc); - top--; - if (ttype(top) == LUA_T_NIL) pc += w; - } - break; - - case IFFUPJMP: - { - Word w; - get_word(w,pc); - top--; - if (ttype(top) == LUA_T_NIL) pc -= w; - } - break; - - case CALLFUNC: - { - int nParams = *(pc++); - int nResults = *(pc++); - StkId newBase = (top-stack)-nParams; - do_call(newBase, nResults); - } - break; - - case RETCODE0: - case RETCODE: - if (lua_callhook) - callHook (base, LUA_T_MARK, 1); - return (base + ((opcode==RETCODE0) ? 0 : *pc)); - - case SETLINE: - { - Word line; - get_word(line,pc); - if ((stack+base-1)->ttype != LUA_T_LINE) - { - /* open space for LINE value */ - open_stack((top-stack)-base); - base++; - (stack+base-1)->ttype = LUA_T_LINE; - } - (stack+base-1)->value.i = line; - if (lua_linehook) - lineHook (line); - break; - } - - default: - lua_error ("internal error - opcode doesn't match"); - } - } -} - - -#if LUA_COMPAT2_5 -/* -** API: set a function as a fallback -*/ -lua_Object lua_setfallback (char *name, lua_CFunction fallback) -{ - lua_pushstring(name); - lua_pushcfunction(fallback); - do_unprotectedrun(luaI_setfallback, 2, 1); - return put_luaObjectonTop(); -} -#endif