#pragma once #include "platform.h"#include "utf8.h"#include "ios.h"#include "tbl.h"#include "bitvector.h"#include "htable_h.h"HTPROT(ptrhash) typedef struct sl_exctx sl_exctx;typedef struct sl_builtin sl_builtin;typedef struct sl_cons sl_cons;typedef struct sl_cv sl_cv;typedef struct sl_cvtable sl_cvtable;typedef struct sl_fn sl_fn;typedef struct sl_gensym sl_gensym;typedef struct sl_readstate sl_readstate;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)(sl_type *, sl_v, void *);typedef sl_v (*sl_builtinfn)(sl_v *, int); enum {	TAG_FIXNUM,	TAG_SPECIAL,	TAG_FN,	TAG_VEC,	TAG_UNBOXED,	TAG_CVALUE,	TAG_SYM,	TAG_CONS, 	TAG_BITS = 3,	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,}; enum {	FLAG_CONST = 1<<0,	FLAG_KEYWORD = 1<<1,}; 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_F32, T_F64, 	// always a cvalue	T_BIG = T_UNBOXED_NUM,}sl_numtype; #define is_nt_sint(nt) ((1<<(nt)) & (1<<T_S8 | 1<<T_S16 | 1<<T_S32 | 1<<T_S64))#define is_nt_uint(nt) ((1<<(nt)) & (1<<T_U8 | 1<<T_U16 | 1<<T_U32 | 1<<T_U64 | 1<<T_P32 | 1<<T_P64)) #if defined(BITS64)typedef s64int sl_fx;#define FIXNUM_BITS (64-TAG_BITS)#define UNBOXED_BITS (64-TAG_EXT_BITS)#define TOP_BIT (1ULL<<63)#define T_FIXNUM T_S64#define PRIdFIXNUM PRId64#elsetypedef s32int sl_fx;#define FIXNUM_BITS (32-TAG_BITS)#define UNBOXED_BITS (32-TAG_EXT_BITS)#define TOP_BIT (1U<<31)#define T_FIXNUM T_S32#define PRIdFIXNUM PRId32#endif #define FIXNUM_MAX (sl_fx)(+((sl_v)1<<(FIXNUM_BITS-1))-1)#define FIXNUM_MIN (sl_fx)(-((sl_v)1<<(FIXNUM_BITS-1))-0) struct sl_cons {	sl_v car;	sl_v cdr;}sl_aligned(8); // NOTE: sl_sym MUST have the same fields as sl_gensym first// there are places where gensyms are treated as normal symbolsstruct sl_sym {	sl_type *type;	sl_v binding;   // global value binding	const char *name;	u32int hash;	u8int numtype;	u8int size;	u8int flags;	u8int _dummy;}sl_aligned(8); struct sl_gensym {	sl_type *type;	sl_v binding;	const char *name;	u32int id;}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 ANYARGS -10000#define NONNUMERIC (0xff)#define valid_numtype(v) ((v) <= T_F64)#define tag(x) ((x) & 7)#define tagext(x) ((x) & 0xff)#define ptr(x) ((void*)((uintptr)(x) & (~(uintptr)7)))#define tagptr(p, t) ((sl_v)(p) | (t))#define fixnum(x) ((sl_v)(x)<<TAG_BITS)#define numval(x) ((sl_fx)(x)>>TAG_BITS)#define ubnumval(x) ((sl_fx)(x)>>(TAG_BITS+1+4))#define uintval(x) (((unsigned int)(x))>>TAG_BITS)#define builtin(n) tagptr(((sl_v)n<<TAG_BITS), TAG_FN)#define special(x) (tagptr(((sl_v)x<<TAG_BITS), TAG_SPECIAL))#define iscons(x) (tag(x) == TAG_CONS)#define issym(x) (tag(x) == TAG_SYM)#define isfixnum(x) (tag(x) == TAG_FIXNUM)#define bothfixnums(x, y) (isfixnum(x) && isfixnum(y))#define isvec(x) (tag(x) == TAG_VEC)#define iscvalue(x) (tag(x) == TAG_CVALUE)#define isunboxed(x) (tag(x) == TAG_UNBOXED)#define isspecial(x) (tag(x) == TAG_SPECIAL)#define isinlined(cv) ((cv)->data == (cv)->_space)// doesn't lead to other values#define leafp(a) (((a)&TAG_NONLEAF_MASK) != TAG_NONLEAF_MASK) /* UNBOXED * integers: ...|xxxxxxxx|xxxxxxxx|xxxxxxxx|tttt0100| * runes:    ...|xxxxxxxx|xxxxxxxx|xxxxxxxx|11111100| */#define TAG_UBNUM_SHIFT (TAG_BITS+1)#define isubnum(x)  ((tagext(x) & ((1<<TAG_UBNUM_SHIFT)-1)) == (0<<TAG_BITS | TAG_UNBOXED))#define ubnumtype(x) ((tagext(x)>>TAG_UBNUM_SHIFT) & 0xf)#if BYTE_ORDER == LITTLE_ENDIAN#define ubnumptr(v, nt) ((u8int*)&(v))#else#define ubnumptr(v, nt) ((u8int*)&(v)+sizeof(v)-unboxedtypes[nt]->size)#endifextern sl_type *unboxedtypes[T_UNBOXED_NUM];extern sl_v unboxedtypesyms[T_UNBOXED_NUM]; #define mk_rune(r) (((sl_v)(r))<<TAG_EXT_BITS | 0xfc)#define 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)#define cons_index(c) (((sl_cons*)ptr(c))-((sl_cons*)slvm.fromspace))#define ismarked(c) bitvector_get(sl.consflags, cons_index(c))#define mark_cons(c) bitvector_set(sl.consflags, cons_index(c))#define unmark_cons(c) bitvector_reset(sl.consflags, cons_index(c)) #define isforwarded(v) (((sl_v*)ptr(v))[0] == sl_unbound)#define forwardloc(v) (((sl_v*)ptr(v))[1])#define forward(v, to) \	do{ \		((sl_v*)ptr(v))[0] = sl_unbound; \		((sl_v*)ptr(v))[1] = (sl_v)(to); \	}while(0) enum {	VEC_VEC,	VEC_STRUCT,	VEC_TYPE_MASK = 3,	VEC_GROWN = 1<<2,};#define vec_elt(v, i) (((sl_v*)ptr(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)#define vec_grow_amt(x) ((x)<8 ? 5 : 6*((x)>>3)) // functions ending in _ are unsafe, faster versions#define car_(v) (((sl_cons*)ptr(v))->car)#define cdr_(v) (((sl_cons*)ptr(v))->cdr)#define car(v) (tocons(v)->car)#define cdr(v) (tocons(v)->cdr)#define fn_bcode(f) (((sl_fn*)ptr(f))->bcode)#define fn_vals(f) (((sl_fn*)ptr(f))->vals)#define fn_env(f) (((sl_fn*)ptr(f))->env)#define fn_name(f) (((sl_fn*)ptr(f))->name)#define fn_maxstack(f) (((sl_fn*)ptr(f))->maxstack)#define set(s, v) (((sl_sym*)ptr(s))->binding = (v))#define setc(s, v) \	do{ \		sl_sym *sy = (sl_sym*)ptr(s); \		sy->flags |= FLAG_CONST; \		sy->binding = (v); \	}while(0)#define isconst(s) ((s)->flags & FLAG_CONST)#define iskeyword(s) ((s)->flags & FLAG_KEYWORD)#define sym_value(s) (((sl_sym*)ptr(s))->binding)#define sym_name_(s) (((sl_sym*)ptr(s))->name)#define sym_to_numtype(s) (((sl_sym*)ptr(s))->numtype)#define ismanaged(v) ((((u8int*)ptr(v)) >= slvm.fromspace) && (((u8int*)ptr(v)) < slvm.fromspace+slvm.heapsize))#define isgensym(v)  (issym(v) && ismanaged(v))#define iscbuiltin(v) (iscvalue(v) && cv_class(ptr(v)) == sl_builtintype)#define isfnbuiltin(v) ((v) < (N_BUILTINS<<TAG_BITS))#define isfn(v) (tag(v) == TAG_FN || iscbuiltin(v))// 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 PUSH(v) do{ \	*sl.sp++ = (sl_v)(v); \}while(0) #define stack_for(n) do{ \	while(sl.sp+(n) >= sl.stackend) \		sl_stack_grow(); \}while(0) #define PUSH_SAFE(v) do{ \	if(sl.sp >= sl.stackend) \		sl_stack_grow(); \	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 x) sl_constfn sl_hotfn;int sl_init(usize heapsize);int sl_load_system_image(sl_v ios); _Noreturn void sl_exit(const char *status); /* 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(void); /* symbol table */sl_v mk_gensym(void);sl_v mk_sym(const char *str, bool copy) sl_hotfn sl_nonnull(1);sl_v mk_csym_(const char *str, int len) sl_nonnull(1);#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 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; /* 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; char *uint2str(char *dest, usize len, u64int num, int base) sl_nonnull(1); /* error handling */struct sl_readstate {	sl_htable backrefs;	sl_htable gensyms;	sl_v source;	ios_loc errloc;	struct sl_readstate *prev;}; struct sl_exctx {	sl_readstate *rdst;	struct sl_exctx *prev;	sl_jmp_buf buf;	usize osp;	usize frame;	int ngchnd;}; void free_readstate(sl_readstate *rs) sl_nonnull(1); #define SL_TRY_EXTERN \	sl_exctx _ctx; \	sl_savestate(&_ctx); \	sl.exctx = &_ctx; \	int l__ca; \	if(!sl_setjmp(_ctx.buf)) \		for(int l__tr = 1; l__tr; l__tr = 0, sl.exctx = sl.exctx->prev) #define SL_CATCH_EXTERN_NO_RESTORE \	else \		for(l__ca=1; l__ca;) #define SL_CATCH_EXTERN \	else \		for(l__ca=1; l__ca; l__ca=0, sl_restorestate(&_ctx)) _Noreturn void lerrorf(sl_v e, const char *format, ...) sl_printfmt(2, 3);void sl_savestate(sl_exctx *_ctx) sl_nonnull(1);void sl_restorestate(sl_exctx *_ctx) sl_nonnull(1);_Noreturn void sl_raise(sl_v e);_Noreturn void type_error(const char *what, const char *expected, sl_v got) sl_nonnull(2);_Noreturn void bounds_error(sl_v arr, sl_v ind);_Noreturn void const_error(sl_v sym);_Noreturn void unbound_error(sl_v sym);_Noreturn void arity_error(int nargs, int c); #define bthrow(stmt) do{ sys_setcurrpc(0); stmt; }while(1)#define cthrow(stmt, a) do{ sys_setcallpc(a); stmt; }while(1) #define argcount(nargs, c) \	do{ \		if(sl_unlikely(nargs != c)) \			bthrow(arity_error(nargs, c)); \		if(c == 0) \			USED(args); \	}while(0) struct sl_cvtable {	void (*print)(sl_v self, ios *f);	void (*relocate)(sl_v oldv, sl_v newv);	void (*finalize)(sl_v self);	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;	sl_type *eltype;  // for arrays	sl_type *artype;  // (arr this)	sl_cvinitfn init;	usize size;	usize elsz;	sl_numtype numtype;}; struct sl_cv {	sl_type *type;	union {		void *data;		sl_builtinfn cbuiltin;	};	usize len; // length of *data in bytes	union {		struct {			u32int startbytes;			u32int startrune;		};		u8int _space[1]; // variable size	};}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) ((sl_type*)(((uintptr)((sl_cv*)cv)->type)&~(uintptr)3))#define cv_len(cv) (((sl_cv*)(cv))->len)#define cv_type(cv) (cv_class(cv)->type)#define cv_data(cv) (((sl_cv*)(cv))->data)#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 cvalue_data(v) cv_data((sl_cv*)ptr(v))#define cvalue_len(v) cv_len((sl_cv*)ptr(v))#define value2c(type, v) ((type)cvalue_data(v))#define cv_numtype(cv) (cv_class(cv)->numtype) #define isbignum(v) (iscvalue(v) && cv_numtype(ptr(v)) == T_BIG)#define tobignum(v) (*(mpint**)cv_data(ptr(v))) #define BUILTIN(lname, cname) \	sl_v fn_builtin_##cname(sl_v *args, int nargs) #define BUILTIN_FN(l, c, attr) attr BUILTIN(l, c);#include "builtin_fns.h"#undef BUILTIN_FN #include "opcodes.h" enum {	sl_unbound = special(0),	sl_nil = special(1),	sl_t = special(2),	sl_void = special(3),	sl_eof = special(4),}; struct sl_proc {	sl_v *sp;	usize curr_frame; 	// saved execution state for an unwind target	sl_exctx *exctx;	usize throwing_frame;  // active frame when exception was thrown	sl_v lasterror; 	sl_readstate *readstate;	u32int *consflags;	sl_v *stack;	sl_v *stackend;	u32int nstack; 	sl_htable printconses;	u32int printlabel;	bool print_pretty;	bool print_princ;	bool print_circle;	bool print_radix;	bool print_ptr_radix;	sl_fx print_base;	sl_fx print_ptr_base;	sl_fx print_length;	sl_fx print_level;	sl_fx p_level;	int scr_width;	ssize hpos, vpos;	uintptr cpc;}; struct sl_vm {	u8int *curheap;	u8int *lim;	usize malloc_pressure;	sl_cv **finalizers;	usize nfinalizers;	usize maxfinalizers;	Tbl *symbols;	u32int gensym_ctr;	// two static buffers for gensym printing so there can be two	// gensym names available at a time, mostly for compare()	char gsname[2][16];	int gsnameno;	bool exiting;	bool grew;	int ngchandles;	int maxgchandles;	sl_v **gchandles;	usize gccalls;	sl_htable reverse_dlsym_lookup;	sl_htable types;	u8int *fromspace;	u8int *tospace;	uintptr heapsize; // bytes}; extern sl_thread(sl_proc *slp);#define sl (*slp) extern sl_vm slvm_;#define slvm (slvm_) extern sl_v sl_builtinssym, sl_quote, sl_lambda, sl_comma, sl_commaat;extern sl_v sl_commadot, sl_trycatch, sl_backquote;

Lines 1–500 of 525. Load more