shithub: femtolisp

ref: 14c196a5da48284123d615418c80b6fbc87d7f46
dir: /flisp.c/

View raw version
/*
  femtoLisp

  by Jeff Bezanson (C) 2009
  Distributed under the BSD License
*/

#include "flisp.h"
#include "operators.h"
#include "cvalues.h"
#include "opcodes.h"
#include "types.h"
#include "print.h"
#include "read.h"
#include "timefuncs.h"
#include "equal.h"
#include "hashing.h"
#include "table.h"
#include "iostream.h"
#include "fsixel.h"

typedef struct {
	char *name;
	builtin_t fptr;
}builtinspec_t;

#ifdef NDEBUG
__thread
#endif
Fl *fl;

bool
isbuiltin(value_t x)
{
	uint32_t i;
	return tag(x) == TAG_FUNCTION && (i = uintval(x)) < nelem(builtins) && builtins[i].name != nil;
}

static value_t apply_cl(uint32_t nargs);

// error utilities ------------------------------------------------------------

void
free_readstate(fl_readstate_t *rs)
{
	htable_free(&rs->backrefs);
	htable_free(&rs->gensyms);
}

_Noreturn void
fl_exit(int status)
{
	FL(exiting) = true;
	gc(0);
	exit(status);
}

#define FL_TRY \
	fl_exception_context_t _ctx; int l__tr, l__ca; \
	_ctx.sp = FL(sp); _ctx.frame = FL(curr_frame); _ctx.rdst = FL(readstate); _ctx.prev = FL(exctx); \
	_ctx.ngchnd = FL(ngchandles); FL(exctx) = &_ctx; \
	if(!setjmp(_ctx.buf)) \
		for(l__tr = 1; l__tr; l__tr = 0, (void)(FL(exctx) = FL(exctx)->prev))

#define FL_CATCH_INC \
	l__ca = 0, FL(lasterror) = FL(Nil), FL(throwing_frame) = 0, FL(sp) = _ctx.sp, FL(curr_frame) = _ctx.frame

#define FL_CATCH \
	else \
		for(l__ca = 1; l__ca; FL_CATCH_INC)

#define FL_CATCH_NO_INC \
	else \
		for(l__ca = 1; l__ca;)

void
fl_savestate(fl_exception_context_t *_ctx)
{
	_ctx->sp = FL(sp);
	_ctx->frame = FL(curr_frame);
	_ctx->rdst = FL(readstate);
	_ctx->prev = FL(exctx);
	_ctx->ngchnd = FL(ngchandles);
}

void
fl_restorestate(fl_exception_context_t *_ctx)
{
	FL(lasterror) = FL(Nil);
	FL(throwing_frame) = 0;
	FL(sp) = _ctx->sp;
	FL(curr_frame) = _ctx->frame;
}

_Noreturn void
fl_raise(value_t e)
{
	FL(lasterror) = e;
	// unwind read state
	while(FL(readstate) != FL(exctx)->rdst){
		free_readstate(FL(readstate));
		FL(readstate) = FL(readstate)->prev;
	}
	if(FL(throwing_frame) == 0)
		FL(throwing_frame) = FL(curr_frame);
	FL(ngchandles) = FL(exctx)->ngchnd;
	fl_exception_context_t *thisctx = FL(exctx);
	if(FL(exctx)->prev)   // don't throw past toplevel
		FL(exctx) = FL(exctx)->prev;
	longjmp(thisctx->buf, 1);
}

_Noreturn void
lerrorf(value_t e, const char *format, ...)
{
	char msgbuf[256];
	va_list args;

	PUSH(e);
	va_start(args, format);
	vsnprintf(msgbuf, sizeof(msgbuf), format, args);
	value_t msg = string_from_cstr(msgbuf);
	va_end(args);

	e = POP();
	fl_raise(fl_list2(e, msg));
}

_Noreturn void
type_error(const char *expected, value_t got)
{
	fl_raise(fl_listn(3, FL(TypeError), symbol(expected, false), got));
}

_Noreturn void
bounds_error(value_t arr, value_t ind)
{
	fl_raise(fl_listn(3, FL(BoundsError), arr, ind));
}

_Noreturn void
unbound_error(value_t sym)
{
	fl_raise(fl_listn(2, FL(UnboundError), sym));
}

// safe cast operators --------------------------------------------------------

#define isstring fl_isstring
#define SAFECAST_OP(type, ctype, cnvt) \
	ctype to##type(value_t v) \
	{ \
		if(__likely(is##type(v))) \
			return (ctype)cnvt(v); \
		type_error(#type, v); \
	}
SAFECAST_OP(cons, cons_t*, ptr)
SAFECAST_OP(symbol, symbol_t*, ptr)
SAFECAST_OP(fixnum, fixnum_t, numval)
//SAFECAST_OP(cvalue, cvalue_t*, ptr)
SAFECAST_OP(string, char*, cvalue_data)
#undef isstring

// symbol table ---------------------------------------------------------------

bool
fl_is_keyword_name(const char *str, size_t len)
{
	return (str[0] == ':' || str[len-1] == ':') && str[1] != '\0';
}

static symbol_t *
mk_symbol(const char *str, bool copy)
{
	symbol_t *sym;
	int len = strlen(str);

	sym = calloc(1, sizeof(*sym) + (copy ? len+1 : 0));
	assert(((uintptr_t)sym & 0x7) == 0); // make sure malloc aligns 8
	sym->numtype = NONNUMERIC;
	if(fl_is_keyword_name(str, len)){
		value_t s = tagptr(sym, TAG_SYM);
		setc(s, s);
		sym->flags |= FLAG_KEYWORD;
	}else{
		sym->binding = UNBOUND;
	}
	sym->hash = memhash32(str, len)^0xAAAAAAAA;
	if(copy){
		sym->name = (const char*)(sym+1);
		memcpy((char*)sym->name, str, len+1);
	}else{
		sym->name = str;
	}
	return sym;
}

static symbol_t **
symtab_lookup(symbol_t **ptree, const char *str)
{
	int x;
	while(*ptree != nil && (x = strcmp(str, (*ptree)->name)) != 0)
		ptree = x < 0 ? &(*ptree)->left : &(*ptree)->right;
	return ptree;
}

value_t
symbol(const char *str, bool copy)
{
	symbol_t **pnode;

	pnode = symtab_lookup(&FL(symtab), str);
	if(*pnode == nil)
		*pnode = mk_symbol(str, copy);
	return tagptr(*pnode, TAG_SYM);
}

BUILTIN("gensym", gensym)
{
	argcount(nargs, 0);
	USED(args);
	gensym_t *gs = alloc_words(sizeof(gensym_t)/sizeof(value_t));
	gs->id = FL(gensym_ctr)++;
	gs->binding = UNBOUND;
	gs->type = nil;
	return tagptr(gs, TAG_SYM);
}

value_t
gensym(void)
{
	return fn_builtin_gensym(nil, 0);
}

BUILTIN("gensym?", gensymp)
{
	argcount(nargs, 1);
	return isgensym(args[0]) ? FL(t) : FL(f);
}

char *
uint2str(char *dest, size_t len, uint64_t num, uint32_t base)
{
	int i = len-1;
	uint64_t b = (uint64_t)base;
	char ch;
	dest[i--] = '\0';
	while(i >= 0){
		ch = (char)(num % b);
		if(ch < 10)
			ch += '0';
		else
			ch = ch-10+'a';
		dest[i--] = ch;
		num /= b;
		if(num == 0)
			break;
	}
	return &dest[i+1];
}

const char *
symbol_name(value_t v)
{
	if(ismanaged(v)){
		gensym_t *gs = (gensym_t*)ptr(v);
		FL(gsnameno) = 1-FL(gsnameno);
		char *n = uint2str(FL(gsname)[FL(gsnameno)]+1, sizeof(FL(gsname)[0])-1, gs->id, 10);
		*(--n) = 'g';
		return n;
	}
	return ((symbol_t*)ptr(v))->name;
}

// conses ---------------------------------------------------------------------

value_t
mk_cons(void)
{
	cons_t *c;

	if(__unlikely(FL(curheap) > FL(lim)))
		gc(0);
	c = (cons_t*)FL(curheap);
	FL(curheap) += sizeof(cons_t);
	return tagptr(c, TAG_CONS);
}

void *
alloc_words(uint32_t n)
{
	value_t *first;

	assert(n > 0);
	n = ALIGNED(n, 2);   // only allocate multiples of 2 words
	if(__unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)+2-n)){
		gc(0);
		while((value_t*)FL(curheap) > ((value_t*)FL(lim))+2-n)
			gc(1);
	}
	first = (value_t*)FL(curheap);
	FL(curheap) += n*sizeof(value_t);
	return first;
}

value_t
alloc_vector(size_t n, int init)
{
	if(n == 0)
		return FL(the_empty_vector);
	value_t *c = alloc_words(n+1);
	value_t v = tagptr(c, TAG_VECTOR);
	vector_setsize(v, n);
	if(init){
		unsigned int i;
		for(i = 0; i < n; i++)
			vector_elt(v, i) = FL(unspecified);
	}
	return v;
}

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

void
fl_gc_handle(value_t *pv)
{
	if(__unlikely(FL(ngchandles) >= N_GC_HANDLES))
		lerrorf(FL(MemoryError), "out of gc handles");
	FL(gchandles)[FL(ngchandles)++] = pv;
}

void
fl_free_gc_handles(uint32_t n)
{
	assert(FL(ngchandles) >= n);
	FL(ngchandles) -= n;
}

value_t
relocate(value_t v)
{
	value_t a, d, nc, first, *pcdr;

	if(isfixnum(v))
		return v;

	uintptr_t t = tag(v);
	if(t == TAG_CONS){
		// iterative implementation allows arbitrarily long cons chains
		pcdr = &first;
		do{
			if((a = car_(v)) == TAG_FWD){
				*pcdr = cdr_(v);
				return first;
			}
			car_(v) = TAG_FWD;
			d = cdr_(v);
			*pcdr = nc = tagptr((cons_t*)FL(curheap), TAG_CONS);
			FL(curheap) += sizeof(cons_t);
			cdr_(v) = nc;
			car_(nc) = relocate(a);
			pcdr = &cdr_(nc);
			v = d;
		}while(iscons(v));
		*pcdr = d == FL(Nil) ? FL(Nil) : relocate(d);
		return first;
	}

	if(!ismanaged(v))
		return v;
	if(isforwarded(v))
		return forwardloc(v);

	if(t == TAG_CVALUE)
		return cvalue_relocate(v);
	if(t == TAG_CPRIM){
		cprim_t *pcp = ptr(v);
		size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size);
		cprim_t *ncp = alloc_words(nw);
		while(nw--)
			((value_t*)ncp)[nw] = ((value_t*)pcp)[nw];
		nc = tagptr(ncp, TAG_CPRIM);
		forward(v, nc);
		return nc;
	}
	if(t == TAG_FUNCTION){
		function_t *fn = ptr(v);
		function_t *nfn = 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);
		assert(!ismanaged(fn->name));
		nfn->name = fn->name;
		return nc;
	}
	if(t == TAG_VECTOR){
		// N.B.: 0-length vectors secretly have space for a first element
		size_t i, sz = vector_size(v);
		if(vector_elt(v, -1) & 0x1){
			// grown vector
			nc = relocate(vector_elt(v, 0));
			forward(v, nc);
		}else{
			nc = tagptr(alloc_words(sz+1), TAG_VECTOR);
			vector_setsize(nc, sz);
			a = vector_elt(v, 0);
			forward(v, nc);
			if(sz > 0){
				vector_elt(nc, 0) = relocate(a);
				for(i = 1; i < sz; i++)
					vector_elt(nc, i) = relocate(vector_elt(v, i));
			}
		}
		return nc;
	}
	if(t == TAG_SYM){
		gensym_t *gs = ptr(v);
		gensym_t *ng = alloc_words(sizeof(gensym_t)/sizeof(value_t));
		ng->id = gs->id;
		ng->binding = gs->binding;
		nc = tagptr(ng, TAG_SYM);
		forward(v, nc);
		if(__likely(ng->binding != UNBOUND))
			ng->binding = relocate(ng->binding);
		return nc;
	}
	return v;
}

