conservatory
/
femtolisp
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

some performance tweaks

This commit is contained in:
JeffBezanson 2009-04-27 03:21:53 +00:00
parent de19e4f401
commit 14d625bd83
3 changed files with 99 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
femtolisp/Makefile
View File

@ -12,7 +12,7 @@ FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAG
LIBS = $(LLT) -lm LIBS = $(LLT) -lm
DEBUGFLAGS = -g -DDEBUG $(FLAGS) DEBUGFLAGS = -g -DDEBUG $(FLAGS)
SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer $(FLAGS) SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer -mtune=generic -march=i686 $(FLAGS)
default: release test default: release test

18
femtolisp/compiler.lsp
View File

@ -377,18 +377,18 @@
(emit g (if (and tail? (eq? b :apply)) :tapply b))))) (emit g (if (and tail? (eq? b :apply)) :tapply b)))))
(emit g (if tail? :tcall :call) nargs))))))) (emit g (if tail? :tcall :call) nargs)))))))
(define (fits-i8 x) (and (fixnum? x) (>= x -128) (<= x 127)))
(define (compile-in g env tail? x) (define (compile-in g env tail? x)
(cond ((symbol? x) (compile-sym g env x [:loada :loadc :loadg])) (cond ((symbol? x) (compile-sym g env x [:loada :loadc :loadg]))
((atom? x) ((atom? x)
(cond ((eq? x 0) (emit g :load0)) (cond ((eq? x 0) (emit g :load0))
((eq? x 1) (emit g :load1)) ((eq? x 1) (emit g :load1))
((eq? x #t) (emit g :loadt)) ((eq? x #t) (emit g :loadt))
((eq? x #f) (emit g :loadf)) ((eq? x #f) (emit g :loadf))
((eq? x ()) (emit g :loadnil)) ((eq? x ()) (emit g :loadnil))
((and (fixnum? x) ((fits-i8 x) (emit g :loadi8 x))
(>= x -128) (else (emit g :loadv x))))
(<= x 127)) (emit g :loadi8 x))
(else (emit g :loadv x))))
(else (else
(case (car x) (case (car x)
(quote (emit g :loadv (cadr x))) (quote (emit g :loadv (cadr x)))

177
femtolisp/flisp.c
View File

@ -765,7 +765,8 @@ static value_t apply_cl(uint32_t nargs)
PUSH(fn->env); PUSH(fn->env);
ip = 0; ip = 0;
while (1) { {
next_op:
op = code[ip++]; op = code[ip++];
dispatch: dispatch:
switch (op) { switch (op) {
@ -773,7 +774,7 @@ static value_t apply_cl(uint32_t nargs)
if (nargs > code[ip++]) { if (nargs > code[ip++]) {
lerror(ArgError, "apply: too many arguments"); lerror(ArgError, "apply: too many arguments");
} }
break; goto next_op;
case OP_VARGC: case OP_VARGC:
i = code[ip++]; i = code[ip++];
s = (fixnum_t)nargs - (fixnum_t)i; s = (fixnum_t)nargs - (fixnum_t)i;
@ -793,33 +794,33 @@ static value_t apply_cl(uint32_t nargs)
Stack[SP-2] = NIL; Stack[SP-2] = NIL;
} }
nargs = i+1; nargs = i+1;
break; goto next_op;
case OP_LET: case OP_LET:
ip++; ip++;
// last arg is closure environment to use // last arg is closure environment to use
nargs--; nargs--;
POPN(1); POPN(1);
break; goto next_op;
case OP_NOP: break; case OP_NOP: goto next_op;
case OP_DUP: v = Stack[SP-1]; PUSH(v); break; case OP_DUP: v = Stack[SP-1]; PUSH(v); goto next_op;
case OP_POP: POPN(1); break; case OP_POP: POPN(1); goto next_op;
case OP_TCALL: case OP_TCALL:
n = code[ip++]; // nargs
if (isfunction(Stack[SP-n-1])) {
for(s=-1; s < (fixnum_t)n; s++)
Stack[bp+s] = Stack[SP-n+s];
SP = bp+n;
nargs = n;
goto apply_cl_top;
}
goto do_call;
case OP_CALL: case OP_CALL:
n = code[ip++]; // nargs n = code[ip++]; // nargs
do_call: do_call:
s = SP;
func = Stack[SP-n-1]; func = Stack[SP-n-1];
s = SP;
if (isfunction(func)) { if (isfunction(func)) {
if (op == OP_TCALL) { v = apply_cl(n);
for(s=-1; s < (fixnum_t)n; s++)
Stack[bp+s] = Stack[SP-n+s];
SP = bp+n;
nargs = n;
goto apply_cl_top;
}
else {
v = apply_cl(n);
}
} }
else if (isbuiltinish(func)) { else if (isbuiltinish(func)) {
op = uintval(func); op = uintval(func);
@ -853,36 +854,36 @@ static value_t apply_cl(uint32_t nargs)
else { else {
type_error("apply", "function", func); type_error("apply", "function", func);
} }
SP = s-n-1; SP = s-n;
PUSH(v); Stack[SP-1] = v;
break; goto next_op;
case OP_JMP: ip = (uint32_t)*(uint16_t*)&code[ip]; break; case OP_JMP: ip = (uint32_t)*(uint16_t*)&code[ip]; goto next_op;
case OP_BRF: case OP_BRF:
v = POP(); v = POP();
if (v == FL_F) ip = (uint32_t)*(uint16_t*)&code[ip]; if (v == FL_F) ip = (uint32_t)*(uint16_t*)&code[ip];
else ip += 2; else ip += 2;
break; goto next_op;
case OP_BRT: case OP_BRT:
v = POP(); v = POP();
if (v != FL_F) ip = (uint32_t)*(uint16_t*)&code[ip]; if (v != FL_F) ip = (uint32_t)*(uint16_t*)&code[ip];
else ip += 2; else ip += 2;
break; goto next_op;
case OP_JMPL: ip = *(uint32_t*)&code[ip]; break; case OP_JMPL: ip = *(uint32_t*)&code[ip]; goto next_op;
case OP_BRFL: case OP_BRFL:
v = POP(); v = POP();
if (v == FL_F) ip = *(uint32_t*)&code[ip]; if (v == FL_F) ip = *(uint32_t*)&code[ip];
else ip += 4; else ip += 4;
break; goto next_op;
case OP_BRTL: case OP_BRTL:
v = POP(); v = POP();
if (v != FL_F) ip = *(uint32_t*)&code[ip]; if (v != FL_F) ip = *(uint32_t*)&code[ip];
else ip += 4; else ip += 4;
break; goto next_op;
case OP_RET: v = POP(); return v; case OP_RET: v = POP(); return v;
case OP_EQ: case 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); break; POPN(1); goto next_op;
case OP_EQV: case OP_EQV:
if (Stack[SP-2] == Stack[SP-1]) { if (Stack[SP-2] == Stack[SP-1]) {
v = FL_T; v = FL_T;
@ -895,7 +896,7 @@ static value_t apply_cl(uint32_t nargs)
FL_T : FL_F; FL_T : FL_F;
} }
Stack[SP-2] = v; POPN(1); Stack[SP-2] = v; POPN(1);
break; goto next_op;
case OP_EQUAL: case OP_EQUAL:
if (Stack[SP-2] == Stack[SP-1]) { if (Stack[SP-2] == Stack[SP-1]) {
v = FL_T; v = FL_T;
@ -908,41 +909,41 @@ static value_t apply_cl(uint32_t nargs)
FL_T : FL_F; FL_T : FL_F;
} }
Stack[SP-2] = v; POPN(1); Stack[SP-2] = v; POPN(1);
break; goto next_op;
case OP_PAIRP: case OP_PAIRP:
Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_T : FL_F); break; Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
case OP_ATOMP: case OP_ATOMP:
Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_F : FL_T); break; Stack[SP-1] = (iscons(Stack[SP-1]) ? FL_F : FL_T); goto next_op;
case OP_NOT: case OP_NOT:
Stack[SP-1] = ((Stack[SP-1]==FL_F) ? FL_T : FL_F); break; Stack[SP-1] = ((Stack[SP-1]==FL_F) ? FL_T : FL_F); goto next_op;
case OP_NULLP: case OP_NULLP:
Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); break; Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); goto next_op;
case OP_BOOLEANP: case OP_BOOLEANP:
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = ((v == FL_T || v == FL_F) ? FL_T : FL_F); break; Stack[SP-1] = ((v == FL_T || v == FL_F) ? FL_T : FL_F); goto next_op;
case OP_SYMBOLP: case OP_SYMBOLP:
Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); break; Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
case OP_NUMBERP: case OP_NUMBERP:
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = (isfixnum(v) || iscprim(v) ? FL_T : FL_F); break; Stack[SP-1] = (isfixnum(v) || iscprim(v) ? FL_T : FL_F); goto next_op;
case OP_FIXNUMP: case OP_FIXNUMP:
Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); break; Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
case OP_BOUNDP: case 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);
break; goto next_op;
case OP_BUILTINP: case OP_BUILTINP:
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL) Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL)
? FL_T : FL_F); ? FL_T : FL_F);
break; goto next_op;
case OP_FUNCTIONP: case OP_FUNCTIONP:
v = Stack[SP-1]; v = Stack[SP-1];
Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL) || Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL) ||
isfunction(v)) ? FL_T : FL_F; isfunction(v)) ? FL_T : FL_F;
break; goto next_op;
case OP_VECTORP: case OP_VECTORP:
Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); break; Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); goto next_op;
case OP_CONS: case OP_CONS:
if (curheap > lim) if (curheap > lim)
@ -952,23 +953,23 @@ 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); break; POPN(1); goto next_op;
case OP_CAR: case 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);
break; goto next_op;
case OP_CDR: case 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);
break; goto next_op;
case OP_SETCAR: case OP_SETCAR:
car(Stack[SP-2]) = Stack[SP-1]; car(Stack[SP-2]) = Stack[SP-1];
POPN(1); break; POPN(1); goto next_op;
case OP_SETCDR: case OP_SETCDR:
cdr(Stack[SP-2]) = Stack[SP-1]; cdr(Stack[SP-2]) = Stack[SP-1];
POPN(1); break; POPN(1); goto next_op;
case OP_LIST: case OP_LIST:
n = code[ip++]; n = code[ip++];
apply_list: apply_list:
@ -980,7 +981,7 @@ static value_t apply_cl(uint32_t nargs)
else { else {
PUSH(NIL); PUSH(NIL);
} }
break; goto next_op;
case OP_TAPPLY: case OP_TAPPLY:
case OP_APPLY: case OP_APPLY:
@ -1022,21 +1023,21 @@ static value_t apply_cl(uint32_t nargs)
v = fixnum(s); v = fixnum(s);
POPN(n); POPN(n);
PUSH(v); PUSH(v);
break; goto next_op;
case OP_ADD2: case OP_ADD2:
if (bothfixnums(Stack[SP-1], Stack[SP-2])) { if (bothfixnums(Stack[SP-1], Stack[SP-2])) {
accum = (int64_t)numval(Stack[SP-1]) + numval(Stack[SP-2]); s = numval(Stack[SP-1]) + numval(Stack[SP-2]);
if (fits_fixnum(accum)) if (fits_fixnum(s))
v = fixnum(accum); v = fixnum(s);
else else
v = return_from_int64(accum); v = mk_long(s);
} }
else { else {
v = fl_add_any(&Stack[SP-2], 2, 0); v = fl_add_any(&Stack[SP-2], 2, 0);
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
case OP_SUB: case OP_SUB:
n = code[ip++]; n = code[ip++];
apply_sub: apply_sub:
@ -1052,32 +1053,30 @@ 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);
break; goto next_op;
case OP_NEG: case OP_NEG:
do_neg: do_neg:
if (__likely(isfixnum(Stack[SP-1]))) if (__likely(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]);
break; goto next_op;
case OP_SUB2: case OP_SUB2:
do_sub2: do_sub2:
if (__likely(bothfixnums(Stack[SP-2], Stack[SP-1]))) { if (__likely(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]);
if (__likely(fits_fixnum(s))) { if (__likely(fits_fixnum(s)))
POPN(1); v = fixnum(s);
Stack[SP-1] = fixnum(s); else
break; v = mk_long(s);
}
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]);
v = fl_add_any(&Stack[SP-2], 2, 0);
} }
v = fl_add_any(&Stack[SP-2], 2, 0);
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
case OP_MUL: case OP_MUL:
n = code[ip++]; n = code[ip++];
apply_mul: apply_mul:
@ -1102,7 +1101,7 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(n); POPN(n);
PUSH(v); PUSH(v);
break; goto next_op;
case OP_DIV: case OP_DIV:
n = code[ip++]; n = code[ip++];
apply_div: apply_div:
@ -1121,7 +1120,7 @@ static value_t apply_cl(uint32_t nargs)
POPN(n); POPN(n);
PUSH(v); PUSH(v);
} }
break; goto next_op;
case OP_NUMEQ: case 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)) {
@ -1132,7 +1131,7 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
case OP_LT: case 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;
@ -1143,11 +1142,11 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
case OP_COMPARE: case 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);
break; goto next_op;
case OP_VECTOR: case OP_VECTOR:
n = code[ip++]; n = code[ip++];
@ -1171,7 +1170,7 @@ static value_t apply_cl(uint32_t nargs)
} }
} }
PUSH(v); PUSH(v);
break; goto next_op;
case OP_AREF: case OP_AREF:
v = Stack[SP-2]; v = Stack[SP-2];
@ -1189,7 +1188,7 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
case OP_ASET: case OP_ASET:
e = Stack[SP-3]; e = Stack[SP-3];
if (isvector(e)) { if (isvector(e)) {
@ -1206,7 +1205,7 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(2); POPN(2);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
case OP_FOR: case OP_FOR:
lo = tofixnum(Stack[SP-3], "for"); lo = tofixnum(Stack[SP-3], "for");
hi = tofixnum(Stack[SP-2], "for"); hi = tofixnum(Stack[SP-2], "for");
@ -1222,25 +1221,25 @@ static value_t apply_cl(uint32_t nargs)
} }
POPN(4); POPN(4);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
case OP_LOADT: PUSH(FL_T); break; case OP_LOADT: PUSH(FL_T); goto next_op;
case OP_LOADF: PUSH(FL_F); break; case OP_LOADF: PUSH(FL_F); goto next_op;
case OP_LOADNIL: PUSH(NIL); break; case OP_LOADNIL: PUSH(NIL); goto next_op;
case OP_LOAD0: PUSH(fixnum(0)); break; case OP_LOAD0: PUSH(fixnum(0)); goto next_op;
case OP_LOAD1: PUSH(fixnum(1)); break; case OP_LOAD1: PUSH(fixnum(1)); goto next_op;
case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); break; case OP_LOADI8: s = (int8_t)code[ip++]; PUSH(fixnum(s)); goto next_op;
case OP_LOADV: case OP_LOADV:
v = fn_vals(Stack[bp-1]); v = fn_vals(Stack[bp-1]);
assert(code[ip] < vector_size(v)); assert(code[ip] < vector_size(v));
v = vector_elt(v, code[ip]); ip++; v = vector_elt(v, code[ip]); ip++;
PUSH(v); PUSH(v);
break; goto next_op;
case OP_LOADVL: case OP_LOADVL:
v = fn_vals(Stack[bp-1]); v = fn_vals(Stack[bp-1]);
v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4; v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4;
PUSH(v); PUSH(v);
break; goto next_op;
case OP_LOADGL: case OP_LOADGL:
v = fn_vals(Stack[bp-1]); v = fn_vals(Stack[bp-1]);
v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4; v = vector_elt(v, *(uint32_t*)&code[ip]); ip+=4;
@ -1255,7 +1254,7 @@ 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);
break; goto next_op;
case OP_SETGL: case OP_SETGL:
v = fn_vals(Stack[bp-1]); v = fn_vals(Stack[bp-1]);
@ -1271,7 +1270,7 @@ 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;
break; goto next_op;
case OP_LOADA: case OP_LOADA:
assert(nargs > 0); assert(nargs > 0);
@ -1287,7 +1286,7 @@ static value_t apply_cl(uint32_t nargs)
v = Stack[bp+i]; v = Stack[bp+i];
} }
PUSH(v); PUSH(v);
break; goto next_op;
case OP_SETA: case OP_SETA:
assert(nargs > 0); assert(nargs > 0);
v = Stack[SP-1]; v = Stack[SP-1];
@ -1302,7 +1301,7 @@ static value_t apply_cl(uint32_t nargs)
assert(bp+i < SP); assert(bp+i < SP);
Stack[bp+i] = v; Stack[bp+i] = v;
} }
break; goto next_op;
case OP_LOADC: case OP_LOADC:
case OP_SETC: case OP_SETC:
s = code[ip++]; s = code[ip++];
@ -1316,7 +1315,7 @@ static value_t apply_cl(uint32_t nargs)
vector_elt(v, i) = Stack[SP-1]; vector_elt(v, i) = Stack[SP-1];
else else
PUSH(vector_elt(v, i)); PUSH(vector_elt(v, i));
break; goto next_op;
case OP_CLOSURE: case OP_CLOSURE:
case OP_CLOSE: case OP_CLOSE:
@ -1352,15 +1351,17 @@ static value_t apply_cl(uint32_t nargs)
POPN(1); POPN(1);
Stack[SP-1] = tagptr(pv, TAG_CVALUE); Stack[SP-1] = tagptr(pv, TAG_CVALUE);
} }
break; goto next_op;
case OP_TRYCATCH: case OP_TRYCATCH:
v = do_trycatch(); v = do_trycatch();
POPN(1); POPN(1);
Stack[SP-1] = v; Stack[SP-1] = v;
break; goto next_op;
} }
} }
assert(0);
return UNBOUND;
} }
// initialization ------------------------------------------------------------- // initialization -------------------------------------------------------------