diff --git a/src/fillarr.c b/src/fillarr.c index fe503b24..475e3a57 100644 --- a/src/fillarr.c +++ b/src/fillarr.c @@ -8,7 +8,7 @@ typedef struct FillArr { B asFill(B x) { // consumes if (isArr(x)) { - HArr_p r = m_harrc(x); + HArr_p r = m_harrUc(x); usz ia = r.c->ia; BS2B xget = TI(x).get; bool noFill = false; @@ -88,7 +88,7 @@ static inline void fillarr_init() { B m_unit(B x) { B xf = asFill(inc(x)); if (noFill(xf)) { - HArr_p r = m_harrp(1); + HArr_p r = m_harrUp(1); arr_shAllocR(r.b, 0); r.a[0] = x; return r.b; diff --git a/src/h.h b/src/h.h index 0c278efb..1e9c29f8 100644 --- a/src/h.h +++ b/src/h.h @@ -65,7 +65,7 @@ enum Type { /*17*/ t_hslice, t_i32slice, t_fillslice, t_c32slice, /*21*/ t_comp, t_block, t_body, t_scope, - /*25*/ t_freed, + /*25*/ t_freed, t_harrPartial, #ifdef RT_PERF /*26*/ t_funPerf, t_md1Perf, t_md2Perf, #endif @@ -187,6 +187,8 @@ B mm_alloc(usz sz, u8 type, u64 tag) { return b((u64)mm_allocN(sz,type) | tag); } +void gsAdd(B x); +B gsPop(); // some primitive actions void dec(B x); diff --git a/src/harr.c b/src/harr.c index 7b319596..ac2fde62 100644 --- a/src/harr.c +++ b/src/harr.c @@ -16,24 +16,57 @@ HArr_p harr_parts(B b) { } -HArr_p m_harrv(usz ia) { +HArr_p m_harrs(usz ia, usz* ctr) { // writes just ia + B r = m_arr(fsizeof(HArr,a,B,ia), t_harrPartial); + a(r)->ia = ia; + a(r)->sh = ctr; + gsAdd(r); + return harr_parts(r); +} +B harr_fv(HArr_p p) { VT(p.b, t_harrPartial); + p.c->type = t_harr; + p.c->sh = &p.c->ia; + srnk(p.b, 1); + gsPop(); + return p.b; +} +B harr_fc(HArr_p p, B x) { VT(p.b, t_harrPartial); + p.c->type = t_harr; + arr_shCopy(p.b, x); + gsPop(); + return p.b; +} +B harr_fcd(HArr_p p, B x) { VT(p.b, t_harrPartial); + p.c->type = t_harr; + arr_shCopy(p.b, x); + dec(x); + gsPop(); + return p.b; +} +usz* harr_fa(HArr_p p, ur r) { VT(p.b, t_harrPartial); + p.c->type = t_harr; + gsPop(); + return arr_shAllocR(p.b, r); +} + +HArr_p m_harrUv(usz ia) { B r = m_arr(fsizeof(HArr,a,B,ia), t_harr); arr_shVec(r, ia); return harr_parts(r); } -HArr_p m_harrc(B x) { assert(isArr(x)); +HArr_p m_harrUc(B x) { assert(isArr(x)); B r = m_arr(fsizeof(HArr,a,B,a(x)->ia), t_harr); arr_shCopy(r, x); return harr_parts(r); } -HArr_p m_harrp(usz ia) { // doesn't write shape/rank +HArr_p m_harrUp(usz ia) { // doesn't write shape/rank B r = m_arr(fsizeof(HArr,a,B,ia), t_harr); a(r)->ia = ia; return harr_parts(r); } B m_hunit(B x) { - HArr_p r = m_harrp(1); + HArr_p r = m_harrUp(1); arr_shAllocR(r.b, 0); r.a[0] = x; return r.b; @@ -44,7 +77,7 @@ B* harr_ptr(B x) { VT(x,t_harr); return c(HArr,x)->a; } HArr* toHArr(B x) { if (v(x)->type==t_harr) return c(HArr,x); - HArr_p r = m_harrc(x); + HArr_p r = m_harrUc(x); usz ia = r.c->ia; BS2B xget = TI(x).get; for (usz i = 0; i < ia; i++) r.a[i] = xget(x,i); @@ -52,30 +85,23 @@ HArr* toHArr(B x) { return r.c; } -NOINLINE void harr_pfree(B x, usz am) { // am - item after last written - B* p = harr_ptr(x); - for (usz i = 0; i < am; i++) dec(p[i]); - mm_free(v(x)); -} - - B m_caB(usz ia, B* a) { - HArr_p r = m_harrv(ia); + HArr_p r = m_harrUv(ia); for (usz i = 0; i < ia; i++) r.a[i] = a[i]; return r.b; } B m_caf64(usz sz, f64* a) { - HArr_p r = m_harrv(sz); + HArr_p r = m_harrUv(sz); for (usz i = 0; i < sz; i++) r.a[i] = m_f64(a[i]); return r.b; } // consumes all -B m_v1(B a ) { HArr_p r = m_harrv(1); r.a[0] = a; return r.b; } -B m_v2(B a, B b ) { HArr_p r = m_harrv(2); r.a[0] = a; r.a[1] = b; return r.b; } -B m_v3(B a, B b, B c ) { HArr_p r = m_harrv(3); r.a[0] = a; r.a[1] = b; r.a[2] = c; return r.b; } -B m_v4(B a, B b, B c, B d) { HArr_p r = m_harrv(4); r.a[0] = a; r.a[1] = b; r.a[2] = c; r.a[3] = d; return r.b; } +B m_v1(B a ) { HArr_p r = m_harrUv(1); r.a[0] = a; return r.b; } +B m_v2(B a, B b ) { HArr_p r = m_harrUv(2); r.a[0] = a; r.a[1] = b; return r.b; } +B m_v3(B a, B b, B c ) { HArr_p r = m_harrUv(3); r.a[0] = a; r.a[1] = b; r.a[2] = c; return r.b; } +B m_v4(B a, B b, B c, B d) { HArr_p r = m_harrUv(4); r.a[0] = a; r.a[1] = b; r.a[2] = c; r.a[3] = d; return r.b; } typedef struct HSlice { @@ -109,13 +135,47 @@ void harr_visit(B x) { } bool harr_canStore(B x) { return true; } + + +NOINLINE void harr_pfree(B x, usz am) { // am - item after last written + B* p = harr_ptr(x); + for (usz i = 0; i < am; i++) dec(p[i]); + mm_free(v(x)); +} +void harrP_free(B x) { assert(v(x)->type==t_harrPartial|v(x)->type==t_freed); + assert(rnk(x)>1? true : a(x)->sh!=&a(x)->ia); + B* p = c(HArr,x)->a; + usz am = *c(HArr,x)->sh; + // printf("partfree %d/%d %p\n", am, a(x)->ia, (void*)x.u); + for (usz i = 0; i < am; i++) dec(p[i]); +} +void harrP_visit(B x) { VT(x, t_harrPartial); + assert(rnk(x)>1? true : a(x)->sh!=&a(x)->ia); + B* p = c(HArr,x)->a; + usz am = *c(HArr,x)->sh; + for (usz i = 0; i < am; i++) mm_visit(p[i]); +} +B harrP_get(B x, usz n) { return err("getting item from t_harrPartial"); } +void harrP_print(B x) { + B* p = c(HArr,x)->a; + usz am = *c(HArr,x)->sh; + usz ia = a(x)->ia; + printf("(partial HArr %d/%d %p %p: ?⥊⟨", am, ia, c(HArr,x)->sh, &a(x)->ia); + for (usz i = 0; i < ia; i++) { + if (i) printf(", "); + if (i>=am) printf("(…)\n"); + else print(p[i]); + } + printf("⟩)"); +} + static inline void harr_init() { - ti[t_harr].get = harr_get; ti[t_hslice].get = hslice_get; - ti[t_harr].getU = harr_getU; ti[t_hslice].getU = hslice_getU; + ti[t_harr].get = harr_get; ti[t_hslice].get = hslice_get; ti[t_harrPartial].get = harrP_get; + ti[t_harr].getU = harr_getU; ti[t_hslice].getU = hslice_getU; ti[t_harrPartial].getU = harrP_get; ti[t_harr].slice = harr_slice; ti[t_hslice].slice = hslice_slice; - ti[t_harr].free = harr_free; ti[t_hslice].free = slice_free; - ti[t_harr].visit = harr_visit; ti[t_hslice].visit = slice_visit; - ti[t_harr].print = arr_print; ti[t_hslice].print = arr_print; + ti[t_harr].free = harr_free; ti[t_hslice].free = slice_free; ti[t_harrPartial].free = harrP_free; + ti[t_harr].visit = harr_visit; ti[t_hslice].visit = slice_visit; ti[t_harrPartial].visit = harrP_visit; + ti[t_harr].print = arr_print; ti[t_hslice].print = arr_print; ti[t_harrPartial].print = harrP_print; ti[t_harr].isArr = true; ti[t_hslice].isArr = true; ti[t_harr].canStore = harr_canStore; } diff --git a/src/main.c b/src/main.c index 1a8b246a..6e8690f3 100644 --- a/src/main.c +++ b/src/main.c @@ -128,7 +128,7 @@ int main() { dec(rtRes); runtimeLen = c(Arr,rtObjRaw)->ia; - HArr_p runtimeH = m_harrc(rtObjRaw); + HArr_p runtimeH = m_harrUc(rtObjRaw); BS2B rtObjGet = TI(rtObjRaw).get; rt_sortAsc = rtObjGet(rtObjRaw, 10); gc_add(rt_sortAsc); diff --git a/src/md1.c b/src/md1.c index d2c72ddc..5c5c7ea6 100644 --- a/src/md1.c +++ b/src/md1.c @@ -10,22 +10,22 @@ B tbl_c2(B d, B w, B x) { B f = c(Md1D,d)->f; usz xia = a(x)->ia; ur xr = rnk(x); usz ria = wia*xia; ur rr = wr+xr; if (rrsh, wr*sizeof(usz)); - memcpy(rsh+wr, a(x)->sh, xr*sizeof(usz)); - } BS2B wgetU = TI(w).getU; BS2B xget = TI(x).get; usz ri = 0; + HArr_p r = m_harrs(ria, &ri); for (usz wi = 0; wi < wia; wi++) { B cw = wgetU(w,wi); - for (usz xi = 0; xi < xia; xi++) { - r.a[ri++] = c2(f, inc(cw), xget(x,xi)); + for (usz xi = 0; xi < xia; xi++,ri++) { + r.a[ri] = c2(f, inc(cw), xget(x,xi)); } } + usz* rsh = harr_fa(r, rr); + if (rsh) { + memcpy(rsh , a(w)->sh, wr*sizeof(usz)); + memcpy(rsh+wr, a(x)->sh, xr*sizeof(usz)); + } dec(w); dec(x); return r.b; } @@ -44,43 +44,47 @@ B scan_c1(B d, B x) { B f = c(Md1D,d)->f; ur xr = rnk(x); usz ia = a(x)->ia; if (ia==0) return x; + bool reuse = v(x)->type==t_harr && reusable(x); - HArr_p r = reuse? harr_parts(inc(x)) : m_harrc(x); + usz i = 0; + HArr_p r = reuse? harr_parts(x) : m_harrs(a(x)->ia, &i); BS2B xget = reuse? TI(x).getU : TI(x).get; + if (xr==1) { - r.a[0] = xget(x,0); - for (usz i = 1; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-1]), xget(x,i)); + r.a[i] = xget(x,0); i++; + for (i = 1; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-1]), xget(x,i)); } else { usz csz = arr_csz(x); - for (usz i = 0; i < csz; i++) r.a[i] = xget(x,i); - for (usz i = csz; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-csz]), xget(x,i)); + for (; i < csz; i++) r.a[i] = xget(x,i); + for (; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-csz]), xget(x,i)); } - dec(x); - return withFill(r.b, xf); + return withFill(reuse? x : harr_fcd(r, x), xf); } B scan_c2(B d, B w, B x) { B f = c(Md1D,d)->f; if (!isArr(x) || rnk(x)==0) thrM("`: 𝕩 cannot have rank 0"); ur xr = rnk(x); usz* xsh = a(x)->sh; usz ia = a(x)->ia; - bool reuse = v(x)->type==t_harr && reusable(x); - HArr_p r = reuse? harr_parts(inc(x)) : m_harrc(x); + + bool reuse = (v(x)->type==t_harr && reusable(x)) | !ia; + usz i = 0; + HArr_p r = reuse? harr_parts(x) : m_harrs(a(x)->ia, &i); BS2B xget = reuse? TI(x).getU : TI(x).get; + if (isArr(w)) { ur wr = rnk(w); usz* wsh = a(w)->sh; BS2B wget = TI(w).get; if (wr+1 != xr) thrM("`: Shape of 𝕨 must match the cell of 𝕩"); if (memcmp(wsh, xsh+1, wr)) thrM("`: Shape of 𝕨 must match the cell of 𝕩"); - if (ia==0) { ptr_dec(r.c); return x; } // only safe as r would have 0 items too + if (ia==0) return x; usz csz = arr_csz(x); - for (usz i = 0; i < csz; i++) r.a[i] = c2(f, wget(w,i), xget(x,i)); - for (usz i = csz; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-csz]), xget(x,i)); + for (; i < csz; i++) r.a[i] = c2(f, wget(w,i), xget(x,i)); + for (; i < ia; i++) r.a[i] = c2(f, inc(r.a[i-csz]), xget(x,i)); dec(w); } else { if (xr!=1) thrM("`: Shape of 𝕨 must match the cell of 𝕩"); - if (ia==0) { ptr_dec(r.c); return x; } - B pr = r.a[0] = c2(f, w, xget(x,0)); - for (usz i = 1; i < ia; i++) r.a[i] = pr = c2(f, inc(pr), xget(x,i)); + if (ia==0) return x; + B pr = r.a[0] = c2(f, w, xget(x,0)); i++; + for (; i < ia; i++) r.a[i] = pr = c2(f, inc(pr), xget(x,i)); } - dec(x); - return r.b; + return reuse? x : harr_fcd(r, x); } B fold_c1(B d, B x) { B f = c(Md1D,d)->f; diff --git a/src/md2.c b/src/md2.c index 8f875d5f..c95ade08 100644 --- a/src/md2.c +++ b/src/md2.c @@ -51,7 +51,7 @@ B repeat_replace(B g, B* q) { // doesn't consume if (isArr(g)) { BS2B ggetU = TI(g).getU; usz ia = a(g)->ia; - HArr_p r = m_harrc(g); + HArr_p r = m_harrUc(g); for (usz i = 0; i < ia; i++) r.a[i] = repeat_replace(ggetU(g,i), q); return r.b; } else { diff --git a/src/sfns.c b/src/sfns.c index 5301efd7..ee1c0df5 100644 --- a/src/sfns.c +++ b/src/sfns.c @@ -35,20 +35,22 @@ B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is a 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)); - else if (wr==0) { B c=wget(w, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, inc(c), xget(x,i)); dec(c); } - else if (xr==0) { B c=xget(x, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, wget(w,i), inc(c)); dec(c); } + B bo = wg? w : x; + usz ria = a(bo)->ia; + usz ri = 0; + HArr_p r = m_harrs(ria, &ri); + if (wr==xr) for(; ri < ria; ri++) r.a[ri] = f(fo, wget(w,ri), xget(x,ri)); + else if (wr==0) { B c=wget(w, 0); for(; ri < ria; ri++) r.a[ri] = f(fo, inc(c) , xget(x,ri)); dec(c); } + else if (xr==0) { B c=xget(x, 0); for(; ri < ria; ri++) r.a[ri] = f(fo, wget(w,ri), inc(c) ); dec(c); } else if (ria>0) { usz min = wg? a(x)->ia : a(w)->ia; usz ext = ria / min; - usz k = 0; - if (wg) for (usz i = 0; i < min; i++) { B c=xget(x,i); for (usz j = 0; j < ext; j++) { r.a[k] = f(fo, wget(w,k), inc(c)); k++; } } - else for (usz i = 0; i < min; i++) { B c=wget(w,i); for (usz j = 0; j < ext; j++) { r.a[k] = f(fo, inc(c), xget(x,k)); k++; } } + if (wg) for (usz i = 0; i < min; i++) { B c=xget(x,i); for (usz j = 0; j < ext; j++,ri++) r.a[ri] = f(fo, wget(w,ri), inc(c)); } + else for (usz i = 0; i < min; i++) { B c=wget(w,i); for (usz j = 0; j < ext; j++,ri++) r.a[ri] = f(fo, inc(c), xget(x,ri)); } } + B rb = harr_fc(r, bo); dec(w); dec(x); - return r.b; + return rb; } B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array usz ia = a(x)->ia; @@ -66,11 +68,10 @@ B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array for (; i < ia; i++) xp[i] = f(fo, xp[i]); return x; } else { - HArr_p rp = m_harrc(x); - rp.a[i++] = cr; - for (; i < ia; i++) rp.a[i] = f(fo, inc(xp[i])); - dec(x); - return rp.b; + rH = m_harrs(ia, &i); + rH.a[i++] = cr; + for (; i < ia; i++) rH.a[i] = f(fo, inc(xp[i])); + return harr_fcd(rH, x); } } else if (v(x)->type==t_i32arr) { i32* xp = i32arr_ptr(x); @@ -80,7 +81,7 @@ B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array for (; i < ia; i++) { cr = f(fo, m_i32(xp[i])); if (!q_i32(cr)) { - rH = m_harrc(x); + rH = m_harrs(ia, &i); for (usz j = 0; j < i; j++) rH.a[j] = m_i32(rp[j]); if (!reuse) dec(r); goto fallback; @@ -98,30 +99,29 @@ B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array for (; i < ia; i++) xp[i] = f(fo, xp[i]); return x; } else { - HArr_p rp = m_harrc(x); + HArr_p rp = m_harrs(ia, &i); rp.a[i++] = cr; for (; i < ia; i++) rp.a[i] = f(fo, inc(xp[i])); - dec(x); - return rp.b; + return harr_fcd(rp, x); } } else - rH = m_harrc(x); + rH = m_harrs(ia, &i); } else - rH = m_harrc(x); + rH = m_harrs(ia, &i); fallback: rH.a[i++] = cr; for (; i < ia; i++) rH.a[i] = f(fo, xget(x,i)); - dec(x); - return rH.b; + return harr_fcd(rH, x); } B eachm(B f, B x) { // complete F¨ x if (!isArr(x)) return m_hunit(c1(f, x)); if (isFun(f)) return eachm_fn(c(Fun,f)->c1, f, x); if (isMd(f)) if (!isArr(x) || a(x)->ia) { decR(x); thrM("Calling a modifier"); } - HArr_p r = m_harrc(x); - for(usz i = 0; i < r.c->ia; i++) r.a[i] = inc(f); + usz ia = a(x)->ia; dec(x); + HArr_p r = m_harrUv(ia); + for(usz i = 0; i < ia; i++) r.a[i] = inc(f); return r.b; } @@ -134,7 +134,7 @@ B eachd(B f, B w, B x) { // complete w F¨ x } if (isMd(f)) if ((isArr(w)&&a(w)->ia) || (isArr(x)&&a(x)->ia)) { decR(x); thrM("Calling a modifier"); } // case where both are scalars has already been taken care of - HArr_p r = m_harrc(!isArr(w)? x : rnk(w)>rnk(x)? w : x); + HArr_p r = m_harrUc(!isArr(w)? x : rnk(w)>rnk(x)? w : x); for(usz i = 0; i < r.c->ia; i++) r.a[i] = inc(f); dec(w); dec(x); return r.b; @@ -194,7 +194,7 @@ B ud_c1(B t, B x) { for (usz i = 0; i < xu; i++) pr[i] = i; return r; } - HArr_p r = m_harrv(xu); // TODO f64arr + HArr_p r = m_harrUv(xu); // TODO f64arr for (usz i = 0; i < xu; i++) r.a[i] = m_f64(i); return r.b; } @@ -226,7 +226,7 @@ B fne_c1(B t, B x) { 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); + HArr_p r = m_harrUv(xr); for (i32 j = 0; j < xr; j++) r.a[j] = m_f64(sh[j]); dec(x); return r.b; @@ -297,7 +297,7 @@ B select_c2(B t, B w, B x) { usz wia = a(w)->ia; usz xia = a(x)->ia; B xf = getFill(inc(x)); - HArr_p r = m_harrc(w); + HArr_p r = m_harrUc(w); BS2B wgetU = TI(w).getU; BS2B xget = TI(x).get; for (usz i = 0; i < wia; i++) { @@ -341,13 +341,13 @@ B slash_c1(B t, B x) { dec(x); return r; } - HArr_p r = m_harrv(s); + HArr_p r = m_harrs(s, &ri); for (usz i = 0; i < xia; i++) { usz c = o2s(xgetU(x, i)); for (usz j = 0; j < c; j++) r.a[ri++] = m_i32(i); } dec(x); - return withFill(r.b,m_f64(0)); + return withFill(harr_fv(r),m_f64(0)); } B slash_c2(B t, B w, B x) { if (isArr(w) && isArr(x) && rnk(w)==1 && rnk(x)==1 && depth(w)==1) { @@ -356,10 +356,10 @@ B slash_c2(B t, B w, B x) { B xf = getFill(inc(x)); if (wia!=xia) thrM("/: Lengths of components of 𝕨 must match 𝕩"); usz ria = isum(w); - HArr_p r = m_harrv(ria); + usz ri = 0; + HArr_p r = m_harrs(ria, &ri); BS2B wgetU = TI(w).getU; BS2B xgetU = TI(x).getU; - usz ri = 0; for (usz i = 0; i < wia; i++) { B cw = wgetU(w, i); if (isNum(cw)) { @@ -373,7 +373,7 @@ B slash_c2(B t, B w, B x) { } else { dec(cw); goto base; } } dec(w); dec(x); - return withFill(r.b,xf); + return withFill(harr_fv(r), xf); } base: return c2(rt_slash, w, x); diff --git a/src/stuff.c b/src/stuff.c index e458d989..cdd10e17 100644 --- a/src/stuff.c +++ b/src/stuff.c @@ -137,7 +137,7 @@ usz arr_csz(B x) { B VALIDATE(B x) { if (!isVal(x)) return x; VALIDATEP(v(x)); - if(isArr(x)!=TI(x).isArr && v(x)->type!=t_freed) { + if(isArr(x)!=TI(x).isArr && v(x)->type!=t_freed && v(x)->type!=t_harrPartial) { printf("wat %d %p\n", v(x)->type, (void*)x.u); print(x); err("\nk"); diff --git a/src/sysfn.c b/src/sysfn.c index 5cebcbb7..0a80798d 100644 --- a/src/sysfn.c +++ b/src/sysfn.c @@ -47,44 +47,44 @@ B fill_c2(B t, B w, B x) { // TODO not set fill for typed arrays return x; } -B grLen_c1(B t, B x) { +B grLen_c1(B t, B x) { // assumes valid arguments i64 ria = -1; usz ia = a(x)->ia; BS2B xgetU = TI(x).getU; for (usz i = 0; i < ia; i++) { - i64 c = o2i64(xgetU(x, i)); + i64 c = o2i64u(xgetU(x, i)); if (c>ria) ria = c; } ria++; - HArr_p r = m_harrv(ria); + HArr_p r = m_harrUv(ria); for (usz i = 0; i < ria; i++) r.a[i] = m_f64(0); for (usz i = 0; i < ia; i++) { - i64 n = o2i64(xgetU(x, i)); + i64 n = o2i64u(xgetU(x, i)); if (n>=0) r.a[n].f++; } dec(x); return r.b; } -B grLen_c2(B t, B w, B x) { - i64 ria = o2i64(w)-1; +B grLen_c2(B t, B w, B x) { // assumes valid arguments + i64 ria = o2i64u(w)-1; usz ia = a(x)->ia; BS2B xgetU = TI(x).getU; for (usz i = 0; i < ia; i++) { - i64 c = o2i64(xgetU(x, i)); + i64 c = o2i64u(xgetU(x, i)); if (c>ria) ria = c; } ria++; - HArr_p r = m_harrv(ria); + HArr_p r = m_harrUv(ria); for (usz i = 0; i < ria; i++) r.a[i] = m_f64(0); for (usz i = 0; i < ia; i++) { - i64 n = o2i64(xgetU(x, i)); + i64 n = o2i64u(xgetU(x, i)); if (n>=0) r.a[n].f++; } dec(x); return r.b; } -B grOrd_c2(B t, B w, B x) { +B grOrd_c2(B t, B w, B x) { // assumes valid arguments usz wia = a(w)->ia; usz xia = a(x)->ia; if (wia==0) { dec(w); dec(x); return c1(bi_ud, m_i32(0)); } @@ -93,9 +93,9 @@ B grOrd_c2(B t, B w, B x) { BS2B xgetU = TI(x).getU; usz tmp[wia]; tmp[0] = 0; - for (int i = 1; i < wia; i++) tmp[i] = tmp[i-1]+o2s(wgetU(w,i-1)); - usz ria = tmp[wia-1]+o2s(wgetU(w,wia-1)); - HArr_p r = m_harrv(ria); + for (int i = 1; i < wia; i++) tmp[i] = tmp[i-1]+o2su(wgetU(w,i-1)); + usz ria = tmp[wia-1]+o2su(wgetU(w,wia-1)); + HArr_p r = m_harrUv(ria); for (usz i = 0; i < xia; i++) { i64 c = o2i64(xgetU(x,i)); if (c>=0) r.a[tmp[c]++] = m_usz(i); @@ -144,17 +144,17 @@ static inline void sysfn_init() { bm(type) bm(decp) bm(primInd) bm(glyph) ba(fil B sys_c1(B t, B x) { assert(isArr(x)); - HArr_p r = m_harrc(x); + usz i = 0; + HArr_p r = m_harrs(a(x)->ia, &i); BS2B xgetU = TI(x).getU; - for (usz i = 0; i < a(x)->ia; i++) { + for (; i < a(x)->ia; i++) { B c = xgetU(x,i); if (eqStr(c, U"internal")) r.a[i] = inc(bi_internal); else if (eqStr(c, U"eq")) r.a[i] = inc(bi_feq); else if (eqStr(c, U"decompose")) r.a[i] = inc(bi_decp); else if (eqStr(c, U"primind")) r.a[i] = inc(bi_primInd); else if (eqStr(c, U"type")) r.a[i] = inc(bi_type); - else err("Unknown system function"); + else thrM("Unknown system function"); } - dec(x); - return r.b; + return harr_fcd(r, x); } \ No newline at end of file diff --git a/src/vm.c b/src/vm.c index 3d79c76d..a34a47b2 100644 --- a/src/vm.c +++ b/src/vm.c @@ -239,7 +239,7 @@ B v_get(Scope* sc, B s) { // get value representing s, replacing with bi_optOut; VT(s, t_harr); usz ia = a(s)->ia; B* sp = harr_ptr(s); - HArr_p r = m_harrv(ia); + HArr_p r = m_harrUv(ia); for (u64 i = 0; i < ia; i++) r.a[i] = v_get(sc, sp[i]); return r.b; } @@ -259,7 +259,7 @@ B* gStack; // points to after end B* gStackStart; B* gStackEnd; -void allocStack(u64 am) { +void gsReserve(u64 am) { u64 left = gStackEnd-gStack; if (am>left) { u64 n = gStackEnd-gStackStart + am + 500; @@ -269,6 +269,14 @@ void allocStack(u64 am) { gStackEnd = gStackStart+n; } } +NOINLINE void gsReserveR(u64 am) { gsReserve(am); } +void gsAdd(B x) { + if (gStack==gStackEnd) gsReserveR(1); + *(gStack++) = x; +} +B gsPop() { + return *--gStack; +} B evalBC(Body* b, Scope* sc) { // doesn't consume #ifdef DEBUG_VM @@ -281,7 +289,7 @@ B evalBC(Body* b, Scope* sc) { // doesn't consume B* objs = b->comp->objs->a; Block** blocks = b->comp->blocks; i32* bc = b->bc; - allocStack(b->maxStack); + gsReserve(b->maxStack); #define POP (*--gStack) #define P(N) B N=POP; #define ADD(X) { B tr=X; *(gStack++) = tr; } // if ordering is needed @@ -324,7 +332,7 @@ B evalBC(Body* b, Scope* sc) { // doesn't consume } case ARRO: case ARRM: { i32 sz = *bc++; - HArr_p r = m_harrv(sz); + HArr_p r = m_harrUv(sz); for (i32 i = 0; i < sz; i++) r.a[sz-i-1] = POP; ADD(r.b); break;