From 180b05fa8e5ce0dd7a172c3a5cfad3fcec8f7073 Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Fri, 18 Jul 2008 04:16:07 +0000 Subject: [PATCH] storing environment size on the stack so lambda doesn't need to compute it. changed penv from pointer to stack index. result is best performance yet. fixing constantp to be true for quoted values --- femtolisp/builtins.c | 7 ++- femtolisp/flisp.c | 102 ++++++++++++++++++++++--------------------- femtolisp/todo | 4 +- 3 files changed, 60 insertions(+), 53 deletions(-) diff --git a/femtolisp/builtins.c b/femtolisp/builtins.c index ae1e40c..d0760d5 100644 --- a/femtolisp/builtins.c +++ b/femtolisp/builtins.c @@ -148,13 +148,18 @@ value_t fl_global_env(value_t *args, u_int32_t nargs) return POP(); } +extern value_t QUOTE; + value_t fl_constantp(value_t *args, u_int32_t nargs) { argcount("constantp", nargs, 1); if (issymbol(args[0])) return (isconstant(args[0]) ? T : NIL); - if (iscons(args[0])) + if (iscons(args[0])) { + if (car_(args[0]) == QUOTE) + return T; return NIL; + } return T; } diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index d5c91f0..09b663d 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -90,7 +90,7 @@ value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError; value_t DivideError, BoundsError, Error; value_t conssym, symbolsym, fixnumsym, vectorsym, builtinsym; -static value_t eval_sexpr(value_t e, value_t *penv, int tail); +static value_t eval_sexpr(value_t e, uint32_t penv, int tail); static value_t *alloc_words(int n); static value_t relocate(value_t v); static void do_print(FILE *f, value_t v, int princ); @@ -614,7 +614,7 @@ static value_t assoc(value_t item, value_t v) if (tag(xpr)<0x2) { return (xpr); } \ else { e=(xpr); goto eval_top; } } while (0) -static value_t do_trycatch(value_t expr, value_t *penv) +static value_t do_trycatch(value_t expr, uint32_t penv) { value_t v; @@ -650,16 +650,18 @@ static value_t do_trycatch(value_t expr, value_t *penv) of the stack from LL through CLO. There might be zero values, in which case LL is NIL. + Stack[penv-1] is the size of the whole environment (as a fixnum) + if tail==1, you are allowed (indeed encouraged) to overwrite this environment, otherwise you have to put any new environment on the top of the stack. */ -static value_t eval_sexpr(value_t e, value_t *penv, int tail) +static value_t eval_sexpr(value_t e, uint32_t penv, int tail) { - value_t f, v, *pv, *argsyms, *body, *lenv; + value_t f, v, *pv, *argsyms, *body; cons_t *c; symbol_t *sym; - u_int32_t saveSP, envsz; + uint32_t saveSP, envsz, lenv; int i, nargs, noeval=0; fixnum_t s; cvalue_t *cv; @@ -669,17 +671,17 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail) if (issymbol(e)) { sym = (symbol_t*)ptr(e); if (sym->syntax == TAG_CONST) return sym->binding; + pv = &Stack[penv]; while (1) { - v = *penv++; + v = *pv++; while (iscons(v)) { - if (car_(v)==e) return *penv; - v = cdr_(v); penv++; + if (car_(v)==e) return *pv; + v = cdr_(v); pv++; } - if (v == e) return *penv; // dotted list - if (v != NIL) penv++; - if (*penv == NIL) - break; - penv = &vector_elt(*penv, 0); + if (v == e) return *pv; // dotted list + if (v != NIL) pv++; + if (*pv == NIL) break; + pv = &vector_elt(*pv, 0); } if ((v = sym->binding) == UNBOUND) raise(list2(UnboundError, e)); @@ -722,30 +724,23 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail) break; case F_LAMBDA: // build a closure (lambda args body . env) - if (*penv != NIL) { + if (Stack[penv] != NIL) { // save temporary environment to the heap lenv = penv; - //envsz = saveSP - (penv - &Stack[0]); - envsz = 2; - v = *penv; - while (iscons(v)) { - envsz++; - v = cdr_(v); - } - if (v != NIL) envsz++; + envsz = numval(Stack[penv-1]); pv = alloc_words(envsz + 1); PUSH(tagptr(pv, TAG_BUILTIN)); pv[0] = envsz<<2; pv++; while (envsz--) - *pv++ = *penv++; + *pv++ = Stack[penv++]; // environment representation changed; install // the new representation so everybody can see it - lenv[0] = NIL; - lenv[1] = Stack[SP-1]; + Stack[lenv] = NIL; + Stack[lenv+1] = Stack[SP-1]; } else { - PUSH(penv[1]); // env has already been captured; share + PUSH(Stack[penv+1]); // env has already been captured; share } c = (cons_t*)ptr(v=cons_reserve(3)); c->car = LAMBDA; @@ -843,25 +838,25 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail) case F_SET: argcount("set", nargs, 2); e = Stack[SP-2]; + pv = &Stack[penv]; while (1) { - v = *penv++; + v = *pv++; while (iscons(v)) { if (car_(v)==e) { - *penv = Stack[SP-1]; + *pv = Stack[SP-1]; SP=saveSP; - return *penv; + return *pv; } - v = cdr_(v); penv++; + v = cdr_(v); pv++; } if (v == e) { - *penv = Stack[SP-1]; + *pv = Stack[SP-1]; SP=saveSP; - return *penv; + return *pv; } - if (v != NIL) penv++; - if (*penv == NIL) - break; - penv = &vector_elt(*penv, 0); + if (v != NIL) pv++; + if (*pv == NIL) break; + pv = &vector_elt(*pv, 0); } sym = tosymbol(e, "set"); v = Stack[SP-1]; @@ -1134,17 +1129,18 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail) v = Stack[SP-1]; if (tag(v)<0x2) { SP=saveSP; return v; } if (tail) { - penv[0] = NIL; - penv[1] = NIL; - //envsz = 0; - SP = (u_int32_t)(penv-&Stack[0]) + 2; + Stack[penv-1] = fixnum(2); + Stack[penv] = NIL; + Stack[penv+1] = NIL; + SP = penv + 2; e=v; goto eval_top; } else { + PUSH(fixnum(2)); PUSH(NIL); PUSH(NIL); - v = eval_sexpr(v, &Stack[SP-2], 1); + v = eval_sexpr(v, SP-2, 1); } break; case F_RAISE: @@ -1260,29 +1256,34 @@ static value_t eval_sexpr(value_t e, value_t *penv, int tail) PUSH(cdr(f)); e = car_(f); - // macro: evaluate expansion in the calling environment if (noeval == 2) { + // macro: evaluate body in lambda environment if (tag(e)<0x2) ; - else e = eval_sexpr(e, argsyms, 1); + else { + Stack[saveSP+1] = fixnum(SP-saveSP-2); + e = eval_sexpr(e, saveSP+2, 1); + } SP = saveSP; if (tag(e)<0x2) return(e); noeval = 0; + // macro: evaluate expansion in calling environment goto eval_top; } else { if (tag(e)<0x2) { SP=saveSP; return(e); } + envsz = SP - saveSP - 2; if (tail) { noeval = 0; // ok to overwrite environment - s = SP - saveSP - 2; - for(i=0; i < s; i++) - penv[i] = argsyms[i]; - SP = (u_int32_t)((penv+s) - &Stack[0]); - //envsz = s; + for(i=0; i < (int)envsz; i++) + Stack[penv+i] = Stack[saveSP+2+i]; + SP = penv+envsz; + Stack[penv-1] = fixnum(envsz); goto eval_top; } else { - v = eval_sexpr(e, argsyms, 1); + Stack[saveSP+1] = fixnum(envsz); + v = eval_sexpr(e, saveSP+2, 1); SP = saveSP; return v; } @@ -1366,9 +1367,10 @@ value_t toplevel_eval(value_t expr) { value_t v; u_int32_t saveSP = SP; + PUSH(fixnum(2)); PUSH(NIL); PUSH(NIL); - v = topeval(expr, &Stack[SP-2]); + v = topeval(expr, SP-2); SP = saveSP; return v; } diff --git a/femtolisp/todo b/femtolisp/todo index 14cbdc1..825c858 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -112,7 +112,7 @@ for internal use: - a special version of apply that takes arguments on the stack, to avoid consing when implementing "call-with" style primitives like trycatch, hashtable-foreach, or the fl_apply API -try this environment representation: +- try this environment representation: for all kinds of functions (except maybe builtin special forms) push all arguments on the stack, either evaluated or not. for lambdas, push the lambda list and next-env pointers. @@ -770,7 +770,7 @@ String API string.dec string.char - char at byte offset string.count - # of chars between 2 byte offsets -*string.sub - substring between 2 byte offsets, or nil for beginning/end +*string.sub - substring between 2 byte offsets *string.split - (string.split s sep-chars) string.trim - (string.trim s chars-at-start chars-at-end) *string.reverse