From 264df1f90b03973340fd96d85cbec744af77a65d Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Tue, 28 Apr 2009 04:10:18 +0000 Subject: [PATCH] improving closure representation some performance tweaks --- femtolisp/Makefile | 2 +- femtolisp/cvalues.c | 37 +++++----- femtolisp/equal.c | 17 +++-- femtolisp/flisp.c | 168 +++++++++++++++++--------------------------- femtolisp/flisp.h | 13 ++-- femtolisp/print.c | 63 +++++++++++------ femtolisp/todo | 1 + 7 files changed, 146 insertions(+), 155 deletions(-) diff --git a/femtolisp/Makefile b/femtolisp/Makefile index ff40f4f..f8325c3 100644 --- a/femtolisp/Makefile +++ b/femtolisp/Makefile @@ -12,7 +12,7 @@ FLAGS = -falign-functions -Wall -Wextra -Wno-strict-aliasing -I$(LLTDIR) $(CFLAG LIBS = $(LLT) -lm DEBUGFLAGS = -g -DDEBUG $(FLAGS) -SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer -mtune=generic -march=i686 $(FLAGS) +SHIPFLAGS = -O3 -DNDEBUG -fomit-frame-pointer -march=native $(FLAGS) default: release test diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 0ddfa72..7249990 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -635,12 +635,14 @@ value_t cvalue_typeof(value_t *args, u_int32_t nargs) case TAG_NUM: return fixnumsym; case TAG_SYM: return symbolsym; case TAG_VECTOR: return vectorsym; - case TAG_BUILTIN: + case TAG_FUNCTION: if (args[0] == FL_T || args[0] == FL_F) return booleansym; if (args[0] == NIL) return nullsym; - return builtinsym; + if (isbuiltin(args[0])) + return builtinsym; + return FUNCTION; } return cv_type((cvalue_t*)ptr(args[0])); } @@ -877,31 +879,26 @@ value_t fl_builtin(value_t *args, u_int32_t nargs) { argcount("builtin", nargs, 1); symbol_t *name = tosymbol(args[0], "builtin"); - builtin_t f; - if (ismanaged(args[0]) || (f=(builtin_t)name->dlcache) == NULL) { + cvalue_t *cv; + if (ismanaged(args[0]) || (cv=name->dlcache) == NULL) { lerror(ArgError, "builtin: function not found"); } - return tagptr(f, TAG_BUILTIN); + return tagptr(cv, TAG_CVALUE); } value_t cbuiltin(char *name, builtin_t f) { - assert(((uptrint_t)f & 0x7) == 0); + cvalue_t *cv = (cvalue_t*)malloc(CVALUE_NWORDS * sizeof(value_t)); + cv->type = builtintype; + cv->data = &cv->_space[0]; + cv->len = sizeof(value_t); + *(void**)cv->data = f; + value_t sym = symbol(name); - ((symbol_t*)ptr(sym))->dlcache = f; - ptrhash_put(&reverse_dlsym_lookup_table, f, (void*)sym); - return tagptr(f, TAG_BUILTIN); - /* - value_t gf = cvalue(builtintype, sizeof(void*)); - ((cvalue_t*)ptr(gf))->data = f; - size_t nw = cv_nwords((cvalue_t*)ptr(gf)); - // directly-callable values are assumed not to move for - // evaluator performance, so put builtin func metadata on the - // unmanaged heap - cvalue_t *buf = malloc(nw * sizeof(value_t)); - memcpy(buf, ptr(gf), nw*sizeof(value_t)); - return tagptr(buf, TAG_BUILTIN); - */ + ((symbol_t*)ptr(sym))->dlcache = cv; + ptrhash_put(&reverse_dlsym_lookup_table, cv, (void*)sym); + + return tagptr(cv, TAG_CVALUE); } static value_t fl_logand(value_t *args, u_int32_t nargs); diff --git a/femtolisp/equal.c b/femtolisp/equal.c index aac2461..a86882b 100644 --- a/femtolisp/equal.c +++ b/femtolisp/equal.c @@ -91,11 +91,16 @@ static value_t bounded_compare(value_t a, value_t b, int bound, int eq) return fixnum(c); break; case TAG_CVALUE: - if (iscvalue(b)) - return cvalue_compare(a, b); + if (iscvalue(b)) { + if (cv_isPOD((cvalue_t*)ptr(a)) && cv_isPOD((cvalue_t*)ptr(b))) + return cvalue_compare(a, b); + return fixnum(1); + } break; - case TAG_BUILTIN: - if (tagb == TAG_BUILTIN) { + case TAG_FUNCTION: + if (uintval(a) > N_BUILTINS || uintval(b) > N_BUILTINS) + return fixnum(1); + if (tagb == TAG_FUNCTION) { return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1); } break; @@ -267,7 +272,9 @@ static uptrint_t bounded_hash(value_t a, int bound) case TAG_NUM1: d = numval(a); return doublehash(*(int64_t*)&d); - case TAG_BUILTIN: + case TAG_FUNCTION: + if (uintval(a) > N_BUILTINS) + return bounded_hash(((function_t*)ptr(a))->bcode, bound); return inthash(a); case TAG_SYM: return ((symbol_t*)ptr(a))->hash; diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 234eb6d..36688f2 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -95,7 +95,6 @@ value_t DivideError, BoundsError, Error, KeyError, EnumerationError; value_t conssym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym; value_t definesym, defmacrosym, forsym, labelsym, printprettysym, setqsym; value_t printwidthsym, tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym; -static fltype_t *functiontype; static value_t apply_cl(uint32_t nargs); static value_t *alloc_words(int n); @@ -203,7 +202,7 @@ void bounds_error(char *fname, value_t arr, value_t ind) #define SAFECAST_OP(type,ctype,cnvt) \ ctype to##type(value_t v, char *fname) \ { \ - if (__likely(is##type(v))) \ + if (is##type(v)) \ return (ctype)cnvt(v); \ type_error(fname, #type, v); \ } @@ -437,6 +436,18 @@ static value_t relocate(value_t v) else if (t == TAG_CVALUE) { return cvalue_relocate(v); } + else if (t == TAG_FUNCTION) { + function_t *fn = (function_t*)ptr(v); + function_t *nfn = (function_t*)alloc_words(4); + nfn->bcode = fn->bcode; + nfn->vals = fn->vals; + nc = tagptr(nfn, TAG_FUNCTION); + forward(v, nc); + nfn->env = relocate(fn->env); + nfn->vals = relocate(nfn->vals); + nfn->bcode = relocate(nfn->bcode); + return nc; + } else if (t == TAG_SYM) { gensym_t *gs = (gensym_t*)ptr(v); gensym_t *ng = (gensym_t*)alloc_words(sizeof(gensym_t)/sizeof(void*)); @@ -541,19 +552,17 @@ static value_t _applyn(uint32_t n) value_t f = Stack[SP-n-1]; uint32_t saveSP = SP; value_t v; - if (isbuiltinish(f)) { - if (uintval(f) > N_BUILTINS) { - v = ((builtin_t)ptr(f))(&Stack[SP-n], n); - SP = saveSP; - return v; - } + if (iscbuiltin(f)) { + v = ((builtin_t*)ptr(f))[3](&Stack[SP-n], n); } else if (isfunction(f)) { v = apply_cl(n); - SP = saveSP; - return v; } - type_error("apply", "function", f); + else { + type_error("apply", "function", f); + } + SP = saveSP; + return v; } value_t apply(value_t f, value_t l) @@ -716,7 +725,9 @@ static value_t do_trycatch() return v; } -#define fn_vals(f) (((value_t*)ptr(f))[4]) +#define fn_bcode(f) (((value_t*)ptr(f))[0]) +#define fn_vals(f) (((value_t*)ptr(f))[1]) +#define fn_env(f) (((value_t*)ptr(f))[2]) /* stack on entry: @@ -745,7 +756,6 @@ static value_t apply_cl(uint32_t nargs) int64_t accum; uint8_t *code; value_t func, v, x, e; - function_t *fn; value_t *lenv, *pv; symbol_t *sym; cons_t *c; @@ -753,16 +763,12 @@ static value_t apply_cl(uint32_t nargs) apply_cl_top: captured = 0; func = Stack[SP-nargs-1]; - fn = value2c(function_t*,func); - code = cv_data((cvalue_t*)ptr(fn->bcode)); + code = cv_data((cvalue_t*)ptr(fn_bcode(func))); assert(!ismanaged((uptrint_t)code)); assert(ismanaged(func)); - assert(ismanaged(fn->bcode)); - if (nargs < code[1]) - lerror(ArgError, "apply: too few arguments"); bp = SP-nargs; - PUSH(fn->env); + PUSH(fn_env(func)); ip = 0; { @@ -771,8 +777,12 @@ static value_t apply_cl(uint32_t nargs) dispatch: switch (op) { case OP_ARGC: - if (nargs > code[ip++]) { - lerror(ArgError, "apply: too many arguments"); + n = code[ip++]; + if (nargs != n) { + if (nargs > n) + lerror(ArgError, "apply: too many arguments"); + else + lerror(ArgError, "apply: too few arguments"); } goto next_op; case OP_VARGC: @@ -788,6 +798,9 @@ static value_t apply_cl(uint32_t nargs) Stack[bp+i] = v; Stack[bp+i+1] = Stack[bp+nargs]; } + else if (s < 0) { + lerror(ArgError, "apply: too few arguments"); + } else { PUSH(NIL); Stack[SP-1] = Stack[SP-2]; @@ -819,15 +832,12 @@ static value_t apply_cl(uint32_t nargs) do_call: func = Stack[SP-n-1]; s = SP; - if (isfunction(func)) { - v = apply_cl(n); - } - else if (isbuiltinish(func)) { - op = uintval(func); - if (op > N_BUILTINS) { - v = ((builtin_t)ptr(func))(&Stack[SP-n], n); + if (tag(func) == TAG_FUNCTION) { + if (func > (N_BUILTINS<<3)) { + v = apply_cl(n); } else { + op = uintval(func); if (op > OP_ASET) type_error("apply", "function", func); s = builtin_arg_counts[op]; @@ -851,6 +861,9 @@ static value_t apply_cl(uint32_t nargs) } } } + else if (iscbuiltin(func)) { + v = (((builtin_t*)ptr(func))[3])(&Stack[SP-n], n); + } else { type_error("apply", "function", func); } @@ -892,8 +905,7 @@ static value_t apply_cl(uint32_t nargs) v = FL_F; } else { - v = (numval(compare(Stack[SP-2], Stack[SP-1]))==0) ? - FL_T : FL_F; + v = equal(Stack[SP-2], Stack[SP-1]); } Stack[SP-2] = v; POPN(1); goto next_op; @@ -901,12 +913,8 @@ static value_t apply_cl(uint32_t nargs) if (Stack[SP-2] == Stack[SP-1]) { v = FL_T; } - else if (eq_comparable(Stack[SP-2],Stack[SP-1])) { - v = FL_F; - } else { - v = (numval(compare(Stack[SP-2], Stack[SP-1]))==0) ? - FL_T : FL_F; + v = equal(Stack[SP-2], Stack[SP-1]); } Stack[SP-2] = v; POPN(1); goto next_op; @@ -920,12 +928,12 @@ static value_t apply_cl(uint32_t nargs) Stack[SP-1] = ((Stack[SP-1]==NIL) ? FL_T : FL_F); goto next_op; case OP_BOOLEANP: 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); goto next_op; case OP_SYMBOLP: Stack[SP-1] = (issymbol(Stack[SP-1]) ? FL_T : FL_F); goto next_op; case OP_NUMBERP: 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); goto next_op; case OP_FIXNUMP: Stack[SP-1] = (isfixnum(Stack[SP-1]) ? FL_T : FL_F); goto next_op; case OP_BOUNDP: @@ -934,13 +942,12 @@ static value_t apply_cl(uint32_t nargs) goto next_op; case OP_BUILTINP: v = Stack[SP-1]; - Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL) - ? FL_T : FL_F); + Stack[SP-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL_T : FL_F; goto next_op; case OP_FUNCTIONP: v = Stack[SP-1]; - Stack[SP-1] = ((isbuiltinish(v) && v!=FL_F && v!=FL_T && v!=NIL) || - isfunction(v)) ? FL_T : FL_F; + Stack[SP-1] = ((tag(v)==TAG_FUNCTION &&v!=FL_F&&v!=FL_T&&v!=NIL) || + iscbuiltin(v)) ? FL_T : FL_F; goto next_op; case OP_VECTORP: Stack[SP-1] = (isvector(Stack[SP-1]) ? FL_T : FL_F); goto next_op; @@ -1006,9 +1013,9 @@ static value_t apply_cl(uint32_t nargs) i = SP-n; if (n > MAX_ARGS) goto add_ovf; for (; i < SP; i++) { - if (__likely(isfixnum(Stack[i]))) { + if (isfixnum(Stack[i])) { s += numval(Stack[i]); - if (__unlikely(!fits_fixnum(s))) { + if (!fits_fixnum(s)) { i++; goto add_ovf; } @@ -1056,16 +1063,16 @@ static value_t apply_cl(uint32_t nargs) goto next_op; case OP_NEG: do_neg: - if (__likely(isfixnum(Stack[SP-1]))) + if (isfixnum(Stack[SP-1])) Stack[SP-1] = fixnum(-numval(Stack[SP-1])); else Stack[SP-1] = fl_neg(Stack[SP-1]); goto next_op; case OP_SUB2: do_sub2: - if (__likely(bothfixnums(Stack[SP-2], Stack[SP-1]))) { + if (bothfixnums(Stack[SP-2], Stack[SP-1])) { s = numval(Stack[SP-2]) - numval(Stack[SP-1]); - if (__likely(fits_fixnum(s))) + if (fits_fixnum(s)) v = fixnum(s); else v = mk_long(s); @@ -1084,7 +1091,7 @@ static value_t apply_cl(uint32_t nargs) i = SP-n; if (n > MAX_ARGS) goto mul_ovf; for (; i < SP; i++) { - if (__likely(isfixnum(Stack[i]))) { + if (isfixnum(Stack[i])) { accum *= numval(Stack[i]); } else { @@ -1094,7 +1101,7 @@ static value_t apply_cl(uint32_t nargs) } } if (i == SP) { - if (__likely(fits_fixnum(accum))) + if (fits_fixnum(accum)) v = fixnum(accum); else v = return_from_int64(accum); @@ -1176,7 +1183,7 @@ static value_t apply_cl(uint32_t nargs) v = Stack[SP-2]; if (isvector(v)) { i = tofixnum(Stack[SP-1], "aref"); - if (__unlikely((unsigned)i >= vector_size(v))) + if ((unsigned)i >= vector_size(v)) bounds_error("aref", v, Stack[SP-1]); v = vector_elt(v, i); } @@ -1193,7 +1200,7 @@ static value_t apply_cl(uint32_t nargs) e = Stack[SP-3]; if (isvector(e)) { i = tofixnum(Stack[SP-2], "aset!"); - if (__unlikely((unsigned)i >= vector_size(e))) + if ((unsigned)i >= vector_size(e)) bounds_error("aset!", v, Stack[SP-1]); vector_elt(e, i) = (v=Stack[SP-1]); } @@ -1339,17 +1346,14 @@ static value_t apply_cl(uint32_t nargs) PUSH(Stack[bp]); // env has already been captured; share } if (op == OP_CLOSURE) { - pv = alloc_words(6); + pv = alloc_words(4); x = Stack[SP-2]; // closure to copy assert(isfunction(x)); pv[0] = ((value_t*)ptr(x))[0]; - pv[1] = (value_t)&pv[3]; - pv[2] = ((value_t*)ptr(x))[2]; - pv[3] = ((value_t*)ptr(x))[3]; - pv[4] = ((value_t*)ptr(x))[4]; - pv[5] = Stack[SP-1]; // env + pv[1] = ((value_t*)ptr(x))[1]; + pv[2] = Stack[SP-1]; // env POPN(1); - Stack[SP-1] = tagptr(pv, TAG_CVALUE); + Stack[SP-1] = tagptr(pv, TAG_FUNCTION); } goto next_op; @@ -1379,42 +1383,6 @@ void assign_global_builtins(builtinspec_t *b) } } -static void print_function(value_t v, ios_t *f, int princ) -{ - (void)princ; - function_t *fn = value2c(function_t*,v); - outs("#function(", f); - char *data = cvalue_data(fn->bcode); - size_t i, sz = cvalue_len(fn->bcode); - for(i=0; i < sz; i++) data[i] += 48; - fl_print_child(f, fn->bcode, 0); - for(i=0; i < sz; i++) data[i] -= 48; - outc(' ', f); - fl_print_child(f, fn->vals, 0); - if (fn->env != NIL) { - outc(' ', f); - fl_print_child(f, fn->env, 0); - } - outc(')', f); -} - -static void print_traverse_function(value_t v) -{ - function_t *fn = value2c(function_t*,v); - print_traverse(fn->bcode); - print_traverse(fn->vals); - print_traverse(fn->env); -} - -static void relocate_function(value_t oldv, value_t newv) -{ - (void)oldv; - function_t *fn = value2c(function_t*,newv); - fn->bcode = relocate(fn->bcode); - fn->vals = relocate(fn->vals); - fn->env = relocate(fn->env); -} - static value_t fl_function(value_t *args, uint32_t nargs) { if (nargs != 3) @@ -1432,8 +1400,8 @@ static value_t fl_function(value_t *args, uint32_t nargs) for(i=0; i < sz; i++) data[i] -= 48; } - value_t fv = cvalue(functiontype, sizeof(function_t)); - function_t *fn = value2c(function_t*,fv); + function_t *fn = (function_t*)alloc_words(4); + value_t fv = tagptr(fn, TAG_FUNCTION); fn->bcode = args[0]; fn->vals = args[1]; if (nargs == 3) @@ -1447,19 +1415,16 @@ static value_t fl_function2vector(value_t *args, uint32_t nargs) { argcount("function->vector", nargs, 1); value_t v = args[0]; - if (!iscvalue(v) || cv_class((cvalue_t*)ptr(v)) != functiontype) + if (!isclosure(v)) type_error("function->vector", "function", v); value_t vec = alloc_vector(3, 0); - function_t *fn = value2c(function_t*,args[0]); + function_t *fn = (function_t*)ptr(args[0]); vector_elt(vec,0) = fn->bcode; vector_elt(vec,1) = fn->vals; vector_elt(vec,2) = fn->env; return vec; } -static cvtable_t function_vtable = { print_function, relocate_function, - NULL, print_traverse_function }; - static builtinspec_t core_builtin_info[] = { { "function", fl_function }, { "function->vector", fl_function2vector }, @@ -1557,9 +1522,6 @@ static void lisp_init(void) the_empty_vector = tagptr(alloc_words(1), TAG_VECTOR); vector_setsize(the_empty_vector, 0); - functiontype = define_opaque_type(FUNCTION, sizeof(function_t), - &function_vtable, NULL); - assign_global_builtins(core_builtin_info); builtins_init(); diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index 701ed25..c848234 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -31,7 +31,7 @@ typedef struct _symbol_t { #define TAG_NUM 0x0 #define TAG_CPRIM 0x1 -#define TAG_BUILTIN 0x2 +#define TAG_FUNCTION 0x2 #define TAG_VECTOR 0x3 #define TAG_NUM1 0x4 #define TAG_CVALUE 0x5 @@ -52,13 +52,12 @@ typedef struct _symbol_t { #endif #define fits_bits(x,b) (((x)>>(b-1)) == 0 || (~((x)>>(b-1))) == 0) #define uintval(x) (((unsigned int)(x))>>3) -#define builtin(n) tagptr((((int)n)<<3), TAG_BUILTIN) +#define builtin(n) tagptr((((int)n)<<3), TAG_FUNCTION) #define iscons(x) (tag(x) == TAG_CONS) #define issymbol(x) (tag(x) == TAG_SYM) #define isfixnum(x) (((x)&3) == TAG_NUM) #define bothfixnums(x,y) ((((x)|(y))&3) == TAG_NUM) -#define isbuiltin(x) ((tag(x) == TAG_BUILTIN) && uintval(x) < N_BUILTINS) -#define isbuiltinish(x) (tag(x) == TAG_BUILTIN) +#define isbuiltin(x) ((tag(x) == TAG_FUNCTION) && (x) < (OP_BOOL_CONST_T<<3)) #define isvector(x) (tag(x) == TAG_VECTOR) #define iscvalue(x) (tag(x) == TAG_CVALUE) #define iscprim(x) (tag(x) == TAG_CPRIM) @@ -93,7 +92,9 @@ typedef struct _symbol_t { (((unsigned char*)ptr(v)) < fromspace+heapsize)) #define isgensym(x) (issymbol(x) && ismanaged(x)) -#define isfunction(x) (iscvalue(x) && (cv_class((cvalue_t*)ptr(x))==functiontype)) +#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS<<3)) +#define isclosure(x) isfunction(x) +#define iscbuiltin(x) (iscvalue(x) && (cv_class((cvalue_t*)ptr(x))==builtintype)) extern value_t *Stack; extern uint32_t SP; @@ -105,6 +106,8 @@ extern uint32_t SP; // the largest value nargs can have is MAX_ARGS+1 #define MAX_ARGS 127 +#include "opcodes.h" + // utility for iterating over all arguments in a builtin // i=index, i0=start index, arg = var for each arg, args = arg array // assumes "nargs" is the argument count diff --git a/femtolisp/print.c b/femtolisp/print.c index 700465a..9810945 100644 --- a/femtolisp/print.c +++ b/femtolisp/print.c @@ -81,6 +81,13 @@ void print_traverse(value_t v) else if (iscprim(v)) { mark_cons(v); } + else if (isclosure(v)) { + mark_cons(v); + function_t *f = (function_t*)ptr(v); + print_traverse(f->bcode); + print_traverse(f->vals); + print_traverse(f->env); + } else { assert(iscvalue(v)); cvalue_t *cv = (cvalue_t*)ptr(v); @@ -152,7 +159,7 @@ static inline int tinyp(value_t v) return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN); if (isstring(v)) return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN); - return (isfixnum(v) || isbuiltinish(v)); + return (isfixnum(v) || isbuiltin(v)); } static int smallp(value_t v) @@ -351,35 +358,37 @@ void fl_print_child(ios_t *f, value_t v, int princ) else print_symbol_name(f, name); break; - case TAG_BUILTIN: + case TAG_FUNCTION: if (v == FL_T) { outsn("#t", f, 2); - break; } - if (v == FL_F) { + else if (v == FL_F) { outsn("#f", f, 2); - break; } - if (v == NIL) { + else if (v == NIL) { outsn("()", f, 2); - break; } - if (isbuiltin(v)) { + else if (isbuiltin(v)) { if (!princ) outsn("#.", f, 2); outs(builtin_names[uintval(v)], f); - break; - } - label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, ptr(v)); - if (label == (value_t)HT_NOTFOUND) { - HPOS += ios_printf(f, "#", - (unsigned long)(builtin_t)ptr(v)); } else { - if (princ) - outs(symbol_name(label), f); - else - HPOS += ios_printf(f, "#builtin(%s)", symbol_name(label)); + assert(isclosure(v)); + function_t *fn = (function_t*)ptr(v); + outs("#function(", f); + char *data = cvalue_data(fn->bcode); + size_t i, sz = cvalue_len(fn->bcode); + for(i=0; i < sz; i++) data[i] += 48; + fl_print_child(f, fn->bcode, 0); + for(i=0; i < sz; i++) data[i] -= 48; + outc(' ', f); + fl_print_child(f, fn->vals, 0); + if (fn->env != NIL) { + outc(' ', f); + fl_print_child(f, fn->env, 0); + } + outc(')', f); } break; case TAG_CVALUE: @@ -423,7 +432,8 @@ void fl_print_child(ios_t *f, value_t v, int princ) break; } if (iscvalue(v) || iscprim(v)) { - unmark_cons(v); + if (ismanaged(v)) + unmark_cons(v); cvalue_print(f, v, princ); break; } @@ -657,10 +667,21 @@ static void cvalue_print(ios_t *f, value_t v, int princ) { cvalue_t *cv = (cvalue_t*)ptr(v); void *data = cptr(v); + value_t label; if (cv_class(cv) == builtintype) { - HPOS+=ios_printf(f, "#", - (unsigned long)(builtin_t)data); + void *fptr = *(void**)data; + label = (value_t)ptrhash_get(&reverse_dlsym_lookup_table, cv); + if (label == (value_t)HT_NOTFOUND) { + HPOS += ios_printf(f, "#", + (unsigned long)(builtin_t)fptr); + } + else { + if (princ) + outs(symbol_name(label), f); + else + HPOS += ios_printf(f, "#builtin(%s)", symbol_name(label)); + } } else if (cv_class(cv)->vtable != NULL && cv_class(cv)->vtable->print != NULL) { diff --git a/femtolisp/todo b/femtolisp/todo index ba3ffac..0a9001a 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -1024,6 +1024,7 @@ new evaluator todo: * make (for ...) a special form * trycatch should require 2nd arg to be a lambda expression * immediate load int8 instruction +- fix equal? on functions - maxstack calculation, replace Stack with C stack, alloca - stack traces and better debugging support - lambda lifting