ref: f4e2fb078b67553b832ae8a18b53deb451be4f99
parent: 497eb997f7c9d494b7ecd26c52dcac3361ef93e1
author: mag <mag-one@autistici.org>
date: Mon May 15 15:42:44 EDT 2023
first failing attempt
--- /dev/null
+++ b/MAG.notes
@@ -1,0 +1,35 @@
+
+cvalues.c: #include "operators.c"
+flisp.c: #include "cvalues.c"
+flisp.c: #include "types.c"
+flisp.c: #include "print.c"
+flisp.c: #include "read.c"
+flisp.c: #include "equal.c"
+llt/hashing.c: #include "lookup3.c"
+================================================================================
+
+$ make
+
+cc -o flmain.o -c flmain.c -O2 -g -Wall -Wextra -Wno-parentheses -std=c99 -I3rd -Illt -Iposix
+sed -nE 's/^BUILTIN[_]?(\(".*)/BUILTIN_FN\1/gp' *.c >builtin_fns.h+cc -o flisp.o -c flisp.c -O2 -g -Wall -Wextra -Wno-parentheses -std=c99 -I3rd -Illt -Iposix
+flisp.c: In function 'fn_builtin_function':
+flisp.c:1855:24: warning: implicit declaration of function 'fn_builtin_builtin'; did you mean 'fn_builtin_function'? [-Wimplicit-function-declaration]
+ 1855 | return fn_builtin_builtin(args, nargs);
+ | ^~~~~~~~~~~~~~~~~~
+ | fn_builtin_function
+In file included from flisp.c:9:
+builtin_fns.h: At top level:
+flisp.h:308:17: error: conflicting types for 'fn_builtin_builtin'; have 'value_t(value_t *, int)' {aka 'long unsigned int(long unsigned int *, int)'}+ 308 | value_t fn_builtin_##cname(value_t *args, int nargs)
+ | ^~~~~~~~~~~
+flisp.c:2060:33: note: in expansion of macro 'BUILTIN'
+ 2060 | #define BUILTIN_FN(l, c) extern BUILTIN(l, c);
+ | ^~~~~~~
+builtin_fns.h:46:1: note: in expansion of macro 'BUILTIN_FN'
+ 46 | BUILTIN_FN("builtin", builtin)+ | ^~~~~~~~~~
+flisp.c:1855:24: note: previous implicit declaration of 'fn_builtin_builtin' with type 'int()'
+ 1855 | return fn_builtin_builtin(args, nargs);
+ | ^~~~~~~~~~~~~~~~~~
+make: *** [Makefile:79: flisp.o] Error 1
--- a/Makefile
+++ b/Makefile
@@ -56,6 +56,13 @@
3rd/mp/u64.o\
3rd/mt19937-64.o\
+# cvalues.o\
+# read.o\
+# print.o\
+# equal.o\
+# types.o\
+
+
.PHONY: all default test bootstrap clean
all: default
--- a/cvalues.c
+++ b/cvalues.c
@@ -1,11 +1,8 @@
+//#include "llt.h"
+//#include "flisp.h"
+
#include "operators.c"
-#ifdef BITS64
-#define NWORDS(sz) (((sz)+7)>>3)
-#else
-#define NWORDS(sz) (((sz)+3)>>2)
-#endif
-
value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
value_t int64sym, uint64sym, mpintsym;
value_t longsym, ulongsym, bytesym, wcharsym;
@@ -16,14 +13,14 @@
value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
value_t unionsym;
-static htable_t TypeTable;
-static htable_t reverse_dlsym_lookup_table;
+htable_t TypeTable;
+htable_t reverse_dlsym_lookup_table;
+fltype_t *mpinttype;
static fltype_t *int8type, *uint8type;
static fltype_t *int16type, *uint16type;
static fltype_t *int32type, *uint32type;
static fltype_t *int64type, *uint64type;
static fltype_t *longtype, *ulongtype;
-static fltype_t *mpinttype;
static fltype_t *floattype, *doubletype;
fltype_t *bytetype, *wchartype;
fltype_t *stringtype, *wcstringtype;
@@ -55,7 +52,7 @@
}
// remove dead objects from finalization list in-place
-static void
+void
sweep_finalizers(void)
{cvalue_t **lst = Finalizers;
@@ -401,7 +398,7 @@
type_error("number", n);}
-static int
+int
cvalue_enum_init(fltype_t *ft, value_t arg, void *dest)
{int n;
@@ -443,7 +440,7 @@
return cv;
}
-static int
+int
isarray(value_t v)
{return iscvalue(v) && cv_class((cvalue_t*)ptr(v))->eltype != nil;
@@ -463,7 +460,7 @@
return 1;
}
-static int
+int
cvalue_array_init(fltype_t *ft, value_t arg, void *dest)
{value_t type = ft->type;
@@ -700,7 +697,7 @@
return cv_type(ptr(args[0]));
}
-static value_t
+value_t
cvalue_relocate(value_t v)
{size_t nw;
@@ -845,7 +842,7 @@
bounds_error(arr, ind);
}
-static value_t
+value_t
cvalue_array_aref(value_t *args)
{char *data; int index;
@@ -879,7 +876,7 @@
return el;
}
-static value_t
+value_t
cvalue_array_aset(value_t *args)
{char *data; int index;
@@ -969,7 +966,7 @@
RETURN_NUM_AS(Saccum, int32);
}
-static value_t
+value_t
fl_add_any(value_t *args, uint32_t nargs, fixnum_t carryIn)
{uint64_t Uaccum = 0;
@@ -1061,7 +1058,7 @@
return return_from_uint64(Uaccum);
}
-static value_t
+value_t
fl_neg(value_t n)
{uint32_t ui32;
@@ -1113,7 +1110,7 @@
type_error("number", n);}
-static value_t
+value_t
fl_mul_any(value_t *args, uint32_t nargs, int64_t Saccum)
{uint64_t Uaccum = 1;
@@ -1264,13 +1261,13 @@
return 1;
}
-static _Noreturn void
+_Noreturn void
DivideByZeroError(void)
{lerrorf(DivideError, "/: division by zero");
}
-static value_t
+value_t
fl_div2(value_t a, value_t b)
{double da, db;
@@ -1296,7 +1293,7 @@
return mk_double(da);
}
-static value_t
+value_t
fl_idiv2(value_t a, value_t b)
{lltint_t ai, bi;
@@ -1567,7 +1564,7 @@
type_error("integer", a);}
-static void
+void
cvalues_init(void)
{htable_new(&TypeTable, 256);
--- a/equal.c
+++ b/equal.c
@@ -1,3 +1,7 @@
+//#include "llt.h"
+//#include "flisp.h"
+//#include "opcodes.h"
+
#define BOUNDED_COMPARE_BOUND 128
#define BOUNDED_HASH_BOUND 16384
@@ -286,7 +290,7 @@
}
// 'eq' means unordered comparison is sufficient
-static value_t
+value_t
compare_(value_t a, value_t b, int eq)
{value_t guess = bounded_compare(a, b, BOUNDED_COMPARE_BOUND, eq);
--- a/flisp.c
+++ b/flisp.c
@@ -7,16 +7,6 @@
#include "llt.h"
#include "flisp.h"
-
-typedef struct Builtin Builtin;
-
-struct Builtin {- char *name;
- int nargs;
-};
-
-#define ANYARGS -10000
-
#include "opcodes.h"
int
@@ -26,20 +16,11 @@
return tag(x) == TAG_FUNCTION && i < nelem(builtins) && builtins[i].name != nil;
}
-static uint32_t N_STACK;
-static value_t *Stack;
-static uint32_t SP = 0;
-static uint32_t curr_frame = 0;
-static char *curr_fname = nil;
-#define PUSH(v) \
- do{ \- Stack[SP++] = (v); \
- }while(0)
-#define POP() (Stack[--SP])
-#define POPN(n) \
- do{ \- SP -= (n); \
- }while(0)
+uint32_t N_STACK;
+value_t *Stack;
+uint32_t SP = 0;
+uint32_t curr_frame = 0;
+char *curr_fname = nil;
#define N_GC_HANDLES 1024
static value_t *GCHandleStack[N_GC_HANDLES];
@@ -52,23 +33,28 @@
value_t printwidthsym, printreadablysym, printprettysym, printlengthsym;
value_t printlevelsym, builtins_table_sym;
-static value_t NIL, LAMBDA, IF, TRYCATCH;
-static value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION;
+value_t NIL, LAMBDA, IF, TRYCATCH;
+value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION;
-static value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
-static value_t definesym, defmacrosym, forsym, setqsym;
-static value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym, fnsym;
+value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
+value_t definesym, defmacrosym, forsym, setqsym;
+value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym, fnsym;
// for reading characters
-static value_t nulsym, alarmsym, backspacesym, tabsym, linefeedsym, newlinesym;
-static value_t vtabsym, pagesym, returnsym, escsym, spacesym, deletesym;
+value_t nulsym, alarmsym, backspacesym, tabsym, linefeedsym, newlinesym;
+value_t vtabsym, pagesym, returnsym, escsym, spacesym, deletesym;
static value_t apply_cl(uint32_t nargs);
-static void *alloc_words(int n);
-static value_t relocate(value_t v);
-static fl_readstate_t *readstate = nil;
+fl_readstate_t *readstate = nil;
-static void
+uint8_t *fromspace;
+uint8_t *tospace;
+uint8_t *curheap;
+uint8_t *lim;
+uint32_t heapsize;//bytes
+uint32_t *consflags;
+
+void
free_readstate(fl_readstate_t *rs)
{htable_free(&rs->backrefs);
@@ -75,13 +61,6 @@
htable_free(&rs->gensyms);
}
-static uint8_t *fromspace;
-static uint8_t *tospace;
-static uint8_t *curheap;
-static uint8_t *lim;
-static uint32_t heapsize;//bytes
-static uint32_t *consflags;
-
// error utilities ------------------------------------------------------------
// saved execution state for an unwind target
@@ -304,9 +283,7 @@
// conses ---------------------------------------------------------------------
-void gc(int mustgrow);
-
-static value_t
+value_t
mk_cons(void)
{cons_t *c;
@@ -318,7 +295,7 @@
return tagptr(c, TAG_CONS);
}
-static void *
+void *
alloc_words(int n)
{value_t *first;
@@ -336,16 +313,8 @@
return first;
}
-// allocate n consecutive conses
-#define cons_reserve(n) tagptr(alloc_words((n)*2), TAG_CONS)
+value_t the_empty_vector;
-#define cons_index(c) (((cons_t*)ptr(c))-((cons_t*)fromspace))
-#define ismarked(c) bitvector_get(consflags, cons_index(c))
-#define mark_cons(c) bitvector_set(consflags, cons_index(c), 1)
-#define unmark_cons(c) bitvector_set(consflags, cons_index(c), 0)
-
-static value_t the_empty_vector;
-
value_t
alloc_vector(size_t n, int init)
{@@ -369,8 +338,9 @@
// print ----------------------------------------------------------------------
-static int isnumtok(char *tok, value_t *pval);
-static inline int symchar(char c);
+//static int isnumtok(char *tok, value_t *pval);
+//static inline int symchar(char c);
+extern inline int symchar(char c);
#include "print.c"
@@ -391,7 +361,7 @@
N_GCHND -= n;
}
-static value_t
+value_t
relocate(value_t v)
{value_t a, d, nc, first, *pcdr;
--- a/flisp.h
+++ b/flisp.h
@@ -99,8 +99,6 @@
// doesn't lead to other values
#define leafp(a) (((a)&3) != 3)
-int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp);
-
#define isforwarded(v) (((value_t*)ptr(v))[0] == TAG_FWD)
#define forwardloc(v) (((value_t*)ptr(v))[1])
#define forward(v, to) \
@@ -141,8 +139,6 @@
#define isclosure(x) isfunction(x)
#define iscbuiltin(x) (iscvalue(x) && cv_class(ptr(x)) == builtintype)
-void fl_gc_handle(value_t *pv);
-void fl_free_gc_handles(uint32_t n);
// utility for iterating over all arguments in a builtin
// i=index, i0=start index, arg = var for each arg, args = arg array
@@ -152,19 +148,24 @@
#define N_BUILTINS ((int)N_OPCODES)
+extern value_t printprettysym, printreadablysym, printwidthsym, printlengthsym;
+extern value_t printlevelsym, builtins_table_sym;
+extern value_t QUOTE;
extern value_t FL_NIL, FL_T, FL_F, FL_EOF;
-
#define FL_UNSPECIFIED FL_T
+int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp);
+void fl_gc_handle(value_t *pv);
+void fl_free_gc_handles(uint32_t n);
+int fl_isnumber(value_t v);
+void fl_init(size_t initial_heapsize);
+int fl_load_system_image(value_t ios);
+
/* read, eval, print main entry points */
-value_t fl_read_sexpr(value_t f);
-void fl_print(ios_t *f, value_t v);
value_t fl_toplevel_eval(value_t expr);
value_t fl_apply(value_t f, value_t l);
value_t fl_applyn(uint32_t n, value_t f, ...);
-extern value_t printprettysym, printreadablysym, printwidthsym;
-
/* object model manipulation */
value_t fl_cons(value_t a, value_t b);
value_t fl_list2(value_t a, value_t b);
@@ -173,12 +174,6 @@
char *symbol_name(value_t v);
int fl_is_keyword_name(char *str, size_t len);
value_t alloc_vector(size_t n, int init);
-size_t llength(value_t v);
-value_t fl_compare(value_t a, value_t b); // -1, 0, or 1
-value_t fl_equal(value_t a, value_t b); // T or nil
-int equal_lispvalue(value_t a, value_t b);
-uintptr_t hash_lispvalue(value_t a);
-int isnumtok_base(char *tok, value_t *pval, int base);
/* safe casts */
cons_t *tocons(value_t v);
@@ -243,10 +238,6 @@
} cvtable_t;
value_t relocate_lispvalue(value_t v);
-void print_traverse(value_t v);
-void fl_print_chr(char c, ios_t *f);
-void fl_print_str(char *s, ios_t *f);
-void fl_print_child(ios_t *f, value_t v);
typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
@@ -318,9 +309,42 @@
typedef value_t (*builtin_t)(value_t*, int);
-extern value_t QUOTE;
+typedef struct {+ char *name;
+ builtin_t fptr;
+}builtinspec_t;
+
+//--------------------------------------------------
+// Nothing changed here...just grouping by file.
+//--------------------------------------------------
+
+//--------------------------------------------------read.c
+value_t fl_read_sexpr(value_t f);
+int isnumtok_base(char *tok, value_t *pval, int base);
+//--------------------------------------------------read.c
+
+//--------------------------------------------------builtins.c
+size_t llength(value_t v);
+//--------------------------------------------------builtins.c
+
+//--------------------------------------------------equal.c
+value_t fl_compare(value_t a, value_t b); // -1, 0, or 1
+value_t fl_equal(value_t a, value_t b); // T or nil
+int equal_lispvalue(value_t a, value_t b);
+uintptr_t hash_lispvalue(value_t a);
+//--------------------------------------------------equal.c
+
+//--------------------------------------------------print.c
+void fl_print(ios_t *f, value_t v);
+void print_traverse(value_t v);
+void fl_print_chr(char c, ios_t *f);
+void fl_print_str(char *s, ios_t *f);
+void fl_print_child(ios_t *f, value_t v);
+//--------------------------------------------------print.c
+
+//--------------------------------------------------cvalues.c
extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
-extern value_t int64sym, uint64sym;
+extern value_t int64sym, uint64sym, mpintsym;
extern value_t longsym, ulongsym, bytesym, wcharsym;
extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
extern value_t stringtypesym, wcstringtypesym, emptystringsym;
@@ -328,7 +352,6 @@
extern fltype_t *bytetype, *wchartype;
extern fltype_t *stringtype, *wcstringtype;
extern fltype_t *builtintype;
-
value_t cvalue(fltype_t *type, size_t sz);
void add_finalizer(cvalue_t *cv);
void cv_autorelease(cvalue_t *cv);
@@ -347,18 +370,9 @@
value_t string_from_cstr(char *str);
value_t string_from_cstrn(char *str, size_t n);
int fl_isstring(value_t v);
-int fl_isnumber(value_t v);
-int fl_isiostream(value_t v);
-ios_t *fl_toiostream(value_t v);
value_t cvalue_compare(value_t a, value_t b);
int numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr);
-
void to_sized_ptr(value_t v, char **pdata, size_t *psz);
-
-fltype_t *get_type(value_t t);
-fltype_t *get_array_type(value_t eltype);
-fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, cvinitfunc_t init);
-
value_t mk_double(double n);
value_t mk_float(float n);
value_t mk_int32(int32_t n);
@@ -368,7 +382,21 @@
value_t mk_wchar(int32_t n);
value_t return_from_uint64(uint64_t Uaccum);
value_t return_from_int64(int64_t Saccum);
+//--------------------------------------------------cvalues.c
+//--------------------------------------------------iostream.c
+int fl_isiostream(value_t v);
+ios_t *fl_toiostream(value_t v);
+//--------------------------------------------------iostream.c
+
+
+//--------------------------------------------------types.c
+fltype_t *get_type(value_t t);
+fltype_t *get_array_type(value_t eltype);
+fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, cvinitfunc_t init);
+//--------------------------------------------------types.c
+
+//--------------------------------------------------operators.c
double conv_to_double(void *data, numerictype_t tag);
void conv_from_double(void *data, double d, numerictype_t tag);
mpint *conv_to_mpint(void *data, numerictype_t tag);
@@ -376,6 +404,7 @@
uint64_t conv_to_uint64(void *data, numerictype_t tag);
int32_t conv_to_int32(void *data, numerictype_t tag);
uint32_t conv_to_uint32(void *data, numerictype_t tag);
+
#if defined(ULONG64)
#define conv_to_long conv_to_int64
#define conv_to_ulong conv_to_uint64
@@ -383,13 +412,135 @@
#define conv_to_long conv_to_int32
#define conv_to_ulong conv_to_uint32
#endif
+//--------------------------------------------------operators.c
-typedef struct {- char *name;
- builtin_t fptr;
-}builtinspec_t;
-void fl_init(size_t initial_heapsize);
-int fl_load_system_image(value_t ios);
+//--------------------------------------------------------------------------------
+// New declarations here.. needed to permit files splitting
+// (and grouped by files).
+//--------------------------------------------------------------------------------
+extern value_t *Stack;
+extern uint32_t SP;
+extern uint32_t N_STACK;
+extern uint32_t curr_frame;
+extern char *curr_fname;
+#define PUSH(v) \
+ do{ \+ Stack[SP++] = (v); \
+ }while(0)
+#define POP() (Stack[--SP])
+#define POPN(n) \
+ do{ \+ SP -= (n); \
+ }while(0)
+
+extern value_t NIL, LAMBDA, IF, TRYCATCH;
+extern value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION;
+extern value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
+extern value_t definesym, defmacrosym, forsym, setqsym;
+extern value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym, fnsym;
+extern value_t nulsym, alarmsym, backspacesym, tabsym, linefeedsym, newlinesym;
+extern value_t vtabsym, pagesym, returnsym, escsym, spacesym, deletesym;
+
+void *alloc_words(int n);
+value_t relocate(value_t v);
+
+extern fl_readstate_t *readstate;
+void free_readstate(fl_readstate_t *rs);
+
+extern uint8_t *fromspace;
+extern uint32_t heapsize;//bytes
+extern uint8_t *tospace;
+extern uint8_t *curheap;
+extern uint8_t *lim;
+extern uint32_t *consflags;
+
+void gc(int mustgrow);
+
+extern value_t IOError, ParseError, TypeError, ArgError, MemoryError;
+extern value_t DivideError, BoundsError, Error, KeyError, EnumerationError;
+
+// allocate n consecutive conses
+#define cons_reserve(n) tagptr(alloc_words((n)*2), TAG_CONS)
+#define cons_index(c) (((cons_t*)ptr(c))-((cons_t*)fromspace))
+#define ismarked(c) bitvector_get(consflags, cons_index(c))
+#define mark_cons(c) bitvector_set(consflags, cons_index(c), 1)
+#define unmark_cons(c) bitvector_set(consflags, cons_index(c), 0)
+
+typedef struct Builtin Builtin;
+
+struct Builtin {+ char *name;
+ int nargs;
+};
+
+#define ANYARGS -10000
+
+extern value_t the_empty_vector;
+value_t mk_cons(void);
+
+//--------------------------------------------------cvalues.c
+void cvalues_init(void);
+value_t fl_idiv2(value_t a, value_t b);
+value_t fl_div2(value_t a, value_t b);
+value_t fl_mul_any(value_t *args, uint32_t nargs, int64_t Saccum);
+value_t fl_neg(value_t n);
+value_t fl_add_any(value_t *args, uint32_t nargs, fixnum_t carryIn);
+value_t cvalue_array_aset(value_t *args);
+value_t cvalue_array_aref(value_t *args);
+value_t cvalue_relocate(value_t v);
+void sweep_finalizers(void);
+
+extern htable_t TypeTable;
+extern htable_t reverse_dlsym_lookup_table;
+extern fltype_t *mpinttype;
+
+int cvalue_array_init(fltype_t *ft, value_t arg, void *dest);
+int cvalue_enum_init(fltype_t *ft, value_t arg, void *dest);
+
+value_t mk_mpint(mpint *n);
+
+#ifdef BITS64
+#define NWORDS(sz) (((sz)+7)>>3)
+#else
+#define NWORDS(sz) (((sz)+3)>>2)
#endif
+
+int isarray(value_t v);
+_Noreturn void DivideByZeroError(void);
+
+//--------------------------------------------------cvalues.c
+
+
+//--------------------------------------------------read.c
+int isnumtok(char *tok, value_t *pval);
+
+// defines which characters are ordinary symbol characters.
+// exceptions are '.', which is an ordinary symbol character
+// unless it's the only character in the symbol, and '#', which is
+// an ordinary symbol character unless it's the first character.
+inline int
+symchar(char c)
+{+ //static char *special = "()[]'\";`,\\| \a\b\f\n\r\t\v";
+ char *special = "()[]'\";`,\\| \a\b\f\n\r\t\v";
+ return !strchr(special, c);
+}
+//--------------------------------------------------read.c
+
+//--------------------------------------------------types.c
+void relocate_typetable(void);
+//--------------------------------------------------types.c
+
+//--------------------------------------------------equal.c
+value_t compare_(value_t a, value_t b, int eq);
+//--------------------------------------------------equal.c
+
+//--------------------------------------------------print.c
+extern htable_t printconses;
+extern int SCR_WIDTH;
+//--------------------------------------------------print.c
+
+#endif
+
--- /dev/null
+++ b/flisp.h-first_attempt
@@ -1,0 +1,467 @@
+#ifndef FLISP_H
+#define FLISP_H
+
+/* functions needed to implement the value interface (cvtable_t) */
+typedef enum {+ T_INT8, T_UINT8,
+ T_INT16, T_UINT16,
+ T_INT32, T_UINT32,
+ T_INT64, T_UINT64,
+ T_MPINT,
+ T_FLOAT,
+ T_DOUBLE,
+}numerictype_t;
+
+#define NONNUMERIC (0xff)
+#define valid_numtype(v) ((v) <= T_DOUBLE)
+
+typedef uintptr_t value_t;
+typedef lltint_t fixnum_t;
+
+#ifdef BITS64
+#define T_FIXNUM T_INT64
+#define fits_fixnum(x) (((x)>>61) == 0 || (~((x)>>61)) == 0)
+#define mk_xlong mk_int64
+#else
+#define T_FIXNUM T_INT32
+#define fits_fixnum(x) (((x)>>29) == 0 || (~((x)>>29)) == 0)
+#define mk_xlong mk_long
+#endif
+
+typedef struct {+ value_t car;
+ value_t cdr;
+}cons_t;
+
+typedef struct _symbol_t {+ value_t binding; // global value binding
+ uint32_t hash;
+ uint8_t numtype;
+ uint8_t size;
+ uint8_t align;
+ uint8_t flags;
+ struct _fltype_t *type;
+ void *dlcache; // dlsym address
+ // below fields are private
+ struct _symbol_t *left;
+ struct _symbol_t *right;
+ union {+ char name[1];
+ void *_pad; // ensure field aligned to pointer size
+ };
+}symbol_t;
+
+typedef struct {+ value_t isconst;
+ value_t binding; // global value binding
+ struct _fltype_t *type;
+ uint32_t id;
+}gensym_t;
+
+enum {+ TAG_NUM,
+ TAG_CPRIM,
+ TAG_FUNCTION,
+ TAG_VECTOR,
+ TAG_NUM1,
+ TAG_CVALUE,
+ TAG_SYM,
+ TAG_CONS,
+};
+
+enum {+ FLAG_CONST = 1<<0,
+ FLAG_KEYWORD = 1<<1,
+};
+
+#define UNBOUND ((value_t)0x1) // an invalid value
+#define TAG_FWD UNBOUND
+#define tag(x) ((x) & 0x7)
+#define ptr(x) ((void*)((x) & (~(value_t)0x7)))
+#define tagptr(p, t) (((value_t)(p)) | (t))
+#define fixnum(x) ((value_t)((fixnum_t)(x))<<2)
+#define numval(x) (((fixnum_t)(x))>>2)
+#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_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)
+int isbuiltin(value_t x);
+#define isvector(x) (tag(x) == TAG_VECTOR)
+#define iscvalue(x) (tag(x) == TAG_CVALUE)
+#define iscprim(x) (tag(x) == TAG_CPRIM)
+#define selfevaluating(x) (tag(x) < 6)
+// comparable with ==
+#define eq_comparable(a, b) (!(((a)|(b))&1))
+#define eq_comparablep(a) (!((a)&1))
+// doesn't lead to other values
+#define leafp(a) (((a)&3) != 3)
+
+#define isforwarded(v) (((value_t*)ptr(v))[0] == TAG_FWD)
+#define forwardloc(v) (((value_t*)ptr(v))[1])
+#define forward(v, to) \
+ do{ \+ (((value_t*)ptr(v))[0] = TAG_FWD); \
+ (((value_t*)ptr(v))[1] = to); \
+ }while (0)
+
+#define vector_size(v) (((size_t*)ptr(v))[0]>>2)
+#define vector_setsize(v, n) (((size_t*)ptr(v))[0] = ((n)<<2))
+#define vector_elt(v, i) (((value_t*)ptr(v))[1+(i)])
+#define vector_grow_amt(x) ((x)<8 ? 5 : 6*((x)>>3))
+// functions ending in _ are unsafe, faster versions
+#define car_(v) (((cons_t*)ptr(v))->car)
+#define cdr_(v) (((cons_t*)ptr(v))->cdr)
+#define car(v) (tocons((v))->car)
+#define cdr(v) (tocons((v))->cdr)
+#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])
+#define fn_name(f) (((value_t*)ptr(f))[3])
+
+#define set(s, v) (((symbol_t*)ptr(s))->binding = (v))
+#define setc(s, v) \
+ do{ \+ ((symbol_t*)ptr(s))->flags |= FLAG_CONST; \
+ ((symbol_t*)ptr(s))->binding = (v); \
+ }while (0)
+#define isconstant(s) ((s)->flags & FLAG_CONST)
+#define iskeyword(s) ((s)->flags & FLAG_KEYWORD)
+#define symbol_value(s) (((symbol_t*)ptr(s))->binding)
+#define sym_to_numtype(s) (((symbol_t*)ptr(s))->numtype)
+#define ismanaged(v) ((((uint8_t*)ptr(v)) >= fromspace) && (((uint8_t*)ptr(v)) < fromspace+heapsize))
+#define isgensym(x) (issymbol(x) && ismanaged(x))
+value_t gensym(void);
+
+#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS<<3))
+#define isclosure(x) isfunction(x)
+#define iscbuiltin(x) (iscvalue(x) && cv_class(ptr(x)) == builtintype)
+
+
+// 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
+#define FOR_ARGS(i, i0, arg, args) \
+ for(i=i0; i<nargs && ((arg=args[i]) || 1); i++)
+
+#define N_BUILTINS ((int)N_OPCODES)
+
+extern value_t printprettysym, printreadablysym, printwidthsym;
+extern value_t QUOTE;
+extern value_t FL_NIL, FL_T, FL_F, FL_EOF;
+#define FL_UNSPECIFIED FL_T
+
+int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp);
+void fl_gc_handle(value_t *pv);
+void fl_free_gc_handles(uint32_t n);
+int fl_isnumber(value_t v);
+void fl_init(size_t initial_heapsize);
+int fl_load_system_image(value_t ios);
+
+/* read, eval, print main entry points */
+value_t fl_toplevel_eval(value_t expr);
+value_t fl_apply(value_t f, value_t l);
+value_t fl_applyn(uint32_t n, value_t f, ...);
+
+/* object model manipulation */
+value_t fl_cons(value_t a, value_t b);
+value_t fl_list2(value_t a, value_t b);
+value_t fl_listn(size_t n, ...);
+value_t symbol(char *str);
+char *symbol_name(value_t v);
+int fl_is_keyword_name(char *str, size_t len);
+value_t alloc_vector(size_t n, int init);
+
+/* safe casts */
+cons_t *tocons(value_t v);
+symbol_t *tosymbol(value_t v);
+fixnum_t tofixnum(value_t v);
+char *tostring(value_t v);
+
+/* error handling */
+typedef struct _fl_readstate_t {+ htable_t backrefs;
+ htable_t gensyms;
+ value_t source;
+ struct _fl_readstate_t *prev;
+}fl_readstate_t;
+
+typedef struct _ectx_t {+ jmp_buf buf;
+ uint32_t sp;
+ uint32_t frame;
+ uint32_t ngchnd;
+ fl_readstate_t *rdst;
+ struct _ectx_t *prev;
+}fl_exception_context_t;
+
+extern fl_exception_context_t *fl_ctx;
+extern uint32_t fl_throwing_frame;
+extern value_t fl_lasterror;
+
+#define FL_TRY_EXTERN \
+ fl_exception_context_t _ctx; int l__tr, l__ca; \
+ fl_savestate(&_ctx); fl_ctx = &_ctx; \
+ if(!setjmp(_ctx.buf)) \
+ for(l__tr=1; l__tr; l__tr=0, (void)(fl_ctx = fl_ctx->prev))
+
+#define FL_CATCH_EXTERN_NO_RESTORE \
+ else \
+ for(l__ca=1; l__ca;)
+
+#define FL_CATCH_EXTERN \
+ else \
+ for(l__ca=1; l__ca; l__ca=0, fl_restorestate(&_ctx))
+
+_Noreturn void lerrorf(value_t e, char *format, ...);
+void fl_savestate(fl_exception_context_t *_ctx);
+void fl_restorestate(fl_exception_context_t *_ctx);
+_Noreturn void fl_raise(value_t e);
+_Noreturn void type_error(char *expected, value_t got);
+_Noreturn void bounds_error(value_t arr, value_t ind);
+_Noreturn void unbound_error(value_t sym);
+extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
+#define argcount(nargs, c) \
+ do{ \+ if(__unlikely(nargs != c)) \
+ lerrorf(ArgError, "arity mismatch: wanted %d, got %d", c, nargs); \
+ }while(0)
+
+typedef struct {+ void (*print)(value_t self, ios_t *f);
+ void (*relocate)(value_t oldv, value_t newv);
+ void (*finalize)(value_t self);
+ void (*print_traverse)(value_t self);
+} cvtable_t;
+
+value_t relocate_lispvalue(value_t v);
+
+typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
+
+typedef struct _fltype_t {+ value_t type;
+ cvtable_t *vtable;
+ struct _fltype_t *eltype; // for arrays
+ struct _fltype_t *artype; // (array this)
+ cvinitfunc_t init;
+ size_t size;
+ size_t elsz;
+ int marked;
+ numerictype_t numtype;
+}fltype_t;
+
+typedef struct {+ fltype_t *type;
+ void *data;
+ size_t len; // length of *data in bytes
+ union {+ value_t parent; // optional
+ char _space[1]; // variable size
+ };
+}cvalue_t;
+
+#define CVALUE_NWORDS 4
+
+typedef struct {+ fltype_t *type;
+ char _space[1];
+}cprim_t;
+
+typedef struct {+ value_t bcode;
+ value_t vals;
+ value_t env;
+ value_t name;
+}function_t;
+
+#define CPRIM_NWORDS 2
+#define MAX_INL_SIZE 384
+
+#define CV_OWNED_BIT 0x1
+#define CV_PARENT_BIT 0x2
+#define owned(cv) ((uintptr_t)(cv)->type & CV_OWNED_BIT)
+#define hasparent(cv) ((uintptr_t)(cv)->type & CV_PARENT_BIT)
+#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
+#define cv_class(cv) ((fltype_t*)(((uintptr_t)((cvalue_t*)cv)->type)&~3))
+#define cv_len(cv) (((cvalue_t*)(cv))->len)
+#define cv_type(cv) (cv_class(cv)->type)
+#define cv_data(cv) (((cvalue_t*)(cv))->data)
+#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
+#define cv_isPOD(cv) (cv_class(cv)->init != nil)
+
+#define cvalue_data(v) cv_data((cvalue_t*)ptr(v))
+#define cvalue_len(v) cv_len((cvalue_t*)ptr(v))
+#define value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v)))
+
+#define cp_class(cp) (((cprim_t*)(cp))->type)
+#define cp_type(cp) (cp_class(cp)->type)
+#define cp_numtype(cp) (cp_class(cp)->numtype)
+#define cp_data(cp) (&((cprim_t*)(cp))->_space[0])
+
+// WARNING: multiple evaluation!
+#define cptr(v) (iscprim(v) ? cp_data(ptr(v)) : cv_data(ptr(v)))
+
+#define BUILTIN(lname, cname) \
+ value_t fn_builtin_##cname(value_t *args, int nargs)
+
+typedef value_t (*builtin_t)(value_t*, int);
+
+typedef struct {+ char *name;
+ builtin_t fptr;
+}builtinspec_t;
+
+//--------------------------------------------------
+// THESE WERE STATIC BEFORE FILES SPLITTING
+//--------------------------------------------------
+extern value_t *Stack;
+extern uint32_t SP;
+extern uint32_t N_STACK;
+extern uint32_t curr_frame;
+extern char *curr_fname;
+
+#define PUSH(v) \
+ do{ \+ Stack[SP++] = (v); \
+ }while(0)
+#define POP() (Stack[--SP])
+#define POPN(n) \
+ do{ \+ SP -= (n); \
+ }while(0)
+
+extern value_t NIL, LAMBDA, IF, TRYCATCH;
+extern value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION;
+extern value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
+extern value_t definesym, defmacrosym, forsym, setqsym;
+extern value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym, fnsym;
+// for reading characters
+extern value_t nulsym, alarmsym, backspacesym, tabsym, linefeedsym, newlinesym;
+extern value_t vtabsym, pagesym, returnsym, escsym, spacesym, deletesym;
+extern void *alloc_words(int n);
+extern value_t relocate(value_t v);
+extern fl_readstate_t *readstate = nil;
+extern void
+free_readstate(fl_readstate_t *rs)
+{+ htable_free(&rs->backrefs);
+ htable_free(&rs->gensyms);
+}
+
+extern uint8_t *fromspace;
+extern uint32_t heapsize;//bytes
+extern uint8_t *tospace;
+extern uint8_t *curheap;
+extern uint8_t *lim;
+extern uint32_t *consflags;
+
+value_t mk_cons(void);
+void *alloc_words(int n);
+
+int isnumtok(char *tok, value_t *pval);
+inline int symchar(char c);
+value_t relocate(value_t v);
+
+extern value_t the_empty_vector;
+
+
+
+//--------------------------------------------------read.c
+value_t fl_read_sexpr(value_t f);
+int isnumtok_base(char *tok, value_t *pval, int base);
+//--------------------------------------------------read.c
+
+//--------------------------------------------------builtins.c
+size_t llength(value_t v);
+//--------------------------------------------------builtins.c
+
+//--------------------------------------------------equal.c
+value_t fl_compare(value_t a, value_t b); // -1, 0, or 1
+value_t fl_equal(value_t a, value_t b); // T or nil
+int equal_lispvalue(value_t a, value_t b);
+uintptr_t hash_lispvalue(value_t a);
+//--------------------------------------------------equal.c
+
+//--------------------------------------------------print.c
+void fl_print(ios_t *f, value_t v);
+void print_traverse(value_t v);
+void fl_print_chr(char c, ios_t *f);
+void fl_print_str(char *s, ios_t *f);
+void fl_print_child(ios_t *f, value_t v);
+//--------------------------------------------------print.c
+
+//--------------------------------------------------cvalues.c
+extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
+extern value_t int64sym, uint64sym;
+extern value_t longsym, ulongsym, bytesym, wcharsym;
+extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
+extern value_t stringtypesym, wcstringtypesym, emptystringsym;
+extern value_t unionsym, floatsym, doublesym;
+extern fltype_t *bytetype, *wchartype;
+extern fltype_t *stringtype, *wcstringtype;
+extern fltype_t *builtintype;
+value_t cvalue(fltype_t *type, size_t sz);
+void add_finalizer(cvalue_t *cv);
+void cv_autorelease(cvalue_t *cv);
+void cv_pin(cvalue_t *cv);
+size_t ctype_sizeof(value_t type, int *palign);
+value_t cvalue_copy(value_t v);
+value_t cvalue_from_data(fltype_t *type, void *data, size_t sz);
+value_t cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent);
+value_t cbuiltin(char *name, builtin_t f);
+size_t cvalue_arraylen(value_t v);
+value_t size_wrap(size_t sz);
+size_t toulong(value_t n);
+off_t tooffset(value_t n);
+value_t cvalue_string(size_t sz);
+value_t cvalue_static_cstring(const char *str);
+value_t string_from_cstr(char *str);
+value_t string_from_cstrn(char *str, size_t n);
+int fl_isstring(value_t v);
+value_t cvalue_compare(value_t a, value_t b);
+int numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr);
+void to_sized_ptr(value_t v, char **pdata, size_t *psz);
+value_t mk_double(double n);
+value_t mk_float(float n);
+value_t mk_int32(int32_t n);
+value_t mk_uint32(uint32_t n);
+value_t mk_int64(int64_t n);
+value_t mk_uint64(uint64_t n);
+value_t mk_wchar(int32_t n);
+value_t return_from_uint64(uint64_t Uaccum);
+value_t return_from_int64(int64_t Saccum);
+//--------------------------------------------------cvalues.c
+
+//--------------------------------------------------iostream.c
+int fl_isiostream(value_t v);
+ios_t *fl_toiostream(value_t v);
+//--------------------------------------------------iostream.c
+
+
+//--------------------------------------------------types.c
+fltype_t *get_type(value_t t);
+fltype_t *get_array_type(value_t eltype);
+fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, cvinitfunc_t init);
+//--------------------------------------------------types.c
+
+//--------------------------------------------------operators.c
+double conv_to_double(void *data, numerictype_t tag);
+void conv_from_double(void *data, double d, numerictype_t tag);
+mpint *conv_to_mpint(void *data, numerictype_t tag);
+int64_t conv_to_int64(void *data, numerictype_t tag);
+uint64_t conv_to_uint64(void *data, numerictype_t tag);
+int32_t conv_to_int32(void *data, numerictype_t tag);
+uint32_t conv_to_uint32(void *data, numerictype_t tag);
+//--------------------------------------------------???
+#if defined(ULONG64)
+#define conv_to_long conv_to_int64
+#define conv_to_ulong conv_to_uint64
+#else
+#define conv_to_long conv_to_int32
+#define conv_to_ulong conv_to_uint32
+#endif
+//--------------------------------------------------operators.c
+
+#endif
--- /dev/null
+++ b/flisp.h-orig
@@ -1,0 +1,395 @@
+#ifndef FLISP_H
+#define FLISP_H
+
+/* functions needed to implement the value interface (cvtable_t) */
+typedef enum {+ T_INT8, T_UINT8,
+ T_INT16, T_UINT16,
+ T_INT32, T_UINT32,
+ T_INT64, T_UINT64,
+ T_MPINT,
+ T_FLOAT,
+ T_DOUBLE,
+}numerictype_t;
+
+#define NONNUMERIC (0xff)
+#define valid_numtype(v) ((v) <= T_DOUBLE)
+
+typedef uintptr_t value_t;
+typedef lltint_t fixnum_t;
+
+#ifdef BITS64
+#define T_FIXNUM T_INT64
+#define fits_fixnum(x) (((x)>>61) == 0 || (~((x)>>61)) == 0)
+#define mk_xlong mk_int64
+#else
+#define T_FIXNUM T_INT32
+#define fits_fixnum(x) (((x)>>29) == 0 || (~((x)>>29)) == 0)
+#define mk_xlong mk_long
+#endif
+
+typedef struct {+ value_t car;
+ value_t cdr;
+}cons_t;
+
+typedef struct _symbol_t {+ value_t binding; // global value binding
+ uint32_t hash;
+ uint8_t numtype;
+ uint8_t size;
+ uint8_t align;
+ uint8_t flags;
+ struct _fltype_t *type;
+ void *dlcache; // dlsym address
+ // below fields are private
+ struct _symbol_t *left;
+ struct _symbol_t *right;
+ union {+ char name[1];
+ void *_pad; // ensure field aligned to pointer size
+ };
+}symbol_t;
+
+typedef struct {+ value_t isconst;
+ value_t binding; // global value binding
+ struct _fltype_t *type;
+ uint32_t id;
+}gensym_t;
+
+enum {+ TAG_NUM,
+ TAG_CPRIM,
+ TAG_FUNCTION,
+ TAG_VECTOR,
+ TAG_NUM1,
+ TAG_CVALUE,
+ TAG_SYM,
+ TAG_CONS,
+};
+
+enum {+ FLAG_CONST = 1<<0,
+ FLAG_KEYWORD = 1<<1,
+};
+
+#define UNBOUND ((value_t)0x1) // an invalid value
+#define TAG_FWD UNBOUND
+#define tag(x) ((x) & 0x7)
+#define ptr(x) ((void*)((x) & (~(value_t)0x7)))
+#define tagptr(p, t) (((value_t)(p)) | (t))
+#define fixnum(x) ((value_t)((fixnum_t)(x))<<2)
+#define numval(x) (((fixnum_t)(x))>>2)
+#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_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)
+int isbuiltin(value_t x);
+#define isvector(x) (tag(x) == TAG_VECTOR)
+#define iscvalue(x) (tag(x) == TAG_CVALUE)
+#define iscprim(x) (tag(x) == TAG_CPRIM)
+#define selfevaluating(x) (tag(x) < 6)
+// comparable with ==
+#define eq_comparable(a, b) (!(((a)|(b))&1))
+#define eq_comparablep(a) (!((a)&1))
+// doesn't lead to other values
+#define leafp(a) (((a)&3) != 3)
+
+int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp);
+
+#define isforwarded(v) (((value_t*)ptr(v))[0] == TAG_FWD)
+#define forwardloc(v) (((value_t*)ptr(v))[1])
+#define forward(v, to) \
+ do{ \+ (((value_t*)ptr(v))[0] = TAG_FWD); \
+ (((value_t*)ptr(v))[1] = to); \
+ }while (0)
+
+#define vector_size(v) (((size_t*)ptr(v))[0]>>2)
+#define vector_setsize(v, n) (((size_t*)ptr(v))[0] = ((n)<<2))
+#define vector_elt(v, i) (((value_t*)ptr(v))[1+(i)])
+#define vector_grow_amt(x) ((x)<8 ? 5 : 6*((x)>>3))
+// functions ending in _ are unsafe, faster versions
+#define car_(v) (((cons_t*)ptr(v))->car)
+#define cdr_(v) (((cons_t*)ptr(v))->cdr)
+#define car(v) (tocons((v))->car)
+#define cdr(v) (tocons((v))->cdr)
+#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])
+#define fn_name(f) (((value_t*)ptr(f))[3])
+
+#define set(s, v) (((symbol_t*)ptr(s))->binding = (v))
+#define setc(s, v) \
+ do{ \+ ((symbol_t*)ptr(s))->flags |= FLAG_CONST; \
+ ((symbol_t*)ptr(s))->binding = (v); \
+ }while (0)
+#define isconstant(s) ((s)->flags & FLAG_CONST)
+#define iskeyword(s) ((s)->flags & FLAG_KEYWORD)
+#define symbol_value(s) (((symbol_t*)ptr(s))->binding)
+#define sym_to_numtype(s) (((symbol_t*)ptr(s))->numtype)
+#define ismanaged(v) ((((uint8_t*)ptr(v)) >= fromspace) && (((uint8_t*)ptr(v)) < fromspace+heapsize))
+#define isgensym(x) (issymbol(x) && ismanaged(x))
+value_t gensym(void);
+
+#define isfunction(x) (tag(x) == TAG_FUNCTION && (x) > (N_BUILTINS<<3))
+#define isclosure(x) isfunction(x)
+#define iscbuiltin(x) (iscvalue(x) && cv_class(ptr(x)) == builtintype)
+
+void fl_gc_handle(value_t *pv);
+void fl_free_gc_handles(uint32_t n);
+
+// 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
+#define FOR_ARGS(i, i0, arg, args) \
+ for(i=i0; i<nargs && ((arg=args[i]) || 1); i++)
+
+#define N_BUILTINS ((int)N_OPCODES)
+
+extern value_t FL_NIL, FL_T, FL_F, FL_EOF;
+
+#define FL_UNSPECIFIED FL_T
+
+/* read, eval, print main entry points */
+value_t fl_read_sexpr(value_t f);
+void fl_print(ios_t *f, value_t v);
+value_t fl_toplevel_eval(value_t expr);
+value_t fl_apply(value_t f, value_t l);
+value_t fl_applyn(uint32_t n, value_t f, ...);
+
+extern value_t printprettysym, printreadablysym, printwidthsym;
+
+/* object model manipulation */
+value_t fl_cons(value_t a, value_t b);
+value_t fl_list2(value_t a, value_t b);
+value_t fl_listn(size_t n, ...);
+value_t symbol(char *str);
+char *symbol_name(value_t v);
+int fl_is_keyword_name(char *str, size_t len);
+value_t alloc_vector(size_t n, int init);
+size_t llength(value_t v);
+value_t fl_compare(value_t a, value_t b); // -1, 0, or 1
+value_t fl_equal(value_t a, value_t b); // T or nil
+int equal_lispvalue(value_t a, value_t b);
+uintptr_t hash_lispvalue(value_t a);
+int isnumtok_base(char *tok, value_t *pval, int base);
+
+/* safe casts */
+cons_t *tocons(value_t v);
+symbol_t *tosymbol(value_t v);
+fixnum_t tofixnum(value_t v);
+char *tostring(value_t v);
+
+/* error handling */
+typedef struct _fl_readstate_t {+ htable_t backrefs;
+ htable_t gensyms;
+ value_t source;
+ struct _fl_readstate_t *prev;
+}fl_readstate_t;
+
+typedef struct _ectx_t {+ jmp_buf buf;
+ uint32_t sp;
+ uint32_t frame;
+ uint32_t ngchnd;
+ fl_readstate_t *rdst;
+ struct _ectx_t *prev;
+}fl_exception_context_t;
+
+extern fl_exception_context_t *fl_ctx;
+extern uint32_t fl_throwing_frame;
+extern value_t fl_lasterror;
+
+#define FL_TRY_EXTERN \
+ fl_exception_context_t _ctx; int l__tr, l__ca; \
+ fl_savestate(&_ctx); fl_ctx = &_ctx; \
+ if(!setjmp(_ctx.buf)) \
+ for(l__tr=1; l__tr; l__tr=0, (void)(fl_ctx = fl_ctx->prev))
+
+#define FL_CATCH_EXTERN_NO_RESTORE \
+ else \
+ for(l__ca=1; l__ca;)
+
+#define FL_CATCH_EXTERN \
+ else \
+ for(l__ca=1; l__ca; l__ca=0, fl_restorestate(&_ctx))
+
+_Noreturn void lerrorf(value_t e, char *format, ...);
+void fl_savestate(fl_exception_context_t *_ctx);
+void fl_restorestate(fl_exception_context_t *_ctx);
+_Noreturn void fl_raise(value_t e);
+_Noreturn void type_error(char *expected, value_t got);
+_Noreturn void bounds_error(value_t arr, value_t ind);
+_Noreturn void unbound_error(value_t sym);
+extern value_t ArgError, IOError, KeyError, MemoryError, EnumerationError;
+#define argcount(nargs, c) \
+ do{ \+ if(__unlikely(nargs != c)) \
+ lerrorf(ArgError, "arity mismatch: wanted %d, got %d", c, nargs); \
+ }while(0)
+
+typedef struct {+ void (*print)(value_t self, ios_t *f);
+ void (*relocate)(value_t oldv, value_t newv);
+ void (*finalize)(value_t self);
+ void (*print_traverse)(value_t self);
+} cvtable_t;
+
+value_t relocate_lispvalue(value_t v);
+void print_traverse(value_t v);
+void fl_print_chr(char c, ios_t *f);
+void fl_print_str(char *s, ios_t *f);
+void fl_print_child(ios_t *f, value_t v);
+
+typedef int (*cvinitfunc_t)(struct _fltype_t*, value_t, void*);
+
+typedef struct _fltype_t {+ value_t type;
+ cvtable_t *vtable;
+ struct _fltype_t *eltype; // for arrays
+ struct _fltype_t *artype; // (array this)
+ cvinitfunc_t init;
+ size_t size;
+ size_t elsz;
+ int marked;
+ numerictype_t numtype;
+}fltype_t;
+
+typedef struct {+ fltype_t *type;
+ void *data;
+ size_t len; // length of *data in bytes
+ union {+ value_t parent; // optional
+ char _space[1]; // variable size
+ };
+}cvalue_t;
+
+#define CVALUE_NWORDS 4
+
+typedef struct {+ fltype_t *type;
+ char _space[1];
+}cprim_t;
+
+typedef struct {+ value_t bcode;
+ value_t vals;
+ value_t env;
+ value_t name;
+}function_t;
+
+#define CPRIM_NWORDS 2
+#define MAX_INL_SIZE 384
+
+#define CV_OWNED_BIT 0x1
+#define CV_PARENT_BIT 0x2
+#define owned(cv) ((uintptr_t)(cv)->type & CV_OWNED_BIT)
+#define hasparent(cv) ((uintptr_t)(cv)->type & CV_PARENT_BIT)
+#define isinlined(cv) ((cv)->data == &(cv)->_space[0])
+#define cv_class(cv) ((fltype_t*)(((uintptr_t)((cvalue_t*)cv)->type)&~3))
+#define cv_len(cv) (((cvalue_t*)(cv))->len)
+#define cv_type(cv) (cv_class(cv)->type)
+#define cv_data(cv) (((cvalue_t*)(cv))->data)
+#define cv_isstr(cv) (cv_class(cv)->eltype == bytetype)
+#define cv_isPOD(cv) (cv_class(cv)->init != nil)
+
+#define cvalue_data(v) cv_data((cvalue_t*)ptr(v))
+#define cvalue_len(v) cv_len((cvalue_t*)ptr(v))
+#define value2c(type, v) ((type)cv_data((cvalue_t*)ptr(v)))
+
+#define cp_class(cp) (((cprim_t*)(cp))->type)
+#define cp_type(cp) (cp_class(cp)->type)
+#define cp_numtype(cp) (cp_class(cp)->numtype)
+#define cp_data(cp) (&((cprim_t*)(cp))->_space[0])
+
+// WARNING: multiple evaluation!
+#define cptr(v) (iscprim(v) ? cp_data(ptr(v)) : cv_data(ptr(v)))
+
+#define BUILTIN(lname, cname) \
+ value_t fn_builtin_##cname(value_t *args, int nargs)
+
+typedef value_t (*builtin_t)(value_t*, int);
+
+extern value_t QUOTE;
+extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
+extern value_t int64sym, uint64sym;
+extern value_t longsym, ulongsym, bytesym, wcharsym;
+extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
+extern value_t stringtypesym, wcstringtypesym, emptystringsym;
+extern value_t unionsym, floatsym, doublesym;
+extern fltype_t *bytetype, *wchartype;
+extern fltype_t *stringtype, *wcstringtype;
+extern fltype_t *builtintype;
+
+value_t cvalue(fltype_t *type, size_t sz);
+void add_finalizer(cvalue_t *cv);
+void cv_autorelease(cvalue_t *cv);
+void cv_pin(cvalue_t *cv);
+size_t ctype_sizeof(value_t type, int *palign);
+value_t cvalue_copy(value_t v);
+value_t cvalue_from_data(fltype_t *type, void *data, size_t sz);
+value_t cvalue_from_ref(fltype_t *type, void *ptr, size_t sz, value_t parent);
+value_t cbuiltin(char *name, builtin_t f);
+size_t cvalue_arraylen(value_t v);
+value_t size_wrap(size_t sz);
+size_t toulong(value_t n);
+off_t tooffset(value_t n);
+value_t cvalue_string(size_t sz);
+value_t cvalue_static_cstring(const char *str);
+value_t string_from_cstr(char *str);
+value_t string_from_cstrn(char *str, size_t n);
+int fl_isstring(value_t v);
+int fl_isnumber(value_t v);
+int fl_isiostream(value_t v);
+ios_t *fl_toiostream(value_t v);
+value_t cvalue_compare(value_t a, value_t b);
+int numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr);
+
+void to_sized_ptr(value_t v, char **pdata, size_t *psz);
+
+fltype_t *get_type(value_t t);
+fltype_t *get_array_type(value_t eltype);
+fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, cvinitfunc_t init);
+
+value_t mk_double(double n);
+value_t mk_float(float n);
+value_t mk_int32(int32_t n);
+value_t mk_uint32(uint32_t n);
+value_t mk_int64(int64_t n);
+value_t mk_uint64(uint64_t n);
+value_t mk_wchar(int32_t n);
+value_t return_from_uint64(uint64_t Uaccum);
+value_t return_from_int64(int64_t Saccum);
+
+double conv_to_double(void *data, numerictype_t tag);
+void conv_from_double(void *data, double d, numerictype_t tag);
+mpint *conv_to_mpint(void *data, numerictype_t tag);
+int64_t conv_to_int64(void *data, numerictype_t tag);
+uint64_t conv_to_uint64(void *data, numerictype_t tag);
+int32_t conv_to_int32(void *data, numerictype_t tag);
+uint32_t conv_to_uint32(void *data, numerictype_t tag);
+#if defined(ULONG64)
+#define conv_to_long conv_to_int64
+#define conv_to_ulong conv_to_uint64
+#else
+#define conv_to_long conv_to_int32
+#define conv_to_ulong conv_to_uint32
+#endif
+
+typedef struct {+ char *name;
+ builtin_t fptr;
+}builtinspec_t;
+
+void fl_init(size_t initial_heapsize);
+int fl_load_system_image(value_t ios);
+
+#endif
--- a/print.c
+++ b/print.c
@@ -1,6 +1,10 @@
+//#include "llt.h"
+//#include "flisp.h"
+//#include "opcodes.h"
+
#include "ieee754.h"
-static htable_t printconses;
+htable_t printconses;
static uint32_t printlabel;
static int print_pretty;
static int print_princ;
@@ -7,7 +11,7 @@
static fixnum_t print_length;
static fixnum_t print_level;
static fixnum_t P_LEVEL;
-static int SCR_WIDTH = 80;
+int SCR_WIDTH = 80;
static int HPOS = 0, VPOS;
static void
--- a/read.c
+++ b/read.c
@@ -1,3 +1,6 @@
+//#include "llt.h"
+//#include "flisp.h"
+
enum {TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,
TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT,
@@ -83,12 +86,13 @@
// exceptions are '.', which is an ordinary symbol character
// unless it's the only character in the symbol, and '#', which is
// an ordinary symbol character unless it's the first character.
-static inline int
-symchar(char c)
-{- static char *special = "()[]'\";`,\\| \a\b\f\n\r\t\v";
- return !strchr(special, c);
-}
+//inline int
+//symchar(char c)
+//{+// //static char *special = "()[]'\";`,\\| \a\b\f\n\r\t\v";
+// char *special = "()[]'\";`,\\| \a\b\f\n\r\t\v";
+// return !strchr(special, c);
+//}
int
isnumtok_base(char *tok, value_t *pval, int base)
@@ -150,7 +154,7 @@
return *end == '\0';
}
-static int
+int
isnumtok(char *tok, value_t *pval)
{return isnumtok_base(tok, pval, 0);
--- a/types.c
+++ b/types.c
@@ -1,3 +1,6 @@
+//#include "llt.h"
+//#include "flisp.h"
+
#include "equalhash.h"
fltype_t *