static void
trace_globals(symbol_t *root)
{
	while(root != nil){
		if(root->binding != UNBOUND)
			root->binding = relocate(root->binding);
		trace_globals(root->left);
		root = root->right;
	}
}

void
gc(int mustgrow)
{
	void *temp;
	uint32_t i, f, top;
	fl_readstate_t *rs;

	FL(gccalls)++;
	FL(curheap) = FL(tospace);
	if(FL(grew))
		FL(lim) = FL(curheap)+FL(heapsize)*2-sizeof(cons_t);
	else
		FL(lim) = FL(curheap)+FL(heapsize)-sizeof(cons_t);

	if(FL(throwing_frame) > FL(curr_frame)){
		top = FL(throwing_frame) - 3;
		f = FL(stack)[FL(throwing_frame)-3];
	}else{
		top = FL(sp);
		f = FL(curr_frame);
	}
	while(1){
		for(i = f; i < top; i++)
			FL(stack)[i] = relocate(FL(stack)[i]);
		if(f == 0)
			break;
		top = f - 3;
		f = FL(stack)[f-3];
	}
	for(i = 0; i < FL(ngchandles); i++)
		*FL(gchandles)[i] = relocate(*FL(gchandles)[i]);
	trace_globals(FL(symtab));
	relocate_typetable();
	rs = FL(readstate);
	while(rs){
		value_t ent;
		for(i = 0; i < rs->backrefs.size; i++){
			ent = (value_t)rs->backrefs.table[i];
			if(ent != (value_t)HT_NOTFOUND)
				rs->backrefs.table[i] = (void*)relocate(ent);
		}
		for(i = 0; i < rs->gensyms.size; i++){
			ent = (value_t)rs->gensyms.table[i];
			if(ent != (value_t)HT_NOTFOUND)
				rs->gensyms.table[i] = (void*)relocate(ent);
		}
		rs->source = relocate(rs->source);
		rs = rs->prev;
	}
	FL(lasterror) = relocate(FL(lasterror));
	FL(memory_exception_value) = relocate(FL(memory_exception_value));
	FL(the_empty_vector) = relocate(FL(the_empty_vector));

	sweep_finalizers();

#if defined(VERBOSEGC)
	printf("GC: found %d/%d live conses\n",
		   (FL(curheap)-FL(tospace))/sizeof(cons_t), FL(heapsize)/sizeof(cons_t));
#endif
	temp = FL(tospace);
	FL(tospace) = FL(fromspace);
	FL(fromspace) = temp;

	// if we're using > 80% of the space, resize tospace so we have
	// more space to fill next time. if we grew tospace last time,
	// grow the other half of the heap this time to catch up.
	if(FL(grew) || ((FL(lim)-FL(curheap)) < (int)(FL(heapsize)/5)) || mustgrow){
		temp = MEM_REALLOC(FL(tospace), FL(heapsize)*2);
		if(__unlikely(temp == nil))
			fl_raise(FL(memory_exception_value));
		FL(tospace) = temp;
		if(FL(grew)){
			FL(heapsize) *= 2;
			temp = bitvector_resize(FL(consflags), 0, FL(heapsize)/sizeof(cons_t), 1);
			if(__unlikely(temp == nil))
				fl_raise(FL(memory_exception_value));
			FL(consflags) = (uint32_t*)temp;
		}
		FL(grew) = !FL(grew);
	}
	if(__unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)-2)){
		// all data was live; gc again and grow heap.
		// but also always leave at least 4 words available, so a closure
		// can be allocated without an extra check.
		gc(0);
	}
}

static void
grow_stack(void)
{
	size_t newsz = FL(nstack) * 2;
	value_t *ns = MEM_REALLOC(FL(stack), newsz*sizeof(value_t));
	if(__unlikely(ns == nil))
		lerrorf(FL(MemoryError), "stack overflow");
	FL(stack) = ns;
	FL(nstack) = newsz;
}

// utils ----------------------------------------------------------------------

// apply function with n args on the stack
static value_t
_applyn(uint32_t n)
{
	value_t f = FL(stack)[FL(sp)-n-1];
	uint32_t saveSP = FL(sp);
	value_t v;
	if(iscbuiltin(f))
		v = ((builtin_t*)ptr(f))[3](&FL(stack)[FL(sp)-n], n);
	else if(isfunction(f))
		v = apply_cl(n);
	else if(__likely(isbuiltin(f))){
		value_t tab = symbol_value(FL(builtins_table_sym));
		if(__unlikely(ptr(tab) == nil))
			unbound_error(tab);
		FL(stack)[FL(sp)-n-1] = vector_elt(tab, uintval(f));
		v = apply_cl(n);
	}else{
		type_error("function", f);
	}
	FL(sp) = saveSP;
	return v;
}

value_t
fl_apply(value_t f, value_t l)
{
	value_t v = l;
	uint32_t n = FL(sp);

	PUSH(f);
	while(iscons(v)){
		if(FL(sp) >= FL(nstack))
			grow_stack();
		PUSH(car_(v));
		v = cdr_(v);
	}
	n = FL(sp) - n - 1;
	v = _applyn(n);
	POPN(n+1);
	return v;
}

value_t
fl_applyn(uint32_t n, value_t f, ...)
{
	va_list ap;
	va_start(ap, f);
	size_t i;

	PUSH(f);
	while(FL(sp)+n >= FL(nstack))
		grow_stack();
	for(i = 0; i < n; i++){
		value_t a = va_arg(ap, value_t);
		PUSH(a);
	}
	value_t v = _applyn(n);
	POPN(n+1);
	va_end(ap);
	return v;
}

value_t
fl_listn(size_t n, ...)
{
	va_list ap;
	va_start(ap, n);
	uint32_t si = FL(sp);
	size_t i;

	while(FL(sp)+n >= FL(nstack))
		grow_stack();
	for(i = 0; i < n; i++){
		value_t a = va_arg(ap, value_t);
		PUSH(a);
	}
	cons_t *c = alloc_words(n*2);
	cons_t *l = c;
	for(i = 0; i < n; i++){
		c->car = FL(stack)[si++];
		c->cdr = tagptr(c+1, TAG_CONS);
		c++;
	}
	c[-1].cdr = FL(Nil);

	POPN(n);
	va_end(ap);
	return tagptr(l, TAG_CONS);
}

value_t
fl_list2(value_t a, value_t b)
{
	PUSH(a);
	PUSH(b);
	cons_t *c = alloc_words(4);
	b = POP();
	a = POP();
	c[0].car = a;
	c[0].cdr = tagptr(c+1, TAG_CONS);
	c[1].car = b;
	c[1].cdr = FL(Nil);
	return tagptr(c, TAG_CONS);
}

