#include "inc/priv.h"#include "inc/equal.h"#include "inc/cvalues.h"#include "inc/io.h" #define ENTER do{ \	sl.stack[ipd] = (uintptr)ip; \}while(0) sl_vsl_vm_apply_cl(int nargs){	usize obp, ipd, top_frame = sl.curr_frame;	const u8int *ip;	bool tail;	int n; 	goto apply_func; #if defined(COMPUTED_GOTO)#pragma GCC diagnostic push#pragma GCC diagnostic ignored "-Wpedantic"	static const void * const ops[] = {#define GOTO_OP_OFFSET(op) [op] = &&op_##op#include "vm_jmptbl.h"#undef GOTO_OP_OFFSET	};#define NEXT_OP do{ goto *ops[*ip++]; }while(0)#define LABEL(x) x#define OP(x) op_##x:#else /* just a usual (portable) switch/case */	u8int op;	while(1){		switch(op){#define NEXT_OP break#define LABEL(x) x#define OP(x) case x:#endif OP(OP_CALL) {	tail = false;	if(0){OP(OP_TCALL)		tail = true;	}	n = *ip++; // nargs	if(0){OP(OP_TCALLL)		tail = true;		if(0){OP(OP_CALLL)			tail = false;		}		n = GET_S32(ip);		ip += 4;	}LABEL(do_call):	ENTER;	sl_v v = sl.sp[-n-1];	if(tag(v) == TAG_FN){		if(sl_likely(!isfnbuiltin(v))){			nargs = n;			if(tail){				sl.curr_frame = sl.stack[sl.curr_frame-3];				for(sl_fx s = -1; s < (sl_fx)n; s++)					sl.stack[obp+s] = sl.sp[s-n];				sl.sp = &sl.stack[obp+n];			}else{LABEL(apply_func):				obp = sl.sp-sl.stack-nargs;			}			sl_fn *fn = ptr(sl_fn, sl.stack[obp-1]);			assert(ismanaged(fn));			stack_for(fn->maxstack);			ip = cvalue_data(fn->bcode);			assert(!ismanaged((uintptr)ip));			PUSH(fn->env);			PUSH(sl.curr_frame);			PUSH(nargs);			ipd = sl.sp++ - sl.stack;			sl.curr_frame = ipd + 1;			NEXT_OP;		}		assert(isbuiltin(v));		int i = u32numval(v), s = builtins[i].nargs;		if(n != s && s != ANYARGS && (s >= 0 || n < -s))			cthrow(arity_error(n, s, sl_nil), nargs);		// remove function arg		for(sl_v *p = sl.sp-n-1; p < sl.sp-1; p++)			p[0] = p[1];		POPN(1);		switch(i){		case OP_LT: goto LABEL(apply_lt);		case OP_LIST: goto LABEL(apply_list);		case OP_VEC: goto LABEL(apply_vec);		case OP_ADD: goto LABEL(apply_add);		case OP_APPLY: goto LABEL(apply_apply);		case OP_SUB: goto LABEL(apply_sub);		case OP_MUL: goto LABEL(apply_mul);		case OP_DIV: goto LABEL(apply_div);		case OP_AREF: goto LABEL(apply_aref);		case OP_ASET: goto LABEL(apply_aset);		case OP_NUMEQP: goto LABEL(apply_numeqp);		default:#if defined(COMPUTED_GOTO)			goto *ops[i];#else			op = i;			continue;#endif		}	}else if(iscbuiltin(v)){		sl_builtinfn f = ptr(sl_cv, v)->cbuiltin;		stack_for(4);		PUSH(sl_nil); // fn->env;		PUSH(sl.curr_frame);		PUSH(n);		PUSH(f); // ip		sl.curr_frame = sl.sp - sl.stack;		v = f(sl.sp-n-4, n);		sl.sp = sl.stack + sl.curr_frame;		sl.curr_frame = sl.sp[-3];		POPN(4+n);		sl.sp[-1] = v;		NEXT_OP;	}	cthrow(type_error(tail ? "tcall" : "call", "fn", v), nargs);} OP(OP_ARGC) {	int na = *ip++;	if(0){OP(OP_ARGCL)		na = GET_S32(ip);		ip += 4;	}	if(sl_unlikely(nargs != na)){		ENTER;		cthrow(arity_error(nargs, na, sl_nil), nargs);	}	NEXT_OP;} OP(OP_RET) {	sl_v v = POP();	sl.sp = sl.stack + sl.curr_frame;	sl.curr_frame = sl.sp[-3];	if(sl.curr_frame == top_frame)		return v;	POPN(4+nargs);	ipd = sl.curr_frame-1;	ip = (u8int*)sl.stack[ipd];	nargs = sl.stack[sl.curr_frame-2];	obp = sl.curr_frame-4-nargs;	sl.sp[-1] = v;	NEXT_OP;} OP(OP_LOAD1)	PUSH(fixnum(1));	NEXT_OP; OP(OP_LOADA)	PUSH(sl.stack[obp + *ip++]);	NEXT_OP; OP(OP_BRN)	ip += POP() == sl_nil ? GET_S16(ip) : 2;	NEXT_OP; OP(OP_LOADG) {	sl_v v = fn_vals(sl.stack[obp-1]);	assert(*ip < vec_size(v));	v = vec_elt(v, *ip);	ip++;	if(0){OP(OP_LOADGL)		v = fn_vals(sl.stack[obp-1]);		v = vec_elt(v, GET_S32(ip));		ip += 4;	}	assert(issym(v));	sl_sym *sym = ptr(sl_sym, v);	if(sl_unlikely(sym->binding == sl_unbound)){		ENTER;		cthrow(unbound_error(v), nargs);	}	PUSH(sym->binding);	NEXT_OP;} OP(OP_LT) {	n = *ip++;LABEL(apply_lt):;	int i = n;	sl_v a = sl.sp[-i], b, v;	for(v = sl_t; i > 1; a = b){		i--;		b = sl.sp[-i];		if(sl_likely(bothfixnums(a, b))){			if((sl_fx)a >= (sl_fx)b){				v = sl_nil;				break;			}		}else{			int x = numeric_compare(a, b, false);			if(x > 1)				x = numval(sl_compare(a, b, false));			if(sl_unlikely(x >= 0)){				v = sl_nil;				break;			}		}	}	POPN(n);	PUSH(v);	NEXT_OP;} OP(OP_LOADV) {	sl_v v = fn_vals(sl.stack[obp-1]);	assert(*ip < vec_size(v));	PUSH(vec_elt(v, *ip++));	assert(sl.sp < sl.stackend);	NEXT_OP;} OP(OP_ADD2) {	sl_fx a, b, q;	sl_v v;	ENTER;	if(0){OP(OP_SUB2)LABEL(do_sub2):		ENTER;		v = sl.sp[-1];		s64int i64;		b = isfixnum(v) ? fixnum_neg(v) : sl_neg(v);	}else{		b = sl.sp[-1];	}	a = sl.sp[-2];	if(sl_likely(bothfixnums(a, b) && !sadd_overflow(a, b, &q)))		v = q;	else{		sl.sp[-1] = b;		v = sl_add_any(sl.sp-2, 2);	}	POPN(1);	sl.sp[-1] = v;	NEXT_OP;} OP(OP_LOADI8)	PUSH(fixnum((s8int)*ip++));	NEXT_OP; OP(OP_POP)	POPN(1);	NEXT_OP; OP(OP_BRNN)	ip += POP() != sl_nil ? GET_S16(ip) : 2;	NEXT_OP; OP(OP_DUP)	sl.sp[0] = sl.sp[-1];	sl.sp++;	NEXT_OP; OP(OP_CAR) {	sl_v v = sl.sp[-1];	if(sl_likely(iscons(v)))		v = car_(v);	else if(sl_unlikely(v != sl_nil)){		ENTER;		cthrow(type_error("car", "cons", v), nargs);	}	sl.sp[-1] = v;	NEXT_OP;} OP(OP_CLOSURE) {	int x = *ip++;	assert(x > 0);	ENTER;	sl_v v = alloc_vec(x, false);	for(int i = 0; i < x; i++)		vec_elt(v, i) = sl.sp[-x+i];	POPN(x);	PUSH(v);	sl_fn *fn = (sl_fn*)alloc_words(sizeof(sl_fn)/sizeof(sl_v));	sl_v e = sl.sp[-2];  // closure to copy	assert(isfn(e));	fn->vals = fn_vals(e);	fn->bcode = fn_bcode(e);	fn->env = sl.sp[-1];	fn->name = fn_name(e);	fn->maxstack = fn_maxstack(e);	POPN(1);	sl.sp[-1] = tagptr(fn, TAG_FN);	NEXT_OP;} OP(OP_CONS) {	if(sl_unlikely((sl_v*)slvm.curheap > (sl_v*)slvm.lim))		sl_gc(false);	sl_cons *c = (sl_cons*)slvm.curheap;	slvm.curheap += sizeof(sl_cons);	c->car = sl.sp[-2];	c->cdr = sl.sp[-1];	sl.sp[-2] = tagptr(c, TAG_CONS);	POPN(1);	NEXT_OP;} OP(OP_BRNE)	ip += sl.sp[-2] != sl.sp[-1] ? GET_S16(ip) : 2;	POPN(2);	NEXT_OP; OP(OP_CDR) {	sl_v v = sl.sp[-1];	if(sl_likely(iscons(v)))		v = cdr_(v);	else if(sl_unlikely(v != sl_nil)){		ENTER;		cthrow(type_error("cdr", "cons", v), nargs);	}	sl.sp[-1] = v;	NEXT_OP;} OP(OP_NOT)	sl.sp[-1] = sl.sp[-1] == sl_nil ? sl_t : sl_nil;	NEXT_OP; OP(OP_SETA)	sl.stack[obp + *ip++] = sl.sp[-1];	NEXT_OP; OP(OP_VARGC) {	int i = *ip++;	if(0){OP(OP_VARGCL)		i = GET_S32(ip);		ip += 4;	}	sl_fx s = (sl_fx)nargs - (sl_fx)i;	ENTER;	if(s > 0){		sl_v v = sl_list(&sl.stack[obp+i], s, false);		sl.stack[obp+i] = v;		if(s > 1){			sl.stack[obp+i+1] = sl.stack[obp+nargs+0];			sl.stack[obp+i+2] = sl.stack[obp+nargs+1];			sl.stack[obp+i+3] = i+1;			sl.stack[obp+i+4] = 0;			sl.sp = sl.stack+obp+i+5;			sl.curr_frame = sl.sp - sl.stack;		}	}else if(sl_unlikely(s < 0)){		cthrow(arity_error(nargs, i, sl_minsym), nargs);	}else{		sl.sp++;		sl.sp[-2] = i+1;		sl.sp[-3] = sl.sp[-4];		sl.sp[-4] = sl.sp[-5];		sl.sp[-5] = sl_nil;		sl.curr_frame = sl.sp - sl.stack;	}	ipd = sl.curr_frame-1;	nargs = i+1;	NEXT_OP;} OP(OP_SHIFT) {	int i = *ip++;	sl.sp[-1-i] = sl.sp[-1];	POPN(i);	NEXT_OP;} OP(OP_SETCAR) {	sl_v v = sl.sp[-2];	if(sl_unlikely(!iscons(v))){		ENTER;		cthrow(type_error("set-car!", "cons", v), nargs);	}	car_(v) = sl.sp[-1];	POPN(1);	NEXT_OP;} OP(OP_BOX) {	int i = *ip++;	ENTER;	sl_v v = alloc_cons();	car_(v) = sl.stack[obp+i];	cdr_(v) = sl_nil;	sl.stack[obp+i] = v;	NEXT_OP;} OP(OP_JMP)	ip += GET_S16(ip);	NEXT_OP; OP(OP_ATOMP)	sl.sp[-1] = iscons(sl.sp[-1]) ? sl_nil : sl_t;	NEXT_OP; OP(OP_AREF2) {	ENTER;	n = 2;	if(0){OP(OP_AREF)	ENTER;	n = 3 + *ip++;	}LABEL(apply_aref):;	sl_v v = sl.sp[-n];	for(int i = n-1; i > 0; i--){		sl_v e = sl.sp[-i];		usize isz = tosize(e);		if(sl_unlikely(isarr(v))){			sl.sp[-i-1] = v;			v = cvalue_arr_aref(sl.sp-i-1);			continue;		}		if(isvec(v)){			if(sl_unlikely(isz >= (usize)vec_size(v)))				cthrow(bounds_error(v, e), nargs);			v = vec_elt(v, isz);			continue;		}		if(sl_unlikely(!iscons(v))){			if(isio(v)){				ios *s = toio(v, true, true, false);				if(sl_unlikely(s->bm != IOS_BUF_MEM))					cthrow(error(sl_errarg, "requires in-memory io"), nargs);				if(isz >= s->size)					cthrow(bounds_error(v, e), nargs);				v = mk_u8(s->buf[isz]);				continue;			}else				cthrow(type_error("aref", "sequence", v), nargs);		}		for(sl_v v0 = v;; isz--){			if(isz == 0){				v = car_(v);				break;			}			v = cdr_(v);			if(sl_unlikely(!iscons(v)))				cthrow(bounds_error(v0, e), nargs);		}	}	POPN(n);	PUSH(v);	NEXT_OP;} OP(OP_NANP) {	sl_v v = sl.sp[-1];	if(sl_likely(!iscvalue(v)))		v = sl_nil;	else{		sl_cv *p = ptr(sl_cv, v);		switch(cv_numtype(p)){		case T_F64:			v = isnan(*(double*)cv_data(p)) ? sl_t : sl_nil;			break;		case T_F32:			v = isnan(*(float*)cv_data(p)) ? sl_t : sl_nil;			break;		default:			v = sl_nil;			break;		}	}	sl.sp[-1] = v;	NEXT_OP;} OP(OP_LOAD0)	PUSH(fixnum(0));	NEXT_OP; OP(OP_SETCDR) {	sl_v v = sl.sp[-2];	if(sl_unlikely(!iscons(v))){		ENTER;		cthrow(type_error("set-cdr!", "cons", v), nargs);	}	cdr_(v) = sl.sp[-1];	POPN(1);	NEXT_OP;} 

Lines 1–500 of 998. Load more