diff --git a/lvm.c b/lvm.c new file mode 100644 index 00000000..8993056b --- /dev/null +++ b/lvm.c @@ -0,0 +1,655 @@ +/* +** $Id: $ +** Lua virtual machine +** See Copyright Notice in lua.h +*/ + + +#include +#include + +#include "lauxlib.h" +#include "ldo.h" +#include "lfunc.h" +#include "lgc.h" +#include "lglobal.h" +#include "lmem.h" +#include "lopcodes.h" +#include "lstring.h" +#include "ltable.h" +#include "ltm.h" +#include "luadebug.h" +#include "lvm.h" + + +#define get_word(w,pc) {w=*pc+(*(pc+1)<<8); pc+=2;} + + +/* Extra stack to run a function: LUA_T_LINE(1), TM calls(2), ... */ +#define EXTRA_STACK 4 + + + +static TaggedString *strconc (char *l, char *r) +{ + size_t nl = strlen(l); + char *buffer = luaM_buffer(nl+strlen(r)+1); + strcpy(buffer, l); + strcpy(buffer+nl, r); + return luaS_new(buffer); +} + + +int luaV_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; +} + + +int luaV_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) = luaS_new(s); + ttype(obj) = LUA_T_STRING; + return 0; + } +} + + +void luaV_closure (void) +{ + int nelems = (luaD_stack.top-1)->value.tf->nupvalues; + Closure *c = luaF_newclosure(nelems); + c->consts[0] = *(luaD_stack.top-1); + memcpy(&c->consts[1], luaD_stack.top-(nelems+1), nelems*sizeof(TObject)); + luaD_stack.top -= nelems; + ttype(luaD_stack.top-1) = LUA_T_FUNCTION; + (luaD_stack.top-1)->value.cl = c; +} + + +/* +** Function to index a table. +** Receives the table at top-2 and the index at top-1. +*/ +void luaV_gettable (void) +{ + TObject *im; + if (ttype(luaD_stack.top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */ + im = luaT_getimbyObj(luaD_stack.top-2, IM_GETTABLE); + else { /* object is a table... */ + int tg = (luaD_stack.top-2)->value.a->htag; + im = luaT_getim(tg, IM_GETTABLE); + if (ttype(im) == LUA_T_NIL) { /* and does not have a "gettable" method */ + TObject *h = luaH_get(avalue(luaD_stack.top-2), luaD_stack.top-1); + if (h != NULL && ttype(h) != LUA_T_NIL) { + --luaD_stack.top; + *(luaD_stack.top-1) = *h; + } + else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL) + luaD_callTM(im, 2, 1); + else { + --luaD_stack.top; + ttype(luaD_stack.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) + luaD_callTM(im, 2, 1); + else + lua_error("indexed expression not a table"); +} + + +/* +** Function to store indexed based on values at the luaD_stack.top +** mode = 0: raw store (without internal methods) +** mode = 1: normal store (with internal methods) +** mode = 2: "deep luaD_stack.stack" store (with internal methods) +*/ +void luaV_settable (TObject *t, int mode) +{ + TObject *im = (mode == 0) ? NULL : luaT_getimbyObj(t, IM_SETTABLE); + if (ttype(t) == LUA_T_ARRAY && (im == NULL || ttype(im) == LUA_T_NIL)) { + TObject *h = luaH_set(avalue(t), t+1); + *h = *(luaD_stack.top-1); + luaD_stack.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) { + *(luaD_stack.top+1) = *(luaD_stack.top-1); + *(luaD_stack.top) = *(t+1); + *(luaD_stack.top-1) = *t; + luaD_stack.top += 2; /* WARNING: caller must assure stack space */ + } + luaD_callTM(im, 3, 0); + } + else + lua_error("indexed expression not a table"); + } +} + + +void luaV_getglobal (Word n) +{ + /* WARNING: caller must assure stack space */ + TObject *value = &luaG_global[n].object; + TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL); + if (ttype(im) == LUA_T_NIL) { /* default behavior */ + *luaD_stack.top = *value; + luaD_stack.top++; + } + else { + ttype(luaD_stack.top) = LUA_T_STRING; + tsvalue(luaD_stack.top) = luaG_global[n].varname; + luaD_stack.top++; + *luaD_stack.top = *value; + luaD_stack.top++; + luaD_callTM(im, 2, 1); + } +} + + +void luaV_setglobal (Word n) +{ + TObject *oldvalue = &luaG_global[n].object; + TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL); + if (ttype(im) == LUA_T_NIL) /* default behavior */ + s_object(n) = *(--luaD_stack.top); + else { + /* WARNING: caller must assure stack space */ + TObject newvalue = *(luaD_stack.top-1); + ttype(luaD_stack.top-1) = LUA_T_STRING; + tsvalue(luaD_stack.top-1) = luaG_global[n].varname; + *luaD_stack.top = *oldvalue; + luaD_stack.top++; + *luaD_stack.top = newvalue; + luaD_stack.top++; + luaD_callTM(im, 3, 0); + } +} + + +static void call_binTM (IMS event, char *msg) +{ + TObject *im = luaT_getimbyObj(luaD_stack.top-2, event);/* try first operand */ + if (ttype(im) == LUA_T_NIL) { + im = luaT_getimbyObj(luaD_stack.top-1, event); /* try second operand */ + if (ttype(im) == LUA_T_NIL) { + im = luaT_getim(0, event); /* try a 'global' i.m. */ + if (ttype(im) == LUA_T_NIL) + lua_error(msg); + } + } + lua_pushstring(luaT_eventname[event]); + luaD_callTM(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 = luaD_stack.top-2; + TObject *r = luaD_stack.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; + } + luaD_stack.top--; + nvalue(luaD_stack.top-1) = 1; + ttype(luaD_stack.top-1) = (result < 0) ? ttype_less : + (result == 0) ? ttype_equal : ttype_great; +} + + +void luaV_pack (StkId firstel, int nvararg, TObject *tab) +{ + TObject *firstelem = luaD_stack.stack+firstel; + int i; + if (nvararg < 0) nvararg = 0; + avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */ + ttype(tab) = LUA_T_ARRAY; + for (i=0; iconsts[0].value.tf; + Byte *pc = func->code; + if (lua_callhook) + luaD_callHook(base, LUA_T_MARK, 0); + luaD_checkstack((*pc++)+EXTRA_STACK); + while (1) { + OpCode opcode; + switch (opcode = (OpCode)*pc++) { + + case PUSHNIL: + ttype(luaD_stack.top) = LUA_T_NIL; + luaD_stack.top++; + break; + + case PUSHNILS: { + int n = *pc++; + while (n--) + ttype(luaD_stack.top++) = LUA_T_NIL; + break; + } + + case PUSH0: case PUSH1: case PUSH2: + ttype(luaD_stack.top) = LUA_T_NUMBER; + nvalue(luaD_stack.top) = opcode-PUSH0; + luaD_stack.top++; + break; + + case PUSHBYTE: + ttype(luaD_stack.top) = LUA_T_NUMBER; + nvalue(luaD_stack.top) = *pc++; + luaD_stack.top++; + break; + + case PUSHWORD: { + Word w; + get_word(w,pc); + ttype(luaD_stack.top) = LUA_T_NUMBER; + nvalue(luaD_stack.top) = w; + luaD_stack.top++; + break; + } + + case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: + case PUSHLOCAL3: case PUSHLOCAL4: case PUSHLOCAL5: + case PUSHLOCAL6: case PUSHLOCAL7: case PUSHLOCAL8: + case PUSHLOCAL9: + *luaD_stack.top = *((luaD_stack.stack+base) + (int)(opcode-PUSHLOCAL0)); + luaD_stack.top++; + break; + + case PUSHLOCAL: + *luaD_stack.top = *((luaD_stack.stack+base) + (*pc++)); + luaD_stack.top++; + break; + + case PUSHGLOBAL: { + Word w; + get_word(w,pc); + luaV_getglobal(w); + break; + } + + case PUSHTABLE: + luaV_gettable(); + break; + + case PUSHSELF: { + TObject receiver = *(luaD_stack.top-1); + Word w; + get_word(w,pc); + *luaD_stack.top = func->consts[w]; + luaD_stack.top++; + luaV_gettable(); + *luaD_stack.top = receiver; + luaD_stack.top++; + break; + } + + case PUSHCONSTANTB: { + *luaD_stack.top = func->consts[*pc++]; + luaD_stack.top++; + break; + } + + case PUSHCONSTANT: { + Word w; + get_word(w,pc); + *luaD_stack.top = func->consts[w]; + luaD_stack.top++; + break; + } + + case PUSHUPVALUE0: + case PUSHUPVALUE: { + int i = (opcode == PUSHUPVALUE0) ? 0 : *pc++; + *luaD_stack.top = cl->consts[i+1]; + luaD_stack.top++; + break; + } + + case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: + case SETLOCAL3: case SETLOCAL4: case SETLOCAL5: + case SETLOCAL6: case SETLOCAL7: case SETLOCAL8: + case SETLOCAL9: + *((luaD_stack.stack+base) + (int)(opcode-SETLOCAL0)) = + *(--luaD_stack.top); + break; + + case SETLOCAL: + *((luaD_stack.stack+base) + (*pc++)) = *(--luaD_stack.top); break; + + case SETGLOBAL: { + Word w; + get_word(w,pc); + luaV_setglobal(w); + break; + } + + case SETTABLE0: + luaV_settable(luaD_stack.top-3, 1); + break; + + case SETTABLE: { + int n = *pc++; + luaV_settable(luaD_stack.top-3-n, 2); + break; + } + + case SETLIST0: + case SETLIST: { + int m, n; + TObject *arr; + if (opcode == SETLIST0) m = 0; + else m = *(pc++) * LFIELDS_PER_FLUSH; + n = *(pc++); + arr = luaD_stack.top-n-1; + while (n) { + ttype(luaD_stack.top) = LUA_T_NUMBER; nvalue(luaD_stack.top) = n+m; + *(luaH_set (avalue(arr), luaD_stack.top)) = *(luaD_stack.top-1); + luaD_stack.top--; + n--; + } + break; + } + + case SETMAP: { + int n = *(pc++); + TObject *arr = luaD_stack.top-(2*n)-1; + while (n--) { + *(luaH_set (avalue(arr), luaD_stack.top-2)) = *(luaD_stack.top-1); + luaD_stack.top-=2; + } + break; + } + + case POPS: + luaD_stack.top -= *(pc++); + break; + + case ARGS: + luaD_adjusttop(base + *(pc++)); + break; + + case VARARGS: + luaC_checkGC(); + adjust_varargs(base + *(pc++)); + break; + + case CREATEARRAY: { + Word size; + luaC_checkGC(); + get_word(size,pc); + avalue(luaD_stack.top) = luaH_new(size); + ttype(luaD_stack.top) = LUA_T_ARRAY; + luaD_stack.top++; + break; + } + + case EQOP: case NEQOP: { + int res = luaO_equalObj(luaD_stack.top-2, luaD_stack.top-1); + --luaD_stack.top; + if (opcode == NEQOP) res = !res; + ttype(luaD_stack.top-1) = res ? LUA_T_NUMBER : LUA_T_NIL; + nvalue(luaD_stack.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 = luaD_stack.top-2; + TObject *r = luaD_stack.top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_ADD); + else { + nvalue(l) += nvalue(r); + --luaD_stack.top; + } + break; + } + + case SUBOP: { + TObject *l = luaD_stack.top-2; + TObject *r = luaD_stack.top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_SUB); + else { + nvalue(l) -= nvalue(r); + --luaD_stack.top; + } + break; + } + + case MULTOP: { + TObject *l = luaD_stack.top-2; + TObject *r = luaD_stack.top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_MUL); + else { + nvalue(l) *= nvalue(r); + --luaD_stack.top; + } + break; + } + + case DIVOP: { + TObject *l = luaD_stack.top-2; + TObject *r = luaD_stack.top-1; + if (tonumber(r) || tonumber(l)) + call_arith(IM_DIV); + else { + nvalue(l) /= nvalue(r); + --luaD_stack.top; + } + break; + } + + case POWOP: + call_arith(IM_POW); + break; + + case CONCOP: { + TObject *l = luaD_stack.top-2; + TObject *r = luaD_stack.top-1; + if (tostring(l) || tostring(r)) + call_binTM(IM_CONCAT, "unexpected type for concatenation"); + else { + tsvalue(l) = strconc(svalue(l), svalue(r)); + --luaD_stack.top; + } + luaC_checkGC(); + break; + } + + case MINUSOP: + if (tonumber(luaD_stack.top-1)) { + ttype(luaD_stack.top) = LUA_T_NIL; + luaD_stack.top++; + call_arith(IM_UNM); + } + else + nvalue(luaD_stack.top-1) = - nvalue(luaD_stack.top-1); + break; + + case NOTOP: + ttype(luaD_stack.top-1) = + (ttype(luaD_stack.top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL; + nvalue(luaD_stack.top-1) = 1; + break; + + case ONTJMP: { + Word w; + get_word(w,pc); + if (ttype(luaD_stack.top-1) != LUA_T_NIL) pc += w; + else luaD_stack.top--; + } + break; + + case ONFJMP: { + Word w; + get_word(w,pc); + if (ttype(luaD_stack.top-1) == LUA_T_NIL) pc += w; + else luaD_stack.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); + luaD_stack.top--; + if (ttype(luaD_stack.top) == LUA_T_NIL) pc += w; + break; + } + + case IFFUPJMP: { + Word w; + get_word(w,pc); + luaD_stack.top--; + if (ttype(luaD_stack.top) == LUA_T_NIL) pc -= w; + break; + } + + case CLOSURE: + luaV_closure(); + luaC_checkGC(); + break; + + case CALLFUNC: { + int nParams = *pc++; + int nResults = *pc++; + StkId newBase = (luaD_stack.top-luaD_stack.stack)-nParams; + luaD_call(newBase, nResults); + break; + } + + case ENDCODE: + luaD_stack.top = luaD_stack.stack + base; + /* goes through */ + case RETCODE: + if (lua_callhook) + luaD_callHook(base, LUA_T_MARK, 1); + return (base + ((opcode==RETCODE) ? *pc : 0)); + + case SETLINE: { + Word line; + get_word(line,pc); + if ((luaD_stack.stack+base-1)->ttype != LUA_T_LINE) { + /* open space for LINE value */ + luaD_openstack((luaD_stack.top-luaD_stack.stack)-base); + base++; + (luaD_stack.stack+base-1)->ttype = LUA_T_LINE; + } + (luaD_stack.stack+base-1)->value.i = line; + if (lua_linehook) + luaD_lineHook(line); + break; + } + +#ifdef DEBUG + default: + lua_error("internal error - opcode doesn't match"); +#endif + } + } +} + diff --git a/lvm.h b/lvm.h new file mode 100644 index 00000000..9a180e3e --- /dev/null +++ b/lvm.h @@ -0,0 +1,29 @@ +/* +** $Id: $ +** Lua virtual machine +** See Copyright Notice in lua.h +*/ + +#ifndef lvm_h +#define lvm_h + + +#include "ldo.h" +#include "lobject.h" + + +#define tonumber(o) ((ttype(o) != LUA_T_NUMBER) && (luaV_tonumber(o) != 0)) +#define tostring(o) ((ttype(o) != LUA_T_STRING) && (luaV_tostring(o) != 0)) + + +void luaV_pack (StkId firstel, int nvararg, TObject *tab); +int luaV_tonumber (TObject *obj); +int luaV_tostring (TObject *obj); +void luaV_gettable (void); +void luaV_settable (TObject *t, int mode); +void luaV_getglobal (Word n); +void luaV_setglobal (Word n); +StkId luaV_execute (Closure *func, StkId base); +void luaV_closure (void); + +#endif