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