shithub: femtolisp

Download patch

ref: 403612b41e00e04cc7d8e292db4022f4c2d2f81f
parent: 778666f04ceea0a943829b1d5509cd2c8ed17824
author: Sigrid Solveig Haflínudóttir <[email protected]>
date: Wed Nov 20 15:11:51 EST 2024

rearrange for slightly better performance

--- a/cvalues.c
+++ b/cvalues.c
@@ -3,6 +3,7 @@
 #include "cvalues.h"
 #include "types.h"
 #include "iostream.h"
+#include "equal.h"
 
 // trigger unconditional GC after this many bytes are allocated
 #define ALLOC_LIMIT_TRIGGER 67108864
@@ -1076,7 +1077,7 @@
   typeerr: if not 0, throws type errors, else returns 2 for type errors
 */
 int
-numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr)
+numeric_compare(value_t a, value_t b, bool eq, bool eqnans, bool typeerr)
 {
 	fixnum_t ai, bi;
 	numerictype_t ta, tb;
@@ -1083,10 +1084,10 @@
 	void *aptr, *bptr;
 
 	if(bothfixnums(a, b)){
+		if(!eq && numval(a) < numval(b))
+			return -1;
 		if(a == b)
 			return 0;
-		if(numval(a) < numval(b))
-			return -1;
 		return 1;
 	}
 	if(!num_to_ptr(a, &ai, &ta, &aptr)){
--- a/cvalues.h
+++ b/cvalues.h
@@ -49,7 +49,6 @@
 value_t fl_neg(value_t n);
 value_t fl_mul_any(value_t *args, uint32_t nargs);
 int num_to_ptr(value_t a, fixnum_t *pi, numerictype_t *pt, void **pp);
-int numeric_compare(value_t a, value_t b, int eq, int eqnans, int typeerr);
 _Noreturn void DivideByZeroError(void);
 value_t fl_div2(value_t a, value_t b);
 value_t fl_idiv2(value_t a, value_t b);
--- a/equal.c
+++ b/equal.c
@@ -42,11 +42,11 @@
 	ptrhash_put(table, (void*)b, (void*)ca);
 }
 
-static value_t bounded_compare(value_t a, value_t b, int bound, int eq);
-static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq);
+static value_t bounded_compare(value_t a, value_t b, int bound, bool eq);
+static value_t cyc_compare(value_t a, value_t b, htable_t *table, bool eq);
 
 static value_t
