mirrors/lua
1
0
Fork 0
mirror of https://github.com/lua/lua synced 2024-11-26 06:39:41 +03:00
Code Issues Packages Projects Releases Wiki Activity
541e722360
lua/lvm.c
Roberto Ierusalimschy 541e722360 details
1997-12-23 17:24:19 -02:00

712 lines
17 KiB
C
Raw Blame History

/*
** $Id: lvm.c,v 1.18 1997/12/17 20:48:58 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
#include <stdio.h>
#include <string.h>
#include "lauxlib.h"
#include "ldo.h"
#include "lfunc.h"
#include "lgc.h"
#include "lmem.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "luadebug.h"
#include "lvm.h"
#define skip_word(pc) (pc+=2)
#define get_word(pc) (*(pc)+(*((pc)+1)<<8))
#define next_word(pc) (pc+=2, get_word(pc-2))
/* Extra stack size to run a function: LUA_T_LINE(1), TM calls(2), ... */
#define EXTRA_STACK 5
static TaggedString *strconc (char *l, char *r)
{
size_t nl = strlen(l);
char *buffer = luaL_openspace(nl+strlen(r)+1);
strcpy(buffer, l);
strcpy(buffer+nl, r);
return luaS_new(buffer);
}
int luaV_tonumber (TObject *obj)
{ /* LUA_NUMBER */
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)
{ /* LUA_NUMBER */
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 (int nelems)
{
if (nelems > 0) {
struct Stack *S = &L->stack;
Closure *c = luaF_newclosure(nelems);
c->consts[0] = *(S->top-1);
memcpy(&c->consts[1], S->top-(nelems+1), nelems*sizeof(TObject));
S->top -= nelems;
ttype(S->top-1) = LUA_T_CLOSURE;
(S->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)
{
struct Stack *S = &L->stack;
TObject *im;
if (ttype(S->top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */
im = luaT_getimbyObj(S->top-2, IM_GETTABLE);
else { /* object is a table... */
int tg = (S->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(S->top-2), S->top-1);
if (h != NULL && ttype(h) != LUA_T_NIL) {
--S->top;
*(S->top-1) = *h;
}
else if (ttype(im=luaT_getim(tg, IM_INDEX)) != LUA_T_NIL)
luaD_callTM(im, 2, 1);
else {
--S->top;
ttype(S->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 stack.top
** mode = 0: raw store (without internal methods)
** mode = 1: normal store (with internal methods)
** mode = 2: "deep L->stack.stack" store (with internal methods)
*/
void luaV_settable (TObject *t, int mode)
{
struct Stack *S = &L->stack;
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 = *(S->top-1);
S->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) {
*(S->top+1) = *(L->stack.top-1);
*(S->top) = *(t+1);
*(S->top-1) = *t;
S->top += 2; /* WARNING: caller must assure stack space */
}
luaD_callTM(im, 3, 0);
}
else
lua_error("indexed expression not a table");
}
}
void luaV_getglobal (TaggedString *ts)
{
/* WARNING: caller must assure stack space */
TObject *value = &ts->u.globalval;
TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);
if (ttype(im) == LUA_T_NIL) { /* default behavior */
*L->stack.top++ = *value;
}
else {
struct Stack *S = &L->stack;
ttype(S->top) = LUA_T_STRING;
tsvalue(S->top) = ts;
S->top++;
*S->top++ = *value;
luaD_callTM(im, 2, 1);
}
}
void luaV_setglobal (TaggedString *ts)
{
TObject *oldvalue = &ts->u.globalval;
TObject *im = luaT_getimbyObj(oldvalue, IM_SETGLOBAL);
if (ttype(im) == LUA_T_NIL) /* default behavior */
luaS_rawsetglobal(ts, --L->stack.top);
else {
/* WARNING: caller must assure stack space */
struct Stack *S = &L->stack;
TObject newvalue = *(S->top-1);
ttype(S->top-1) = LUA_T_STRING;
tsvalue(S->top-1) = ts;
*S->top++ = *oldvalue;
*S->top++ = newvalue;
luaD_callTM(im, 3, 0);
}
}
static void call_binTM (IMS event, char *msg)
{
TObject *im = luaT_getimbyObj(L->stack.top-2, event);/* try first operand */
if (ttype(im) == LUA_T_NIL) {
im = luaT_getimbyObj(L->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 in arithmetic operation");
}
static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
lua_Type ttype_great, IMS op)
{
struct Stack *S = &L->stack;
TObject *l = S->top-2;
TObject *r = S->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 in comparison");
return;
}
S->top--;
nvalue(S->top-1) = 1;
ttype(S->top-1) = (result < 0) ? ttype_less :
(result == 0) ? ttype_equal : ttype_great;
}
void luaV_pack (StkId firstel, int nvararg, TObject *tab)
{
TObject *firstelem = L->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; i<nvararg; i++) {
TObject index;
ttype(&index) = LUA_T_NUMBER;
nvalue(&index) = i+1;
*(luaH_set(avalue(tab), &index)) = *(firstelem+i);
}
/* store counter in field "n" */ {
TObject index, extra;
ttype(&index) = LUA_T_STRING;
tsvalue(&index) = luaS_new("n");
ttype(&extra) = LUA_T_NUMBER;
nvalue(&extra) = nvararg;
*(luaH_set(avalue(tab), &index)) = extra;
}
}
static void adjust_varargs (StkId first_extra_arg)
{
TObject arg;
luaV_pack(first_extra_arg,
(L->stack.top-L->stack.stack)-first_extra_arg, &arg);
luaD_adjusttop(first_extra_arg);
*L->stack.top++ = arg;
}
/*
** 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).
*/
StkId luaV_execute (Closure *cl, TProtoFunc *tf, StkId base)
{
struct Stack *S = &L->stack; /* to optimize */
Byte *pc = tf->code;
TObject *consts = tf->consts;
if (lua_callhook)
luaD_callHook(base, tf, 0);
luaD_checkstack((*pc++)+EXTRA_STACK);
while (1) {
int aux;
switch ((OpCode)(aux = *pc++)) {
case PUSHNIL0:
ttype(S->top++) = LUA_T_NIL;
break;
case PUSHNIL:
aux = *pc++;
do {
ttype(S->top++) = LUA_T_NIL;
} while (aux--);
break;
case PUSHNUMBER:
aux = *pc++; goto pushnumber;
case PUSHNUMBERW:
aux = next_word(pc); goto pushnumber;
case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2:
aux -= PUSHNUMBER0;
pushnumber:
ttype(S->top) = LUA_T_NUMBER;
nvalue(S->top) = aux;
S->top++;
break;
case PUSHLOCAL:
aux = *pc++; goto pushlocal;
case PUSHLOCAL0: case PUSHLOCAL1: case PUSHLOCAL2: case PUSHLOCAL3:
case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
aux -= PUSHLOCAL0;
pushlocal:
*S->top++ = *((S->stack+base) + aux);
break;
case GETGLOBALW:
aux = next_word(pc); goto getglobal;
case GETGLOBAL:
aux = *pc++; goto getglobal;
case GETGLOBAL0: case GETGLOBAL1: case GETGLOBAL2: case GETGLOBAL3:
case GETGLOBAL4: case GETGLOBAL5: case GETGLOBAL6: case GETGLOBAL7:
aux -= GETGLOBAL0;
getglobal:
luaV_getglobal(tsvalue(&consts[aux]));
break;
case GETTABLE:
luaV_gettable();
break;
case GETDOTTEDW:
aux = next_word(pc); goto getdotted;
case GETDOTTED:
aux = *pc++; goto getdotted;
case GETDOTTED0: case GETDOTTED1: case GETDOTTED2: case GETDOTTED3:
case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7:
aux -= GETDOTTED0;
getdotted:
*S->top++ = consts[aux];
luaV_gettable();
break;
case PUSHSELFW:
aux = next_word(pc); goto pushself;
case PUSHSELF:
aux = *pc++;
pushself: {
TObject receiver = *(S->top-1);
*S->top++ = consts[aux];
luaV_gettable();
*S->top++ = receiver;
break;
}
case PUSHCONSTANTW:
aux = next_word(pc); goto pushconstant;
case PUSHCONSTANT:
aux = *pc++; goto pushconstant;
case PUSHCONSTANT0: case PUSHCONSTANT1: case PUSHCONSTANT2:
case PUSHCONSTANT3: case PUSHCONSTANT4: case PUSHCONSTANT5:
case PUSHCONSTANT6: case PUSHCONSTANT7:
aux -= PUSHCONSTANT0;
pushconstant:
*S->top++ = consts[aux];
break;
case PUSHUPVALUE:
aux = *pc++; goto pushupvalue;
case PUSHUPVALUE0: case PUSHUPVALUE1:
aux -= PUSHUPVALUE0;
pushupvalue:
*S->top++ = cl->consts[aux+1];
break;
case SETLOCAL:
aux = *pc++; goto setlocal;
case SETLOCAL0: case SETLOCAL1: case SETLOCAL2: case SETLOCAL3:
case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7:
aux -= SETLOCAL0;
setlocal:
*((S->stack+base) + aux) = *(--S->top);
break;
case SETGLOBALW:
aux = next_word(pc); goto setglobal;
case SETGLOBAL:
aux = *pc++; goto setglobal;
case SETGLOBAL0: case SETGLOBAL1: case SETGLOBAL2: case SETGLOBAL3:
case SETGLOBAL4: case SETGLOBAL5: case SETGLOBAL6: case SETGLOBAL7:
aux -= SETGLOBAL0;
setglobal:
luaV_setglobal(tsvalue(&consts[aux]));
break;
case SETTABLE0:
luaV_settable(S->top-3, 1);
break;
case SETTABLE:
luaV_settable(S->top-3-(*pc++), 2);
break;
case SETLISTW:
aux = next_word(pc); aux *= LFIELDS_PER_FLUSH; goto setlist;
case SETLIST:
aux = *(pc++) * LFIELDS_PER_FLUSH; goto setlist;
case SETLIST0:
aux = 0;
setlist: {
int n = *(pc++);
TObject *arr = S->top-n-1;
for (; n; n--) {
ttype(S->top) = LUA_T_NUMBER;
nvalue(S->top) = n+aux;
*(luaH_set(avalue(arr), S->top)) = *(S->top-1);
S->top--;
}
break;
}
case SETMAP0:
aux = 0; goto setmap;
case SETMAP:
aux = *pc++;
setmap: {
TObject *arr = S->top-(2*aux)-3;
do {
*(luaH_set(avalue(arr), S->top-2)) = *(S->top-1);
S->top-=2;
} while (aux--);
break;
}
case POP:
aux = *pc++; goto pop;
case POP0: case POP1:
aux -= POP0;
pop:
S->top -= (aux+1);
break;
case ARGS:
luaD_adjusttop(base+(*pc++));
break;
case VARARGS:
luaC_checkGC();
adjust_varargs(base+(*pc++));
break;
case CREATEARRAYW:
aux = next_word(pc); goto createarray;
case CREATEARRAY0: case CREATEARRAY1:
aux -= CREATEARRAY0; goto createarray;
case CREATEARRAY:
aux = *pc++;
createarray:
luaC_checkGC();
avalue(S->top) = luaH_new(aux);
ttype(S->top) = LUA_T_ARRAY;
S->top++;
break;
case EQOP: case NEQOP: {
int res = luaO_equalObj(S->top-2, S->top-1);
S->top--;
if (aux == NEQOP) res = !res;
ttype(S->top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(S->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 = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_ADD);
else {
nvalue(l) += nvalue(r);
--S->top;
}
break;
}
case SUBOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_SUB);
else {
nvalue(l) -= nvalue(r);
--S->top;
}
break;
}
case MULTOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_MUL);
else {
nvalue(l) *= nvalue(r);
--S->top;
}
break;
}
case DIVOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_DIV);
else {
nvalue(l) /= nvalue(r);
--S->top;
}
break;
}
case POWOP:
call_arith(IM_POW);
break;
case CONCOP: {
TObject *l = S->top-2;
TObject *r = S->top-1;
if (tostring(l) || tostring(r))
call_binTM(IM_CONCAT, "unexpected type for concatenation");
else {
tsvalue(l) = strconc(svalue(l), svalue(r));
--S->top;
}
luaC_checkGC();
break;
}
case MINUSOP:
if (tonumber(S->top-1)) {
ttype(S->top) = LUA_T_NIL;
S->top++;
call_arith(IM_UNM);
}
else
nvalue(S->top-1) = - nvalue(S->top-1);
break;
case NOTOP:
ttype(S->top-1) =
(ttype(S->top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(S->top-1) = 1;
break;
case ONTJMPW:
aux = next_word(pc); goto ontjmp;
case ONTJMP:
aux = *pc++;
ontjmp:
if (ttype(S->top-1) != LUA_T_NIL) pc += aux;
else S->top--;
break;
case ONFJMPW:
aux = next_word(pc); goto onfjmp;
case ONFJMP:
aux = *pc++;
onfjmp:
if (ttype(S->top-1) == LUA_T_NIL) pc += aux;
else S->top--;
break;
case JMPW:
aux = next_word(pc); goto jmp;
case JMP:
aux = *pc++;
jmp:
pc += aux;
break;
case IFFJMPW:
aux = next_word(pc); goto iffjmp;
case IFFJMP:
aux = *pc++;
iffjmp:
if (ttype(--S->top) == LUA_T_NIL) pc += aux;
break;
case IFTUPJMPW:
aux = next_word(pc); goto iftupjmp;
case IFTUPJMP:
aux = *pc++;
iftupjmp:
if (ttype(--S->top) != LUA_T_NIL) pc -= aux;
break;
case IFFUPJMPW:
aux = next_word(pc); goto iffupjmp;
case IFFUPJMP:
aux = *pc++;
iffupjmp:
if (ttype(--S->top) == LUA_T_NIL) pc -= aux;
break;
case CLOSURE:
aux = *pc++; goto closure;
case CLOSURE0: case CLOSURE1:
aux -= CLOSURE0;
closure:
luaV_closure(aux);
luaC_checkGC();
break;
case CALLFUNC:
aux = *pc++; goto callfunc;
case CALLFUNC0: case CALLFUNC1:
aux -= CALLFUNC0;
callfunc: {
StkId newBase = (S->top-S->stack)-(*pc++);
luaD_call(newBase, aux);
break;
}
case ENDCODE:
S->top = S->stack + base;
/* goes through */
case RETCODE:
if (lua_callhook)
luaD_callHook(base, NULL, 1);
return (base + ((aux==RETCODE) ? *pc : 0));
case SETLINEW:
aux = next_word(pc); goto setline;
case SETLINE:
aux = *pc++;
setline:
if ((S->stack+base-1)->ttype != LUA_T_LINE) {
/* open space for LINE value */
luaD_openstack((S->top-S->stack)-base);
base++;
(S->stack+base-1)->ttype = LUA_T_LINE;
}
(S->stack+base-1)->value.i = aux;
if (lua_linehook)
luaD_lineHook(aux);
break;
#ifdef DEBUG
default:
lua_error("internal error - opcode doesn't match");
#endif
}
}
}
Reference in New Issue View Git Blame Copy Permalink