shithub: femtolisp

Download patch

ref: 264df1f90b03973340fd96d85cbec744af77a65d
parent: 14d625bd83715b043d530349cfa40e3c843ffd91
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Tue Apr 28 00:10:18 EDT 2009

improving closure representation
some performance tweaks


--- a/femtolisp/Makefile
+++ b/femtolisp/Makefile
@@ -12,7 +12,7 @@
 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
 
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -635,12 +635,14 @@
     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 @@
 {
     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);
--- a/femtolisp/equal.c
+++ b/femtolisp/equal.c
@@ -91,11 +91,16 @@
             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 @@
     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;
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -95,7 +95,6 @@
 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 @@
 #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 @@
     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 @@
     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 @@
     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: <func>  <args...>
@@ -745,7 +756,6 @@
     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 @@
  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 @@
     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 @@
                 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 @@
         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 @@
                     }
                 }
             }
+            else if (iscbuiltin(func)) {
+                v = (((builtin_t*)ptr(func))[3])(&Stack[SP-n], n);
+            }
             else {
                 type_error("apply", "function", func);
             }
@@ -892,8 +905,7 @@
                 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 @@
             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 @@
             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 @@
             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 @@
             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,7 +1063,7 @@
             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]);
@@ -1063,9 +1070,9 @@
             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 @@
             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 @@
                 }
             }
             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 @@
             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 @@
             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 @@
                 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 @@
     }
 }
 
-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 @@
         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,10 +1415,10 @@
 {
     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;
@@ -1457,9 +1425,6 @@
     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 },
@@ -1556,9 +1521,6 @@
 
     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);
 
--- a/femtolisp/flisp.h
+++ b/femtolisp/flisp.h
@@ -31,7 +31,7 @@
 
 #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 @@
 #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 @@
                       (((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;
@@ -104,6 +105,8 @@
 // maximum number of explicit arguments. the 128th arg is a list of rest args.
 // 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
--- a/femtolisp/print.c
+++ b/femtolisp/print.c
@@ -81,6 +81,13 @@
     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 @@
         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 @@
         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, "#<builtin @0x%08lx>",
-                               (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 @@
             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 @@
 {
     cvalue_t *cv = (cvalue_t*)ptr(v);
     void *data = cptr(v);
+    value_t label;
 
     if (cv_class(cv) == builtintype) {
-        HPOS+=ios_printf(f, "#<builtin @0x%08lx>",
-                         (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, "#<builtin @0x%08lx>",
+                               (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) {
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -1024,6 +1024,7 @@
 * 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