#include "inc/priv.h"#include "inc/equal.h"#include "inc/cvalues.h"#include "inc/io.h" #define OP_ARGS \	int nargs, const u8int *ip, usize top_frame, usize obp, \	usize ipd, int n, bool tail #if __has_attribute(musttail)#define sl_musttail __attribute__((musttail))#else#define sl_musttail#endif #if __has_attribute(preserve_none)#define sl_preserve_less __attribute__((preserve_none))#elif __has_attribute(preserve_most)#define sl_preserve_less __attribute__((preserve_most))#else#define sl_preserve_less#endif #define CALL_OP(op) \	sl_musttail \	return op(nargs, ip, top_frame, obp, ipd, n, tail) #define MAKE_OP(name) \	sl_preserve_less \	static sl_v op_##name(OP_ARGS) typedef sl_v (*op_func)(OP_ARGS) sl_preserve_less; extern const op_func sl_ops[]; #define NEXT_OP do{ \	ip++; \	CALL_OP(sl_ops[ip[-1]]); \}while(0) #define ENTER do{ \	sl.stack[ipd] = (uintptr)ip; \}while(0) static sl_v op_CALL_(OP_ARGS) sl_preserve_less; MAKE_OP(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;} MAKE_OP(LT){	n = *ip++;	CALL_OP(op_LT_);} MAKE_OP(LIST_){	ENTER;	sl_v v = sl_list(sl.sp-n, n, false);	POPN(n);	PUSH(v);	NEXT_OP;} MAKE_OP(LIST){	n = *ip++;	CALL_OP(op_LIST_);} MAKE_OP(VEC_){	ENTER;	sl_v v;	if(sl.sp[-n] == sl_vecstructsym){		if(sl_unlikely(n < 2))			cthrow(arity_error(n, 2, sl_minsym), nargs);		v = alloc_vec(n-1, false);		vec_setsize(v, vec_size(v), VEC_STRUCT);		for(int i = 0; i < n-1; i++)			vec_elt(v, i) = sl.sp[-n+1+i];	}else{		v = alloc_vec(n, false);		for(int i = 0; i < n; i++)			vec_elt(v, i) = sl.sp[-n+i];	}	POPN(n);	PUSH(v);	NEXT_OP;} MAKE_OP(VEC){	n = *ip++;	CALL_OP(op_VEC_);} MAKE_OP(ADD_){	ENTER;	sl_v v = sl_add_any(sl.sp-n, n);	POPN(n);	PUSH(v);	NEXT_OP;} MAKE_OP(ADD){	n = *ip++;	CALL_OP(op_ADD_);} MAKE_OP(APPLY_){	sl_v v = POP(); // arglist	n -= 2; // n-2 == # leading arguments not in the list	if(v == sl_nil || iscons(v)){		while(iscons(v)){			n++;			PUSH_SAFE(car_(v));			v = cdr_(v);		}		if(sl_unlikely(v != sl_nil)){			ENTER;			cthrow(type_error("apply", "null", v), nargs);		}	}else if(isvec(v)){		usize s = vec_size(v);		stack_for(s);		memcpy(sl.sp, &vec_elt(v, 0), s*sizeof(sl_v));		sl.sp += s;		n += s;	}else{		ENTER;		cthrow(type_error("apply", "(or list vec)", v), nargs);	}	CALL_OP(op_CALL_);} MAKE_OP(TAPPLY){	n = *ip++;	tail = true;	CALL_OP(op_APPLY_);} MAKE_OP(APPLY){	n = *ip++;	tail = false;	CALL_OP(op_APPLY_);} MAKE_OP(SUB2){	sl_fx a, b, q;	sl_v v;	ENTER;	v = sl.sp[-1];	s64int i64;	b = isfixnum(v) ? fixnum_neg(v) : sl_neg(v);	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;} MAKE_OP(ADD2){	sl_fx a, b, q;	sl_v v;	ENTER;	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;} MAKE_OP(SUB_){	if(n == 2)		CALL_OP(op_SUB2);	assert(n != 1);	ENTER;	sl_v *p = sl.sp-n;	// we need to pass the full arglist on to sl_add_any	// so it can handle rest args properly	PUSH(*p);	*p = fixnum(0);	sl_v v = sl_add_any(p, n);	s64int i64;	p[1] = isfixnum(v) ? fixnum_neg(v) : sl_neg(v);	p[0] = POP();	v = sl_add_any(p, 2);	POPN(n);	PUSH(v);	NEXT_OP;} MAKE_OP(SUB){	n = *ip++;	CALL_OP(op_SUB_);} MAKE_OP(MUL_){	ENTER;	sl_v v = sl_mul_any(sl.sp-n, n);	POPN(n);	PUSH(v);	NEXT_OP;} MAKE_OP(MUL){	n = *ip++;	CALL_OP(op_MUL_);} MAKE_OP(DIV_){	ENTER;	sl_v *p = sl.sp-n;	if(sl_unlikely(n == 1)){		sl.sp[-1] = sl_div2(fixnum(1), *p);	}else{		if(sl_unlikely(n > 2)){			PUSH(*p);			*p = fixnum(1);			p[1] = sl_mul_any(p, n);			*p = POP();		}		sl_v v = sl_div2(p[0], p[1]);		POPN(n);		PUSH(v);	}	NEXT_OP;} MAKE_OP(DIV){	n = *ip++;	CALL_OP(op_DIV_);} MAKE_OP(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;} MAKE_OP(AREF){	n = 3 + *ip++;	CALL_OP(op_AREF_);} MAKE_OP(ASET__){	sl_v v = sl.sp[-3];	sl_v e = sl.sp[-2];	usize isz = tosize(e);	if(sl_likely(isvec(v))){		if(sl_unlikely(isz >= (usize)vec_size(v)))			cthrow(bounds_error(v, e), nargs);		vec_elt(v, isz) = (e = sl.sp[-1]);	}else if(iscons(v)){		for(sl_v v0 = v;; isz--){			if(isz == 0){				car_(v) = (e = sl.sp[-1]);				break;			}			v = cdr_(v);			if(sl_unlikely(!iscons(v)))				cthrow(bounds_error(v0, e), nargs);		}	}else if(isarr(v)){		e = cvalue_arr_aset(sl.sp-3);	}else if(isio(v)){		ios *s = toio(v, true, false, true);		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);		s->buf[isz] = tou32(sl.sp[-1]);		e = mk_u8(s->buf[isz]);	}else{		cthrow(type_error("aset!", "sequence", v), nargs);	}	POPN(n);	PUSH(e);	NEXT_OP;} MAKE_OP(ASET_){	sl_v v = sl.sp[-n];	for(int i = n-1; i >= 3; i--){		if(sl_unlikely(isarr(v))){			sl.sp[-i-1] = v;			v = cvalue_arr_aref(sl.sp-i-1);			continue;		}		sl_v e = sl.sp[-i];		sl_fx isz = tosize(e);		if(isvec(v)){			if(sl_unlikely(isz >= vec_size(v)))				cthrow(bounds_error(v, e), nargs);			v = vec_elt(v, isz);			continue;		}		if(sl_unlikely(!iscons(v)))			cthrow(type_error("aset!", "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);		}	}	sl.sp[-3] = v;	CALL_OP(op_ASET__);} MAKE_OP(ASET){	ENTER;	n = 3;	CALL_OP(op_ASET__);} MAKE_OP(NUMEQP_){	ENTER;	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(bothfixnums(a, b)){			if(a != b){				v = sl_nil;				break;			}		}else if(numeric_compare(a, b, true) != 0){			v = sl_nil;			break;		}	}	POPN(n);	PUSH(v);	NEXT_OP;} MAKE_OP(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{				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: CALL_OP(op_LT_);		case OP_LIST: CALL_OP(op_LIST_);		case OP_VEC: CALL_OP(op_VEC_);		case OP_ADD: CALL_OP(op_ADD_);		case OP_APPLY: CALL_OP(op_APPLY_);		case OP_SUB: CALL_OP(op_SUB_);		case OP_MUL: CALL_OP(op_MUL_);		case OP_DIV: CALL_OP(op_DIV_);		case OP_AREF: CALL_OP(op_AREF_);		case OP_ASET: CALL_OP(op_ASET_);		case OP_NUMEQP: CALL_OP(op_NUMEQP_);		default:			CALL_OP(sl_ops[i]);		}	}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);}

Lines 1–500 of 1213. Load more