/* ** opcode.c ** TecCGraf - PUC-Rio */ char *rcs_opcode="$Id: opcode.c,v 3.12 1994/11/16 16:03:48 roberto Exp roberto $"; #include #include #include #include #include "mem.h" #include "opcode.h" #include "hash.h" #include "inout.h" #include "table.h" #include "lua.h" #include "fallback.h" #define tonumber(o) ((tag(o) != LUA_T_NUMBER) && (lua_tonumber(o) != 0)) #define tostring(o) ((tag(o) != LUA_T_STRING) && (lua_tostring(o) != 0)) #define STACK_BUFFER (STACKGAP+128) static Long maxstack = 0L; static Object *stack = NULL; static Object *top = NULL; /* macros to convert from lua_Object to (Object *) and back */ #define Address(lo) ((lo)+stack-1) #define Ref(st) ((st)-stack+1) static int CBase = 0; /* when Lua calls C or C calls Lua, points to the */ /* first slot after the last parameter. */ static int CnResults = 0; /* when Lua calls C, has the number of parameters; */ /* when C calls Lua, has the number of results. */ static jmp_buf *errorJmp = NULL; /* current error recover point */ static int lua_execute (Byte *pc, int base); static void do_call (Object *func, int base, int nResults, int whereRes); Object *luaI_Address (lua_Object o) { return Address(o); } /* ** Error messages */ static void lua_message (char *s) { lua_pushstring(s); do_call(&luaI_fallBacks[FB_ERROR].function, (top-stack)-1, 0, (top-stack)-1); } /* ** Reports an error, and jumps up to the available recover label */ void lua_error (char *s) { lua_message(s); if (errorJmp) longjmp(*errorJmp, 1); else { fprintf (stderr, "lua: exit(1). Unable to recover\n"); exit(1); } } /* ** Init stack */ static void lua_initstack (void) { maxstack = STACK_BUFFER; stack = newvector(maxstack, Object); top = stack; } /* ** Check stack overflow and, if necessary, realloc vector */ static void lua_checkstack (Word n) { if ((Long)n > maxstack) { int t; if (stack == NULL) lua_initstack(); t = top-stack; maxstack *= 2; stack = growvector(stack, maxstack, Object); top = stack + t; } } /* ** Concatenate two given strings. Return the new string pointer. */ static char *lua_strconc (char *l, char *r) { static char *buffer = NULL; static int buffer_size = 0; int nl = strlen(l); int n = nl+strlen(r)+1; if (n > buffer_size) { buffer_size = n; if (buffer != NULL) luaI_free(buffer); buffer = newvector(buffer_size, char); } 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 (Object *obj) { float t; if (tag(obj) != LUA_T_STRING) return 1; else if (sscanf(svalue(obj), "%f %*c",&t) == 1) { nvalue(obj) = t; tag(obj) = LUA_T_NUMBER; return 0; } else return 2; } /* ** Convert, if possible, to a string tag ** Return 0 in success or not 0 on error. */ static int lua_tostring (Object *obj) { static char s[256]; if (tag(obj) != LUA_T_NUMBER) return 1; if ((int) nvalue(obj) == nvalue(obj)) sprintf (s, "%d", (int) nvalue(obj)); else sprintf (s, "%g", nvalue(obj)); svalue(obj) = lua_createstring(s); if (svalue(obj) == NULL) return 1; tag(obj) = LUA_T_STRING; return 0; } /* ** Adjust stack. Set top to the given value, pushing NILs if needed. */ static void adjust_top (int newtop) { Object *nt = stack+newtop; while (top < nt) tag(top++) = LUA_T_NIL; top = nt; /* top could be bigger than newtop */ } static void adjustC (int nParams) { adjust_top(CBase+nParams); } /* ** Call a C function. CBase will point to the top of the stack, ** and CnResults is the number of parameters. Returns an index ** to the first result from C. */ static int callC (lua_CFunction func, int base) { int oldBase = CBase; int oldCnResults = CnResults; int firstResult; CnResults = (top-stack) - base; /* incorporate parameters on the stack */ CBase = base+CnResults; (*func)(); firstResult = CBase; CBase = oldBase; CnResults = oldCnResults; return firstResult; } /* ** Call a function (C or Lua). The parameters must be on the stack, ** between [stack+base,top). When returns, the results are on the stack, ** between [stack+whereRes,top). The number of results is nResults, unless ** nResults=MULT_RET. */ static void do_call (Object *func, int base, int nResults, int whereRes) { int firstResult; if (tag(func) == LUA_T_CFUNCTION) firstResult = callC(fvalue(func), base); else if (tag(func) == LUA_T_FUNCTION) firstResult = lua_execute(bvalue(func), base); else { lua_reportbug ("call expression not a function"); return; /* to avoid warnings */ } /* adjust the number of results */ if (nResults != MULT_RET && top - (stack+firstResult) != nResults) adjust_top(firstResult+nResults); /* move results to the given position */ if (firstResult != whereRes) { int i; nResults = top - (stack+firstResult); /* actual number of results */ for (i=0; i= stack; o--) fn (o); } /* ** Execute a protected call. If function is null compiles the pre-set input. ** Leave nResults on the stack. */ static int do_protectedrun (Object *function, int nResults) { jmp_buf myErrorJmp; int status; int oldCBase = CBase; jmp_buf *oldErr = errorJmp; errorJmp = &myErrorJmp; if (setjmp(myErrorJmp) == 0) { do_call(function, CBase, nResults, CBase); CnResults = (top-stack) - CBase; /* number of results */ CBase += CnResults; /* incorporate results on the stack */ status = 0; } else { CBase = oldCBase; top = stack+CBase; status = 1; } errorJmp = oldErr; return status; } static int do_protectedmain (void) { Byte *code = NULL; int status; int oldCBase = CBase; jmp_buf myErrorJmp; jmp_buf *oldErr = errorJmp; errorJmp = &myErrorJmp; if (setjmp(myErrorJmp) == 0) { Object f; lua_parse(&code); tag(&f) = LUA_T_FUNCTION; bvalue(&f) = code; do_call(&f, CBase, 0, CBase); status = 0; } else status = 1; if (code) luaI_free(code); errorJmp = oldErr; CBase = oldCBase; top = stack+CBase; return status; } /* ** Execute the given lua function. Return 0 on success or 1 on error. */ int lua_callfunction (lua_Object function) { if (function == NULL) return 1; else return do_protectedrun (Address(function), MULT_RET); } int lua_call (char *funcname) { int n = luaI_findsymbolbyname(funcname); return do_protectedrun(&s_object(n), MULT_RET); } /* ** Open file, generate opcode and execute global statement. Return 0 on ** success or 1 on error. */ int lua_dofile (char *filename) { int status; char *message = lua_openfile (filename); if (message) { lua_message(message); return 1; } status = do_protectedmain(); lua_closefile(); return status; } /* ** Generate opcode stored on string and execute global statement. Return 0 on ** success or 1 on error. */ int lua_dostring (char *string) { int status; char *message = lua_openstring(string); if (message) { lua_message(message); return 1; } status = do_protectedmain(); lua_closestring(); return status; } /* ** API: set a function as a fallback */ lua_Object lua_setfallback (char *name, lua_CFunction fallback) { static Object func = {LUA_T_CFUNCTION, luaI_setfallback}; adjustC(0); lua_pushstring(name); lua_pushcfunction(fallback); do_protectedrun(&func, 1); return (Ref(top-1)); } /* ** API: receives on the stack the table and the index. ** returns the value. */ lua_Object lua_getsubscript (void) { static Byte code[2] = {PUSHINDEXED, RETCODE0}; int status; Object func; tag(&func) = LUA_T_FUNCTION; bvalue(&func) = code; adjustC(2); status = do_protectedrun(&func, 1); if (status == 0) return (Ref(top-1)); else return 0; } /* ** API: receives on the stack the table, the index, and the new value. */ int lua_storesubscript (void) { static Byte code[2] = {STOREINDEXED, RETCODE0}; Object func; tag(&func) = LUA_T_FUNCTION; bvalue(&func) = code; adjustC(3); return(do_protectedrun(&func, 0)); } /* ** API: creates a new table */ lua_Object lua_createTable (int initSize) { adjustC(0); tag(top) = LUA_T_ARRAY; avalue(top) = lua_createarray(initSize); top++; CBase++; /* incorporate object in the stack */ return Ref(top-1); } /* ** Get a parameter, returning the object handle or 0 on error. ** 'number' must be 1 to get the first parameter. */ lua_Object lua_getparam (int number) { if (number <= 0 || number > CnResults) return 0; /* Ref(stack+(CBase-CnResults+number-1)) == stack+(CBase-CnResults+number-1)-stack+1 == */ return CBase-CnResults+number; } /* ** Given an object handle, return its number value. On error, return 0.0. */ real lua_getnumber (lua_Object object) { if (object == 0 || tag(Address(object)) == LUA_T_NIL) 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 == 0 || tag(Address(object)) == LUA_T_NIL) return NULL; if (tostring (Address(object))) return NULL; else return (svalue(Address(object))); } /* ** Given an object handle, return a copy of its string. On error, return NULL. */ char *lua_copystring (lua_Object object) { if (object == 0 || tag(Address(object)) == LUA_T_NIL) return NULL; if (tostring (Address(object))) return NULL; else return (strdup(svalue(Address(object)))); } /* ** Given an object handle, return its cfuntion pointer. On error, return NULL. */ lua_CFunction lua_getcfunction (lua_Object object) { if (object == 0) return NULL; if (tag(Address(object)) != LUA_T_CFUNCTION) return NULL; else return (fvalue(Address(object))); } /* ** Given an object handle, return its user data. On error, return NULL. */ void *lua_getuserdata (lua_Object object) { if (object == 0) return NULL; if (tag(Address(object)) != LUA_T_USERDATA) return NULL; else return (uvalue(Address(object))); } lua_Object lua_getlocked (int ref) { adjustC(0); *top = *luaI_getlocked(ref); top++; CBase++; /* incorporate object in the stack */ return Ref(top-1); } /* ** Get a global object. Return the object handle or NULL on error. */ lua_Object lua_getglobal (char *name) { int n = luaI_findsymbolbyname(name); adjustC(0); *top = s_object(n); top++; CBase++; /* incorporate object in the stack */ return Ref(top-1); } /* ** Store top of the stack at a global variable array field. ** Return 1 on error, 0 on success. */ int lua_storeglobal (char *name) { int n = luaI_findsymbolbyname(name); if (n < 0) return 1; adjustC(1); s_object(n) = *(--top); return 0; } /* ** Push a nil object */ int lua_pushnil (void) { lua_checkstack(top-stack+1); tag(top++) = LUA_T_NIL; return 0; } /* ** Push an object (tag=number) to stack. Return 0 on success or 1 on error. */ int lua_pushnumber (real n) { lua_checkstack(top-stack+1); tag(top) = LUA_T_NUMBER; nvalue(top++) = n; return 0; } /* ** Push an object (tag=string) to stack. Return 0 on success or 1 on error. */ int lua_pushstring (char *s) { lua_checkstack(top-stack+1); tag(top) = LUA_T_STRING; svalue(top++) = lua_createstring(s); return 0; } /* ** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error. */ int lua_pushcfunction (lua_CFunction fn) { lua_checkstack(top-stack+1); tag(top) = LUA_T_CFUNCTION; fvalue(top++) = fn; return 0; } /* ** Push an object (tag=userdata) to stack. Return 0 on success or 1 on error. */ int lua_pushuserdata (void *u) { lua_checkstack(top-stack+1); tag(top) = LUA_T_USERDATA; uvalue(top++) = u; return 0; } /* ** Push a lua_Object to stack. */ int lua_pushobject (lua_Object o) { lua_checkstack(top-stack+1); *top++ = *Address(o); return 0; } /* ** Push an object on the stack. */ void luaI_pushobject (Object *o) { lua_checkstack(top-stack+1); *top++ = *o; } int lua_type (lua_Object o) { if (o == 0) return LUA_T_NIL; else return tag(Address(o)); } void luaI_gcFB (Object *o) { *(top++) = *o; do_call(&luaI_fallBacks[FB_GC].function, (top-stack)-1, 0, (top-stack)-1); } static void call_arith (char *op) { lua_pushstring(op); do_call(&luaI_fallBacks[FB_ARITH].function, (top-stack)-3, 1, (top-stack)-3); } static void comparison (lua_Type tag_less, lua_Type tag_equal, lua_Type tag_great, char *op) { Object *l = top-2; Object *r = top-1; int result; if (tag(l) == LUA_T_NUMBER && tag(r) == LUA_T_NUMBER) result = (nvalue(l) < nvalue(r)) ? -1 : (nvalue(l) == nvalue(r)) ? 0 : 1; else if (tostring(l) || tostring(r)) { lua_pushstring(op); do_call(&luaI_fallBacks[FB_ORDER].function, (top-stack)-3, 1, (top-stack)-3); return; } else result = strcmp(svalue(l), svalue(r)); top--; nvalue(top-1) = 1; tag(top-1) = (result < 0) ? tag_less : (result == 0) ? tag_equal : tag_great; } /* ** Execute the given opcode, until a RET. Parameters are between ** [stack+base,top). Returns n such that the the results are between ** [stack+n,top). */ static int lua_execute (Byte *pc, int base) { lua_checkstack(STACKGAP+MAX_TEMPS+base); while (1) { OpCode opcode; switch (opcode = (OpCode)*pc++) { case PUSHNIL: tag(top++) = LUA_T_NIL; break; case PUSH0: case PUSH1: case PUSH2: tag(top) = LUA_T_NUMBER; nvalue(top++) = opcode-PUSH0; break; case PUSHBYTE: tag(top) = LUA_T_NUMBER; nvalue(top++) = *pc++; break; case PUSHWORD: { CodeWord code; get_word(code,pc); tag(top) = LUA_T_NUMBER; nvalue(top++) = code.w; } break; case PUSHFLOAT: { CodeFloat code; get_float(code,pc); tag(top) = LUA_T_NUMBER; nvalue(top++) = code.f; } break; case PUSHSTRING: { CodeWord code; get_word(code,pc); tag(top) = LUA_T_STRING; svalue(top++) = lua_constant[code.w]; } break; case PUSHFUNCTION: { CodeCode code; get_code(code,pc); tag(top) = LUA_T_FUNCTION; bvalue(top++) = code.b; } 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)); break; case PUSHLOCAL: *top++ = *((stack+base) + (*pc++)); break; case PUSHGLOBAL: { CodeWord code; get_word(code,pc); *top++ = s_object(code.w); } break; case PUSHINDEXED: pushsubscript(); break; case PUSHSELF: { Object receiver = *(top-2); pushsubscript(); *(top++) = receiver; 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: { CodeWord code; get_word(code,pc); s_object(code.w) = *(--top); } break; case STOREINDEXED0: storesubscript(); break; case STOREINDEXED: { int n = *pc++; if (tag(top-3-n) != LUA_T_ARRAY) { *(top+1) = *(top-1); *(top) = *(top-2-n); *(top-1) = *(top-3-n); top += 2; do_call(&luaI_fallBacks[FB_SETTABLE].function, (top-stack)-3, 0, (top-stack)-3); } else { Object *h = lua_hashdefine (avalue(top-3-n), top-2-n); *h = *(top-1); top--; } } break; case STORELIST0: case STORELIST: { int m, n; Object *arr; if (opcode == STORELIST0) m = 0; else m = *(pc++) * FIELDS_PER_FLUSH; n = *(pc++); arr = top-n-1; while (n) { tag(top) = LUA_T_NUMBER; nvalue(top) = n+m; *(lua_hashdefine (avalue(arr), top)) = *(top-1); top--; n--; } } break; case STORERECORD: { int n = *(pc++); Object *arr = top-n-1; while (n) { CodeWord code; get_word(code,pc); tag(top) = LUA_T_STRING; svalue(top) = lua_constant[code.w]; *(lua_hashdefine (avalue(arr), top)) = *(top-1); top--; n--; } } break; case ADJUST0: adjust_top(base); break; case ADJUST: adjust_top(base + *(pc++)); break; case CREATEARRAY: { CodeWord size; get_word(size,pc); tag(top) = LUA_T_ARRAY; avalue(top) = lua_createarray(size.w); top++; } break; case EQOP: { int res = lua_equalObj(top-2, top-1); --top; tag(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, "<"); break; case LEOP: comparison(LUA_T_NUMBER, LUA_T_NUMBER, LUA_T_NIL, "<="); break; case GTOP: comparison(LUA_T_NIL, LUA_T_NIL, LUA_T_NUMBER, ">"); break; case GEOP: comparison(LUA_T_NIL, LUA_T_NUMBER, LUA_T_NUMBER, ">="); break; case ADDOP: { Object *l = top-2; Object *r = top-1; if (tonumber(r) || tonumber(l)) call_arith("+"); else { nvalue(l) += nvalue(r); --top; } } break; case SUBOP: { Object *l = top-2; Object *r = top-1; if (tonumber(r) || tonumber(l)) call_arith("-"); else { nvalue(l) -= nvalue(r); --top; } } break; case MULTOP: { Object *l = top-2; Object *r = top-1; if (tonumber(r) || tonumber(l)) call_arith("*"); else { nvalue(l) *= nvalue(r); --top; } } break; case DIVOP: { Object *l = top-2; Object *r = top-1; if (tonumber(r) || tonumber(l)) call_arith("/"); else { nvalue(l) /= nvalue(r); --top; } } break; case POWOP: { Object *l = top-2; Object *r = top-1; if (tonumber(r) || tonumber(l)) call_arith("^"); else { nvalue(l) = pow(nvalue(l), nvalue(r)); --top; } } break; case CONCOP: { Object *l = top-2; Object *r = top-1; if (tostring(r) || tostring(l)) do_call(&luaI_fallBacks[FB_CONCAT].function, (top-stack)-2, 1, (top-stack)-2); else { svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r))); --top; } } break; case MINUSOP: if (tonumber(top-1)) do_call(&luaI_fallBacks[FB_UNMINUS].function, (top-stack)-1, 1, (top-stack)-1); else nvalue(top-1) = - nvalue(top-1); break; case NOTOP: tag(top-1) = (tag(top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL; nvalue(top-1) = 1; break; case ONTJMP: { CodeWord code; get_word(code,pc); if (tag(top-1) != LUA_T_NIL) pc += code.w; } break; case ONFJMP: { CodeWord code; get_word(code,pc); if (tag(top-1) == LUA_T_NIL) pc += code.w; } break; case JMP: { CodeWord code; get_word(code,pc); pc += code.w; } break; case UPJMP: { CodeWord code; get_word(code,pc); pc -= code.w; } break; case IFFJMP: { CodeWord code; get_word(code,pc); top--; if (tag(top) == LUA_T_NIL) pc += code.w; } break; case IFFUPJMP: { CodeWord code; get_word(code,pc); top--; if (tag(top) == LUA_T_NIL) pc -= code.w; } break; case POP: --top; break; case CALLFUNC: { int nParams = *(pc++); int nResults = *(pc++); Object *func = top-1-nParams; /* function is below parameters */ int newBase = (top-stack)-nParams; do_call(func, newBase, nResults, newBase-1); } break; case RETCODE0: return base; case RETCODE: return base+*pc; case SETFUNCTION: { CodeCode file; CodeWord func; get_code(file,pc); get_word(func,pc); lua_pushfunction ((char *)file.b, func.w); } break; case SETLINE: { CodeWord code; get_word(code,pc); lua_debugline = code.w; } break; case RESET: lua_popfunction (); break; default: lua_error ("internal error - opcode doesn't match"); } } }