value_t
fl_cons(value_t a, value_t b)
{
	PUSH(a);
	PUSH(b);
	value_t c = mk_cons();
	cdr_(c) = POP();
	car_(c) = POP();
	return c;
}

bool
fl_isnumber(value_t v)
{
	if(isfixnum(v))
		return true;
	if(iscprim(v)){
		cprim_t *c = ptr(v);
		return c->type != FL(runetype) && valid_numtype(c->type->numtype);
	}
	if(iscvalue(v)){
		cvalue_t *c = ptr(v);
		return valid_numtype(cp_numtype(c));
	}
	return false;
}

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

static value_t
list(value_t *args, uint32_t nargs, int star)
{
	cons_t *c;
	uint32_t i;
	value_t v;
	v = cons_reserve(nargs);
	c = ptr(v);
	for(i = 0; i < nargs; i++){
		c->car = args[i];
		c->cdr = tagptr(c+1, TAG_CONS);
		c++;
	}
	if(star)
		c[-2].cdr = c[-1].car;
	else
		c[-1].cdr = FL(Nil);
	return v;
}

static value_t
copy_list(value_t L)
{
	if(!iscons(L))
		return FL(Nil);
	PUSH(FL(Nil));
	PUSH(L);
	value_t *plcons = &FL(stack)[FL(sp)-2];
	value_t *pL = &FL(stack)[FL(sp)-1];
	value_t c;
	c = mk_cons(); PUSH(c);  // save first cons
	car_(c) = car_(*pL);
	cdr_(c) = FL(Nil);
	*plcons = c;
	*pL = cdr_(*pL);
	while(iscons(*pL)){
		c = mk_cons();
		car_(c) = car_(*pL);
		cdr_(c) = FL(Nil);
		cdr_(*plcons) = c;
		*plcons = c;
		*pL = cdr_(*pL);
	}
	c = POP();  // first cons
	POPN(2);
	return c;
}

static value_t
do_trycatch(void)
{
	uint32_t saveSP = FL(sp);
	value_t v = FL(Nil);
	value_t thunk = FL(stack)[FL(sp)-2];
	FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-1];
	FL(stack)[FL(sp)-1] = thunk;

	FL_TRY{
		v = apply_cl(0);
	}
	FL_CATCH{
		v = FL(stack)[saveSP-2];
		PUSH(v);
		PUSH(FL(lasterror));
		v = apply_cl(1);
	}
	FL(sp) = saveSP;
	return v;
}

/*
  argument layout on stack is
  |--required args--|--opt args--|--kw args--|--rest args...
*/
static uint32_t
process_keys(value_t kwtable, uint32_t nreq, uint32_t nkw, uint32_t nopt, uint32_t bp, uint32_t nargs, int va)
{
	uint32_t extr = nopt+nkw;
	uint32_t ntot = nreq+extr;
	value_t args[64], v = FL(Nil);
	uint32_t i, a = 0, nrestargs;
	value_t s1 = FL(stack)[FL(sp)-1];
	value_t s3 = FL(stack)[FL(sp)-3];
	value_t s4 = FL(stack)[FL(sp)-4];
	if(__unlikely(nargs < nreq))
		lerrorf(FL(ArgError), "too few arguments");
	if(__unlikely(extr > nelem(args)))
		lerrorf(FL(ArgError), "too many arguments");
	for(i = 0; i < extr; i++)
		args[i] = UNBOUND;
	for(i = nreq; i < nargs; i++){
		v = FL(stack)[bp+i];
		if(issymbol(v) && iskeyword((symbol_t*)ptr(v)))
			break;
		if(a >= nopt)
			goto no_kw;
		args[a++] = v;
	}
	if(i >= nargs)
		goto no_kw;
	// now process keywords
	uintptr_t n = vector_size(kwtable)/2;
	do{
		i++;
		if(__unlikely(i >= nargs))
			lerrorf(FL(ArgError), "keyword %s requires an argument", symbol_name(v));
		value_t hv = fixnum(((symbol_t*)ptr(v))->hash);
		fixnum_t lx = numval(hv);
		uintptr_t x = 2*((lx < 0 ? -lx : lx) % n);
		if(__likely(vector_elt(kwtable, x) == v)){
			uintptr_t idx = numval(vector_elt(kwtable, x+1));
			assert(idx < nkw);
			idx += nopt;
			if(args[idx] == UNBOUND){
				// if duplicate key, keep first value
				args[idx] = FL(stack)[bp+i];
			}
		}else{
			lerrorf(FL(ArgError), "unsupported keyword %s", symbol_name(v));
		}
		i++;
		if(i >= nargs)
			break;
		v = FL(stack)[bp+i];
	}while(issymbol(v) && iskeyword((symbol_t*)ptr(v)));
no_kw:
	nrestargs = nargs - i;
	if(__unlikely(!va && nrestargs > 0))
		lerrorf(FL(ArgError), "too many arguments");
	nargs = ntot + nrestargs;
	if(nrestargs)
		memmove(&FL(stack)[bp+ntot], &FL(stack)[bp+i], nrestargs*sizeof(value_t));
	memmove(&FL(stack)[bp+nreq], args, extr*sizeof(value_t));
	FL(sp) = bp + nargs;
	assert(FL(sp) < FL(nstack)-4);
	PUSH(s4);
	PUSH(s3);
	PUSH(nargs);
	PUSH(s1);
	FL(curr_frame) = FL(sp);
	return nargs;
}

#define GET_INT32(a) \
	((int32_t) \
	((((uint32_t)a[0])<<0)  | \
	 (((uint32_t)a[1])<<8)  | \
	 (((uint32_t)a[2])<<16) | \
	 (((uint32_t)a[3])<<24)))
#define GET_INT16(a) \
	((int16_t) \
	((((int16_t)a[0])<<0)  | \
	 (((int16_t)a[1])<<8)))
#define PUT_INT32(a, i) \
	do{ \
		((uint8_t*)(a))[0] = ((uint32_t)(i)>>0)&0xff; \
		((uint8_t*)(a))[1] = ((uint32_t)(i)>>8)&0xff; \
		((uint8_t*)(a))[2] = ((uint32_t)(i)>>16)&0xff; \
		((uint8_t*)(a))[3] = ((uint32_t)(i)>>24)&0xff; \
	}while(0)

