ref: 43cb51f6406bc5f1a59a7c6137db5df44869490c
parent: e119a66bcda2bc6a2903748d1eb994c8110e19ad
author: JeffBezanson <[email protected]>
date: Tue Apr 7 11:55:13 EDT 2009
replacing a recursive call with a goto; saves lots of stack space.
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -660,8 +660,8 @@
#define eval(e) (selfevaluating(e) ? (e) : eval_sexpr((e),penv,0))
#define topeval(e, env) (selfevaluating(e) ? (e) : eval_sexpr((e),env,1))
-#define tail_eval(xpr) do { SP = saveSP; \- if (selfevaluating(xpr)) { return (xpr); } \+#define tail_eval(xpr) do { \+ if (selfevaluating(xpr)) { SP=saveSP; return (xpr); } \ else { e=(xpr); goto eval_top; } } while (0)/* eval a list of expressions, giving a list of the results */
@@ -767,24 +767,30 @@
value_t f, v, *pv, *lenv;
cons_t *c;
symbol_t *sym;
- uint32_t saveSP, envsz, nargs;
+ uint32_t saveSP, bp, envsz, nargs;
int i, noeval=0;
fixnum_t s, lo, hi;
cvalue_t *cv;
int64_t accum;
+ /*
+ ios_printf(ios_stdout, "eval "); print(ios_stdout, e, 0);
+ ios_printf(ios_stdout, " in "); print(ios_stdout, penv[0], 0);
+ ios_printf(ios_stdout, "\n");
+ */
+ saveSP = SP;
eval_top:
if (issymbol(e)) {sym = (symbol_t*)ptr(e);
- if (sym->syntax == TAG_CONST) return sym->binding;
+ if (sym->syntax == TAG_CONST) { SP=saveSP; return sym->binding; } while (1) {v = *penv++;
while (iscons(v)) {- if (car_(v)==e) return *penv;
+ if (car_(v)==e) { SP=saveSP; return *penv; }v = cdr_(v); penv++;
}
if (v != NIL) {- if (v == e) return *penv; // dotted list
+ if (v == e) { SP=saveSP; return *penv; } // dotted listpenv++;
}
if (*penv == NIL) break;
@@ -792,11 +798,15 @@
}
if (__unlikely((v = sym->binding) == UNBOUND))
raise(list2(UnboundError, e));
+ SP = saveSP;
return v;
}
- if (__unlikely(SP >= (N_STACK-MAX_ARGS-4)))
- return new_stackseg(e, penv, tail);
- saveSP = SP;
+ if (__unlikely(SP >= (N_STACK-MAX_ARGS-4))) {+ v = new_stackseg(e, penv, tail);
+ SP = saveSP;
+ return v;
+ }
+ bp = SP;
v = car_(e);
PUSH(cdr_(e));
if (selfevaluating(v)) f=v;
@@ -809,17 +819,17 @@
else {noeval = 2;
PUSH(f);
- v = Stack[saveSP];
+ v = Stack[bp];
goto move_args;
}
}
else f = eval(v);
PUSH(f);
- v = Stack[saveSP];
+ v = Stack[bp];
// evaluate argument list, placing arguments on stack
while (iscons(v)) {- if (SP-saveSP-2 == MAX_ARGS) {- v = evlis(&Stack[saveSP], penv);
+ if (SP-bp-2 == MAX_ARGS) {+ v = evlis(&Stack[bp], penv);
PUSH(v);
break;
}
@@ -826,10 +836,10 @@
v = car_(v);
v = eval(v);
PUSH(v);
- v = Stack[saveSP] = cdr_(Stack[saveSP]);
+ v = Stack[bp] = cdr_(Stack[bp]);
}
do_apply:
- nargs = SP - saveSP - 2;
+ nargs = SP - bp - 2;
if (isbuiltinish(f)) {// handle builtin function
apply_special:
@@ -836,13 +846,13 @@
switch (uintval(f)) {// special forms
case F_QUOTE:
- if (__unlikely(!iscons(Stack[saveSP])))
+ if (__unlikely(!iscons(Stack[bp])))
lerror(ArgError, "quote: expected argument");
- v = car_(Stack[saveSP]);
+ v = car_(Stack[bp]);
break;
case F_SETQ:
- e = car(Stack[saveSP]);
- v = car(cdr_(Stack[saveSP]));
+ e = car(Stack[bp]);
+ v = car(cdr_(Stack[bp]));
v = eval(v);
while (1) {f = *penv++;
@@ -890,7 +900,7 @@
PUSH(penv[1]); // env has already been captured; share
}
c = (cons_t*)ptr(v=cons_reserve(3));
- e = Stack[saveSP];
+ e = Stack[bp];
if (!iscons(e)) goto notpair;
c->car = LAMBDA;
c->cdr = tagptr(c+1, TAG_CONS); c++;
@@ -901,15 +911,15 @@
c->cdr = Stack[SP-1]; //env
break;
case F_IF:
- if (!iscons(Stack[saveSP])) goto notpair;
- v = car_(Stack[saveSP]);
+ if (!iscons(Stack[bp])) goto notpair;
+ v = car_(Stack[bp]);
if (eval(v) != FL_F) {- v = cdr_(Stack[saveSP]);
+ v = cdr_(Stack[bp]);
if (!iscons(v)) goto notpair;
v = car_(v);
}
else {- v = cdr_(Stack[saveSP]);
+ v = cdr_(Stack[bp]);
if (!iscons(v)) goto notpair;
if (!iscons(v=cdr_(v))) v = FL_F; // allow 2-arg form
else v = car_(v);
@@ -917,7 +927,7 @@
tail_eval(v);
break;
case F_COND:
- pv = &Stack[saveSP]; v = FL_F;
+ pv = &Stack[bp]; v = FL_F;
while (iscons(*pv)) {c = tocons(car_(*pv), "cond");
v = c->car;
@@ -941,7 +951,7 @@
}
break;
case F_AND:
- pv = &Stack[saveSP]; v = FL_T;
+ pv = &Stack[bp]; v = FL_T;
if (iscons(*pv)) { while (iscons(cdr_(*pv))) { if ((v=eval(car_(*pv))) == FL_F) {@@ -953,7 +963,7 @@
}
break;
case F_OR:
- pv = &Stack[saveSP]; v = FL_F;
+ pv = &Stack[bp]; v = FL_F;
if (iscons(*pv)) { while (iscons(cdr_(*pv))) { if ((v=eval(car_(*pv))) != FL_F) {@@ -965,11 +975,11 @@
}
break;
case F_WHILE:
- PUSH(cdr(Stack[saveSP]));
+ PUSH(cdr(Stack[bp]));
lenv = &Stack[SP-1];
PUSH(*lenv);
- Stack[saveSP] = car_(Stack[saveSP]);
- value_t *cond = &Stack[saveSP];
+ Stack[bp] = car_(Stack[bp]);
+ value_t *cond = &Stack[bp];
PUSH(FL_F);
pv = &Stack[SP-1];
while (eval(*cond) != FL_F) {@@ -983,7 +993,7 @@
break;
case F_BEGIN:
// return last arg
- pv = &Stack[saveSP];
+ pv = &Stack[bp];
if (iscons(*pv)) { while (iscons(cdr_(*pv))) {v = car_(*pv);
@@ -996,7 +1006,7 @@
break;
case F_PROG1:
// return first arg
- pv = &Stack[saveSP];
+ pv = &Stack[bp];
if (__unlikely(!iscons(*pv)))
lerror(ArgError, "prog1: too few arguments");
PUSH(eval(car_(*pv)));
@@ -1008,7 +1018,7 @@
v = POP();
break;
case F_TRYCATCH:
- v = do_trycatch(car(Stack[saveSP]), penv);
+ v = do_trycatch(car(Stack[bp]), penv);
break;
// ordinary functions
@@ -1033,8 +1043,8 @@
break;
case F_LIST:
if (nargs) {- Stack[saveSP] = v;
- list(&v, nargs, &Stack[saveSP]);
+ Stack[bp] = v;
+ list(&v, nargs, &Stack[bp]);
}
// else v is already set to the final cdr, which is the result
break;
@@ -1065,7 +1075,7 @@
}
else i = 0;
v = alloc_vector(nargs+i, 0);
- memcpy(&vector_elt(v,0), &Stack[saveSP+2], nargs*sizeof(value_t));
+ memcpy(&vector_elt(v,0), &Stack[bp+2], nargs*sizeof(value_t));
if (i > 0) {e = Stack[SP-1];
while (iscons(e)) {@@ -1185,7 +1195,7 @@
break;
case F_ADD:
s = 0;
- i = saveSP+2;
+ i = bp+2;
if (nargs > MAX_ARGS) goto add_ovf;
for (; i < (int)SP; i++) { if (__likely(isfixnum(Stack[i]))) {@@ -1206,7 +1216,7 @@
break;
case F_SUB:
if (__unlikely(nargs < 1)) lerror(ArgError, "-: too few arguments");
- i = saveSP+2;
+ i = bp+2;
if (nargs == 1) {if (__likely(isfixnum(Stack[i])))
v = fixnum(-numval(Stack[i]));
@@ -1239,7 +1249,7 @@
break;
case F_MUL:
accum = 1;
- i = saveSP+2;
+ i = bp+2;
if (nargs > MAX_ARGS) goto mul_ovf;
for (; i < (int)SP; i++) { if (__likely(isfixnum(Stack[i]))) {@@ -1259,7 +1269,7 @@
break;
case F_DIV:
if (__unlikely(nargs < 1)) lerror(ArgError, "/: too few arguments");
- i = saveSP+2;
+ i = bp+2;
if (nargs == 1) {v = fl_div2(fixnum(1), Stack[i]);
}
@@ -1361,8 +1371,8 @@
}
break;
case F_SPECIAL_APPLY:
- f = Stack[saveSP-4];
- v = Stack[saveSP-3];
+ f = Stack[bp-4];
+ v = Stack[bp-3];
PUSH(f);
PUSH(v);
nargs = 2;
@@ -1369,12 +1379,12 @@
// falls through!!
case F_APPLY:
argcount("apply", nargs, 2);- v = Stack[saveSP] = Stack[SP-1]; // second arg is new arglist
- f = Stack[saveSP+1] = Stack[SP-2]; // first arg is new function
+ v = Stack[bp] = Stack[SP-1]; // second arg is new arglist
+ f = Stack[bp+1] = Stack[SP-2]; // first arg is new function
POPN(2); // pop apply's args
move_args:
while (iscons(v)) {- if (SP-saveSP-2 == MAX_ARGS) {+ if (SP-bp-2 == MAX_ARGS) {PUSH(v);
break;
}
@@ -1388,7 +1398,7 @@
goto apply_type_error;
default:
// function pointer tagged as a builtin
- v = ((builtin_t)ptr(f))(&Stack[saveSP+2], nargs);
+ v = ((builtin_t)ptr(f))(&Stack[bp+2], nargs);
}
SP = saveSP;
return v;
@@ -1395,8 +1405,8 @@
}
if (__likely(iscons(f))) {// apply lambda expression
- f = Stack[saveSP+1];
- f = Stack[saveSP+1] = cdr_(f);
+ f = Stack[bp+1];
+ f = Stack[bp+1] = cdr_(f);
if (!iscons(f)) goto notpair;
v = car_(f); // arglist
i = nargs;
@@ -1424,20 +1434,19 @@
PUSH(NIL);
}
}
- f = cdr_(Stack[saveSP+1]);
+ f = cdr_(Stack[bp+1]);
if (!iscons(f)) goto notpair;
e = car_(f);
if (selfevaluating(e)) { SP=saveSP; return(e); }PUSH(cdr_(f)); // add closed environment
- Stack[saveSP+1] = car_(Stack[saveSP+1]); // put lambda list
- envsz = SP - saveSP - 1;
+ Stack[bp+1] = car_(Stack[bp+1]); // put lambda list
+ envsz = SP - bp - 1;
if (noeval == 2) {// macro: evaluate body in lambda environment
- Stack[saveSP] = fixnum(envsz);
- e = eval_sexpr(e, &Stack[saveSP+1], 1);
- SP = saveSP;
- if (selfevaluating(e)) return(e);
+ Stack[bp] = fixnum(envsz);
+ e = eval_sexpr(e, &Stack[bp+1], 1);
+ if (selfevaluating(e)) { SP=saveSP; return(e); }noeval = 0;
// macro: evaluate expansion in calling environment
goto eval_top;
@@ -1447,15 +1456,15 @@
// ok to overwrite environment
penv[-1] = fixnum(envsz);
for(i=0; i < (int)envsz; i++)
- penv[i] = Stack[saveSP+1+i];
+ penv[i] = Stack[bp+1+i];
SP = (penv-Stack)+envsz;
goto eval_top;
}
else {- Stack[saveSP] = fixnum(envsz);
- v = eval_sexpr(e, &Stack[saveSP+1], 1);
- SP = saveSP;
- return v;
+ Stack[bp] = fixnum(envsz);
+ penv = &Stack[bp+1];
+ tail = 1;
+ goto eval_top;
}
}
// not reached