-bounded_vector_compare(value_t a, value_t b, int bound, int eq)
+bounded_vector_compare(value_t a, value_t b, int bound, bool eq)
 {
 	size_t la = vector_size(a);
 	size_t lb = vector_size(b);
@@ -69,7 +69,7 @@
 // strange comparisons are resolved arbitrarily but consistently.
 // ordering: number < cprim < function < vector < cvalue < symbol < cons
 static value_t
-bounded_compare(value_t a, value_t b, int bound, int eq)
+bounded_compare(value_t a, value_t b, int bound, bool eq)
 {
 	value_t d;
 	cvalue_t *cv;
@@ -86,16 +86,16 @@
 	case TAG_NUM :
 	case TAG_NUM1:
 		if(isfixnum(b))
-			return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
+			return (fixnum_t)a < (fixnum_t)b ? fixnum(-1) : fixnum(1);
 		if(iscprim(b)){
 			if(cp_class((cprim_t*)ptr(b)) == FL(runetype))
 				return fixnum(1);
-			return fixnum(numeric_compare(a, b, eq, 1, 0));
+			return fixnum(numeric_compare(a, b, eq, true, false));
 		}
 		if(iscvalue(b)){
 			cv = ptr(b);
 			if(valid_numtype(cv_class(cv)->numtype))
-				return fixnum(numeric_compare(a, b, eq, 1, 0));
+				return fixnum(numeric_compare(a, b, eq, true, false));
 		}
 		return fixnum(-1);
 	case TAG_SYM:
@@ -114,7 +114,7 @@
 				return fixnum(-1);
 		}else if(iscprim(b) && cp_class(ptr(b)) == FL(runetype))
 			return fixnum(1);
-		c = numeric_compare(a, b, eq, 1, 0);
+		c = numeric_compare(a, b, eq, true, false);
 		if(c != 2)
 			return fixnum(c);
 		break;
@@ -121,7 +121,7 @@
 	case TAG_CVALUE:
 		cv = ptr(a);
 		if(valid_numtype(cv_class(cv)->numtype)){
-			if((c = numeric_compare(a, b, eq, 1, 0)) != 2)
+			if((c = numeric_compare(a, b, eq, true, false)) != 2)
 				return fixnum(c);
 		}
 		if(iscvalue(b)){
@@ -163,7 +163,7 @@
 }
 
 static value_t
-cyc_vector_compare(value_t a, value_t b, htable_t *table, int eq)
+cyc_vector_compare(value_t a, value_t b, htable_t *table, bool eq)
 {
 	size_t la = vector_size(a);
 	size_t lb = vector_size(b);
@@ -212,7 +212,7 @@
 }
 
 static value_t
-cyc_compare(value_t a, value_t b, htable_t *table, int eq)
+cyc_compare(value_t a, value_t b, htable_t *table, bool eq)
 {
 	value_t d, ca, cb;
 cyc_compare_top:
@@ -298,7 +298,7 @@
 
 // 'eq' means unordered comparison is sufficient
 value_t
-compare_(value_t a, value_t b, int eq)
+compare_(value_t a, value_t b, bool eq)
 {
 	value_t guess = bounded_compare(a, b, BOUNDED_COMPARE_BOUND, eq);
 	if(guess == FL(Nil)){
--- a/equal.h
+++ b/equal.h
@@ -8,5 +8,6 @@
 value_t fl_equal(value_t a, value_t b);
 int equal_lispvalue(value_t a, value_t b);
 uintptr_t hash_lispvalue(value_t a);
-value_t compare_(value_t a, value_t b, int eq);
+value_t compare_(value_t a, value_t b, bool eq);
+int numeric_compare(value_t a, value_t b, bool eq, bool eqnans, bool typeerr);
 void comparehash_init(void);
--- a/flisp.c
+++ b/flisp.c
@@ -364,6 +364,8 @@
 	if(isforwarded(v))
 		return forwardloc(v);
 
+	if(t == TAG_CVALUE)
+		return cvalue_relocate(v);
 	if(t == TAG_CPRIM){
 		cprim_t *pcp = ptr(v);
 		size_t nw = CPRIM_NWORDS-1+NWORDS(cp_class(pcp)->size);
@@ -374,8 +376,20 @@
 		forward(v, nc);
 		return nc;
 	}
-	if(t == TAG_CVALUE)
-		return cvalue_relocate(v);
+	if(t == TAG_FUNCTION){
+		function_t *fn = ptr(v);
+		function_t *nfn = alloc_words(4);
+		nfn->bcode = fn->bcode;
+		nfn->vals = fn->vals;
+		nc = tagptr(nfn, TAG_FUNCTION);
+		forward(v, nc);
+		nfn->env = relocate(fn->env);
+		nfn->vals = relocate(nfn->vals);
+		nfn->bcode = relocate(nfn->bcode);
+		assert(!ismanaged(fn->name));
+		nfn->name = fn->name;
+		return nc;
+	}
 	if(t == TAG_VECTOR){
 		// N.B.: 0-length vectors secretly have space for a first element
 		size_t i, sz = vector_size(v);
@@ -396,20 +410,6 @@
 		}
 		return nc;
 	}
-	if(t == TAG_FUNCTION){
-		function_t *fn = ptr(v);
-		function_t *nfn = alloc_words(4);
-		nfn->bcode = fn->bcode;
-		nfn->vals = fn->vals;
-		nc = tagptr(nfn, TAG_FUNCTION);
-		forward(v, nc);
-		nfn->env = relocate(fn->env);
-		nfn->vals = relocate(nfn->vals);
-		nfn->bcode = relocate(nfn->bcode);
-		assert(!ismanaged(fn->name));
-		nfn->name = fn->name;
-		return nc;
-	}
 	if(t == TAG_SYM){
 		gensym_t *gs = ptr(v);
 		gensym_t *ng = alloc_words(sizeof(gensym_t)/sizeof(void*));
@@ -544,11 +544,11 @@
 	value_t f = FL(stack)[FL(sp)-n-1];
 	uint32_t saveSP = FL(sp);
 	value_t v;
-	if(iscbuiltin(f)){
+	if(iscbuiltin(f))
 		v = ((builtin_t*)ptr(f))[3](&FL(stack)[FL(sp)-n], n);
-	}else if(isfunction(f)){
+	else if(isfunction(f))
 		v = apply_cl(n);
-	}else if(__likely(isbuiltin(f))){
+	else if(__likely(isbuiltin(f))){
 		value_t tab = symbol_value(FL(builtins_table_sym));
 		if(__unlikely(ptr(tab) == nil))
 			unbound_error(tab);
@@ -1014,7 +1014,7 @@
 			NEXT_OP;
 
 		OP(OP_BRF)
-			ip += POP() == FL(f) ? GET_INT16(ip) : 2;
+			ip += POP() != FL(f) ? 2 : GET_INT16(ip);
 			NEXT_OP;
 
 		OP(OP_POP)
@@ -1285,11 +1285,18 @@
 			NEXT_OP;
 
 		OP(OP_LT)
-			x = numeric_compare(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1], 0, 0, 0);
-			if(x > 1)
-				x = numval(fl_compare(FL(stack)[FL(sp)-2], FL(stack)[FL(sp)-1]));
-			POPN(1);
-			FL(stack)[FL(sp)-1] = x < 0 ? FL(t) : FL(f);
+			{
+				value_t a = FL(stack)[FL(sp)-2], b = FL(stack)[FL(sp)-1];
+				POPN(1);
+				if(bothfixnums(a, b)){
+					FL(stack)[FL(sp)-1] = (fixnum_t)a < (fixnum_t)b ? FL(t) : FL(f);
+				}else{
+					x = numeric_compare(a, b, false, false, false);
+					if(x > 1)
+						x = numval(fl_compare(a, b));
+					FL(stack)[FL(sp)-1] = x < 0 ? FL(t) : FL(f);
+				}
+			}
 			NEXT_OP;
 
 		OP(OP_ADD2)
@@ -1585,7 +1592,7 @@
 				v = v == e ? FL(t) : FL(f);
 			else{
 				FL(stack)[ipd] = (uintptr_t)ip;
-				v = numeric_compare(v, e, 1, 0, 1) == 0 ? FL(t) : FL(f);
+				v = numeric_compare(v, e, true, false, true) == 0 ? FL(t) : FL(f);
 			}
 			POPN(1);
 			FL(stack)[FL(sp)-1] = v;
--- a/read.c
+++ b/read.c
@@ -575,6 +575,21 @@
 	t = peek(ctx);
 	take(ctx);
 	switch(t){
+	case TOK_OPEN:
+		PUSH(FL(Nil));
+		read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSE);
+		return POP();
+	case TOK_SYM:
+	case TOK_NUM:
+		return ctx->tokval;
+	case TOK_OPENB:
+		PUSH(FL(Nil));
+		read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSEB);
+		return POP();
+	case TOK_OPENC:
+		PUSH(FL(Nil));
+		read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSEC);
+		return POP();
 	case TOK_CLOSE:
 		parse_error("unexpected ')'");
 	case TOK_CLOSEB:
@@ -583,9 +598,6 @@
 		parse_error("unexpected '}'");
 	case TOK_DOT:
 		parse_error("unexpected '.'");
-	case TOK_SYM:
-	case TOK_NUM:
-		return ctx->tokval;
 	case TOK_COMMA:
 		head = &FL(comma); goto listwith;
 	case TOK_COMMAAT:
@@ -610,18 +622,6 @@
 	case TOK_SHARPQUOTE:
 		// femtoLisp doesn't need symbol-function, so #' does nothing
 		return do_read_sexpr(ctx, label);
-	case TOK_OPEN:
-		PUSH(FL(Nil));
-		read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSE);
-		return POP();
-	case TOK_OPENB:
-		PUSH(FL(Nil));
-		read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSEB);
-		return POP();
-	case TOK_OPENC:
-		PUSH(FL(Nil));
-		read_list(ctx, &FL(stack)[FL(sp)-1], label, TOK_CLOSEC);
-		return POP();
 	case TOK_SHARPSYM:
 		sym = ctx->tokval;
 		if(sym == FL(tsym) || sym == FL(Tsym))