diff options
Diffstat (limited to 'opcode.c')
| -rw-r--r-- | opcode.c | 933 |
1 files changed, 933 insertions, 0 deletions
diff --git a/opcode.c b/opcode.c new file mode 100644 index 00000000..97975ba1 --- /dev/null +++ b/opcode.c @@ -0,0 +1,933 @@ +/* +** opcode.c +** TecCGraf - PUC-Rio +** 26 Apr 93 +*/ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#ifdef __GNUC__ +#include <floatingpoint.h> +#endif + +#include "opcode.h" +#include "hash.h" +#include "inout.h" +#include "table.h" +#include "lua.h" + +#define tonumber(o) ((tag(o) != T_NUMBER) && (lua_tonumber(o) != 0)) +#define tostring(o) ((tag(o) != T_STRING) && (lua_tostring(o) != 0)) + +#ifndef MAXSTACK +#define MAXSTACK 256 +#endif +static Object stack[MAXSTACK] = {{T_MARK, {NULL}}}; +static Object *top=stack+1, *base=stack+1; + + +/* +** Concatenate two given string, creating a mark space at the beginning. +** Return the new string pointer. +*/ +static char *lua_strconc (char *l, char *r) +{ + char *s = calloc (strlen(l)+strlen(r)+2, sizeof(char)); + if (s == NULL) + { + lua_error ("not enough memory"); + return NULL; + } + *s++ = 0; /* create mark space */ + return strcat(strcpy(s,l),r); +} + +/* +** Duplicate a string, creating a mark space at the beginning. +** Return the new string pointer. +*/ +char *lua_strdup (char *l) +{ + char *s = calloc (strlen(l)+2, sizeof(char)); + if (s == NULL) + { + lua_error ("not enough memory"); + return NULL; + } + *s++ = 0; /* create mark space */ + return strcpy(s,l); +} + +/* +** Convert, if possible, to a number tag. +** Return 0 in success or not 0 on error. +*/ +static int lua_tonumber (Object *obj) +{ + char *ptr; + if (tag(obj) != T_STRING) + { + lua_reportbug ("unexpected type at conversion to number"); + return 1; + } + nvalue(obj) = strtod(svalue(obj), &ptr); + if (*ptr) + { + lua_reportbug ("string to number convertion failed"); + return 2; + } + tag(obj) = T_NUMBER; + return 0; +} + +/* +** Test if is possible to convert an object to a number one. +** If possible, return the converted object, otherwise return nil object. +*/ +static Object *lua_convtonumber (Object *obj) +{ + static Object cvt; + + if (tag(obj) == T_NUMBER) + { + cvt = *obj; + return &cvt; + } + + tag(&cvt) = T_NIL; + if (tag(obj) == T_STRING) + { + char *ptr; + nvalue(&cvt) = strtod(svalue(obj), &ptr); + if (*ptr == 0) + tag(&cvt) = T_NUMBER; + } + return &cvt; +} + + + +/* +** 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) != T_NUMBER) + { + lua_reportbug ("unexpected type at conversion to string"); + return 1; + } + if ((int) nvalue(obj) == nvalue(obj)) + sprintf (s, "%d", (int) nvalue(obj)); + else + sprintf (s, "%g", nvalue(obj)); + svalue(obj) = lua_createstring(lua_strdup(s)); + if (svalue(obj) == NULL) + return 1; + tag(obj) = T_STRING; + return 0; +} + + +/* +** Execute the given opcode. Return 0 in success or 1 on error. +*/ +int lua_execute (Byte *pc) +{ + while (1) + { + switch ((OpCode)*pc++) + { + case NOP: break; + + case PUSHNIL: tag(top++) = T_NIL; break; + + case PUSH0: tag(top) = T_NUMBER; nvalue(top++) = 0; break; + case PUSH1: tag(top) = T_NUMBER; nvalue(top++) = 1; break; + case PUSH2: tag(top) = T_NUMBER; nvalue(top++) = 2; break; + + case PUSHBYTE: tag(top) = T_NUMBER; nvalue(top++) = *pc++; break; + + case PUSHWORD: + tag(top) = T_NUMBER; nvalue(top++) = *((Word *)(pc)); pc += sizeof(Word); + break; + + case PUSHFLOAT: + tag(top) = T_NUMBER; nvalue(top++) = *((float *)(pc)); pc += sizeof(float); + break; + case PUSHSTRING: + { + int w = *((Word *)(pc)); + pc += sizeof(Word); + tag(top) = T_STRING; svalue(top++) = lua_constant[w]; + } + break; + + case PUSHLOCAL0: *top++ = *(base + 0); break; + case PUSHLOCAL1: *top++ = *(base + 1); break; + case PUSHLOCAL2: *top++ = *(base + 2); break; + case PUSHLOCAL3: *top++ = *(base + 3); break; + case PUSHLOCAL4: *top++ = *(base + 4); break; + case PUSHLOCAL5: *top++ = *(base + 5); break; + case PUSHLOCAL6: *top++ = *(base + 6); break; + case PUSHLOCAL7: *top++ = *(base + 7); break; + case PUSHLOCAL8: *top++ = *(base + 8); break; + case PUSHLOCAL9: *top++ = *(base + 9); break; + + case PUSHLOCAL: *top++ = *(base + (*pc++)); break; + + case PUSHGLOBAL: + *top++ = s_object(*((Word *)(pc))); pc += sizeof(Word); + break; + + case PUSHINDEXED: + --top; + if (tag(top-1) != T_ARRAY) + { + lua_reportbug ("indexed expression not a table"); + return 1; + } + { + Object *h = lua_hashdefine (avalue(top-1), top); + if (h == NULL) return 1; + *(top-1) = *h; + } + break; + + case PUSHMARK: tag(top++) = T_MARK; break; + + case PUSHOBJECT: *top = *(top-3); top++; break; + + case STORELOCAL0: *(base + 0) = *(--top); break; + case STORELOCAL1: *(base + 1) = *(--top); break; + case STORELOCAL2: *(base + 2) = *(--top); break; + case STORELOCAL3: *(base + 3) = *(--top); break; + case STORELOCAL4: *(base + 4) = *(--top); break; + case STORELOCAL5: *(base + 5) = *(--top); break; + case STORELOCAL6: *(base + 6) = *(--top); break; + case STORELOCAL7: *(base + 7) = *(--top); break; + case STORELOCAL8: *(base + 8) = *(--top); break; + case STORELOCAL9: *(base + 9) = *(--top); break; + + case STORELOCAL: *(base + (*pc++)) = *(--top); break; + + case STOREGLOBAL: + s_object(*((Word *)(pc))) = *(--top); pc += sizeof(Word); + break; + + case STOREINDEXED0: + if (tag(top-3) != T_ARRAY) + { + lua_reportbug ("indexed expression not a table"); + return 1; + } + { + Object *h = lua_hashdefine (avalue(top-3), top-2); + if (h == NULL) return 1; + *h = *(top-1); + } + top -= 3; + break; + + case STOREINDEXED: + { + int n = *pc++; + if (tag(top-3-n) != T_ARRAY) + { + lua_reportbug ("indexed expression not a table"); + return 1; + } + { + Object *h = lua_hashdefine (avalue(top-3-n), top-2-n); + if (h == NULL) return 1; + *h = *(top-1); + } + --top; + } + break; + + case STOREFIELD: + if (tag(top-3) != T_ARRAY) + { + lua_error ("internal error - table expected"); + return 1; + } + *(lua_hashdefine (avalue(top-3), top-2)) = *(top-1); + top -= 2; + break; + + case ADJUST: + { + Object *newtop = base + *(pc++); + if (top != newtop) + { + while (top < newtop) tag(top++) = T_NIL; + top = newtop; + } + } + break; + + case CREATEARRAY: + if (tag(top-1) == T_NIL) + nvalue(top-1) = 101; + else + { + if (tonumber(top-1)) return 1; + if (nvalue(top-1) <= 0) nvalue(top-1) = 101; + } + avalue(top-1) = lua_createarray(lua_hashcreate(nvalue(top-1))); + if (avalue(top-1) == NULL) + return 1; + tag(top-1) = T_ARRAY; + break; + + case EQOP: + { + Object *l = top-2; + Object *r = top-1; + --top; + if (tag(l) != tag(r)) + tag(top-1) = T_NIL; + else + { + switch (tag(l)) + { + case T_NIL: tag(top-1) = T_NUMBER; break; + case T_NUMBER: tag(top-1) = (nvalue(l) == nvalue(r)) ? T_NUMBER : T_NIL; break; + case T_ARRAY: tag(top-1) = (avalue(l) == avalue(r)) ? T_NUMBER : T_NIL; break; + case T_FUNCTION: tag(top-1) = (bvalue(l) == bvalue(r)) ? T_NUMBER : T_NIL; break; + case T_CFUNCTION: tag(top-1) = (fvalue(l) == fvalue(r)) ? T_NUMBER : T_NIL; break; + case T_USERDATA: tag(top-1) = (uvalue(l) == uvalue(r)) ? T_NUMBER : T_NIL; break; + case T_STRING: tag(top-1) = (strcmp (svalue(l), svalue(r)) == 0) ? T_NUMBER : T_NIL; break; + case T_MARK: return 1; + } + } + nvalue(top-1) = 1; + } + break; + + case LTOP: + { + Object *l = top-2; + Object *r = top-1; + --top; + if (tag(l) == T_NUMBER && tag(r) == T_NUMBER) + tag(top-1) = (nvalue(l) < nvalue(r)) ? T_NUMBER : T_NIL; + else + { + if (tostring(l) || tostring(r)) + return 1; + tag(top-1) = (strcmp (svalue(l), svalue(r)) < 0) ? T_NUMBER : T_NIL; + } + nvalue(top-1) = 1; + } + break; + + case LEOP: + { + Object *l = top-2; + Object *r = top-1; + --top; + if (tag(l) == T_NUMBER && tag(r) == T_NUMBER) + tag(top-1) = (nvalue(l) <= nvalue(r)) ? T_NUMBER : T_NIL; + else + { + if (tostring(l) || tostring(r)) + return 1; + tag(top-1) = (strcmp (svalue(l), svalue(r)) <= 0) ? T_NUMBER : T_NIL; + } + nvalue(top-1) = 1; + } + break; + + case ADDOP: + { + Object *l = top-2; + Object *r = top-1; + if (tonumber(r) || tonumber(l)) + return 1; + nvalue(l) += nvalue(r); + --top; + } + break; + + case SUBOP: + { + Object *l = top-2; + Object *r = top-1; + if (tonumber(r) || tonumber(l)) + return 1; + nvalue(l) -= nvalue(r); + --top; + } + break; + + case MULTOP: + { + Object *l = top-2; + Object *r = top-1; + if (tonumber(r) || tonumber(l)) + return 1; + nvalue(l) *= nvalue(r); + --top; + } + break; + + case DIVOP: + { + Object *l = top-2; + Object *r = top-1; + if (tonumber(r) || tonumber(l)) + return 1; + nvalue(l) /= nvalue(r); + --top; + } + break; + + case CONCOP: + { + Object *l = top-2; + Object *r = top-1; + if (tostring(r) || tostring(l)) + return 1; + svalue(l) = lua_createstring (lua_strconc(svalue(l),svalue(r))); + if (svalue(l) == NULL) + return 1; + --top; + } + break; + + case MINUSOP: + if (tonumber(top-1)) + return 1; + nvalue(top-1) = - nvalue(top-1); + break; + + case NOTOP: + tag(top-1) = tag(top-1) == T_NIL ? T_NUMBER : T_NIL; + break; + + case ONTJMP: + { + int n = *((Word *)(pc)); + pc += sizeof(Word); + if (tag(top-1) != T_NIL) pc += n; + } + break; + + case ONFJMP: + { + int n = *((Word *)(pc)); + pc += sizeof(Word); + if (tag(top-1) == T_NIL) pc += n; + } + break; + + case JMP: pc += *((Word *)(pc)) + sizeof(Word); break; + + case UPJMP: pc -= *((Word *)(pc)) - sizeof(Word); break; + + case IFFJMP: + { + int n = *((Word *)(pc)); + pc += sizeof(Word); + top--; + if (tag(top) == T_NIL) pc += n; + } + break; + + case IFFUPJMP: + { + int n = *((Word *)(pc)); + pc += sizeof(Word); + top--; + if (tag(top) == T_NIL) pc -= n; + } + break; + + case POP: --top; break; + + case CALLFUNC: + { + Byte *newpc; + Object *b = top-1; + while (tag(b) != T_MARK) b--; + if (tag(b-1) == T_FUNCTION) + { + lua_debugline = 0; /* always reset debug flag */ + newpc = bvalue(b-1); + bvalue(b-1) = pc; /* store return code */ + nvalue(b) = (base-stack); /* store base value */ + base = b+1; + pc = newpc; + if (MAXSTACK-(base-stack) < STACKGAP) + { + lua_error ("stack overflow"); + return 1; + } + } + else if (tag(b-1) == T_CFUNCTION) + { + int nparam; + lua_debugline = 0; /* always reset debug flag */ + nvalue(b) = (base-stack); /* store base value */ + base = b+1; + nparam = top-base; /* number of parameters */ + (fvalue(b-1))(); /* call C function */ + + /* shift returned values */ + { + int i; + int nretval = top - base - nparam; + top = base - 2; + base = stack + (int) nvalue(base-1); + for (i=0; i<nretval; i++) + { + *top = *(top+nparam+2); + ++top; + } + } + } + else + { + lua_reportbug ("call expression not a function"); + return 1; + } + } + break; + + case RETCODE: + { + int i; + int shift = *pc++; + int nretval = top - base - shift; + top = base - 2; + pc = bvalue(base-2); + base = stack + (int) nvalue(base-1); + for (i=0; i<nretval; i++) + { + *top = *(top+shift+2); + ++top; + } + } + break; + + case HALT: + return 0; /* success */ + + case SETFUNCTION: + { + int file, func; + file = *((Word *)(pc)); + pc += sizeof(Word); + func = *((Word *)(pc)); + pc += sizeof(Word); + if (lua_pushfunction (file, func)) + return 1; + } + break; + + case SETLINE: + lua_debugline = *((Word *)(pc)); + pc += sizeof(Word); + break; + + case RESET: + lua_popfunction (); + break; + + default: + lua_error ("internal error - opcode didn't match"); + return 1; + } + } +} + + +/* +** Mark all strings and arrays used by any object stored at stack. +*/ +void lua_markstack (void) +{ + Object *o; + for (o = top-1; o >= stack; o--) + lua_markobject (o); +} + +/* +** Open file, generate opcode and execute global statement. Return 0 on +** success or 1 on error. +*/ +int lua_dofile (char *filename) +{ + if (lua_openfile (filename)) return 1; + if (lua_parse ()) { lua_closefile (); return 1; } + lua_closefile (); + return 0; +} + +/* +** Generate opcode stored on string and execute global statement. Return 0 on +** success or 1 on error. +*/ +int lua_dostring (char *string) +{ + if (lua_openstring (string)) return 1; + if (lua_parse ()) return 1; + return 0; +} + +/* +** Execute the given function. Return 0 on success or 1 on error. +*/ +int lua_call (char *functionname, int nparam) +{ + static Byte startcode[] = {CALLFUNC, HALT}; + int i; + Object func = s_object(lua_findsymbol(functionname)); + if (tag(&func) != T_FUNCTION) return 1; + for (i=1; i<=nparam; i++) + *(top-i+2) = *(top-i); + top += 2; + tag(top-nparam-1) = T_MARK; + *(top-nparam-2) = func; + return (lua_execute (startcode)); +} + +/* +** Get a parameter, returning the object handle or NULL on error. +** 'number' must be 1 to get the first parameter. +*/ +Object *lua_getparam (int number) +{ + if (number <= 0 || number > top-base) return NULL; + return (base+number-1); +} + +/* +** Given an object handle, return its number value. On error, return 0.0. +*/ +real lua_getnumber (Object *object) +{ + if (tonumber (object)) return 0.0; + else return (nvalue(object)); +} + +/* +** Given an object handle, return its string pointer. On error, return NULL. +*/ +char *lua_getstring (Object *object) +{ + if (tostring (object)) return NULL; + else return (svalue(object)); +} + +/* +** Given an object handle, return a copy of its string. On error, return NULL. +*/ +char *lua_copystring (Object *object) +{ + if (tostring (object)) return NULL; + else return (strdup(svalue(object))); +} + +/* +** Given an object handle, return its cfuntion pointer. On error, return NULL. +*/ +lua_CFunction lua_getcfunction (Object *object) +{ + if (tag(object) != T_CFUNCTION) return NULL; + else return (fvalue(object)); +} + +/* +** Given an object handle, return its user data. On error, return NULL. +*/ +void *lua_getuserdata (Object *object) +{ + if (tag(object) != T_USERDATA) return NULL; + else return (uvalue(object)); +} + +/* +** Given an object handle and a field name, return its field object. +** On error, return NULL. +*/ +Object *lua_getfield (Object *object, char *field) +{ + if (tag(object) != T_ARRAY) + return NULL; + else + { + Object ref; + tag(&ref) = T_STRING; + svalue(&ref) = lua_createstring(lua_strdup(field)); + return (lua_hashdefine(avalue(object), &ref)); + } +} + +/* +** Given an object handle and an index, return its indexed object. +** On error, return NULL. +*/ +Object *lua_getindexed (Object *object, float index) +{ + if (tag(object) != T_ARRAY) + return NULL; + else + { + Object ref; + tag(&ref) = T_NUMBER; + nvalue(&ref) = index; + return (lua_hashdefine(avalue(object), &ref)); + } +} + +/* +** Get a global object. Return the object handle or NULL on error. +*/ +Object *lua_getglobal (char *name) +{ + int n = lua_findsymbol(name); + if (n < 0) return NULL; + return &s_object(n); +} + +/* +** Pop and return an object +*/ +Object *lua_pop (void) +{ + if (top <= base) return NULL; + top--; + return top; +} + +/* +** Push a nil object +*/ +int lua_pushnil (void) +{ + if ((top-stack) >= MAXSTACK-1) + { + lua_error ("stack overflow"); + return 1; + } + tag(top) = T_NIL; + return 0; +} + +/* +** Push an object (tag=number) to stack. Return 0 on success or 1 on error. +*/ +int lua_pushnumber (real n) +{ + if ((top-stack) >= MAXSTACK-1) + { + lua_error ("stack overflow"); + return 1; + } + tag(top) = 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) +{ + if ((top-stack) >= MAXSTACK-1) + { + lua_error ("stack overflow"); + return 1; + } + tag(top) = T_STRING; + svalue(top++) = lua_createstring(lua_strdup(s)); + return 0; +} + +/* +** Push an object (tag=cfunction) to stack. Return 0 on success or 1 on error. +*/ +int lua_pushcfunction (lua_CFunction fn) +{ + if ((top-stack) >= MAXSTACK-1) + { + lua_error ("stack overflow"); + return 1; + } + tag(top) = 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) +{ + if ((top-stack) >= MAXSTACK-1) + { + lua_error ("stack overflow"); + return 1; + } + tag(top) = T_USERDATA; uvalue(top++) = u; + return 0; +} + +/* +** Push an object to stack. +*/ +int lua_pushobject (Object *o) +{ + if ((top-stack) >= MAXSTACK-1) + { + lua_error ("stack overflow"); + return 1; + } + *top++ = *o; + return 0; +} + +/* +** 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 = lua_findsymbol (name); + if (n < 0) return 1; + if (tag(top-1) == T_MARK) return 1; + s_object(n) = *(--top); + return 0; +} + +/* +** Store top of the stack at an array field. Return 1 on error, 0 on success. +*/ +int lua_storefield (lua_Object object, char *field) +{ + if (tag(object) != T_ARRAY) + return 1; + else + { + Object ref, *h; + tag(&ref) = T_STRING; + svalue(&ref) = lua_createstring(lua_strdup(field)); + h = lua_hashdefine(avalue(object), &ref); + if (h == NULL) return 1; + if (tag(top-1) == T_MARK) return 1; + *h = *(--top); + } + return 0; +} + + +/* +** Store top of the stack at an array index. Return 1 on error, 0 on success. +*/ +int lua_storeindexed (lua_Object object, float index) +{ + if (tag(object) != T_ARRAY) + return 1; + else + { + Object ref, *h; + tag(&ref) = T_NUMBER; + nvalue(&ref) = index; + h = lua_hashdefine(avalue(object), &ref); + if (h == NULL) return 1; + if (tag(top-1) == T_MARK) return 1; + *h = *(--top); + } + return 0; +} + + +/* +** Given an object handle, return if it is nil. +*/ +int lua_isnil (Object *object) +{ + return (object != NULL && tag(object) == T_NIL); +} + +/* +** Given an object handle, return if it is a number one. +*/ +int lua_isnumber (Object *object) +{ + return (object != NULL && tag(object) == T_NUMBER); +} + +/* +** Given an object handle, return if it is a string one. +*/ +int lua_isstring (Object *object) +{ + return (object != NULL && tag(object) == T_STRING); +} + +/* +** Given an object handle, return if it is an array one. +*/ +int lua_istable (Object *object) +{ + return (object != NULL && tag(object) == T_ARRAY); +} + +/* +** Given an object handle, return if it is a cfunction one. +*/ +int lua_iscfunction (Object *object) +{ + return (object != NULL && tag(object) == T_CFUNCTION); +} + +/* +** Given an object handle, return if it is an user data one. +*/ +int lua_isuserdata (Object *object) +{ + return (object != NULL && tag(object) == T_USERDATA); +} + +/* +** Internal function: return an object type. +*/ +void lua_type (void) +{ + Object *o = lua_getparam(1); + lua_pushstring (lua_constant[tag(o)]); +} + +/* +** Internal function: convert an object to a number +*/ +void lua_obj2number (void) +{ + Object *o = lua_getparam(1); + lua_pushobject (lua_convtonumber(o)); +} + +/* +** Internal function: print object values +*/ +void lua_print (void) +{ + int i=1; + void *obj; + while ((obj=lua_getparam (i++)) != NULL) + { + if (lua_isnumber(obj)) printf("%g\n",lua_getnumber (obj)); + else if (lua_isstring(obj)) printf("%s\n",lua_getstring (obj)); + else if (lua_iscfunction(obj)) printf("cfunction: %p\n",lua_getcfunction (obj)); + else if (lua_isuserdata(obj)) printf("userdata: %p\n",lua_getuserdata (obj)); + else if (lua_istable(obj)) printf("table: %p\n",obj); + else if (lua_isnil(obj)) printf("nil\n"); + else printf("invalid value to print\n"); + } +} + |