/*
  stack on entry: <func>  <nargs args...>
  caller's responsibility:
  - put the stack in this state
  - provide arg count
  - respect tail position
  - restore SP

  callee's responsibility:
  - check arg counts
  - allocate vararg array
  - push closed env, set up new environment
*/
static value_t
apply_cl(uint32_t nargs)
{
	uint32_t top_frame = FL(curr_frame);
	// frame variables
	uint32_t n, bp;
	const uint8_t *ip;
	fixnum_t s, hi;
	int tail, x;

	// temporary variables (not necessary to preserve across calls)
	size_t isz;
	uint32_t i, ipd;
	symbol_t *sym;
	cons_t *c;
	value_t *pv;
	value_t func, v, e;

	n = 0;
	v = 0;
	USED(n);
	USED(v);
apply_cl_top:
	func = FL(stack)[FL(sp)-nargs-1];
	ip = cvalue_data(fn_bcode(func));
	assert(!ismanaged((uintptr_t)ip));
	i = FL(sp)+GET_INT32(ip);
	while(i >= FL(nstack))
		grow_stack();
	ip += 4;

	bp = FL(sp)-nargs;
	PUSH(fn_env(func));
	PUSH(FL(curr_frame));
	PUSH(nargs);
	ipd = FL(sp);
	FL(sp)++; // ip
	FL(curr_frame) = FL(sp);

#if defined(COMPUTED_GOTO)
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wpedantic"
#define OP(x) op_##x:
#define NEXT_OP goto *ops[*ip++]
#define GOTO_OP_OFFSET(op) [op] = &&op_##op
	static const void *ops[] = {
		GOTO_OP_OFFSET(OP_LOADA0),
		GOTO_OP_OFFSET(OP_LOADA1),
		GOTO_OP_OFFSET(OP_LOADV),
		GOTO_OP_OFFSET(OP_BRF),
		GOTO_OP_OFFSET(OP_POP),
		GOTO_OP_OFFSET(OP_CALL),
		GOTO_OP_OFFSET(OP_TCALL),
		GOTO_OP_OFFSET(OP_LOADG),
		GOTO_OP_OFFSET(OP_LOADA),
		GOTO_OP_OFFSET(OP_LOADC),
		GOTO_OP_OFFSET(OP_RET),
		GOTO_OP_OFFSET(OP_DUP),
		GOTO_OP_OFFSET(OP_CAR),
		GOTO_OP_OFFSET(OP_CDR),
		GOTO_OP_OFFSET(OP_CLOSURE),
		GOTO_OP_OFFSET(OP_SETA),
		GOTO_OP_OFFSET(OP_JMP),
		GOTO_OP_OFFSET(OP_LOADC0),
		GOTO_OP_OFFSET(OP_PAIRP),
		GOTO_OP_OFFSET(OP_BRNE),
		GOTO_OP_OFFSET(OP_LOADT),
		GOTO_OP_OFFSET(OP_LOAD0),
		GOTO_OP_OFFSET(OP_LOADC1),
		GOTO_OP_OFFSET(OP_AREF),
		GOTO_OP_OFFSET(OP_ATOMP),
		GOTO_OP_OFFSET(OP_BRT),
		GOTO_OP_OFFSET(OP_BRNN),
		GOTO_OP_OFFSET(OP_LOAD1),
		GOTO_OP_OFFSET(OP_LT),
		GOTO_OP_OFFSET(OP_ADD2),
		GOTO_OP_OFFSET(OP_SETCDR),
		GOTO_OP_OFFSET(OP_LOADF),
		GOTO_OP_OFFSET(OP_CONS),
		GOTO_OP_OFFSET(OP_EQ),
		GOTO_OP_OFFSET(OP_SYMBOLP),
		GOTO_OP_OFFSET(OP_NOT),
		GOTO_OP_OFFSET(OP_CADR),
		GOTO_OP_OFFSET(OP_NEG),
		GOTO_OP_OFFSET(OP_NULLP),
		GOTO_OP_OFFSET(OP_BOOLEANP),
		GOTO_OP_OFFSET(OP_NUMBERP),
		GOTO_OP_OFFSET(OP_FIXNUMP),
		GOTO_OP_OFFSET(OP_BOUNDP),
		GOTO_OP_OFFSET(OP_BUILTINP),
		GOTO_OP_OFFSET(OP_FUNCTIONP),
		GOTO_OP_OFFSET(OP_VECTORP),
		GOTO_OP_OFFSET(OP_SETCAR),
		GOTO_OP_OFFSET(OP_JMPL),
		GOTO_OP_OFFSET(OP_BRFL),
		GOTO_OP_OFFSET(OP_BRTL),
		GOTO_OP_OFFSET(OP_EQV),
		GOTO_OP_OFFSET(OP_EQUAL),
		GOTO_OP_OFFSET(OP_LIST),
		GOTO_OP_OFFSET(OP_APPLY),
		GOTO_OP_OFFSET(OP_ADD),
		GOTO_OP_OFFSET(OP_SUB),
		GOTO_OP_OFFSET(OP_MUL),
		GOTO_OP_OFFSET(OP_DIV),
		GOTO_OP_OFFSET(OP_IDIV),
		GOTO_OP_OFFSET(OP_NUMEQ),
		GOTO_OP_OFFSET(OP_COMPARE),
		GOTO_OP_OFFSET(OP_ARGC),
		GOTO_OP_OFFSET(OP_VECTOR),
		GOTO_OP_OFFSET(OP_ASET),
		GOTO_OP_OFFSET(OP_LOADNIL),
		GOTO_OP_OFFSET(OP_LOADI8),
		GOTO_OP_OFFSET(OP_LOADVL),
		GOTO_OP_OFFSET(OP_LOADGL),
		GOTO_OP_OFFSET(OP_LOADAL),
		GOTO_OP_OFFSET(OP_LOADCL),
		GOTO_OP_OFFSET(OP_SETG),
		GOTO_OP_OFFSET(OP_SETGL),
		GOTO_OP_OFFSET(OP_SETAL),
		GOTO_OP_OFFSET(OP_VARGC),
		GOTO_OP_OFFSET(OP_TRYCATCH),
		GOTO_OP_OFFSET(OP_FOR),
		GOTO_OP_OFFSET(OP_TAPPLY),
		GOTO_OP_OFFSET(OP_SUB2),
		GOTO_OP_OFFSET(OP_LARGC),
		GOTO_OP_OFFSET(OP_LVARGC),
		GOTO_OP_OFFSET(OP_CALLL),
		GOTO_OP_OFFSET(OP_TCALLL),
		GOTO_OP_OFFSET(OP_BRNEL),
		GOTO_OP_OFFSET(OP_BRNNL),
		GOTO_OP_OFFSET(OP_BRN),
		GOTO_OP_OFFSET(OP_BRNL),
		GOTO_OP_OFFSET(OP_OPTARGS),
		GOTO_OP_OFFSET(OP_BRBOUND),
		GOTO_OP_OFFSET(OP_KEYARGS),
		GOTO_OP_OFFSET(OP_BOX),
		GOTO_OP_OFFSET(OP_BOXL),
		GOTO_OP_OFFSET(OP_SHIFT),
	};
	NEXT_OP;
#else
#define OP(x) case x:
#define NEXT_OP break
	uint8_t op = *ip++;
	while(1){
		switch(op){
#endif
		OP(OP_LOADA0)
			PUSH(FL(stack)[bp]);
			NEXT_OP;

		OP(OP_LOADA1)
			PUSH(FL(stack)[bp+1]);
			NEXT_OP;

		OP(OP_LOADV)
			v = fn_vals(FL(stack)[bp-1]);
			assert(*ip < vector_size(v));
			PUSH(vector_elt(v, *ip++));
			NEXT_OP;

		OP(OP_BRF)
			ip += POP() != FL(f) ? 2 : GET_INT16(ip);
			NEXT_OP;

		OP(OP_POP)
			POPN(1);
			NEXT_OP;

		OP(OP_TCALLL)
			tail = 1;
			if(0){
		OP(OP_CALLL)
				tail = 0;
			}
			n = GET_INT32(ip);
			ip += 4;
			if(0){
		OP(OP_TCALL)
				tail = 1;
				if(0){
		OP(OP_CALL)
					tail = 0;
				}
				n = *ip++;  // nargs
			}
		do_call:
			FL(stack)[ipd] = (uintptr_t)ip;
			func = FL(stack)[FL(sp)-n-1];
			if(tag(func) == TAG_FUNCTION){
				if(func > (N_BUILTINS<<3)){
					if(tail){
						FL(curr_frame) = FL(stack)[FL(curr_frame)-3];
						for(s = -1; s < (fixnum_t)n; s++)
							FL(stack)[bp+s] = FL(stack)[FL(sp)-n+s];
						FL(sp) = bp+n;
					}
					nargs = n;
					goto apply_cl_top;
				}else{
					i = uintval(func);
					if(isbuiltin(func)){
						s = builtins[i].nargs;
						if(s >= 0)
							argcount(n, (unsigned)s);
						else if(s != ANYARGS && (signed)n < -s)
							argcount(n, (unsigned)-s);
						// remove function arg
						for(s = FL(sp)-n-1; s < (int)FL(sp)-1; s++)
							FL(stack)[s] = FL(stack)[s+1];
						FL(sp)--;
						switch(i){
						case OP_LIST:   goto apply_list;
						case OP_VECTOR: goto apply_vector;
						case OP_APPLY:  goto apply_apply;
						case OP_ADD:	goto apply_add;
						case OP_SUB:	goto apply_sub;
						case OP_MUL:	goto apply_mul;
						case OP_DIV:	goto apply_div;
						default:
#if defined(COMPUTED_GOTO)
							goto *ops[i];
#else
							op = i;
							continue;
#endif
						}
					}
				}
			}else if(__likely(iscbuiltin(func))){
				s = FL(sp);
				v = (((builtin_t*)ptr(func))[3])(&FL(stack)[FL(sp)-n], n);
				FL(sp) = s-n;
				FL(stack)[FL(sp)-1] = v;
				NEXT_OP;
			}
			type_error("function", func);

		OP(OP_LOADGL)
			v = fn_vals(FL(stack)[bp-1]);
			v = vector_elt(v, GET_INT32(ip));
			ip += 4;
			if(0){
		OP(OP_LOADG)
				v = fn_vals(FL(stack)[bp-1]);
				assert(*ip < vector_size(v));
				v = vector_elt(v, *ip);
				ip++;
			}
			assert(issymbol(v));
			sym = (symbol_t*)ptr(v);
			if(__unlikely(sym->binding == UNBOUND)){
				FL(stack)[ipd] = (uintptr_t)ip;
				unbound_error(v);
			}
			PUSH(sym->binding);
			NEXT_OP;

		OP(OP_LOADA)
			i = *ip++;
			v = FL(stack)[bp+i];
			PUSH(v);
			NEXT_OP;

		OP(OP_LOADC)
			i = *ip++;
			v = FL(stack)[bp+nargs];
			assert(isvector(v));
			assert(i < vector_size(v));
			PUSH(vector_elt(v, i));
			NEXT_OP;

		OP(OP_BOX)
			i = *ip++;
			v = mk_cons();
			car_(v) = FL(stack)[bp+i];
			cdr_(v) = FL(Nil);
			FL(stack)[bp+i] = v;
			NEXT_OP;

		OP(OP_BOXL)
			i = GET_INT32(ip); ip += 4;
			v = mk_cons();
			car_(v) = FL(stack)[bp+i];
			cdr_(v) = FL(Nil);
			FL(stack)[bp+i] = v;
			NEXT_OP;

		OP(OP_SHIFT)
			i = *ip++;
			FL(stack)[FL(sp)-1-i] = FL(stack)[FL(sp)-1];
			FL(sp) -= i;
			NEXT_OP;

		OP(OP_RET)
			v = POP();
			FL(sp) = FL(curr_frame);
			FL(curr_frame) = FL(stack)[FL(sp)-3];
			if(FL(curr_frame) == top_frame)
				return v;
			FL(sp) -= 4+nargs;
			ipd = FL(curr_frame)-1;
			ip = (uint8_t*)FL(stack)[ipd];
			nargs = FL(stack)[FL(curr_frame)-2];
			bp = FL(curr_frame) - 4 - nargs;
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_DUP)
			FL(stack)[FL(sp)] = FL(stack)[FL(sp)-1];
			FL(sp)++;
			NEXT_OP;

		OP(OP_CAR)
			v = FL(stack)[FL(sp)-1];
			if(__likely(iscons(v)))
				v = car_(v);
			else if(__unlikely(v != FL(Nil))){
				FL(stack)[ipd] = (uintptr_t)ip;
				type_error("cons", v);
			}
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_CDR)
			v = FL(stack)[FL(sp)-1];
			if(__likely(iscons(v)))
				v = cdr_(v);
			else if(__unlikely(v != FL(Nil))){
				FL(stack)[ipd] = (uintptr_t)ip;
				type_error("cons", v);
			}
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_CLOSURE)
			n = *ip++;
			assert(n > 0);
			pv = alloc_words(n + 1);
			v = tagptr(pv, TAG_VECTOR);
			i = 0;
			pv[i++] = fixnum(n);
			do{
				pv[i] = FL(stack)[FL(sp)-n + i-1];
				i++;
			}while(i <= n);
			POPN(n);
			PUSH(v);
			if(__unlikely((value_t*)FL(curheap) > (value_t*)FL(lim)-2))
				gc(0);
			pv = (value_t*)FL(curheap);
			FL(curheap) += 4*sizeof(value_t);
			e = FL(stack)[FL(sp)-2];  // closure to copy
			assert(isfunction(e));
			pv[0] = ((value_t*)ptr(e))[0];
			pv[1] = ((value_t*)ptr(e))[1];
			pv[2] = FL(stack)[FL(sp)-1];  // env
			pv[3] = ((value_t*)ptr(e))[3];
			POPN(1);
			FL(stack)[FL(sp)-1] = tagptr(pv, TAG_FUNCTION);
			NEXT_OP;

		OP(OP_SETA)
			assert(nargs > 0);
			v = FL(stack)[FL(sp)-1];
			i = *ip++;
			FL(stack)[bp+i] = v;
			NEXT_OP;

		OP(OP_JMP)
			ip += GET_INT16(ip);
			NEXT_OP;

		OP(OP_LOADC0)
			PUSH(vector_elt(FL(stack)[bp+nargs], 0));
			NEXT_OP;

		OP(OP_PAIRP)
			FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_BRNE)
			ip += FL(stack)[FL(sp)-2] != FL(stack)[FL(sp)-1] ? GET_INT16(ip) : 2;
			POPN(2);
			NEXT_OP;

		OP(OP_LOADT)
			PUSH(FL(t));
			NEXT_OP;

		OP(OP_LOAD0)
			PUSH(fixnum(0));
			NEXT_OP;

		OP(OP_LOADC1)
			PUSH(vector_elt(FL(stack)[bp+nargs], 1));
			NEXT_OP;

		OP(OP_AREF)
			FL(stack)[ipd] = (uintptr_t)ip;
			v = FL(stack)[FL(sp)-2];
			if(isvector(v)){
				e = FL(stack)[FL(sp)-1];
				isz = tosize(e);
				if(__unlikely(isz >= vector_size(v)))
					bounds_error(v, e);
				v = vector_elt(v, isz);
			}else if(__likely(isarray(v))){
				v = cvalue_array_aref(&FL(stack)[FL(sp)-2]);
			}else{
				type_error("sequence", v);
			}
			POPN(1);
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_ATOMP)
			FL(stack)[FL(sp)-1] = iscons(FL(stack)[FL(sp)-1]) ? FL(f) : FL(t);
			NEXT_OP;

		OP(OP_BRT)
			ip += POP() != FL(f) ? GET_INT16(ip) : 2;
			NEXT_OP;

		OP(OP_BRNN)
			ip += POP() != FL(Nil) ? GET_INT16(ip) : 2;
			NEXT_OP;

		OP(OP_LOAD1)
			PUSH(fixnum(1));
			NEXT_OP;

		OP(OP_LT)
			{
				value_t a = FL(stack)[FL(sp)-2], b = FL(stack)[FL(sp)-1];
				POPN(1);
				if(bothfixnums(a, b)){
					FL(stack)[FL(sp)-1] = (fixnum_t)a < (fixnum_t)b ? FL(t) : FL(f);
				}else{
					x = numeric_compare(a, b, false, false, false);
					if(x > 1)
						x = numval(fl_compare(a, b));
					FL(stack)[FL(sp)-1] = x < 0 ? FL(t) : FL(f);
				}
			}
			NEXT_OP;

		OP(OP_ADD2)
		do_add2:
			FL(stack)[ipd] = (uintptr_t)ip;
			if(0){
		OP(OP_SUB2)
		do_sub2:
				FL(stack)[ipd] = (uintptr_t)ip;
				FL(stack)[FL(sp)-1] = fl_neg(FL(stack)[FL(sp)-1]);
			}
			{
				fixnum_t a, b, c;
				a = FL(stack)[FL(sp)-2];
				b = FL(stack)[FL(sp)-1];
				if(bothfixnums(a, b) && !sadd_overflow(numval(a), numval(b), &c) && fits_fixnum(c)){
					v = fixnum(c);
				}else{
					v = fl_add_any(&FL(stack)[FL(sp)-2], 2);
				}
			}
			POPN(1);
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_SETCDR)
			v = FL(stack)[FL(sp)-2];
			if(__unlikely(!iscons(v))){
				FL(stack)[ipd] = (uintptr_t)ip;
				type_error("cons", v);
			}
			cdr_(v) = FL(stack)[FL(sp)-1];
			POPN(1);
			NEXT_OP;

		OP(OP_LOADF)
			PUSH(FL(f));
			NEXT_OP;

		OP(OP_CONS)
			if(FL(curheap) > FL(lim))
				gc(0);
			c = (cons_t*)FL(curheap);
			FL(curheap) += sizeof(cons_t);
			c->car = FL(stack)[FL(sp)-2];
			c->cdr = FL(stack)[FL(sp)-1];
			FL(stack)[FL(sp)-2] = tagptr(c, TAG_CONS);
			POPN(1);
			NEXT_OP;

		OP(OP_EQ)
			FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1] ? FL(t) : FL(f);
			POPN(1);
			NEXT_OP;

		OP(OP_SYMBOLP)
			FL(stack)[FL(sp)-1] = issymbol(FL(stack)[FL(sp)-1]) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_NOT)
			FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL(f) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_CADR)
			v = FL(stack)[FL(sp)-1];
			if(__likely(iscons(v))){
				v = cdr_(v);
				if(__likely(iscons(v)))
					v = car_(v);
				else
					goto cadr_nil;
			}else{
			cadr_nil:
				if(__unlikely(v != FL(Nil))){
					FL(stack)[ipd] = (uintptr_t)ip;
					type_error("cons", v);
				}
			}
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_NEG)
		do_neg:
			FL(stack)[ipd] = (uintptr_t)ip;
			FL(stack)[FL(sp)-1] = fl_neg(FL(stack)[FL(sp)-1]);
			NEXT_OP;

		OP(OP_NULLP)
			FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-1] == FL(Nil) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_BOOLEANP)
			v = FL(stack)[FL(sp)-1];
			FL(stack)[FL(sp)-1] = (v == FL(t) || v == FL(f)) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_NUMBERP)
			v = FL(stack)[FL(sp)-1];
			FL(stack)[FL(sp)-1] = fl_isnumber(v) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_FIXNUMP)
			FL(stack)[FL(sp)-1] = isfixnum(FL(stack)[FL(sp)-1]) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_BOUNDP)
			FL(stack)[ipd] = (uintptr_t)ip;
			sym = tosymbol(FL(stack)[FL(sp)-1]);
			FL(stack)[FL(sp)-1] = sym->binding == UNBOUND ? FL(f) : FL(t);
			NEXT_OP;

		OP(OP_BUILTINP)
			v = FL(stack)[FL(sp)-1];
			FL(stack)[FL(sp)-1] = (isbuiltin(v) || iscbuiltin(v)) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_FUNCTIONP)
			v = FL(stack)[FL(sp)-1];
			FL(stack)[FL(sp)-1] =
				((tag(v) == TAG_FUNCTION &&
				  (isbuiltin(v) || v>(N_BUILTINS<<3))) ||
				 iscbuiltin(v)) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_VECTORP)
			FL(stack)[FL(sp)-1] = isvector(FL(stack)[FL(sp)-1]) ? FL(t) : FL(f);
			NEXT_OP;

		OP(OP_JMPL)
			ip += GET_INT32(ip);
			NEXT_OP;

		OP(OP_BRFL)
			ip += POP() == FL(f) ? GET_INT32(ip) : 4;
			NEXT_OP;

		OP(OP_BRTL)
			ip += POP() != FL(f) ? GET_INT32(ip) : 4;
			NEXT_OP;

		OP(OP_BRNEL)
			ip += FL(stack)[FL(sp)-2] != FL(stack)[FL(sp)-1] ? GET_INT32(ip) : 4;
			POPN(2);
			NEXT_OP;

		OP(OP_BRNNL)
			ip += POP() != FL(Nil) ? GET_INT32(ip) : 4;
			NEXT_OP;

		OP(OP_BRN)
			ip += POP() == FL(Nil) ? GET_INT16(ip) : 2;
			NEXT_OP;

		OP(OP_BRNL)
			ip += POP() == FL(Nil) ? GET_INT32(ip) : 4;
			NEXT_OP;

		OP(OP_EQV)
			if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
				v = FL(t);
			else if(!leafp(FL(stack)[FL(sp)-2]) || !leafp(FL(stack)[FL(sp)-1]))
				v = FL(f);
			else
				v = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 1) == 0 ? FL(t) : FL(f);
			FL(stack)[FL(sp)-2] = v;
			POPN(1);
			NEXT_OP;

		OP(OP_EQUAL)
			if(FL(stack)[FL(sp)-2] == FL(stack)[FL(sp)-1])
				v = FL(t);
			else
				v = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 1) == 0 ? FL(t) : FL(f);
			FL(stack)[FL(sp)-2] = v;
			POPN(1);
			NEXT_OP;

		OP(OP_SETCAR)
			v = FL(stack)[FL(sp)-2];
			if(__unlikely(!iscons(v))){
				FL(stack)[ipd] = (uintptr_t)ip;
				type_error("cons", v);
			}
			car_(v) = FL(stack)[FL(sp)-1];
			POPN(1);
			NEXT_OP;

		OP(OP_LIST)
			n = *ip++;
		apply_list:
			if(n > 0){
				v = list(&FL(stack)[FL(sp)-n], n, 0);
				POPN(n);
				PUSH(v);
			}else{
				PUSH(FL(Nil));
			}
			NEXT_OP;

		OP(OP_TAPPLY)
			tail = 1;
			if(0){
		OP(OP_APPLY)
				tail = 0;
			}
			n = *ip++;
		apply_apply:
			v = POP();	 // arglist
			n = FL(sp)-(n-2);  // n-2 == # leading arguments not in the list
			while(iscons(v)){
				if(FL(sp) >= FL(nstack))
					grow_stack();
				PUSH(car_(v));
				v = cdr_(v);
			}
			n = FL(sp)-n;
			goto do_call;

		OP(OP_ADD)
			n = *ip++;
			if(n == 2)
				goto do_add2;
		apply_add:
			FL(stack)[ipd] = (uintptr_t)ip;
			v = fl_add_any(&FL(stack)[FL(sp)-n], n);
			POPN(n);
			PUSH(v);
			NEXT_OP;

		OP(OP_SUB)
			n = *ip++;
		apply_sub:
			if(n == 2)
				goto do_sub2;
			if(n == 1)
				goto do_neg;
			FL(stack)[ipd] = (uintptr_t)ip;
			i = FL(sp)-n;
			// we need to pass the full arglist on to fl_add_any
			// so it can handle rest args properly
			PUSH(FL(stack)[i]);
			FL(stack)[i] = fixnum(0);
			FL(stack)[i+1] = fl_neg(fl_add_any(&FL(stack)[i], n));
			FL(stack)[i] = POP();
			v = fl_add_any(&FL(stack)[i], 2);
			POPN(n);
			PUSH(v);
			NEXT_OP;

		OP(OP_MUL)
			n = *ip++;
		apply_mul:
			FL(stack)[ipd] = (uintptr_t)ip;
			v = fl_mul_any(&FL(stack)[FL(sp)-n], n);
			POPN(n);
			PUSH(v);
			NEXT_OP;

		OP(OP_DIV)
			n = *ip++;
		apply_div:
			FL(stack)[ipd] = (uintptr_t)ip;
			i = FL(sp)-n;
			if(n == 1){
				FL(stack)[FL(sp)-1] = fl_div2(fixnum(1), FL(stack)[i]);
			}else{
				if(n > 2){
					PUSH(FL(stack)[i]);
					FL(stack)[i] = fixnum(1);
					FL(stack)[i+1] = fl_mul_any(&FL(stack)[i], n);
					FL(stack)[i] = POP();
				}
				v = fl_div2(FL(stack)[i], FL(stack)[i+1]);
				POPN(n);
				PUSH(v);
			}
			NEXT_OP;

		OP(OP_IDIV)
			FL(stack)[ipd] = (uintptr_t)ip;
			v = FL(stack)[FL(sp)-2];
			e = FL(stack)[FL(sp)-1];
			if(bothfixnums(v, e)){
				if(e == 0)
					DivideByZeroError();
				v = fixnum(numval(v) / numval(e));
			}else{
				v = fl_idiv2(v, e);
			}
			POPN(1);
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_NUMEQ)
			v = FL(stack)[FL(sp)-2]; e = FL(stack)[FL(sp)-1];
			if(bothfixnums(v, e))
				v = v == e ? FL(t) : FL(f);
			else{
				FL(stack)[ipd] = (uintptr_t)ip;
				v = numeric_compare(v, e, true, false, true) == 0 ? FL(t) : FL(f);
			}
			POPN(1);
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_COMPARE)
			FL(stack)[FL(sp)-2] = compare_(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 0);
			POPN(1);
			NEXT_OP;

		OP(OP_ARGC)
			n = *ip++;
			if(0){
		OP(OP_LARGC)
				n = GET_INT32(ip);
				ip += 4;
			}
			FL(stack)[ipd] = (uintptr_t)ip;
			argcount(nargs, n);
			NEXT_OP;

		OP(OP_VECTOR)
			n = *ip++;
		apply_vector:
			v = alloc_vector(n, 0);
			if(n){
				memcpy(&vector_elt(v, 0), &FL(stack)[FL(sp)-n], n*sizeof(value_t));
				POPN(n);
			}
			PUSH(v);
			NEXT_OP;

		OP(OP_ASET)
			e = FL(stack)[FL(sp)-3];
			FL(stack)[ipd] = (uintptr_t)ip;
			if(isvector(e)){
				i = tofixnum(FL(stack)[FL(sp)-2]);
				if(__unlikely(i >= vector_size(e)))
					bounds_error(v, FL(stack)[FL(sp)-1]);
				vector_elt(e, i) = (v = FL(stack)[FL(sp)-1]);
			}else if(__likely(isarray(e))){
				v = cvalue_array_aset(&FL(stack)[FL(sp)-3]);
			}else{
				type_error("sequence", e);
			}
			POPN(2);
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_FOR)
			FL(stack)[ipd] = (uintptr_t)ip;
			s  = tofixnum(FL(stack)[FL(sp)-3]);
			hi = tofixnum(FL(stack)[FL(sp)-2]);
			v = FL(unspecified);
			FL(sp) += 2;
			n = FL(sp);
			for(; s <= hi; s++){
				FL(stack)[FL(sp)-2] = FL(stack)[FL(sp)-3];
				FL(stack)[FL(sp)-1] = fixnum(s);
				v = _applyn(1);
				FL(sp) = n;
			}
			POPN(4);
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_LOADNIL)
			PUSH(FL(Nil));
			NEXT_OP;

		OP(OP_LOADI8)
			s = (int8_t)*ip++;
			PUSH(fixnum(s));
			NEXT_OP;

		OP(OP_LOADVL)
			v = fn_vals(FL(stack)[bp-1]);
			v = vector_elt(v, GET_INT32(ip));
			ip += 4;
			PUSH(v);
			NEXT_OP;

		OP(OP_SETGL)
			v = fn_vals(FL(stack)[bp-1]);
			v = vector_elt(v, GET_INT32(ip));
			ip += 4;
			if(0){
		OP(OP_SETG)
				v = fn_vals(FL(stack)[bp-1]);
				assert(*ip < vector_size(v));
				v = vector_elt(v, *ip);
				ip++;
			}
			assert(issymbol(v));
			sym = (symbol_t*)ptr(v);
			v = FL(stack)[FL(sp)-1];
			if(!isconstant(sym))
				sym->binding = v;
			NEXT_OP;

		OP(OP_LOADAL)
			assert(nargs > 0);
			i = GET_INT32(ip);
			ip += 4;
			v = FL(stack)[bp+i];
			PUSH(v);
			NEXT_OP;

		OP(OP_SETAL)
			assert(nargs > 0);
			v = FL(stack)[FL(sp)-1];
			i = GET_INT32(ip);
			ip += 4;
			FL(stack)[bp+i] = v;
			NEXT_OP;

		OP(OP_LOADCL)
			i = GET_INT32(ip);
			ip += 4;
			v = FL(stack)[bp+nargs];
			PUSH(vector_elt(v, i));
			NEXT_OP;

		OP(OP_VARGC)
			i = *ip++;
			if(0){
		OP(OP_LVARGC)
				i = GET_INT32(ip);
				ip += 4;
			}
			s = (fixnum_t)nargs - (fixnum_t)i;
			if(s > 0){
				v = list(&FL(stack)[bp+i], s, 0);
				FL(stack)[bp+i] = v;
				if(s > 1){
					FL(stack)[bp+i+1] = FL(stack)[bp+nargs+0];
					FL(stack)[bp+i+2] = FL(stack)[bp+nargs+1];
					FL(stack)[bp+i+3] = i+1;
					FL(stack)[bp+i+4] = 0;
					FL(sp) =  bp+i+5;
					FL(curr_frame) = FL(sp);
				}
			}else if(__unlikely(s < 0)){
				FL(stack)[ipd] = (uintptr_t)ip;
				lerrorf(FL(ArgError), "too few arguments");
			}else{
				FL(sp)++;
				FL(stack)[FL(sp)-2] = i+1;
				FL(stack)[FL(sp)-3] = FL(stack)[FL(sp)-4];
				FL(stack)[FL(sp)-4] = FL(stack)[FL(sp)-5];
				FL(stack)[FL(sp)-5] = FL(Nil);
				FL(curr_frame) = FL(sp);
			}
			ipd = FL(sp)-1;
			nargs = i+1;
			NEXT_OP;

		OP(OP_TRYCATCH)
			FL(stack)[ipd] = (uintptr_t)ip;
			v = do_trycatch();
			POPN(1);
			FL(stack)[FL(sp)-1] = v;
			NEXT_OP;

		OP(OP_OPTARGS)
			i = GET_INT32(ip);
			ip += 4;
			n = GET_INT32(ip);
			ip += 4;
			if(__unlikely(nargs < i)){
				FL(stack)[ipd] = (uintptr_t)ip;
				lerrorf(FL(ArgError), "too few arguments");
			}
			if((int32_t)n > 0){
				if(__unlikely(nargs > n)){
					FL(stack)[ipd] = (uintptr_t)ip;
					lerrorf(FL(ArgError), "too many arguments");
				}
			}else
				n = -n;
			if(__likely(n > nargs)){
				n -= nargs;
				FL(sp) += n;
				FL(stack)[FL(sp)-1] = FL(stack)[FL(sp)-n-1];
				FL(stack)[FL(sp)-2] = nargs+n;
				FL(stack)[FL(sp)-3] = FL(stack)[FL(sp)-n-3];
				FL(stack)[FL(sp)-4] = FL(stack)[FL(sp)-n-4];
				FL(curr_frame) = FL(sp);
				ipd = FL(sp)-1;
				for(i = 0; i < n; i++)
					FL(stack)[bp+nargs+i] = UNBOUND;
				nargs += n;
			}
			NEXT_OP;

		OP(OP_BRBOUND)
			i = GET_INT32(ip);
			ip += 4;
			v = FL(stack)[bp+i];
			PUSH(v != UNBOUND ? FL(t) : FL(f));
			NEXT_OP;

		OP(OP_KEYARGS)
			v = fn_vals(FL(stack)[bp-1]);
			v = vector_elt(v, 0);
			i = GET_INT32(ip);
			ip += 4;
			n = GET_INT32(ip);
			ip += 4;
			s = GET_INT32(ip);
			ip += 4;
			FL(stack)[ipd] = (uintptr_t)ip;
			nargs = process_keys(v, i, n, labs(s)-(i+n), bp, nargs, s<0);
			ipd = FL(sp)-1;
			NEXT_OP;

