shithub: sl

Info  •  Files  •  Log  •  Branches

apply_cl:

Make sure sl.sp is always up to date in circumstances where a throw
is possible. Define "SYNC" macro to update both IP and SP.

Fixes: https://todo.sr.ht/~ft/sl/61

--- a/src/vm.h

+++ b/src/vm.h

@@ -5,6 +5,8 @@

 		: (fits_fixnum(i64) ? fixnum(i64) : mk_bignum(vtomp(i64, nil))) \

 )

+#define SYNC do { *ipd = (uintptr)ip; sl.sp = sp; }while(0)

+

 OP(OP_LOADA0)

 	*sp++ = bp[0];

 	NEXT_OP;

@@ -27,7 +29,7 @@

 		ip += 4;

 	}

 LABEL(do_call):

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v v = sp[-n-1];

 	if(tag(v) == TAG_FN){

 		if(v > (N_BUILTINS<<3)){

@@ -55,13 +57,10 @@

 		if(!isbuiltin(v))

 			type_error("fn", v);

 		sl_fx s = builtins[i].nargs;

-		if(s >= 0){

-			sl.sp = sp;

+		if(s >= 0)

 			argcount(n, s);

-		}else if(s != ANYARGS && n < -s){

-			sl.sp = sp;

+		else if(s != ANYARGS && n < -s)

 			argcount(n, -s);

-		}

 		// remove function arg

 		for(sl_v *p = sp-n-1; p < sp-1; p++)

 			p[0] = p[1];

@@ -101,7 +100,6 @@

 		sp[-1] = v;

 		NEXT_OP;

 	}

-	sl.sp = sp;

 	type_error("fn", v);

 }

@@ -113,8 +111,7 @@

 		ip += 4;

 	}

 	if(sl_unlikely(nargs != na)){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		arity_error(nargs, na);

 	}

 	NEXT_OP;

@@ -167,8 +164,7 @@

 	assert(issym(v));

 	sl_sym *sym = ptr(v);

 	if(sl_unlikely(sym->binding == UNBOUND)){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		unbound_error(v);

 	}

 	*sp++ = sym->binding;

@@ -214,11 +210,11 @@

 	sl_fx a, b, q;

 	sl_v v;

 LABEL(do_add2):

-	*ipd = (uintptr)ip;

