uCBQN/src/builtins/internal.c
dzaima f87a1155f5 store references instead of GC root functions to handle mutable roots
-0.21% binary size; mm_visit & mm_visitP got inlined in the gcFn-s, even though that's very pointless
2022-11-06 02:01:14 +02:00

326 lines
11 KiB
C
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#include "../core.h"
#include "../utils/file.h"
#include "../builtins.h"
#include "../ns.h"
B itype_c1(B t, B x) {
B r;
if(isVal(x)) {
r = m_c8vec_0(type_repr(TY(x)));
} else {
if (isF64(x)) r = m_c8vec_0("tagged f64");
else if (isC32(x)) r = m_c8vec_0("tagged c32");
else if (isTag(x)) r = m_c8vec_0("tagged tag");
else if (isVar(x)) r = m_c8vec_0("tagged var");
else if (isExt(x)) r = m_c8vec_0("tagged extvar");
else r = m_c8vec_0("tagged unknown");
}
dec(x);
return r;
}
B elType_c1(B t, B x) {
B r = m_i32(isArr(x)? TI(x,elType) : selfElType(x));
dec(x);
return r;
}
B refc_c1(B t, B x) {
B r = isVal(x)? m_i32(v(x)->refc) : m_c8vec_0("(not heap-allocated)");
dec(x);
return r;
}
B squeeze_c1(B t, B x) {
if (!isArr(x)) return x;
return any_squeeze(x);
}
B deepSqueeze_c1(B t, B x) {
return squeeze_deep(x);
}
B isPure_c1(B t, B x) {
B r = m_f64(isPureFn(x));
dec(x);
return r;
}
B info_c2(B t, B w, B x) {
B s = emptyCVec();
i32 m = o2i(w);
if (isVal(x)) {
if (m) AFMT("%xl: ", x.u);
else AFMT("%xl: ", x.u>>48);
Value* xv = v(x);
AFMT("refc:%i ", xv->refc);
if (m) {
AFMT("mmInfo:%i ", xv->mmInfo);
AFMT("flags:%i ", xv->flags);
AFMT("extra:%i ", xv->extra);
}
AFMT("type:%i=%S ", PTY(xv), type_repr(PTY(xv)));
AFMT("alloc:%l", mm_size(xv));
decG(x);
} else {
AFMT("%xl: ", x.u);
A8("not heap-allocated");
}
return s;
}
B info_c1(B t, B x) {
return info_c2(t, m_i32(0), x);
}
#define FOR_VARIATION(F) F(Ai8 ) F(Si8 ) F(Ai8Inc ) F(Si8Inc ) \
F(Ai16) F(Si16) F(Ai16Inc) F(Si16Inc) \
F(Ai32) F(Si32) F(Ai32Inc) F(Si32Inc) \
F(Ac8 ) F(Sc8 ) F(Ac8Inc ) F(Sc8Inc ) \
F(Ac16) F(Sc16) F(Ac16Inc) F(Sc16Inc) \
F(Ac32) F(Sc32) F(Ac32Inc) F(Sc32Inc) \
F(Af64) F(Sf64) F(Af64Inc) F(Sf64Inc) \
F(Ah) F(Sh) F(AhInc) F(ShInc) \
F(Af) F(Sf) F(AfInc) F(SfInc) \
F(Ab) F(AbInc)
#define F(X) static B v_##X;
FOR_VARIATION(F)
#undef F
static B listVariations_def;
B listVariations_c2(B t, B w, B x) {
if (!isArr(x)) thrM("•internal.ListVariations: 𝕩 must be an array");
if (!isArr(w) || RNK(w)!=1) thrM("•internal.ListVariations: 𝕨 must be a list");
usz wia = IA(w);
SGetU(w)
bool c_incr=false, c_rmFill=false;
for (usz i = 0; i < wia; i++) {
u32 c = o2c(GetU(w, i));
if (c=='i') c_incr=true;
else if (c=='f') c_rmFill=true;
else thrF("internal.ListVariations: Unknown option '%c' in 𝕨", c);
}
decG(w);
u8 xe = TI(x,elType);
B xf = getFillQ(x);
bool ah = c_rmFill || noFill(xf);
bool ai8=false, ai16=false, ai32=false, af64=false,
ac8=false, ac16=false, ac32=false, abit=false;
usz xia = IA(x);
SGetU(x)
if (isNum(xf)) {
i32 min=I32_MAX, max=I32_MIN;
if (xe==el_i8 ) { i8* xp = i8any_ptr (x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; } }
else if (xe==el_i16) { i16* xp = i16any_ptr(x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; } }
else if (xe==el_i32) { i32* xp = i32any_ptr(x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; } }
else if (xe==el_f64) { f64* xp = f64any_ptr(x); for (usz i = 0; i < xia; i++) { if (xp[i]>max) max=xp[i]; if (xp[i]<min) min=xp[i]; if(xp[i]!=(i32)xp[i]) goto onlyF64; } }
else for (usz i = 0; i < xia; i++) { B c = GetU(x, i); if (!isF64(c)) goto noSpec; if (c.f>max) max=c.f; if (c.f<min) min=c.f; }
ai8 = min==(i8 )min && max==(i8 )max;
ai16 = min==(i16)min && max==(i16)max;
ai32 = min==(i32)min && max==(i32)max;
abit = min>=0 && max<=1;
onlyF64:
af64 = true;
} else if (isC32(xf)) {
u32 max = 0;
if (xe!=el_c8) for (usz i = 0; i < xia; i++) {
B c = GetU(x, i);
if (!isC32(c)) goto noSpec;
if (o2cG(c)>max) max = o2cG(c);
}
ac8 = max == (u8 )max;
ac16 = max == (u16)max;
ac32 = true;
}
noSpec:;
B r = emptyHVec();
if(abit) { r=vec_addN(r,incG(v_Ab )); if(c_incr) { r=vec_addN(r,incG(v_AbInc )); } }
if(ai8 ) { r=vec_addN(r,incG(v_Ai8 ));r=vec_addN(r,incG(v_Si8 )); if(c_incr) { r=vec_addN(r,incG(v_Ai8Inc ));r=vec_addN(r,incG(v_Si8Inc )); } }
if(ai16) { r=vec_addN(r,incG(v_Ai16));r=vec_addN(r,incG(v_Si16)); if(c_incr) { r=vec_addN(r,incG(v_Ai16Inc));r=vec_addN(r,incG(v_Si16Inc)); } }
if(ai32) { r=vec_addN(r,incG(v_Ai32));r=vec_addN(r,incG(v_Si32)); if(c_incr) { r=vec_addN(r,incG(v_Ai32Inc));r=vec_addN(r,incG(v_Si32Inc)); } }
if(ac8 ) { r=vec_addN(r,incG(v_Ac8 ));r=vec_addN(r,incG(v_Sc8 )); if(c_incr) { r=vec_addN(r,incG(v_Ac8Inc ));r=vec_addN(r,incG(v_Sc8Inc )); } }
if(ac16) { r=vec_addN(r,incG(v_Ac16));r=vec_addN(r,incG(v_Sc16)); if(c_incr) { r=vec_addN(r,incG(v_Ac16Inc));r=vec_addN(r,incG(v_Sc16Inc)); } }
if(ac32) { r=vec_addN(r,incG(v_Ac32));r=vec_addN(r,incG(v_Sc32)); if(c_incr) { r=vec_addN(r,incG(v_Ac32Inc));r=vec_addN(r,incG(v_Sc32Inc)); } }
if(af64) { r=vec_addN(r,incG(v_Af64));r=vec_addN(r,incG(v_Sf64)); if(c_incr) { r=vec_addN(r,incG(v_Af64Inc));r=vec_addN(r,incG(v_Sf64Inc)); } }
if(ah) { r=vec_addN(r,incG(v_Ah ));r=vec_addN(r,incG(v_Sh )); if(c_incr) { r=vec_addN(r,incG(v_AhInc ));r=vec_addN(r,incG(v_ShInc )); } }
{ r=vec_addN(r,incG(v_Af ));r=vec_addN(r,incG(v_Sf )); if(c_incr) { r=vec_addN(r,incG(v_AfInc ));r=vec_addN(r,incG(v_SfInc )); } }
decG(x);
dec(xf);
return r;
}
B listVariations_c1(B t, B x) {
return listVariations_c2(t, incG(listVariations_def), x);
}
static bool u8_get(u8** cv, u8* cE, const char* x) {
u8* c = *cv;
while (true) {
if (!*x) {
*cv = c;
return true;
}
if (c==cE || *c!=*x) return false;
c++; x++;
}
}
static B variation_refs;
B variation_c2(B t, B w, B x) {
if (!isArr(w)) thrM("•internal.Variation: Non-array 𝕨");
if (!isArr(x)) thrM("•internal.Variation: Non-array 𝕩");
usz xia = IA(x);
C8Arr* wc = toC8Arr(w);
u8* wp = c8arrv_ptr(wc);
u8* wpE = wp+PIA(wc);
if (PIA(wc)==0) thrM("•internal.Variation: Zero-length 𝕨");
B res;
if (*wp == 'A' || *wp == 'S') {
bool slice = *wp == 'S';
wp++;
if (u8_get(&wp, wpE, "b" )) res = taga(cpyBitArr(incG(x)));
else if (u8_get(&wp, wpE, "i8" )) res = taga(cpyI8Arr (incG(x)));
else if (u8_get(&wp, wpE, "i16")) res = taga(cpyI16Arr(incG(x)));
else if (u8_get(&wp, wpE, "i32")) res = taga(cpyI32Arr(incG(x)));
else if (u8_get(&wp, wpE, "c8" )) res = taga(cpyC8Arr (incG(x)));
else if (u8_get(&wp, wpE, "c16")) res = taga(cpyC16Arr(incG(x)));
else if (u8_get(&wp, wpE, "c32")) res = taga(cpyC32Arr(incG(x)));
else if (u8_get(&wp, wpE, "f64")) res = taga(cpyF64Arr(incG(x)));
else if (u8_get(&wp, wpE, "h" )) res = taga(cpyHArr (incG(x)));
else if (u8_get(&wp, wpE, "f")) {
Arr* t = m_fillarrp(xia);
fillarr_setFill(t, getFillQ(x));
arr_shCopy(t, x);
HArr* h = NULL;
B* xp = arr_bptr(x);
if (xp==NULL) {
h = cpyHArr(incG(x));
xp = h->a;
}
B* rp = fillarr_ptr(t);
for (usz i = 0; i < xia; i++) rp[i] = inc(xp[i]);
if (h) ptr_dec(h);
res = taga(t);
} else thrF("•internal.Variation: Bad type \"%R\"", taga(wc));
if (slice) {
Arr* slice = TI(res,slice)(inc(res), 0, IA(res));
arr_shCopy(slice, res);
dec(res);
res = taga(slice);
}
if (u8_get(&wp, wpE, "Inc")) {
if (!variation_refs.u) {
variation_refs = emptyHVec();
}
variation_refs = vec_addN(variation_refs, incG(res));
}
if (wp!=wpE) thrM("•internal.Variation: Bad 𝕨");
} else thrM("•internal.Variation: Bad start of 𝕨");
decG(x);
ptr_dec(wc);
return res;
}
B clearRefs_c1(B t, B x) {
dec(x);
if (!isArr(variation_refs)) return m_f64(0);
usz res = IA(variation_refs);
dec(variation_refs);
variation_refs = m_f64(0);
return m_f64(res);
}
static B unshare(B x) {
if (!isArr(x)) return x;
usz xia = IA(x);
switch (TY(x)) {
case t_bitarr: return taga(cpyBitArr(inc(x)));
case t_i8arr: return taga(cpyI8Arr (inc(x)));
case t_i16arr: return taga(cpyI16Arr(inc(x)));
case t_i32arr: return taga(cpyI32Arr(inc(x)));
case t_c8arr: return taga(cpyC8Arr (inc(x)));
case t_c16arr: return taga(cpyC16Arr(inc(x)));
case t_c32arr: return taga(cpyC32Arr(inc(x)));
case t_f64arr: return taga(cpyF64Arr(inc(x)));
case t_harr: {
B* xp = harr_ptr(x);
M_HARR(r, xia)
for (usz i = 0; i < xia; i++) HARR_ADD(r, i, unshare(xp[i]));
return HARR_FC(r, x);
}
case t_fillarr: {
Arr* r = m_fillarrp(xia); arr_shCopy(r, x);
fillarr_setFill(r, unshare(c(FillArr,x)->fill));
B* rp = fillarr_ptr(r); B* xp = fillarr_ptr(a(x));
for (usz i = 0; i < xia; i++) rp[i] = unshare(xp[i]);
return taga(r);
}
default: thrF("•internal.Unshare: Cannot unshare array with type %i=%S", TY(x), type_repr(TY(x)));
}
}
B eequal_c2(B t, B w, B x) {
bool r = eequal(w, x);
dec(w); dec(x);
return m_i32(r);
}
#ifdef TEST_BITCPY
#include "../utils/mut.h"
#endif
B internalTemp_c1(B t, B x) {
#ifdef TEST_BITCPY
SGetU(x)
bit_cpy(bitarr_ptr(GetU(x,0)), o2s(GetU(x,1)), bitarr_ptr(GetU(x,2)), o2s(GetU(x,3)), o2s(GetU(x,4)));
#endif
return x;
}
#ifdef TEST_MUT
#include "../utils/calls.h"
#endif
B internalTemp_c2(B t, B w, B x) {
#ifdef TEST_MUT
SGetU(x)
FILL_TO(tyarr_ptr(w), o2s(GetU(x,0)), o2s(GetU(x,1)), GetU(x,2), o2s(GetU(x,3)));
#endif
return x;
}
B heapDump_c1(B t, B x) {
cbqn_heapDump();
return m_c32(0);
}
B unshare_c1(B t, B x) {
if (!isArr(x)) thrM("•internal.Unshare: Argument must be an array");
B r = unshare(x);
dec(x);
return r;
}
static B internalNS;
B getInternalNS() {
if (internalNS.u == 0) {
#define F(X) v_##X = m_c8vec_0(#X);
FOR_VARIATION(F)
#undef F
listVariations_def = m_c8vec_0("if");
gc_add(listVariations_def);
gc_add_ref(&variation_refs);
#define F(X) gc_add_ref(&v_##X); // 38 refs
FOR_VARIATION(F)
#undef F
#define F(X) incG(bi_##X),
Body* d = m_nnsDesc("type","eltype","refc","squeeze","ispure","info","listvariations","variation","clearrefs","unshare","deepsqueeze","heapdump","eequal","temp");
internalNS = m_nns(d,F(itype)F(elType)F(refc)F(squeeze)F(isPure)F(info)F(listVariations)F(variation)F(clearRefs)F(unshare)F(deepSqueeze)F(heapDump)F(eequal)F(internalTemp));
#undef F
gc_add(internalNS);
}
return incG(internalNS);
}