#if defined(COMPUTED_GOTO)
#pragma GCC diagnostic pop
#else
		}
		op = *ip++;
	}
#endif
}

#define SWAP_INT32(a)
#define SWAP_INT16(a)
#include "maxstack.inc"

#if BYTE_ORDER == BIG_ENDIAN
#undef SWAP_INT32
#undef SWAP_INT16
#define SWAP_INT32(a) \
	do{ \
		uint8_t *x = (void*)a, y; \
		y = x[0]; x[0] = x[3]; x[3] = y; \
		y = x[1]; x[1] = x[2]; x[2] = y; \
	}while(0)
#define SWAP_INT16(a) \
	do{ \
		uint8_t *x = (void*)a, y; \
		y = x[0]; x[0] = x[1]; x[1] = y; \
	}while(0)
#define compute_maxstack compute_maxstack_swap
#include "maxstack.inc"
#undef compute_maxstack
#else
#endif

// top = top frame pointer to start at
static value_t
_stacktrace(uint32_t top)
{
	value_t lst = FL(Nil);

	fl_gc_handle(&lst);
	while(top > 0){
		const uint8_t *ip1 = (void*)FL(stack)[top-1];
		uint32_t sz = FL(stack)[top-2]+1;
		uint32_t bp = top-4-sz;
		value_t func = FL(stack)[bp];
		const uint8_t *ip0 = cvalue_data(fn_bcode(func));
		intptr_t ip = ip1 - ip0 - 1; /* -1: ip1 is *after* the one that was being executed */
		value_t v = alloc_vector(sz+1, 0);
		vector_elt(v, 0) = fixnum(ip);
		vector_elt(v, 1) = func;
		for(uint32_t i = 1; i < sz; i++){
			value_t si = FL(stack)[bp+i];
			// if there's an error evaluating argument defaults some slots
			// might be left set to UNBOUND (issue #22)
			vector_elt(v, i+1) = si == UNBOUND ? FL(unspecified) : si;
		}
		lst = fl_cons(v, lst);
		top = FL(stack)[top-3];
	}
	fl_free_gc_handles(1);
	return lst;
}