+	SYNC;

 	if(0){

 OP(OP_SUB2)

 LABEL(do_sub2):

-		*ipd = (uintptr)ip;

+		SYNC;

 		v = sp[-1];

 		s64int i64;

 		b = isfixnum(v) ? fixnum_neg(v) : sl_neg(v);

@@ -263,8 +259,7 @@

 	if(sl_likely(iscons(v)))

 		v = car_(v);

 	else if(sl_unlikely(v != sl_nil)){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		type_error("cons", v);

 	}

 	sp[-1] = v;

@@ -274,7 +269,7 @@

 OP(OP_CLOSURE) {

 	int x = *ip++;

 	assert(x > 0);

-	sl.sp = sp;

+	SYNC;

 	sl_v *pv = alloc_words(

 		1+x+

 #if !defined(BITS64)

@@ -304,7 +299,7 @@

 OP(OP_CONS) {

 	if(slg.curheap > slg.lim){

-		sl.sp = sp;

+		SYNC;

 		sl_gc(0);

 	}

 	sl_cons *c = (sl_cons*)slg.curheap;

@@ -326,8 +321,7 @@

 	if(sl_likely(iscons(v)))

 		v = cdr_(v);

 	else if(sl_unlikely(v != sl_nil)){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		type_error("cons", v);

 	}

 	sp[-1] = v;

@@ -366,8 +360,7 @@

 			sl.curr_frame = sp;

 		}

 	}else if(sl_unlikely(s < 0)){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		lerrorf(sl_errarg, "too few arguments");

 	}else{

 		sp++;

@@ -392,8 +385,7 @@

 OP(OP_SETCAR) {

 	sl_v v = sp[-2];

 	if(sl_unlikely(!iscons(v))){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		type_error("cons", v);

 	}

 	car_(v) = sp[-1];

@@ -407,7 +399,7 @@

 OP(OP_BOX) {

 	int i = *ip++;

-	sl.sp = sp;

+	SYNC;

 	sl_v v = alloc_cons();

 	car_(v) = bp[i];

 	cdr_(v) = sl_nil;

@@ -427,7 +419,7 @@

 	n = 2;

 	if(0){

 OP(OP_AREF)

-	*ipd = (uintptr)ip;

+	SYNC;

 	n = 3 + *ip++;

 	}

 LABEL(apply_aref):;

@@ -441,17 +433,13 @@

 			continue;

 		}

 		if(isvec(v)){

-			if(sl_unlikely(isz >= vec_size(v))){

-				sl.sp = sp;

+			if(sl_unlikely(isz >= vec_size(v)))

 				bounds_error(v, e);

-			}

 			v = vec_elt(v, isz);

 			continue;

 		}

-		if(!iscons(v)){

-			sl.sp = sp;

+		if(!iscons(v))

 			type_error("sequence", v);

-		}

 		for(sl_v v0 = v;; isz--){

 			if(isz == 0){

 				v = car_(v);

@@ -458,10 +446,8 @@

 				break;

 			}

 			v = cdr_(v);

-			if(sl_unlikely(!iscons(v))){

-				sl.sp = sp;

+			if(sl_unlikely(!iscons(v)))

 				bounds_error(v0, e);

-			}

 		}

 	}

 	sp -= n;

@@ -498,8 +484,7 @@

 OP(OP_SETCDR) {

 	sl_v v = sp[-2];

 	if(sl_unlikely(!iscons(v))){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		type_error("cons", v);

 	}

 	cdr_(v) = sp[-1];

@@ -512,7 +497,7 @@

 	NEXT_OP;

 OP(OP_ASET) {

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v v = sp[-3];

 	n = 3;

 	if(0){

@@ -527,17 +512,13 @@

 			sl_v e = sp[-i];

 			usize isz = tosize(e);

 			if(isvec(v)){

-				if(sl_unlikely(isz >= vec_size(v))){

-					sl.sp = sp;

+				if(sl_unlikely(isz >= vec_size(v)))

 					bounds_error(v, e);

-				}

 				v = vec_elt(v, isz);

 				continue;

 			}

-			if(sl_unlikely(!iscons(v))){

-				sl.sp = sp;

+			if(sl_unlikely(!iscons(v)))

 				type_error("sequence", v);

-			}

 			for(sl_v v0 = v;; isz--){

 				if(isz == 0){

 					v = car_(v);

@@ -544,10 +525,8 @@

 					break;

 				}

 				v = cdr_(v);

-				if(sl_unlikely(!iscons(v))){

-					sl.sp = sp;

+				if(sl_unlikely(!iscons(v)))

 					bounds_error(v0, e);

-				}

 			}

 		}

 		sp[-3] = v;

@@ -555,10 +534,8 @@

 	sl_v e = sp[-2];

 	usize isz = tosize(e);

 	if(isvec(v)){

-		if(sl_unlikely(isz >= vec_size(v))){

-			sl.sp = sp;

+		if(sl_unlikely(isz >= vec_size(v)))

 			bounds_error(v, e);

-		}

 		vec_elt(v, isz) = (e = sp[-1]);

 	}else if(iscons(v)){

 		for(sl_v v0 = v;; isz--){

@@ -567,15 +544,12 @@

 				break;

 			}

 			v = cdr_(v);

-			if(sl_unlikely(!iscons(v))){

-				sl.sp = sp;

+			if(sl_unlikely(!iscons(v)))

 				bounds_error(v0, e);

-			}

 		}

 	}else if(isarr(v)){

 		e = cvalue_arr_aset(sp-3);

 	}else{

-		sl.sp = sp;

 		type_error("sequence", v);

 	}

 	sp -= n;

@@ -622,14 +596,12 @@

 	int x = GET_S32(ip);

 	ip += 4;

 	if(sl_unlikely(nargs < i)){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		lerrorf(sl_errarg, "too few arguments");

 	}

 	if(x > 0){

 		if(sl_unlikely(nargs > x)){

-			*ipd = (uintptr)ip;

-			sl.sp = sp;

+			SYNC;

 			lerrorf(sl_errarg, "too many arguments");

 		}

 	}else

@@ -666,7 +638,7 @@

 }

 OP(OP_BOUNDP) {

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_sym *sym = tosym(sp[-1]);

 	sp[-1] = sym->binding == UNBOUND ? sl_nil : sl_t;

 	NEXT_OP;

@@ -706,8 +678,7 @@

 	}else{

 LABEL(cadr_nil):

 		if(sl_unlikely(v != sl_nil)){

-			*ipd = (uintptr)ip;

-			sl.sp = sp;

+			SYNC;

 			type_error("cons", v);

 		}

 	}

@@ -730,8 +701,7 @@

 		v = cdr_(v);

 	}

 	if(v != sl_nil){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		lerrorf(sl_errarg, "apply: last argument: not a list");

 	}

 	n = sp-p;

@@ -750,7 +720,7 @@

 OP(OP_NEG) {

 LABEL(do_neg):

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v v = sp[-1];

 	s64int i64;

 	sp[-1] = isfixnum(v) ? fixnum_neg(v) : sl_neg(v);

@@ -764,7 +734,7 @@

 OP(OP_MUL) {

 	n = *ip++;

 LABEL(apply_mul):

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v v = sl_mul_any(sp-n, n);

 	sp -= n;

 	*sp++ = v;

@@ -775,8 +745,7 @@

 	sl_v a = sp[-2];

 	sl_v b = sp[-1];

 	if(sl_unlikely(b == 0)){

-		*ipd = (uintptr)ip;

-		sl.sp = sp;

+		SYNC;

 		divide_by_0_error();

 	}

 	sl_v v;

@@ -783,7 +752,7 @@

 	if(bothfixnums(a, b))

 		v = fixnum((sl_fx)a / (sl_fx)b);

 	else{

-		*ipd = (uintptr)ip;

+		SYNC;

 		v = sl_idiv2(a, b);

 	}

 	sp--;

@@ -794,7 +763,7 @@

 OP(OP_DIV) {

 	n = *ip++;

 LABEL(apply_div):

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v *p = sp-n;

 	if(n == 1){

 		sp[-1] = sl_div2(fixnum(1), *p);

@@ -815,14 +784,12 @@

 OP(OP_VEC) {

 	n = *ip++;

 LABEL(apply_vec):;

-	sl.sp = sp;

+	SYNC;

 	int type = VEC_VEC;

 	sp -= n;

 	if(*sp == sl_vecstructsym){

-		if(n < 2){

-			*ipd = (uintptr)ip;

+		if(n < 2)

 			arity_error(n, 2);

-		}

 		sp++;

 		n--;

 		type = VEC_STRUCT;

@@ -843,13 +810,13 @@

 	NEXT_OP;

 OP(OP_FOR) {

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v *p = sp;

 	sl_v v;

 	sl_fx s = tofixnum(p[-3]);

 	sl_fx hi = tofixnum(p[-2]);

 	sp += 2;

-	sl.sp = sp;

+	SYNC;

 	for(v = sl_void; s <= hi; s++){

 		p[0] = p[-1];

 		p[1] = fixnum(s);

@@ -873,7 +840,7 @@

 	assert(issym(v));

 	sl_sym *sym = ptr(v);

 	if(sl_unlikely(isconst(sym))){

-		*ipd = (uintptr)ip;

+		SYNC;

 		const_error(v);

 	}

 	sym->binding = sp[-1];

@@ -885,8 +852,7 @@

 	NEXT_OP;

 OP(OP_TRYCATCH) {

-	*ipd = (uintptr)ip;

-	sl.sp = sp;

+	SYNC;

 	sl_v v = do_trycatch();

 	sp--;

 	sp[-1] = v;

@@ -898,7 +864,7 @@

 	if(n == 2)

 		goto LABEL(do_add2);

 LABEL(apply_add):

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v v = sl_add_any(sp-n, n);

 	sp -= n;

 	*sp++ = v;

@@ -927,8 +893,7 @@

 	ip += 4;

 	sl_fx s = GET_S32(ip);

 	ip += 4;

-	*ipd = (uintptr)ip;

-	sl.sp = sp;

+	SYNC;

 	nargs = process_keys(v, i, x, labs(s)-(i+x), bp, nargs, s<0);

 	sp = sl.sp;

 	ipd = sp-1;

@@ -942,7 +907,7 @@

 		goto LABEL(do_sub2);

 	if(n == 1)

 		goto LABEL(do_neg);

-	*ipd = (uintptr)ip;

+	SYNC;

 	sl_v *p = sp-n;

 	// we need to pass the full arglist on to sl_add_any

 	// so it can handle rest args properly

@@ -970,7 +935,7 @@

 OP(OP_BOXL) {

 	int i = GET_S32(ip);

 	ip += 4;

-	sl.sp = sp;

+	SYNC;

 	sl_v v = alloc_cons();

 	car_(v) = bp[i];

 	cdr_(v) = sl_nil;

@@ -1013,3 +978,6 @@

 	*sp++ = v;

 	NEXT_OP;

 }

+

+#undef fixnum_neg

+#undef SYNC

--- a/test/unittest.sl

+++ b/test/unittest.sl

@@ -775,3 +775,10 @@

   `(let ((a# 2)) (list a# ,x)))

 (assert (equal? '(1 (2 3)) (f (g 3))))

+

+;; these crashed before

+(assert-fail (map - '(5) '("hi")))

+(assert-fail (map + '(5) '("hi")))

+(assert-fail (map / '(5) '("hi")))

+(assert-fail (map * '(5) '("hi")))

+(assert-fail (map bound? '(5) '("hi")))