adding the ability for the VM to use computed goto where available

with gcc v4.3.2 I found the combination of -O2 and computed goto to give the
best performance; with -O3 performance was a little worse and computed goto
was a wash.
This commit is contained in:
JeffBezanson 2009-06-28 19:47:11 +00:00
parent b5897e0ad1
commit 3844191d70
3 changed files with 265 additions and 190 deletions

View File

@ -8,11 +8,11 @@ EXENAME = $(NAME)
LLTDIR = ../llt LLTDIR = ../llt
LLT = $(LLTDIR)/libllt.a LLT = $(LLTDIR)/libllt.a
FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAGS) FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAGS) -DUSE_COMPUTED_GOTO
LIBS = $(LLT) -lm LIBS = $(LLT) -lm
DEBUGFLAGS = -g -DDEBUG $(FLAGS) DEBUGFLAGS = -g -DDEBUG $(FLAGS)
SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer -march=native $(FLAGS) SHIPFLAGS = -O2 -DNDEBUG -fomit-frame-pointer -march=native $(FLAGS)
default: release test default: release test

View File

@ -832,6 +832,16 @@ static value_t do_trycatch()
#define PUT_INT32(a,i) (*(int32_t*)(a) = (int32_t)(i)) #define PUT_INT32(a,i) (*(int32_t*)(a) = (int32_t)(i))
#endif #endif
#ifdef USE_COMPUTED_GOTO
#define OP(x) L_##x:
#define NEXT_OP goto *vm_labels[*ip++]
#define DISPATCH goto *vm_labels[op]
#else
#define OP(x) case x:
#define NEXT_OP goto next_op
#define DISPATCH goto dispatch
#endif
/* /*
stack on entry: <func> <up to MAX_ARGS args...> <arglist if nargs>MAX_ARGS> stack on entry: <func> <up to MAX_ARGS args...> <arglist if nargs>MAX_ARGS>
caller's responsibility: caller's responsibility:
@ -847,9 +857,10 @@ static value_t do_trycatch()
*/ */
static value_t apply_cl(uint32_t nargs) static value_t apply_cl(uint32_t nargs)
{ {
VM_LABELS;
// frame variables // frame variables
uint32_t n, captured; uint32_t n, captured;
value_t *bp; uint32_t bp;
const uint8_t *ip; const uint8_t *ip;
fixnum_t s, hi; fixnum_t s, hi;
@ -871,15 +882,20 @@ static value_t apply_cl(uint32_t nargs)
lerror(MemoryError, "stack overflow"); lerror(MemoryError, "stack overflow");
ip += 4; ip += 4;
bp = &Stack[SP-nargs]; bp = SP-nargs;
PUSH(fn_env(func)); PUSH(fn_env(func));
{ {
#ifdef USE_COMPUTED_GOTO
{
NEXT_OP;
#else
next_op: next_op:
op = *ip++; op = *ip++;
dispatch: dispatch:
switch (op) { switch (op) {
case OP_ARGC: #endif
OP(OP_ARGC)
n = *ip++; n = *ip++;
if (nargs != n) { if (nargs != n) {
if (nargs > n) if (nargs > n)
@ -887,13 +903,13 @@ static value_t apply_cl(uint32_t nargs)
else else
lerror(ArgError, "apply: too few arguments"); lerror(ArgError, "apply: too few arguments");
} }
goto next_op; NEXT_OP;
case OP_VARGC: OP(OP_VARGC)
i = *ip++; i = *ip++;
s = (fixnum_t)nargs - (fixnum_t)i; s = (fixnum_t)nargs - (fixnum_t)i;
v = NIL; v = NIL;
if (s > 0) { if (s > 0) {
v = list(&bp[i], s); v = list(&Stack[bp+i], s);
if (nargs > MAX_ARGS) { if (nargs > MAX_ARGS) {
if (s == 1) { if (s == 1) {
v = car_(v); v = car_(v);
@ -903,8 +919,8 @@ static value_t apply_cl(uint32_t nargs)
(c-2)->cdr = (c-1)->car; (c-2)->cdr = (c-1)->car;
} }
} }
bp[i] = v; Stack[bp+i] = v;
bp[i+1] = bp[nargs]; Stack[bp+i+1] = Stack[bp+nargs];
} }
else if (s < 0) { else if (s < 0) {
lerror(ArgError, "apply: too few arguments"); lerror(ArgError, "apply: too few arguments");
@ -915,9 +931,9 @@ static value_t apply_cl(uint32_t nargs)
Stack[SP-2] = NIL; Stack[SP-2] = NIL;
} }
nargs = i+1; nargs = i+1;
goto next_op; NEXT_OP;
case OP_LARGC: OP(OP_LARGC)
case OP_LVARGC: OP(OP_LVARGC)
// move extra arguments from list to stack // move extra arguments from list to stack
i = GET_INT32(ip); ip+=4; i = GET_INT32(ip); ip+=4;
e = POP(); // cloenv e = POP(); // cloenv
@ -933,7 +949,7 @@ static value_t apply_cl(uint32_t nargs)
nargs++; nargs++;
v = cdr_(v); v = cdr_(v);
} }
if (op == OP_LVARGC) { if (ip[-5] == OP_LVARGC) {
PUSH(v); PUSH(v);
nargs++; nargs++;
} }
@ -942,27 +958,27 @@ static value_t apply_cl(uint32_t nargs)
lerror(ArgError, "apply: too many arguments"); lerror(ArgError, "apply: too many arguments");
} }
PUSH(e); PUSH(e);
goto next_op; NEXT_OP;
case OP_LET: OP(OP_LET)
// last arg is closure environment to use // last arg is closure environment to use
nargs--; nargs--;
POPN(1); POPN(1);
goto next_op; NEXT_OP;
case OP_NOP: goto next_op; OP(OP_NOP) NEXT_OP;
case OP_DUP: SP++; Stack[SP-1] = Stack[SP-2]; goto next_op; OP(OP_DUP) SP++; Stack[SP-1] = Stack[SP-2]; NEXT_OP;
case OP_POP: POPN(1); goto next_op; OP(OP_POP) POPN(1); NEXT_OP;
case OP_TCALL: OP(OP_TCALL)
n = *ip++; // nargs n = *ip++; // nargs
do_tcall: do_tcall:
if (isfunction(Stack[SP-n-1])) { if (isfunction(Stack[SP-n-1])) {
for(s=-1; s < (fixnum_t)n; s++) for(s=-1; s < (fixnum_t)n; s++)
bp[s] = Stack[SP-n+s]; Stack[bp+s] = Stack[SP-n+s];
SP = (bp-Stack)+n; SP = bp+n;
nargs = n; nargs = n;
goto apply_cl_top; goto apply_cl_top;
} }
goto do_call; goto do_call;
case OP_CALL: OP(OP_CALL)
n = *ip++; // nargs n = *ip++; // nargs
do_call: do_call:
func = Stack[SP-n-1]; func = Stack[SP-n-1];
@ -994,7 +1010,7 @@ static value_t apply_cl(uint32_t nargs)
case OP_MUL: goto apply_mul; case OP_MUL: goto apply_mul;
case OP_DIV: goto apply_div; case OP_DIV: goto apply_div;
default: default:
goto dispatch; DISPATCH;
} }
} }
} }
@ -1006,35 +1022,35 @@ static value_t apply_cl(uint32_t nargs)
} }
SP = s-n; SP = s-n;
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_JMP: ip += (ptrint_t)GET_INT16(ip); goto next_op; OP(OP_JMP) ip += (ptrint_t)GET_INT16(ip); NEXT_OP;
case OP_BRF: OP(OP_BRF)
v = POP(); v = POP();
if (v == FL_F) ip += (ptrint_t)GET_INT16(ip); if (v == FL_F) ip += (ptrint_t)GET_INT16(ip);
else ip += 2; else ip += 2;
goto next_op; NEXT_OP;
case OP_BRT: OP(OP_BRT)
v = POP(); v = POP();
if (v != FL_F) ip += (ptrint_t)GET_INT16(ip); if (v != FL_F) ip += (ptrint_t)GET_INT16(ip);
else ip += 2; else ip += 2;
goto next_op; NEXT_OP;
case OP_JMPL: ip += (ptrint_t)GET_INT32(ip); goto next_op; OP(OP_JMPL) ip += (ptrint_t)GET_INT32(ip); NEXT_OP;
case OP_BRFL: OP(OP_BRFL)
v = POP(); v = POP();
if (v == FL_F) ip += (ptrint_t)GET_INT32(ip); if (v == FL_F) ip += (ptrint_t)GET_INT32(ip);
else ip += 4; else ip += 4;
goto next_op; NEXT_OP;
case OP_BRTL: OP(OP_BRTL)
v = POP(); v = POP();
if (v != FL_F) ip += (ptrint_t)GET_INT32(ip); if (v != FL_F) ip += (ptrint_t)GET_INT32(ip);
else ip += 4; else ip += 4;
goto next_op; NEXT_OP;
case OP_RET: v = POP(); return v; OP(OP_RET) v = POP(); return v;
case OP_EQ: OP(OP_EQ)
Stack[SP-2] = ((Stack[SP-2] == Stack[SP-1]) ? FL_T : FL_F); Stack[SP-2] = ((Stack[SP-2] == Stack[SP-1]) ? FL_T : FL_F);
POPN(1); goto next_op; POPN(1); NEXT_OP;
case OP_EQV: OP(OP_EQV)
if (Stack[SP-2] == Stack[SP-1]) { if (Stack[SP-2] == Stack[SP-1]) {
v = FL_T; v = FL_T;
} }
@ -1045,8 +1061,8 @@ static value_t apply_cl(uint32_t nargs)
v = equal(Stack[SP-2], Stack[SP-1]); v = equal(Stack[SP-2], Stack[SP-1]);
} }
Stack[SP-2] = v; POPN(1); Stack[SP-2] = v; POPN(1);
goto next_op; NEXT_OP;
case OP_EQUAL: OP(OP_EQUAL)
if (Stack[SP-2] == Stack[SP-1]) { if (Stack[SP-2] == Stack[SP-1]) {
v = FL_T; v = FL_T;
} }
@ -1054,42 +1070,42 @@ static value_t apply_cl(uint32_t nargs)
v = equal(Stack[SP-2], Stack[SP-1]); v = equal(Stack[SP-2], Stack[SP-1]);
} }
Stack[SP-2] = v; POPN(1); Stack[SP-2] = v; POPN(1);
goto next_op; NEXT_OP;
case OP_PAIRP: OP(OP_PAIRP)
Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_T : FL_F); goto next_op; Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP;
case OP_ATOMP: OP(OP_ATOMP)
Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_F : FL_T); goto next_op; Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_F : FL_T); NEXT_OP;
case OP_NOT: OP(OP_NOT)
Stack[SP-1] = ((Stack[SP-1]==FL_F) ? FL_T : FL_F); goto next_op; Stack[SP-1] = ((Stack[SP-1]==FL_F) ? FL_T : FL_F); NEXT_OP;
case OP_NULLP: OP(OP_NULLP)
Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); goto next_op; Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); NEXT_OP;
case OP_BOOLEANP: OP(OP_BOOLEANP)
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = ((v == FL_T || v == FL_F) ? FL_T:FL_F); goto next_op; Stack[SP-1] = ((v == FL_T || v == FL_F) ? FL_T:FL_F); NEXT_OP;
case OP_SYMBOLP: OP(OP_SYMBOLP)
Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); goto next_op; Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP;
case OP_NUMBERP: OP(OP_NUMBERP)
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = (isfixnum(v) || iscprim(v) ? FL_T:FL_F); goto next_op; Stack[SP-1] = (isfixnum(v) || iscprim(v) ? FL_T:FL_F); NEXT_OP;
case OP_FIXNUMP: OP(OP_FIXNUMP)
Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); goto next_op; Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP;
case OP_BOUNDP: OP(OP_BOUNDP)
sym = tosymbol(Stack[SP-1], "bound?"); sym = tosymbol(Stack[SP-1], "bound?");
Stack[SP-1] = ((sym->binding == UNBOUND) ? FL_F : FL_T); Stack[SP-1] = ((sym->binding == UNBOUND) ? FL_F : FL_T);
goto next_op; NEXT_OP;
case OP_BUILTINP: OP(OP_BUILTINP)
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_T : FL_F; Stack[SP-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_T : FL_F;
goto next_op; NEXT_OP;
case OP_FUNCTIONP: OP(OP_FUNCTIONP)
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = ((tag(v)==TAG_FUNCTION &&v!=FL_F&&v!=FL_T&&v!=NIL) || Stack[SP-1] = ((tag(v)==TAG_FUNCTION &&v!=FL_F&&v!=FL_T&&v!=NIL) ||
iscbuiltin(v)) ? FL_T : FL_F; iscbuiltin(v)) ? FL_T : FL_F;
goto next_op; NEXT_OP;
case OP_VECTORP: OP(OP_VECTORP)
Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); goto next_op; Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); NEXT_OP;
case OP_CONS: OP(OP_CONS)
if (curheap > lim) if (curheap > lim)
gc(0); gc(0);
c = (cons_t*)curheap; c = (cons_t*)curheap;
@ -1097,24 +1113,24 @@ static value_t apply_cl(uint32_t nargs)
c->car = Stack[SP-2]; c->car = Stack[SP-2];
c->cdr = Stack[SP-1]; c->cdr = Stack[SP-1];
Stack[SP-2] = tagptr(c, TAG_CONS); Stack[SP-2] = tagptr(c, TAG_CONS);
POPN(1); goto next_op; POPN(1); NEXT_OP;
case OP_CAR: OP(OP_CAR)
v = Stack[SP-1]; v = Stack[SP-1];
if (!iscons(v)) type_error("car", "cons", v); if (!iscons(v)) type_error("car", "cons", v);
Stack[SP-1] = car_(v); Stack[SP-1] = car_(v);
goto next_op; NEXT_OP;
case OP_CDR: OP(OP_CDR)
v = Stack[SP-1]; v = Stack[SP-1];
if (!iscons(v)) type_error("cdr", "cons", v); if (!iscons(v)) type_error("cdr", "cons", v);
Stack[SP-1] = cdr_(v); Stack[SP-1] = cdr_(v);
goto next_op; NEXT_OP;
case OP_SETCAR: OP(OP_SETCAR)
car(Stack[SP-2]) = Stack[SP-1]; car(Stack[SP-2]) = Stack[SP-1];
POPN(1); goto next_op; POPN(1); NEXT_OP;
case OP_SETCDR: OP(OP_SETCDR)
cdr(Stack[SP-2]) = Stack[SP-1]; cdr(Stack[SP-2]) = Stack[SP-1];
POPN(1); goto next_op; POPN(1); NEXT_OP;
case OP_LIST: OP(OP_LIST)
n = *ip++; n = *ip++;
apply_list: apply_list:
if (n > 0) { if (n > 0) {
@ -1125,10 +1141,13 @@ static value_t apply_cl(uint32_t nargs)
else { else {
PUSH(NIL); PUSH(NIL);
} }
goto next_op; NEXT_OP;
case OP_TAPPLY: OP(OP_TAPPLY)
case OP_APPLY: OP(OP_APPLY)
#ifdef USE_COMPUTED_GOTO
op = ip[-1];
#endif
n = *ip++; n = *ip++;
apply_apply: apply_apply:
v = POP(); // arglist v = POP(); // arglist
@ -1148,7 +1167,7 @@ static value_t apply_cl(uint32_t nargs)
if (op==OP_TAPPLY) goto do_tcall; if (op==OP_TAPPLY) goto do_tcall;
else goto do_call; else goto do_call;
case OP_ADD: OP(OP_ADD)
n = *ip++; n = *ip++;
apply_add: apply_add:
s = 0; s = 0;
@ -1172,8 +1191,8 @@ static value_t apply_cl(uint32_t nargs)
v = fixnum(s); v = fixnum(s);
POPN(n); POPN(n);
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_ADD2: OP(OP_ADD2)
if (bothfixnums(Stack[SP-1], Stack[SP-2])) { if (bothfixnums(Stack[SP-1], Stack[SP-2])) {
s = numval(Stack[SP-1]) + numval(Stack[SP-2]); s = numval(Stack[SP-1]) + numval(Stack[SP-2]);
if (fits_fixnum(s)) if (fits_fixnum(s))
@ -1186,8 +1205,8 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_SUB: OP(OP_SUB)
n = *ip++; n = *ip++;
apply_sub: apply_sub:
if (n == 2) goto do_sub2; if (n == 2) goto do_sub2;
@ -1202,15 +1221,15 @@ static value_t apply_cl(uint32_t nargs)
v = fl_add_any(&Stack[i], 2, 0); v = fl_add_any(&Stack[i], 2, 0);
POPN(n); POPN(n);
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_NEG: OP(OP_NEG)
do_neg: do_neg:
if (isfixnum(Stack[SP-1])) if (isfixnum(Stack[SP-1]))
Stack[SP-1] = fixnum(-numval(Stack[SP-1])); Stack[SP-1] = fixnum(-numval(Stack[SP-1]));
else else
Stack[SP-1] = fl_neg(Stack[SP-1]); Stack[SP-1] = fl_neg(Stack[SP-1]);
goto next_op; NEXT_OP;
case OP_SUB2: OP(OP_SUB2)
do_sub2: do_sub2:
if (bothfixnums(Stack[SP-2], Stack[SP-1])) { if (bothfixnums(Stack[SP-2], Stack[SP-1])) {
s = numval(Stack[SP-2]) - numval(Stack[SP-1]); s = numval(Stack[SP-2]) - numval(Stack[SP-1]);
@ -1225,8 +1244,8 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_MUL: OP(OP_MUL)
n = *ip++; n = *ip++;
apply_mul: apply_mul:
accum = 1; accum = 1;
@ -1250,8 +1269,8 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(n); POPN(n);
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_DIV: OP(OP_DIV)
n = *ip++; n = *ip++;
apply_div: apply_div:
i = SP-n; i = SP-n;
@ -1269,8 +1288,8 @@ static value_t apply_cl(uint32_t nargs)
POPN(n); POPN(n);
PUSH(v); PUSH(v);
} }
goto next_op; NEXT_OP;
case OP_IDIV: OP(OP_IDIV)
v = Stack[SP-2]; e = Stack[SP-1]; v = Stack[SP-2]; e = Stack[SP-1];
if (bothfixnums(v, e)) { if (bothfixnums(v, e)) {
if (e==0) DivideByZeroError(); if (e==0) DivideByZeroError();
@ -1280,8 +1299,8 @@ static value_t apply_cl(uint32_t nargs)
v = fl_idiv2(v, e); v = fl_idiv2(v, e);
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_NUMEQ: OP(OP_NUMEQ)
v = Stack[SP-2]; e = Stack[SP-1]; v = Stack[SP-2]; e = Stack[SP-1];
if (bothfixnums(v, e)) if (bothfixnums(v, e))
v = (v == e) ? FL_T : FL_F; v = (v == e) ? FL_T : FL_F;
@ -1289,8 +1308,8 @@ static value_t apply_cl(uint32_t nargs)
v = (!numeric_compare(v,e,1,0,"=")) ? FL_T : FL_F; v = (!numeric_compare(v,e,1,0,"=")) ? FL_T : FL_F;
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_LT: OP(OP_LT)
if (bothfixnums(Stack[SP-2], Stack[SP-1])) { if (bothfixnums(Stack[SP-2], Stack[SP-1])) {
v = (numval(Stack[SP-2]) < numval(Stack[SP-1])) ? FL_T : FL_F; v = (numval(Stack[SP-2]) < numval(Stack[SP-1])) ? FL_T : FL_F;
} }
@ -1300,13 +1319,13 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_COMPARE: OP(OP_COMPARE)
Stack[SP-2] = compare(Stack[SP-2], Stack[SP-1]); Stack[SP-2] = compare(Stack[SP-2], Stack[SP-1]);
POPN(1); POPN(1);
goto next_op; NEXT_OP;
case OP_VECTOR: OP(OP_VECTOR)
n = *ip++; n = *ip++;
apply_vector: apply_vector:
if (n > MAX_ARGS) { if (n > MAX_ARGS) {
@ -1328,9 +1347,9 @@ static value_t apply_cl(uint32_t nargs)
} }
} }
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_AREF: OP(OP_AREF)
v = Stack[SP-2]; v = Stack[SP-2];
if (isvector(v)) { if (isvector(v)) {
i = tofixnum(Stack[SP-1], "aref"); i = tofixnum(Stack[SP-1], "aref");
@ -1346,8 +1365,8 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_ASET: OP(OP_ASET)
e = Stack[SP-3]; e = Stack[SP-3];
if (isvector(e)) { if (isvector(e)) {
i = tofixnum(Stack[SP-2], "aset!"); i = tofixnum(Stack[SP-2], "aset!");
@ -1363,8 +1382,8 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(2); POPN(2);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_FOR: OP(OP_FOR)
s = tofixnum(Stack[SP-3], "for"); s = tofixnum(Stack[SP-3], "for");
hi = tofixnum(Stack[SP-2], "for"); hi = tofixnum(Stack[SP-2], "for");
//f = Stack[SP-1]; //f = Stack[SP-1];
@ -1379,31 +1398,31 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(4); POPN(4);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
case OP_LOADT: PUSH(FL_T); goto next_op; OP(OP_LOADT) PUSH(FL_T); NEXT_OP;
case OP_LOADF: PUSH(FL_F); goto next_op; OP(OP_LOADF) PUSH(FL_F); NEXT_OP;
case OP_LOADNIL: PUSH(NIL); goto next_op; OP(OP_LOADNIL) PUSH(NIL); NEXT_OP;
case OP_LOAD0: PUSH(fixnum(0)); goto next_op; OP(OP_LOAD0) PUSH(fixnum(0)); NEXT_OP;
case OP_LOAD1: PUSH(fixnum(1)); goto next_op; OP(OP_LOAD1) PUSH(fixnum(1)); NEXT_OP;
case OP_LOADI8: s = (int8_t)*ip++; PUSH(fixnum(s)); goto next_op; OP(OP_LOADI8) s = (int8_t)*ip++; PUSH(fixnum(s)); NEXT_OP;
case OP_LOADV: OP(OP_LOADV)
v = fn_vals(bp[-1]); v = fn_vals(Stack[bp-1]);
assert(*ip < vector_size(v)); assert(*ip < vector_size(v));
v = vector_elt(v, *ip); ip++; v = vector_elt(v, *ip); ip++;
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_LOADVL: OP(OP_LOADVL)
v = fn_vals(bp[-1]); v = fn_vals(Stack[bp-1]);
v = vector_elt(v, GET_INT32(ip)); ip+=4; v = vector_elt(v, GET_INT32(ip)); ip+=4;
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_LOADGL: OP(OP_LOADGL)
v = fn_vals(bp[-1]); v = fn_vals(Stack[bp-1]);
v = vector_elt(v, GET_INT32(ip)); ip+=4; v = vector_elt(v, GET_INT32(ip)); ip+=4;
goto do_loadg; goto do_loadg;
case OP_LOADG: OP(OP_LOADG)
v = fn_vals(bp[-1]); v = fn_vals(Stack[bp-1]);
assert(*ip < vector_size(v)); assert(*ip < vector_size(v));
v = vector_elt(v, *ip); ip++; v = vector_elt(v, *ip); ip++;
do_loadg: do_loadg:
@ -1412,14 +1431,14 @@ static value_t apply_cl(uint32_t nargs)
if (sym->binding == UNBOUND) if (sym->binding == UNBOUND)
raise(list2(UnboundError, v)); raise(list2(UnboundError, v));
PUSH(sym->binding); PUSH(sym->binding);
goto next_op; NEXT_OP;
case OP_SETGL: OP(OP_SETGL)
v = fn_vals(bp[-1]); v = fn_vals(Stack[bp-1]);
v = vector_elt(v, GET_INT32(ip)); ip+=4; v = vector_elt(v, GET_INT32(ip)); ip+=4;
goto do_setg; goto do_setg;
case OP_SETG: OP(OP_SETG)
v = fn_vals(bp[-1]); v = fn_vals(Stack[bp-1]);
assert(*ip < vector_size(v)); assert(*ip < vector_size(v));
v = vector_elt(v, *ip); ip++; v = vector_elt(v, *ip); ip++;
do_setg: do_setg:
@ -1428,103 +1447,113 @@ static value_t apply_cl(uint32_t nargs)
v = Stack[SP-1]; v = Stack[SP-1];
if (sym->syntax != TAG_CONST) if (sym->syntax != TAG_CONST)
sym->binding = v; sym->binding = v;
goto next_op; NEXT_OP;
case OP_LOADA: OP(OP_LOADA)
assert(nargs > 0); assert(nargs > 0);
i = *ip++; i = *ip++;
if (captured) { if (captured) {
e = *bp; e = Stack[bp];
assert(isvector(e)); assert(isvector(e));
assert(i < vector_size(e)); assert(i < vector_size(e));
v = vector_elt(e, i); v = vector_elt(e, i);
} }
else { else {
v = bp[i]; v = Stack[bp+i];
} }
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_LOADA0: OP(OP_LOADA0)
if (captured) if (captured)
v = vector_elt(*bp, 0); v = vector_elt(Stack[bp], 0);
else else
v = *bp; v = Stack[bp];
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_LOADA1: OP(OP_LOADA1)
if (captured) if (captured)
v = vector_elt(*bp, 1); v = vector_elt(Stack[bp], 1);
else else
v = bp[1]; v = Stack[bp+1];
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_LOADAL: OP(OP_LOADAL)
assert(nargs > 0); assert(nargs > 0);
i = GET_INT32(ip); ip+=4; i = GET_INT32(ip); ip+=4;
if (captured) if (captured)
v = vector_elt(*bp, i); v = vector_elt(Stack[bp], i);
else else
v = bp[i]; v = Stack[bp+i];
PUSH(v); PUSH(v);
goto next_op; NEXT_OP;
case OP_SETA: OP(OP_SETA)
assert(nargs > 0); assert(nargs > 0);
v = Stack[SP-1]; v = Stack[SP-1];
i = *ip++; i = *ip++;
if (captured) { if (captured) {
e = *bp; e = Stack[bp];
assert(isvector(e)); assert(isvector(e));
assert(i < vector_size(e)); assert(i < vector_size(e));
vector_elt(e, i) = v; vector_elt(e, i) = v;
} }
else { else {
bp[i] = v; Stack[bp+i] = v;
} }
goto next_op; NEXT_OP;
case OP_SETAL: OP(OP_SETAL)
assert(nargs > 0); assert(nargs > 0);
v = Stack[SP-1]; v = Stack[SP-1];
i = GET_INT32(ip); ip+=4; i = GET_INT32(ip); ip+=4;
if (captured) if (captured)
vector_elt(*bp, i) = v; vector_elt(Stack[bp], i) = v;
else else
bp[i] = v; Stack[bp+i] = v;
goto next_op; NEXT_OP;
case OP_LOADC: OP(OP_LOADC)
case OP_SETC:
s = *ip++; s = *ip++;
i = *ip++; i = *ip++;
v = bp[nargs]; v = Stack[bp+nargs];
while (s--) while (s--)
v = vector_elt(v, vector_size(v)-1); v = vector_elt(v, vector_size(v)-1);
assert(isvector(v)); assert(isvector(v));
assert(i < vector_size(v)); assert(i < vector_size(v));
if (op == OP_SETC)
vector_elt(v, i) = Stack[SP-1];
else
PUSH(vector_elt(v, i)); PUSH(vector_elt(v, i));
goto next_op; NEXT_OP;
case OP_LOADC00: OP(OP_SETC)
PUSH(vector_elt(bp[nargs], 0)); s = *ip++;
goto next_op; i = *ip++;
case OP_LOADC01: v = Stack[bp+nargs];
PUSH(vector_elt(bp[nargs], 1));
goto next_op;
case OP_LOADCL:
case OP_SETCL:
s = GET_INT32(ip); ip+=4;
i = GET_INT32(ip); ip+=4;
v = bp[nargs];
while (s--) while (s--)
v = vector_elt(v, vector_size(v)-1); v = vector_elt(v, vector_size(v)-1);
if (op == OP_SETCL) assert(isvector(v));
assert(i < vector_size(v));
vector_elt(v, i) = Stack[SP-1]; vector_elt(v, i) = Stack[SP-1];
else NEXT_OP;
OP(OP_LOADC00)
PUSH(vector_elt(Stack[bp+nargs], 0));
NEXT_OP;
OP(OP_LOADC01)
PUSH(vector_elt(Stack[bp+nargs], 1));
NEXT_OP;
OP(OP_LOADCL)
s = GET_INT32(ip); ip+=4;
i = GET_INT32(ip); ip+=4;
v = Stack[bp+nargs];
while (s--)
v = vector_elt(v, vector_size(v)-1);
PUSH(vector_elt(v, i)); PUSH(vector_elt(v, i));
goto next_op; NEXT_OP;
OP(OP_SETCL)
s = GET_INT32(ip); ip+=4;
i = GET_INT32(ip); ip+=4;
v = Stack[bp+nargs];
while (s--)
v = vector_elt(v, vector_size(v)-1);
vector_elt(v, i) = Stack[SP-1];
NEXT_OP;
case OP_CLOSURE: OP(OP_CLOSURE)
case OP_COPYENV: OP(OP_COPYENV)
// build a closure (lambda args body . env) // build a closure (lambda args body . env)
if (nargs > 0 && !captured) { if (nargs > 0 && !captured) {
// save temporary environment to the heap // save temporary environment to the heap
@ -1534,17 +1563,17 @@ static value_t apply_cl(uint32_t nargs)
pv[0] = fixnum(n+1); pv[0] = fixnum(n+1);
pv++; pv++;
do { do {
pv[n] = bp[n]; pv[n] = Stack[bp+n];
} while (n--); } while (n--);
// environment representation changed; install // environment representation changed; install
// the new representation so everybody can see it // the new representation so everybody can see it
captured = 1; captured = 1;
*bp = Stack[SP-1]; Stack[bp] = Stack[SP-1];
} }
else { else {
PUSH(*bp); // env has already been captured; share PUSH(Stack[bp]); // env has already been captured; share
} }
if (op == OP_CLOSURE) { if (ip[-1] == OP_CLOSURE) {
pv = alloc_words(4); pv = alloc_words(4);
e = Stack[SP-2]; // closure to copy e = Stack[SP-2]; // closure to copy
assert(isfunction(e)); assert(isfunction(e));
@ -1554,19 +1583,25 @@ static value_t apply_cl(uint32_t nargs)
POPN(1); POPN(1);
Stack[SP-1] = tagptr(pv, TAG_FUNCTION); Stack[SP-1] = tagptr(pv, TAG_FUNCTION);
} }
goto next_op; NEXT_OP;
case OP_TRYCATCH: OP(OP_TRYCATCH)
v = do_trycatch(); v = do_trycatch();
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
goto next_op; NEXT_OP;
#ifndef USE_COMPUTED_GOTO
default: default:
goto dispatch; goto dispatch;
#endif
} }
} }
#ifdef USE_COMPUTED_GOTO
return UNBOUND; // not reached
#else
goto dispatch; goto dispatch;
#endif
} }
static uint32_t compute_maxstack(uint8_t *code, size_t len) static uint32_t compute_maxstack(uint8_t *code, size_t len)

View File

@ -32,4 +32,44 @@ enum {
N_OPCODES N_OPCODES
}; };
#ifdef USE_COMPUTED_GOTO
#define VM_LABELS \
static void *vm_labels[] = { \
&&L_OP_NOP, &&L_OP_DUP, &&L_OP_POP, &&L_OP_CALL, &&L_OP_TCALL, &&L_OP_JMP, \
&&L_OP_BRF, &&L_OP_BRT, \
&&L_OP_JMPL, &&L_OP_BRFL, &&L_OP_BRTL, &&L_OP_RET, \
\
&&L_OP_EQ, &&L_OP_EQV, &&L_OP_EQUAL, &&L_OP_ATOMP, &&L_OP_NOT, \
&&L_OP_NULLP, &&L_OP_BOOLEANP, \
&&L_OP_SYMBOLP, &&L_OP_NUMBERP, &&L_OP_BOUNDP, &&L_OP_PAIRP, \
&&L_OP_BUILTINP, &&L_OP_VECTORP, \
&&L_OP_FIXNUMP, &&L_OP_FUNCTIONP, \
\
&&L_OP_CONS, &&L_OP_LIST, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_SETCAR, \
&&L_OP_SETCDR, &&L_OP_APPLY, \
\
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_IDIV, &&L_OP_NUMEQ, \
&&L_OP_LT, &&L_OP_COMPARE, \
\
&&L_OP_VECTOR, &&L_OP_AREF, &&L_OP_ASET, \
\
&&L_OP_LOADT, &&L_OP_LOADF, &&L_OP_LOADNIL, &&L_OP_LOAD0, &&L_OP_LOAD1, \
&&L_OP_LOADI8, \
&&L_OP_LOADV, &&L_OP_LOADVL, \
&&L_OP_LOADG, &&L_OP_LOADGL, \
&&L_OP_LOADA, &&L_OP_LOADAL, &&L_OP_LOADC, &&L_OP_LOADCL, \
&&L_OP_SETG, &&L_OP_SETGL, \
&&L_OP_SETA, &&L_OP_SETAL, &&L_OP_SETC, &&L_OP_SETCL, \
\
&&L_OP_CLOSURE, &&L_OP_ARGC, &&L_OP_VARGC, &&L_OP_TRYCATCH, \
&&L_OP_COPYENV, \
&&L_OP_LET, &&L_OP_FOR, \
&&L_OP_TAPPLY, &&L_OP_ADD2, &&L_OP_SUB2, &&L_OP_NEG, &&L_OP_LARGC, \
&&L_OP_LVARGC, \
&&L_OP_LOADA0, &&L_OP_LOADA1, &&L_OP_LOADC00, &&L_OP_LOADC01 \
}
#else
#define VM_LABELS
#endif
#endif #endif