// builtins -------------------------------------------------------------------

BUILTIN("gc", gc)
{
	USED(args);
	argcount(nargs, 0);
	gc(0);
	return FL(t);
}

BUILTIN("function", function)
{
	if(nargs == 1 && issymbol(args[0]))
		return fn_builtin_builtin(args, nargs);
	if(nargs < 2 || nargs > 4)
		argcount(nargs, 2);
	if(__unlikely(!fl_isstring(args[0])))
		type_error("string", args[0]);
	if(__unlikely(!isvector(args[1])))
		type_error("vector", args[1]);
	cvalue_t *arr = (cvalue_t*)ptr(args[0]);
	cv_pin(arr);
	char *data = cv_data(arr);
	uint32_t ms;
	if((uint8_t)data[4] >= N_OPCODES){
		// read syntax, shifted 48 for compact text representation
		size_t i, sz = cv_len(arr);
		for(i = 0; i < sz; i++)
			data[i] -= 48;
#if BYTE_ORDER == BIG_ENDIAN
		ms = compute_maxstack((uint8_t*)data, cv_len(arr));
	}else{
		ms = compute_maxstack_swap((uint8_t*)data, cv_len(arr));
	}
#else
	}
	ms = compute_maxstack((uint8_t*)data, cv_len(arr));
