shithub: femtolisp

Info  •  Files  •  Log

worked

--- a/MAG.notes

+++ b/MAG.notes

@@ -8,28 +8,3 @@

 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

@@ -15,6 +15,11 @@

 	equalhash.o\

 	table.o\

 	iostream.o\

+	cvalues.o\

+	read.o\

+	print.o\

+	equal.o\

+	types.o\

 	llt/bitvector-ops.o\

 	llt/bitvector.o\

 	llt/dump.o\

@@ -56,13 +61,6 @@

 	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

@@ -79,7 +77,9 @@

 .c.o:

 	${CC} -o $@ -c $< ${CFLAGS}

-flisp.o: flisp.c cvalues.c operators.c types.c flisp.h print.c read.c equal.c maxstack.inc opcodes.h builtin_fns.h

+cvalues.o: operators.c

+

+flisp.o: flisp.c flisp.h maxstack.inc opcodes.h builtin_fns.h

 flmain.o: flmain.c boot.h flisp.h

 boot.h: flisp.boot

--- a/cvalues.c

+++ b/cvalues.c

@@ -1,5 +1,5 @@

-//#include "llt.h"

-//#include "flisp.h"

+#include "llt.h"

+#include "flisp.h"

 #include "operators.c"

--- a/equal.c

+++ b/equal.c

@@ -1,6 +1,6 @@

-//#include "llt.h"

-//#include "flisp.h"

-//#include "opcodes.h"

+#include "llt.h"

+#include "flisp.h"

+#include "opcodes.h"

 #define BOUNDED_COMPARE_BOUND 128

 #define BOUNDED_HASH_BOUND 16384

--- a/flisp.c

+++ b/flisp.c

@@ -333,8 +333,8 @@

 // cvalues --------------------------------------------------------------------

-#include "cvalues.c"

-#include "types.c"

+//#include "cvalues.c"

+//#include "types.c"

 // print ----------------------------------------------------------------------

@@ -342,7 +342,7 @@

 //static inline int symchar(char c);

 extern inline int symchar(char c);

-#include "print.c"

+//#include "print.c"

 // collector ------------------------------------------------------------------

@@ -727,11 +727,11 @@

 // read -----------------------------------------------------------------------

-#include "read.c"

+//#include "read.c"

 // equal ----------------------------------------------------------------------

-#include "equal.c"

+//#include "equal.c"

 // eval -----------------------------------------------------------------------

@@ -2057,14 +2057,11 @@

 	return first;

 }

-#define BUILTIN_FN(l, c) extern BUILTIN(l, c);

-#include "builtin_fns.h"

-#undef BUILTIN_FN

-

 static const builtinspec_t builtin_fns[] = {

 #define BUILTIN_FN(l, c){l, fn_builtin_##c},

 #include "builtin_fns.h"

 #undef BUILTIN_FN

+

 };

 // initialization -------------------------------------------------------------

--- a/flisp.h

+++ b/flisp.h

@@ -480,6 +480,10 @@

 extern value_t the_empty_vector;

 value_t mk_cons(void);

+#define BUILTIN_FN(l, c) extern BUILTIN(l, c);

+#include "builtin_fns.h"

+#undef BUILTIN_FN

+

 //--------------------------------------------------cvalues.c

 void cvalues_init(void);

 value_t fl_idiv2(value_t a, value_t b);

--- a/flisp.h-first_attempt

+++ /dev/null

@@ -1,467 +1,0 @@

-#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

--- a/flisp.h-orig

+++ /dev/null

@@ -1,395 +1,0 @@

-#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,6 @@

-//#include "llt.h"

-//#include "flisp.h"

-//#include "opcodes.h"

+#include "llt.h"

+#include "flisp.h"

+#include "opcodes.h"

 #include "ieee754.h"

--- a/read.c

+++ b/read.c

@@ -1,5 +1,5 @@

-//#include "llt.h"

-//#include "flisp.h"

+#include "llt.h"

+#include "flisp.h"

 enum {

 	TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,

--- a/types.c

+++ b/types.c

@@ -1,5 +1,5 @@

-//#include "llt.h"

-//#include "flisp.h"

+#include "llt.h"

+#include "flisp.h"

 #include "equalhash.h"