From b2b826be9b5e301bf095458b25a4840b96faae05 Mon Sep 17 00:00:00 2001 From: dzaima Date: Sun, 23 May 2021 21:48:27 +0300 Subject: [PATCH] incremental compilation --- .gitignore | 12 +- build | 4 +- buildg | 4 +- debugBuild | 4 +- genRuntime | 9 +- genRuntimeSrc | 9 +- makefile | 18 + obj/debug/makefile | 1 + obj/o3/makefile | 1 + obj/rtperf/makefile | 1 + obj/subMakefile | 45 ++ src/{ => builtins}/arith.c | 7 +- src/{ => builtins}/fns.c | 98 +-- src/{grade.c => builtins/grade.h} | 4 +- src/{ => builtins}/md1.c | 32 +- src/{ => builtins}/md2.c | 7 +- src/{ => builtins}/sfns.c | 152 +---- src/{ => builtins}/sort.c | 17 +- .../sortTemplate.h} | 0 src/{ => builtins}/sysfn.c | 13 +- src/c32arr.c | 105 --- src/core.h | 51 ++ src/core/c32arr.c | 49 ++ src/core/c32arr.h | 57 ++ src/core/derv.c | 55 ++ src/core/derv.h | 47 ++ src/core/f64arr.c | 34 + src/core/f64arr.h | 43 ++ src/{ => core}/fillarr.c | 124 +--- src/core/fillarr.h | 111 ++++ src/core/gstack.h | 45 ++ src/{ => core}/harr.c | 103 +-- src/core/harr.h | 90 +++ src/{ => core}/heap.c | 17 +- src/core/heap.h | 23 + src/core/i32arr.c | 36 ++ src/core/i32arr.h | 48 ++ src/core/mm.c | 11 + src/{ => core}/stuff.c | 598 +++++++----------- src/core/stuff.h | 261 ++++++++ src/derv.c | 91 --- src/f64arr.c | 80 --- src/gen/.gitignore | 2 + src/h.h | 425 ++++++------- src/i32arr.c | 88 --- src/load.c | 99 ++- src/main.c | 77 +-- src/mm_malloc.c | 32 - src/ns.c | 3 +- src/ns.h | 1 - src/{ => opt}/gc.c | 39 +- src/opt/gc.h | 44 ++ src/opt/mm_2buddy.c | 14 + src/{mm_2buddy.c => opt/mm_2buddy.h} | 23 +- src/opt/mm_buddy.c | 10 + src/{mm_buddy.c => opt/mm_buddy.h} | 14 +- .../mm_buddyTemplate.h} | 16 +- src/opt/mm_malloc.c | 9 + src/opt/mm_malloc.h | 33 + src/opt/single.c | 25 + src/rtPerf.c | 8 +- src/utils/each.h | 150 +++++ src/{ => utils}/file.c | 10 +- src/utils/file.h | 14 + src/utils/hash.c | 12 + src/{hash.c => utils/hash.h} | 54 +- src/{hashmap.c => utils/hashmap.h} | 6 +- src/{mut.c => utils/mut.h} | 32 +- src/{ => utils}/utf.c | 14 +- src/utils/utf.h | 9 + src/{ => utils}/wyhash.h | 0 src/vm.c | 106 +--- src/vm.h | 33 +- 73 files changed, 2095 insertions(+), 1824 deletions(-) create mode 100644 makefile create mode 120000 obj/debug/makefile create mode 120000 obj/o3/makefile create mode 120000 obj/rtperf/makefile create mode 100644 obj/subMakefile rename src/{ => builtins}/arith.c (98%) rename src/{ => builtins}/fns.c (71%) rename src/{grade.c => builtins/grade.h} (98%) rename src/{ => builtins}/md1.c (90%) rename src/{ => builtins}/md2.c (96%) rename src/{ => builtins}/sfns.c (82%) rename src/{ => builtins}/sort.c (75%) rename src/{sortTemplate.c => builtins/sortTemplate.h} (100%) rename src/{ => builtins}/sysfn.c (96%) delete mode 100644 src/c32arr.c create mode 100644 src/core.h create mode 100644 src/core/c32arr.c create mode 100644 src/core/c32arr.h create mode 100644 src/core/derv.c create mode 100644 src/core/derv.h create mode 100644 src/core/f64arr.c create mode 100644 src/core/f64arr.h rename src/{ => core}/fillarr.c (62%) create mode 100644 src/core/fillarr.h create mode 100644 src/core/gstack.h rename src/{ => core}/harr.c (68%) create mode 100644 src/core/harr.h rename src/{ => core}/heap.c (70%) create mode 100644 src/core/heap.h create mode 100644 src/core/i32arr.c create mode 100644 src/core/i32arr.h create mode 100644 src/core/mm.c rename src/{ => core}/stuff.c (51%) create mode 100644 src/core/stuff.h delete mode 100644 src/derv.c delete mode 100644 src/f64arr.c create mode 100644 src/gen/.gitignore delete mode 100644 src/i32arr.c delete mode 100644 src/mm_malloc.c rename src/{ => opt}/gc.c (74%) create mode 100644 src/opt/gc.h create mode 100644 src/opt/mm_2buddy.c rename src/{mm_2buddy.c => opt/mm_2buddy.h} (79%) create mode 100644 src/opt/mm_buddy.c rename src/{mm_buddy.c => opt/mm_buddy.h} (75%) rename src/{mm_buddyTemplate.c => opt/mm_buddyTemplate.h} (91%) create mode 100644 src/opt/mm_malloc.c create mode 100644 src/opt/mm_malloc.h create mode 100644 src/opt/single.c create mode 100644 src/utils/each.h rename src/{ => utils}/file.c (91%) create mode 100644 src/utils/file.h create mode 100644 src/utils/hash.c rename src/{hash.c => utils/hash.h} (51%) rename src/{hashmap.c => utils/hashmap.h} (97%) rename src/{mut.c => utils/mut.h} (90%) rename src/{ => utils}/utf.c (82%) create mode 100644 src/utils/utf.h rename src/{ => utils}/wyhash.h (100%) diff --git a/.gitignore b/.gitignore index 14a69ef7..3f6eee7a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,10 +1,6 @@ -main.s BQN -src/runtime -src/runtime0 -src/runtime1 -src/compiler -src/interp -src/formatter c.bqn -perf.* \ No newline at end of file +perf.* +obj/*/*.o +obj/*/*.d +obj/*/*.tmp diff --git a/build b/build index 12a7b53c..2c8c67e1 100755 --- a/build +++ b/build @@ -1,3 +1,3 @@ #!/usr/bin/env bash -clang -std=gnu11 -O3 -Wall -Wno-microsoft-anon-tag -fms-extensions $@ -o BQN src/main.c -lm -# gcc -std=gnu11 -O3 -Wall -Wno-parentheses -Wno-misleading-indentation -fms-extensions $@ -o BQN src/main.c -lm +clang -std=gnu11 -O3 -Wall -Wno-microsoft-anon-tag -Wno-unused-function -fms-extensions $@ -o BQN src/opt/single.c -lm +# gcc -std=gnu11 -O3 -Wall -Wno-parentheses -Wno-misleading-indentation -Wno-unused-function -fms-extensions $@ -o BQN src/opt/single.c -lm diff --git a/buildg b/buildg index 7a6257a3..3460e8b0 100755 --- a/buildg +++ b/buildg @@ -1,3 +1,3 @@ #!/usr/bin/env bash -clang -std=gnu11 -O3 -g -Wall -Wno-microsoft-anon-tag -fms-extensions -fno-omit-frame-pointer $@ -o BQN src/main.c -lm -# gcc -std=gnu11 -O3 -g -Wall -Wno-parentheses -Wno-misleading-indentation -fms-extensions -fno-omit-frame-pointer $@ -o BQN src/main.c -lm +clang -std=gnu11 -O3 -g -Wall -Wno-microsoft-anon-tag -fms-extensions -Wno-unused-function -fno-omit-frame-pointer $@ -o BQN src/opt/single.c -lm +# gcc -std=gnu11 -O3 -g -Wall -Wno-parentheses -Wno-misleading-indentation -Wno-unused-function -fms-extensions -fno-omit-frame-pointer $@ -o BQN src/opt/single.c -lm diff --git a/debugBuild b/debugBuild index a169c201..75891ecf 100755 --- a/debugBuild +++ b/debugBuild @@ -1,3 +1,3 @@ #!/usr/bin/env bash -clang -DDEBUG -std=gnu11 -g -Wall -Wno-microsoft-anon-tag -fms-extensions $@ -o BQN src/main.c -lm -# gcc -DDEBUG -std=gnu11 -g -Wall -Wno-parentheses -Wno-misleading-indentation -fms-extensions $@ -o BQN src/main.c -lm +clang -DDEBUG -std=gnu11 -g -Wall -Wno-microsoft-anon-tag -Wno-unused-function -fms-extensions $@ -o BQN src/opt/single.c -lm +# gcc -DDEBUG -std=gnu11 -g -Wall -Wno-parentheses -Wno-misleading-indentation -Wno-unused-function -fms-extensions $@ -o BQN src/opt/single.c -lm diff --git a/genRuntime b/genRuntime index e2217c8c..910165a7 100755 --- a/genRuntime +++ b/genRuntime @@ -3,7 +3,8 @@ args←•args "Usage: ./getRuntime.bqn path/to/mlochbaum/BQN"!1≤≠args path←⊑•args CC ← {𝕨 •FChars ⟨1,path,𝕩⟩ •Import "cc.bqn"} - "src/runtime0"CC"r0" - "src/runtime1"CC"r1" - "src/compiler"CC"c" -"src/formatter"CC"f" +"src/gen/src" •FChars "#define RT_SRC 0"∾@+10 + "src/gen/compiler"CC"c" + "src/gen/runtime0"CC"r0" + "src/gen/runtime1"CC"r1" +"src/gen/formatter"CC"f" diff --git a/genRuntimeSrc b/genRuntimeSrc index a296a11f..fd919f03 100755 --- a/genRuntimeSrc +++ b/genRuntimeSrc @@ -3,7 +3,8 @@ args←•args "Usage: ./getRuntime.bqn path/to/mlochbaum/BQN"!1≤≠args path←⊑•args CC ← {𝕨 •FChars ⟨1,path,"-i",𝕩⟩ •Import "cc.bqn"} - "src/runtime0"CC"r0" - "src/runtime1"CC"r1" - "src/compiler"CC"c" -"src/formatter"CC"f" +"src/gen/src" •FChars "#define RT_SRC 1"∾@+10 + "src/gen/compiler"CC"c" + "src/gen/runtime0"CC"r0" + "src/gen/runtime1"CC"r1" +"src/gen/formatter"CC"f" diff --git a/makefile b/makefile new file mode 100644 index 00000000..afee04a1 --- /dev/null +++ b/makefile @@ -0,0 +1,18 @@ +MAKEFLAGS=--no-print-directory +J=-j4 + +o3: + @$(MAKE) $(J) -C obj/o3 o3 +debug: + @$(MAKE) -C obj/debug debug +rtperf: + @$(MAKE) $(J) -C obj/rtperf rtperf + +o3-clean: + @$(MAKE) -C obj/o3 clean +debug-clean: + @$(MAKE) -C obj/debug clean +rtperf-clean: + @$(MAKE) -C obj/rtperf clean + +clean: o3-clean debug-clean rtperf-clean diff --git a/obj/debug/makefile b/obj/debug/makefile new file mode 120000 index 00000000..9b4ecaa6 --- /dev/null +++ b/obj/debug/makefile @@ -0,0 +1 @@ +/home/dzaima/CLionProjects/bqn/obj/subMakefile \ No newline at end of file diff --git a/obj/o3/makefile b/obj/o3/makefile new file mode 120000 index 00000000..9b4ecaa6 --- /dev/null +++ b/obj/o3/makefile @@ -0,0 +1 @@ +/home/dzaima/CLionProjects/bqn/obj/subMakefile \ No newline at end of file diff --git a/obj/rtperf/makefile b/obj/rtperf/makefile new file mode 120000 index 00000000..9b4ecaa6 --- /dev/null +++ b/obj/rtperf/makefile @@ -0,0 +1 @@ +/home/dzaima/CLionProjects/bqn/obj/subMakefile \ No newline at end of file diff --git a/obj/subMakefile b/obj/subMakefile new file mode 100644 index 00000000..55d68699 --- /dev/null +++ b/obj/subMakefile @@ -0,0 +1,45 @@ +CC=clang +CCFLAGS=-Wno-microsoft-anon-tag +# CC=gcc +# CCFLAGS=-Wno-parentheses + +CMD=$(CC) -std=gnu11 -Wall -Wno-unused-function -fms-extensions ${CCFLAGS} $(FLAGS) -fPIE -MMD -MP -MF + +o3: FLAGS=-O3 +o3: gen +debug: FLAGS=-g -DDEBUG +debug: gen +rtperf: FLAGS=-O3 -DRT_PERF +rtperf: gen + +gen: builtins core base utils + @$(CC) -o BQN *.o -lm + @mv BQN ../../BQN + @echo + +core: i32arr.o c32arr.o f64arr.o harr.o fillarr.o stuff.o derv.o mm.o heap.o +%.o: ../../src/core/%.c + @echo $< | cut -c 11- + @$(CMD) $@.d -c $< + +base: load.o main.o rtPerf.o vm.o ns.o +%.o: ../../src/%.c + @echo $< | cut -c 11- + @$(CMD) $@.d -c $< + +utils: utf.o hash.o file.o +%.o: ../../src/utils/%.c + @echo $< | cut -c 11- + @$(CMD) $@.d -c $< + +builtins: arith.o sfns.o sort.o md1.o md2.o fns.o sysfn.o +%.o: ../../src/builtins/%.c + @echo $< | cut -c 11- + @$(CMD) $@.d -c $< + +-include *.d + + +clean: + @rm -f *.o + @rm -f *.d diff --git a/src/arith.c b/src/builtins/arith.c similarity index 98% rename from src/arith.c rename to src/builtins/arith.c index 3578ad0d..57dfdf23 100644 --- a/src/arith.c +++ b/src/builtins/arith.c @@ -1,4 +1,5 @@ -#include "h.h" +#include "../core.h" +#include "../utils/each.h" #include static inline B arith_recm(BB2B f, B x) { @@ -199,13 +200,13 @@ B ne_c1(B t, B x) { B r = m_f64(isArr(x)&&rnk(x)? *a(x)->sh : 1); decR(x); retur B rt_sortDsc; B or_c1(B t, B x) { return c1(rt_sortDsc, x); } +B and_c1(B t, B x); // defined in sort.c #undef P1 #undef P2 #define F(A,M,D) A(add) A(sub) A(mul) A(div) A(pow) A(floor) A(ceil) A(stile) A(eq) A(ne) D(le) D(ge) A(lt) A(gt) A(and) A(or) A(not) A(log) -BI_FNS0(F); -static inline void arith_init() { BI_FNS1(F) +void arith_init() { BI_FNS(F) c(BFn,bi_add)->ident = c(BFn,bi_sub)->ident = c(BFn,bi_or )->ident = c(BFn,bi_ne)->ident = c(BFn,bi_gt)->ident = m_i32(0); c(BFn,bi_mul)->ident = c(BFn,bi_div)->ident = c(BFn,bi_and)->ident = c(BFn,bi_eq)->ident = c(BFn,bi_ge)->ident = c(BFn,bi_pow)->ident = c(BFn,bi_not)->ident = m_i32(1); c(BFn,bi_floor)->ident = m_f64(1.0/0.0); diff --git a/src/fns.c b/src/builtins/fns.c similarity index 71% rename from src/fns.c rename to src/builtins/fns.c index 4646e3f9..7268f7c0 100644 --- a/src/fns.c +++ b/src/builtins/fns.c @@ -1,11 +1,7 @@ -#include "h.h" +#include "../core.h" +#include "../utils/hash.h" +#include "../utils/mut.h" -typedef struct BFn { - struct Fun; - B ident; - BBB2B uc1; - BBBB2B ucw; -} BFn; void print_funBI(B x) { printf("%s", format_pf(c(Fun,x)->extra)); } B funBI_uc1(B t, B o, B x) { return c(BFn,t)->uc1(t, o, x); } @@ -13,53 +9,6 @@ B funBI_ucw(B t, B o, B w, B x) { return c(BFn,t)->ucw(t, o, w, x); } B funBI_identity(B x) { return inc(c(BFn,x)->ident); } -B bqn_merge(B x) { - assert(isArr(x)); - usz xia = a(x)->ia; - ur xr = rnk(x); - if (xia==0) { - B xf = getFillE(x); - if (isAtm(xf)) { dec(xf); return x; } - i32 xfr = rnk(xf); - B xff = getFillQ(xf); - B r = m_fillarrp(0); - fillarr_setFill(r, xff); - if (xr+xfr > UR_MAX) thrM(">: Result rank too large"); - usz* rsh = arr_shAllocI(r, 0, xr+xfr); - if (rsh) { - memcpy (rsh , a(x)->sh, xr *sizeof(usz)); - if(xfr)memcpy(rsh+xr, a(xf)->sh, xfr*sizeof(usz)); - } - return r; - } - - BS2B xgetU = TI(x).getU; - B x0 = xgetU(x, 0); - usz* elSh = isArr(x0)? a(x0)->sh : NULL; - ur elR = isArr(x0)? rnk(x0) : 0; - usz elIA = isArr(x0)? a(x0)->ia : 1; - B fill = getFillQ(x0); - if (xr+elR > UR_MAX) thrM(">: Result rank too large"); - - MAKE_MUT(r, xia*elIA); - usz rp = 0; - for (usz i = 0; i < xia; i++) { - B c = xgetU(x, i); - if (isArr(c)? (elR!=rnk(c) || !eqShPrefix(elSh, a(c)->sh, elR)) : elR!=0) { mut_pfree(r, rp); thrF(">: Elements didn't have equal shapes (contained %H and %H)", x0, c); } - if (isArr(c)) mut_copy(r, rp, c, 0, elIA); - else mut_set(r, rp, c); - if (!noFill(fill)) fill = fill_or(fill, getFillQ(c)); - rp+= elIA; - } - B rb = mut_fp(r); - usz* rsh = arr_shAllocR(rb, xr+elR); - if (rsh) { - memcpy (rsh , a(x)->sh, xr *sizeof(usz)); - if (elSh)memcpy(rsh+xr, elSh, elR*sizeof(usz)); - } - dec(x); - return withFill(rb,fill); -} void ud_rec(B** p, usz d, usz r, usz* pos, usz* sh) { @@ -148,24 +97,6 @@ B fmtF_c1(B t, B x) { return m_c32(U"+-×÷⋆√⌊⌈|¬∧∨<>≠=≤≥≡≢⊣⊢⥊∾≍↑↓↕«»⌽⍉/⍋⍒⊏⊑⊐⊒∊⍷⊔!˙˜˘¨⌜⁼´˝`∘○⊸⟜⌾⊘◶⎉⚇⍟⎊"[fl-1]); } -i64 isum(B x) { // doesn't consume; may error; TODO error on overflow - assert(isArr(x)); - i64 r = 0; - usz xia = a(x)->ia; - u8 xe = TI(x).elType; - if (xe==el_i32) { - i32* p = i32any_ptr(x); - for (usz i = 0; i < xia; i++) r+= p[i]; - } else if (xe==el_f64) { - f64* p = f64any_ptr(x); - for (usz i = 0; i < xia; i++) { if(p[i]!=(f64)p[i]) thrM("Expected integer"); r+= p[i]; } - } else { - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < xia; i++) r+= o2i64(xgetU(x,i)); - } - return r; -} - B fne_c1(B t, B x) { if (isArr(x)) { @@ -187,18 +118,6 @@ B fne_c1(B t, B x) { return inc(bi_emptyIVec); } } -u64 depth(B x) { // doesn't consume - if (isAtm(x)) return 0; - if (TI(x).arrD1) return 1; - u64 r = 0; - usz ia = a(x)->ia; - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) { - u64 n = depth(xgetU(x,i)); - if (n>r) r = n; - } - return r+1; -} B feq_c1(B t, B x) { u64 r = depth(x); dec(x); @@ -363,17 +282,10 @@ B count_c2(B t, B w, B x) { -#define BI_A(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=N##_c2 ; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(t); } -#define BI_D(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=N##_c2 ; f->c1=c1_invalid; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(t); } -#define BI_M(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=c2_invalid; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(t); } -#define BI_VAR(N) B bi_##N; -#define BI_FNS0(F) F(BI_VAR,BI_VAR,BI_VAR) -#define BI_FNS1(F) F(BI_A,BI_M,BI_D) -#define F(A,M,D) A(ud) A(fne) A(feq) A(ltack) A(rtack) M(fmtF) A(indexOf) A(memberOf) A(find) A(count) -BI_FNS0(F); -static inline void fns_init() { BI_FNS1(F) +#define F(A,M,D) A(ud) A(pair) A(fne) A(feq) A(ltack) A(rtack) M(fmtF) A(indexOf) A(memberOf) A(find) A(count) +void fns_init() { BI_FNS(F) ti[t_funBI].print = print_funBI; ti[t_funBI].identity = funBI_identity; ti[t_funBI].fn_uc1 = funBI_uc1; diff --git a/src/grade.c b/src/builtins/grade.h similarity index 98% rename from src/grade.c rename to src/builtins/grade.h index 183bc8e9..a0f9ff38 100644 --- a/src/grade.c +++ b/src/builtins/grade.h @@ -3,12 +3,12 @@ #define SORT_CMP(W, X) GRADE_NEG compare((W).k, (X).k) #define SORT_NAME GRADE_CAT(BP) #define SORT_TYPE BI32p -#include "sortTemplate.c" +#include "sortTemplate.h" #define SORT_CMP(W, X) (GRADE_NEG ((W).k - (i64)(X).k)) #define SORT_NAME GRADE_CAT(IP) #define SORT_TYPE I32I32p -#include "sortTemplate.c" +#include "sortTemplate.h" B GRADE_CAT(c1)(B t, B x) { if (isAtm(x) || rnk(x)==0) thrM(GRADE_CHR": Argument cannot be a unit"); diff --git a/src/md1.c b/src/builtins/md1.c similarity index 90% rename from src/md1.c rename to src/builtins/md1.c index fe47b751..5390fe0d 100644 --- a/src/md1.c +++ b/src/builtins/md1.c @@ -1,26 +1,10 @@ -#include "h.h" +#include "../core.h" +#include "../utils/each.h" +#include "../utils/file.h" -bool isPureFn(B x) { // doesn't consume - if (isCallable(x)) { - if (v(x)->flags) return true; - B2B dcf = TI(x).decompose; - B xd = dcf(inc(x)); - B* xdp = harr_ptr(xd); - i32 t = o2iu(xdp[0]); - if (t<2) { dec(xd); return t==0; } - usz xdia = a(xd)->ia; - for (i32 i = 1; iia; - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) if (!isPureFn(xgetU(x,i))) return false; - return true; - } else return isNum(x) || isC32(x); -} -B homFil1(B f, B r, B xf) { +static B homFil1(B f, B r, B xf) { assert(EACH_FILLS); if (isPureFn(f)) { if (f.u==bi_eq.u || f.u==bi_ne.u || f.u==bi_feq.u) { dec(xf); return tag(toI32Arr(r), ARR_TAG); } // ≠ may return ≥2⋆31, but whatever, this thing is stupid anyway @@ -35,7 +19,7 @@ B homFil1(B f, B r, B xf) { dec(xf); return r; } -B homFil2(B f, B r, B wf, B xf) { +static B homFil2(B f, B r, B wf, B xf) { assert(EACH_FILLS); if (isPureFn(f)) { if (f.u==bi_feq.u || f.u==bi_fne.u) { dec(wf); dec(xf); return tag(toI32Arr(r), ARR_TAG); } @@ -381,10 +365,10 @@ B cell_c2(B d, B w, B x) { B f = c(Md1D,d)->f; #define bd(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = NAME##_c2; c(Md1,bi_##NAME)->c1 = c1_invalid; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME); #define bm(NAME) bi_##NAME = mm_alloc(sizeof(Md1), t_md1BI, ftag(MD1_TAG)); c(Md1,bi_##NAME)->c2 = c2_invalid;c(Md1,bi_##NAME)->c1 = NAME##_c1 ; c(Md1,bi_##NAME)->extra=pm1_##NAME; gc_add(bi_##NAME); -void print_md1BI(B x) { printf("%s", format_pm1(c(Md1,x)->extra)); } +static void print_md1BI(B x) { printf("%s", format_pm1(c(Md1,x)->extra)); } -B bi_tbl, bi_each, bi_fold, bi_scan, bi_const, bi_swap, bi_cell, bi_timed, bi_fchars, bi_fbytes, bi_flines, bi_import; -static inline void md1_init() { ba(tbl) ba(each) ba(fold) ba(scan) ba(const) ba(swap) ba(cell) ba(timed) ba(fchars) bm(fbytes) bm(flines) ba(import) +B bi_tbl, bi_each, bi_fold, bi_scan, bi_const, bi_swap, bi_cell, bi_timed, bi_fchars, bi_fbytes, bi_flines, bi_import; +void md1_init() { ba(tbl) ba(each) ba(fold) ba(scan) ba(const) ba(swap) ba(cell) ba(timed) ba(fchars) bm(fbytes) bm(flines) ba(import) ti[t_md1BI].print = print_md1BI; } diff --git a/src/md2.c b/src/builtins/md2.c similarity index 96% rename from src/md2.c rename to src/builtins/md2.c index 76adc409..72b24304 100644 --- a/src/md2.c +++ b/src/builtins/md2.c @@ -1,4 +1,4 @@ -#include "h.h" +#include "../core.h" typedef struct BMd2 { struct Md1; @@ -160,13 +160,12 @@ B before_uc1(B t, B o, B f, B g, B x) { #define bd(N) { B t=bi_##N=mm_alloc(sizeof(BMd2), t_md2BI, ftag(MD2_TAG)); BMd2*m=c(BMd2,t); m->c2 = N##_c2 ; m->c1 = c1_invalid; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(t); } #define bm(N) { B t=bi_##N=mm_alloc(sizeof(BMd2), t_md2BI, ftag(MD2_TAG)); BMd2*m=c(BMd2,t); m->c2 = c2_invalid; m->c1 = N##_c1; m->extra=pm2_##N; m->uc1=def_m2_uc1; m->ucw=def_m2_ucw; gc_add(t); } -B bi_val, bi_repeat, bi_atop, bi_over, bi_before, bi_after, bi_cond, bi_fillBy, bi_under, bi_catch; -static inline void md2_init() { ba(val) ba(repeat) ba(atop) ba(over) ba(before) ba(after) ba(cond) ba(fillBy) ba(under) ba(catch) +B bi_val, bi_repeat, bi_atop, bi_over, bi_before, bi_after, bi_cond, bi_fillBy, bi_under, bi_catch; +void md2_init() { ba(val) ba(repeat) ba(atop) ba(over) ba(before) ba(after) ba(cond) ba(fillBy) ba(under) ba(catch) ti[t_md2BI].print = print_md2BI; ti[t_md2BI].m2_uc1 = md2BI_uc1; ti[t_md2BI].m2_ucw = md2BI_ucw; c(BMd2,bi_before)->uc1 = before_uc1; - } #undef ba diff --git a/src/sfns.c b/src/builtins/sfns.c similarity index 82% rename from src/sfns.c rename to src/builtins/sfns.c index f8cd81f4..ef6775e0 100644 --- a/src/sfns.c +++ b/src/builtins/sfns.c @@ -1,149 +1,8 @@ -#include "h.h" +#include "../core.h" +#include "../utils/each.h" +#include "../utils/mut.h" -static inline B mv(B* p, usz n) { B r = p [n]; p [n] = m_f64(0); return r; } -static inline B hmv(HArr_p p, usz n) { B r = p.a[n]; p.a[n] = m_f64(0); return r; } -B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is array - if (isAtm(w)) w = m_atomUnit(w); - if (isAtm(x)) x = m_atomUnit(x); - ur wr = rnk(w); BS2B wget = TI(w).get; - ur xr = rnk(x); BS2B xget = TI(x).get; - bool wg = wr>xr; - ur rM = wg? wr : xr; - ur rm = wg? xr : wr; - if (rM==0) { - B r = f(fo, wget(w,0), xget(x,0)); - dec(w); dec(x); - return m_hunit(r); - } - if (rm && !eqShPrefix(a(w)->sh, a(x)->sh, rm)) thrF("Mapping: Expected equal shape prefix (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x); - 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), hmv(r,i)); dec(c); } - else if (xr==0) { B c=xget(x, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, hmv(r,i), inc(c) ); dec(c); } - else { - assert(wr==xr); - if (rw) for (usz i = 0; i < ria; i++) r.a[i] = f(fo, hmv(r,i), xget(x,i)); - else for (usz i = 0; i < ria; i++) r.a[i] = f(fo, wget(w,i), hmv(r,i)); - } - dec(rw? x : w); - return r.b; - } - - 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; - 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 rb; -} -B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array - usz ia = a(x)->ia; - if (ia==0) return x; - BS2B xget = TI(x).get; - usz i = 0; - B cr = f(fo, xget(x,0)); - HArr_p rH; - if (TI(x).canStore(cr)) { - bool reuse = reusable(x); - if (v(x)->type==t_harr) { - B* xp = harr_ptr(x); - if (reuse) { - dec(xp[i]); xp[i++] = cr; - for (; i < ia; i++) xp[i] = f(fo, mv(xp,i)); - return x; - } else { - 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 (TI(x).elType==el_i32) { - i32* xp = i32any_ptr(x); - B r; i32* rp; - if (reuse && v(x)->type==t_i32arr) { r=x; rp = xp; } - else r = m_i32arrc(&rp, x); - rp[i++] = o2iu(cr); - for (; i < ia; i++) { - cr = f(fo, m_i32(xp[i])); - if (!q_i32(cr)) { - 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; - } - rp[i] = o2iu(cr); - } - if (!reuse) dec(x); - return r; - } else if (TI(x).elType==el_f64) { - f64* xp = f64any_ptr(x); - B r; f64* rp; - if (reuse && v(x)->type==t_f64arr) { r=x; rp = xp; } - else r = m_f64arrc(&rp, x); - rp[i++] = o2fu(cr); - for (; i < ia; i++) { - cr = f(fo, m_f64(xp[i])); - if (!q_f64(cr)) { - rH = m_harrs(ia, &i); - for (usz j = 0; j < i; j++) rH.a[j] = m_f64(rp[j]); - if (!reuse) dec(r); - goto fallback; - } - rp[i] = o2fu(cr); - } - if (!reuse) dec(x); - return r; - } else if (v(x)->type==t_fillarr) { - B* xp = fillarr_ptr(x); - if (reuse) { - dec(c(FillArr,x)->fill); - c(FillArr,x)->fill = bi_noFill; - dec(xp[i]); xp[i++] = cr; - for (; i < ia; i++) xp[i] = f(fo, mv(xp,i)); - return x; - } else { - HArr_p rp = m_harrs(ia, &i); - rp.a[i++] = cr; - for (; i < ia; i++) rp.a[i] = f(fo, inc(xp[i])); - return harr_fcd(rp, x); - } - } else - rH = m_harrs(ia, &i); - } else - rH = m_harrs(ia, &i); - fallback: - rH.a[i++] = cr; - for (; i < ia; i++) rH.a[i] = f(fo, xget(x,i)); - return harr_fcd(rH, x); -} -B eachm(B f, B x) { // complete F¨ x without fills - if (isAtm(x)) return m_hunit(c1(f, x)); - if (isFun(f)) return eachm_fn(c(Fun,f)->c1, f, x); - if (isMd(f)) if (isAtm(x) || a(x)->ia) { decR(x); thrM("Calling a modifier"); } - - usz ia = a(x)->ia; - MAKE_MUT(r, ia); - mut_fill(r, 0, f, ia); - return mut_fcd(r, x); -} -B eachd(B f, B w, B x) { // complete w F¨ x without fills - if (isAtm(w) & isAtm(x)) return m_hunit(c2(f, w, x)); - return eachd_fn(c2fn(f), f, w, x); -} B shape_c1(B t, B x) { if (isAtm(x)) thrM("⥊: deshaping non-array"); usz ia = a(x)->ia; @@ -948,9 +807,8 @@ B select_ucw(B t, B o, B w, B x) { } -#define F(A,M,D) A(shape) A(pick) A(pair) A(select) A(slash) A(join) A(couple) A(shiftb) A(shifta) A(take) A(drop) A(group) A(reverse) -BI_FNS0(F); -static inline void sfns_init() { BI_FNS1(F) +#define F(A,M,D) A(shape) A(pick) A(select) A(slash) A(join) A(couple) A(shiftb) A(shifta) A(take) A(drop) A(group) A(reverse) +void sfns_init() { BI_FNS(F) c(BFn,bi_pick)->uc1 = pick_uc1; c(BFn,bi_reverse)->uc1 = reverse_uc1; c(BFn,bi_pick)->ucw = pick_ucw; diff --git a/src/sort.c b/src/builtins/sort.c similarity index 75% rename from src/sort.c rename to src/builtins/sort.c index 16affe05..63309187 100644 --- a/src/sort.c +++ b/src/builtins/sort.c @@ -1,4 +1,5 @@ -#include "h.h" +#include "../core.h" + #define CAT0(A,B) A##_##B @@ -9,27 +10,24 @@ typedef struct I32I32p { i32 k; i32 v; } I32I32p; #define GRADE_UD(U,D) U #define GRADE_NEG #define GRADE_CHR "⍋" -#include "grade.c" +#include "grade.h" #define GRADE_UD(U,D) D #define GRADE_NEG - #define GRADE_CHR "⍒" -#include "grade.c" +#include "grade.h" #define SORT_CMP(W, X) compare(W, X) #define SORT_NAME b #define SORT_TYPE B -#include "sortTemplate.c" +#include "sortTemplate.h" #define SORT_CMP(W, X) ((W) - (i64)(X)) #define SORT_NAME i #define SORT_TYPE i32 -#include "sortTemplate.c" +#include "sortTemplate.h" -int sort_icmp(const void* w, const void* x) { return *(int*)w - *(int*)x; } -int sort_bcmp(const void* w, const void* x) { return compare(*(B*)w, *(B*)x); } -B rt_sortAsc; B and_c1(B t, B x) { if (isAtm(x) || rnk(x)==0) thrM("∧: Argument cannot have rank 0"); if (rnk(x)!=1) return bqn_merge(and_c1(t, toCells(x))); @@ -52,6 +50,5 @@ B and_c1(B t, B x) { } #define F(A,M,D) A(gradeUp) A(gradeDown) -BI_FNS0(F); -static inline void sort_init() { BI_FNS1(F) } +void sort_init() { BI_FNS(F) } #undef F diff --git a/src/sortTemplate.c b/src/builtins/sortTemplate.h similarity index 100% rename from src/sortTemplate.c rename to src/builtins/sortTemplate.h diff --git a/src/sysfn.c b/src/builtins/sysfn.c similarity index 96% rename from src/sysfn.c rename to src/builtins/sysfn.c index c286a10a..ac4b0807 100644 --- a/src/sysfn.c +++ b/src/builtins/sysfn.c @@ -1,4 +1,6 @@ -#include "h.h" +#include "../core.h" +#include "../utils/hash.h" +#include "../utils/file.h" B type_c1(B t, B x) { i32 r = -1; @@ -20,12 +22,11 @@ B decp_c1(B t, B x) { return TI(x).decompose(x); } -usz runtimeLen; B primInd_c1(B t, B x) { - if (!isVal(x)) return m_i32(runtimeLen); + if (!isVal(x)) return m_i32(rtLen); if (v(x)->flags) { B r = m_i32(v(x)->flags-1); dec(x); return r; } dec(x); - return m_i32(runtimeLen); + return m_i32(rtLen); } B glyph_c1(B t, B x) { @@ -190,15 +191,13 @@ B hash_c1(B t, B x) { #define F(A,M,D) M(type) M(decp) M(primInd) M(glyph) M(repr) A(fill) A(grLen) D(grOrd) A(asrt) M(out) M(show) M(sys) M(bqn) D(cmp) D(internal) A(hash) -BI_FNS0(F); -static inline void sysfn_init() { BI_FNS1(F) } +void sysfn_init() { BI_FNS(F) } #undef F static B makeRel(B md) { // doesn't consume return m1_d(inc(md), path_dir(inc(comp_currPath))); } -B bi_timed, bi_fchars, bi_fbytes, bi_flines, bi_import; B sys_c1(B t, B x) { assert(isArr(x)); usz i = 0; diff --git a/src/c32arr.c b/src/c32arr.c deleted file mode 100644 index 980d0c3e..00000000 --- a/src/c32arr.c +++ /dev/null @@ -1,105 +0,0 @@ -#include "h.h" - -typedef struct C32Arr { - struct Arr; - u32 a[]; -} C32Arr; - - -B m_c32arrv(u32** p, usz ia) { - C32Arr* r = mm_allocN(fsizeof(C32Arr,a,u32,ia), t_c32arr); B rb = tag(r, ARR_TAG); - *p = r->a; - arr_shVec(rb, ia); - return rb; -} -B m_c32arrc(u32** p, B x) { assert(isArr(x)); - C32Arr* r = mm_allocN(fsizeof(C32Arr,a,u32,a(x)->ia), t_c32arr); B rb = tag(r, ARR_TAG); - *p = r->a; - arr_shCopy(rb, x); - return rb; -} -B m_c32arrp(u32** p, usz ia) { // doesn't write shape/rank - C32Arr* r = mm_allocN(fsizeof(C32Arr,a,u32,ia), t_c32arr); - *p = r->a; - r->ia = ia; - return tag(r, ARR_TAG); -} - - -typedef struct C32Slice { - struct Slice; - u32* a; -} C32Slice; -B m_c32slice(B p, u32* ptr) { - C32Slice* r = mm_allocN(sizeof(C32Slice), t_c32slice); - r->p = p; - r->a = ptr; - return tag(r, ARR_TAG); -} - - -u32* c32arr_ptr(B x) { VTY(x, t_c32arr); return c(C32Arr,x)->a; } -u32* c32any_ptr(B x) { assert(isArr(x)); u8 t=v(x)->type; if(t==t_c32arr) return c(C32Arr,x)->a; assert(t==t_c32slice); return c(C32Slice,x)->a; } - -B m_str8(usz sz, char* s) { - u32* rp; B r = m_c32arrv(&rp, sz); - for (u64 i = 0; i < sz; i++) rp[i] = (u32)s[i]; - return r; -} -B m_str8l(char* s) { - usz sz = strlen(s); - u32* rp; B r = m_c32arrv(&rp, sz); - for (u64 i = 0; i < sz; i++) rp[i] = (u32)s[i]; - return r; -} - -NOINLINE B m_str32(u32* s) { - usz sz = 0; while(s[sz]) sz++; - u32* rp; B r = m_c32arrv(&rp, sz); - for (usz i = 0; i < sz; i++) rp[i] = s[i]; - return r; -} -C32Arr* toC32Arr(B x) { - if (v(x)->type==t_c32arr) return c(C32Arr,x); - u32* rp; B r = m_c32arrc(&rp, x); - usz ia = a(r)->ia; - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) rp[i] = o2c(xgetU(x,i)); - dec(x); - return c(C32Arr,r); -} -bool eqStr(B w, u32* x) { - if (isAtm(w) || rnk(w)!=1) return false; - BS2B wgetU = TI(w).getU; - u64 i = 0; - while (x[i]) { - B c = wgetU(w, i); - if (!isC32(c) || x[i]!=(u32)c.u) return false; - i++; - } - return i==a(w)->ia; -} - - -B c32arr_slice (B x, usz s) {return m_c32slice(x , c(C32Arr ,x)->a+s); } -B c32slice_slice(B x, usz s) { B r = m_c32slice(inc(c(Slice,x)->p), c(C32Slice,x)->a+s); dec(x); return r; } - -B c32arr_get (B x, usz n) { VTY(x,t_c32arr ); return m_c32(c(C32Arr ,x)->a[n]); } -B c32slice_get(B x, usz n) { VTY(x,t_c32slice); return m_c32(c(C32Slice,x)->a[n]); } -void c32arr_free(Value* x) { decSh(x); } -bool c32arr_canStore(B x) { return isC32(x); } - -static inline void c32arr_init() { - ti[t_c32arr].get = c32arr_get; ti[t_c32slice].get = c32slice_get; - ti[t_c32arr].getU = c32arr_get; ti[t_c32slice].getU = c32slice_get; - ti[t_c32arr].slice = c32arr_slice; ti[t_c32slice].slice = c32slice_slice; - ti[t_c32arr].free = c32arr_free; ti[t_c32slice].free = slice_free; - ti[t_c32arr].visit = noop_visit; ti[t_c32slice].visit = slice_visit; - ti[t_c32arr].print = arr_print; ti[t_c32slice].print = arr_print; - ti[t_c32arr].isArr = true; ti[t_c32slice].isArr = true; - ti[t_i32arr].arrD1 = true; ti[t_i32slice].arrD1 = true; - ti[t_c32arr].elType = el_c32; ti[t_c32slice].elType = el_c32; - ti[t_c32arr].canStore = c32arr_canStore; - u32* tmp; bi_emptyCVec = m_c32arrv(&tmp, 0); - gc_add(bi_emptyCVec); -} diff --git a/src/core.h b/src/core.h new file mode 100644 index 00000000..e84728d9 --- /dev/null +++ b/src/core.h @@ -0,0 +1,51 @@ +#pragma once +#include "h.h" +#include "core/stuff.h" +#include "core/heap.h" + +#if MM==0 + #include "opt/mm_malloc.h" +#elif MM==1 + #include "opt/mm_buddy.h" +#elif MM==2 + #include "opt/mm_2buddy.h" +#else + #error bad MM value +#endif + +#include "core/gstack.h" +#include "core/harr.h" +#include "core/f64arr.h" +#include "core/i32arr.h" +#include "core/c32arr.h" +#include "core/fillarr.h" +#include "core/derv.h" + +typedef struct BFn { + struct Fun; + B ident; + BBB2B uc1; + BBBB2B ucw; +} BFn; +#define BI_A(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=N##_c2 ; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(t); } +#define BI_D(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=N##_c2 ; f->c1=c1_invalid; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(t); } +#define BI_M(N) { B t=bi_##N = mm_alloc(sizeof(BFn), t_funBI, ftag(FUN_TAG)); BFn*f=c(BFn,t); f->c2=c2_invalid; f->c1=N##_c1 ; f->extra=pf_##N; f->ident=bi_N; f->uc1=def_fn_uc1; f->ucw=def_fn_ucw; gc_add(t); } +#define BI_FNS(F) F(BI_A,BI_M,BI_D) + +static i64 isum(B x) { // doesn't consume; may error; TODO error on overflow + assert(isArr(x)); + i64 r = 0; + usz xia = a(x)->ia; + u8 xe = TI(x).elType; + if (xe==el_i32) { + i32* p = i32any_ptr(x); + for (usz i = 0; i < xia; i++) r+= p[i]; + } else if (xe==el_f64) { + f64* p = f64any_ptr(x); + for (usz i = 0; i < xia; i++) { if(p[i]!=(f64)p[i]) thrM("Expected integer"); r+= p[i]; } + } else { + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < xia; i++) r+= o2i64(xgetU(x,i)); + } + return r; +} diff --git a/src/core/c32arr.c b/src/core/c32arr.c new file mode 100644 index 00000000..db412e95 --- /dev/null +++ b/src/core/c32arr.c @@ -0,0 +1,49 @@ +#include "../core.h" + +B m_str8(usz sz, char* s) { + u32* rp; B r = m_c32arrv(&rp, sz); + for (u64 i = 0; i < sz; i++) rp[i] = (u32)s[i]; + return r; +} +B m_str8l(char* s) { + usz sz = strlen(s); + u32* rp; B r = m_c32arrv(&rp, sz); + for (u64 i = 0; i < sz; i++) rp[i] = (u32)s[i]; + return r; +} + +B m_str32(u32* s) { + usz sz = 0; while(s[sz]) sz++; + u32* rp; B r = m_c32arrv(&rp, sz); + for (usz i = 0; i < sz; i++) rp[i] = s[i]; + return r; +} + +static B m_c32slice(B p, u32* ptr) { + C32Slice* r = mm_allocN(sizeof(C32Slice), t_c32slice); + r->p = p; + r->a = ptr; + return tag(r, ARR_TAG); +} +static B c32arr_slice (B x, usz s) {return m_c32slice(x , c(C32Arr ,x)->a+s); } +static B c32slice_slice(B x, usz s) { B r = m_c32slice(inc(c(Slice,x)->p), c(C32Slice,x)->a+s); dec(x); return r; } + +static B c32arr_get (B x, usz n) { VTY(x,t_c32arr ); return m_c32(c(C32Arr ,x)->a[n]); } +static B c32slice_get(B x, usz n) { VTY(x,t_c32slice); return m_c32(c(C32Slice,x)->a[n]); } +static void c32arr_free(Value* x) { decSh(x); } +static bool c32arr_canStore(B x) { return isC32(x); } + +void c32arr_init() { + ti[t_c32arr].get = c32arr_get; ti[t_c32slice].get = c32slice_get; + ti[t_c32arr].getU = c32arr_get; ti[t_c32slice].getU = c32slice_get; + ti[t_c32arr].slice = c32arr_slice; ti[t_c32slice].slice = c32slice_slice; + ti[t_c32arr].free = c32arr_free; ti[t_c32slice].free = slice_free; + ti[t_c32arr].visit = noop_visit; ti[t_c32slice].visit = slice_visit; + ti[t_c32arr].print = arr_print; ti[t_c32slice].print = arr_print; + ti[t_c32arr].isArr = true; ti[t_c32slice].isArr = true; + ti[t_i32arr].arrD1 = true; ti[t_i32slice].arrD1 = true; + ti[t_c32arr].elType = el_c32; ti[t_c32slice].elType = el_c32; + ti[t_c32arr].canStore = c32arr_canStore; + u32* tmp; bi_emptyCVec = m_c32arrv(&tmp, 0); + gc_add(bi_emptyCVec); +} diff --git a/src/core/c32arr.h b/src/core/c32arr.h new file mode 100644 index 00000000..bf9aff94 --- /dev/null +++ b/src/core/c32arr.h @@ -0,0 +1,57 @@ +typedef struct C32Arr { + struct Arr; + u32 a[]; +} C32Arr; +typedef struct C32Slice { + struct Slice; + u32* a; +} C32Slice; + + +static B m_c32arrv(u32** p, usz ia) { + C32Arr* r = mm_allocN(fsizeof(C32Arr,a,u32,ia), t_c32arr); B rb = tag(r, ARR_TAG); + *p = r->a; + arr_shVec(rb, ia); + return rb; +} +static B m_c32arrc(u32** p, B x) { assert(isArr(x)); + C32Arr* r = mm_allocN(fsizeof(C32Arr,a,u32,a(x)->ia), t_c32arr); B rb = tag(r, ARR_TAG); + *p = r->a; + arr_shCopy(rb, x); + return rb; +} +static B m_c32arrp(u32** p, usz ia) { // doesn't write shape/rank + C32Arr* r = mm_allocN(fsizeof(C32Arr,a,u32,ia), t_c32arr); + *p = r->a; + r->ia = ia; + return tag(r, ARR_TAG); +} + +B m_str8(usz sz, char* s); +B m_str8l(char* s); +B m_str32(u32* s); + +static u32* c32arr_ptr(B x) { VTY(x, t_c32arr); return c(C32Arr,x)->a; } +static u32* c32any_ptr(B x) { assert(isArr(x)); u8 t=v(x)->type; if(t==t_c32arr) return c(C32Arr,x)->a; assert(t==t_c32slice); return c(C32Slice,x)->a; } + + +static C32Arr* toC32Arr(B x) { + if (v(x)->type==t_c32arr) return c(C32Arr,x); + u32* rp; B r = m_c32arrc(&rp, x); + usz ia = a(r)->ia; + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < ia; i++) rp[i] = o2c(xgetU(x,i)); + dec(x); + return c(C32Arr,r); +} +static bool eqStr(B w, u32* x) { + if (isAtm(w) || rnk(w)!=1) return false; + BS2B wgetU = TI(w).getU; + u64 i = 0; + while (x[i]) { + B c = wgetU(w, i); + if (!isC32(c) || x[i]!=(u32)c.u) return false; + i++; + } + return i==a(w)->ia; +} diff --git a/src/core/derv.c b/src/core/derv.c new file mode 100644 index 00000000..1cc3737b --- /dev/null +++ b/src/core/derv.c @@ -0,0 +1,55 @@ +#include "../core.h" + +static void md1D_free(Value* x) { dec(((Md1D*)x)->m1); dec(((Md1D*)x)->f); } +static void md2D_free(Value* x) { dec(((Md2D*)x)->m2); dec(((Md2D*)x)->f); dec(((Md2D*)x)->g); } +static void md2H_free(Value* x) { dec(((Md2H*)x)->m2); dec(((Md2H*)x)->g); } +static void fork_free(Value* x) { dec(((Fork*)x)->f ); dec(((Fork*)x)->g); dec(((Fork*)x)->h); } +static void atop_free(Value* x) { dec(((Atop*)x)->g); dec(((Atop*)x)->h); } + +static void md1D_visit(Value* x) { mm_visit(((Md1D*)x)->m1); mm_visit(((Md1D*)x)->f); } +static void md2D_visit(Value* x) { mm_visit(((Md2D*)x)->m2); mm_visit(((Md2D*)x)->f); mm_visit(((Md2D*)x)->g); } +static void md2H_visit(Value* x) { mm_visit(((Md2H*)x)->m2); mm_visit(((Md2H*)x)->g); } +static void fork_visit(Value* x) { mm_visit(((Fork*)x)->f ); mm_visit(((Fork*)x)->g); mm_visit(((Fork*)x)->h); } +static void atop_visit(Value* x) { mm_visit(((Atop*)x)->g); mm_visit(((Atop*)x)->h); } + +static void md1D_print(B x) { printf("(md1D ");print(c(Md1D,x)->f);printf(" ");print(c(Md1D,x)->m1); printf(")"); } +static void md2D_print(B x) { printf("(md2D ");print(c(Md2D,x)->f);printf(" ");print(c(Md2D,x)->m2);printf(" ");print(c(Md2D,x)->g);printf(")"); } +static void md2H_print(B x) { printf("(md2H "); print(c(Md2H,x)->m2);printf(" ");print(c(Md2H,x)->g);printf(")"); } +static void fork_print(B x) { printf("(fork ");print(c(Fork,x)->f);printf(" ");print(c(Fork,x)->g );printf(" ");print(c(Fork,x)->h);printf(")"); } +static void atop_print(B x) { printf("(atop "); print(c(Atop,x)->g );printf(" ");print(c(Atop,x)->h);printf(")"); } + +B md1D_c1(B t, B x) { return c(Md1,c(Md1D, t)->m1)->c1(t, x); } +B md1D_c2(B t, B w, B x) { return c(Md1,c(Md1D, t)->m1)->c2(t, w, x); } +B md2D_c1(B t, B x) { return c(Md2,c(Md2D, t)->m2)->c1(t, x); } +B md2D_c2(B t, B w, B x) { return c(Md2,c(Md2D, t)->m2)->c2(t, w, x); } +B tr2D_c1(B t, B x) { return c1(c(Atop,t)->g, c1(c(Atop,t)->h, x)); } +B tr2D_c2(B t, B w, B x) { return c1(c(Atop,t)->g, c2(c(Atop,t)->h, w, x)); } +B fork_c1(B t, B x) { B g=c1(c(Fork,t)->h, inc(x)); return c2(c(Fork,t)->g, c1(c(Fork,t)->f, x), g); } +B fork_c2(B t, B w, B x) { B g=c2(c(Fork,t)->h, inc(w), inc(x)); return c2(c(Fork,t)->g, c2(c(Fork,t)->f, w, x), g); } +B md2H_c1(B d, B x) { Md1D* m=c(Md1D,d); Md2H* t=c(Md2H,m->m1); return md2D_c1(m_md2D(t->m2, m->f, t->g), x); } +B md2H_c2(B d, B w, B x) { Md1D* m=c(Md1D,d); Md2H* t=c(Md2H,m->m1); return md2D_c2(m_md2D(t->m2, m->f, t->g), w, x); } + +static B md1D_decompose(B x) { B r=m_v3(m_i32(4),inc(c(Md1D,x)->f),inc(c(Md1D,x)->m1) ); decR(x); return r; } +static B md2D_decompose(B x) { B r=m_v4(m_i32(5),inc(c(Md2D,x)->f),inc(c(Md2D,x)->m2), inc(c(Md2D,x)->g)); decR(x); return r; } +static B md2H_decompose(B x) { B r=m_v3(m_i32(6), inc(c(Md2H,x)->m2), inc(c(Md2H,x)->g)); decR(x); return r; } +static B fork_decompose(B x) { B r=m_v4(m_i32(3),inc(c(Fork,x)->f),inc(c(Fork,x)->g ), inc(c(Fork,x)->h)); decR(x); return r; } +static B atop_decompose(B x) { B r=m_v3(m_i32(2), inc(c(Atop,x)->g ), inc(c(Atop,x)->h)); decR(x); return r; } + +static B md2D_uc1(B t, B o, B x) { + B m = c(Md2D, t)->m2; + B f = c(Md2D, t)->f; + B g = c(Md2D, t)->g; + if (v(t)->flags || !isMd2(m)) return def_fn_uc1(t, o, x); // flags check to not deconstruct builtins + return TI(m).m2_uc1(m, o, f, g, x); +} + + +void derv_init() { + ti[t_md1D].free = md1D_free; ti[t_md1D].visit = md1D_visit; ti[t_md1D].print = md1D_print; ti[t_md1D].decompose = md1D_decompose; + ti[t_md2D].free = md2D_free; ti[t_md2D].visit = md2D_visit; ti[t_md2D].print = md2D_print; ti[t_md2D].decompose = md2D_decompose; ti[t_md2D].fn_uc1 = md2D_uc1; + ti[t_md2H].free = md2H_free; ti[t_md2H].visit = md2H_visit; ti[t_md2H].print = md2H_print; ti[t_md2H].decompose = md2H_decompose; + ti[t_fork].free = fork_free; ti[t_fork].visit = fork_visit; ti[t_fork].print = fork_print; ti[t_fork].decompose = fork_decompose; + ti[t_atop].free = atop_free; ti[t_atop].visit = atop_visit; ti[t_atop].print = atop_print; ti[t_atop].decompose = atop_decompose; + ti[t_md1BI].m1_d = m_md1D; + ti[t_md2BI].m2_d = m_md2D; +} diff --git a/src/core/derv.h b/src/core/derv.h new file mode 100644 index 00000000..2fab72ee --- /dev/null +++ b/src/core/derv.h @@ -0,0 +1,47 @@ +#pragma once + +typedef struct Md1D { // F _md + struct Fun; + B m1; + B f; +} Md1D; +typedef struct Md2D { // F _md_ G + struct Fun; + B m2; + B f, g; +} Md2D; +typedef struct Md2H { // _md_ G + struct Md1; + B m2; + B g; +} Md2H; +typedef struct Fork { + struct Fun; + B f, g, h; +} Fork; +typedef struct Atop { + struct Fun; + B g, h; +} Atop; + +B md1D_c1(B t, B x); +B md1D_c2(B t, B w, B x); +B md2D_c1(B t, B x); +B md2D_c2(B t, B w, B x); +B tr2D_c1(B t, B x); +B tr2D_c2(B t, B w, B x); +B fork_c1(B t, B x); +B fork_c2(B t, B w, B x); +B md2H_c1(B d, B x); +B md2H_c2(B d, B w, B x); +// consume all args +static 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)->m1 = m; c(Md1D,r)->c1=md1D_c1; c(Md1D,r)->c2=md1D_c2; c(Md1D,r)->extra=pf_md1d; return r; } +static 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)->m2 = 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; } +static B m_md2H(B m, B g) { B r = mm_alloc(sizeof(Md2H), t_md2H, ftag(MD1_TAG)); c(Md2H,r)->m2 = m; c(Md2H,r)->g = g; c(Md2H,r)->c1=md2H_c1; c(Md2H,r)->c2=md2H_c2; return r; } +static 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; } +static 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=tr2D_c1; c(Atop,r)->c2=tr2D_c2; c(Atop,r)->extra=pf_atop; return r; } + +// consume all args +static B m1_d(B m, B f ) { if(isMd1(m)) return TI(m).m1_d(m, f ); thrM("Interpreting non-1-modifier as 1-modifier"); } +static B m2_d(B m, B f, B g) { if(isMd2(m)) return TI(m).m2_d(m, f, g); thrM("Interpreting non-2-modifier as 2-modifier"); } +static B m2_h(B m, B g) { return m_md2H(m, g); } diff --git a/src/core/f64arr.c b/src/core/f64arr.c new file mode 100644 index 00000000..243e6ded --- /dev/null +++ b/src/core/f64arr.c @@ -0,0 +1,34 @@ +#include "../core.h" + +NOINLINE B m_caf64(usz sz, f64* a) { + f64* rp; B r = m_f64arrv(&rp, sz); + for (usz i = 0; i < sz; i++) rp[i] = a[i]; + return r; +} + +static B m_f64slice(B p, f64* ptr) { + F64Slice* r = mm_allocN(sizeof(F64Slice), t_f64slice); + r->p = p; + r->a = ptr; + return tag(r, ARR_TAG); +} +static B f64arr_slice (B x, usz s) {return m_f64slice(x , c(F64Arr ,x)->a+s); } +static B f64slice_slice(B x, usz s) { B r = m_f64slice(inc(c(Slice,x)->p), c(F64Slice,x)->a+s); dec(x); return r; } + +static B f64arr_get (B x, usz n) { VTY(x,t_f64arr ); return m_f64(c(F64Arr ,x)->a[n]); } +static B f64slice_get(B x, usz n) { VTY(x,t_f64slice); return m_f64(c(F64Slice,x)->a[n]); } +static void f64arr_free(Value* x) { decSh(x); } +static bool f64arr_canStore(B x) { return q_f64(x); } + +void f64arr_init() { + ti[t_f64arr].get = f64arr_get; ti[t_f64slice].get = f64slice_get; + ti[t_f64arr].getU = f64arr_get; ti[t_f64slice].getU = f64slice_get; + ti[t_f64arr].slice = f64arr_slice; ti[t_f64slice].slice = f64slice_slice; + ti[t_f64arr].free = f64arr_free; ti[t_f64slice].free = slice_free; + ti[t_f64arr].visit = noop_visit; ti[t_f64slice].visit = slice_visit; + ti[t_f64arr].print = arr_print; ti[t_f64slice].print = arr_print; + ti[t_f64arr].isArr = true; ti[t_f64slice].isArr = true; + ti[t_f64arr].arrD1 = true; ti[t_f64slice].arrD1 = true; + ti[t_f64arr].elType = el_f64; ti[t_f64slice].elType = el_f64; + ti[t_f64arr].canStore = f64arr_canStore; +} diff --git a/src/core/f64arr.h b/src/core/f64arr.h new file mode 100644 index 00000000..db3e2a05 --- /dev/null +++ b/src/core/f64arr.h @@ -0,0 +1,43 @@ +typedef struct F64Arr { + struct Arr; + f64 a[]; +} F64Arr; +typedef struct F64Slice { + struct Slice; + f64* a; +} F64Slice; + + +static B m_f64arrv(f64** p, usz ia) { + F64Arr* r = mm_allocN(fsizeof(F64Arr,a,f64,ia), t_f64arr); B rb = tag(r, ARR_TAG); + *p = r->a; + arr_shVec(rb, ia); + return rb; +} +static B m_f64arrc(f64** p, B x) { assert(isArr(x)); + F64Arr* r = mm_allocN(fsizeof(F64Arr,a,f64,a(x)->ia), t_f64arr); B rb = tag(r, ARR_TAG); + *p = r->a; + arr_shCopy(rb, x); + return rb; +} +static B m_f64arrp(f64** p, usz ia) { // doesn't write shape/rank + F64Arr* r = mm_allocN(fsizeof(F64Arr,a,f64,ia), t_f64arr); + *p = r->a; + r->ia = ia; + return tag(r, ARR_TAG); +} + +B m_caf64(usz sz, f64* a); + +static f64* f64arr_ptr(B x) { VTY(x, t_f64arr); return c(F64Arr,x)->a; } +static f64* f64any_ptr(B x) { assert(isArr(x)); u8 t=v(x)->type; if(t==t_f64arr) return c(F64Arr,x)->a; assert(t==t_f64slice); return c(F64Slice,x)->a; } + +static F64Arr* toF64Arr(B x) { + if (v(x)->type==t_f64arr) return c(F64Arr,x); + f64* rp; B r = m_f64arrc(&rp, x); + usz ia = a(r)->ia; + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < ia; i++) rp[i] = o2f(xgetU(x,i)); + dec(x); + return c(F64Arr,r); +} diff --git a/src/fillarr.c b/src/core/fillarr.c similarity index 62% rename from src/fillarr.c rename to src/core/fillarr.c index 86a475b1..7869dbf1 100644 --- a/src/fillarr.c +++ b/src/core/fillarr.c @@ -1,41 +1,4 @@ -#include "h.h" - -typedef struct FillArr { - struct Arr; - B fill; - B a[]; -} FillArr; - -B getFillR(B x) { // doesn't consume; can return bi_noFill - if (isArr(x)) { - u8 t = v(x)->type; - if (t==t_fillarr ) { B r = inc(c(FillArr,x )->fill); return r; } - if (t==t_fillslice) { B r = inc(c(FillArr,c(Slice,x)->p)->fill); return r; } - if (t==t_c32arr || t==t_c32slice) return m_c32(' '); - if (t==t_i32arr || t==t_i32slice) return m_f64(0 ); - if (t==t_f64arr || t==t_f64slice) return m_f64(0 ); - return bi_noFill; - } - if (isF64(x)|isI32(x)) return m_i32(0); - if (isC32(x)) return m_c32(' '); - return bi_noFill; -} -B getFillQ(B x) { // doesn't consume; can return bi_noFill if CATCH_ERRORS - B r = getFillR(x); - #ifdef CATCH_ERRORS - return r; - #endif - return noFill(r)? m_f64(0) : r; -} -B getFillE(B x) { // errors if there's no fill - B xf = getFillQ(x); - if (noFill(xf)) { - if (PROPER_FILLS) thrM("No fill found"); - else return m_f64(0); - } - return xf; -} -bool noFill(B x) { return x.u == bi_noFill.u; } +#include "../core.h" B asFill(B x) { // consumes if (isArr(x)) { @@ -55,48 +18,28 @@ B asFill(B x) { // consumes return bi_noFill; } -B m_fillarrp(usz ia) { // doesn't set ia - return m_arr(fsizeof(FillArr,a,B,ia), t_fillarr); -} -void fillarr_setFill(B x, B fill) { // consumes fill - c(FillArr, x)->fill = fill; -} +static B fillarr_slice (B x, usz s) {return m_fillslice(x , c(FillArr ,x)->a+s); } +static B fillslice_slice(B x, usz s) { B r = m_fillslice(inc(c(Slice,x)->p), c(FillSlice,x)->a+s); dec(x); return r; } -typedef struct FillSlice { - struct Slice; - B* a; -} FillSlice; -B m_fillslice(B p, B* ptr) { - FillSlice* r = mm_allocN(sizeof(FillSlice), t_fillslice); - r->p = p; - r->a = ptr; - return tag(r, ARR_TAG); -} - -B* fillarr_ptr(B x) { VTY(x,t_fillarr); return c(FillArr,x)->a; } -B fillarr_slice (B x, usz s) {return m_fillslice(x , c(FillArr ,x)->a+s); } -B fillslice_slice(B x, usz s) { B r = m_fillslice(inc(c(Slice,x)->p), c(FillSlice,x)->a+s); dec(x); return r; } - - -B fillarr_get (B x, usz n) { VTY(x,t_fillarr ); return inc(c(FillArr ,x)->a[n]); } -B fillslice_get (B x, usz n) { VTY(x,t_fillslice); return inc(c(FillSlice,x)->a[n]); } -B fillarr_getU (B x, usz n) { VTY(x,t_fillarr ); return c(FillArr ,x)->a[n] ; } -B fillslice_getU(B x, usz n) { VTY(x,t_fillslice); return c(FillSlice,x)->a[n] ; } -void fillarr_free(Value* x) { +static B fillarr_get (B x, usz n) { VTY(x,t_fillarr ); return inc(c(FillArr ,x)->a[n]); } +static B fillslice_get (B x, usz n) { VTY(x,t_fillslice); return inc(c(FillSlice,x)->a[n]); } +static B fillarr_getU (B x, usz n) { VTY(x,t_fillarr ); return c(FillArr ,x)->a[n] ; } +static B fillslice_getU(B x, usz n) { VTY(x,t_fillslice); return c(FillSlice,x)->a[n] ; } +static void fillarr_free(Value* x) { decSh(x); B* p = ((FillArr*)x)->a; dec(((FillArr*)x)->fill); usz ia = ((Arr*)x)->ia; for (usz i = 0; i < ia; i++) dec(p[i]); } -void fillarr_visit(Value* x) { assert(x->type == t_fillarr); +static void fillarr_visit(Value* x) { assert(x->type == t_fillarr); usz ia = ((Arr*)x)->ia; B* p = ((FillArr*)x)->a; mm_visit(((FillArr*)x)->fill); for (usz i = 0; i < ia; i++) mm_visit(p[i]); } -bool fillarr_canStore(B x) { return true; } +static bool fillarr_canStore(B x) { return true; } -static inline void fillarr_init() { +void fillarr_init() { ti[t_fillarr].get = fillarr_get; ti[t_fillslice].get = fillslice_get; ti[t_fillarr].getU = fillarr_getU; ti[t_fillslice].getU = fillslice_getU; ti[t_fillarr].slice = fillarr_slice; ti[t_fillslice].slice = fillslice_slice; @@ -107,36 +50,7 @@ static inline void fillarr_init() { ti[t_fillarr].canStore = fillarr_canStore; } -B m_unit(B x) { - B xf = asFill(inc(x)); - if (noFill(xf)) { - HArr_p r = m_harrUp(1); - arr_shAllocR(r.b, 0); - r.a[0] = x; - return r.b; - } - B r = m_arr(fsizeof(FillArr,a,B,1), t_fillarr); - arr_shAllocI(r, 1, 0); - c(FillArr,r)->fill = xf; - c(FillArr,r)->a[0] = x; - return r; -} -B m_atomUnit(B x) { - if (isNum(x)) { - B r; - if (q_i32(x)) { i32* rp; r=m_i32arrp(&rp, 1); rp[0] = o2iu(x); } - else { f64* rp; r=m_f64arrp(&rp, 1); rp[0] = o2fu(x); } - arr_shAllocR(r,0); - return r; - } - if (isC32(x)) { - u32* rp; B r = m_c32arrp(&rp, 1); - rp[0] = o2cu(x); - arr_shAllocR(r,0); - return r; - } - return m_unit(x); -} + void validateFill(B x) { if (isArr(x)) { @@ -175,21 +89,7 @@ bool fillEqual(B w, B x) { // doesn't consume return true; } -B fill_or(B wf, B xf) { // consumes - if (fillEqual(wf, xf)) { - dec(wf); - return xf; - } - dec(wf); dec(xf); - return bi_noFill; -} -B fill_both(B w, B x) { // doesn't consume - B wf = getFillQ(w); - if (noFill(wf)) return bi_noFill; - B xf = getFillQ(x); - return fill_or(wf, xf); -} B withFill(B x, B fill) { // consumes both assert(isArr(x)); diff --git a/src/core/fillarr.h b/src/core/fillarr.h new file mode 100644 index 00000000..15967d0f --- /dev/null +++ b/src/core/fillarr.h @@ -0,0 +1,111 @@ +typedef struct FillArr { + struct Arr; + B fill; + B a[]; +} FillArr; +typedef struct FillSlice { + struct Slice; + B* a; +} FillSlice; + +B asFill(B x); // consumes +void validateFill(B x); +bool fillEqual(B w, B x); +B withFill(B x, B fill); // consumes both +B qWithFill(B x, B fill); // consumes both + +static B getFillR(B x) { // doesn't consume; can return bi_noFill + if (isArr(x)) { + u8 t = v(x)->type; + if (t==t_fillarr ) { B r = inc(c(FillArr,x )->fill); return r; } + if (t==t_fillslice) { B r = inc(c(FillArr,c(Slice,x)->p)->fill); return r; } + if (t==t_c32arr || t==t_c32slice) return m_c32(' '); + if (t==t_i32arr || t==t_i32slice) return m_f64(0 ); + if (t==t_f64arr || t==t_f64slice) return m_f64(0 ); + return bi_noFill; + } + if (isF64(x)|isI32(x)) return m_i32(0); + if (isC32(x)) return m_c32(' '); + return bi_noFill; +} +static B getFillQ(B x) { // doesn't consume; can return bi_noFill if CATCH_ERRORS + B r = getFillR(x); + #ifdef CATCH_ERRORS + return r; + #endif + return noFill(r)? m_f64(0) : r; +} +static B getFillE(B x) { // errors if there's no fill + B xf = getFillQ(x); + if (noFill(xf)) { + if (PROPER_FILLS) thrM("No fill found"); + else return m_f64(0); + } + return xf; +} + + +static B m_fillarrp(usz ia) { // doesn't set ia + return m_arr(fsizeof(FillArr,a,B,ia), t_fillarr); +} +static void fillarr_setFill(B x, B fill) { // consumes fill + c(FillArr, x)->fill = fill; +} + +static B m_fillslice(B p, B* ptr) { + FillSlice* r = mm_allocN(sizeof(FillSlice), t_fillslice); + r->p = p; + r->a = ptr; + return tag(r, ARR_TAG); +} + +static B* fillarr_ptr(B x) { VTY(x,t_fillarr); return c(FillArr,x)->a; } + + +static B m_unit(B x) { + B xf = asFill(inc(x)); + if (noFill(xf)) { + HArr_p r = m_harrUp(1); + arr_shAllocR(r.b, 0); + r.a[0] = x; + return r.b; + } + B r = m_arr(fsizeof(FillArr,a,B,1), t_fillarr); + arr_shAllocI(r, 1, 0); + c(FillArr,r)->fill = xf; + c(FillArr,r)->a[0] = x; + return r; +} + +static B m_atomUnit(B x) { + if (isNum(x)) { + B r; + if (q_i32(x)) { i32* rp; r=m_i32arrp(&rp, 1); rp[0] = o2iu(x); } + else { f64* rp; r=m_f64arrp(&rp, 1); rp[0] = o2fu(x); } + arr_shAllocR(r,0); + return r; + } + if (isC32(x)) { + u32* rp; B r = m_c32arrp(&rp, 1); + rp[0] = o2cu(x); + arr_shAllocR(r,0); + return r; + } + return m_unit(x); +} + +static B fill_or(B wf, B xf) { // consumes + if (fillEqual(wf, xf)) { + dec(wf); + return xf; + } + dec(wf); dec(xf); + return bi_noFill; +} + +static B fill_both(B w, B x) { // doesn't consume + B wf = getFillQ(w); + if (noFill(wf)) return bi_noFill; + B xf = getFillQ(x); + return fill_or(wf, xf); +} diff --git a/src/core/gstack.h b/src/core/gstack.h new file mode 100644 index 00000000..543b01fc --- /dev/null +++ b/src/core/gstack.h @@ -0,0 +1,45 @@ +#pragma once +// #define GS_REALLOC // whether to dynamically realloc gStack +#ifndef GS_SIZE +#define GS_SIZE 65536 // if !GS_REALLOC, size in number of B objects of the global object stack +#endif +#ifndef ENV_SIZE +#define ENV_SIZE 4096 // max recursion depth; GS_SIZE and C stack size may limit this +#endif + +extern B* gStack; // points to after end +extern B* gStackStart; +extern B* gStackEnd; +void gsPrint(); + +static void gsReserve(u64 am) { + #ifdef GS_REALLOC + if (am>gStackEnd-gStack) { + u64 n = gStackEnd-gStackStart + am + 500; + u64 d = gStack-gStackStart; + gStackStart = realloc(gStackStart, n*sizeof(B)); + gStack = gStackStart+d; + gStackEnd = gStackStart+n; + } + #elif DEBUG + if (am>gStackEnd-gStack) thrM("Stack overflow"); + #endif +} + +#ifdef GS_REALLOC +NOINLINE +#endif +static void gsReserveR(u64 am) { gsReserve(am); } + + +static inline void gsAdd(B x) { + #ifdef GS_REALLOC + if (gStack==gStackEnd) gsReserveR(1); + #else + if (gStack==gStackEnd) thrM("Stack overflow"); + #endif + *(gStack++) = x; +} +static inline B gsPop() { + return *--gStack; +} diff --git a/src/harr.c b/src/core/harr.c similarity index 68% rename from src/harr.c rename to src/core/harr.c index c71fbdfd..30e616c2 100644 --- a/src/harr.c +++ b/src/core/harr.c @@ -1,76 +1,8 @@ -#include "h.h" - -typedef struct HArr { - struct Arr; - B a[]; -} HArr; - -typedef struct HArr_p { - B b; - B* a; - HArr* c; -} HArr_p; -HArr_p harr_parts(B b) { - HArr* p = c(HArr,b); - return (HArr_p){.b = b, .a = p->a, .c = p}; -} +#include "../core.h" +#include "gstack.h" -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) { VTY(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) { VTY(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) { VTY(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) { VTY(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_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_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_harrUp(1); - arr_shAllocR(r.b, 0); - r.a[0] = x; - return r.b; -} B toCells(B x) { assert(isArr(x) && rnk(x)>1); usz cam = a(x)->sh[0]; @@ -133,8 +65,6 @@ B toKCells(B x, ur k) { } -B* harr_ptr(B x) { VTY(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_harrUc(x); @@ -145,35 +75,30 @@ HArr* toHArr(B x) { return r.c; } - -B m_caB(usz ia, B* a) { +NOINLINE B m_caB(usz ia, B* a) { HArr_p r = m_harrUv(ia); for (usz i = 0; i < ia; i++) r.a[i] = a[i]; return r.b; } -// consumes all -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; } +NOINLINE void harr_pfree(B x, usz am) { // am - item after last written + assert(v(x)->type==t_harr); + B* p = harr_ptr(x); + for (usz i = 0; i < am; i++) dec(p[i]); + mm_free(v(x)); +} + -typedef struct HSlice { - struct Slice; - B* a; -} HSlice; B m_hslice(B p, B* ptr) { HSlice* r = mm_allocN(sizeof(HSlice), t_hslice); r->p = p; r->a = ptr; return tag(r, ARR_TAG); } - B harr_slice (B x, usz s) {return m_hslice(x , c(HArr ,x)->a+s); } B hslice_slice(B x, usz s) { B r = m_hslice(inc(c(Slice,x)->p), c(HSlice,x)->a+s); dec(x); return r; } - B harr_get (B x, usz n) { VTY(x,t_harr ); return inc(c(HArr ,x)->a[n]); } B hslice_get (B x, usz n) { VTY(x,t_hslice); return inc(c(HSlice,x)->a[n]); } B harr_getU (B x, usz n) { VTY(x,t_harr ); return c(HArr ,x)->a[n] ; } @@ -192,12 +117,6 @@ bool harr_canStore(B x) { return true; } -NOINLINE void harr_pfree(B x, usz am) { // am - item after last written - assert(v(x)->type==t_harr); - B* p = harr_ptr(x); - for (usz i = 0; i < am; i++) dec(p[i]); - mm_free(v(x)); -} void harrP_free(Value* x) { assert(x->type==t_harrPartial|x->type==t_freed); assert(prnk(x)>1? true : ((Arr*)x)->sh!=&((Arr*)x)->ia); B* p = ((HArr*)x)->a; @@ -225,7 +144,7 @@ void harrP_print(B x) { printf("⟩)"); } -static inline void harr_init() { +void harr_init() { 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; diff --git a/src/core/harr.h b/src/core/harr.h new file mode 100644 index 00000000..0c8dc96d --- /dev/null +++ b/src/core/harr.h @@ -0,0 +1,90 @@ +typedef struct HArr { + struct Arr; + B a[]; +} HArr; +typedef struct HSlice { + struct Slice; + B* a; +} HSlice; + + +typedef struct HArr_p { + B b; + B* a; + HArr* c; +} HArr_p; +static inline HArr_p harr_parts(B b) { + HArr* p = c(HArr,b); + return (HArr_p){.b = b, .a = p->a, .c = p}; +} +NOINLINE void harr_pfree(B x, usz am); // am - item after last written + + +static 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); +} +static B harr_fv(HArr_p p) { VTY(p.b, t_harrPartial); + p.c->type = t_harr; + p.c->sh = &p.c->ia; + srnk(p.b, 1); + gsPop(); + return p.b; +} +static B harr_fc(HArr_p p, B x) { VTY(p.b, t_harrPartial); + p.c->type = t_harr; + arr_shCopy(p.b, x); + gsPop(); + return p.b; +} +static B harr_fcd(HArr_p p, B x) { VTY(p.b, t_harrPartial); + p.c->type = t_harr; + arr_shCopy(p.b, x); + dec(x); + gsPop(); + return p.b; +} +static usz* harr_fa(HArr_p p, ur r) { VTY(p.b, t_harrPartial); + p.c->type = t_harr; + gsPop(); + return arr_shAllocR(p.b, r); +} + +static 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); +} +static 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); +} +static 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); +} + +static B m_hunit(B x) { + HArr_p r = m_harrUp(1); + arr_shAllocR(r.b, 0); + r.a[0] = x; + return r.b; +} + + + +static B* harr_ptr(B x) { VTY(x,t_harr); return c(HArr,x)->a; } +HArr* toHArr(B x); +B m_caB(usz ia, B* a); + +// consumes all +static B m_v1(B a ) { HArr_p r = m_harrUv(1); r.a[0] = a; return r.b; } +static B m_v2(B a, B b ) { HArr_p r = m_harrUv(2); r.a[0] = a; r.a[1] = b; return r.b; } +static 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; } +static 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; } + diff --git a/src/heap.c b/src/core/heap.c similarity index 70% rename from src/heap.c rename to src/core/heap.c index ea12d433..bd6a6415 100644 --- a/src/heap.c +++ b/src/core/heap.c @@ -1,5 +1,7 @@ +#include "../core.h" + u64 heapUsed_ctr; -void heapUsedFn(Value* p) { heapUsed_ctr+= mm_size(p); } +static void heapUsedFn(Value* p) { heapUsed_ctr+= mm_size(p); } u64 mm_heapUsed() { heapUsed_ctr = 0; mm_forHeap(heapUsedFn); @@ -26,19 +28,6 @@ void heapVerify_checkFn(Value* v) { } -bool heapVerify_visit(B x) { - if (heapVerify_mode==-1) return false; - if (isVal(x)) mm_visitP(v(x)); - return true; -} -bool heapVerify_visitP(void* x) { - if(heapVerify_mode==-1) return false; - Value* v = x; - if(heapVerify_mode==0) v->refc--; - else if(heapVerify_mode==1) v->refc++; - else if(heapVerify_mode==2) if (x==heap_observed) { printf("referee: %p ", heap_curr); print(tag(heap_curr,OBJ_TAG)); putchar('\n'); } - return true; -} void heapVerify_callVisit(Value* v) { if (ti[v->type].isArr && prnk(v)>1) heapVerify_visitP(shObjP(v)); diff --git a/src/core/heap.h b/src/core/heap.h new file mode 100644 index 00000000..a70d04fb --- /dev/null +++ b/src/core/heap.h @@ -0,0 +1,23 @@ +u64 mm_heapUsed(); + +#ifdef HEAP_VERIFY + +extern u32 heapVerify_mode; +extern Value* heap_observed; +extern Value* heap_curr; +static bool heapVerify_visit(B x) { + if (heapVerify_mode==-1) return false; + if (isVal(x)) mm_visitP(v(x)); + return true; +} +static bool heapVerify_visitP(void* x) { + if(heapVerify_mode==-1) return false; + Value* v = x; + if(heapVerify_mode==0) v->refc--; + else if(heapVerify_mode==1) v->refc++; + else if(heapVerify_mode==2) if (x==heap_observed) { printf("referee: %p ", heap_curr); print(tag(heap_curr,OBJ_TAG)); putchar('\n'); } + return true; +} +void heapVerify(); + +#endif diff --git a/src/core/i32arr.c b/src/core/i32arr.c new file mode 100644 index 00000000..3158af29 --- /dev/null +++ b/src/core/i32arr.c @@ -0,0 +1,36 @@ +#include "../core.h" + +NOINLINE B m_cai32(usz ia, i32* a) { + i32* rp; B r = m_i32arrv(&rp, ia); + for (usz i = 0; i < ia; i++) rp[i] = a[i]; + return r; +} + +static B m_i32slice(B p, i32* ptr) { + I32Slice* r = mm_allocN(sizeof(I32Slice), t_i32slice); + r->p = p; + r->a = ptr; + return tag(r, ARR_TAG); +} +static B i32arr_slice (B x, usz s) {return m_i32slice(x , c(I32Arr ,x)->a+s); } +static B i32slice_slice(B x, usz s) { B r = m_i32slice(inc(c(Slice,x)->p), c(I32Slice,x)->a+s); dec(x); return r; } + +static B i32arr_get (B x, usz n) { VTY(x,t_i32arr ); return m_i32(c(I32Arr ,x)->a[n]); } +static B i32slice_get(B x, usz n) { VTY(x,t_i32slice); return m_i32(c(I32Slice,x)->a[n]); } +static void i32arr_free(Value* x) { decSh(x); } +static bool i32arr_canStore(B x) { return q_i32(x); } + +void i32arr_init() { + ti[t_i32arr].get = i32arr_get; ti[t_i32slice].get = i32slice_get; + ti[t_i32arr].getU = i32arr_get; ti[t_i32slice].getU = i32slice_get; + ti[t_i32arr].slice = i32arr_slice; ti[t_i32slice].slice = i32slice_slice; + ti[t_i32arr].free = i32arr_free; ti[t_i32slice].free = slice_free; + ti[t_i32arr].visit = noop_visit; ti[t_i32slice].visit = slice_visit; + ti[t_i32arr].print = arr_print; ti[t_i32slice].print = arr_print; + ti[t_i32arr].isArr = true; ti[t_i32slice].isArr = true; + ti[t_i32arr].arrD1 = true; ti[t_i32slice].arrD1 = true; + ti[t_i32arr].elType = el_i32; ti[t_i32slice].elType = el_i32; + ti[t_i32arr].canStore = i32arr_canStore; + i32* tmp; bi_emptyIVec = m_i32arrv(&tmp, 0); + gc_add(bi_emptyIVec); +} diff --git a/src/core/i32arr.h b/src/core/i32arr.h new file mode 100644 index 00000000..459a3626 --- /dev/null +++ b/src/core/i32arr.h @@ -0,0 +1,48 @@ +typedef struct I32Arr { + struct Arr; + i32 a[]; +} I32Arr; +typedef struct I32Slice { + struct Slice; + i32* a; +} I32Slice; + + +static B m_i32arrv(i32** p, usz ia) { + I32Arr* r = mm_allocN(fsizeof(I32Arr,a,i32,ia), t_i32arr); B rb = tag(r, ARR_TAG); + *p = r->a; + arr_shVec(rb, ia); + return rb; +} +static B m_i32arrc(i32** p, B x) { assert(isArr(x)); + I32Arr* r = mm_allocN(fsizeof(I32Arr,a,i32,a(x)->ia), t_i32arr); B rb = tag(r, ARR_TAG); + *p = r->a; + arr_shCopy(rb, x); + return rb; +} +static B m_i32arrp(i32** p, usz ia) { // doesn't write shape/rank + I32Arr* r = mm_allocN(fsizeof(I32Arr,a,i32,ia), t_i32arr); + *p = r->a; + r->ia = ia; + return tag(r, ARR_TAG); +} + +B m_cai32(usz ia, i32* a); + +static i32* i32arr_ptr(B x) { VTY(x, t_i32arr); return c(I32Arr,x)->a; } +static i32* i32any_ptr(B x) { assert(isArr(x)); u8 t=v(x)->type; if(t==t_i32arr) return c(I32Arr,x)->a; assert(t==t_i32slice); return c(I32Slice,x)->a; } + +static I32Arr* toI32Arr(B x) { // assumes it's possible + if (v(x)->type==t_i32arr) return c(I32Arr,x); + i32* rp; B r = m_i32arrc(&rp, x); + usz ia = a(r)->ia; + if (TI(x).elType==el_f64) { + f64* fp = f64any_ptr(x); + for (usz i = 0; i < ia; i++) rp[i] = (i32)fp[i]; + } else { + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < ia; i++) rp[i] = o2iu(xgetU(x,i)); + } + dec(x); + return c(I32Arr,r); +} diff --git a/src/core/mm.c b/src/core/mm.c new file mode 100644 index 00000000..d4db6bf6 --- /dev/null +++ b/src/core/mm.c @@ -0,0 +1,11 @@ +#include "../core.h" + +#if MM==0 + #include "../opt/mm_malloc.c" +#elif MM==1 + #include "../opt/mm_buddy.c" +#elif MM==2 + #include "../opt/mm_2buddy.c" +#else + #error bad MM value +#endif diff --git a/src/stuff.c b/src/core/stuff.c similarity index 51% rename from src/stuff.c rename to src/core/stuff.c index f6f287ce..d9f7beb3 100644 --- a/src/stuff.c +++ b/src/core/stuff.c @@ -1,65 +1,97 @@ -#include "h.h" -// a bunch of random things that don't really belong in any other file +#include "../core.h" +#include "../utils/mut.h" +#include "../utils/utf.h" +u64 allocB; // currently allocated number of bytes +B bi_N, bi_noVar, bi_badHdr, bi_optOut, bi_noFill, bi_emptyHVec, bi_emptyIVec, bi_emptyCVec; +#define F(N) u64 N; +CTR_FOR(F) +#undef F -#include -#include - -#ifndef MAP_NORESERVE - #define MAP_NORESERVE 0 // apparently needed for freebsd or something -#endif - -typedef struct TAlloc { - struct Value; - u8 data[]; -} TAlloc; -#define TOFF offsetof(TAlloc, data) -#define TALLOC(T,N,AM) T* N = (T*) ((TAlloc*)mm_allocN(TOFF + (AM)*sizeof(T) + 8, t_temp))->data; // +8 so mm is happy -#define TOBJ(N) (void*)((u8*)(N) - TOFF) -#define TFREE(N) mm_free((Value*)TOBJ(N)); -#define TREALLOC(N, AM) talloc_realloc(TOBJ(N), AM) -#define TSIZE(N) (mm_size(TOBJ(N))-TOFF) -static inline void* talloc_realloc(TAlloc* t, u64 am) { - u64 stored = mm_size((Value*)t)-TOFF; - if (stored > am) return t->data; - TALLOC(u8,r,am); - memcpy(r, t->data, stored); - mm_free((Value*)t); - return r; +NOINLINE void arr_print(B x) { // should accept refc=0 arguments for debugging purposes + ur r = rnk(x); + BS2B xgetU = TI(x).getU; + usz ia = a(x)->ia; + if (r!=1) { + if (r==0) { + printf("<"); + print(xgetU(x,0)); + return; + } + usz* sh = a(x)->sh; + for (i32 i = 0; i < r; i++) { + if(i==0)printf("%d",sh[i]); + else printf("‿%d",sh[i]); + } + printf("⥊"); + } else if (ia>0) { + for (usz i = 0; i < ia; i++) { + B c = xgetU(x,i); + if (!isC32(c) || (u32)c.u=='\n') goto reg; + } + printf("\""); + for (usz i = 0; i < ia; i++) printUTF8((u32)xgetU(x,i).u); // c32, no need to decrement + printf("\""); + return; + } + reg:; + printf("⟨"); + for (usz i = 0; i < ia; i++) { + if (i!=0) printf(", "); + print(xgetU(x,i)); + } + printf("⟩"); } -static void freed_visit(Value* x) { - #ifndef CATCH_ERRORS - err("visiting t_freed\n"); - #endif +NOINLINE void print(B x) { + if (isF64(x)) { + printf("%g", x.f); + } else if (isC32(x)) { + if ((u32)x.u>=32) { printf("'"); printUTF8((u32)x.u); printf("'"); } + else if((u32)x.u>15) printf("\\x%x", (u32)x.u); + else printf("\\x0%x", (u32)x.u); + } else if (isI32(x)) { + printf("%d", (i32)x.u); + } else if (isVal(x)) { + #ifdef DEBUG + if (isVal(x) && (v(x)->type==t_freed || v(x)->type==t_empty)) { + u8 t = v(x)->type; + v(x)->type = v(x)->flags; + printf(t==t_freed?"FREED:":"EMPTY:"); + TI(x).print(x); + v(x)->type = t; + return; + } + #endif + 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_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)"); + else if (x.u==bi_noFill.u) printf("(no fill placeholder)"); + else printf("(todo tag %lx)", x.u>>48); } -static void empty_free(Value* x) { err("FREEING EMPTY\n"); } -static void builtin_free(Value* x) { err("FREEING BUILTIN\n"); } -static void noop_visit(Value* x) { } -static void def_free(Value* x) { } -static void def_visit(Value* x) { printf("(no visit for %d=%s)\n", x->type, format_type(x->type)); } -static void def_print(B x) { printf("(%d=%s)", v(x)->type, format_type(v(x)->type)); } -static bool def_canStore(B x) { return false; } -static B def_identity(B f) { return bi_N; } -static B def_get (B x, usz n) { return inc(x); } -static B def_getU(B x, usz n) { return x; } -static B def_m1_d(B m, B f ) { thrM("cannot derive this"); } -static B def_m2_d(B m, B f, B g) { thrM("cannot derive this"); } -static B def_slice(B x, usz s) { thrM("cannot slice non-array!"); } -B m_c32arrv(u32** p, usz ia); -B m_str8l(char* s); -B m_str32c(u32 c) { - u32* rp; B r = m_c32arrv(&rp, 1); - rp[0] = c; - return r; +NOINLINE void printRaw(B x) { + if (isAtm(x)) { + if (isF64(x)) printf("%g", x.f); + else if (isC32(x)) printUTF8((u32)x.u); + else thrM("bad printRaw argument: atom arguments should be either numerical or characters"); + } else { + usz ia = a(x)->ia; + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < ia; i++) { + B c = xgetU(x,i); + #ifndef CATCH_ERRORS + if (c.u==0 || noFill(c)) { printf(" "); continue; } + #endif + if (!isC32(c)) thrM("bad printRaw argument: expected all character items"); + printUTF8((u32)c.u); + } + } } -B fromUTF8(char* x, i64 len); -B fromUTF8l(char* x); -#define A8(X) s = vec_join(s,m_str8l(X)) -#define AU(X) s = vec_join(s,fromUTF8l(X)) -#define AC(X) s = vec_join(s,m_str32c(X)) -#define AFMT(...) s = append_fmt(s, __VA_ARGS__) NOINLINE B append_fmt(B s, char* p, ...) { va_list a; va_start(a, p); @@ -163,147 +195,6 @@ NOINLINE B append_fmt(B s, char* p, ...) { return s; } -B rt_under, bi_before; -B rtUnder_c1(B f, B g, B x) { // consumes x - B fn = m2_d(inc(rt_under), inc(f), inc(g)); - B r = c1(fn, x); - dec(fn); - return r; -} -B rtUnder_cw(B f, B g, B w, B x) { // consumes w,x - B fn = m2_d(inc(rt_under), inc(f), m2_d(inc(bi_before), w, inc(g))); - B r = c1(fn, x); - dec(fn); - return r; -} - - -B bi_before; -B def_fn_uc1(B t, B o, B x) { return rtUnder_c1(o, t, x); } -B def_fn_ucw(B t, B o, B w, B x) { return rtUnder_cw(o, t, w, x); } -B def_m1_uc1(B t, B o, B f, B x) { B t2 = m1_d(inc(t),inc(f) ); B r = rtUnder_c1(o, t2, x); dec(t2); return r; } -B def_m1_ucw(B t, B o, B f, B w, B x) { B t2 = m1_d(inc(t),inc(f) ); B r = rtUnder_cw(o, t2, w, x); dec(t2); return r; } -B def_m2_uc1(B t, B o, B f, B g, B x) { B t2 = m2_d(inc(t),inc(f),inc(g)); B r = rtUnder_c1(o, t2, x); dec(t2); return r; } -B def_m2_ucw(B t, B o, B f, B g, B w, B x) { B t2 = m2_d(inc(t),inc(f),inc(g)); B r = rtUnder_cw(o, t2, w, x); dec(t2); return r; } - - -void arr_print(B x) { // should accept refc=0 arguments for debugging purposes - ur r = rnk(x); - BS2B xgetU = TI(x).getU; - usz ia = a(x)->ia; - if (r!=1) { - if (r==0) { - printf("<"); - print(xgetU(x,0)); - return; - } - usz* sh = a(x)->sh; - for (i32 i = 0; i < r; i++) { - if(i==0)printf("%d",sh[i]); - else printf("‿%d",sh[i]); - } - printf("⥊"); - } else if (ia>0) { - for (usz i = 0; i < ia; i++) { - B c = xgetU(x,i); - if (!isC32(c) || (u32)c.u=='\n') goto reg; - } - printf("\""); - for (usz i = 0; i < ia; i++) printUTF8((u32)xgetU(x,i).u); // c32, no need to decrement - printf("\""); - return; - } - reg:; - printf("⟨"); - for (usz i = 0; i < ia; i++) { - if (i!=0) printf(", "); - print(xgetU(x,i)); - } - printf("⟩"); -} - -void print(B x) { - if (isF64(x)) { - printf("%g", x.f); - } else if (isC32(x)) { - if ((u32)x.u>=32) { printf("'"); printUTF8((u32)x.u); printf("'"); } - else if((u32)x.u>15) printf("\\x%x", (u32)x.u); - else printf("\\x0%x", (u32)x.u); - } else if (isI32(x)) { - printf("%d", (i32)x.u); - } else if (isVal(x)) { - #ifdef DEBUG - if (isVal(x) && (v(x)->type==t_freed || v(x)->type==t_empty)) { - u8 t = v(x)->type; - v(x)->type = v(x)->flags; - printf(t==t_freed?"FREED:":"EMPTY:"); - TI(x).print(x); - v(x)->type = t; - return; - } - #endif - 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_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)"); - else if (x.u==bi_noFill.u) printf("(no fill placeholder)"); - else printf("(todo tag %lx)", x.u>>48); -} - -void printRaw(B x) { - if (isAtm(x)) { - if (isF64(x)) printf("%g", x.f); - else if (isC32(x)) printUTF8((u32)x.u); - else thrM("bad printRaw argument: atom arguments should be either numerical or characters"); - } else { - usz ia = a(x)->ia; - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) { - B c = xgetU(x,i); - #ifndef CATCH_ERRORS - if (c.u==0 || noFill(c)) { printf(" "); continue; } - #endif - if (!isC32(c)) thrM("bad printRaw argument: expected all character items"); - printUTF8((u32)c.u); - } - } -} - -B def_decompose(B x) { return m_v2(m_i32(isCallable(x)? 0 : -1),x); } -static NOINLINE bool equalR(B w, B x) { return equal(w, x); } -bool atomEqual(B w, B x) { // doesn't consume (not that that matters really currently) - if(isF64(w)&isF64(x)) return w.f==x.f; - if (w.u==x.u) return true; - if (!isVal(w) | !isVal(x)) return false; - if (v(w)->type!=v(x)->type) return false; - B2B dcf = TI(w).decompose; - if (dcf == def_decompose) return false; - B wd=dcf(inc(w)); B* wdp = harr_ptr(wd); - B xd=dcf(inc(x)); B* xdp = harr_ptr(xd); - if (o2i(wdp[0])<=1) { dec(wd);dec(xd); return false; } - usz wia = a(wd)->ia; - if (wia!=a(xd)->ia) { dec(wd);dec(xd); return false; } - for (i32 i = 0; iia; - BS2B xgetU = TI(x).getU; - BS2B wgetU = TI(w).getU; - for (usz i = 0; i < ia; i++) if(!equal(wgetU(w,i),xgetU(x,i))) return false; - return true; -} -B bqn_merge(B x); - #define CMP(W,X) ({ AUTO wt = (W); AUTO xt = (X); (wt>xt?1:0)-(wttype!=v(x)->type) return false; + B2B dcf = TI(w).decompose; + if (dcf == def_decompose) return false; + B wd=dcf(inc(w)); B* wdp = harr_ptr(wd); + B xd=dcf(inc(x)); B* xdp = harr_ptr(xd); + if (o2i(wdp[0])<=1) { dec(wd);dec(xd); return false; } + usz wia = a(wd)->ia; + if (wia!=a(xd)->ia) { dec(wd);dec(xd); return false; } + for (i32 i = 0; ish; - ur xr = rnk(x); usz* xsh = a(x)->sh; - if (wr!=xr) return false; - if (wsh==xsh) return true; - return eqShPrefix(wsh, xsh, wr); +bool equal(B w, B x) { // doesn't consume + bool wa = isAtm(w); + bool xa = isAtm(x); + if (wa!=xa) return false; + if (wa) return atomEqual(w, x); + if (!eqShape(w,x)) return false; + usz ia = a(x)->ia; + BS2B xgetU = TI(x).getU; + BS2B wgetU = TI(w).getU; + for (usz i = 0; i < ia; i++) if(!equal(wgetU(w,i),xgetU(x,i))) return false; + return true; +} +u64 depth(B x) { // doesn't consume + if (isAtm(x)) return 0; + if (TI(x).arrD1) return 1; + u64 r = 0; + usz ia = a(x)->ia; + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < ia; i++) { + u64 n = depth(xgetU(x,i)); + if (n>r) r = n; + } + return r+1; +} +void slice_free(Value* x) { dec(((Slice*)x)->p); decSh(x); } +void slice_visit(Value* x) { mm_visit(((Slice*)x)->p); } +void slice_print(B x) { arr_print(x); } + +char* format_type(u8 u) { + switch(u) { default: return"(unknown type)"; + case t_empty:return"empty"; case t_shape:return"shape"; + case t_funBI:return"builtin fun"; case t_fun_block:return"fun_block"; + case t_md1BI:return"builtin md1"; case t_md1_block:return"md1_block"; + case t_md2BI:return"builtin md2"; case t_md2_block:return"md2_block"; + case t_fork:return"fork"; case t_atop:return"atop"; + case t_md1D:return"md1D"; case t_md2D:return"md2D"; case t_md2H:return"md2H"; + case t_harr :return"harr" ; case t_i8arr :return"i8arr" ; case t_i32arr :return"i32arr" ; case t_fillarr :return"fillarr" ; case t_c32arr :return"c32arr" ; case t_f64arr :return"f64arr" ; + case t_hslice:return"hslice"; case t_i8slice:return"i8slice"; case t_i32slice:return"i32slice"; case t_fillslice:return"fillslice"; case t_c32slice:return"c32slice"; case t_f64slice:return"f64slice"; + case t_comp:return"comp"; case t_block:return"block"; case t_body:return"body"; case t_scope:return"scope"; + case t_ns:return"ns"; case t_nsDesc:return"nsDesc"; case t_fldAlias:return"alias"; case t_hashmap:return"hashmap"; case t_temp:return"temporary"; + case t_freed:return"(freed by GC)"; case t_harrPartial:return"partHarr"; + #ifdef RT_PERF + case t_funPerf:return"perf fn"; case t_md1Perf:return"perf m1"; case t_md2Perf:return "perf m2"; + #endif + } +} +bool isPureFn(B x) { // doesn't consume + if (isCallable(x)) { + if (v(x)->flags) return true; + B2B dcf = TI(x).decompose; + B xd = dcf(inc(x)); + B* xdp = harr_ptr(xd); + i32 t = o2iu(xdp[0]); + if (t<2) { dec(xd); return t==0; } + usz xdia = a(xd)->ia; + for (i32 i = 1; iia; + BS2B xgetU = TI(x).getU; + for (usz i = 0; i < ia; i++) if (!isPureFn(xgetU(x,i))) return false; + return true; + } else return isNum(x) || isC32(x); } -usz arr_csz(B x) { +B bqn_squeeze(B x) { // consumes + assert(isArr(x)); + u8 xe = TI(x).elType; + if (xe==el_i32 || xe==el_c32) return x; + usz ia = a(x)->ia; + if (ia==0) return x; + if (xe==el_f64) { + f64* xp = f64any_ptr(x); + for (usz i = 0; i < ia; i++) if (xp[i] != (f64)(i32)xp[i]) return x; + return tag(toI32Arr(x), ARR_TAG); + } + assert(xe==el_B); + BS2B xgetU = TI(x).getU; + B x0 = xgetU(x, 0); + if (isNum(x0)) { + for (usz i = 0; i < ia; i++) { + B c = xgetU(x, i); + if (!isNum(c)) return x; + if (!q_i32(c)) { + for (i++; i < ia; i++) if (!isNum(xgetU(x, i))) return x; + return tag(toF64Arr(x), ARR_TAG); + } + } + return tag(toI32Arr(x), ARR_TAG); + } else if (isC32(x0)) { + for (usz i = 1; i < ia; i++) { + B c = xgetU(x, i); + if (!isC32(c)) return x; + } + return tag(toC32Arr(x), ARR_TAG); + } else return x; +} +B bqn_merge(B x) { // consumes + assert(isArr(x)); + usz xia = a(x)->ia; ur xr = rnk(x); - if (xr<=1) return 1; - usz* sh = a(x)->sh; - usz r = 1; - for (i32 i = 1; i < xr; i++) r*= sh[i]; - return r; -} - -u8 fillElType(B x) { - if (isNum(x)) return el_i32; - if (isC32(x)) return el_c32; - return el_B; -} -u8 selfElType(B x) { - if (isF64(x)) return q_i32(x)? el_i32 : el_f64; - if (isC32(x)) return el_c32; - return el_B; -} - -bool isNumEl(u8 elt) { return elt==el_i32 | elt==el_f64; } - - - -#ifdef DEBUG - Value* VALIDATEP(Value* x) { - if (x->refc<=0 || (x->refc>>28) == 'a' || x->type==t_empty) { - printf("bad refcount for type %d: %d\nattempting to print: ", x->type, x->refc); fflush(stdout); - print(tag(x,OBJ_TAG)); putchar('\n'); fflush(stdout); - err(""); + if (xia==0) { + B xf = getFillE(x); + if (isAtm(xf)) { dec(xf); return x; } + i32 xfr = rnk(xf); + B xff = getFillQ(xf); + B r = m_fillarrp(0); + fillarr_setFill(r, xff); + if (xr+xfr > UR_MAX) thrM(">: Result rank too large"); + usz* rsh = arr_shAllocI(r, 0, xr+xfr); + if (rsh) { + memcpy (rsh , a(x)->sh, xr *sizeof(usz)); + if(xfr)memcpy(rsh+xr, a(xf)->sh, xfr*sizeof(usz)); } - if (ti[x->type].isArr) { - Arr* a = (Arr*)x; - if (prnk(x)<=1) assert(a->sh == &a->ia); - else VALIDATE(tag(shObjP(x),OBJ_TAG)); - } - return x; + return r; } - B VALIDATE(B x) { - if (!isVal(x)) return x; - VALIDATEP(v(x)); - if(isArr(x)!=TI(x).isArr && v(x)->type!=t_freed && v(x)->type!=t_harrPartial) { - printf("bad array tag/type: type=%d, obj=%p\n", v(x)->type, (void*)x.u); - print(x); - err("\nk"); - } - return x; + + BS2B xgetU = TI(x).getU; + B x0 = xgetU(x, 0); + usz* elSh = isArr(x0)? a(x0)->sh : NULL; + ur elR = isArr(x0)? rnk(x0) : 0; + usz elIA = isArr(x0)? a(x0)->ia : 1; + B fill = getFillQ(x0); + if (xr+elR > UR_MAX) thrM(">: Result rank too large"); + + MAKE_MUT(r, xia*elIA); + usz rp = 0; + for (usz i = 0; i < xia; i++) { + B c = xgetU(x, i); + if (isArr(c)? (elR!=rnk(c) || !eqShPrefix(elSh, a(c)->sh, elR)) : elR!=0) { mut_pfree(r, rp); thrF(">: Elements didn't have equal shapes (contained %H and %H)", x0, c); } + if (isArr(c)) mut_copy(r, rp, c, 0, elIA); + else mut_set(r, rp, c); + if (!noFill(fill)) fill = fill_or(fill, getFillQ(c)); + rp+= elIA; } -#endif - -#ifdef USE_VALGRIND - #include - #include - void pst(char* msg) { - VALGRIND_PRINTF_BACKTRACE("%s", msg); + B rb = mut_fp(r); + usz* rsh = arr_shAllocR(rb, xr+elR); + if (rsh) { + memcpy (rsh , a(x)->sh, xr *sizeof(usz)); + if (elSh)memcpy(rsh+xr, elSh, elR*sizeof(usz)); } -#endif - -static inline void hdr_init() { - for (i32 i = 0; i < t_COUNT; i++) { - ti[i].free = def_free; - ti[i].visit = def_visit; - ti[i].get = def_get; - ti[i].getU = def_getU; - ti[i].print = def_print; - ti[i].m1_d = def_m1_d; - ti[i].m2_d = def_m2_d; - ti[i].isArr = false; - ti[i].arrD1 = false; - ti[i].elType = el_B; - ti[i].identity = def_identity; - ti[i].decompose = def_decompose; - ti[i].slice = def_slice; - ti[i].canStore = def_canStore; - ti[i].fn_uc1 = def_fn_uc1; - ti[i].fn_ucw = def_fn_ucw; - ti[i].m1_uc1 = def_m1_uc1; - ti[i].m1_ucw = def_m1_ucw; - ti[i].m2_uc1 = def_m2_uc1; - ti[i].m2_ucw = def_m2_ucw; - } - ti[t_empty].free = empty_free; - ti[t_freed].free = def_free; - ti[t_freed].visit = freed_visit; - ti[t_shape].visit = noop_visit; - ti[t_funBI].visit = ti[t_md1BI].visit = ti[t_md2BI].visit = noop_visit; - ti[t_funBI].free = ti[t_md1BI].free = ti[t_md2BI].free = builtin_free; - bi_N = tag(0, TAG_TAG); - bi_noVar = tag(1, TAG_TAG); - bi_badHdr = tag(2, TAG_TAG); - bi_optOut = tag(3, TAG_TAG); - bi_noFill = tag(5, TAG_TAG); - assert((MD1_TAG>>1) == (MD2_TAG>>1)); // just to be sure it isn't changed incorrectly, `isMd` depends on this + dec(x); + return withFill(rb,fill); } -static NOINLINE B c1_invalid(B f, B x) { thrM("This function can't be called monadically"); } -static NOINLINE B c2_invalid(B f, B w, B x) { thrM("This function can't be called dyadically"); } -static B md_c1(B t, B x) { thrM("Cannot call a modifier"); } -static B md_c2(B t, B w, B x) { thrM("Cannot call a modifier"); } -static B arr_c1(B t, B x) { return inc(t); } -static B arr_c2(B t, B w, B x) { return inc(t); } -BB2B c1fn(B f) { - if (isFun(f)) return c(Fun,f)->c1; - if (isMd(f)) return md_c1; - return arr_c1; -} -BBB2B c2fn(B f) { - if (isFun(f)) return c(Fun,f)->c2; - if (isMd(f)) return md_c2; - return arr_c2; -} - - #ifdef ALLOC_STAT u64* ctr_a = 0; u64* ctr_f = 0; @@ -476,39 +403,7 @@ BBB2B c2fn(B f) { #endif #endif -static inline void onAlloc(usz sz, u8 type) { - #ifdef ALLOC_STAT - if (!ctr_a) { - #ifdef ALLOC_SIZES - actrs = malloc(sizeof(u32*)*actrc); - for (i32 i = 0; i < actrc; i++) actrs[i] = calloc(t_COUNT, sizeof(u32)); - #endif - ctr_a = calloc(t_COUNT, sizeof(u64)); - ctr_f = calloc(t_COUNT, sizeof(u64)); - } - assert(type=actrc? actrc-1 : (sz+3)/4][type]++; - #endif - ctr_a[type]++; - talloc+= sz; - #endif -} -static inline void onFree(Value* x) { - #ifdef ALLOC_STAT - ctr_f[x->type]++; - #endif - #ifdef DEBUG - if (x->type==t_empty) err("double-free"); - // u32 undef; - // x->refc = undef; - x->refc = -1431655000; - #endif - // x->refc = 0x61616161; -} - - -void printAllocStats() { +NOINLINE void printAllocStats() { #ifdef ALLOC_STAT printf("total ever allocated: %lu\n", talloc); printf("allocated heap size: %ld\n", mm_heapAllocated()); @@ -535,16 +430,3 @@ void printAllocStats() { #endif #endif } - -_Thread_local B comp_currPath; -_Thread_local B comp_currArgs; -#define FOR_INIT(F) F(hdr) F(harr) F(fillarr) F(i32arr) F(c32arr) F(f64arr) F(hash) F(fns) F(sfns) F(arith) F(sort) F(md1) F(md2) F(sysfn) F(derv) F(comp) F(rtPerf) F(ns) F(load) -#define F(X) static inline void X##_init(); -FOR_INIT(F) -#undef F -void cbqn_init() { - #define F(X) X##_init(); - FOR_INIT(F) - #undef F -} -#undef FOR_INIT diff --git a/src/core/stuff.h b/src/core/stuff.h new file mode 100644 index 00000000..6d8784b6 --- /dev/null +++ b/src/core/stuff.h @@ -0,0 +1,261 @@ +extern u64 allocB; // currently allocated number of bytes + +#include +#include + +// memory defs + +static void* mm_allocN(usz sz, u8 type); +static void mm_free(Value* x); +static u64 mm_size(Value* x); +static void mm_visit(B x); +static void mm_visitP(void* x); +static u64 mm_heapAllocated(); +u64 mm_heapUsed(); +void printAllocStats(); +static B mm_alloc(usz sz, u8 type, u64 tag) { + assert(tag>1LL<<16 || tag==0); // make sure it's `ftag`ged :| + return b((u64)mm_allocN(sz,type) | tag); +} + + +#ifndef MAP_NORESERVE + #define MAP_NORESERVE 0 // apparently needed for freebsd or something +#endif + +typedef struct TAlloc { + struct Value; + u8 data[]; +} TAlloc; +#define TOFF offsetof(TAlloc, data) +#define TALLOC(T,N,AM) T* N = (T*) ((TAlloc*)mm_allocN(TOFF + (AM)*sizeof(T) + 8, t_temp))->data; // +8 so mm is happy +#define TOBJ(N) (void*)((u8*)(N) - TOFF) +#define TFREE(N) mm_free((Value*)TOBJ(N)); +#define TREALLOC(N, AM) talloc_realloc(TOBJ(N), AM) +#define TSIZE(N) (mm_size(TOBJ(N))-TOFF) +static inline void* talloc_realloc(TAlloc* t, u64 am) { + u64 stored = mm_size((Value*)t)-TOFF; + if (stored > am) return t->data; + TALLOC(u8,r,am); + memcpy(r, t->data, stored); + mm_free((Value*)t); + return r; +} + +// shape mess + +typedef struct ShArr { + struct Value; + usz a[]; +} ShArr; +static ShArr* shObj (B x) { return (ShArr*)((u64)a(x)->sh-offsetof(ShArr,a)); } +static ShArr* shObjP(Value* x) { return (ShArr*)((u64)((Arr*)x)->sh-offsetof(ShArr,a)); } +static void decSh(Value* x) { if (prnk(x)>1) ptr_dec(shObjP(x)); } + +// some array stuff + +static void arr_shVec(B x, usz ia) { + a(x)->ia = ia; + srnk(x, 1); + a(x)->sh = &a(x)->ia; +} +static ShArr* m_shArr(ur r) { + assert(r>1); + return ((ShArr*)mm_allocN(fsizeof(ShArr, a, usz, r), t_shape)); +} +static usz* arr_shAllocR(B x, ur r) { // allocates shape, sets rank + srnk(x,r); + if (r>1) return a(x)->sh = m_shArr(r)->a; + a(x)->sh = &a(x)->ia; + return 0; +} +static usz* arr_shAllocI(B x, usz ia, ur r) { // allocates shape, sets ia,rank + a(x)->ia = ia; + return arr_shAllocR(x, r); +} +static void arr_shSetI(B x, usz ia, ur r, ShArr* sh) { + srnk(x,r); + a(x)->ia = ia; + if (r>1) { a(x)->sh = sh->a; ptr_inc(sh); } + else { a(x)->sh = &a(x)->ia; } +} +static void arr_shCopy(B n, B o) { // copy shape,rank,ia from o to n + assert(isArr(o)); + a(n)->ia = a(o)->ia; + ur r = srnk(n,rnk(o)); + if (r<=1) { + a(n)->sh = &a(n)->ia; + } else { + ptr_inc(shObj(o)); + a(n)->sh = a(o)->sh; + } +} +static usz arr_csz(B x) { + ur xr = rnk(x); + if (xr<=1) return 1; + usz* sh = a(x)->sh; + usz r = 1; + for (i32 i = 1; i < xr; i++) r*= sh[i]; + return r; +} +static bool eqShPrefix(usz* w, usz* x, ur len) { + return memcmp(w, x, len*sizeof(usz))==0; +} +static bool eqShape(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 eqShPrefix(wsh, xsh, wr); +} + + +static B m_arr(usz min, u8 type) { return mm_alloc(min, type, ftag(ARR_TAG)); } +static B m_v1(B a ); // consumes all +static B m_v2(B a, B b ); // consumes all +static B m_v3(B a, B b, B c ); // consumes all +static B m_v4(B a, B b, B c, B d); // consumes all +static B vec_join(B w, B x); +static B vec_add(B w, B x); +static bool isNumEl(u8 elt) { return elt==el_i32 | elt==el_f64; } + +// string stuff + +B m_str8l(char* s); +B fromUTF8l(char* x); +#define A8(X) s = vec_join(s,m_str8l(X)) +#define AU(X) s = vec_join(s,fromUTF8l(X)) +#define AFMT(...) s = append_fmt(s, __VA_ARGS__) +NOINLINE B append_fmt(B s, char* p, ...); + +// function stuff + +bool isPureFn(B x); // doesn't consume +B bqn_merge(B x); // consumes +B bqn_squeeze(B x); // consumes +static void noop_visit(Value* x) { } +static B def_getU(B x, usz n) { return x; } + +B rt_under, bi_before; +static B rtUnder_c1(B f, B g, B x) { // consumes x + B fn = m2_d(inc(rt_under), inc(f), inc(g)); + B r = c1(fn, x); + dec(fn); + return r; +} +static B rtUnder_cw(B f, B g, B w, B x) { // consumes w,x + B fn = m2_d(inc(rt_under), inc(f), m2_d(inc(bi_before), w, inc(g))); + B r = c1(fn, x); + dec(fn); + return r; +} +static B def_fn_uc1(B t, B o, B x) { return rtUnder_c1(o, t, x); } +static B def_fn_ucw(B t, B o, B w, B x) { return rtUnder_cw(o, t, w, x); } +static B def_m1_uc1(B t, B o, B f, B x) { B t2 = m1_d(inc(t),inc(f) ); B r = rtUnder_c1(o, t2, x); dec(t2); return r; } +static B def_m1_ucw(B t, B o, B f, B w, B x) { B t2 = m1_d(inc(t),inc(f) ); B r = rtUnder_cw(o, t2, w, x); dec(t2); return r; } +static B def_m2_uc1(B t, B o, B f, B g, B x) { B t2 = m2_d(inc(t),inc(f),inc(g)); B r = rtUnder_c1(o, t2, x); dec(t2); return r; } +static B def_m2_ucw(B t, B o, B f, B g, B w, B x) { B t2 = m2_d(inc(t),inc(f),inc(g)); B r = rtUnder_cw(o, t2, w, x); dec(t2); return r; } +static B def_decompose(B x) { return m_v2(m_i32(isCallable(x)? 0 : -1),x); } + + + + + +#ifdef DEBUG + static Value* VALIDATEP(Value* x) { + if (x->refc<=0 || (x->refc>>28) == 'a' || x->type==t_empty) { + printf("bad refcount for type %d: %d\nattempting to print: ", x->type, x->refc); fflush(stdout); + print(tag(x,OBJ_TAG)); putchar('\n'); fflush(stdout); + err(""); + } + if (ti[x->type].isArr) { + Arr* a = (Arr*)x; + if (prnk(x)<=1) assert(a->sh == &a->ia); + else VALIDATE(tag(shObjP(x),OBJ_TAG)); + } + return x; + } + static B VALIDATE(B x) { + if (!isVal(x)) return x; + VALIDATEP(v(x)); + if(isArr(x)!=TI(x).isArr && v(x)->type!=t_freed && v(x)->type!=t_harrPartial) { + printf("bad array tag/type: type=%d, obj=%p\n", v(x)->type, (void*)x.u); + print(x); + err("\nk"); + } + return x; + } +#endif + +#ifdef USE_VALGRIND + #include + #include + static void pst(char* msg) { + VALGRIND_PRINTF_BACKTRACE("%s", msg); + } +#endif + +// call stuff + +static NOINLINE B c1_invalid(B f, B x) { thrM("This function can't be called monadically"); } +static NOINLINE B c2_invalid(B f, B w, B x) { thrM("This function can't be called dyadically"); } +static B md_c1(B t, B x) { thrM("Cannot call a modifier"); } +static B md_c2(B t, B w, B x) { thrM("Cannot call a modifier"); } +static B arr_c1(B t, B x) { return inc(t); } +static B arr_c2(B t, B w, B x) { return inc(t); } +static BB2B c1fn(B f) { + if (isFun(f)) return c(Fun,f)->c1; + if (isMd(f)) return md_c1; + return arr_c1; +} +static BBB2B c2fn(B f) { + if (isFun(f)) return c(Fun,f)->c2; + if (isMd(f)) return md_c2; + return arr_c2; +} + +// alloc stuff + +#ifdef ALLOC_STAT + extern u64* ctr_a; + extern u64* ctr_f; + extern u64 actrc; + extern u64 talloc; + #ifdef ALLOC_SIZES + extern u32** actrs; + #endif +#endif +static inline void onAlloc(usz sz, u8 type) { + #ifdef ALLOC_STAT + if (!ctr_a) { + #ifdef ALLOC_SIZES + actrs = malloc(sizeof(u32*)*actrc); + for (i32 i = 0; i < actrc; i++) actrs[i] = calloc(t_COUNT, sizeof(u32)); + #endif + ctr_a = calloc(t_COUNT, sizeof(u64)); + ctr_f = calloc(t_COUNT, sizeof(u64)); + } + assert(type=actrc? actrc-1 : (sz+3)/4][type]++; + #endif + ctr_a[type]++; + talloc+= sz; + #endif +} +static inline void onFree(Value* x) { + #ifdef ALLOC_STAT + ctr_f[x->type]++; + #endif + #ifdef DEBUG + if (x->type==t_empty) err("double-free"); + // u32 undef; + // x->refc = undef; + x->refc = -1431655000; + #endif + // x->refc = 0x61616161; +} + + +extern _Thread_local B comp_currPath; +extern _Thread_local B comp_currArgs; diff --git a/src/derv.c b/src/derv.c deleted file mode 100644 index d189ed68..00000000 --- a/src/derv.c +++ /dev/null @@ -1,91 +0,0 @@ -#include "h.h" - -typedef struct Md1D { // F _md - struct Fun; - B m1; - B f; -} Md1D; -typedef struct Md2D { // F _md_ G - struct Fun; - B m2; - B f, g; -} Md2D; -typedef struct Md2H { // _md_ G - struct Md1; - B m2; - B g; -} Md2H; -typedef struct Fork { - struct Fun; - B f, g, h; -} Fork; -typedef struct Atop { - struct Fun; - B g, h; -} Atop; - -void md1D_free(Value* x) { dec(((Md1D*)x)->m1); dec(((Md1D*)x)->f); } -void md2D_free(Value* x) { dec(((Md2D*)x)->m2); dec(((Md2D*)x)->f); dec(((Md2D*)x)->g); } -void md2H_free(Value* x) { dec(((Md2H*)x)->m2); dec(((Md2H*)x)->g); } -void fork_free(Value* x) { dec(((Fork*)x)->f ); dec(((Fork*)x)->g); dec(((Fork*)x)->h); } -void atop_free(Value* x) { dec(((Atop*)x)->g); dec(((Atop*)x)->h); } - -void md1D_visit(Value* x) { mm_visit(((Md1D*)x)->m1); mm_visit(((Md1D*)x)->f); } -void md2D_visit(Value* x) { mm_visit(((Md2D*)x)->m2); mm_visit(((Md2D*)x)->f); mm_visit(((Md2D*)x)->g); } -void md2H_visit(Value* x) { mm_visit(((Md2H*)x)->m2); mm_visit(((Md2H*)x)->g); } -void fork_visit(Value* x) { mm_visit(((Fork*)x)->f ); mm_visit(((Fork*)x)->g); mm_visit(((Fork*)x)->h); } -void atop_visit(Value* x) { mm_visit(((Atop*)x)->g); mm_visit(((Atop*)x)->h); } - -void md1D_print(B x) { printf("(md1D ");print(c(Md1D,x)->f);printf(" ");print(c(Md1D,x)->m1); printf(")"); } -void md2D_print(B x) { printf("(md2D ");print(c(Md2D,x)->f);printf(" ");print(c(Md2D,x)->m2);printf(" ");print(c(Md2D,x)->g);printf(")"); } -void md2H_print(B x) { printf("(md2H "); print(c(Md2H,x)->m2);printf(" ");print(c(Md2H,x)->g);printf(")"); } -void fork_print(B x) { printf("(fork ");print(c(Fork,x)->f);printf(" ");print(c(Fork,x)->g );printf(" ");print(c(Fork,x)->h);printf(")"); } -void atop_print(B x) { printf("(atop "); print(c(Atop,x)->g );printf(" ");print(c(Atop,x)->h);printf(")"); } - -B md1D_c1(B t, B x) { return c(Md1,c(Md1D, t)->m1)->c1(t, x); } -B md1D_c2(B t, B w, B x) { return c(Md1,c(Md1D, t)->m1)->c2(t, w, x); } -B md2D_c1(B t, B x) { return c(Md2,c(Md2D, t)->m2)->c1(t, x); } -B md2D_c2(B t, B w, B x) { return c(Md2,c(Md2D, t)->m2)->c2(t, w, x); } -B tr2D_c1(B t, B x) { return c1(c(Atop,t)->g, c1(c(Atop,t)->h, x)); } -B tr2D_c2(B t, B w, B x) { return c1(c(Atop,t)->g, c2(c(Atop,t)->h, w, x)); } -B fork_c1(B t, B x) { B g=c1(c(Fork,t)->h, inc(x)); return c2(c(Fork,t)->g, c1(c(Fork,t)->f, x), g); } -B fork_c2(B t, B w, B x) { B g=c2(c(Fork,t)->h, inc(w), inc(x)); return c2(c(Fork,t)->g, c2(c(Fork,t)->f, w, x), g); } -B md2H_c1(B d, B x) { Md1D* m=c(Md1D,d); Md2H* t=c(Md2H,m->m1); return md2D_c1(m_md2D(t->m2, m->f, t->g), x); } -B md2H_c2(B d, B w, B x) { Md1D* m=c(Md1D,d); Md2H* t=c(Md2H,m->m1); return md2D_c2(m_md2D(t->m2, m->f, t->g), w, x); } - -B md1D_decompose(B x) { B r=m_v3(m_i32(4),inc(c(Md1D,x)->f),inc(c(Md1D,x)->m1) ); decR(x); return r; } -B md2D_decompose(B x) { B r=m_v4(m_i32(5),inc(c(Md2D,x)->f),inc(c(Md2D,x)->m2), inc(c(Md2D,x)->g)); decR(x); return r; } -B md2H_decompose(B x) { B r=m_v3(m_i32(6), inc(c(Md2H,x)->m2), inc(c(Md2H,x)->g)); decR(x); return r; } -B fork_decompose(B x) { B r=m_v4(m_i32(3),inc(c(Fork,x)->f),inc(c(Fork,x)->g ), inc(c(Fork,x)->h)); decR(x); return r; } -B atop_decompose(B x) { B r=m_v3(m_i32(2), inc(c(Atop,x)->g ), inc(c(Atop,x)->h)); decR(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)->m1 = 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)->m2 = 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)->m2 = 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=tr2D_c1; c(Atop,r)->c2=tr2D_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 ); thrM("Interpreting non-1-modifier as 1-modifier"); } -B m2_d(B m, B f, B g) { if(isMd2(m)) return TI(m).m2_d(m, f, g); thrM("Interpreting non-2-modifier as 2-modifier"); } -B m2_h(B m, B g) { return m_md2H(m, g); } - -B md2D_uc1(B t, B o, B x) { - B m = c(Md2D, t)->m2; - B f = c(Md2D, t)->f; - B g = c(Md2D, t)->g; - if (v(t)->flags || !isMd2(m)) return def_fn_uc1(t, o, x); // flags check to not deconstruct builtins - return TI(m).m2_uc1(m, o, f, g, x); -} - - -static inline void derv_init() { - ti[t_md1D].free = md1D_free; ti[t_md1D].visit = md1D_visit; ti[t_md1D].print = md1D_print; ti[t_md1D].decompose = md1D_decompose; - ti[t_md2D].free = md2D_free; ti[t_md2D].visit = md2D_visit; ti[t_md2D].print = md2D_print; ti[t_md2D].decompose = md2D_decompose; ti[t_md2D].fn_uc1 = md2D_uc1; - ti[t_md2H].free = md2H_free; ti[t_md2H].visit = md2H_visit; ti[t_md2H].print = md2H_print; ti[t_md2H].decompose = md2H_decompose; - ti[t_fork].free = fork_free; ti[t_fork].visit = fork_visit; ti[t_fork].print = fork_print; ti[t_fork].decompose = fork_decompose; - ti[t_atop].free = atop_free; ti[t_atop].visit = atop_visit; ti[t_atop].print = atop_print; ti[t_atop].decompose = atop_decompose; - ti[t_md1BI].m1_d = m_md1D; - ti[t_md2BI].m2_d = m_md2D; -} diff --git a/src/f64arr.c b/src/f64arr.c deleted file mode 100644 index 3cfe9906..00000000 --- a/src/f64arr.c +++ /dev/null @@ -1,80 +0,0 @@ -#include "h.h" - -typedef struct F64Arr { - struct Arr; - f64 a[]; -} F64Arr; - - -B m_f64arrv(f64** p, usz ia) { - F64Arr* r = mm_allocN(fsizeof(F64Arr,a,f64,ia), t_f64arr); B rb = tag(r, ARR_TAG); - *p = r->a; - arr_shVec(rb, ia); - return rb; -} -B m_f64arrc(f64** p, B x) { assert(isArr(x)); - F64Arr* r = mm_allocN(fsizeof(F64Arr,a,f64,a(x)->ia), t_f64arr); B rb = tag(r, ARR_TAG); - *p = r->a; - arr_shCopy(rb, x); - return rb; -} -B m_f64arrp(f64** p, usz ia) { // doesn't write shape/rank - F64Arr* r = mm_allocN(fsizeof(F64Arr,a,f64,ia), t_f64arr); - *p = r->a; - r->ia = ia; - return tag(r, ARR_TAG); -} - - -typedef struct F64Slice { - struct Slice; - f64* a; -} F64Slice; -B m_f64slice(B p, f64* ptr) { - F64Slice* r = mm_allocN(sizeof(F64Slice), t_f64slice); - r->p = p; - r->a = ptr; - return tag(r, ARR_TAG); -} - - -f64* f64arr_ptr(B x) { VTY(x, t_f64arr); return c(F64Arr,x)->a; } -f64* f64any_ptr(B x) { assert(isArr(x)); u8 t=v(x)->type; if(t==t_f64arr) return c(F64Arr,x)->a; assert(t==t_f64slice); return c(F64Slice,x)->a; } - -NOINLINE B m_caf64(usz sz, f64* a) { - f64* rp; B r = m_f64arrv(&rp, sz); - for (usz i = 0; i < sz; i++) rp[i] = a[i]; - return r; -} - -F64Arr* toF64Arr(B x) { - if (v(x)->type==t_f64arr) return c(F64Arr,x); - f64* rp; B r = m_f64arrc(&rp, x); - usz ia = a(r)->ia; - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) rp[i] = o2f(xgetU(x,i)); - dec(x); - return c(F64Arr,r); -} - - -B f64arr_slice (B x, usz s) {return m_f64slice(x , c(F64Arr ,x)->a+s); } -B f64slice_slice(B x, usz s) { B r = m_f64slice(inc(c(Slice,x)->p), c(F64Slice,x)->a+s); dec(x); return r; } - -B f64arr_get (B x, usz n) { VTY(x,t_f64arr ); return m_f64(c(F64Arr ,x)->a[n]); } -B f64slice_get(B x, usz n) { VTY(x,t_f64slice); return m_f64(c(F64Slice,x)->a[n]); } -void f64arr_free(Value* x) { decSh(x); } -bool f64arr_canStore(B x) { return q_f64(x); } - -static inline void f64arr_init() { - ti[t_f64arr].get = f64arr_get; ti[t_f64slice].get = f64slice_get; - ti[t_f64arr].getU = f64arr_get; ti[t_f64slice].getU = f64slice_get; - ti[t_f64arr].slice = f64arr_slice; ti[t_f64slice].slice = f64slice_slice; - ti[t_f64arr].free = f64arr_free; ti[t_f64slice].free = slice_free; - ti[t_f64arr].visit = noop_visit; ti[t_f64slice].visit = slice_visit; - ti[t_f64arr].print = arr_print; ti[t_f64slice].print = arr_print; - ti[t_f64arr].isArr = true; ti[t_f64slice].isArr = true; - ti[t_f64arr].arrD1 = true; ti[t_f64slice].arrD1 = true; - ti[t_f64arr].elType = el_f64; ti[t_f64slice].elType = el_f64; - ti[t_f64arr].canStore = f64arr_canStore; -} diff --git a/src/gen/.gitignore b/src/gen/.gitignore new file mode 100644 index 00000000..d6b7ef32 --- /dev/null +++ b/src/gen/.gitignore @@ -0,0 +1,2 @@ +* +!.gitignore diff --git a/src/h.h b/src/h.h index f79ad120..0c894238 100644 --- a/src/h.h +++ b/src/h.h @@ -1,4 +1,34 @@ #pragma once + +// #define ATOM_I32 +#ifdef DEBUG + // #define DEBUG_VM +#endif +#define CATCH_ERRORS // whether to allow catching errors; currently means refcounts won't be accurate and can't be tested for +#define ENABLE_GC // whether to ever garbage-collect +// #define HEAP_VERIFY // enable usage of heapVerify() +// #define ALLOC_STAT // store basic allocation statistics +// #define ALLOC_SIZES // store per-type allocation size statistics +// #define USE_VALGRIND // whether to mark freed memory for valgrind +// #define DONT_FREE // don't actually ever free objects, such that they can be printed after being freed for debugging +// #define OBJ_COUNTER // store a unique allocation number with each object for easier analysis +// #define ALL_R0 // use all of r0.bqn for runtime_0 +// #define ALL_R1 // use all of r1.bqn for runtime +#define TYPED_ARITH true // whether to use typed arith +#define VM_POS true // whether to store detailed execution position information for stacktraces +#define CHECK_VALID true // whether to check for valid arguments in places where that would be detrimental to performance (e.g. left argument sortedness of ⍋/⍒, incompatible changes in ⌾, etc) +#define EACH_FILLS false // whether to try to squeeze out fills for ¨ and ⌜ +#define SFNS_FILLS true // whether to insert fills for structural functions (∾, ≍, etc) +#define FAKE_RUNTIME false // whether to disable the self-hosted runtime +#define MM 1 // memory manager; 0 - malloc (no GC); 1 - buddy; 2 - 2buddy + +// #define LOG_GC // log GC stats +// #define FORMATTER // use self-hosted formatter for output +// #define TIME // output runtime of every expression +// #define RT_PERF // time runtime primitives +// #define NO_COMP // don't load the compiler, instead execute src/interp; needed for ./precompiled.bqn + + #include #include #include @@ -48,31 +78,39 @@ typedef u8 ur; #define UR_MAX 255 #define CTR_FOR(F) -#define CTR_DEF(N) u64 N; #define CTR_PRINT(N) printf(#N ": %lu\n", N); -CTR_FOR(CTR_DEF) +#define F(N) extern u64 N; +CTR_FOR(F) +#undef F #define fsizeof(T,F,E,n) (offsetof(T, F) + sizeof(E)*(n)) // type, flexible array member name, flexible array member type, item amount #define ftag(x) ((u64)(x) << 48) #define tag(v, t) b(((u64)(v)) | ftag(t)) - // .111111111110000000000000000000000000000000000000000000000000000 infinity - // .111111111111000000000000000000000000000000000000000000000000000 qNaN - // .111111111110nnn................................................ sNaN aka tagged aka not f64, if nnn≠0 - // 0111111111110................................................... direct value with no need of refcounting -const u16 C32_TAG = 0b0111111111110001; // 0111111111110001................00000000000ccccccccccccccccccccc char -const u16 TAG_TAG = 0b0111111111110010; // 0111111111110010................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn special value (0=nothing, 1=undefined var, 2=bad header; 3=optimized out; 4=error?; 5=no fill) -const u16 VAR_TAG = 0b0111111111110011; // 0111111111110011ddddddddddddddddnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn variable reference -const u16 I32_TAG = 0b0111111111110111; // 0111111111110111................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn 32-bit int; unused -const u16 MD1_TAG = 0b1111111111110010; // 1111111111110010ppppppppppppppppppppppppppppppppppppppppppppp000 1-modifier -const u16 MD2_TAG = 0b1111111111110011; // 1111111111110011ppppppppppppppppppppppppppppppppppppppppppppp000 2-modifier -const u16 FUN_TAG = 0b1111111111110100; // 1111111111110100ppppppppppppppppppppppppppppppppppppppppppppp000 function -const u16 NSP_TAG = 0b1111111111110101; // 1111111111110101ppppppppppppppppppppppppppppppppppppppppppppp000 namespace maybe? -const u16 OBJ_TAG = 0b1111111111110110; // 1111111111110110ppppppppppppppppppppppppppppppppppppppppppppp000 custom object (e.g. bigints) -const u16 ARR_TAG = 0b1111111111110111; // 1111111111110111ppppppppppppppppppppppppppppppppppppppppppppp000 array (everything else is an atom) -const u16 VAL_TAG = 0b1111111111110 ; // 1111111111110................................................... pointer to Value, needs refcounting + // .111111111110000000000000000000000000000000000000000000000000000 infinity + // .111111111111000000000000000000000000000000000000000000000000000 qNaN + // .111111111110nnn................................................ sNaN aka tagged aka not f64, if nnn≠0 + // 0111111111110................................................... direct value with no need of refcounting +static const u16 C32_TAG = 0b0111111111110001; // 0111111111110001................00000000000ccccccccccccccccccccc char +static const u16 TAG_TAG = 0b0111111111110010; // 0111111111110010................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn special value (0=nothing, 1=undefined var, 2=bad header; 3=optimized out; 4=error?; 5=no fill) +static const u16 VAR_TAG = 0b0111111111110011; // 0111111111110011ddddddddddddddddnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn variable reference +static const u16 I32_TAG = 0b0111111111110111; // 0111111111110111................nnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn 32-bit int; unused +static const u16 MD1_TAG = 0b1111111111110010; // 1111111111110010ppppppppppppppppppppppppppppppppppppppppppppp000 1-modifier +static const u16 MD2_TAG = 0b1111111111110011; // 1111111111110011ppppppppppppppppppppppppppppppppppppppppppppp000 2-modifier +static const u16 FUN_TAG = 0b1111111111110100; // 1111111111110100ppppppppppppppppppppppppppppppppppppppppppppp000 function +static const u16 NSP_TAG = 0b1111111111110101; // 1111111111110101ppppppppppppppppppppppppppppppppppppppppppppp000 namespace maybe? +static const u16 OBJ_TAG = 0b1111111111110110; // 1111111111110110ppppppppppppppppppppppppppppppppppppppppppppp000 custom object (e.g. bigints) +static const u16 ARR_TAG = 0b1111111111110111; // 1111111111110111ppppppppppppppppppppppppppppppppppppppppppppp000 array (everything else is an atom) +static const u16 VAL_TAG = 0b1111111111110 ; // 1111111111110................................................... pointer to Value, needs refcounting void cbqn_init(); +typedef union B { + u64 u; + i64 s; + f64 f; +} B; +#define b(x) ((B)(x)) + enum Type { /* 0*/ t_empty, // empty bucket placeholder /* 1*/ t_funBI, t_fun_block, @@ -103,79 +141,75 @@ enum ElType { // a⌈b shall return the type that can store both, if possible; a el_MAX=4 // also used for incomplete in mut.c }; -char* format_type(u8 u) { - switch(u) { default: return"(unknown type)"; - case t_empty:return"empty"; case t_shape:return"shape"; - case t_funBI:return"builtin fun"; case t_fun_block:return"fun_block"; - case t_md1BI:return"builtin md1"; case t_md1_block:return"md1_block"; - case t_md2BI:return"builtin md2"; case t_md2_block:return"md2_block"; - case t_fork:return"fork"; case t_atop:return"atop"; - case t_md1D:return"md1D"; case t_md2D:return"md2D"; case t_md2H:return"md2H"; - case t_harr :return"harr" ; case t_i8arr :return"i8arr" ; case t_i32arr :return"i32arr" ; case t_fillarr :return"fillarr" ; case t_c32arr :return"c32arr" ; case t_f64arr :return"f64arr" ; - case t_hslice:return"hslice"; case t_i8slice:return"i8slice"; case t_i32slice:return"i32slice"; case t_fillslice:return"fillslice"; case t_c32slice:return"c32slice"; case t_f64slice:return"f64slice"; - case t_comp:return"comp"; case t_block:return"block"; case t_body:return"body"; case t_scope:return"scope"; - case t_ns:return"ns"; case t_nsDesc:return"nsDesc"; case t_fldAlias:return"alias"; case t_hashmap:return"hashmap"; case t_temp:return"temporary"; - case t_freed:return"(freed by GC)"; case t_harrPartial:return"partHarr"; - #ifdef RT_PERF - case t_funPerf:return"perf fn"; case t_md1Perf:return"perf m1"; case t_md2Perf:return "perf m2"; - #endif - } -} +char* format_type(u8 u); -#define FOR_PF(F) F(none, "(unknown fn)") \ - /*arith.c*/ F(add,"+") F(sub,"-") F(mul,"×") F(div,"÷") F(pow,"⋆") F(floor,"⌊") F(ceil,"⌈") F(stile,"|") F(eq,"=") \ - /*arith.c*/ F(ne,"≠") F(le,"≤") F(ge,"≥") F(lt,"<") F(gt,">") F(and,"∧") F(or,"∨") F(not,"¬") F(log,"⋆⁼") \ - /*fns.c*/ F(ud,"↕") F(fne,"≢") F(feq,"≡") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"•FmtF") F(indexOf,"⊐") F(memberOf,"∊") F(find,"⍷") F(count,"⊒") \ - /*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(couple,"≍") F(shiftb,"»") F(shifta,"«") F(take,"↑") F(drop,"↓") F(group,"⊔") F(reverse,"⌽") \ - /*derv.c*/ F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") \ - /*sort.c*/ F(gradeUp,"⍋") F(gradeDown,"⍒") \ - /*sysfn.c*/ F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(repr,"•Repr") F(fill,"•FillFn") \ - /*sysfn.c*/ F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(bqn,"•BQN") F(cmp,"•Cmp") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") F(hash,"•Hash") \ +#define FOR_PFN(F) F(none, "(unknown fn)") \ + /*arith.c*/ F(add,"+") F(sub,"-") F(mul,"×") F(div,"÷") F(pow,"⋆") F(floor,"⌊") F(ceil,"⌈") F(stile,"|") F(eq,"=") \ + /*arith.c*/ F(ne,"≠") F(le,"≤") F(ge,"≥") F(lt,"<") F(gt,">") F(and,"∧") F(or,"∨") F(not,"¬") F(log,"⋆⁼") \ + /*fns.c*/ F(ud,"↕") F(fne,"≢") F(feq,"≡") F(ltack,"⊣") F(rtack,"⊢") F(fmtF,"•FmtF") F(indexOf,"⊐") F(memberOf,"∊") F(find,"⍷") F(count,"⊒") \ + /*sfns.c*/ F(shape,"⥊") F(pick,"⊑") F(pair,"{𝕨‿𝕩}") F(select,"⊏") F(slash,"/") F(join,"∾") F(couple,"≍") F(shiftb,"»") F(shifta,"«") F(take,"↑") F(drop,"↓") F(group,"⊔") F(reverse,"⌽") \ + /*derv.c*/ F(fork,"(fork)") F(atop,"(atop)") F(md1d,"(derived 1-modifier)") F(md2d,"(derived 2-modifier)") \ + /*sort.c*/ F(gradeUp,"⍋") F(gradeDown,"⍒") \ + /*sysfn.c*/ F(type,"•Type") F(decp,"•Decompose") F(primInd,"•PrimInd") F(glyph,"•Glyph") F(repr,"•Repr") F(fill,"•FillFn") \ + /*sysfn.c*/ F(grLen,"•GroupLen") F(grOrd,"•groupOrd") F(asrt,"!") F(sys,"•getsys") F(bqn,"•BQN") F(cmp,"•Cmp") F(internal,"•Internal") F(show,"•Show") F(out,"•Out") F(hash,"•Hash") \ + +#define FOR_PM1(F) F(none, "(unknown 1-modifier)") \ + /*md1.c*/ F(tbl,"⌜") F(each,"¨") F(fold,"´") F(scan,"`") F(const,"˙") F(swap,"˜") F(cell,"˘") \ + /*md1.c*/ F(timed,"•_timed") F(fchars,"•FChars") F(fbytes,"•FBytes") F(flines,"•FLines") F(import,"•Import") + +#define FOR_PM2(F) F(none, "(unknown 2-modifier)") \ + /*md2.c*/ F(val,"⊘") F(repeat,"⍟") F(fillBy,"•_fillBy_") F(catch,"⎊") \ + /*md2.c*/ F(atop,"∘") F(over,"○") F(before,"⊸") F(after,"⟜") F(cond,"◶") F(under,"⌾") enum PrimFns { #define F(N,X) pf_##N, - FOR_PF(F) + FOR_PFN(F) #undef F }; -char* format_pf(u8 u) { - switch(u) { default: return "(unknown fn)"; +enum PrimMd1 { + #define F(N,X) pm1_##N, + FOR_PM1(F) + #undef F +}; +enum PrimMd2 { + #define F(N,X) pm2_##N, + FOR_PM2(F) + #undef F +}; + +static char* format_pf(u8 u) { + switch(u) { default: return "(unknown function)"; #define F(N,X) case pf_##N: return X; - FOR_PF(F) + FOR_PFN(F) #undef F } } -enum PrimMd1 { - pm1_none, - pm1_tbl, pm1_each, pm1_fold, pm1_scan, pm1_const, pm1_swap, pm1_cell, // md1.c - pm1_timed, pm1_fchars, pm1_fbytes, pm1_flines, pm1_import, // md1.c -}; -char* format_pm1(u8 u) { - switch(u) { - default: case pf_none: return"(unknown 1-modifier)"; - case pm1_tbl:return"⌜"; case pm1_each:return"¨"; case pm1_fold:return"´"; case pm1_scan:return"`"; case pm1_const:return"˙"; case pm1_swap:return"˜"; case pm1_cell:return"˘"; - case pm1_timed:return"•_timed"; case pm1_fchars:return"•FChars"; case pm1_fbytes:return"•FBytes"; case pm1_flines:return"•FLines"; case pm1_import:return"•Import"; +static char* format_pm1(u8 u) { + switch(u) { default: return"(unknown 1-modifier)"; + #define F(N,X) case pm1_##N: return X; + FOR_PM1(F) + #undef F } } -enum PrimMd2 { - pm2_none, - pm2_val, pm2_atop, pm2_over, pm2_before, pm2_after, pm2_cond, pm2_repeat, pm2_fillBy, pm2_catch, pm2_under, // md2.c -}; -char* format_pm2(u8 u) { - switch(u) { - default: case pf_none: return"(unknown 1-modifier)"; - case pm2_val:return"⊘"; case pm2_repeat:return"⍟"; case pm2_fillBy:return"•_fillBy_"; case pm2_catch:return"⎊"; - case pm2_atop:return"∘"; case pm2_over:return"○"; case pm2_before:return"⊸"; case pm2_after:return"⟜"; case pm2_cond:return"◶"; case pm2_under:return"⌾"; +static char* format_pm2(u8 u) { + switch(u) { default: return"(unknown 2-modifier)"; + #define F(N,X) case pm2_##N: return X; + FOR_PM2(F) + #undef F } } +#define F(N,X) B bi_##N; +FOR_PFN(F) +#undef F +#define F(N,X) B bi_##N; +FOR_PM1(F) +#undef F +#define F(N,X) B bi_##N; +FOR_PM2(F) +#undef F -typedef union B { - u64 u; - i64 s; - f64 f; -} B; -#define b(x) ((B)(x)) typedef struct Value { i32 refc; // plain old reference count @@ -195,8 +229,8 @@ typedef struct Arr { #ifdef DEBUG #include - B VALIDATE(B x); - Value* VALIDATEP(Value* x); + static B VALIDATE(B x); + static Value* VALIDATEP(Value* x); #else #define assert(x) {if (!(x)) __builtin_unreachable();} #define VALIDATE(x) (x) @@ -209,58 +243,29 @@ typedef void (*vfn)(); void gc_add(B x); // add permanent root object void gc_addFn(vfn f); // add function that calls mm_visit/mm_visitP for dynamic roots -void gc_disable(); // gc starts disabled -void gc_enable(); // can be nested (e.g. gc_disable(); gc_disable(); gc_enable(); will keep gc disabled until another gc_enable(); ) void gc_maybeGC(); // gc if that seems necessary void gc_forceGC(); // force a gc; who knows what happens if gc is disabled (probably should error) void gc_visitRoots(); -void* mm_allocN(usz sz, u8 type); -void mm_free(Value* x); -void mm_visit(B x); -void mm_visitP(void* x); -u64 mm_round(usz x); -u64 mm_size(Value* x); - -u64 mm_heapAllocated(); -u64 mm_heapUsed(); -void mm_forHeap(V2v f); -B mm_alloc(usz sz, u8 type, u64 tag) { - assert(tag>1LL<<16 || tag==0); // make sure it's `ftag`ged :| - return b((u64)mm_allocN(sz,type) | tag); -} - -void gsAdd(B x); // may throw -B gsPop(); // some primitive actions -B bi_N, bi_noVar, bi_badHdr, bi_optOut, bi_noFill, bi_emptyHVec, bi_emptyIVec, bi_emptyCVec; -void dec(B x); -B inc(B x); -void ptr_dec(void* x); -void ptr_inc(void* x); -void printUTF8(u32 c); +extern B bi_N, bi_noVar, bi_badHdr, bi_optOut, bi_noFill, bi_emptyHVec, bi_emptyIVec, bi_emptyCVec; +static void dec(B x); +static B inc(B x); +static void ptr_dec(void* x); +static void ptr_inc(void* x); void printRaw(B x); // doesn't consume void print(B x); // doesn't consume +void arr_print(B x); // doesn't consume bool equal(B w, B x); // doesn't consume i32 compare(B w, B x); // doesn't consume; -1 if wx, 0 if w≡x; 0==compare(NaN,NaN) -void arr_print(B x); // doesn't consume -u8 fillElType(B x); // doesn't consume -bool eqShape(B w, B x); // doesn't consume -usz arr_csz(B x); // doesn't consume bool atomEqual(B w, B x); // doesn't consume +u64 depth(B x); // doesn't consume B toCells(B x); // consumes B toKCells(B x, ur k); // consumes B withFill(B x, B f); // consumes both -B vec_join(B w, B x); // consumes both; w∾x for vectors -B vec_add(B w, B x); // consumes both; w∾>48) == I32_TAG; } +static inline bool isI32(B x) { return (x.u>>48) == I32_TAG; } #else -bool isI32(B x) { return false; } +static inline bool isI32(B x) { return false; } #endif -bool isFun(B x) { return (x.u>>48) == FUN_TAG; } -bool isArr(B x) { return (x.u>>48) == ARR_TAG; } -bool isC32(B x) { return (x.u>>48) == C32_TAG; } -bool isVar(B x) { return (x.u>>48) == VAR_TAG; } -bool isTag(B x) { return (x.u>>48) == TAG_TAG; } -bool isMd1(B x) { return (x.u>>48) == MD1_TAG; } -bool isMd2(B x) { return (x.u>>48) == MD2_TAG; } -bool isMd (B x) { return (x.u>>49) ==(MD2_TAG>>1); } -bool isNsp(B x) { return (x.u>>48) == NSP_TAG; } -bool isObj(B x) { return (x.u>>48) == OBJ_TAG; } -// bool isVal(B x) { return ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0); } -// bool isF64(B x) { return ((x.u>>51&0xFFF) != 0xFFE) | ((x.u<<1)==(b(1.0/0.0).u<<1)); } -bool isVal(B x) { return (x.u - (((u64)VAL_TAG<<51) + 1)) < ((1ull<<51) - 1); } // ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0); -bool isF64(B x) { return (x.u<<1) - ((0xFFEull<<52) + 2) >= (1ull<<52) - 2; } -bool isNum(B x) { return isF64(x)|isI32(x); } +static inline bool isFun(B x) { return (x.u>>48) == FUN_TAG; } +static inline bool isArr(B x) { return (x.u>>48) == ARR_TAG; } +static inline bool isC32(B x) { return (x.u>>48) == C32_TAG; } +static inline bool isVar(B x) { return (x.u>>48) == VAR_TAG; } +static inline bool isTag(B x) { return (x.u>>48) == TAG_TAG; } +static inline bool isMd1(B x) { return (x.u>>48) == MD1_TAG; } +static inline bool isMd2(B x) { return (x.u>>48) == MD2_TAG; } +static inline bool isMd (B x) { return (x.u>>49) ==(MD2_TAG>>1); } +static inline bool isNsp(B x) { return (x.u>>48) == NSP_TAG; } +static inline bool isObj(B x) { return (x.u>>48) == OBJ_TAG; } +// static inline bool isVal(B x) { return ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0); } +// static inline bool isF64(B x) { return ((x.u>>51&0xFFF) != 0xFFE) | ((x.u<<1)==(b(1.0/0.0).u<<1)); } +static inline bool isVal(B x) { return (x.u - (((u64)VAL_TAG<<51) + 1)) < ((1ull<<51) - 1); } // ((x.u>>51) == VAL_TAG) & ((x.u<<13) != 0); +static inline bool isF64(B x) { return (x.u<<1) - ((0xFFEull<<52) + 2) >= (1ull<<52) - 2; } +static inline bool isNum(B x) { return isF64(x)|isI32(x); } -bool isAtm(B x) { return !isArr(x); } -bool isCallable(B x) { return isMd(x) | isFun(x); } -bool noFill(B x); - -// shape mess -typedef struct ShArr { - struct Value; - usz a[]; -} ShArr; -ShArr* shObj (B x) { return (ShArr*)((u64)a(x)->sh-offsetof(ShArr,a)); } -ShArr* shObjP(Value* x) { return (ShArr*)((u64)((Arr*)x)->sh-offsetof(ShArr,a)); } -void decSh(Value* x) { if (prnk(x)>1) ptr_dec(shObjP(x)); } - -void arr_shVec(B x, usz ia) { - a(x)->ia = ia; - srnk(x, 1); - a(x)->sh = &a(x)->ia; -} -ShArr* m_shArr(ur r) { - assert(r>1); - return ((ShArr*)mm_allocN(fsizeof(ShArr, a, usz, r), t_shape)); -} -usz* arr_shAllocR(B x, ur r) { // allocates shape, sets rank - srnk(x,r); - if (r>1) return a(x)->sh = m_shArr(r)->a; - a(x)->sh = &a(x)->ia; - return 0; -} -usz* arr_shAllocI(B x, usz ia, ur r) { // allocates shape, sets ia,rank - a(x)->ia = ia; - return arr_shAllocR(x, r); -} -void arr_shSetI(B x, usz ia, ur r, ShArr* sh) { - srnk(x,r); - a(x)->ia = ia; - if (r>1) { a(x)->sh = sh->a; ptr_inc(sh); } - else { a(x)->sh = &a(x)->ia; } -} -void arr_shCopy(B n, B o) { // copy shape,rank,ia from o to n - assert(isArr(o)); - a(n)->ia = a(o)->ia; - ur r = srnk(n,rnk(o)); - if (r<=1) { - a(n)->sh = &a(n)->ia; - } else { - ptr_inc(shObj(o)); - a(n)->sh = a(o)->sh; - } -} +static inline bool isAtm(B x) { return !isArr(x); } +static inline bool isCallable(B x) { return isMd(x) | isFun(x); } +static inline bool noFill(B x) { return x.u == bi_noFill.u; } // make objects -B m_arr(usz min, u8 type) { return mm_alloc(min, type, ftag(ARR_TAG)); } -B m_f64(f64 n) { assert(isF64(b(n))); return b(n); } // assert just to make sure we're actually creating a float -B m_c32(u32 n) { return tag(n, C32_TAG); } // TODO check validity? +static B m_f64(f64 n) { assert(isF64(b(n))); return b(n); } // assert just to make sure we're actually creating a float +static B m_c32(u32 n) { return tag(n, C32_TAG); } // TODO check validity? #ifdef ATOM_I32 -B m_i32(i32 n) { return tag(n, I32_TAG); } +static B m_i32(i32 n) { return tag(n, I32_TAG); } #else -B m_i32(i32 n) { return m_f64(n); } +static B m_i32(i32 n) { return m_f64(n); } #endif -B m_error() { return tag(4, TAG_TAG); } -B m_usz(usz n) { return np); decSh(x); } -void slice_visit(Value* x) { mm_visit(((Slice*)x)->p); } -void slice_print(B x) { arr_print(x); } - -B* harr_ptr(B x); +void slice_free(Value* x); +void slice_visit(Value* x); +void slice_print(B x); typedef void (*B2v)(B); @@ -457,32 +412,33 @@ TypeInfo ti[t_COUNT]; #define TI(x) (ti[v(x)->type]) -bool isNothing(B b) { return b.u==bi_N.u; } +static bool isNothing(B b) { return b.u==bi_N.u; } +static void mm_free(Value* x); // refcount -bool reusable(B x) { return v(x)->refc==1; } +static bool reusable(B x) { return v(x)->refc==1; } static inline void value_free(Value* x) { ti[x->type].free(x); mm_free(x); } static NOINLINE void value_freeR(Value* x) { value_free(x); } -void dec(B x) { +static void dec(B x) { if (!isVal(VALIDATE(x))) return; Value* vx = v(x); if(!--vx->refc) value_free(vx); } -void ptr_dec(void* x) { if(!--VALIDATEP((Value*)x)->refc) value_free(x); } -void ptr_decR(void* x) { if(!--VALIDATEP((Value*)x)->refc) value_freeR(x); } -void decR(B x) { +static void ptr_dec(void* x) { if(!--VALIDATEP((Value*)x)->refc) value_free(x); } +static void ptr_decR(void* x) { if(!--VALIDATEP((Value*)x)->refc) value_freeR(x); } +static void decR(B x) { if (!isVal(VALIDATE(x))) return; Value* vx = v(x); if(!--vx->refc) value_freeR(vx); } -B inc(B x) { +static B inc(B x) { if (isVal(VALIDATE(x))) v(x)->refc++; return x; } -void ptr_inc(void* x) { VALIDATEP((Value*)x)->refc++; } +static void ptr_inc(void* x) { VALIDATEP((Value*)x)->refc++; } @@ -493,27 +449,22 @@ typedef struct Fun { } Fun; -B c1_rare(B f, B x) { dec(x); +static B c1_rare(B f, B x) { dec(x); if (isMd(f)) thrM("Calling a modifier"); return inc(VALIDATE(f)); } -B c2_rare(B f, B w, B x) { dec(w); dec(x); +static B c2_rare(B f, B w, B x) { dec(w); dec(x); if (isMd(f)) thrM("Calling a modifier"); return inc(VALIDATE(f)); } -BB2B c1fn(B f); -BBB2B c2fn(B f); -B c1(B f, B x) { // BQN-call f monadically; consumes x +static B c1(B f, B x) { // BQN-call f monadically; consumes x if (isFun(f)) return VALIDATE(c(Fun,f)->c1(f, x)); return c1_rare(f, x); } -B c2(B f, B w, B x) { // BQN-call f dyadically; consumes w,x +static B c2(B f, B w, B x) { // BQN-call f dyadically; consumes w,x if (isFun(f)) return VALIDATE(c(Fun,f)->c2(f, w, x)); return c2_rare(f, w, x); } -B m1_d(B m, B f ); -B m2_d(B m, B f, B g); -B m2_h(B m, B g); typedef struct Md1 { @@ -526,11 +477,14 @@ typedef struct Md2 { BB2B c1; // f(md2d{this,f,g}, x); consumes x BBB2B c2; // f(md2d{this,f,g},w,x); consumes w,x } Md2; -B m_md1D(B m, B f ); -B m_md2D(B m, B f, B g); -B m_md2H(B m, B g); -B m_fork(B f, B g, B h); -B m_atop( B g, B h); +static B m1_d(B m, B f ); +static B m2_d(B m, B f, B g); +static B m2_h(B m, B g); +static B m_md1D(B m, B f ); +static B m_md2D(B m, B f, B g); +static B m_md2H(B m, B g); +static B m_fork(B f, B g, B h); +static B m_atop( B g, B h); @@ -542,4 +496,15 @@ static inline u64 nsTime() { return t.tv_sec*1000000000ull + t.tv_nsec; } -u64 allocB; // currently allocated number of bytes + + +static u8 fillElType(B x) { + if (isNum(x)) return el_i32; + if (isC32(x)) return el_c32; + return el_B; +} +static u8 selfElType(B x) { + if (isF64(x)) return q_i32(x)? el_i32 : el_f64; + if (isC32(x)) return el_c32; + return el_B; +} diff --git a/src/i32arr.c b/src/i32arr.c deleted file mode 100644 index 80eefe1d..00000000 --- a/src/i32arr.c +++ /dev/null @@ -1,88 +0,0 @@ -#include "h.h" - -typedef struct I32Arr { - struct Arr; - i32 a[]; -} I32Arr; - - -B m_i32arrv(i32** p, usz ia) { - I32Arr* r = mm_allocN(fsizeof(I32Arr,a,i32,ia), t_i32arr); B rb = tag(r, ARR_TAG); - *p = r->a; - arr_shVec(rb, ia); - return rb; -} -B m_i32arrc(i32** p, B x) { assert(isArr(x)); - I32Arr* r = mm_allocN(fsizeof(I32Arr,a,i32,a(x)->ia), t_i32arr); B rb = tag(r, ARR_TAG); - *p = r->a; - arr_shCopy(rb, x); - return rb; -} -B m_i32arrp(i32** p, usz ia) { // doesn't write shape/rank - I32Arr* r = mm_allocN(fsizeof(I32Arr,a,i32,ia), t_i32arr); - *p = r->a; - r->ia = ia; - return tag(r, ARR_TAG); -} - - -typedef struct I32Slice { - struct Slice; - i32* a; -} I32Slice; -B m_i32slice(B p, i32* ptr) { - I32Slice* r = mm_allocN(sizeof(I32Slice), t_i32slice); - r->p = p; - r->a = ptr; - return tag(r, ARR_TAG); -} - - -i32* i32arr_ptr(B x) { VTY(x, t_i32arr); return c(I32Arr,x)->a; } -i32* i32any_ptr(B x) { assert(isArr(x)); u8 t=v(x)->type; if(t==t_i32arr) return c(I32Arr,x)->a; assert(t==t_i32slice); return c(I32Slice,x)->a; } - -NOINLINE B m_cai32(usz ia, i32* a) { - i32* rp; B r = m_i32arrv(&rp, ia); - for (usz i = 0; i < ia; i++) rp[i] = a[i]; - return r; -} - -f64* f64any_ptr(B x); -I32Arr* toI32Arr(B x) { // assumes it's possible - if (v(x)->type==t_i32arr) return c(I32Arr,x); - i32* rp; B r = m_i32arrc(&rp, x); - usz ia = a(r)->ia; - if (TI(x).elType==el_f64) { - f64* fp = f64any_ptr(x); - for (usz i = 0; i < ia; i++) rp[i] = (i32)fp[i]; - } else { - BS2B xgetU = TI(x).getU; - for (usz i = 0; i < ia; i++) rp[i] = o2iu(xgetU(x,i)); - } - dec(x); - return c(I32Arr,r); -} - - -B i32arr_slice (B x, usz s) {return m_i32slice(x , c(I32Arr ,x)->a+s); } -B i32slice_slice(B x, usz s) { B r = m_i32slice(inc(c(Slice,x)->p), c(I32Slice,x)->a+s); dec(x); return r; } - -B i32arr_get (B x, usz n) { VTY(x,t_i32arr ); return m_i32(c(I32Arr ,x)->a[n]); } -B i32slice_get(B x, usz n) { VTY(x,t_i32slice); return m_i32(c(I32Slice,x)->a[n]); } -void i32arr_free(Value* x) { decSh(x); } -bool i32arr_canStore(B x) { return q_i32(x); } - -static inline void i32arr_init() { - ti[t_i32arr].get = i32arr_get; ti[t_i32slice].get = i32slice_get; - ti[t_i32arr].getU = i32arr_get; ti[t_i32slice].getU = i32slice_get; - ti[t_i32arr].slice = i32arr_slice; ti[t_i32slice].slice = i32slice_slice; - ti[t_i32arr].free = i32arr_free; ti[t_i32slice].free = slice_free; - ti[t_i32arr].visit = noop_visit; ti[t_i32slice].visit = slice_visit; - ti[t_i32arr].print = arr_print; ti[t_i32slice].print = arr_print; - ti[t_i32arr].isArr = true; ti[t_i32slice].isArr = true; - ti[t_i32arr].arrD1 = true; ti[t_i32slice].arrD1 = true; - ti[t_i32arr].elType = el_i32; ti[t_i32slice].elType = el_i32; - ti[t_i32arr].canStore = i32arr_canStore; - i32* tmp; bi_emptyIVec = m_i32arrv(&tmp, 0); - gc_add(bi_emptyIVec); -} diff --git a/src/load.c b/src/load.c index 9910683b..54693970 100644 --- a/src/load.c +++ b/src/load.c @@ -1,5 +1,14 @@ -#include "h.h" +#include "core.h" +#include "vm.h" +#include "utils/file.h" +B rtPerf_wrap(B x); // consumes + +_Thread_local B comp_currPath; +_Thread_local B comp_currArgs; + +B rt_sortDsc, rt_merge, rt_undo, rt_select, rt_slash, rt_join, rt_ud, rt_pick,rt_take, + rt_drop, rt_group, rt_under, rt_reverse, rt_indexOf, rt_count, rt_memberOf, rt_find, rt_cell; Block* load_compObj(B x, B src) { // consumes BS2B xget = TI(x).get; usz xia = a(x)->ia; @@ -9,7 +18,8 @@ Block* load_compObj(B x, B src) { // consumes dec(x); return r; } -#ifdef RT_SRC +#include "gen/src" +#if RT_SRC Block* load_compImport(B bc, B objs, B blocks, B inds, B src) { // consumes all return compile(bc, objs, blocks, inds, bi_N, src); } @@ -37,7 +47,7 @@ void load_gcFn() { mm_visit(comp_currArgs); } -Block* bqn_comp(B str, B path, B args) { // consumes all +NOINLINE Block* bqn_comp(B str, B path, B args) { // consumes all comp_currPath = path; comp_currArgs = args; Block* r = load_compObj(c2(load_comp, inc(load_compArg), inc(str)), str); @@ -89,14 +99,14 @@ static inline void load_init() { B runtime_0[] = {bi_floor,bi_ceil,bi_stile,bi_lt,bi_gt,bi_ne,bi_ge,bi_rtack,bi_ltack,bi_join,bi_take,bi_drop,bi_select,bi_const,bi_swap,bi_each,bi_fold,bi_atop,bi_over,bi_before,bi_after,bi_cond,bi_repeat}; #else Block* runtime0_b = load_compImport( - #include "runtime0" + #include "gen/runtime0" ); B r0r = m_funBlock(runtime0_b, 0); ptr_dec(runtime0_b); B* runtime_0 = toHArr(r0r)->a; #endif Block* runtime_b = load_compImport( - #include "runtime1" + #include "gen/runtime1" ); #ifdef ALL_R0 @@ -108,11 +118,10 @@ static inline void load_init() { B rtFinish = TI(rtRes).get(rtRes,1); dec(rtRes); - runtimeLen = c(Arr,rtObjRaw)->ia; + if (c(Arr,rtObjRaw)->ia != rtLen) err("incorrectly defined rtLen!"); HArr_p runtimeH = m_harrUc(rtObjRaw); BS2B rtObjGet = TI(rtObjRaw).get; - rt_sortAsc = rtObjGet(rtObjRaw, 10); gc_add(rt_sortAsc); rt_sortDsc = rtObjGet(rtObjRaw, 11); gc_add(rt_sortDsc); rt_merge = rtObjGet(rtObjRaw, 13); gc_add(rt_merge); rt_undo = rtObjGet(rtObjRaw, 48); gc_add(rt_undo); @@ -132,7 +141,7 @@ static inline void load_init() { rt_find = rtObjGet(rtObjRaw, 40); gc_add(rt_find); rt_cell = rtObjGet(rtObjRaw, 45); gc_add(rt_cell); - for (usz i = 0; i < runtimeLen; i++) { + for (usz i = 0; i < rtLen; i++) { #ifdef ALL_R1 B r = rtObjGet(rtObjRaw, i); #else @@ -158,7 +167,7 @@ static inline void load_init() { #ifdef NO_COMP Block* c = load_compObj( - #include "interp" + #include "gen/interp" ); B interp = m_funBlock(c, 0); ptr_dec(c); print(interp); @@ -167,7 +176,7 @@ static inline void load_init() { exit(0); #else // use compiler Block* comp_b = load_compImport( - #include "compiler" + #include "gen/compiler" ); load_comp = m_funBlock(comp_b, 0); ptr_dec(comp_b); gc_add(load_comp); @@ -175,7 +184,7 @@ static inline void load_init() { #ifdef FORMATTER Block* fmt_b = load_compImport( - #include "formatter" + #include "gen/formatter" ); B fmtM = m_funBlock(fmt_b, 0); ptr_dec(fmt_b); B fmtR = c1(fmtM, m_caB(4, (B[]){inc(bi_type), inc(bi_decp), inc(bi_fmtF), inc(bi_repr)})); @@ -192,3 +201,71 @@ static inline void load_init() { B bqn_execFile(B path, B args) { // consumes both return bqn_exec(file_chars(inc(path)), path, args); } + + + + +static void freed_visit(Value* x) { + #ifndef CATCH_ERRORS + err("visiting t_freed\n"); + #endif +} +static void empty_free(Value* x) { err("FREEING EMPTY\n"); } +static void builtin_free(Value* x) { err("FREEING BUILTIN\n"); } +static void def_free(Value* x) { } +static void def_visit(Value* x) { printf("(no visit for %d=%s)\n", x->type, format_type(x->type)); } +static void def_print(B x) { printf("(%d=%s)", v(x)->type, format_type(v(x)->type)); } +static bool def_canStore(B x) { return false; } +static B def_identity(B f) { return bi_N; } +static B def_get(B x, usz n) { return inc(x); } +static B def_m1_d(B m, B f ) { thrM("cannot derive this"); } +static B def_m2_d(B m, B f, B g) { thrM("cannot derive this"); } +static B def_slice(B x, usz s) { thrM("cannot slice non-array!"); } + +static inline void base_init() { + for (i32 i = 0; i < t_COUNT; i++) { + ti[i].free = def_free; + ti[i].visit = def_visit; + ti[i].get = def_get; + ti[i].getU = def_getU; + ti[i].print = def_print; + ti[i].m1_d = def_m1_d; + ti[i].m2_d = def_m2_d; + ti[i].isArr = false; + ti[i].arrD1 = false; + ti[i].elType = el_B; + ti[i].identity = def_identity; + ti[i].decompose = def_decompose; + ti[i].slice = def_slice; + ti[i].canStore = def_canStore; + ti[i].fn_uc1 = def_fn_uc1; + ti[i].fn_ucw = def_fn_ucw; + ti[i].m1_uc1 = def_m1_uc1; + ti[i].m1_ucw = def_m1_ucw; + ti[i].m2_uc1 = def_m2_uc1; + ti[i].m2_ucw = def_m2_ucw; + } + ti[t_empty].free = empty_free; + ti[t_freed].free = def_free; + ti[t_freed].visit = freed_visit; + ti[t_shape].visit = noop_visit; + ti[t_funBI].visit = ti[t_md1BI].visit = ti[t_md2BI].visit = noop_visit; + ti[t_funBI].free = ti[t_md1BI].free = ti[t_md2BI].free = builtin_free; + bi_N = tag(0, TAG_TAG); + bi_noVar = tag(1, TAG_TAG); + bi_badHdr = tag(2, TAG_TAG); + bi_optOut = tag(3, TAG_TAG); + bi_noFill = tag(5, TAG_TAG); + assert((MD1_TAG>>1) == (MD2_TAG>>1)); // just to be sure it isn't changed incorrectly, `isMd` depends on this +} + +#define FOR_INIT(F) F(base) F(harr) F(fillarr) F(i32arr) F(c32arr) F(f64arr) F(hash) F(fns) F(sfns) F(arith) F(sort) F(md1) F(md2) F(sysfn) F(derv) F(comp) F(rtPerf) F(ns) F(load) +#define F(X) void X##_init(); +FOR_INIT(F) +#undef F +void cbqn_init() { + #define F(X) X##_init(); + FOR_INIT(F) + #undef F +} +#undef FOR_INIT diff --git a/src/main.c b/src/main.c index d4854621..f6de2c38 100644 --- a/src/main.c +++ b/src/main.c @@ -1,74 +1,13 @@ -// #define ATOM_I32 -#ifdef DEBUG - // #define DEBUG_VM -#endif +#include "core.h" +#include "vm.h" +#include "utils/utf.h" -#define CATCH_ERRORS // whether to allow catching errors; currently means refcounts won't be accurate and can't be tested for -#define ENABLE_GC // whether to ever garbage-collect -// #define HEAP_VERIFY // enable usage of heapVerify() -// #define ALLOC_STAT // store basic allocation statistics -// #define ALLOC_SIZES // store per-type allocation size statistics -// #define USE_VALGRIND // whether to mark freed memory for valgrind -// #define DONT_FREE // don't actually ever free objects, such that they can be printed after being freed for debugging -// #define OBJ_COUNTER // store a unique allocation number with each object for easier analysis -// #define ALL_R0 // use all of r0.bqn for runtime_0 -// #define ALL_R1 // use all of r1.bqn for runtime -// #define RT_SRC // whether ./genRuntimeSrc was used to generate precompiled sources -#define TYPED_ARITH true // whether to use typed arith -#define VM_POS true // whether to store detailed execution position information for stacktraces -#define CHECK_VALID true // whether to check for valid arguments in places where that would be detrimental to performance (e.g. left argument sortedness of ⍋/⍒, incompatible changes in ⌾, etc) -#define EACH_FILLS false // whether to try to squeeze out fills for ¨ and ⌜ -#define SFNS_FILLS true // whether to insert fills for structural functions (∾, ≍, etc) -#define FAKE_RUNTIME false // whether to disable the self-hosted runtime - -// #define LOG_GC // log GC stats -// #define FORMATTER // use self-hosted formatter for output -// #define TIME // output runtime of every expression -// #define RT_PERF // time runtime primitives -// #define NO_COMP // don't load the compiler, instead execute src/interp; needed for ./precompiled.bqn - - -#include "h.h" -#include "stuff.c" -#include "heap.c" -#include "mm_buddy.c" -#include "harr.c" -#include "i32arr.c" -#include "c32arr.c" -#include "f64arr.c" -#include "fillarr.c" -#include "hash.c" -#include "mut.c" -#include "utf.c" -#include "file.c" -#include "derv.c" -#include "fns.c" -#include "sfns.c" -#include "sysfn.c" -#include "sort.c" -#include "arith.c" -#include "md1.c" -#include "md2.c" -#include "vm.c" -#include "ns.c" -#include "rtPerf.c" -#include "load.c" +// TODO these are hacks around not needing tiny headers +Block* bqn_comp(B str, B path, B args); +void rtPerf_print(); int main(int argc, char* argv[]) { cbqn_init(); - // M_b2i* map = m_b2i(16); - // i32 data[] = {5,7,1,5,9,5,3,1,7,9,4,2,6,8,43,3,234,123,5435,435,6745,23,2332,2,3,5,63,3,87}; - // for (i32 i = 0; i < 29; i++) { - // printf("upd %d→%d: %d\n", data[i], i, upd_b2i(&map, m_i32(data[i]), i, false)); - // } - // printf("sz=%ld pop=%ld\n", map->sz, map->pop); - // u64 sz = map->sz; - // for (u64 i = 0; i < sz; i++) { - // Ent_b2i e = map->ent[i]; - // if (e.hash) { print(e.key); printf(": %d\n", e.val); } - // } - // free_b2i(map); - // exit(0); // expects a copy of mlochbaum/BQN/src/c.bqn to be at the execution directory (with •args replaced with the array in glyphs.bqn) #if defined(COMP_COMP) || defined(COMP_COMP_TIME) @@ -182,8 +121,8 @@ int main(int argc, char* argv[]) { while (true) { // exit by evaluating an empty expression char* ln = NULL; size_t gl = 0; - getline(&ln, &gl, stdin); - if (ln[0]==0 || ln[0]==10) break; + i64 read = getline(&ln, &gl, stdin); + if (read<=0 || ln[0]==0 || ln[0]==10) break; Block* block = bqn_comp(fromUTF8(ln, strlen(ln)), inc(replPath), inc(bi_emptyHVec)); free(ln); diff --git a/src/mm_malloc.c b/src/mm_malloc.c deleted file mode 100644 index b0e4ab98..00000000 --- a/src/mm_malloc.c +++ /dev/null @@ -1,32 +0,0 @@ -#include "h.h" -#include - -void mm_free(Value* x) { - onFree(x); - free(x); -} - -void* mm_allocN(usz sz, u8 type) { - Value* x = malloc(sz); - onAlloc(sz, type); - x->flags = x->extra = x->mmInfo = x->type = 0; - x->refc = 1; - x->type = type; - return x; -} - - -void gc_add(B x) { } -void gc_addFn(vfn f) { } -void gc_disable() { } -void gc_enable() { } -void gc_maybeGC() { } -void gc_forceGC() { } -void gc_visitRoots() { } -void mm_visit(B x) { } -void mm_visitP(void* x) { } - -u64 mm_round(usz x) { return x; } -u64 mm_size(Value* x) { return -1; } -u64 mm_totalAllocated() { return -1; } -void mm_forHeap(V2v f) { } diff --git a/src/ns.c b/src/ns.c index 9348cbc6..0efa7eed 100644 --- a/src/ns.c +++ b/src/ns.c @@ -1,3 +1,4 @@ +#include "core.h" #include "ns.h" void m_nsDesc(Body* body, bool imm, u8 ty, B nameList, B varIDs, B exported) { // consumes nameList @@ -102,7 +103,7 @@ void nsDesc_visit(Value* x) { void nsDesc_print(B x) { printf("(namespace description)"); } -static inline void ns_init() { +void ns_init() { ti[t_ns].free = ns_free; ti[t_nsDesc].free = nsDesc_free; ti[t_ns].visit = ns_visit; ti[t_nsDesc].visit = nsDesc_visit; ti[t_ns].print = ns_print; ti[t_nsDesc].print = nsDesc_print; diff --git a/src/ns.h b/src/ns.h index d722247f..944cae6b 100644 --- a/src/ns.h +++ b/src/ns.h @@ -1,5 +1,4 @@ #pragma once -#include "h.h" #include "vm.h" typedef struct NSDesc { diff --git a/src/gc.c b/src/opt/gc.c similarity index 74% rename from src/gc.c rename to src/opt/gc.c index e7988aea..636ff6a3 100644 --- a/src/gc.c +++ b/src/opt/gc.c @@ -1,10 +1,6 @@ -#pragma once -#include "h.h" - - +#include "gc.h" u64 gc_depth = 1; -void gc_disable() { gc_depth++; } -void gc_enable() { gc_depth--; } + vfn gc_roots[16]; u32 gc_rootSz; @@ -12,6 +8,7 @@ void gc_addFn(vfn f) { if (gc_rootSz>=16) err("Too many GC roots"); gc_roots[gc_rootSz++] = f; } + B gc_rootObjs[256]; u32 gc_rootObjSz; void gc_add(B x) { @@ -19,41 +16,13 @@ void gc_add(B x) { gc_rootObjs[gc_rootObjSz++] = x; } + #ifdef LOG_GC u64 gc_visitBytes, gc_visitCount, gc_freedBytes, gc_freedCount; #endif u8 gc_tagCurr = 0x80; // if no gc is running, this is what all objects will have u8 gc_tagNew = 0x00; -void mm_visit(B x) { - #ifdef HEAP_VERIFY - if(heapVerify_visit(x)) return; - #endif - - if (!isVal(x)) return; - Value* vx = v(x); - u8 p = vx->mmInfo; - if ((p&0x80)==gc_tagNew) return; - vx->mmInfo = p^0x80; - #ifdef LOG_GC - gc_visitBytes+= mm_size(vx); gc_visitCount++; - #endif - TI(x).visit(vx); -} -void mm_visitP(void* xp) { - #ifdef HEAP_VERIFY - if(heapVerify_visitP(xp)) return; - #endif - - Value* x = (Value*)xp; - u8 p = x->mmInfo; - if ((p&0x80)==gc_tagNew) return; - x->mmInfo = p^0x80; - #ifdef LOG_GC - gc_visitBytes+= mm_size(x); gc_visitCount++; - #endif - ti[x->type].visit(x); -} void gc_tryFree(Value* v) { u8 t = v->type; #if defined(DEBUG) && !defined(CATCH_ERRORS) diff --git a/src/opt/gc.h b/src/opt/gc.h new file mode 100644 index 00000000..64c67795 --- /dev/null +++ b/src/opt/gc.h @@ -0,0 +1,44 @@ +#pragma once + +extern u64 gc_depth; +static void gc_disable() { gc_depth++; } +static void gc_enable() { gc_depth--; } +void gc_addFn(vfn f); +void gc_add(B x); + + +extern u8 gc_tagCurr; // if no gc is running, this is what all objects will have +extern u8 gc_tagNew; +#ifdef LOG_GC +extern u64 gc_visitBytes, gc_visitCount, gc_freedBytes, gc_freedCount; +#endif + +static void mm_visit(B x) { + #ifdef HEAP_VERIFY + if(heapVerify_visit(x)) return; + #endif + + if (!isVal(x)) return; + Value* vx = v(x); + u8 p = vx->mmInfo; + if ((p&0x80)==gc_tagNew) return; + vx->mmInfo = p^0x80; + #ifdef LOG_GC + gc_visitBytes+= mm_size(vx); gc_visitCount++; + #endif + TI(x).visit(vx); +} +static void mm_visitP(void* xp) { + #ifdef HEAP_VERIFY + if(heapVerify_visitP(xp)) return; + #endif + + Value* x = (Value*)xp; + u8 p = x->mmInfo; + if ((p&0x80)==gc_tagNew) return; + x->mmInfo = p^0x80; + #ifdef LOG_GC + gc_visitBytes+= mm_size(x); gc_visitCount++; + #endif + ti[x->type].visit(x); +} diff --git a/src/opt/mm_2buddy.c b/src/opt/mm_2buddy.c new file mode 100644 index 00000000..9567d5cc --- /dev/null +++ b/src/opt/mm_2buddy.c @@ -0,0 +1,14 @@ +#include "gc.c" + +#ifdef OBJ_COUNTER +u64 currObjCounter; +#endif + +EmptyValue* b1_buckets[64]; +b1_AllocInfo* b1_al; +u64 b1_alCap; +u64 b1_alSize; +EmptyValue* b3_buckets[64]; +b3_AllocInfo* b3_al; +u64 b3_alCap; +u64 b3_alSize; diff --git a/src/mm_2buddy.c b/src/opt/mm_2buddy.h similarity index 79% rename from src/mm_2buddy.c rename to src/opt/mm_2buddy.h index 0f2a4762..90a6aed5 100644 --- a/src/mm_2buddy.c +++ b/src/opt/mm_2buddy.h @@ -1,5 +1,4 @@ -#include "h.h" -#include "gc.c" +#include "gc.h" typedef struct EmptyValue EmptyValue; struct EmptyValue { // needs set: mmInfo; type=t_empty; next; everything else can be garbage @@ -12,7 +11,7 @@ struct EmptyValue { // needs set: mmInfo; type=t_empty; next; everything else ca #define MMI(X) X #define BN(X) b1_##X #define buckets b1_buckets -#include "mm_buddyTemplate.c" +#include "mm_buddyTemplate.h" #undef buckets #undef BN #undef BSZ @@ -23,15 +22,17 @@ struct EmptyValue { // needs set: mmInfo; type=t_empty; next; everything else ca #define MMI(X) ((X)|64) #define BN(X) b3_##X #define buckets b3_buckets -#include "mm_buddyTemplate.c" +#include "mm_buddyTemplate.h" #undef buckets #undef BN #undef BSZ #undef BSZI + #ifdef OBJ_COUNTER -u64 currObjCounter; +extern u64 currObjCounter; #endif -void* mm_allocN(usz sz, u8 type) { + +static void* mm_allocN(usz sz, u8 type) { assert(sz>=16); onAlloc(sz, type); u8 b1 = 64-__builtin_clzl(sz-1ull); @@ -43,26 +44,26 @@ void* mm_allocN(usz sz, u8 type) { #endif return r; } -void mm_free(Value* x) { +static void mm_free(Value* x) { if (x->mmInfo&64) b3_free(x); else b1_free(x); } -void mm_forHeap(V2v f) { +static void mm_forHeap(V2v f) { b1_forHeap(f); b3_forHeap(f); } -u64 mm_round(usz x) { +static u64 mm_round(usz x) { u8 b1 = 64-__builtin_clzl(x-1ull); u64 s3 = 3ull<<(b1-2); if (x<=s3) return s3; return 1ull<mmInfo; if (m&64) return 3ull<<(x->mmInfo&63); else return 1ull<<(x->mmInfo&63); } -u64 mm_heapAllocated() { +static u64 mm_heapAllocated() { return b1_heapAllocated() + b3_heapAllocated(); } diff --git a/src/opt/mm_buddy.c b/src/opt/mm_buddy.c new file mode 100644 index 00000000..d31e493f --- /dev/null +++ b/src/opt/mm_buddy.c @@ -0,0 +1,10 @@ +#include "gc.c" + +#ifdef OBJ_COUNTER +u64 currObjCounter; +#endif + +EmptyValue* buckets[64]; +mm_AllocInfo* mm_al; +u64 mm_alCap; +u64 mm_alSize; diff --git a/src/mm_buddy.c b/src/opt/mm_buddy.h similarity index 75% rename from src/mm_buddy.c rename to src/opt/mm_buddy.h index 084c7d72..990b9afc 100644 --- a/src/mm_buddy.c +++ b/src/opt/mm_buddy.h @@ -1,5 +1,4 @@ -#include "h.h" -#include "gc.c" +#include "gc.h" typedef struct EmptyValue EmptyValue; struct EmptyValue { // needs set: mmInfo; type=t_empty; next; everything else can be garbage @@ -12,12 +11,13 @@ struct EmptyValue { // needs set: mmInfo; type=t_empty; next; everything else ca #define MMI(X) X #define BN(X) mm_##X -#include "mm_buddyTemplate.c" +#include "mm_buddyTemplate.h" #ifdef OBJ_COUNTER -u64 currObjCounter; +extern u64 currObjCounter; #endif -void* mm_allocN(usz sz, u8 type) { + +static void* mm_allocN(usz sz, u8 type) { assert(sz>=16); onAlloc(sz, type); Value* r = mm_allocL(BSZI(sz), type); @@ -27,10 +27,10 @@ void* mm_allocN(usz sz, u8 type) { return r; } -u64 mm_round(usz sz) { +static u64 mm_round(usz sz) { return BSZ(BSZI(sz)); } -u64 mm_size(Value* x) { +static u64 mm_size(Value* x) { return BSZ(x->mmInfo&63); } diff --git a/src/mm_buddyTemplate.c b/src/opt/mm_buddyTemplate.h similarity index 91% rename from src/mm_buddyTemplate.c rename to src/opt/mm_buddyTemplate.h index 341b8eaf..6a43a03e 100644 --- a/src/mm_buddyTemplate.c +++ b/src/opt/mm_buddyTemplate.h @@ -1,4 +1,4 @@ -EmptyValue* buckets[64]; +extern EmptyValue* buckets[64]; #define AllocInfo BN(AllocInfo) #define al BN(al) @@ -8,9 +8,9 @@ typedef struct AllocInfo { Value* p; u64 sz; } AllocInfo; -AllocInfo* al; -u64 alCap; -u64 alSize; +extern AllocInfo* al; +extern u64 alCap; +extern u64 alSize; static NOINLINE EmptyValue* BN(makeEmpty)(u8 bucket) { // result->next is garbage u8 cb = bucket; @@ -54,7 +54,7 @@ static NOINLINE EmptyValue* BN(makeEmpty)(u8 bucket) { // result->next is garbag return c; } -void BN(free)(Value* x) { +static void BN(free)(Value* x) { onFree(x); #ifdef USE_VALGRIND VALGRIND_MAKE_MEM_UNDEFINED(x, BSZ(x->mmInfo&63)); @@ -72,7 +72,7 @@ void BN(free)(Value* x) { x->type = t_empty; } -void* BN(allocL)(u8 bucket, u8 type) { +static void* BN(allocL)(u8 bucket, u8 type) { EmptyValue* x = buckets[bucket]; if (RARE(x==NULL)) x = BN(makeEmpty)(bucket); else buckets[bucket] = x->next; @@ -87,7 +87,7 @@ void* BN(allocL)(u8 bucket, u8 type) { x->type = type; return x; } -void BN(forHeap)(V2v f) { +static void BN(forHeap)(V2v f) { for (u64 i = 0; i < alSize; i++) { AllocInfo ci = al[i]; Value* s = ci.p; @@ -98,7 +98,7 @@ void BN(forHeap)(V2v f) { } } } -u64 BN(heapAllocated)() { +static u64 BN(heapAllocated)() { u64 res = 0; for (u64 i = 0; i < alSize; i++) res+= al[i].sz; return res; diff --git a/src/opt/mm_malloc.c b/src/opt/mm_malloc.c new file mode 100644 index 00000000..8c1ef1b6 --- /dev/null +++ b/src/opt/mm_malloc.c @@ -0,0 +1,9 @@ +#include "../core.h" +#include +#include + +void gc_add(B x) { } +void gc_addFn(vfn f) { } +void gc_maybeGC() { } +void gc_forceGC() { } +void gc_visitRoots() { } diff --git a/src/opt/mm_malloc.h b/src/opt/mm_malloc.h new file mode 100644 index 00000000..63f82dcb --- /dev/null +++ b/src/opt/mm_malloc.h @@ -0,0 +1,33 @@ +#include +#include + +static void mm_free(Value* x) { + onFree(x); + free(x); +} + +static void* mm_allocN(usz sz, u8 type) { + Value* x = malloc(sz); + onAlloc(sz, type); + x->flags = x->extra = x->mmInfo = x->type = 0; + x->refc = 1; + x->type = type; + return x; +} + + +static void gc_disable() { } +static void gc_enable() { } +static void mm_visit(B x) { } +static void mm_visitP(void* x) { } + +void gc_add(B x); +void gc_addFn(vfn f); +void gc_maybeGC(); +void gc_forceGC(); +void gc_visitRoots(); + +static u64 mm_round(usz x) { return x; } +static u64 mm_size(Value* x) { return malloc_usable_size(x); } +static u64 mm_totalAllocated() { return -1; } +static void mm_forHeap(V2v f) { } diff --git a/src/opt/single.c b/src/opt/single.c new file mode 100644 index 00000000..f171ecc0 --- /dev/null +++ b/src/opt/single.c @@ -0,0 +1,25 @@ +#include "../core.h" +#include "../core/i32arr.c" +#include "../core/c32arr.c" +#include "../core/f64arr.c" +#include "../core/harr.c" +#include "../core/fillarr.c" +#include "../core/stuff.c" +#include "../core/derv.c" +#include "../core/mm.c" +#include "../core/heap.c" +#include "../utils/hash.c" +#include "../utils/utf.c" +#include "../utils/file.c" +#include "../builtins/fns.c" +#include "../builtins/sfns.c" +#include "../builtins/sysfn.c" +#include "../builtins/sort.c" +#include "../builtins/arith.c" +#include "../builtins/md1.c" +#include "../builtins/md2.c" +#include "../vm.c" +#include "../ns.c" +#include "../rtPerf.c" +#include "../load.c" +#include "../main.c" diff --git a/src/rtPerf.c b/src/rtPerf.c index b5890e78..f3211977 100644 --- a/src/rtPerf.c +++ b/src/rtPerf.c @@ -1,3 +1,5 @@ +#include "core.h" + #ifdef RT_PERF typedef struct WFun WFun; struct WFun { @@ -197,7 +199,7 @@ B wm1_ucw(B t, B o, B f, B w, B x) { B t2 = c(WMd1,t)->v; return TI(t2).m1_ B wm2_uc1(B t, B o, B f, B g, B x) { B t2 = c(WMd2,t)->v; return TI(t2).m2_uc1(t2, o, f, g, x); } B wm2_ucw(B t, B o, B f, B g, B w, B x) { B t2 = c(WMd2,t)->v; return TI(t2).m2_ucw(t2, o, f, g, w, x); } -static inline void rtPerf_init() { +void rtPerf_init() { ti[t_funPerf].visit = wf_visit; ti[t_funPerf].identity = wf_identity; ti[t_md1Perf].visit = wm1_visit; ti[t_md1Perf].m1_d = m_md1D; ti[t_md2Perf].visit = wm2_visit; ti[t_md2Perf].m2_d = m_md2D; @@ -209,6 +211,6 @@ static inline void rtPerf_init() { ti[t_md2Perf].m2_ucw = wm2_ucw; } #else -static inline void rtPerf_init() { } -static inline void rtPerf_print() { } +void rtPerf_init() { } +void rtPerf_print() { } #endif diff --git a/src/utils/each.h b/src/utils/each.h new file mode 100644 index 00000000..2182d8c4 --- /dev/null +++ b/src/utils/each.h @@ -0,0 +1,150 @@ +#pragma once +#include "mut.h" + +static inline B mv(B* p, usz n) { B r = p [n]; p [n] = m_f64(0); return r; } +static inline B hmv(HArr_p p, usz n) { B r = p.a[n]; p.a[n] = m_f64(0); return r; } + +static B eachd_fn(BBB2B f, B fo, B w, B x) { // consumes w,x; assumes at least one is array + if (isAtm(w)) w = m_atomUnit(w); + if (isAtm(x)) x = m_atomUnit(x); + ur wr = rnk(w); BS2B wget = TI(w).get; + ur xr = rnk(x); BS2B xget = TI(x).get; + bool wg = wr>xr; + ur rM = wg? wr : xr; + ur rm = wg? xr : wr; + if (rM==0) { + B r = f(fo, wget(w,0), xget(x,0)); + dec(w); dec(x); + return m_hunit(r); + } + if (rm && !eqShPrefix(a(w)->sh, a(x)->sh, rm)) thrF("Mapping: Expected equal shape prefix (%H ≡ ≢𝕨, %H ≡ ≢𝕩)", w, x); + 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), hmv(r,i)); dec(c); } + else if (xr==0) { B c=xget(x, 0); for(usz i = 0; i < ria; i++) r.a[i] = f(fo, hmv(r,i), inc(c) ); dec(c); } + else { + assert(wr==xr); + if (rw) for (usz i = 0; i < ria; i++) r.a[i] = f(fo, hmv(r,i), xget(x,i)); + else for (usz i = 0; i < ria; i++) r.a[i] = f(fo, wget(w,i), hmv(r,i)); + } + dec(rw? x : w); + return r.b; + } + + 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; + 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 rb; +} + +static B eachm_fn(BB2B f, B fo, B x) { // consumes x; x must be array + usz ia = a(x)->ia; + if (ia==0) return x; + BS2B xget = TI(x).get; + usz i = 0; + B cr = f(fo, xget(x,0)); + HArr_p rH; + if (TI(x).canStore(cr)) { + bool reuse = reusable(x); + if (v(x)->type==t_harr) { + B* xp = harr_ptr(x); + if (reuse) { + dec(xp[i]); xp[i++] = cr; + for (; i < ia; i++) xp[i] = f(fo, mv(xp,i)); + return x; + } else { + 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 (TI(x).elType==el_i32) { + i32* xp = i32any_ptr(x); + B r; i32* rp; + if (reuse && v(x)->type==t_i32arr) { r=x; rp = xp; } + else r = m_i32arrc(&rp, x); + rp[i++] = o2iu(cr); + for (; i < ia; i++) { + cr = f(fo, m_i32(xp[i])); + if (!q_i32(cr)) { + 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; + } + rp[i] = o2iu(cr); + } + if (!reuse) dec(x); + return r; + } else if (TI(x).elType==el_f64) { + f64* xp = f64any_ptr(x); + B r; f64* rp; + if (reuse && v(x)->type==t_f64arr) { r=x; rp = xp; } + else r = m_f64arrc(&rp, x); + rp[i++] = o2fu(cr); + for (; i < ia; i++) { + cr = f(fo, m_f64(xp[i])); + if (!q_f64(cr)) { + rH = m_harrs(ia, &i); + for (usz j = 0; j < i; j++) rH.a[j] = m_f64(rp[j]); + if (!reuse) dec(r); + goto fallback; + } + rp[i] = o2fu(cr); + } + if (!reuse) dec(x); + return r; + } else if (v(x)->type==t_fillarr) { + B* xp = fillarr_ptr(x); + if (reuse) { + dec(c(FillArr,x)->fill); + c(FillArr,x)->fill = bi_noFill; + dec(xp[i]); xp[i++] = cr; + for (; i < ia; i++) xp[i] = f(fo, mv(xp,i)); + return x; + } else { + HArr_p rp = m_harrs(ia, &i); + rp.a[i++] = cr; + for (; i < ia; i++) rp.a[i] = f(fo, inc(xp[i])); + return harr_fcd(rp, x); + } + } else + rH = m_harrs(ia, &i); + } else + rH = m_harrs(ia, &i); + fallback: + rH.a[i++] = cr; + for (; i < ia; i++) rH.a[i] = f(fo, xget(x,i)); + return harr_fcd(rH, x); +} + +static B eachm(B f, B x) { // complete F¨ x without fills + if (isAtm(x)) return m_hunit(c1(f, x)); + if (isFun(f)) return eachm_fn(c(Fun,f)->c1, f, x); + if (isMd(f)) if (isAtm(x) || a(x)->ia) { decR(x); thrM("Calling a modifier"); } + + usz ia = a(x)->ia; + MAKE_MUT(r, ia); + mut_fill(r, 0, f, ia); + return mut_fcd(r, x); +} + +static B eachd(B f, B w, B x) { // complete w F¨ x without fills + if (isAtm(w) & isAtm(x)) return m_hunit(c2(f, w, x)); + return eachd_fn(c2fn(f), f, w, x); +} diff --git a/src/file.c b/src/utils/file.c similarity index 91% rename from src/file.c rename to src/utils/file.c index 82061a0c..525983af 100644 --- a/src/file.c +++ b/src/utils/file.c @@ -1,9 +1,7 @@ -typedef struct TmpFile { // to be turned into a proper I8Arr - struct Arr; - i8 a[]; -} TmpFile; +#include "../core.h" +#include "file.h" -FILE* file_open(B path, char* desc, char* mode) { // doesn't consume; can error +static FILE* file_open(B path, char* desc, char* mode) { // doesn't consume; can error u64 plen = utf8lenB(path); TALLOC(char, p, plen+1); toUTF8(path, p); @@ -74,7 +72,7 @@ B path_dir(B path) { // consumes; returns directory part of file path, with trai } -void file_write(B path, B x) { // consumes path +void file_write(B path, B x) { // consumes path; may throw FILE* f = file_open(path, "write to", "w"); u64 len = utf8lenB(x); diff --git a/src/utils/file.h b/src/utils/file.h new file mode 100644 index 00000000..d969d2a6 --- /dev/null +++ b/src/utils/file.h @@ -0,0 +1,14 @@ +#pragma once +#include "utf.h" + +typedef struct TmpFile { // to be turned into a proper I8Arr + struct Arr; + i8 a[]; +} TmpFile; + +B path_resolve(B base, B rel); // consumes rel; may error; assumes base is a char vector or bi_N +B path_dir(B path); // consumes; returns directory part of file path, with trailing slash; may error + +TmpFile* file_bytes(B path); // consumes; may throw +B file_chars(B path); // consumes; may throw +void file_write(B path, B x); // consumes path; may throw diff --git a/src/utils/hash.c b/src/utils/hash.c new file mode 100644 index 00000000..aed205de --- /dev/null +++ b/src/utils/hash.c @@ -0,0 +1,12 @@ +#include "../core.h" +#include "hash.h" + +u64 wy_secret[4]; + +void hash_init() { + u64 bad1=0xa0761d6478bd642full; // values wyhash64 is afraid of + u64 bad2=0xe7037ed1a0b428dbull; + again: + make_secret(nsTime(), wy_secret); + for (u64 i = 0; i < 4; i++) if(wy_secret[i]==bad1 || wy_secret[i]==bad2) goto again; +} diff --git a/src/hash.c b/src/utils/hash.h similarity index 51% rename from src/hash.c rename to src/utils/hash.h index 6d8d9221..147d5d5f 100644 --- a/src/hash.c +++ b/src/utils/hash.h @@ -1,40 +1,9 @@ -#include "h.h" +#pragma once #include "wyhash.h" -B bqn_squeeze(B x) { - assert(isArr(x)); - u8 xe = TI(x).elType; - if (xe==el_i32 || xe==el_c32) return x; - usz ia = a(x)->ia; - if (ia==0) return x; - if (xe==el_f64) { - f64* xp = f64any_ptr(x); - for (usz i = 0; i < ia; i++) if (xp[i] != (f64)(i32)xp[i]) return x; - return tag(toI32Arr(x), ARR_TAG); - } - assert(xe==el_B); - BS2B xgetU = TI(x).getU; - B x0 = xgetU(x, 0); - if (isNum(x0)) { - for (usz i = 0; i < ia; i++) { - B c = xgetU(x, i); - if (!isNum(c)) return x; - if (!q_i32(c)) { - for (i++; i < ia; i++) if (!isNum(xgetU(x, i))) return x; - return tag(toF64Arr(x), ARR_TAG); - } - } - return tag(toI32Arr(x), ARR_TAG); - } else if (isC32(x0)) { - for (usz i = 1; i < ia; i++) { - B c = xgetU(x, i); - if (!isC32(c)) return x; - } - return tag(toC32Arr(x), ARR_TAG); - } else return x; -} +extern u64 wy_secret[4]; -u64 bqn_hash(B x, const u64 secret[4]) { // doesn't consume +static u64 bqn_hash(B x, const u64 secret[4]) { // doesn't consume if (isAtm(x)) { if (q_f64(x)) return wyhash64(secret[0], x.u); if (isC32(x)) return wyhash64(secret[1], x.u); @@ -65,8 +34,7 @@ u64 bqn_hash(B x, const u64 secret[4]) { // doesn't consume return r; } -u64 wy_secret[4]; -u64 bqn_hashP(B x, const u64 secret[4]) { // bqn_hash but never zero +static u64 bqn_hashP(B x, const u64 secret[4]) { // bqn_hash but never zero u64 r = bqn_hash(x, secret); return LIKELY(r)?r:secret[3]; // bias towards secret[3], whatever } @@ -85,7 +53,7 @@ u64 bqn_hashP(B x, const u64 secret[4]) { // bqn_hash but never zero #define EQUAL(A,B) equal(A,B) #define VALS #define VT i32 -#include "hashmap.c" +#include "hashmap.h" #define N(X) X##_Sb #define HT u64 @@ -97,14 +65,4 @@ u64 bqn_hashP(B x, const u64 secret[4]) { // bqn_hash but never zero #define HDEF 0 #define KEYS #define EQUAL(A,B) equal(A,B) -#include "hashmap.c" - - - -void hash_init() { - u64 bad1=0xa0761d6478bd642full; // values wyhash64 is afraid of - u64 bad2=0xe7037ed1a0b428dbull; - again: - make_secret(nsTime(), wy_secret); - for (u64 i = 0; i < 4; i++) if(wy_secret[i]==bad1 || wy_secret[i]==bad2) goto again; -} +#include "hashmap.h" diff --git a/src/hashmap.c b/src/utils/hashmap.h similarity index 97% rename from src/hashmap.c rename to src/utils/hashmap.h index 0aedd0b3..d1e96ff3 100644 --- a/src/hashmap.c +++ b/src/utils/hashmap.h @@ -44,7 +44,7 @@ typedef struct Map { Ent a[]; } Map; -Map* N(m) (u64 sz) { +static Map* N(m) (u64 sz) { assert(sz && (sz & sz-1)==0); Map* r = mm_allocN(fsizeof(Map,a,Ent,sz), t_hashmap); #ifdef HDEF @@ -58,7 +58,7 @@ Map* N(m) (u64 sz) { r->pop = 0; return r; } -void N(free) (Map* m) { +static void N(free) (Map* m) { mm_free((Value*) m); } @@ -106,7 +106,7 @@ static inline void N(qins) (Map* m, u64 h1, HT h2, KT k IFVAL(, VT v)) { // if g if (p++==mask) p = 0; } } -void N(dbl) (Map** m) { +static void N(dbl) (Map** m) { Map* pm = *m; u64 psz = pm->sz; Map* nm = N(m)(psz*2); diff --git a/src/mut.c b/src/utils/mut.h similarity index 90% rename from src/mut.c rename to src/utils/mut.h index dc8399b2..bd4998c6 100644 --- a/src/mut.c +++ b/src/utils/mut.h @@ -1,3 +1,5 @@ +#pragma once + typedef struct Mut { u8 type; usz ia; @@ -11,7 +13,7 @@ typedef struct Mut { } Mut; #define MAKE_MUT(N, IA) Mut N##_val; N##_val.type = el_MAX; N##_val.ia = (IA); Mut* N = &N##_val; -void mut_to(Mut* m, u8 n) { +static void mut_to(Mut* m, u8 n) { u8 o = m->type; assert(o!=el_B); m->type = n; @@ -44,28 +46,28 @@ void mut_to(Mut* m, u8 n) { } } -B mut_fv(Mut* m) { assert(m->type!=el_MAX); +static B mut_fv(Mut* m) { assert(m->type!=el_MAX); m->val->sh = &m->val->ia; B r = tag(m->val, ARR_TAG); srnk(r, 1); return r; } -B mut_fp(Mut* m) { assert(m->type!=el_MAX); // has ia set +static B mut_fp(Mut* m) { assert(m->type!=el_MAX); // has ia set return tag(m->val, ARR_TAG); } -B mut_fc(Mut* m, B x) { assert(m->type!=el_MAX); +static B mut_fc(Mut* m, B x) { assert(m->type!=el_MAX); B r = tag(m->val, ARR_TAG); arr_shCopy(r, x); return r; } -B mut_fcd(Mut* m, B x) { assert(m->type!=el_MAX); +static B mut_fcd(Mut* m, B x) { assert(m->type!=el_MAX); B r = tag(m->val, ARR_TAG); arr_shCopy(r, x); dec(x); return r; } -u8 el_or(u8 a, u8 b) { +static u8 el_or(u8 a, u8 b) { #define M(X) if(b==X) return a>X?a:X; switch (a) { default: UD; case el_c32: M(el_c32); return el_B; @@ -77,12 +79,12 @@ u8 el_or(u8 a, u8 b) { #undef M } -void mut_pfree(Mut* m, usz n) { // free the first n elements +static void mut_pfree(Mut* m, usz n) { // free the first n elements if (m->type==el_B) harr_pfree(tag(m->val,ARR_TAG), n); else mm_free((Value*) m->val); } -void mut_set(Mut* m, usz ms, B x) { // consumes x; sets m[ms] to x +static void mut_set(Mut* m, usz ms, B x) { // consumes x; sets m[ms] to x again: #define AGAIN(T) { mut_to(m, T); goto again; } switch(m->type) { default: UD; @@ -110,7 +112,7 @@ void mut_set(Mut* m, usz ms, B x) { // consumes x; sets m[ms] to x } #undef AGAIN } -void mut_setS(Mut* m, usz ms, B x) { // consumes; sets m[ms] to x, assumes the current type can store it +static void mut_setS(Mut* m, usz ms, B x) { // consumes; sets m[ms] to x, assumes the current type can store it switch(m->type) { default: UD; case el_i32: { assert(q_i32(x)); m->ai32[ms] = o2iu(x); @@ -130,10 +132,10 @@ void mut_setS(Mut* m, usz ms, B x) { // consumes; sets m[ms] to x, assumes the c } } } -void mut_rm(Mut* m, usz ms) { // clears the object at position ms +static void mut_rm(Mut* m, usz ms) { // clears the object at position ms if (m->type == el_B) dec(m->aB[ms]); } -B mut_getU(Mut* m, usz ms) { +static B mut_getU(Mut* m, usz ms) { switch(m->type) { default: UD; case el_i32: return m_i32(m->ai32[ms]); case el_c32: return m_c32(m->ac32[ms]); @@ -143,7 +145,7 @@ B mut_getU(Mut* m, usz ms) { } // doesn't consume; fills m[ms…ms+l] with x -void mut_fill(Mut* m, usz ms, B x, usz l) { +static void mut_fill(Mut* m, usz ms, B x, usz l) { again: #define AGAIN(T) { mut_to(m, T); goto again; } switch(m->type) { default: UD; @@ -182,7 +184,7 @@ void mut_fill(Mut* m, usz ms, B x, usz l) { // expects x to be an array, each position must be written to precisely once // doesn't consume x -void mut_copy(Mut* m, usz ms, B x, usz xs, usz l) { +static void mut_copy(Mut* m, usz ms, B x, usz xs, usz l) { assert(isArr(x)); u8 xt = v(x)->type; u8 xe = ti[xt].elType; @@ -239,7 +241,7 @@ void mut_copy(Mut* m, usz ms, B x, usz xs, usz l) { } -B vec_join(B w, B x) { // consumes both +static B vec_join(B w, B x) { // consumes both usz wia = a(w)->ia; usz xia = a(x)->ia; usz ria = wia+xia; @@ -296,7 +298,7 @@ B vec_join(B w, B x) { // consumes both dec(w); dec(x); return mut_fv(r); } -B vec_add(B w, B x) { // consumes both +static B vec_add(B w, B x) { // consumes both usz wia = a(w)->ia; usz ria = wia+1; if (v(w)->refc==1) { diff --git a/src/utf.c b/src/utils/utf.c similarity index 82% rename from src/utf.c rename to src/utils/utf.c index 8561c3ff..a69aafc8 100644 --- a/src/utf.c +++ b/src/utils/utf.c @@ -1,11 +1,14 @@ -i8 utf8lenb(u8 ch) { +#include "../core.h" +#include "utf.h" + +static i8 utf8lenb(u8 ch) { if (ch<128) return 1; if ((ch>>5)== 0b110) return 2; if ((ch>>4)== 0b1110) return 3; if ((ch>>3)==0b11110) return 4; return -1; } -u32 utf8_p(u8* p) { +static u32 utf8_p(u8* p) { i32 len = utf8lenb(*p); switch (len) { default: UD; case -1: return (u32)-1; @@ -15,6 +18,7 @@ u32 utf8_p(u8* p) { case 4: return (0b111u &*p)<<18 | (0b111111u&p[3]) | (0b111111u&p[2])<<6 | (0b111111u&p[1])<<12; } } + B fromUTF8(char* s, i64 len) { u64 sz = 0; i64 j = 0; @@ -46,12 +50,6 @@ void printUTF8(u32 c) { else printf("%c%c%c%c", 0xF0| c>>18, 0x80|(c>>12&0x3F), 0x80|(c>>6&0x3F), 0x80|(c&0x3F)); } -u64 snprintUTF8(char* p, u64 l, u32 c) { - if (c<128) return snprintf(p, l, "%c", c); - else if (c<=0x07FF) return snprintf(p, l, "%c%c" , 0xC0|c>>6 , 0x80|(c &0x3F) ); - else if (c<=0xFFFF) return snprintf(p, l, "%c%c%c" , 0xE0|c>>12, 0x80|(c>>6 &0x3F), 0x80|(c &0x3F) ); - else return snprintf(p, l, "%c%c%c%c", 0xF0|c>>18, 0x80|(c>>12&0x3F), 0x80|(c>>6&0x3F), 0x80|(c&0x3F)); -} u64 utf8lenB(B x) { // doesn't consume; may error as it verifies whether is all chars assert(isArr(x)); diff --git a/src/utils/utf.h b/src/utils/utf.h new file mode 100644 index 00000000..f72b1ab1 --- /dev/null +++ b/src/utils/utf.h @@ -0,0 +1,9 @@ +#pragma once + +B fromUTF8(char* s, i64 len); +B fromUTF8l(char* s); + +void printUTF8(u32 c); + +u64 utf8lenB(B x); // doesn't consume; may error as it verifies whether is all chars +void toUTF8(B x, char* p); // doesn't consume; doesn't verify anything; p must have utf8lenB(x) bytes (calculating which should verify that this call is ok) diff --git a/src/wyhash.h b/src/utils/wyhash.h similarity index 100% rename from src/wyhash.h rename to src/utils/wyhash.h diff --git a/src/vm.c b/src/vm.c index db5963f0..6d8996ef 100644 --- a/src/vm.c +++ b/src/vm.c @@ -1,13 +1,7 @@ +#include "core.h" #include "vm.h" #include "ns.h" - -// #define GS_REALLOC // whether to dynamically realloc gStack -#ifndef GS_SIZE -#define GS_SIZE 65536 // if !GS_REALLOC, size in number of B objects of the global object stack -#endif -#ifndef ENV_SIZE -#define ENV_SIZE 4096 // max recursion depth; GS_SIZE and C stack size may limit this -#endif +#include "utils/utf.h" enum { PUSH = 0, // N; push object from objs[N] @@ -103,7 +97,25 @@ void printBC(i32* p) { -Block* compile(B bcq, B objs, B blocksq, B indices, B tokenInfo, B src) { // consumes all +B* gStack; // points to after end +B* gStackStart; +B* gStackEnd; +void gsPrint() { + B* c = gStackStart; + i32 i = 0; + while (c!=gStack) { + printf("%d: ", i); + print(*c); + printf(", refc=%d\n", v(*c)->refc); + c++; + i++; + } +} + + + + +NOINLINE Block* compile(B bcq, B objs, B blocksq, B indices, B tokenInfo, B src) { // consumes all HArr* blocksH = toHArr(blocksq); usz bam = blocksH->ia; @@ -256,84 +268,12 @@ B v_get(Scope* pscs[], B s) { // get value representing s, replacing with bi_opt -// all don't consume anything -B m_funBlock(Block* bl, Scope* psc); // may return evaluated result, whatever -B m_md1Block(Block* bl, Scope* psc); -B m_md2Block(Block* bl, Scope* psc); + #ifdef DEBUG_VM i32 bcDepth=-2; i32* vmStack; i32 bcCtr = 0; #endif - - - - -B* gStack; // points to after end -B* gStackStart; -B* gStackEnd; -void gsReserve(u64 am) { - #ifdef GS_REALLOC - if (am>gStackEnd-gStack) { - u64 n = gStackEnd-gStackStart + am + 500; - u64 d = gStack-gStackStart; - gStackStart = realloc(gStackStart, n*sizeof(B)); - gStack = gStackStart+d; - gStackEnd = gStackStart+n; - } - #elif DEBUG - if (am>gStackEnd-gStack) thrM("Stack overflow"); - #endif -} -#ifdef GS_REALLOC -NOINLINE -#endif -void gsReserveR(u64 am) { gsReserve(am); } -void gsAdd(B x) { - #ifdef GS_REALLOC - if (gStack==gStackEnd) gsReserveR(1); - #else - if (gStack==gStackEnd) thrM("Stack overflow"); - #endif - *(gStack++) = x; -} -B gsPop() { - return *--gStack; -} -void gsPrint() { - B* c = gStackStart; - i32 i = 0; - while (c!=gStack) { - printf("%d: ", i); - print(*c); - printf(", refc=%d\n", v(*c)->refc); - c++; - i++; - } -} - - - -typedef struct Env { - Scope* sc; - union { i32* bcL; i32 bcV; }; -} Env; - -Env* envCurr; -Env* envStart; -Env* envEnd; - -static inline void pushEnv(Scope* sc, i32* bc) { - if (envCurr==envEnd) thrM("Stack overflow"); - envCurr->sc = sc; - envCurr->bcL = bc; - envCurr++; -} -static inline void popEnv() { - assert(envCurr>envStart); - envCurr--; -} - B evalBC(Body* b, Scope* sc) { // doesn't consume #ifdef DEBUG_VM bcDepth+= 2; @@ -648,7 +588,7 @@ void allocStack(void** curr, void** start, void** end, i32 elSize, i32 count) { mprotect(*end, pageSize, PROT_NONE); // idk first way i found to force erroring on overflow } -static inline void comp_init() { +void comp_init() { ti[t_comp ].free = comp_free; ti[t_comp ].visit = comp_visit; ti[t_comp ].print = comp_print; ti[t_body ].free = body_free; ti[t_body ].visit = body_visit; ti[t_body ].print = body_print; ti[t_block ].free = block_free; ti[t_block ].visit = block_visit; ti[t_block ].print = block_print; diff --git a/src/vm.h b/src/vm.h index cc515be7..ce4687ac 100644 --- a/src/vm.h +++ b/src/vm.h @@ -1,5 +1,4 @@ #pragma once -#include "h.h" typedef struct Block Block; typedef struct Body Body; typedef struct Scope Scope; @@ -43,6 +42,38 @@ struct Scope { B vars[]; }; +typedef struct Env { + Scope* sc; + union { i32* bcL; i32 bcV; }; +} Env; + +NOINLINE Block* compile(B bcq, B objs, B blocksq, B indices, B tokenInfo, B src); +NOINLINE void vm_pst(Env* s, Env* e); + typedef struct FunBlock { struct Fun; Scope* sc; Block* bl; } FunBlock; typedef struct Md1Block { struct Md1; Scope* sc; Block* bl; } Md1Block; typedef struct Md2Block { struct Md2; Scope* sc; Block* bl; } Md2Block; +// all don't consume anything +B m_funBlock(Block* bl, Scope* psc); // may return evaluated result, whatever +B m_md1Block(Block* bl, Scope* psc); +B m_md2Block(Block* bl, Scope* psc); + + + + + + +Env* envCurr; +Env* envStart; +Env* envEnd; + +static inline void pushEnv(Scope* sc, i32* bc) { + if (envCurr==envEnd) thrM("Stack overflow"); + envCurr->sc = sc; + envCurr->bcL = bc; + envCurr++; +} +static inline void popEnv() { + assert(envCurr>envStart); + envCurr--; +}