nik/lush
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

first implementation of centralized global state.

Browse Source
This commit is contained in:
Roberto Ierusalimschy
1997-11-19 15:29:23 -02:00
parent 9cdeb275e7
commit 592a3f289b
25 changed files with 782 additions and 829 deletions
Download Patch File Download Diff File Expand all files Collapse all files

224
lvm.c
View File

@@ -1,5 +1,5 @@
/*
** $Id: lvm.c,v 1.12 1997/10/24 18:40:29 roberto Exp roberto $
** $Id: lvm.c,v 1.13 1997/10/27 16:14:37 roberto Exp roberto $
** Lua virtual machine
** See Copyright Notice in lua.h
*/
@@ -14,6 +14,7 @@
#include "lgc.h"
#include "lmem.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
@@ -79,11 +80,11 @@ int luaV_tostring (TObject *obj)
void luaV_closure (int nelems)
{
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;
c->consts[0] = *(L->stack.top-1);
memcpy(&c->consts[1], L->stack.top-(nelems+1), nelems*sizeof(TObject));
L->stack.top -= nelems;
ttype(L->stack.top-1) = LUA_T_FUNCTION;
(L->stack.top-1)->value.cl = c;
}
@@ -94,22 +95,22 @@ void luaV_closure (int nelems)
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);
if (ttype(L->stack.top-2) != LUA_T_ARRAY) /* not a table, get "gettable" method */
im = luaT_getimbyObj(L->stack.top-2, IM_GETTABLE);
else { /* object is a table... */
int tg = (luaD_stack.top-2)->value.a->htag;
int tg = (L->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);
TObject *h = luaH_get(avalue(L->stack.top-2), L->stack.top-1);
if (h != NULL && ttype(h) != LUA_T_NIL) {
--luaD_stack.top;
*(luaD_stack.top-1) = *h;
--L->stack.top;
*(L->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;
--L->stack.top;
ttype(L->stack.top-1) = LUA_T_NIL;
}
return;
}
@@ -124,26 +125,26 @@ void luaV_gettable (void)
/*
** Function to store indexed based on values at the luaD_stack.top
** Function to store indexed based on values at the L->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)
** mode = 2: "deep L->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;
*h = *(L->stack.top-1);
L->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 */
*(L->stack.top+1) = *(L->stack.top-1);
*(L->stack.top) = *(t+1);
*(L->stack.top-1) = *t;
L->stack.top += 2; /* WARNING: caller must assure stack space */
}
luaD_callTM(im, 3, 0);
}
@@ -159,13 +160,13 @@ void luaV_getglobal (TaggedString *ts)
TObject *value = &ts->u.globalval;
TObject *im = luaT_getimbyObj(value, IM_GETGLOBAL);
if (ttype(im) == LUA_T_NIL) { /* default behavior */
*luaD_stack.top++ = *value;
*L->stack.top++ = *value;
}
else {
ttype(luaD_stack.top) = LUA_T_STRING;
tsvalue(luaD_stack.top) = ts;
luaD_stack.top++;
*luaD_stack.top++ = *value;
ttype(L->stack.top) = LUA_T_STRING;
tsvalue(L->stack.top) = ts;
L->stack.top++;
*L->stack.top++ = *value;
luaD_callTM(im, 2, 1);
}
}
@@ -176,14 +177,14 @@ 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, --luaD_stack.top);
luaS_rawsetglobal(ts, --L->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) = ts;
*luaD_stack.top++ = *oldvalue;
*luaD_stack.top++ = newvalue;
TObject newvalue = *(L->stack.top-1);
ttype(L->stack.top-1) = LUA_T_STRING;
tsvalue(L->stack.top-1) = ts;
*L->stack.top++ = *oldvalue;
*L->stack.top++ = newvalue;
luaD_callTM(im, 3, 0);
}
}
@@ -191,9 +192,9 @@ void luaV_setglobal (TaggedString *ts)
static void call_binTM (IMS event, char *msg)
{
TObject *im = luaT_getimbyObj(luaD_stack.top-2, event);/* try first operand */
TObject *im = luaT_getimbyObj(L->stack.top-2, event);/* try first operand */
if (ttype(im) == LUA_T_NIL) {
im = luaT_getimbyObj(luaD_stack.top-1, event); /* try second operand */
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)
@@ -214,8 +215,8 @@ static void call_arith (IMS event)
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;
TObject *l = L->stack.top-2;
TObject *r = L->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;
@@ -225,16 +226,16 @@ static void comparison (lua_Type ttype_less, lua_Type ttype_equal,
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 :
L->stack.top--;
nvalue(L->stack.top-1) = 1;
ttype(L->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;
TObject *firstelem = L->stack.stack+firstel;
int i;
if (nvararg < 0) nvararg = 0;
avalue(tab) = luaH_new(nvararg+1); /* +1 for field 'n' */
@@ -260,20 +261,21 @@ static void adjust_varargs (StkId first_extra_arg)
{
TObject arg;
luaV_pack(first_extra_arg,
(luaD_stack.top-luaD_stack.stack)-first_extra_arg, &arg);
(L->stack.top-L->stack.stack)-first_extra_arg, &arg);
luaD_adjusttop(first_extra_arg);
*luaD_stack.top++ = arg;
*L->stack.top++ = arg;
}
/*
** Execute the given opcode, until a RET. Parameters are between
** [luaD_stack.stack+base,luaD_stack.top). Returns n such that the the results are between
** [luaD_stack.stack+n,luaD_stack.top).
** [stack+base,top). Returns n such that the the results are between
** [stack+n,top).
*/
StkId luaV_execute (Closure *cl, StkId base)
{
LState *LL = L; /* to optimize */
Byte *pc = cl->consts[0].value.tf->code;
TObject *consts = cl->consts[0].value.tf->consts;
if (lua_callhook)
@@ -284,13 +286,13 @@ StkId luaV_execute (Closure *cl, StkId base)
switch ((OpCode)(aux = *pc++)) {
case PUSHNIL0:
ttype(luaD_stack.top++) = LUA_T_NIL;
ttype(LL->stack.top++) = LUA_T_NIL;
break;
case PUSHNIL:
aux = *pc++;
do {
ttype(luaD_stack.top++) = LUA_T_NIL;
ttype(LL->stack.top++) = LUA_T_NIL;
} while (aux--);
break;
@@ -303,9 +305,9 @@ StkId luaV_execute (Closure *cl, StkId base)
case PUSHNUMBER0: case PUSHNUMBER1: case PUSHNUMBER2:
aux -= PUSHNUMBER0;
pushnumber:
ttype(luaD_stack.top) = LUA_T_NUMBER;
nvalue(luaD_stack.top) = aux;
luaD_stack.top++;
ttype(LL->stack.top) = LUA_T_NUMBER;
nvalue(LL->stack.top) = aux;
LL->stack.top++;
break;
case PUSHLOCAL:
@@ -315,7 +317,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case PUSHLOCAL4: case PUSHLOCAL5: case PUSHLOCAL6: case PUSHLOCAL7:
aux -= PUSHLOCAL0;
pushlocal:
*luaD_stack.top++ = *((luaD_stack.stack+base) + aux);
*LL->stack.top++ = *((LL->stack.stack+base) + aux);
break;
case GETGLOBALW:
@@ -345,7 +347,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case GETDOTTED4: case GETDOTTED5: case GETDOTTED6: case GETDOTTED7:
aux -= GETDOTTED0;
getdotted:
*luaD_stack.top++ = consts[aux];
*LL->stack.top++ = consts[aux];
luaV_gettable();
break;
@@ -355,10 +357,10 @@ StkId luaV_execute (Closure *cl, StkId base)
case PUSHSELF:
aux = *pc++;
pushself: {
TObject receiver = *(luaD_stack.top-1);
*luaD_stack.top++ = consts[aux];
TObject receiver = *(LL->stack.top-1);
*LL->stack.top++ = consts[aux];
luaV_gettable();
*luaD_stack.top++ = receiver;
*LL->stack.top++ = receiver;
break;
}
@@ -373,7 +375,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case PUSHCONSTANT6: case PUSHCONSTANT7:
aux -= PUSHCONSTANT0;
pushconstant:
*luaD_stack.top++ = consts[aux];
*LL->stack.top++ = consts[aux];
break;
case PUSHUPVALUE:
@@ -382,7 +384,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case PUSHUPVALUE0: case PUSHUPVALUE1:
aux -= PUSHUPVALUE0;
pushupvalue:
*luaD_stack.top++ = cl->consts[aux+1];
*LL->stack.top++ = cl->consts[aux+1];
break;
case SETLOCAL:
@@ -392,7 +394,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case SETLOCAL4: case SETLOCAL5: case SETLOCAL6: case SETLOCAL7:
aux -= SETLOCAL0;
setlocal:
*((luaD_stack.stack+base) + aux) = *(--luaD_stack.top);
*((LL->stack.stack+base) + aux) = *(--LL->stack.top);
break;
case SETGLOBALW:
@@ -409,11 +411,11 @@ StkId luaV_execute (Closure *cl, StkId base)
break;
case SETTABLE0:
luaV_settable(luaD_stack.top-3, 1);
luaV_settable(LL->stack.top-3, 1);
break;
case SETTABLE:
luaV_settable(luaD_stack.top-3-(*pc++), 2);
luaV_settable(LL->stack.top-3-(*pc++), 2);
break;
case SETLISTW:
@@ -426,12 +428,12 @@ StkId luaV_execute (Closure *cl, StkId base)
aux = 0;
setlist: {
int n = *(pc++);
TObject *arr = luaD_stack.top-n-1;
TObject *arr = LL->stack.top-n-1;
for (; n; n--) {
ttype(luaD_stack.top) = LUA_T_NUMBER;
nvalue(luaD_stack.top) = n+aux;
*(luaH_set (avalue(arr), luaD_stack.top)) = *(luaD_stack.top-1);
luaD_stack.top--;
ttype(LL->stack.top) = LUA_T_NUMBER;
nvalue(LL->stack.top) = n+aux;
*(luaH_set (avalue(arr), LL->stack.top)) = *(LL->stack.top-1);
LL->stack.top--;
}
break;
}
@@ -442,10 +444,10 @@ StkId luaV_execute (Closure *cl, StkId base)
case SETMAP:
aux = *pc++;
setmap: {
TObject *arr = luaD_stack.top-(2*aux)-3;
TObject *arr = LL->stack.top-(2*aux)-3;
do {
*(luaH_set (avalue(arr), luaD_stack.top-2)) = *(luaD_stack.top-1);
luaD_stack.top-=2;
*(luaH_set (avalue(arr), LL->stack.top-2)) = *(LL->stack.top-1);
LL->stack.top-=2;
} while (aux--);
break;
}
@@ -456,7 +458,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case POP0: case POP1:
aux -= POP0;
pop:
luaD_stack.top -= (aux+1);
LL->stack.top -= (aux+1);
break;
case ARGS:
@@ -478,17 +480,17 @@ StkId luaV_execute (Closure *cl, StkId base)
aux = *pc++;
createarray:
luaC_checkGC();
avalue(luaD_stack.top) = luaH_new(aux);
ttype(luaD_stack.top) = LUA_T_ARRAY;
luaD_stack.top++;
avalue(LL->stack.top) = luaH_new(aux);
ttype(LL->stack.top) = LUA_T_ARRAY;
LL->stack.top++;
break;
case EQOP: case NEQOP: {
int res = luaO_equalObj(luaD_stack.top-2, luaD_stack.top-1);
luaD_stack.top--;
int res = luaO_equalObj(LL->stack.top-2, LL->stack.top-1);
LL->stack.top--;
if (aux == NEQOP) res = !res;
ttype(luaD_stack.top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(luaD_stack.top-1) = 1;
ttype(LL->stack.top-1) = res ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(LL->stack.top-1) = 1;
break;
}
@@ -509,49 +511,49 @@ StkId luaV_execute (Closure *cl, StkId base)
break;
case ADDOP: {
TObject *l = luaD_stack.top-2;
TObject *r = luaD_stack.top-1;
TObject *l = LL->stack.top-2;
TObject *r = LL->stack.top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_ADD);
else {
nvalue(l) += nvalue(r);
--luaD_stack.top;
--LL->stack.top;
}
break;
}
case SUBOP: {
TObject *l = luaD_stack.top-2;
TObject *r = luaD_stack.top-1;
TObject *l = LL->stack.top-2;
TObject *r = LL->stack.top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_SUB);
else {
nvalue(l) -= nvalue(r);
--luaD_stack.top;
--LL->stack.top;
}
break;
}
case MULTOP: {
TObject *l = luaD_stack.top-2;
TObject *r = luaD_stack.top-1;
TObject *l = LL->stack.top-2;
TObject *r = LL->stack.top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_MUL);
else {
nvalue(l) *= nvalue(r);
--luaD_stack.top;
--LL->stack.top;
}
break;
}
case DIVOP: {
TObject *l = luaD_stack.top-2;
TObject *r = luaD_stack.top-1;
TObject *l = LL->stack.top-2;
TObject *r = LL->stack.top-1;
if (tonumber(r) || tonumber(l))
call_arith(IM_DIV);
else {
nvalue(l) /= nvalue(r);
--luaD_stack.top;
--LL->stack.top;
}
break;
}
@@ -561,32 +563,32 @@ StkId luaV_execute (Closure *cl, StkId base)
break;
case CONCOP: {
TObject *l = luaD_stack.top-2;
TObject *r = luaD_stack.top-1;
TObject *l = LL->stack.top-2;
TObject *r = LL->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;
--LL->stack.top;
}
luaC_checkGC();
break;
}
case MINUSOP:
if (tonumber(luaD_stack.top-1)) {
ttype(luaD_stack.top) = LUA_T_NIL;
luaD_stack.top++;
if (tonumber(LL->stack.top-1)) {
ttype(LL->stack.top) = LUA_T_NIL;
LL->stack.top++;
call_arith(IM_UNM);
}
else
nvalue(luaD_stack.top-1) = - nvalue(luaD_stack.top-1);
nvalue(LL->stack.top-1) = - nvalue(LL->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;
ttype(LL->stack.top-1) =
(ttype(LL->stack.top-1) == LUA_T_NIL) ? LUA_T_NUMBER : LUA_T_NIL;
nvalue(LL->stack.top-1) = 1;
break;
case ONTJMPW:
@@ -595,8 +597,8 @@ StkId luaV_execute (Closure *cl, StkId base)
case ONTJMP:
aux = *pc++;
ontjmp:
if (ttype(luaD_stack.top-1) != LUA_T_NIL) pc += aux;
else luaD_stack.top--;
if (ttype(LL->stack.top-1) != LUA_T_NIL) pc += aux;
else LL->stack.top--;
break;
case ONFJMPW:
@@ -605,8 +607,8 @@ StkId luaV_execute (Closure *cl, StkId base)
case ONFJMP:
aux = *pc++;
onfjmp:
if (ttype(luaD_stack.top-1) == LUA_T_NIL) pc += aux;
else luaD_stack.top--;
if (ttype(LL->stack.top-1) == LUA_T_NIL) pc += aux;
else LL->stack.top--;
break;
case JMPW:
@@ -624,7 +626,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case IFFJMP:
aux = *pc++;
iffjmp:
if (ttype(--luaD_stack.top) == LUA_T_NIL) pc += aux;
if (ttype(--LL->stack.top) == LUA_T_NIL) pc += aux;
break;
case IFTUPJMPW:
@@ -633,7 +635,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case IFTUPJMP:
aux = *pc++;
iftupjmp:
if (ttype(--luaD_stack.top) != LUA_T_NIL) pc -= aux;
if (ttype(--LL->stack.top) != LUA_T_NIL) pc -= aux;
break;
case IFFUPJMPW:
@@ -642,7 +644,7 @@ StkId luaV_execute (Closure *cl, StkId base)
case IFFUPJMP:
aux = *pc++;
iffupjmp:
if (ttype(--luaD_stack.top) == LUA_T_NIL) pc -= aux;
if (ttype(--LL->stack.top) == LUA_T_NIL) pc -= aux;
break;
case CLOSURE:
@@ -661,13 +663,13 @@ StkId luaV_execute (Closure *cl, StkId base)
case CALLFUNC0: case CALLFUNC1:
aux -= CALLFUNC0;
callfunc: {
StkId newBase = (luaD_stack.top-luaD_stack.stack)-(*pc++);
StkId newBase = (LL->stack.top-LL->stack.stack)-(*pc++);
luaD_call(newBase, aux);
break;
}
case ENDCODE:
luaD_stack.top = luaD_stack.stack + base;
LL->stack.top = LL->stack.stack + base;
/* goes through */
case RETCODE:
if (lua_callhook)
@@ -680,13 +682,13 @@ StkId luaV_execute (Closure *cl, StkId base)
case SETLINE:
aux = *pc++;
setline:
if ((luaD_stack.stack+base-1)->ttype != LUA_T_LINE) {
if ((LL->stack.stack+base-1)->ttype != LUA_T_LINE) {
/* open space for LINE value */
luaD_openstack((luaD_stack.top-luaD_stack.stack)-base);
luaD_openstack((LL->stack.top-LL->stack.stack)-base);
base++;
(luaD_stack.stack+base-1)->ttype = LUA_T_LINE;
(LL->stack.stack+base-1)->ttype = LUA_T_LINE;
}
(luaD_stack.stack+base-1)->value.i = aux;
(LL->stack.stack+base-1)->value.i = aux;
if (lua_linehook)
luaD_lineHook(aux);
break;