incremental compilation
This commit is contained in:
parent
f26cd2a03b
commit
b2b826be9b
12
.gitignore
vendored
12
.gitignore
vendored
@ -1,10 +1,6 @@
|
||||
main.s
|
||||
BQN
|
||||
src/runtime
|
||||
src/runtime0
|
||||
src/runtime1
|
||||
src/compiler
|
||||
src/interp
|
||||
src/formatter
|
||||
c.bqn
|
||||
perf.*
|
||||
perf.*
|
||||
obj/*/*.o
|
||||
obj/*/*.d
|
||||
obj/*/*.tmp
|
||||
|
||||
4
build
4
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
|
||||
|
||||
4
buildg
4
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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"
|
||||
|
||||
18
makefile
Normal file
18
makefile
Normal file
@ -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
|
||||
1
obj/debug/makefile
Symbolic link
1
obj/debug/makefile
Symbolic link
@ -0,0 +1 @@
|
||||
/home/dzaima/CLionProjects/bqn/obj/subMakefile
|
||||
1
obj/o3/makefile
Symbolic link
1
obj/o3/makefile
Symbolic link
@ -0,0 +1 @@
|
||||
/home/dzaima/CLionProjects/bqn/obj/subMakefile
|
||||
1
obj/rtperf/makefile
Symbolic link
1
obj/rtperf/makefile
Symbolic link
@ -0,0 +1 @@
|
||||
/home/dzaima/CLionProjects/bqn/obj/subMakefile
|
||||
45
obj/subMakefile
Normal file
45
obj/subMakefile
Normal file
@ -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
|
||||
@ -1,4 +1,5 @@
|
||||
#include "h.h"
|
||||
#include "../core.h"
|
||||
#include "../utils/each.h"
|
||||
#include <math.h>
|
||||
|
||||
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);
|
||||
@ -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;
|
||||
@ -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");
|
||||
@ -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; i<xdia; i++) if(!isPureFn(xdp[i])) { dec(xd); return false; }
|
||||
dec(xd); return true;
|
||||
} else if (isArr(x)) {
|
||||
usz ia = a(x)->ia;
|
||||
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;
|
||||
}
|
||||
|
||||
@ -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
|
||||
@ -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;
|
||||
@ -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
|
||||
@ -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;
|
||||
105
src/c32arr.c
105
src/c32arr.c
@ -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);
|
||||
}
|
||||
51
src/core.h
Normal file
51
src/core.h
Normal file
@ -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;
|
||||
}
|
||||
49
src/core/c32arr.c
Normal file
49
src/core/c32arr.c
Normal file
@ -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);
|
||||
}
|
||||
57
src/core/c32arr.h
Normal file
57
src/core/c32arr.h
Normal file
@ -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;
|
||||
}
|
||||
55
src/core/derv.c
Normal file
55
src/core/derv.c
Normal file
@ -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;
|
||||
}
|
||||
47
src/core/derv.h
Normal file
47
src/core/derv.h
Normal file
@ -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); }
|
||||
34
src/core/f64arr.c
Normal file
34
src/core/f64arr.c
Normal file
@ -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;
|
||||
}
|
||||
43
src/core/f64arr.h
Normal file
43
src/core/f64arr.h
Normal file
@ -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);
|
||||
}
|
||||
@ -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));
|
||||
111
src/core/fillarr.h
Normal file
111
src/core/fillarr.h
Normal file
@ -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);
|
||||
}
|
||||
45
src/core/gstack.h
Normal file
45
src/core/gstack.h
Normal file
@ -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;
|
||||
}
|
||||
@ -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;
|
||||
90
src/core/harr.h
Normal file
90
src/core/harr.h
Normal file
@ -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; }
|
||||
|
||||
@ -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));
|
||||
23
src/core/heap.h
Normal file
23
src/core/heap.h
Normal file
@ -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
|
||||
36
src/core/i32arr.c
Normal file
36
src/core/i32arr.c
Normal file
@ -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);
|
||||
}
|
||||
48
src/core/i32arr.h
Normal file
48
src/core/i32arr.h
Normal file
@ -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);
|
||||
}
|
||||
11
src/core/mm.c
Normal file
11
src/core/mm.c
Normal file
@ -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
|
||||
@ -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 <sys/mman.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#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; i<wia; i++) if(!equalR(wdp[i], xdp[i]))
|
||||
{ dec(wd);dec(xd); return false; }
|
||||
dec(wd);dec(xd); return true;
|
||||
}
|
||||
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;
|
||||
}
|
||||
B bqn_merge(B x);
|
||||
|
||||
#define CMP(W,X) ({ AUTO wt = (W); AUTO xt = (X); (wt>xt?1:0)-(wt<xt?1:0); })
|
||||
i32 compare(B w, B x) {
|
||||
if (isNum(w) & isNum(x)) return CMP(o2fu(w), o2fu(x));
|
||||
@ -340,132 +231,168 @@ i32 compare(B w, B x) {
|
||||
#undef CMP
|
||||
|
||||
|
||||
|
||||
|
||||
bool eqShPrefix(usz* w, usz* x, ur len) {
|
||||
return memcmp(w, x, len*sizeof(usz))==0;
|
||||
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; i<wia; i++) if(!equalR(wdp[i], xdp[i]))
|
||||
{ dec(wd);dec(xd); return false; }
|
||||
dec(wd);dec(xd); return true;
|
||||
}
|
||||
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);
|
||||
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; i<xdia; i++) if(!isPureFn(xdp[i])) { dec(xd); return false; }
|
||||
dec(xd); return true;
|
||||
} else if (isArr(x)) {
|
||||
usz ia = a(x)->ia;
|
||||
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 <valgrind/valgrind.h>
|
||||
#include <valgrind/memcheck.h>
|
||||
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<t_COUNT);
|
||||
#ifdef ALLOC_SIZES
|
||||
actrs[(sz+3)/4>=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
|
||||
261
src/core/stuff.h
Normal file
261
src/core/stuff.h
Normal file
@ -0,0 +1,261 @@
|
||||
extern u64 allocB; // currently allocated number of bytes
|
||||
|
||||
#include <sys/mman.h>
|
||||
#include <unistd.h>
|
||||
|
||||
// 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 <valgrind/valgrind.h>
|
||||
#include <valgrind/memcheck.h>
|
||||
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<t_COUNT);
|
||||
#ifdef ALLOC_SIZES
|
||||
actrs[(sz+3)/4>=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;
|
||||
91
src/derv.c
91
src/derv.c
@ -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;
|
||||
}
|
||||
80
src/f64arr.c
80
src/f64arr.c
@ -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;
|
||||
}
|
||||
2
src/gen/.gitignore
vendored
Normal file
2
src/gen/.gitignore
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
*
|
||||
!.gitignore
|
||||
425
src/h.h
425
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 <inttypes.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
@ -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<assert.h>
|
||||
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 w<x, 1 if w>x, 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∾<x for vector w
|
||||
bool eqShPrefix(usz* w, usz* x, ur len);
|
||||
|
||||
B m_v1(B a ); // consumes all
|
||||
B m_v2(B a, B b ); // consumes all
|
||||
B m_v3(B a, B b, B c ); // consumes all
|
||||
B m_v4(B a, B b, B c, B d); // consumes all
|
||||
B m_unit (B x); // consumes
|
||||
B m_hunit(B x); // consumes
|
||||
static B m_unit (B x); // consumes
|
||||
static B m_hunit(B x); // consumes
|
||||
B m_str32(u32* s); // meant to be used as m_str32(U"{𝕨‿𝕩}"), so doesn't free for you
|
||||
|
||||
B bqn_exec(B str, B path, B args); // consumes both
|
||||
@ -298,7 +303,7 @@ void print_vmStack();
|
||||
B validate(B x);
|
||||
Value* validateP(Value* x);
|
||||
#endif
|
||||
B err(char* s) {
|
||||
static B err(char* s) {
|
||||
puts(s); fflush(stdout);
|
||||
print_vmStack();
|
||||
__builtin_trap();
|
||||
@ -307,114 +312,64 @@ B err(char* s) {
|
||||
|
||||
// tag checks
|
||||
#ifdef ATOM_I32
|
||||
bool isI32(B x) { return (x.u>>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 n<I32_MAX? m_i32((i32)n) : m_f64(n); }
|
||||
static B m_usz(usz n) { return n<I32_MAX? m_i32((i32)n) : m_f64(n); }
|
||||
|
||||
i32 o2i (B x) { if (x.f!=(f64)(i32)x.f) thrM("Expected integer"); return (i32)x.f; } // i have no clue whether these consume or not, but it doesn't matter
|
||||
usz o2s (B x) { if (x.f!=(f64)(usz)x.f) thrM("Expected integer"); return (usz)x.f; }
|
||||
i64 o2i64 (B x) { if (x.f!=(f64)(i64)x.f) thrM("Expected integer"); return (i64)x.f; }
|
||||
u64 o2u64 (B x) { if (x.f!=(f64)(u64)x.f) thrM("Expected integer"); return (u64)x.f; }
|
||||
f64 o2f (B x) { if (!isNum(x)) thrM("Expected integer"); return x.f; }
|
||||
u32 o2c (B x) { if (!isC32(x)) thrM("Expected character"); return (u32)x.u; }
|
||||
i32 o2iu (B x) { return isI32(x)? (i32)(u32)x.u : (i32)x.f; }
|
||||
i32 o2cu (B x) { return (u32)x.u; }
|
||||
usz o2su (B x) { return (usz)x.f; }
|
||||
f64 o2fu (B x) { return x.f; }
|
||||
i64 o2i64u(B x) { return (i64)x.f; }
|
||||
bool o2b (B x) { usz t=o2s(x); if(t!=0&t!=1)thrM("Expected boolean"); return t; }
|
||||
bool q_i32(B x) { return isI32(x) | (isF64(x) && x.f==(f64)(i32)x.f); }
|
||||
bool q_i64(B x) { return isI32(x) | (isF64(x) && x.f==(f64)(i64)x.f); }
|
||||
bool q_f64(B x) { return isF64(x) || isI32(x); }
|
||||
static i32 o2i (B x) { if (x.f!=(f64)(i32)x.f) thrM("Expected integer"); return (i32)x.f; } // i have no clue whether these consume or not, but it doesn't matter
|
||||
static usz o2s (B x) { if (x.f!=(f64)(usz)x.f) thrM("Expected integer"); return (usz)x.f; }
|
||||
static i64 o2i64 (B x) { if (x.f!=(f64)(i64)x.f) thrM("Expected integer"); return (i64)x.f; }
|
||||
static u64 o2u64 (B x) { if (x.f!=(f64)(u64)x.f) thrM("Expected integer"); return (u64)x.f; }
|
||||
static f64 o2f (B x) { if (!isNum(x)) thrM("Expected integer"); return x.f; }
|
||||
static u32 o2c (B x) { if (!isC32(x)) thrM("Expected character"); return (u32)x.u; }
|
||||
static i32 o2iu (B x) { return isI32(x)? (i32)(u32)x.u : (i32)x.f; }
|
||||
static i32 o2cu (B x) { return (u32)x.u; }
|
||||
static usz o2su (B x) { return (usz)x.f; }
|
||||
static f64 o2fu (B x) { return x.f; }
|
||||
static i64 o2i64u(B x) { return (i64)x.f; }
|
||||
static bool o2b (B x) { usz t=o2s(x); if(t!=0&t!=1)thrM("Expected boolean"); return t; }
|
||||
static bool q_i32(B x) { return isI32(x) | (isF64(x) && x.f==(f64)(i32)x.f); }
|
||||
static bool q_i64(B x) { return isI32(x) | (isF64(x) && x.f==(f64)(i64)x.f); }
|
||||
static bool q_f64(B x) { return isF64(x) || isI32(x); }
|
||||
|
||||
|
||||
typedef struct Slice {
|
||||
struct Arr;
|
||||
B p;
|
||||
} Slice;
|
||||
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); }
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
88
src/i32arr.c
88
src/i32arr.c
@ -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);
|
||||
}
|
||||
99
src/load.c
99
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
|
||||
|
||||
77
src/main.c
77
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);
|
||||
|
||||
|
||||
@ -1,32 +0,0 @@
|
||||
#include "h.h"
|
||||
#include<stdlib.h>
|
||||
|
||||
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) { }
|
||||
3
src/ns.c
3
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;
|
||||
|
||||
1
src/ns.h
1
src/ns.h
@ -1,5 +1,4 @@
|
||||
#pragma once
|
||||
#include "h.h"
|
||||
#include "vm.h"
|
||||
|
||||
typedef struct NSDesc {
|
||||
|
||||
@ -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)
|
||||
44
src/opt/gc.h
Normal file
44
src/opt/gc.h
Normal file
@ -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);
|
||||
}
|
||||
14
src/opt/mm_2buddy.c
Normal file
14
src/opt/mm_2buddy.c
Normal file
@ -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;
|
||||
@ -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<<b1;
|
||||
}
|
||||
u64 mm_size(Value* x) {
|
||||
static u64 mm_size(Value* x) {
|
||||
u8 m = x->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();
|
||||
}
|
||||
10
src/opt/mm_buddy.c
Normal file
10
src/opt/mm_buddy.c
Normal file
@ -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;
|
||||
@ -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);
|
||||
}
|
||||
|
||||
@ -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;
|
||||
9
src/opt/mm_malloc.c
Normal file
9
src/opt/mm_malloc.c
Normal file
@ -0,0 +1,9 @@
|
||||
#include "../core.h"
|
||||
#include <stdlib.h>
|
||||
#include <malloc.h>
|
||||
|
||||
void gc_add(B x) { }
|
||||
void gc_addFn(vfn f) { }
|
||||
void gc_maybeGC() { }
|
||||
void gc_forceGC() { }
|
||||
void gc_visitRoots() { }
|
||||
33
src/opt/mm_malloc.h
Normal file
33
src/opt/mm_malloc.h
Normal file
@ -0,0 +1,33 @@
|
||||
#include <stdlib.h>
|
||||
#include <malloc.h>
|
||||
|
||||
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) { }
|
||||
25
src/opt/single.c
Normal file
25
src/opt/single.c
Normal file
@ -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"
|
||||
@ -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
|
||||
|
||||
150
src/utils/each.h
Normal file
150
src/utils/each.h
Normal file
@ -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);
|
||||
}
|
||||
@ -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);
|
||||
14
src/utils/file.h
Normal file
14
src/utils/file.h
Normal file
@ -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
|
||||
12
src/utils/hash.c
Normal file
12
src/utils/hash.c
Normal file
@ -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;
|
||||
}
|
||||
@ -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"
|
||||
@ -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);
|
||||
@ -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) {
|
||||
@ -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));
|
||||
9
src/utils/utf.h
Normal file
9
src/utils/utf.h
Normal file
@ -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)
|
||||
106
src/vm.c
106
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;
|
||||
|
||||
33
src/vm.h
33
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--;
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user