diff --git a/src/arith.c b/src/arith.c index 89ec5c61..7b24f7dc 100644 --- a/src/arith.c +++ b/src/arith.c @@ -1,8 +1,8 @@ #include "h.h" #include -#define P1(N) { if( isArr(x)) return eachm_fn(N##_c1, bi_nothing, x); } -#define P2(N) { if(isArr(w)|isArr(x)) return eachd_fn(N##_c2, bi_nothing, w, x); } +#define P1(N) { if( isArr(x)) return eachm_fn(N##_c1, bi_N, x); } +#define P2(N) { if(isArr(w)|isArr(x)) return eachd_fn(N##_c2, bi_N, w, x); } #define ffnx(name, expr, extra) B name##_c2(B t, B w, B x) { \ if (isF64(w) & isF64(x)) return m_f64(expr); \ extra \ @@ -100,9 +100,9 @@ B gt_c1(B t, B x) { return c1(rt_merge, x); } #undef P1 #undef P2 -#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); -#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); -#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); +#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); +#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); +#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); B bi_add, bi_sub, bi_mul, bi_div, bi_pow, bi_floor, bi_ceil, bi_stile, bi_eq, bi_ne, bi_le, bi_ge, bi_lt, bi_gt, bi_and, bi_or, bi_not, bi_log; static inline void arith_init() { ba(add) ba(sub) ba(mul) ba(div) ba(pow) ba(floor) ba(ceil) ba(stile) ba(eq) ba(ne) bd(le) bd(ge) ba(lt) ba(gt) ba(and) ba(or) ba(not) ba(log) diff --git a/src/h.h b/src/h.h index 016fd835..abf2759d 100644 --- a/src/h.h +++ b/src/h.h @@ -380,7 +380,7 @@ TypeInfo ti[t_COUNT]; #define TI(x) (ti[v(x)->type]) -B bi_nothing, bi_noVar, bi_badHdr, bi_optOut, bi_noFill; +B bi_N, bi_noVar, bi_badHdr, bi_optOut, bi_noFill; void do_nothing(B x) { } void empty_free(B x) { err("FREEING EMPTY\n"); } @@ -392,7 +392,7 @@ void freeed_visit(B x) { #endif } void def_print(B x) { printf("(%d=%s)", v(x)->type, format_type(v(x)->type)); } -B def_identity(B f) { return bi_nothing; } +B def_identity(B f) { return bi_N; } B def_get (B x, usz n) { return inc(x); } B def_getU(B x, usz n) { return x; } B def_m1_d(B m, B f ) { return err("cannot derive this"); } @@ -421,7 +421,7 @@ static inline void hdr_init() { ti[t_shape].visit = do_nothing; ti[t_funBI].visit = ti[t_md1BI].visit = ti[t_md2BI].visit = do_nothing; ti[t_funBI].free = ti[t_md1BI].free = ti[t_md2BI].free = builtin_free; - bi_nothing = tag(0, TAG_TAG); + bi_N = tag(0, TAG_TAG); bi_noVar = tag(1, TAG_TAG); bi_badHdr = tag(2, TAG_TAG); bi_optOut = tag(3, TAG_TAG); @@ -429,7 +429,7 @@ static inline void hdr_init() { assert((MD1_TAG>>1) == (MD2_TAG>>1)); // just to be sure it isn't changed incorrectly, `isMd` depends on this } -bool isNothing(B b) { return b.u==bi_nothing.u; } +bool isNothing(B b) { return b.u==bi_N.u; } // refcount @@ -485,7 +485,7 @@ void print(B x) { TI(x).print(x); } else if (isVar(x)) printf("(var d=%d i=%d)", (u16)(x.u>>32), (i32)x.u); - else if (x.u==bi_nothing.u) printf("·"); + else if (x.u==bi_N.u) printf("·"); else if (x.u==bi_optOut.u) printf("(value optimized out)"); else if (x.u==bi_noVar.u) printf("(unset variable placeholder)"); else if (x.u==bi_badHdr.u) printf("(bad header note)"); @@ -514,7 +514,7 @@ bool equal(B w, B x) { // doesn't consume bool wa = isArr(w); bool xa = isArr(x); if (wa!=xa) return false; - if (!wa) return o2iu(eq_c2(bi_nothing, inc(w), inc(x)))?1:0; + if (!wa) return o2iu(eq_c2(bi_N, inc(w), inc(x)))?1:0; if (!eqShape(w,x)) return false; usz ia = a(x)->ia; BS2B xget = TI(x).get; diff --git a/src/main.c b/src/main.c index dec67a88..1d099963 100644 --- a/src/main.c +++ b/src/main.c @@ -95,7 +95,6 @@ int main() { rtPerf_init(); // fake runtime - B bi_N = bi_nothing; B fruntime[] = { /* +-×÷⋆√⌊⌈|¬ */ bi_add , bi_sub , bi_mul , bi_div, bi_pow, bi_N , bi_floor, bi_ceil, bi_stile, bi_not, /* ∧∨<>≠=≤≥≡≢ */ bi_and , bi_or , bi_lt , bi_gt , bi_ne , bi_eq, bi_le , bi_ge , bi_feq , bi_fne, @@ -103,7 +102,7 @@ int main() { /* ⌽⍉/⍋⍒⊏⊑⊐⊒∊ */ bi_N , bi_N , bi_N , bi_N , bi_N , bi_N , bi_pick , bi_N , bi_N , bi_N, /* ⍷⊔!˙˜˘¨⌜⁼´ */ bi_N , bi_N , bi_asrt , bi_N , bi_N , bi_N , bi_each , bi_tbl , bi_N , bi_fold, /* ˝`∘○⊸⟜⌾⊘◶⎉ */ bi_N , bi_scan , bi_N , bi_N , bi_N , bi_N , bi_N , bi_val , bi_N , bi_N, - /* ⚇⍟⎊ */ bi_N , bi_fill , bi_catch + /* ⚇⍟⎊ */ bi_N , bi_N , bi_catch }; bool rtComplete[] = { /* +-×÷⋆√⌊⌈|¬ */ 1,1,1,1,1,0,1,1,1,1, @@ -234,7 +233,9 @@ int main() { pr("", res); #endif - // heapVerify(); + #ifdef HEAP_VERIFY + heapVerify(); + #endif gc_forceGC(); #ifdef DEBUG #endif diff --git a/src/sfns.c b/src/sfns.c index 87e30733..64fbef89 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -11,7 +11,26 @@ B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is a if (isArr(w)) { wia = a(w)->ia; wr = rnk(w); wget = TI(w).get; } else { wia=1; wr=0; wget=def_get; } if (isArr(x)) { xia = a(x)->ia; xr = rnk(x); xget = TI(x).get; } else { xia=1; xr=0; xget=def_get; } bool wg = wr>xr; - if (isArr(w) & isArr(x) && !eqShPrefix(a(w)->sh, a(x)->sh, wg?xr:wr)) thrM("Mapping: Expected equal shape prefix"); + ur rM = wg? wr : xr; + ur rm = wg? xr : wr; + if (rM==0) return f(fo, xget(w,0), wget(x,0)); + if (isArr(w) & isArr(x) && !eqShPrefix(a(w)->sh, a(x)->sh, rm)) thrM("Mapping: Expected equal shape prefix"); + bool rw = rM==wr && ((v(w)->type==t_harr) & reusable(w)); // v(…) is safe as rank>0 + bool rx = rM==xr && ((v(x)->type==t_harr) & reusable(x)); + if (rw|rx && (wr==xr | rm==0)) { + HArr_p r = harr_parts(rw? w : x); + usz ria = r.c->ia; + if (wr==0) { B c=wget(w, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, inc(c), r.a[i]); dec(c); } + else if (xr==0) { B c=xget(x, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, r.a[i], inc(c)); dec(c); } + else { + assert(wr==xr); + if (rw) for (usz i = 0; i < ria; i++) r.a[i] = f(fo, r.a[i], xget(x,i)); + else for (usz i = 0; i < ria; i++) r.a[i] = f(fo, wget(w,i), r.a[i]); + } + dec(rw? x : w); + return r.b; + } + HArr_p r = m_harrc(wg? w : x); usz ria = r.c->ia; if (wr==xr) for(usz i = 0; i < ria; i++) r.a[i] = f(fo, wget(w,i), xget(x,i)); @@ -247,9 +266,9 @@ B funBI_identity(B x) { return inc(c(BFn,x)->ident); } -#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); -#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); -#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); +#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); +#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); +#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); void print_fun_def(B x) { printf("%s", format_pf(c(Fun,x)->extra)); } diff --git a/src/sysfn.c b/src/sysfn.c index 1761ce91..962dc911 100644 --- a/src/sysfn.c +++ b/src/sysfn.c @@ -131,9 +131,9 @@ B internal_c2(B t, B w, B x) { B sys_c1(B t, B x); -#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); -#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); -#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_nothing; gc_add(bi_##N); +#define ba(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); +#define bd(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = N##_c2 ;c(Fun,bi_##N)->c1 = c1_invalid; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); +#define bm(N) bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); c(Fun,bi_##N)->c2 = c2_invalid;c(Fun,bi_##N)->c1 = N##_c1 ; c(Fun,bi_##N)->extra=pf_##N; c(BFn,bi_##N)->ident=bi_N; gc_add(bi_##N); B bi_type, bi_decp, bi_primInd, bi_glyph, bi_fill, bi_grLen, bi_grOrd, bi_asrt, bi_sys, bi_internal; static inline void sysfn_init() { bm(type) bm(decp) bm(primInd) bm(glyph) ba(fill) ba(grLen) bd(grOrd) ba(asrt) bm(sys) bd(internal) } diff --git a/src/vm.c b/src/vm.c index 957f258e..cb482480 100644 --- a/src/vm.c +++ b/src/vm.c @@ -414,12 +414,12 @@ B actualExec(Block* bl, Scope* psc, u32 ga, B* svar) { // consumes svar contents return r; } -B funBl_c1(B t, B x) { FunBlock* b=c(FunBlock, t ); return actualExec(b->bl, b->sc, 3, (B[]){inc(t), x, bi_nothing }); } -B funBl_c2(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); return actualExec(b->bl, b->sc, 3, (B[]){inc(t), x, w }); } -B md1Bl_c1(B D, B x) { Md1D* d=c(Md1D,D); Md1Block* b=c(Md1Block, d->m1); return actualExec(b->bl, b->sc, 5, (B[]){inc(D), x, bi_nothing, inc(d->m1), inc(d->f) }); } -B md1Bl_c2(B D, B w, B x) { Md1D* d=c(Md1D,D); Md1Block* b=c(Md1Block, d->m1); return actualExec(b->bl, b->sc, 5, (B[]){inc(D), x, w , inc(d->m1), inc(d->f) }); } -B md2Bl_c1(B D, B x) { Md2D* d=c(Md2D,D); Md2Block* b=c(Md2Block, d->m2); return actualExec(b->bl, b->sc, 6, (B[]){inc(D), x, bi_nothing, inc(d->m2), inc(d->f), inc(d->g)}); } -B md2Bl_c2(B D, B w, B x) { Md2D* d=c(Md2D,D); Md2Block* b=c(Md2Block, d->m2); return actualExec(b->bl, b->sc, 6, (B[]){inc(D), x, w , inc(d->m2), inc(d->f), inc(d->g)}); } +B funBl_c1(B t, B x) { FunBlock* b=c(FunBlock, t ); return actualExec(b->bl, b->sc, 3, (B[]){inc(t), x, bi_N }); } +B funBl_c2(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); return actualExec(b->bl, b->sc, 3, (B[]){inc(t), x, w }); } +B md1Bl_c1(B D, B x) { Md1D* d=c(Md1D,D); Md1Block* b=c(Md1Block, d->m1); return actualExec(b->bl, b->sc, 5, (B[]){inc(D), x, bi_N, inc(d->m1), inc(d->f) }); } +B md1Bl_c2(B D, B w, B x) { Md1D* d=c(Md1D,D); Md1Block* b=c(Md1Block, d->m1); return actualExec(b->bl, b->sc, 5, (B[]){inc(D), x, w , inc(d->m1), inc(d->f) }); } +B md2Bl_c1(B D, B x) { Md2D* d=c(Md2D,D); Md2Block* b=c(Md2Block, d->m2); return actualExec(b->bl, b->sc, 6, (B[]){inc(D), x, bi_N, inc(d->m2), inc(d->f), inc(d->g)}); } +B md2Bl_c2(B D, B w, B x) { Md2D* d=c(Md2D,D); Md2Block* b=c(Md2Block, d->m2); return actualExec(b->bl, b->sc, 6, (B[]){inc(D), x, w , inc(d->m2), inc(d->f), inc(d->g)}); } B m_funBlock(Block* bl, Scope* psc) { // doesn't consume anything if (bl->imm) return actualExec(bl, psc, 0, NULL); B r = mm_alloc(sizeof(FunBlock), t_fun_block, ftag(FUN_TAG));