ref: 403612b41e00e04cc7d8e292db4022f4c2d2f81f
parent: 778666f04ceea0a943829b1d5509cd2c8ed17824
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
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))