inverse headers
This commit is contained in:
parent
896049ab12
commit
f55e349999
2
makefile
2
makefile
@ -115,7 +115,7 @@ ${bd}/%.o: src/jit/%.c
|
||||
@echo $< | cut -c 5-
|
||||
@$(CMD) $@.d -o $@ -c $<
|
||||
|
||||
builtins: ${addprefix ${bd}/, arithm.o arithd.o cmp.o sfns.o sort.o md1.o md2.o fns.o sysfn.o internal.o}
|
||||
builtins: ${addprefix ${bd}/, arithm.o arithd.o cmp.o sfns.o sort.o md1.o md2.o fns.o sysfn.o internal.o inverse.o}
|
||||
${bd}/%.o: src/builtins/%.c
|
||||
@echo $< | cut -c 5-
|
||||
@$(CMD) $@.d -o $@ -c $<
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
/* sysfn.c*/M(type,"•Type") M(decp,"•Decompose") M(primInd,"•PrimInd") M(glyph,"•Glyph") A(fill,"•FillFn") M(sys,"•getsys") A(grLen,"•GroupLen") D(grOrd,"•GroupOrd") \
|
||||
/* sysfn.c*/M(repr,"•Repr") M(fmt,"•Fmt") A(asrt,"!") A(casrt,"!") M(out,"•Out") M(show,"•Show") A(bqn,"•BQN") A(sh,"•SH") M(fromUtf8,"•FromUTF8") \
|
||||
/* sysfn.c*/D(cmp,"•Cmp") A(hash,"•Hash") M(unixTime,"•UnixTime") M(monoTime,"•MonoTime") M(delay,"•Delay") M(makeRand,"•MakeRand") M(reBQN,"•ReBQN") M(exit,"•Exit") M(getLine,"•GetLine") \
|
||||
/* inverse.c*/M(setInvReg, "(SetInvReg)") M(setInvSwap, "(SetInvSwap)") M(nativeInvReg, "(NativeInvReg)") M(nativeInvSwap, "(NativeInvSwap)") \
|
||||
/*internal.c*/M(itype,"•internal.Type") M(elType,"•internal.ElType") M(refc,"•internal.Refc") M(isPure,"•internal.IsPure") A(info,"•internal.Info") \
|
||||
/*internal.c*/M(squeeze,"•internal.Squeeze") M(deepSqueeze,"•internal.DeepSqueeze") \
|
||||
/*internal.c*/D(variation,"•internal.Variation") A(listVariations,"•internal.ListVariations") M(clearRefs,"•internal.ClearRefs") M(unshare,"•internal.Unshare")
|
||||
@ -34,6 +35,7 @@ enum PrimNumbers {
|
||||
/* ´˝`∘○⊸⟜⌾⊘◶ */ n_fold , n_reduce , n_scan , n_atop , n_over , n_before , n_after , n_under, n_val , n_cond,
|
||||
/* ⎉⚇⍟⎊ */ n_cells , n_depth2 , n_repeat, n_catch
|
||||
};
|
||||
extern B rt_invFnReg, rt_invFnSwap;
|
||||
|
||||
enum PrimFns { pf_none,
|
||||
#define F(N,X) pf_##N,
|
||||
|
||||
42
src/builtins/inverse.c
Normal file
42
src/builtins/inverse.c
Normal file
@ -0,0 +1,42 @@
|
||||
#include "../core.h"
|
||||
#include "../builtins.h"
|
||||
#include "../nfns.h"
|
||||
|
||||
|
||||
static NFnDesc* fun_invRegDesc;
|
||||
static NFnDesc* fun_invSwapDesc;
|
||||
|
||||
B fun_invReg_c1(B t, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_im)(f, x);
|
||||
}
|
||||
B fun_invReg_c2(B t, B w, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_ix)(f, w, x);
|
||||
}
|
||||
|
||||
B fun_invSwap_c1(B t, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_is)(f, x);
|
||||
}
|
||||
B fun_invSwap_c2(B t, B w, B x) {
|
||||
B f = nfn_objU(t);
|
||||
return TI(f, fn_iw)(f, w, x);
|
||||
}
|
||||
|
||||
|
||||
B setInvReg_c1 (B t, B x) { rt_invFnReg = x; return inc(bi_nativeInvReg); }
|
||||
B setInvSwap_c1(B t, B x) { rt_invFnSwap = x; return inc(bi_nativeInvSwap); }
|
||||
B nativeInvReg_c1(B t, B x) {
|
||||
if (isFun(x)) return m_nfn(fun_invRegDesc, x);
|
||||
return c1(rt_invFnReg, x);
|
||||
}
|
||||
B nativeInvSwap_c1(B t, B x) {
|
||||
if (isFun(x)) return m_nfn(fun_invSwapDesc, x);
|
||||
return c1(rt_invFnSwap, x);
|
||||
}
|
||||
|
||||
void inverse_init() {
|
||||
fun_invRegDesc = registerNFn(m_str8l("(fun_invReg)"), fun_invReg_c1, fun_invReg_c2);
|
||||
fun_invSwapDesc = registerNFn(m_str8l("(fun_invSwap)"), fun_invSwap_c1, fun_invSwap_c2);
|
||||
}
|
||||
@ -36,7 +36,7 @@ void heapVerify() {
|
||||
heapVerify_mode=1; mm_forHeap(heapVerify_callVisit); gc_visitRoots();
|
||||
if (heap_observed) {
|
||||
printf("refc of last: %d\n", heap_observed->refc);
|
||||
heapVerify_mode=2; mm_forHeap(heap_getReferents);
|
||||
// heapVerify_mode=2; mm_forHeap(heap_getReferents);
|
||||
}
|
||||
heapVerify_mode=-1;
|
||||
}
|
||||
|
||||
8
src/h.h
8
src/h.h
@ -194,8 +194,10 @@ typedef union B {
|
||||
/*32*/ F(comp) F(block) F(body) F(scope) F(scopeExt) F(blBlocks) \
|
||||
/*38*/ F(ns) F(nsDesc) F(fldAlias) F(vfyObj) F(hashmap) F(temp) F(nfn) F(nfnDesc) \
|
||||
/*46*/ F(freed) F(harrPartial) \
|
||||
/*48*/ F(fun_invReg ) F(md1_invReg ) F(md2_invReg ) \
|
||||
/*51*/ F(fun_invSwap) F(md1_invSwap) F(md2_invSwap) \
|
||||
\
|
||||
/*48*/ IF_RT_WRAP(F(funWrap) F(md1Wrap) F(md2Wrap))
|
||||
/*54*/ IF_RT_WRAP(F(funWrap) F(md1Wrap) F(md2Wrap))
|
||||
|
||||
enum Type {
|
||||
#define F(X) t_##X,
|
||||
@ -447,6 +449,10 @@ typedef B (*M2C2)(Md2D*, B, B);
|
||||
F( BBBBB2B, m1_ucw) /* t,o,f, w,x→r; r≡O⌾(w⊸(F _T )) x; consumes w,x */ \
|
||||
F( BBBBB2B, m2_uc1) /* t,o,f,g, x→r; r≡O⌾( F _T_ G ) x; consumes x */ \
|
||||
F(BBBBBB2B, m2_ucw) /* t,o,f,g,w,x→r; r≡O⌾(w⊸(F _T_ G)) x; consumes w,x */ \
|
||||
F( BB2B, fn_im) /* t, x; function monadic inverse; consumes x */ \
|
||||
F( BB2B, fn_is) /* t, x; function equal-arg inverse; consumes x */ \
|
||||
F( BBB2B, fn_iw) /* t,w,x; function dyadic 𝕨-inverse; consumes w,x */ \
|
||||
F( BBB2B, fn_ix) /* t,w,x; function dyadic 𝕩-inverse; consumes w,x */ \
|
||||
\
|
||||
F(B2b, canStore) /* doesn't consume */ \
|
||||
F(u8, elType) /* guarantees that the corresponding i32any_ptr/f64any_ptr/c32any_ptr/… always succeeds */ \
|
||||
|
||||
27
src/load.c
27
src/load.c
@ -5,7 +5,7 @@
|
||||
#include "ns.h"
|
||||
#include "builtins.h"
|
||||
|
||||
#define FOR_INIT(F) F(base) F(harr) F(mutF) F(fillarr) F(tyarr) F(hash) F(sfns) F(fns) F(arith) F(md1) F(md2) F(derv) F(comp) F(rtWrap) F(ns) F(nfn) F(sysfn) F(load) F(sysfnPost) F(dervPost)
|
||||
#define FOR_INIT(F) F(base) F(harr) F(mutF) F(fillarr) F(tyarr) F(hash) F(sfns) F(fns) F(arith) F(md1) F(md2) F(derv) F(comp) F(rtWrap) F(ns) F(nfn) F(sysfn) F(inverse) F(load) F(sysfnPost) F(dervPost)
|
||||
#define F(X) void X##_init(void);
|
||||
FOR_INIT(F)
|
||||
#undef F
|
||||
@ -148,6 +148,8 @@ void load_gcFn() {
|
||||
mm_visit(comp_currPath);
|
||||
mm_visit(comp_currArgs);
|
||||
mm_visit(comp_currSrc);
|
||||
mm_visit(rt_invFnReg);
|
||||
mm_visit(rt_invFnSwap);
|
||||
}
|
||||
NOINLINE Block* bqn_comp(B str, B path, B args) { // consumes all
|
||||
B prevPath = comp_currPath ; comp_currPath = path;
|
||||
@ -265,11 +267,17 @@ void load_init() { // very last init function
|
||||
#ifdef ALL_R0
|
||||
dec(r0r);
|
||||
#endif
|
||||
|
||||
|
||||
B rtRes = m_funBlock(runtime_b, 0); ptr_dec(runtime_b);
|
||||
B rtObjRaw = IGet(rtRes,0);
|
||||
B rtFinish = IGet(rtRes,1);
|
||||
SGet(rtRes);
|
||||
B rtObjRaw = Get(rtRes,0);
|
||||
B setPrims = Get(rtRes,1);
|
||||
B setInv = Get(rtRes,2);
|
||||
dec(rtRes);
|
||||
dec(c1(setPrims, m_hVec2(incG(bi_decp), incG(bi_primInd)))); dec(setPrims);
|
||||
dec(c2(setInv, incG(bi_setInvSwap), incG(bi_setInvReg))); dec(setInv);
|
||||
|
||||
|
||||
|
||||
if (c(Arr,rtObjRaw)->ia != rtLen) err("incorrectly defined rtLen!");
|
||||
HArr_p runtimeH = m_harrUc(rtObjRaw);
|
||||
@ -312,7 +320,6 @@ void load_init() { // very last init function
|
||||
dec(rtObjRaw);
|
||||
B* runtime = runtimeH.a;
|
||||
B rtObj = runtimeH.b;
|
||||
dec(c1(rtFinish, m_hVec2(incG(bi_decp), incG(bi_primInd)))); dec(rtFinish);
|
||||
load_rtObj = FAKE_RUNTIME? frtObj : rtObj;
|
||||
load_compArg = m_hVec2(load_rtObj, incG(bi_sys)); gc_add(FAKE_RUNTIME? rtObj : frtObj);
|
||||
gc_add(load_compArg);
|
||||
@ -399,6 +406,12 @@ 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 Arr* def_slice(B x, usz s, usz ia) { thrM("cannot slice non-array!"); }
|
||||
|
||||
B rt_invFnReg, rt_invFnSwap;
|
||||
B def_fn_im(B t, B x) { B fn = c(Fun,rt_invFnReg )->c1(rt_invFnReg, inc(t)); B r = c1(fn, x); dec(fn); return r; }
|
||||
B def_fn_is(B t, B x) { B fn = c(Fun,rt_invFnSwap)->c1(rt_invFnSwap, inc(t)); B r = c1(fn, x); dec(fn); return r; }
|
||||
B def_fn_iw(B t, B w, B x) { B fn = c(Fun,rt_invFnSwap)->c1(rt_invFnSwap, inc(t)); B r = c2(fn, w, x); dec(fn); return r; }
|
||||
B def_fn_ix(B t, B w, B x) { B fn = c(Fun,rt_invFnReg )->c1(rt_invFnReg, inc(t)); B r = c2(fn, w, x); dec(fn); return r; }
|
||||
|
||||
#ifdef DONT_FREE
|
||||
static B empty_get(Arr* x, usz n) {
|
||||
x->type = x->flags;
|
||||
@ -437,6 +450,10 @@ void base_init() { // very first init function
|
||||
TIi(i,m1_ucw) = def_m1_ucw;
|
||||
TIi(i,m2_uc1) = def_m2_uc1;
|
||||
TIi(i,m2_ucw) = def_m2_ucw;
|
||||
TIi(i,fn_im) = def_fn_im;
|
||||
TIi(i,fn_is) = def_fn_is;
|
||||
TIi(i,fn_iw) = def_fn_iw;
|
||||
TIi(i,fn_ix) = def_fn_ix;
|
||||
}
|
||||
TIi(t_empty,freeO) = empty_free; TIi(t_freed,freeO) = def_freeO;
|
||||
TIi(t_empty,freeF) = empty_free; TIi(t_freed,freeF) = def_freeF;
|
||||
|
||||
@ -14,8 +14,10 @@ NFnDesc* registerNFn(B name, BB2B c1, BBB2B c2); // should be called a constant
|
||||
B m_nfn(NFnDesc* desc, B obj); // consumes obj
|
||||
B nfn_name(B x); // doesn't consume
|
||||
static B nfn_objU(B t) {
|
||||
assert(isVal(t) && v(t)->type == t_nfn);
|
||||
return c(NFn,t)->obj;
|
||||
}
|
||||
static i32 nfn_data(B t) {
|
||||
assert(isVal(t) && v(t)->type == t_nfn);
|
||||
return c(NFn,t)->data;
|
||||
}
|
||||
|
||||
@ -23,6 +23,7 @@
|
||||
#include "../builtins/md1.c"
|
||||
#include "../builtins/md2.c"
|
||||
#include "../builtins/internal.c"
|
||||
#include "../builtins/inverse.c"
|
||||
#include "../vm.c"
|
||||
#include "../ns.c"
|
||||
#include "../nfns.c"
|
||||
|
||||
440
src/vm.c
440
src/vm.c
@ -102,11 +102,15 @@ static Body* m_body(i32 vam, i32 pos, u32 maxStack, u16 maxPSC) { // leaves varI
|
||||
body->varAm = (u16)vam;
|
||||
return body;
|
||||
}
|
||||
|
||||
|
||||
|
||||
typedef struct NextRequest {
|
||||
u32 off; // offset into bytecode where the two integers must be inserted
|
||||
u32 pos1; // offset into bodyI/bodyMap of what's wanted for monadic
|
||||
u32 pos2; // ↑ for dyadic; U32_MAX if not wanted
|
||||
} NextRequest;
|
||||
|
||||
Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBlocks, B allBodies, B nameList, Scope* sc, i32 depth) {
|
||||
usz blIA = a(block)->ia;
|
||||
if (blIA!=3) thrM("VM compiler: Bad block info size");
|
||||
@ -116,223 +120,237 @@ Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBl
|
||||
B bodyObj = GetU(block,2);
|
||||
i32 argAm = argCount(ty, imm);
|
||||
|
||||
i32* bodyI;
|
||||
i32 bodyAm1, bodyAm2, bodyILen;
|
||||
if (isArr(bodyObj)) {
|
||||
usz boia = a(bodyObj)->ia;
|
||||
if (boia!=1 && boia!=2) thrM("VM compiler: Unexpected body list length");
|
||||
// print(bodyObj); putchar('\n');
|
||||
SGetU(bodyObj)
|
||||
B b1 = GetU(bodyObj,0);
|
||||
B b2 = boia==1? b1 : GetU(bodyObj,1);
|
||||
if (!isArr(b1) || !isArr(b2)) thrM("VM compiler: Body list contained non-arrays");
|
||||
bodyAm1 = a(b1)->ia; SGetU(b1)
|
||||
bodyAm2 = a(b2)->ia; SGetU(b2)
|
||||
bodyILen = bodyAm1+bodyAm2;
|
||||
TALLOC(i32, bodyInds_, bodyILen+2); bodyI = bodyInds_; i32* bodyI2 = bodyInds_+bodyAm1+1;
|
||||
for (i32 i = 0; i < bodyAm1; i++) bodyI [i] = o2i(GetU(b1, i));
|
||||
for (i32 i = 0; i < bodyAm2; i++) bodyI2[i] = o2i(GetU(b2, i));
|
||||
for (i32 i = 1; i < bodyAm1; i++) if (bodyI [i]<=bodyI [i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
for (i32 i = 1; i < bodyAm2; i++) if (bodyI2[i]<=bodyI2[i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
bodyI[bodyAm1] = bodyI[bodyILen+1] = I32_MAX;
|
||||
} else {
|
||||
bodyILen = 2;
|
||||
TALLOC(i32, bodyInds_, bodyILen+2); bodyI = bodyInds_;
|
||||
bodyI[0] = bodyI[2] = o2i(bodyObj);
|
||||
bodyI[1] = bodyI[3] = I32_MAX;
|
||||
bodyAm1 = 1;
|
||||
bodyAm2 = 1;
|
||||
}
|
||||
// for (int i = 0; i < bodyILen+2; i++) printf("%d ", bodyI[i]); putchar('\n'); printf("things: %d %d\n", bodyAm1, bodyAm2);
|
||||
TSALLOC(i32, newBC, 20); // transformed bytecode
|
||||
TSALLOC(i32, mapBC, 20); // map of original bytecode to transformed
|
||||
TSALLOC(Block*, usedBlocks, 2); // list of blocks to be referenced by DFND, stored in result->blocks
|
||||
TSALLOC(Body*, bodies, 2); // list of bodies of this block
|
||||
TALLOC(Body*, bodyMap, bodyILen+2); // map from index in bodyI to the corresponding body
|
||||
TSALLOC(NextRequest, bodyReqs, 10); // list of SETH/PRED-s to fill out when bodyMap is complete
|
||||
|
||||
i32 pos1 = 0; // pos1 and pos2 always stay valid indexes in bodyI because bodyI is padded with -1s
|
||||
i32 pos2 = bodyAm1+1;
|
||||
i32 index1 = -1;
|
||||
i32 index2 = -1;
|
||||
if (bodyAm1==0 || bodyAm2==0) {
|
||||
i32 sz = TSSIZE(bodies);
|
||||
if (bodyAm1==0) index1 = sz;
|
||||
if (bodyAm2==0) index2 = sz;
|
||||
i32 bcStart = TSSIZE(newBC);
|
||||
TSADD(newBC, FAIL);
|
||||
TSADD(mapBC, 0);
|
||||
|
||||
Body* body = m_body(6, bcStart, 1, 0);
|
||||
body->nsDesc = NULL;
|
||||
TSADD(bodies, body);
|
||||
}
|
||||
bodyMap[bodyAm1] = bodyMap[bodyILen+1] = NULL;
|
||||
// failed match body
|
||||
TSADD(newBC, FAIL);
|
||||
TSADD(mapBC, 0);
|
||||
Body* failBody = m_body(6, 0, 1, 0);
|
||||
failBody->nsDesc = NULL;
|
||||
TSADD(bodies, failBody);
|
||||
i32 failBodyI = 0;
|
||||
Body* startBodies[6] = {failBody,failBody,failBody,failBody,failBody,failBody};
|
||||
|
||||
while (true) {
|
||||
i32 curr1 = bodyI[pos1];
|
||||
i32 curr2 = bodyI[pos2];
|
||||
i32 currBody = curr1<curr2? curr1 : curr2;
|
||||
if (currBody==I32_MAX) break;
|
||||
// printf("step %d %d: %d %d %d\n", pos1, pos2, curr1, curr2, currBody);
|
||||
u64 bodyIdx = TSSIZE(bodies);
|
||||
bool is1 = curr1==currBody; if (is1) { if (index1==-1) index1=bodyIdx; pos1++; }
|
||||
bool is2 = curr2==currBody; if (is2) { if (index2==-1) index2=bodyIdx; pos2++; }
|
||||
// printf("idxs: %d %d\n", index1, index2);
|
||||
bool boArr = isArr(bodyObj);
|
||||
i32 boCount = boArr? a(bodyObj)->ia : 1;
|
||||
if (boCount<1 || boCount>5) thrM("VM compiler: Unexpected body list length");
|
||||
// if (boArr) { print(bodyObj); putchar('\n'); }
|
||||
i32 firstMPos = failBodyI;
|
||||
|
||||
for (i32 i = 0; i < 6; i+= 2) {
|
||||
if (i >= boCount) break;
|
||||
|
||||
|
||||
B bodyRepr = IGetU(allBodies, currBody); if (!isArr(bodyRepr)) thrM("VM compiler: Body array contained non-array");
|
||||
usz boIA = a(bodyRepr)->ia; if (boIA!=2 && boIA!=4) thrM("VM compiler: Body array had invalid length");
|
||||
SGetU(bodyRepr)
|
||||
usz idx = o2s(GetU(bodyRepr,0)); if (idx>=bcIA) thrM("VM compiler: Bytecode index out of bounds");
|
||||
usz vam = o2s(GetU(bodyRepr,1)); if (vam!=(u16)vam) thrM("VM compiler: >2⋆16 variables not supported"); // TODO any reason for this? 2⋆32 vars should just work, no? // oh, some size fields are u16s. but i doubt those change much, or even make things worse
|
||||
|
||||
i32 h = 0; // stack height
|
||||
i32 hM = 0; // max stack height
|
||||
i32 mpsc = 0;
|
||||
if (depth==0 && sc && vam > sc->varAm) {
|
||||
if (boIA==2) thrM("VM compiler: Full block info must be provided for extending scopes");
|
||||
u32 regAm = sc->varAm;
|
||||
ScopeExt* oE = sc->ext;
|
||||
if (oE==NULL || vam > regAm+oE->varAm) {
|
||||
i32 nSZ = vam - regAm;
|
||||
ScopeExt* nE = mm_alloc(fsizeof(ScopeExt, vars, B, nSZ*2), t_scopeExt);
|
||||
nE->varAm = nSZ;
|
||||
i32 oSZ = 0;
|
||||
if (oE) {
|
||||
oSZ = oE->varAm;
|
||||
memcpy(nE->vars , oE->vars , oSZ*sizeof(B));
|
||||
memcpy(nE->vars+nSZ, oE->vars+oSZ, oSZ*sizeof(B));
|
||||
mm_free((Value*)oE);
|
||||
}
|
||||
B varIDs = GetU(bodyRepr,2);
|
||||
for (i32 i = oSZ; i < nSZ; i++) {
|
||||
nE->vars[i] = bi_noVar;
|
||||
nE->vars[i+nSZ] = IGet(nameList, o2s(IGetU(varIDs, regAm+i)));
|
||||
}
|
||||
sc->ext = nE;
|
||||
i32* bodyPs;
|
||||
i32 mCount, dCount, mapLen;
|
||||
if (isArr(bodyObj)) {
|
||||
SGetU(bodyObj)
|
||||
B b1, b2;
|
||||
if (i==4) {
|
||||
b1 = bi_emptyHVec;
|
||||
b2 = GetU(bodyObj, 4);
|
||||
} else {
|
||||
b1 = GetU(bodyObj, i);
|
||||
b2 = i+1<boCount? GetU(bodyObj, i+1) : bi_emptyHVec;
|
||||
}
|
||||
if (!isArr(b1) || !isArr(b2)) thrM("VM compiler: Body list contained non-arrays");
|
||||
mCount = a(b1)->ia; SGetU(b1)
|
||||
dCount = a(b2)->ia; SGetU(b2)
|
||||
mapLen = mCount+dCount;
|
||||
TALLOC(i32, bodyPs_, mapLen+2); bodyPs = bodyPs_;
|
||||
i32* bodyM = bodyPs;
|
||||
i32* bodyD = bodyPs + mCount+1;
|
||||
for (i32 i = 0; i < mCount; i++) bodyM[i] = o2i(GetU(b1, i));
|
||||
for (i32 i = 0; i < dCount; i++) bodyD[i] = o2i(GetU(b2, i));
|
||||
for (i32 i = 1; i < mCount; i++) if (bodyM[i]<=bodyM[i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
for (i32 i = 1; i < dCount; i++) if (bodyD[i]<=bodyD[i-1]) thrM("VM compiler: Expected body indices to be sorted");
|
||||
bodyM[mCount] = bodyD[dCount] = I32_MAX;
|
||||
} else {
|
||||
mapLen = 2;
|
||||
TALLOC(i32, bodyPs_, mapLen+2); bodyPs = bodyPs_;
|
||||
bodyPs[0] = bodyPs[2] = o2i(bodyObj);
|
||||
bodyPs[1] = bodyPs[3] = I32_MAX;
|
||||
mCount = dCount = 1;
|
||||
}
|
||||
i32 bcStart = TSSIZE(newBC);
|
||||
u32* c;
|
||||
// for (int i = 0; i < mapLen+2; i++) printf("%d ", bodyPs[i]); putchar('\n'); printf("things: %d %d\n", mCount, dCount);
|
||||
|
||||
bool remapArgs = false;
|
||||
c = bc+idx;
|
||||
while (*c!=RETN & *c!=RETD) {
|
||||
if (*c==PRED) { remapArgs = true; break; }
|
||||
c = nextBC(c);
|
||||
}
|
||||
if (remapArgs) {
|
||||
if (sc && depth==0) thrM("Predicates cannot be used directly in a REPL");
|
||||
TALLOC(Body*, bodyMap, mapLen+2); // map from index in bodyPs to the corresponding body
|
||||
TSALLOC(NextRequest, bodyReqs, 10); // list of SETH/PRED-s to fill out when bodyMap is complete
|
||||
|
||||
i32 pos1 = 0; // pos1 and pos2 always stay valid indexes in bodyPs because bodyPs is padded with -1s
|
||||
i32 pos2 = mCount+1;
|
||||
bodyMap[mCount] = bodyMap[mapLen+1] = NULL;
|
||||
bool firstM = true;
|
||||
bool firstD = true;
|
||||
|
||||
while (true) {
|
||||
i32 curr1 = bodyPs[pos1];
|
||||
i32 curr2 = bodyPs[pos2];
|
||||
i32 currBody = curr1<curr2? curr1 : curr2;
|
||||
if (currBody==I32_MAX) break;
|
||||
// printf("step %d %d: %d %d %d\n", pos1, pos2, curr1, curr2, currBody);
|
||||
bool is1 = curr1==currBody; if (is1) pos1++;
|
||||
bool is2 = curr2==currBody; if (is2) pos2++;
|
||||
// printf("idxs: %d %d\n", index1, firstD);
|
||||
|
||||
|
||||
B bodyRepr = IGetU(allBodies, currBody); if (!isArr(bodyRepr)) thrM("VM compiler: Body array contained non-array");
|
||||
usz boIA = a(bodyRepr)->ia; if (boIA!=2 && boIA!=4) thrM("VM compiler: Body array had invalid length");
|
||||
SGetU(bodyRepr)
|
||||
usz idx = o2s(GetU(bodyRepr,0)); if (idx>=bcIA) thrM("VM compiler: Bytecode index out of bounds");
|
||||
usz vam = o2s(GetU(bodyRepr,1)); if (vam!=(u16)vam) thrM("VM compiler: >2⋆16 variables not supported"); // TODO any reason for this? 2⋆32 vars should just work, no? // oh, some size fields are u16s. but i doubt those change much, or even make things worse
|
||||
|
||||
i32 h = 0; // stack height
|
||||
i32 hM = 0; // max stack height
|
||||
i32 mpsc = 0;
|
||||
if (depth==0 && sc && vam > sc->varAm) {
|
||||
if (boIA==2) thrM("VM compiler: Full block info must be provided for extending scopes");
|
||||
u32 regAm = sc->varAm;
|
||||
ScopeExt* oE = sc->ext;
|
||||
if (oE==NULL || vam > regAm+oE->varAm) {
|
||||
i32 nSZ = vam - regAm;
|
||||
ScopeExt* nE = mm_alloc(fsizeof(ScopeExt, vars, B, nSZ*2), t_scopeExt);
|
||||
nE->varAm = nSZ;
|
||||
i32 oSZ = 0;
|
||||
if (oE) {
|
||||
oSZ = oE->varAm;
|
||||
memcpy(nE->vars , oE->vars , oSZ*sizeof(B));
|
||||
memcpy(nE->vars+nSZ, oE->vars+oSZ, oSZ*sizeof(B));
|
||||
mm_free((Value*)oE);
|
||||
}
|
||||
B varIDs = GetU(bodyRepr,2);
|
||||
for (i32 i = oSZ; i < nSZ; i++) {
|
||||
nE->vars[i] = bi_noVar;
|
||||
nE->vars[i+nSZ] = IGet(nameList, o2s(IGetU(varIDs, regAm+i)));
|
||||
}
|
||||
sc->ext = nE;
|
||||
}
|
||||
}
|
||||
i32 bcStart = TSSIZE(newBC);
|
||||
u32* c;
|
||||
|
||||
bool remapArgs = false;
|
||||
c = bc+idx;
|
||||
bool argUsed[6] = {0,0,0,0,0,0};
|
||||
while (*c!=RETN & *c!=RETD) {
|
||||
if (*c==VARO | *c==VARM | *c==VARU) if (c[1]==0 && c[2]<argAm) argUsed[c[2]] = true;
|
||||
if (*c==PRED) { remapArgs = true; break; }
|
||||
c = nextBC(c);
|
||||
}
|
||||
for (i32 i = 0; i < 6; i++) if (argUsed[i]) {
|
||||
TSADDA(newBC, ((u32[]){ VARO,0,i, VARM,0,vam+i, SETN, POPS }), 8);
|
||||
TSADDA(mapBC, ((u32[]){ 0,0,0, 0,0,0, 0 , 0 }), 8);
|
||||
}
|
||||
}
|
||||
|
||||
c = bc+idx;
|
||||
while (true) {
|
||||
u32* n = nextBC(c);
|
||||
if (n-bc-1 >= bcIA) thrM("VM compiler: No RETN/RETD found before end of bytecode");
|
||||
bool ret = false;
|
||||
#define A64(X) { u64 a64=(X); TSADD(newBC, (u32)a64); TSADD(newBC, a64>>32); }
|
||||
switch (*c) {
|
||||
case PUSH:;
|
||||
B obj = comp->objs->a[c[1]];
|
||||
TSADD(newBC, isVal(obj)? ADDI : ADDU);
|
||||
A64(obj.u);
|
||||
break;
|
||||
case RETN: if(h!=1) thrM("VM compiler: RETN expected to be called with one item on the stack");
|
||||
TSADD(newBC, RETN);
|
||||
ret = true;
|
||||
break;
|
||||
case RETD: if(h!=1&h!=0) thrM("VM compiler: RETD expected to be called with no more than 1 item on the stack");
|
||||
if (h==1) TSADD(newBC, POPS);
|
||||
TSADD(newBC, RETD);
|
||||
ret = true;
|
||||
break;
|
||||
case DFND: {
|
||||
u32 id = c[1];
|
||||
if ((u32)id >= a(allBlocks)->ia) thrM("VM compiler: DFND index out-of-bounds");
|
||||
if (bDone[id]) thrM("VM compiler: DFND of the same block in multiple places");
|
||||
bDone[id] = true;
|
||||
Block* bl = compileBlock(IGetU(allBlocks,id), comp, bDone, bc, bcIA, allBlocks, allBodies, nameList, sc, depth+1);
|
||||
TSADD(newBC, bl->ty==0? DFND0 : bl->ty==1? DFND1 : DFND2);
|
||||
A64((u64)bl);
|
||||
TSADD(usedBlocks, bl);
|
||||
break;
|
||||
if (remapArgs) {
|
||||
if (sc && depth==0) thrM("Predicates cannot be used directly in a REPL");
|
||||
c = bc+idx;
|
||||
bool argUsed[6] = {0,0,0,0,0,0};
|
||||
while (*c!=RETN & *c!=RETD) {
|
||||
if (*c==VARO | *c==VARM | *c==VARU) if (c[1]==0 && c[2]<argAm) argUsed[c[2]] = true;
|
||||
c = nextBC(c);
|
||||
}
|
||||
case VARO: case VARM: case VARU: {
|
||||
i32 ins = c[0];
|
||||
i32 cdepth = c[1];
|
||||
i32 cpos = c[2];
|
||||
if (cdepth+1 > mpsc) mpsc = cdepth+1;
|
||||
if (sc && cdepth>=depth) {
|
||||
Scope* csc = sc;
|
||||
for (i32 i = depth; i < cdepth; i++) if (!(csc = csc->psc)) thrM("VM compiler: VAR_ has an out-of-bounds depth");
|
||||
if (cpos >= csc->varAm) {
|
||||
cpos-= csc->varAm;
|
||||
ins = ins==VARO? EXTO : ins==VARM? EXTM : EXTO;
|
||||
}
|
||||
for (i32 i = 0; i < 6; i++) if (argUsed[i]) {
|
||||
TSADDA(newBC, ((u32[]){ VARO,0,i, VARM,0,vam+i, SETN, POPS }), 8);
|
||||
TSADDA(mapBC, ((u32[]){ 0,0,0, 0,0,0, 0 , 0 }), 8);
|
||||
}
|
||||
}
|
||||
|
||||
c = bc+idx;
|
||||
while (true) {
|
||||
u32* n = nextBC(c);
|
||||
if (n-bc-1 >= bcIA) thrM("VM compiler: No RETN/RETD found before end of bytecode");
|
||||
bool ret = false;
|
||||
#define A64(X) { u64 a64=(X); TSADD(newBC, (u32)a64); TSADD(newBC, a64>>32); }
|
||||
switch (*c) {
|
||||
case PUSH:;
|
||||
B obj = comp->objs->a[c[1]];
|
||||
TSADD(newBC, isVal(obj)? ADDI : ADDU);
|
||||
A64(obj.u);
|
||||
break;
|
||||
case RETN: if(h!=1) thrM("VM compiler: RETN expected to be called with one item on the stack");
|
||||
TSADD(newBC, RETN);
|
||||
ret = true;
|
||||
break;
|
||||
case RETD: if(h!=1&h!=0) thrM("VM compiler: RETD expected to be called with no more than 1 item on the stack");
|
||||
if (h==1) TSADD(newBC, POPS);
|
||||
TSADD(newBC, RETD);
|
||||
ret = true;
|
||||
break;
|
||||
case DFND: {
|
||||
u32 id = c[1];
|
||||
if ((u32)id >= a(allBlocks)->ia) thrM("VM compiler: DFND index out-of-bounds");
|
||||
if (bDone[id]) thrM("VM compiler: DFND of the same block in multiple places");
|
||||
bDone[id] = true;
|
||||
Block* bl = compileBlock(IGetU(allBlocks,id), comp, bDone, bc, bcIA, allBlocks, allBodies, nameList, sc, depth+1);
|
||||
TSADD(newBC, bl->ty==0? DFND0 : bl->ty==1? DFND1 : DFND2);
|
||||
A64((u64)bl);
|
||||
TSADD(usedBlocks, bl);
|
||||
break;
|
||||
}
|
||||
case VARO: case VARM: case VARU: {
|
||||
i32 ins = c[0];
|
||||
i32 cdepth = c[1];
|
||||
i32 cpos = c[2];
|
||||
if (cdepth+1 > mpsc) mpsc = cdepth+1;
|
||||
if (sc && cdepth>=depth) {
|
||||
Scope* csc = sc;
|
||||
for (i32 i = depth; i < cdepth; i++) if (!(csc = csc->psc)) thrM("VM compiler: VAR_ has an out-of-bounds depth");
|
||||
if (cpos >= csc->varAm) {
|
||||
cpos-= csc->varAm;
|
||||
ins = ins==VARO? EXTO : ins==VARM? EXTM : EXTO;
|
||||
}
|
||||
}
|
||||
if (remapArgs && cpos<argAm && cdepth==0) cpos+= vam;
|
||||
TSADD(newBC, ins);
|
||||
TSADD(newBC, cdepth);
|
||||
TSADD(newBC, cpos);
|
||||
break;
|
||||
}
|
||||
case SETH: case PRED:
|
||||
if (*c==PRED && h!=1) thrM("VM compiler: PRED expected to be called with one item on the stack");
|
||||
if (mpsc<1) mpsc=1; // SETH and PRED may want to have a parent scope pointer
|
||||
TSADD(newBC, *c==SETH? SETHi : imm? PRED1 : PRED2);
|
||||
TSADD(bodyReqs, ((NextRequest){.off = TSSIZE(newBC), .pos1 = pos1, .pos2 = imm? U32_MAX : pos2}));
|
||||
A64(0); if(*c==SETH || !imm)A64(0); // to be filled in by later bodyReqs handling
|
||||
break;
|
||||
default: {
|
||||
u32* ccpy = c;
|
||||
while (ccpy!=n) TSADD(newBC, *ccpy++);
|
||||
break;
|
||||
}
|
||||
if (remapArgs && cpos<argAm && cdepth==0) cpos+= vam;
|
||||
TSADD(newBC, ins);
|
||||
TSADD(newBC, cdepth);
|
||||
TSADD(newBC, cpos);
|
||||
break;
|
||||
}
|
||||
case SETH: case PRED:
|
||||
if (*c==PRED && h!=1) thrM("VM compiler: PRED expected to be called with one item on the stack");
|
||||
if (mpsc<1) mpsc=1; // SETH and PRED may want to have a parent scope pointer
|
||||
TSADD(newBC, *c==SETH? SETHi : imm? PRED1 : PRED2);
|
||||
TSADD(bodyReqs, ((NextRequest){.off = TSSIZE(newBC), .pos1 = pos1, .pos2 = imm? U32_MAX : pos2}));
|
||||
A64(0); if(*c==SETH || !imm)A64(0); // to be filled in by later bodyReqs handling
|
||||
break;
|
||||
default: {
|
||||
u32* ccpy = c;
|
||||
while (ccpy!=n) TSADD(newBC, *ccpy++);
|
||||
break;
|
||||
}
|
||||
#undef A64
|
||||
usz nlen = TSSIZE(newBC)-TSSIZE(mapBC);
|
||||
for (usz i = 0; i < nlen; i++) TSADD(mapBC, c-bc);
|
||||
h+= stackDiff(c);
|
||||
if (h<0) thrM("VM compiler: Stack size goes negative");
|
||||
if (h>hM) hM = h;
|
||||
if (ret) break;
|
||||
c = n;
|
||||
}
|
||||
#undef A64
|
||||
usz nlen = TSSIZE(newBC)-TSSIZE(mapBC);
|
||||
for (usz i = 0; i < nlen; i++) TSADD(mapBC, c-bc);
|
||||
h+= stackDiff(c);
|
||||
if (h<0) thrM("VM compiler: Stack size goes negative");
|
||||
if (h>hM) hM = h;
|
||||
if (ret) break;
|
||||
c = n;
|
||||
|
||||
if (mpsc>U16_MAX) thrM("VM compiler: Block too deep");
|
||||
|
||||
Body* body = m_body(vam+(remapArgs? argAm : 0), bcStart, (u32)hM, mpsc);
|
||||
if (boIA>2) {
|
||||
m_nsDesc(body, imm, ty, inc(nameList), GetU(bodyRepr,2), GetU(bodyRepr,3));
|
||||
} else {
|
||||
body->nsDesc = NULL;
|
||||
for (u64 i = 0; i < vam; i++) body->varIDs[i] = -1;
|
||||
}
|
||||
|
||||
if (is1) { bodyMap[pos1-1] = body; if (firstM) { firstM=false; startBodies[i ] = body; if(i==0) firstMPos = TSSIZE(bodies); } }
|
||||
if (is2) { bodyMap[pos2-1] = body; if (firstD) { firstD=false; startBodies[i+1] = body; } }
|
||||
TSADD(bodies, body);
|
||||
}
|
||||
|
||||
if (mpsc>U16_MAX) thrM("VM compiler: Block too deep");
|
||||
|
||||
Body* body = m_body(vam+(remapArgs? argAm : 0), bcStart, (u32)hM, mpsc);
|
||||
if (boIA>2) {
|
||||
m_nsDesc(body, imm, ty, inc(nameList), GetU(bodyRepr,2), GetU(bodyRepr,3));
|
||||
} else {
|
||||
body->nsDesc = NULL;
|
||||
for (u64 i = 0; i < vam; i++) body->varIDs[i] = -1;
|
||||
u64 bodyReqAm = TSSIZE(bodyReqs);
|
||||
for (u64 i = 0; i < bodyReqAm; i++) {
|
||||
NextRequest r = bodyReqs[i];
|
||||
/*ugly, but whatever*/ u64 v1 = (u64)bodyMap[r.pos1]; newBC[r.off+0] = (u32)v1; newBC[r.off+1] = v1>>32;
|
||||
if (r.pos2!=U32_MAX) { u64 v2 = (u64)bodyMap[r.pos2]; newBC[r.off+2] = (u32)v2; newBC[r.off+3] = v2>>32; }
|
||||
}
|
||||
|
||||
TSADD(bodies, body);
|
||||
if (is1) bodyMap[pos1-1] = body;
|
||||
if (is2) bodyMap[pos2-1] = body;
|
||||
TSFREE(bodyReqs);
|
||||
TFREE(bodyMap);
|
||||
TFREE(bodyPs);
|
||||
}
|
||||
u64 bodyReqAm = TSSIZE(bodyReqs);
|
||||
for (u64 i = 0; i < bodyReqAm; i++) {
|
||||
NextRequest r = bodyReqs[i];
|
||||
/*ugly, but whatever*/ u64 v1 = (u64)bodyMap[r.pos1]; newBC[r.off+0] = (u32)v1; newBC[r.off+1] = v1>>32;
|
||||
if (r.pos2!=U32_MAX) { u64 v2 = (u64)bodyMap[r.pos2]; newBC[r.off+2] = (u32)v2; newBC[r.off+3] = v2>>32; }
|
||||
}
|
||||
TSFREE(bodyReqs);
|
||||
TFREE(bodyMap);
|
||||
TFREE(bodyI);
|
||||
|
||||
|
||||
|
||||
usz blC = TSSIZE(usedBlocks);
|
||||
BlBlocks* nBl = NULL;
|
||||
@ -354,23 +372,24 @@ Block* compileBlock(B block, Comp* comp, bool* bDone, u32* bc, usz bcIA, B allBl
|
||||
bl->blocks = nBl==NULL? NULL : nBl->a;
|
||||
bl->map = map;
|
||||
bl->imm = imm;
|
||||
|
||||
bl->bodyCount = bodyCount;
|
||||
if (index1 != 0) { // this is a _mess_
|
||||
i32 sw0 = 0; i32 sw1 = index1;
|
||||
|
||||
Body* t = bodies[sw0]; bodies[sw0] = bodies[sw1]; bodies[sw1] = t;
|
||||
index1 = sw0;
|
||||
|
||||
if (index2==sw0) index2 = sw1;
|
||||
else if (index2==sw1) index2 = sw0;
|
||||
|
||||
bl->dyBody = startBodies[1];
|
||||
bl->invMBody = startBodies[2];
|
||||
bl->invXBody = startBodies[3];
|
||||
bl->invWBody = startBodies[5];
|
||||
|
||||
if (firstMPos != 0) { // swap body 0 and firstMPos so that the first body is the first monadic one
|
||||
Body* t = bodies[0];
|
||||
bodies[0] = bodies[firstMPos];
|
||||
bodies[firstMPos] = t;
|
||||
}
|
||||
|
||||
for (i32 i = 0; i < bodyCount; i++) {
|
||||
bl->bodies[i] = bodies[i];
|
||||
bodies[i]->bc = (u32*)nbc + bodies[i]->bcTmp;
|
||||
bodies[i]->bl = bl;
|
||||
}
|
||||
bl->dyBody = bodies[index2];
|
||||
TSFREE(bodies);
|
||||
return bl;
|
||||
}
|
||||
@ -795,6 +814,10 @@ B md1Bl_c2(Md1D* d, B w, B x) { Md1Block* b=c(Md1Block, d->m1); ptr_inc(d); retu
|
||||
B md2Bl_c1(Md2D* d, B x) { Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->bodies[0], b->sc, 6, (B[]){tag(d,FUN_TAG), x, bi_N, inc(d->m2), inc(d->f), inc(d->g)}); }
|
||||
B md2Bl_c2(Md2D* d, B w, B x) { Md2Block* b=c(Md2Block, d->m2); ptr_inc(d); return execBlock(b->bl, b->bl->dyBody, b->sc, 6, (B[]){tag(d,FUN_TAG), x, w , inc(d->m2), inc(d->f), inc(d->g)}); }
|
||||
|
||||
B funBl_im(B t, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->invMBody, b->sc, 3, (B[]){t, x, bi_N }); }
|
||||
B funBl_iw(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->invWBody, b->sc, 3, (B[]){t, x, w }); }
|
||||
B funBl_ix(B t, B w, B x) { FunBlock* b=c(FunBlock, t ); ptr_inc(b); return execBlock(b->bl, b->bl->invXBody, b->sc, 3, (B[]){t, x, w }); }
|
||||
|
||||
B md1Bl_d(B m, B f ) { Md1Block* c = c(Md1Block,m); Block* bl=c(Md1Block, m)->bl; return c->bl->imm? execBlock(bl, bl->bodies[0], c(Md1Block, m)->sc, 2, (B[]){m, f }) : m_md1D(m,f ); }
|
||||
B md2Bl_d(B m, B f, B g) { Md2Block* c = c(Md2Block,m); Block* bl=c(Md2Block, m)->bl; return c->bl->imm? execBlock(bl, bl->bodies[0], c(Md2Block, m)->sc, 3, (B[]){m, f, g}) : m_md2D(m,f,g); }
|
||||
|
||||
@ -939,6 +962,11 @@ void comp_init() {
|
||||
TIi(t_fun_block,freeO) = funBl_freeO; TIi(t_fun_block,freeF) = funBl_freeF; TIi(t_fun_block,visit) = funBl_visit; TIi(t_fun_block,print) = funBl_print; TIi(t_fun_block,decompose) = block_decompose;
|
||||
TIi(t_md1_block,freeO) = md1Bl_freeO; TIi(t_md1_block,freeF) = md1Bl_freeF; TIi(t_md1_block,visit) = md1Bl_visit; TIi(t_md1_block,print) = md1Bl_print; TIi(t_md1_block,decompose) = block_decompose; TIi(t_md1_block,m1_d)=md1Bl_d;
|
||||
TIi(t_md2_block,freeO) = md2Bl_freeO; TIi(t_md2_block,freeF) = md2Bl_freeF; TIi(t_md2_block,visit) = md2Bl_visit; TIi(t_md2_block,print) = md2Bl_print; TIi(t_md2_block,decompose) = block_decompose; TIi(t_md2_block,m2_d)=md2Bl_d;
|
||||
|
||||
TIi(t_fun_block,fn_im) = funBl_im;
|
||||
TIi(t_fun_block,fn_iw) = funBl_iw;
|
||||
TIi(t_fun_block,fn_ix) = funBl_ix;
|
||||
|
||||
#ifndef GS_REALLOC
|
||||
allocStack((void**)&gStack, (void**)&gStackStart, (void**)&gStackEnd, sizeof(B), GS_SIZE);
|
||||
#endif
|
||||
|
||||
10
src/vm.h
10
src/vm.h
@ -95,8 +95,14 @@ struct Block {
|
||||
i32* map; // pointer in an owned I32Arr
|
||||
i32* bc; // pointer in an owned I32Arr
|
||||
i32 bodyCount;
|
||||
Body* dyBody; // pointer within bodies; not owned; TODO move to the second item of bodies or something
|
||||
Body* bodies[]; // bodies[0] is the first monadic body (also niladic body)
|
||||
|
||||
// pointers within bodies, not owned
|
||||
Body* dyBody;
|
||||
Body* invMBody;
|
||||
Body* invXBody;
|
||||
Body* invWBody;
|
||||
// bodies[0] is the first monadic body (also niladic body)
|
||||
Body* bodies[];
|
||||
};
|
||||
struct Body {
|
||||
struct Value;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user