#endif
	PUT_INT32(data, ms);
	function_t *fn = alloc_words(4);
	value_t fv = tagptr(fn, TAG_FUNCTION);
	fn->bcode = args[0];
	fn->vals = args[1];
	fn->env = FL(Nil);
	fn->name = FL(lambda);
	if(nargs > 2){
		if(issymbol(args[2])){
			fn->name = args[2];
			if(nargs > 3)
				fn->env = args[3];
		}else{
			fn->env = args[2];
			if(nargs > 3){
				if(__unlikely(!issymbol(args[3])))
					type_error("symbol", args[3]);
				fn->name = args[3];
			}
		}
		if(__unlikely(isgensym(fn->name)))
			lerrorf(FL(ArgError), "name should not be a gensym");
	}
	return fv;
}

BUILTIN("function:code", function_code)
{
	argcount(nargs, 1);
	value_t v = args[0];
	if(__unlikely(!isclosure(v)))
		type_error("function", v);
	return fn_bcode(v);
}

BUILTIN("function:vals", function_vals)
{
	argcount(nargs, 1);
	value_t v = args[0];
	if(__unlikely(!isclosure(v)))
		type_error("function", v);
	return fn_vals(v);
}

BUILTIN("function:env", function_env)
{
	argcount(nargs, 1);
	value_t v = args[0];
	if(__unlikely(!isclosure(v)))
		type_error("function", v);
	return fn_env(v);
}

BUILTIN("function:name", function_name)
{
	argcount(nargs, 1);
	value_t v = args[0];
	if(__unlikely(!isclosure(v)))
		type_error("function", v);
	return fn_name(v);
}

BUILTIN("copy-list", copy_list)
{
	argcount(nargs, 1);
	return copy_list(args[0]);
}

BUILTIN("append", append)
{
	value_t first = FL(Nil), lst, lastcons = FL(Nil);
	uint32_t i;
	if(nargs == 0)
		return FL(Nil);
	fl_gc_handle(&first);
	fl_gc_handle(&lastcons);
	for(i = 0; i < nargs; i++){
		lst = args[i];
		if(iscons(lst)){
			lst = copy_list(lst);
			if(first == FL(Nil))
				first = lst;
			else
				cdr_(lastcons) = lst;
			lastcons = tagptr((((cons_t*)FL(curheap))-1), TAG_CONS);
		}else if(lst != FL(Nil)){
			type_error("cons", lst);
		}
	}
	fl_free_gc_handles(2);
	return first;
}

BUILTIN("list*", liststar)
{
	if(nargs == 1)
		return args[0];
	if(nargs == 0)
		argcount(nargs, 1);
	return list(args, nargs, 1);
}

BUILTIN("stacktrace", stacktrace)
{
	USED(args);
	argcount(nargs, 0);
	return _stacktrace(FL(throwing_frame) ? FL(throwing_frame) : FL(curr_frame));
}

BUILTIN("map", map)
{
	if(__unlikely(nargs < 2))
		lerrorf(FL(ArgError), "too few arguments");
	if(!iscons(args[1]))
		return FL(Nil);
	value_t v;
	intptr_t first, last, argSP = args-FL(stack);
	assert(argSP >= 0 && argSP < FL(nstack));
	if(nargs == 2){
		if(FL(sp)+4 > FL(nstack))
			grow_stack();
		PUSH(FL(stack)[argSP]);
		PUSH(car_(FL(stack)[argSP+1]));
		v = _applyn(1);
		POPN(2);
		PUSH(v);
		v = mk_cons();
		car_(v) = POP(); cdr_(v) = FL(Nil);
		PUSH(v);
		PUSH(v);
		first = FL(sp)-2;
		last = FL(sp)-1;
		FL(stack)[argSP+1] = cdr_(FL(stack)[argSP+1]);
		while(iscons(FL(stack)[argSP+1])){
			PUSH(FL(stack)[argSP]);
			PUSH(car_(FL(stack)[argSP+1]));
			v = _applyn(1);
			POPN(2);
			PUSH(v);
			v = mk_cons();
			car_(v) = POP(); cdr_(v) = FL(Nil);
			cdr_(FL(stack)[last]) = v;
			FL(stack)[last] = v;
			FL(stack)[argSP+1] = cdr_(FL(stack)[argSP+1]);
		}
		POPN(2);
	}else{
		size_t i;
		while(FL(sp)+nargs+1 > FL(nstack))
			grow_stack();
		PUSH(FL(stack)[argSP]);
		for(i = 1; i < nargs; i++){
			PUSH(car(FL(stack)[argSP+i]));
			FL(stack)[argSP+i] = cdr_(FL(stack)[argSP+i]);
		}
		v = _applyn(nargs-1);
		POPN(nargs);
		PUSH(v);
		v = mk_cons();
		car_(v) = POP(); cdr_(v) = FL(Nil);
		PUSH(v);
		PUSH(v);
		first = FL(sp)-2;
		last = FL(sp)-1;
		while(iscons(FL(stack)[argSP+1])){
			PUSH(FL(stack)[argSP]);
			for(i = 1; i < nargs; i++){
				PUSH(car(FL(stack)[argSP+i]));
				FL(stack)[argSP+i] = cdr_(FL(stack)[argSP+i]);
			}
			v = _applyn(nargs-1);
			POPN(nargs);
			PUSH(v);
			v = mk_cons();
			car_(v) = POP(); cdr_(v) = FL(Nil);
			cdr_(FL(stack)[last]) = v;
			FL(stack)[last] = v;
		}
		POPN(2);
	}
	return FL(stack)[first];
}

