#pragma once #include "platform.h" typedef struct sl_builtin sl_builtin;typedef struct sl_cons sl_cons;typedef struct sl_cbuiltin sl_cbuiltin;typedef struct sl_cv sl_cv;typedef struct sl_cvtable sl_cvtable;typedef struct sl_fn sl_fn;typedef struct sl_sym sl_sym;typedef struct sl_type sl_type; typedef struct sl_proc sl_proc;typedef struct sl_vm sl_vm; typedef uintptr sl_v; typedef void (*sl_cvinitfn)(const sl_type *, sl_v, void *);typedef sl_v (*sl_builtinfn)(sl_v *, int); enum {	TAG_FIXNUM,	TAG_ESPECIAL,	TAG_FN,	TAG_VEC,	TAG_UNBOXED,	TAG_CVALUE,	TAG_SYM,	TAG_CONS, 	TAG_BITS = 3,	TAG_MASK = (1<<TAG_BITS)-1,	TAG_EXT_BITS = 8,	TAG_EXT_MASK = (1<<TAG_EXT_BITS)-1, 	/* those were set to 7 and 3 strategically on purpose */	TAG_NONLEAF_MASK = TAG_CONS & TAG_VEC,}; #define tag(v) ((v) & TAG_MASK)#define tagext(v) ((v) & TAG_EXT_MASK) #define isfixnum(v) (tag(v) == TAG_FIXNUM)#define isespecial(v) (tag(v) == TAG_ESPECIAL)#define isfn(v) (tag(v) == TAG_FN || iscbuiltin(v))#define isvec(v) (tag(v) == TAG_VEC)#define isunboxed(v) (tag(v) == TAG_UNBOXED)#define iscvalue(v) (tag(v) == TAG_CVALUE)#define issym(v) (tag(v) == TAG_SYM)#define iscons(v) (tag(v) == TAG_CONS) enum {	FLAG_CONST = 1<<0,	FLAG_KEYWORD = 1<<1,	FLAG_GENSYM = 1<<2,}; typedef enum {	T_S8, T_U8,	T_S16, T_U16,	T_S32, T_U32,	T_P32,	T_S64, T_U64,	T_P64,	T_UNBOXED_NUM,	T_BIG = T_UNBOXED_NUM, // always a cvalue	T_F32, T_F64, 	T_NONNUMERIC,}sl_numtype; #if defined(BITS64)typedef s64int sl_fx;#elsetypedef s32int sl_fx;#endif struct sl_cons {	sl_v car;	sl_v cdr;}sl_aligned(8); struct sl_sym {	const sl_type *type;	sl_v binding;	const char *name;	union {		u32int hash;		u32int id; // gensym	};	u8int flags;	u8int numtype;	u8int size;}sl_aligned(8); struct sl_builtin {	const char *name;	int nargs;}; #define fits_bits(x, b) (((x)>>(b-1)) == 0 || (~((x)>>(b-1))) == 0)#define fits_fixnum(x) fits_bits((x), FIXNUM_BITS) #define valid_numtype(v) ((v) < T_NONNUMERIC)#define ptr(typ, v) ((typ*)((uintptr)(v) & (~(uintptr)TAG_MASK)))#define tagptr(p, t) ((sl_v)(p) + t)#define fixnum(v) ((sl_v)(v)<<TAG_BITS)#define numval(v) ((sl_fx)(v)>>TAG_BITS)#define u32numval(v) ((u32int)(v)>>TAG_BITS)#define ubnumval(v) ((sl_fx)(v)>>TAG_EXT_BITS)#define builtin(v) tagptr(((sl_v)(v)<<TAG_BITS), TAG_FN)#define bothfixnums(x, y) (isfixnum(x) && isfixnum(y))#define isinlined(cv) ((cv)->data == cv_space(cv)) #define mk_rune(r) (((sl_v)(r))<<TAG_EXT_BITS | 0xfc)#define sl_isrune(v) (((v) & 0xff) == 0xfc)#define torune(v) ((v)>>8) // allocate n consecutive conses#define cons_reserve(n) tagptr(alloc_words((n)*2), TAG_CONS) #if defined(FWD_BIT)#define isforwarded(v) \	((*ptr(sl_v, (v)) & FWD_BIT) && !isfixnum(*ptr(sl_v, (v))) && !isunboxed(*ptr(sl_v, (v))))#define forwardloc(v) (*ptr(sl_v, (v)) ^ FWD_BIT)#define forward(v, to) do{ *ptr(sl_v, (v)) = (sl_v)(to) | FWD_BIT; }while(0)#else#define isforwarded(v) (ptr(sl_v, (v))[0] == sl_unbound)#define forwardloc(v) (ptr(sl_v, (v))[1])#define forward(v, to) \	do{ ptr(sl_v, (v))[0] = sl_unbound; ptr(sl_v, (v))[1] = (sl_v)(to); }while(0)#endif enum {	VEC_VEC,	VEC_STRUCT,	VEC_TYPE_MASK = 3,	VEC_GROWN = 1<<2,}; #define vec_elt(v, i) (ptr(sl_v, (v))[1+(i)])#define vec_size(v) numval(vec_elt((v), -1))#define vec_setsize(v, n, type) do{ vec_elt((v), -1) = fixnum(n) | (type); }while(0)#define vec_type(v) (vec_elt((v), -1) & VEC_TYPE_MASK)#define isstruct(v) (vec_type(v) == VEC_STRUCT) // supplied and non-NIL#define nonnil(v) ((v) != sl_unbound && (v) != sl_nil) // functions ending in _ are unsafe, faster versions#define car_(v) (ptr(sl_cons, (v))->car)#define cdr_(v) (ptr(sl_cons, (v))->cdr)#define car(v) (tocons(v)->car)#define cdr(v) (tocons(v)->cdr) // 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) #define sym_value(s) (ptr(sl_sym, (s))->binding)#define sym_numtype(s) (ptr(sl_sym, (s))->numtype)#define set(s, v) (sym_value(s) = (v))#define setc(s, v) \	do{ \		sl_sym *sy = ptr(sl_sym, (s)); \		sy->flags |= FLAG_CONST; \		sy->binding = (v); \	}while(0)#define isconst(s) ((s)->flags & FLAG_CONST)#define ismanaged(v) (ptr(u8int, (v)) >= slvm.fromspace && ptr(u8int, (v)) < slvm.fromspace+slvm.heapsize)#define isgensym(v)  (issym(v) && (ptr(sl_sym, (v))->flags & FLAG_GENSYM))#define iskeysym(v)  (issym(v) && (ptr(sl_sym, (v))->flags & FLAG_KEYWORD))#define iscbuiltin(v) (iscvalue(v) && cvalue_class(v) == sl_builtintype)#define isfnbuiltin(v) ((sl_v)(v) < builtin(N_BUILTINS)) #define PUSH(v) do{ \	*sl.sp++ = (sl_v)(v); \}while(0) #define stack_for(n) do{ \	while(sl.sp+(n) >= sl.stackend) \		sl_stack_grow(0); \}while(0) #define PUSH_SAFE(v) do{ \	if(sl.sp >= sl.stackend) \		sl_stack_grow(0); \	PUSH(v); \}while(0) #if defined(NDEBUG)#define POPN(n) do{ sl.sp -= (n); }while(0)#define POP() (*(--sl.sp))#else#define POPN(n) do{ \	int __nn = (n); \	sl.sp -= __nn; \	for(int __i = 0; __i < __nn; __i++) \		sl.sp[__i] = sl_unbound; \}while(0)#define POP() (sl.sp[0] = sl_unbound, *(--sl.sp))#endif bool isbuiltin(sl_v v) sl_constfn sl_hotfn; /* memory */sl_v sl_relocate(sl_v v) sl_hotfn;void sl_gc(bool mustgrow);void sl_gc_handle(sl_v *pv) sl_nonnull(1);void sl_free_gc_handles(int n);void sl_stack_grow(int dummy); /* symbol table */sl_v mk_gensym(void);sl_v mk_sym(const char *str, bool copy) sl_hotfn sl_nonnull(1) sl_cstr(1);sl_v mk_csym_(const char *str, int len) sl_nonnull(1) sl_cstr(1) sl_rd(1, 2);#define mk_csym(str) mk_csym_(str, sizeof(str)-1)const char *sym_name(sl_v v) sl_returns_nonnull; /* read, eval, print main entry points */sl_v sl_toplevel_eval(sl_v expr);sl_v sl_apply(sl_v f, sl_v l);sl_v sl_applyn(int n, sl_v f, ...); /* object model manipulation */sl_v mk_cons(sl_v a, sl_v b);sl_v mk_list2(sl_v a, sl_v b);sl_v mk_listn(int n, ...);bool sl_isnum(sl_v v) sl_purefn;sl_v alloc_vec(usize n, bool init); /* consistent iswprint and wcwidth */int sl_iswprint(Rune c) sl_constfn;int sl_wcwidth(Rune c) sl_constfn;int sl_wcwidth_vs16(Rune c) sl_constfn; /* safe casts */sl_cons *tocons(sl_v v) sl_purefn sl_returns_nonnull;sl_sym *tosym(sl_v v) sl_purefn sl_returns_nonnull;sl_fx tofixnum(sl_v v) sl_purefn;char *tostr(sl_v v) sl_purefn sl_returns_nonnull;double todouble(sl_v a) sl_purefn; /* conses */sl_v alloc_cons(void) sl_hotfn;void *alloc_words(usize n) sl_hotfn sl_returns_nonnull sl_alloc; /* error handling */_Noreturn void sl_error(sl_v e, const char *format, ...) sl_printfmt(2, 3);_Noreturn void sl_raise(sl_v e);_Noreturn void sl_type_error(const char *what, const char *expected, sl_v got) sl_nonnull(2) sl_cstr(1) sl_cstr(2);_Noreturn void sl_bounds_error(sl_v arr, sl_v ind);_Noreturn void sl_const_error(sl_v sym);_Noreturn void sl_unbound_error(sl_v sym);_Noreturn void sl_arity_error(int nargs, int c, sl_v r);_Noreturn void sl_divide_by_0_error(void); #define bthrow(stmt) do{ sys_setcurrpc(0); sl_##stmt; }while(1)#define cthrow(stmt, a) do{ sys_setcallpc(a); sl_##stmt; }while(1) #define argcount(c) \	do{ \		if((c) == 0) \			USED(args); \		if(sl_unlikely(nargs != (c))) \			bthrow(arity_error(nargs, (c), sl_nil)); \	}while(0)#define argcount_least(c) \	do{ \		if(sl_unlikely(nargs < (c))) \			bthrow(arity_error(nargs, (c), sl_minsym)); \	}while(0)#define argcount_most(c) \	do{ \		if(sl_unlikely(nargs > (c))) \			bthrow(arity_error(nargs, (c), sl_maxsym)); \	}while(0)#define noargs() argcount(0) typedef struct ios ios; struct sl_cvtable {	void (*print)(sl_v self);	void (*relocate)(sl_v oldv, sl_v newv);	void (*finalize)(sl_v self); // always non-nil	void (*print_traverse)(sl_v self);	sl_v (*bounded_compare)(sl_v a, sl_v b, int bound, bool eq);}; struct sl_type {	sl_v type;	sl_cvtable *vtable;	const sl_type *eltype;  // for arrays	const sl_type *artype;  // (arr this)	sl_cvinitfn init;	usize size;	usize elsz;	sl_numtype numtype;}; // has to be same as sl_cv (almost)struct sl_cbuiltin {	const sl_type *type;	union {		void *data;		sl_builtinfn cbuiltin;	};	usize len;}; struct sl_cv {	const sl_type *type;	union {		void *data;		sl_builtinfn cbuiltin;	};	usize len; // length of *data in bytes	// inline data follows here	union {		u8int _space;		struct {			// only for non-inlined strings			u32int startbytes;			u32int startrune;		};	};}sl_aligned(8); struct sl_fn {	sl_v vals;	sl_v bcode;	sl_v env;	sl_v name;	usize maxstack;}sl_aligned(8); #define cv_class(cv) ((const sl_type*)((uintptr)(cv)->type&~(uintptr)TAG_MASK))#define cv_data(cv) ((cv)->data)#define cv_len(cv) ((cv)->len)#define cv_type(cv) (cv_class(cv)->type)#define cv_numtype(cv) (cv_class(cv)->numtype)#define cv_isstr(cv) (cv_class(cv)->eltype == sl_utf8type)#define cv_isPOD(cv) (cv_class(cv)->init != nil && cv_numtype(cv) != T_BIG)#define cv_space(cv) ((u8int*)(cv)+sl_offsetof(sl_cv, _space)) #define cvalue_data(v) cv_data(ptr(sl_cv, (v)))#define cvalue_len(v) cv_len(ptr(sl_cv, (v)))#define cvalue_numtype(v) cv_numtype(ptr(sl_cv, (v)))#define cvalue_class(v) cv_class(ptr(sl_cv, (v)))#define value2c(type, v) ((type)cvalue_data(v)) #define isbignum(v) (iscvalue(v) && cv_numtype(ptr(sl_cv, (v))) == T_BIG)#define tobignum(v) (*(mpint**)cvalue_data(v)) #include "opcodes.h" #define especial(x) (tagptr(((sl_v)x<<TAG_BITS), TAG_ESPECIAL))enum {	sl_unbound = especial(0),	sl_nil = especial(1),	sl_t = especial(2),	sl_void = especial(3),	sl_eof = especial(4),};#undef especial #if 0// FIXME(sigrid): stays disabled until it becomes usefulextern sl_thread(sl_proc *slp);extern sl_thread(sl_vm *slvmp);#elseextern sl_proc *slp;extern sl_vm *slvmp;#endif #define sl (*slp)#define slvm (*slvmp) extern sl_v sl_builtinssym, sl_quote, sl_lambda, sl_comma, sl_commaat;extern sl_v sl_commadot, sl_trycatch, sl_backquote;extern sl_v sl_conssym, sl_symsym, sl_fixnumsym, sl_vecsym, sl_vu8sym;extern sl_v sl_defsym, sl_defmacrosym, sl_forsym, sl_setqsym, sl_listsym;extern sl_v sl_boolsym, sl_nullsym, sl_evalsym, sl_fnsym, sl_trimsym, sl_strsym;extern sl_v sl_errio, sl_errparse, sl_errtype, sl_errarg, sl_errmem, sl_errconst;extern sl_v sl_errdiv0, sl_errbounds, sl_err, sl_errkey, sl_errunbound, sl_erroom;extern sl_v sl_emptyvec, sl_emptystr; extern sl_v sl_tablesym, sl_arrsym;extern sl_v sl_s8sym, sl_u8sym, sl_s16sym, sl_u16sym, sl_s32sym, sl_u32sym;extern sl_v sl_s64sym, sl_u64sym, sl_p32sym, sl_p64sym, sl_ptrsym, sl_bignumsym;extern sl_v sl_utf8sym, sl_runesym, sl_f32sym, sl_f64sym, sl_vecstructsym, sl_structsym;extern sl_v sl_minsym, sl_maxsym, sl_extrasym; extern const sl_type *sl_bignumtype, *sl_builtintype;extern const sl_type *sl_s8type, *sl_u8type;extern const sl_type *sl_s16type, *sl_u16type;extern const sl_type *sl_s32type, *sl_u32type;extern const sl_type *sl_s64type, *sl_u64type;extern const sl_type *sl_p32type, *sl_p64type;extern const sl_type *sl_f32type, *sl_f64type;extern const sl_type *sl_utf8type, *sl_runetype;extern const sl_type *sl_strtype, *sl_runestrtype;