diff --git a/src/arith.c b/src/arith.c index 988343b5..a168b327 100644 --- a/src/arith.c +++ b/src/arith.c @@ -56,13 +56,13 @@ B div_c1(B t, B x) { if (isF64(x)) return m_f64( 1/x.f ); return err("getti B pow_c1(B t, B x) { if (isF64(x)) return m_f64( exp(x.f)); return err("getting exp of non-number"); } B floor_c1(B t, B x) { if (isF64(x)) return m_f64(floor(x.f)); return err("getting floor of non-number"); } B log_c1(B t, B x) { if (isF64(x)) return m_f64( log(x.f)); return err("getting log of non-number"); } -B eq_c1(B t, B x) { B r = m_i32(isArr(x)? a(x)->rank : 0); dec(x); return r; } +B eq_c1(B t, B x) { B r = m_i32(isArr(x)? rnk(x) : 0); dec(x); return r; } -#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME; -#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->id=pf_##NAME; -#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME; +#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; +#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->extra=pf_##NAME; +#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; B bi_add, bi_sub, bi_mul, bi_div, bi_pow, bi_floor, bi_eq, bi_le, bi_log; void arith_init() { ba(add) ba(sub) ba(mul) ba(div) ba(pow) bm(floor) ba(eq) bd(le) ba(log) } diff --git a/src/derv.c b/src/derv.c index 27d757fc..37ee42d2 100644 --- a/src/derv.c +++ b/src/derv.c @@ -54,11 +54,11 @@ B fork_decompose(B x) { B r=m_v4(m_i32(3),inci(c(Fork,x)->f),inci(c(Fork,x)->g), B atop_decompose(B x) { B r=m_v3(m_i32(2), inci(c(Atop,x)->g), inci(c(Atop,x)->h)); dec(x); return r; } // consume all args -B m_md1D(B m, B f ) { B r = mm_alloc(sizeof(Md1D), t_md1D, ftag(FUN_TAG)); c(Md1D,r)->f = f; c(Md1D,r)->m = m; c(Md1D,r)->c1=md1D_c1; c(Md1D,r)->c2=md1D_c2; c(Md1D,r)->id=pf_md1d; return r; } -B m_md2D(B m, B f, B g) { B r = mm_alloc(sizeof(Md2D), t_md2D, ftag(FUN_TAG)); c(Md2D,r)->f = f; c(Md2D,r)->m = m; c(Md2D,r)->g = g; c(Md2D,r)->c1=md2D_c1; c(Md2D,r)->c2=md2D_c2; c(Md2D,r)->id=pf_md2d; return r; } -B m_md2H(B m, B g) { B r = mm_alloc(sizeof(Md2H), t_md2H, ftag(MD1_TAG)); c(Md2H,r)->m = m; c(Md2H,r)->g = g; c(Md2H,r)->c1=md2H_c1; c(Md2H,r)->c2=md2H_c2; return r; } -B m_fork(B f, B g, B h) { B r = mm_alloc(sizeof(Fork), t_fork, ftag(FUN_TAG)); c(Fork,r)->f = f; c(Fork,r)->g = g; c(Fork,r)->h = h; c(Fork,r)->c1=fork_c1; c(Fork,r)->c2=fork_c2; c(Fork,r)->id=pf_fork; return r; } -B m_atop( B g, B h) { B r = mm_alloc(sizeof(Atop), t_atop, ftag(FUN_TAG)); c(Atop,r)->g = g; c(Atop,r)->h = h; c(Atop,r)->c1=atop_c1; c(Atop,r)->c2=atop_c2; c(Atop,r)->id=pf_atop; return r; } +B m_md1D(B m, B f ) { B r = mm_alloc(sizeof(Md1D), t_md1D, ftag(FUN_TAG)); c(Md1D,r)->f = f; c(Md1D,r)->m = m; c(Md1D,r)->c1=md1D_c1; c(Md1D,r)->c2=md1D_c2; c(Md1D,r)->extra=pf_md1d; return r; } +B m_md2D(B m, B f, B g) { B r = mm_alloc(sizeof(Md2D), t_md2D, ftag(FUN_TAG)); c(Md2D,r)->f = f; c(Md2D,r)->m = m; c(Md2D,r)->g = g; c(Md2D,r)->c1=md2D_c1; c(Md2D,r)->c2=md2D_c2; c(Md2D,r)->extra=pf_md2d; return r; } +B m_md2H(B m, B g) { B r = mm_alloc(sizeof(Md2H), t_md2H, ftag(MD1_TAG)); c(Md2H,r)->m = m; c(Md2H,r)->g = g; c(Md2H,r)->c1=md2H_c1; c(Md2H,r)->c2=md2H_c2; return r; } +B m_fork(B f, B g, B h) { B r = mm_alloc(sizeof(Fork), t_fork, ftag(FUN_TAG)); c(Fork,r)->f = f; c(Fork,r)->g = g; c(Fork,r)->h = h; c(Fork,r)->c1=fork_c1; c(Fork,r)->c2=fork_c2; c(Fork,r)->extra=pf_fork; return r; } +B m_atop( B g, B h) { B r = mm_alloc(sizeof(Atop), t_atop, ftag(FUN_TAG)); c(Atop,r)->g = g; c(Atop,r)->h = h; c(Atop,r)->c1=atop_c1; c(Atop,r)->c2=atop_c2; c(Atop,r)->extra=pf_atop; return r; } // consume all args B m1_d(B m, B f ) { if(isMd1(m)) return TI(m).m1_d(m, f ); return err("Interpreting non-1-modifier as 1-modifier"); } diff --git a/src/h.h b/src/h.h index 3ff3c90f..b73d3495 100644 --- a/src/h.h +++ b/src/h.h @@ -103,10 +103,10 @@ typedef struct Value { i32 refc; u16 flags; // incl GC stuff when that's a thing, possibly whether is sorted/a permutation/whatever, bucket size, etc u8 type; // needed globally so refc-- and GC know what to visit + u8 extra; // whatever object-specific stuff. Rank for arrays, id for functions } Value; typedef struct Arr { struct Value; - ur rank; usz ia; usz* sh; } Arr; @@ -126,9 +126,11 @@ B m_v1(B a ); B m_v2(B a, B b ); B m_v3(B a, B b, B c ); B m_v4(B a, B b, B c, B d); + #define c(T,x) ((T*)((x).u&0xFFFFFFFFFFFFull)) Value* v(B x) { return c(Value, x); } Arr* a(B x) { return c(Arr , x); } +#define rnk(x) (v(x)->extra) // expects argument to be Arr void print_vmStack(); #ifdef DEBUG @@ -177,23 +179,24 @@ usz* allocSh(ur r) { return ((ShArr*)v(x))->a; } ShArr* shObj(B x) { return (ShArr*)((u64)a(x)->sh-offsetof(ShArr,a)); } -void decSh(B x) { if (a(x)->rank>1) ptr_dec(shObj(x)); } +void decSh(B x) { if (rnk(x)>1) ptr_dec(shObj(x)); } void arr_shVec(B x, usz ia) { a(x)->ia = ia; - a(x)->rank = 1; + v(x)->extra = 1; a(x)->sh = &a(x)->ia; } usz* arr_shAlloc(B x, usz ia, usz r) { a(x)->ia = ia; - a(x)->rank = r; + a(x)->extra = r; if (r>1) return a(x)->sh = allocSh(r); a(x)->sh = &a(x)->ia; return 0; } void arr_shCopy(B n, B o) { // copy shape from o to n + assert(isArr(o)); a(n)->ia = a(o)->ia; - ur r = a(n)->rank = a(o)->rank; + ur r = a(n)->extra = rnk(o); if (r<=1) { a(n)->sh = &a(n)->ia; } else { @@ -201,15 +204,15 @@ void arr_shCopy(B n, B o) { // copy shape from o to n ptr_inc(shObj(o)); } } -bool shEq(B w, B x) { // assumes both are Arr - ur wr = a(w)->rank; usz* wsh = a(w)->sh; - ur xr = a(x)->rank; usz* xsh = a(x)->sh; +bool shEq(B w, B x) { assert(isArr(w)); assert(isArr(x)); + ur wr = rnk(w); usz* wsh = a(w)->sh; + ur xr = rnk(x); usz* xsh = a(x)->sh; if (wr!=xr) return false; if (wsh==xsh) return true; return memcmp(wsh,xsh,wr*sizeof(usz))==0; } usz arr_csz(B x) { - ur xr = a(x)->rank; + ur xr = rnk(x); if (xr<=1) return 1; usz* sh = a(x)->sh; usz r = 1; @@ -327,7 +330,6 @@ void print(B x) { typedef struct Fun { struct Value; - u8 id; BB2B c1; BBB2B c2; } Fun; @@ -352,20 +354,18 @@ B c2(B f, B w, B x) { // BQN-call f dyadically; consumes w,x typedef struct Md1 { struct Value; - u8 id; BBB2B c1; // f(m,f, x); consumes x BBBB2B c2; // f(m,f,w,x); consumes w,x } Md1; typedef struct Md2 { struct Value; - u8 id; BBBB2B c1; // f(m,f,g, x); consumes x BBBBB2B c2; // f(m,f,g,w,x); consumes w,x } Md2; void arr_print(B x) { - usz r = a(x)->rank; + usz r = rnk(x); BS2B xget = TI(x).get; usz ia = a(x)->ia; if (r!=1) { @@ -414,7 +414,7 @@ void arr_print(B x) { err(""); } if (isArr(x)) { - ur r = a(x)->rank; + ur r = rnk(x); if (r<=1) assert(a(x)->sh == &a(x)->ia); else validate(tag(shObj(x),OBJ_TAG)); } diff --git a/src/main.c b/src/main.c index 75bde6b0..f8170e84 100644 --- a/src/main.c +++ b/src/main.c @@ -150,6 +150,7 @@ int main() { dec(comp); #ifdef ALLOC_STAT + printf("total allocated: %lu\n", talloc); printf("ctrA←"); for (i64 j = 0; j < Type_MAX; j++) { if(j)printf("‿"); printf("%lu", ctr_a[j]); } printf("\n"); printf("ctrF←"); for (i64 j = 0; j < Type_MAX; j++) { if(j)printf("‿"); printf("%lu", ctr_f[j]); } printf("\n"); for(i64 i = 0; i < actrc; i++) { diff --git a/src/md1.c b/src/md1.c index 0e2160f8..916d2409 100644 --- a/src/md1.c +++ b/src/md1.c @@ -16,8 +16,8 @@ B tbl_c1(B t, B f, B x) { } B tbl_c2(B t, B f, B w, B x) { if (isArr(w) & isArr(x)) { - usz wia = a(w)->ia; ur wr = a(w)->rank; - usz xia = a(x)->ia; ur xr = a(x)->rank; + usz wia = a(w)->ia; ur wr = rnk(w); + usz xia = a(x)->ia; ur xr = rnk(x); usz ria = wia*xia; ur rr = wr+xr; if (rrrank; + ur xr = rnk(x); if (xr==0) return err("`: argument cannot be a scalar"); HArr_p r = (v(x)->type==t_harr && reusable(x))? harr_parts(inci(x)) : m_harrc(x); usz ia = r.c->ia; @@ -64,11 +64,11 @@ B scan_c1(B t, B f, B x) { } B scan_c2(B t, B f, B w, B x) { if (!isArr(x)) return err("`: 𝕩 cannot be a scalar"); - ur xr = a(x)->rank; usz* xsh = a(x)->sh; BS2B xget = TI(x).get; + ur xr = rnk(x); usz* xsh = a(x)->sh; BS2B xget = TI(x).get; HArr_p r = (v(x)->type==t_harr && reusable(x))? harr_parts(inci(x)) : m_harrc(x); usz ia = r.c->ia; if (isArr(w)) { - ur wr = a(w)->rank; usz* wsh = a(w)->sh; BS2B wget = TI(w).get; + ur wr = rnk(w); usz* wsh = a(w)->sh; BS2B wget = TI(w).get; if (xr==0) return err("`: 𝕩 cannot be a scalar"); if (wr+1 != xr) return err("`: shape of 𝕨 must match the cell of 𝕩"); if (memcmp(wsh, xsh+1, wr)) return err("`: shape of 𝕨 must match the cell of 𝕩"); @@ -88,11 +88,11 @@ B scan_c2(B t, B f, B w, B x) { } -#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->id=pm1_##NAME; -#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->id=pm1_##NAME; -#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->id=pm1_##NAME; +#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; +#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm1_##NAME; +#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1_def, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; -void print_md1_def(B x) { printf("%s", format_pm1(c(Md1,x)->id)); } +void print_md1_def(B x) { printf("%s", format_pm1(c(Md1,x)->extra)); } B bi_tbl, bi_scan; void md1_init() { ba(tbl) ba(scan) diff --git a/src/mm.c b/src/mm.c index 182d90b5..d41d87d2 100644 --- a/src/mm.c +++ b/src/mm.c @@ -5,6 +5,7 @@ u64* ctr_a = 0; u64* ctr_f = 0; u64 actrc = 21000; +u64 talloc = 0; u32** actrs; #endif @@ -25,6 +26,7 @@ void* mm_allocN(usz sz, u8 type) { assert(type=actrc? actrc-1 : (sz+3)/4][type]++; ctr_a[type]++; + talloc+= sz; #endif #ifdef DEBUG memset(x, 'a', sz); diff --git a/src/sfns.c b/src/sfns.c index 72aad058..a7870c7b 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -76,7 +76,7 @@ B pair_c2(B t, B w, B x) { return m_v2(w, x); } B fne_c1(B t, B x) { if (isArr(x)) { - ur xr = a(x)->rank; + ur xr = rnk(x); usz* sh = a(x)->sh; for (i32 i = 0; i < xr; i++) if (sh[i]>I32_MAX) { HArr_p r = m_harrv(xr); @@ -100,11 +100,11 @@ B lt_c2(B t, B w, B x) { dec(x); return w; } B rt_c1(B t, B x) { return x; } B rt_c2(B t, B w, B x) { dec(w); return x; } -#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME; -#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->id=pf_##NAME; -#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME; +#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; +#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->extra=pf_##NAME; +#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; -void print_fun_def(B x) { printf("%s", format_pf(c(Fun,x)->id)); } +void print_fun_def(B x) { printf("%s", format_pf(c(Fun,x)->extra)); } B bi_shape, bi_pick, bi_ud, bi_pair, bi_fne, bi_lt, bi_rt; void sfns_init() { ba(shape) ba(pick) bm(ud) ba(pair) bm(fne) ba(lt) ba(rt) diff --git a/src/sysfn.c b/src/sysfn.c index 9cf7a71a..abf31700 100644 --- a/src/sysfn.c +++ b/src/sysfn.c @@ -108,9 +108,9 @@ B asrt_c2(B t, B w, B x) { } -#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME; -#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->id=pf_##NAME; -#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->id=pf_##NAME; +#define ba(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; +#define bd(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = NAME##_c2; c(Fun,bi_##NAME)->c1 = c1_invalid; c(Fun,bi_##NAME)->extra=pf_##NAME; +#define bm(NAME) bi_##NAME = mm_alloc(sizeof(Fun), t_fun_def, ftag(FUN_TAG)); c(Fun,bi_##NAME)->c2 = c2_invalid;c(Fun,bi_##NAME)->c1 = NAME##_c1 ; c(Fun,bi_##NAME)->extra=pf_##NAME; B bi_type, bi_decp, bi_primInd, bi_glyph, bi_fill, bi_grLen, bi_grOrd, bi_asrt; void sysfn_init() { bm(type) bm(decp) bm(primInd) bm(glyph) ba(fill) ba(grLen) bd(grOrd) ba(asrt) }