BUILTIN("for-each", for_each)
{
    argcount(nargs, 2);
    intptr_t argSP = args-FL(stack);
    assert(argSP >= 0 && argSP < FL(nstack));
    if(FL(sp)+2 > FL(nstack))
        grow_stack();
    PUSH(FL(t));
    PUSH(FL(t));
    while(iscons(FL(stack)[argSP+1])){
        FL(stack)[FL(sp)-2] = FL(stack)[argSP];
        FL(stack)[FL(sp)-1] = car_(FL(stack)[argSP+1]);
        _applyn(1);
        FL(stack)[argSP+1] = cdr_(FL(stack)[argSP+1]);
    }
    POPN(2);
    return FL(t);
}

BUILTIN("sleep", fl_sleep)
{
	if(nargs > 1)
		argcount(nargs, 1);
	double s = nargs > 0 ? todouble(args[0]) : 0;
	sleep_ms(s * 1000.0);
	return FL(t);
}

BUILTIN("*vm-stats*", vm_stats)
{
	USED(args);
	argcount(nargs, 0);
	ios_printf(ios_stderr, "heap total     %10"PRIu32"\n", FL(heapsize));
	ios_printf(ios_stderr, "heap free      %10"PRIu32"\n", (uint32_t)(FL(lim)-FL(curheap)));
	ios_printf(ios_stderr, "heap used      %10"PRIu32"\n", (uint32_t)(FL(curheap)-FL(fromspace)));
	ios_printf(ios_stderr, "stack          %10"PRIu32"\n", FL(nstack)*sizeof(value_t));
	ios_printf(ios_stderr, "gc calls       %10"PRIu64"\n", (uint64_t)FL(gccalls));
	ios_printf(ios_stderr, "max finalizers %10"PRIu32"\n", (uint32_t)FL(maxfinalizers));
	ios_printf(ios_stderr, "opcodes        %10d\n", N_OPCODES);
	return FL(t);
}

static const builtinspec_t builtin_fns[] = {
#define BUILTIN_FN(l, c){l, fn_builtin_##c},
#include "builtin_fns.h"
#undef BUILTIN_FN
};

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

void
fl_init(size_t initial_heapsize)
{
	int i;

	fl = calloc(1, sizeof(*fl));
	FL(scr_width) = 80;

	FL(heapsize) = initial_heapsize;

	FL(fromspace) = MEM_ALLOC(FL(heapsize));
	FL(tospace)   = MEM_ALLOC(FL(heapsize));
	FL(curheap) = FL(fromspace);
	FL(lim) = FL(curheap)+FL(heapsize)-sizeof(cons_t);
	FL(consflags) = bitvector_new(FL(heapsize)/sizeof(cons_t), 1);
	htable_new(&FL(printconses), 32);
	comparehash_init();
	FL(nstack) = 4096;
	FL(stack) = MEM_ALLOC(FL(nstack)*sizeof(value_t));

	FL(Nil) = builtin(OP_THE_EMPTY_LIST);
	FL(t) = builtin(OP_BOOL_CONST_T);
	FL(f) = builtin(OP_BOOL_CONST_F);
	FL(eof) = builtin(OP_EOF_OBJECT);
	FL(lambda) = symbol("λ", false);
	FL(function) = symbol("function", false);
	FL(quote) = symbol("quote", false);
	FL(trycatch) = symbol("trycatch", false);
	FL(backquote) = symbol("quasiquote", false);
	FL(comma) = symbol("unquote", false);
	FL(commaat) = symbol("unquote-splicing", false);
	FL(commadot) = symbol("unquote-nsplicing", false);
	FL(IOError) = symbol("io-error", false);
	FL(ParseError) = symbol("parse-error", false);
	FL(TypeError) = symbol("type-error", false);
	FL(ArgError) = symbol("arg-error", false);
	FL(UnboundError) = symbol("unbound-error", false);
	FL(KeyError) = symbol("key-error", false);
	FL(MemoryError) = symbol("memory-error", false);
	FL(BoundsError) = symbol("bounds-error", false);
	FL(DivideError) = symbol("divide-error", false);
	FL(EnumerationError) = symbol("enumeration-error", false);
	FL(Error) = symbol("error", false);
	FL(pairsym) = symbol("pair", false);
	FL(symbolsym) = symbol("symbol", false);
	FL(fixnumsym) = symbol("fixnum", false);
	FL(vectorsym) = symbol("vector", false);
	FL(builtinsym) = symbol("builtin", false);
	FL(booleansym) = symbol("boolean", false);
	FL(nullsym) = symbol("null", false);
	FL(definesym) = symbol("define", false);
	FL(defmacrosym) = symbol("define-macro", false);
	FL(forsym) = symbol("for", false);
	FL(setqsym) = symbol("set!", false);
	FL(evalsym) = symbol("eval", false);
	FL(vu8sym) = symbol("vu8", false);
	FL(fnsym) = symbol("fn", false);
	FL(nulsym) = symbol("nul", false);
	FL(alarmsym) = symbol("alarm", false);
	FL(backspacesym) = symbol("backspace", false);
	FL(tabsym) = symbol("tab", false);
	FL(linefeedsym) = symbol("linefeed", false);
	FL(vtabsym) = symbol("vtab", false);
	FL(pagesym) = symbol("page", false);
	FL(returnsym) = symbol("return", false);
	FL(escsym) = symbol("esc", false);
	FL(spacesym) = symbol("space", false);
	FL(deletesym) = symbol("delete", false);
	FL(newlinesym) = symbol("newline", false);
	FL(tsym) = symbol("t", false);
	FL(Tsym) = symbol("T", false);
	FL(fsym) = symbol("f", false);
	FL(Fsym) = symbol("F", false);
	FL(builtins_table_sym) = symbol("*builtins*", false);
	set(FL(printprettysym) = symbol("*print-pretty*", false), FL(t));
	set(FL(printreadablysym) = symbol("*print-readably*", false), FL(t));
	set(FL(printwidthsym) = symbol("*print-width*", false), fixnum(FL(scr_width)));
	set(FL(printlengthsym) = symbol("*print-length*", false), FL(f));
	set(FL(printlevelsym) = symbol("*print-level*", false), FL(f));
	FL(lasterror) = FL(Nil);
	for(i = 0; i < nelem(builtins); i++){
		if(builtins[i].name)
			set(symbol(builtins[i].name, false), builtin(i));
	}
	set(symbol("eq", false), builtin(OP_EQ));
	set(symbol("procedure?", false), builtin(OP_FUNCTIONP));
	set(symbol("top-level-bound?", false), builtin(OP_BOUNDP));

	FL(the_empty_vector) = tagptr(alloc_words(1), TAG_VECTOR);
	vector_setsize(FL(the_empty_vector), 0);

	cvalues_init();

	set(symbol("*os-name*", false), cvalue_static_cstring(__os_name__));
	FL(memory_exception_value) = fl_list2(FL(MemoryError), cvalue_static_cstring("out of memory"));

	const builtinspec_t *b;
	for(i = 0, b = builtin_fns; i < nelem(builtin_fns); i++, b++)
		set(symbol(b->name, false), cbuiltin(b->name, b->fptr));

	table_init();
	iostream_init();
	fsixel_init();
}

// top level ------------------------------------------------------------------

value_t
fl_toplevel_eval(value_t expr)
{
	return fl_applyn(1, symbol_value(FL(evalsym)), expr);
}

int
fl_load_system_image(value_t sys_image_iostream)
{
	value_t e;
	uint32_t saveSP;
	symbol_t *sym;

	PUSH(sys_image_iostream);
	saveSP = FL(sp);
	FL_TRY{
		while(1){
			e = fl_read_sexpr(FL(stack)[FL(sp)-1]);
			if(ios_eof(value2c(ios_t*, FL(stack)[FL(sp)-1])))
				break;
			if(isfunction(e)){
				// stage 0 format: series of thunks
				PUSH(e);
				(void)_applyn(0);
				FL(sp) = saveSP;
			}else{
				// stage 1 format: list alternating symbol/value
				while(iscons(e)){
					sym = tosymbol(car_(e));
					e = cdr_(e);
					(void)tocons(e);
					sym->binding = car_(e);
					e = cdr_(e);
				}
				break;
			}
		}
	}
	FL_CATCH_NO_INC{
		ios_puts("fatal error during bootstrap:\n", ios_stderr);
		fl_print(ios_stderr, FL(lasterror));
		ios_putc('\n', ios_stderr);
		return 1;
	}
	ios_close(value2c(ios_t*, FL(stack)[FL(sp)-1]));
	POPN(1);
	return 0;
}