From 8a7fa77163425047c5a8509802b5e02ceaad1dfd Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 26 Jun 2020 18:58:02 -0400
Subject: [PATCH] cvm: bootstraps itself!

---
 cvm/.gitignore |   3 ++
 cvm/Makefile   |   1 +
 cvm/forth.bin  | Bin 0 -> 5435 bytes
 cvm/stage.c    |  60 ++++++++++++++++++++++++
 cvm/vm.c       | 123 ++++++++++++++++++++++---------------------------
 cvm/xcomp.fs   | 104 +++++++++++++++++++++++++++++++++++++++++
 6 files changed, 224 insertions(+), 67 deletions(-)
 create mode 100644 cvm/.gitignore
 create mode 100644 cvm/forth.bin
 create mode 100644 cvm/stage.c
 create mode 100644 cvm/xcomp.fs

diff --git a/cvm/.gitignore b/cvm/.gitignore
new file mode 100644
index 0000000..41d74cd
--- /dev/null
+++ b/cvm/.gitignore
@@ -0,0 +1,3 @@
+/blkfs
+/forth
+/stage
diff --git a/cvm/Makefile b/cvm/Makefile
index 880fddf..909f49e 100644
--- a/cvm/Makefile
+++ b/cvm/Makefile
@@ -31,6 +31,7 @@ vm.o: vm.c blkfs
 .PHONY: updatebootstrap
 updatebootstrap: stage xcomp.fs pack
 	./stage < xcomp.fs > new.bin
+	mv new.bin forth.bin
 
 .PHONY: pack
 pack:
diff --git a/cvm/forth.bin b/cvm/forth.bin
new file mode 100644
index 0000000000000000000000000000000000000000..26f2583f8c5c34741f6c874243351a1773de0460
GIT binary patch
literal 5435
zcmb7IUrbx)760zFv5m3KpA<?)T6}>78!$1XElX#>f3S-eV^jM=l4S%zfE0y71hi>Y
zH6<PGw5Z$Cmr9XVv4^Efq)bA})Q7Z+AM(&env{o;m$pF_56e_dn^diIing%d@B8dP
z+C6lU;(O2e&N<)tf6he+A?{QiciXD*^8fvdA4!@*Shtyc<MVzG5ZVq@FL0HjMCjW%
zzWHY6=1%)-giTl;J@_9`XHRw?$aY*LCCvJF0bBA2gKxoK1*EMfYsHQBY!4rf&TLN!
zu%+=M@z{_VFBNv-%w|mD%KC-|`E>Q-#fCfFec6nB@#GFi<V$&GIG*KE#b7dah%c4C
z`MH@HzXRG=b&}o=HFk9tBs`W2^499+93M52bRRExJR?=AJ(9^1+?`hU|De?Zchv>>
zyQhV}PwXGa^zoJ_4TAMy{(55ug&DCh9}R;sgF+eyV_`m<lBC(2Z06y<9}{Sf9*y(J
z=bN8g$PM~wv!CzToP2M|b(6R?HXzM!8=ab-ouC<kAlchH_`5&QL84$sD<2&l0X{lA
zC3K)uLQiFL{mFz$S3I41`1(vXGSCVew7d|1UDl!^noPI46)Xt%$Fp$-Tg8YT6|tdg
zHl8+HDun|)&+o)l2)p*Keu+%sQlV?F%lAYw-B$*IzXN1w<q(lf_jrT_+(F5mO#56C
z>;y>eWE#22^RQUgse^BNc4`K>Y169pb={`j)>pI@;GZ8#n!6x+6ZpJvfPF=?Sk{Ei
z_u|;}tpA2yt8I#?h(t44bFV1TzSMSGq9UHnIw5{d*nOwxr)L*IcM?I|6cHSD*9uK5
z(a%D9$RS@F^l9LGoD!&$KrmDW^YUWrjdMKeCbVdgJl!<>oO}=Vbn~8HOQ0vjgFK>g
z0LKr+198rB5|?!Mgt{M>?&it+^5lJaGLTHyfc<%pQ$0hg1^Gba2&x9i#U03Wa*#+x
zVGhL((cOmD0{XylUTbLQ@g57eQXiXk4G6z(5M{Jh02Q!a1%ea-MnX{p3lxDOMGzFJ
zcw{*4fh#w}hN#tUX+ixn@fmzPlul(bgO4Lb8{$jRuMszTdSdLv35LxE%MC%D9pI{i
zAO`=u#5;jMtErO)oEV^WiVNB@f{M_e9-Cj7obbnxZV77(bgzb9c@YrP(gS|ITBkR!
zh!$wGjPvW(lfs2tf;joW8Wl_8FIxuiMIM`|)(={#gOYv1e-yH9Z~$qVA-4rj3zEMG
zpVX)y`J$o=ROB7)6q-~&2vZJ<&!LR7U{n+a=fxPHsfYN(Fg6OMXrQ|G1%Geh+Do7g
zzA`PHpe|tmXr>=oZP{VkyCpWH6L0FrIgO($tinW<EQwFI>ZMtu!#h;#c&GyX{iq7#
z{^p%3jDH^$+HBudp-xu{d|psM8R-8B+QCmtn7dK&=fZQ?reINk*F=f$%<PmbK?h1O
z2WpmKEYur9Cg$OF)e~YNx2zu)`6aDfMuZM`NtjjM_9V<+MF&{byY$!bgp{^QFs<rW
z@!wy-MU!TjJ%dG%gnu=`G6dEjmj2Y>RTD|YG-ATdYB}M-Ra@d^)YLWYB&e=}=Wwn!
zD0O6Jqpf7j-eRL<#{k?`guCofVP+0zvVG;UiPdVl-KM=~KMR2$*k_Slf8Rn*of+RF
z1$tl<z{$BqB|x*@v#)6PAcP_+q31ojU;iUSd|+qc^lRVXtOZ*6b=}VNZHELV@_SM^
z3*espJWAr8{c3^d8#{eXnaP2HcwaJN#)n0z?9xHBSmyqcm@SwpNqV1v?m<~4OVVkr
zMmgLYuwFvl8L}bo_Xth9sMRAgF&f!zF3PqQNu@HT3vJ_d{XIuiH21PAl{s#}%4T-i
z+YVM(h1gC9)w#2oRO$(stK!W>@<X=+xQ(6kg4QFi>g3pOf^=5Pfx>T8baE|ttbo4n
z;Ng8-J^*Tlx*RuFp{B1O+zIOgan!mbHn;i_SW*PMU?j;t5wI@9><7pIwrKTEwim$k
zn$<w%ZL_sK1-4baMZ4)Rv~+1y3})lQ3>a@`zq=$`@v+I-#rao9YEU5wYruNBbXDhg
zJg+s{yX<^t_WC4|zX3#LjysSQ%f=BUH==OAl*%xxh9lWzB$|Rn4$bK#_9kp(n)oW9
zN-<z>AYfEsSze#WWS@(h4Cki~xYNmM`M6Zw8Xp)mkJf^9O;|@4UR~gDbb*pIilQ$Q
z&-K)Uf&!`bRhczPJjpghBQ%R;(m6AdHrZpG&PMwMCujSyWMZTo{!ncIqxzWHA5V|i
zVB&v({MQzzoWeEXR#ax{P`Je*Z+l9X1rSCHM^IioQ$+NrI{9G{?lX_F(DLHhBF3jE
zLV&3Tg!rjOqzrox;wv#t#H^wxkZJ|o!g|y3p}kt~C|g12uE(#WGxmb6z6@;$|2L6B
zJdcV*YADxF&vgJz`+ixb)Mxx{l7TbJhA|Kom&=G*(H_7n>|V6W*azmif;8Xci_?qH
zkvq>vVDO!qeAUkqs@87;j3;toj`=z{B0i$Bs5Qob@BEdfeG4b~jHkiJOes=-Kh9Vt
zmFtq6gU~mXOviInCojAJBWB>pQ3cwh1||5#Z3AjS%cHTYzRh-}+Wa^0PGJG_$~s_8
zC9Kz7OX9xFf@rR~(DJXlaA892TuwnKmQ|3u0HqR)Z>8Jfj*8r1jGc#yku;quGJabF
z1H`_Ure@Cg>*3}#QNFM^cH)%xrP+ze`Kg(?Gih{jIi2>v&bzL5_nPpWnVX;R&dx1*
zr{+LMinfM5P?P;UFB;@lq9WXd2KyztdMar))T8k7=x&WD?rOcu{u{RqiFVM+9gCx+
z9TabBH{5w~*TveA8*4+Qcw74dxQK<gQ5PCzUfi=7NTzCZce;{m6!#4UtBbilU6d^{
zh-(c@uP>lRdkE}mcDuk9fNvV~3!244y$^C5EoA0(S5Ev54884OK&^OiHG4GaN+n$t
z_?_rxTymBnUa7$%YJa6!hD>OGK)<bk8fQJ%UHp%;BfAS{7q!ct%M{CLp{n${%LZgS
zjJ3*^%tonF+K|NU?k;@^?yLpYAt@48a(bc4S*$q41(K7G8MLt#LU8+r1_sBF7Zx`M
zhC_OVg~_Gyin!xh694Ad9bafbzT8G*SeI_)oFNp{`JwSO0{=DikLG%tK*n3&K$w-p
zY0E6kJ`_jCWX27BC(CW%^vzGq%%1Qw%PICB@)9mDPPy;=wwyAZGIh8f=LK8*TjdPM
z@p49&-XZ4-%KbJbDCyk~Q%$bPyuv>UT8rgoc^+SfT(&p2Ebet_L{wz^Qt8l>NMs7S
z1~b^!l{hW}dn**aT0dt|TNhgznVLGm#IDHCvlVE+uAj$vvw$p7p%yUewawJtxgUX6
zHmT2)b~m#qmCTv^)cF`aw?fA77WS3jS1{^faZ9^^mbEPT!ZL5K0LL}NE1a?`e1(`U
zi9aD?$+Q{IVzQbkY%FDP2a`p!Zg<xk_<&=1T(i-(P4ShDuv@T%^|@1bT_JZ)d;&?n
z@wvIhkUx&lsHN!=6yR!Dhm~4k=!aA$(q}+*HvP{KIJJfHP3@<A<I2U;kIUG332}rR
zuT<1KT~t%KQK09nEIRHMsFhsW;gR208<3WRvq+^rZ~4`w^lAMS;zEU%wKppjD$9}2
zFFU#p!_yOTzgf8?{s}{ALAI46U$GbupZluNZ^A7qfqS4fLAK1XDm9uSMvMAB5356i
zhi8k2T$VVE)gon+A7OJ<53n`ybL^ceRxOt*^-10g1!^kS0Y@_#lLL%{XheS(&f+Rj
zblmp$Jl{AxR&awVF!kn?IOSk|1kl;npfjIWq28kof32dh&fF<o6V4d^CNy?>VKS3r
zCVT=1jE<jp;nX`YLzOpUza@JecT)TKd|>Y7shPVjewy@U_M%tk@ma=hPS0ir%VmFG
zl9=<_#4h%0^!;?TG%yc5G59mbIgA<2uXdeHgyq=^w7~nNb(jfUhffOpolRSIY){EX
zOc5LM_`_W}vCh;_?3cHnly?>PJ?>D|&_PX=iCt<NkEe3j3u#LZ)QYy@u~of?S|`oW
zZh6M3#2UJW%(;v$Ga7#`nXVOYq2`eZ&qb1HCjcd56{WAN8%mqWRE<1PsuT~7Rl&#_
zB;<$<rm1v|Wd;V5DWu8Iv2cF4tLTqo1w8iPU*Lc)`jG?NdGy~#yJ9`oJW?TkCfU>+
jD*XM)8}{-qQ(nW1&8f-T?Bznl_izhv5|l><LF<13r2QP1

literal 0
HcmV?d00001

diff --git a/cvm/stage.c b/cvm/stage.c
new file mode 100644
index 0000000..c1a1a0e
--- /dev/null
+++ b/cvm/stage.c
@@ -0,0 +1,60 @@
+#include <stdint.h>
+#include <stdio.h>
+#include <unistd.h>
+#include "vm.h"
+
+#define RAMSTART 0
+#define STDIO_PORT 0x00
+// To know which part of RAM to dump, we listen to port 2, which at the end of
+// its compilation process, spits its HERE addr to port 2 (MSB first)
+#define HERE_PORT 0x02
+
+VM *vm;
+// We support double-pokes, that is, a first poke to tell where to start the
+// dump and a second one to tell where to stop. If there is only one poke, it's
+// then ending HERE and we start at sizeof(KERNEL).
+static uint16_t start_here = 0;
+static uint16_t end_here = 0;
+
+static uint8_t iord_stdio()
+{
+    int c = getc(stdin);
+    if (c == EOF) {
+        vm->running = false;
+    }
+    return (uint8_t)c;
+}
+
+static void iowr_stdio(uint8_t val)
+{
+    // comment if you don't like verbose staging output
+    putc(val, stderr);
+}
+
+static void iowr_here(uint8_t val)
+{
+    start_here <<=8;
+    start_here |= (end_here >> 8);
+    end_here <<= 8;
+    end_here |= val;
+}
+
+int main(int argc, char *argv[])
+{
+    vm = VM_init();
+    if (vm == NULL) {
+        return 1;
+    }
+    vm->iord[STDIO_PORT] = iord_stdio;
+    vm->iowr[STDIO_PORT] = iowr_stdio;
+    vm->iowr[HERE_PORT] = iowr_here;
+    while (VM_steps(1));
+
+    // We're done, now let's spit dict data
+    for (int i=start_here; i<end_here; i++) {
+        putchar(vm->mem[i]);
+    }
+    VM_printdbg();
+    VM_deinit();
+    return 0;
+}
diff --git a/cvm/vm.c b/cvm/vm.c
index d159efe..eff275d 100644
--- a/cvm/vm.c
+++ b/cvm/vm.c
@@ -238,18 +238,8 @@ static void MINUS2() { push(pop()-2); }
 static void PLUS2() { push(pop()+2); }
 static void RSHIFT() { word u = pop(); push(pop()>>u); }
 static void LSHIFT() { word u = pop(); push(pop()<<u); }
-// create a native word with a specific target offset. target is addr of
-// wordref.
-static void create_native_t(word target, char *name, NativeWord func) {
-    int len = strlen(name);
-    strcpy(&vm.mem[target-len-3], name);
-    word prev_off = target - 3 - vm.xcurrent;
-    sw(target-3, prev_off);
-    vm.mem[target-1] = len;
-    vm.mem[target] = 0; // native word type
-    vm.mem[target+1] = vm.nativew_count;
+static void native(NativeWord func) {
     vm.nativew[vm.nativew_count++] = func;
-    vm.xcurrent = target;
 }
 
 /* INITIAL BOOTSTRAP PLAN
@@ -299,63 +289,62 @@ VM* VM_init() {
         vm.iowr[i] = NULL;
     }
     vm.iowr[BLK_PORT] = iowr_blk;
-    vm.xcurrent = 0x3f; // make EXIT's prev field 0
-    create_native_t(0x42, "EXIT", EXIT);
-    create_native_t(0x53, "(br)", _br_);
-    create_native_t(0x67, "(?br)", _cbr_);
-    create_native_t(0x80, "(loop)", _loop_);
-    create_native_t(0xa9, "2>R", SP_to_R_2);
-    create_native_t(0xbf, "(n)", nlit);
-    create_native_t(0xd4, "(s)", slit);
+    native(EXIT);
+    native(_br_);
+    native(_cbr_);
+    native(_loop_);
+    native(SP_to_R_2);
+    native(nlit);
+    native(slit);
     // End of stable ABI
-    create_native_t(0xe7, ">R", SP_to_R);
-    create_native_t(0xf4, "R>", R_to_SP);
-    create_native_t(0x102, "2R>", R_to_SP_2);
-    create_native_t(0x1d4, "EXECUTE", EXECUTE);
-    create_native_t(0x1e1, "ROT", ROT);
-    create_native_t(0x1f4, "DUP", DUP);
-    create_native_t(0x205, "?DUP", CDUP);
-    create_native_t(0x21a, "DROP", DROP);
-    create_native_t(0x226, "SWAP", SWAP);
-    create_native_t(0x238, "OVER", OVER);
-    create_native_t(0x24b, "PICK", PICK);
-    create_native_t(0x26c, "(roll)", _roll_);
-    create_native_t(0x283, "2DROP", DROP2);
-    create_native_t(0x290, "2DUP", DUP2);
-    create_native_t(0x2a2, "S0", S0);
-    create_native_t(0x2af, "'S", Saddr);
-    create_native_t(0x2be, "AND", AND);
-    create_native_t(0x2d3, "OR", OR);
-    create_native_t(0x2e9, "XOR", XOR);
-    create_native_t(0x2ff, "NOT", NOT);
-    create_native_t(0x314, "+", PLUS);
-    create_native_t(0x323, "-", MINUS);
-    create_native_t(0x334, "*", MULT);
-    create_native_t(0x358, "/MOD", DIVMOD);
-    create_native_t(0x37c, "!", STORE);
-    create_native_t(0x389, "@", FETCH);
-    create_native_t(0x39a, "C!", CSTORE);
-    create_native_t(0x3a6, "C@", CFETCH);
-    create_native_t(0x3b8, "PC!", IO_OUT);
-    create_native_t(0x3c6, "PC@", IO_IN);
-    create_native_t(0x3d7, "I", RI);
-    create_native_t(0x3e7, "I'", RI_);
-    create_native_t(0x3f6, "J", RJ);
-    create_native_t(0x407, "BYE", BYE);
-    create_native_t(0x416, "(resSP)", _resSP_);
-    create_native_t(0x427, "(resRS)", _resRS_);
-    create_native_t(0x434, "S=", Seq);
-    create_native_t(0x457, "CMP", CMP);
-    create_native_t(0x476, "_find", _find);
-    create_native_t(0x4a4, "0", ZERO);
-    create_native_t(0x4b0, "1", ONE);
-    create_native_t(0x4bd, "-1", MONE);
-    create_native_t(0x4ca, "1+", PLUS1);
-    create_native_t(0x4d9, "1-", MINUS1);
-    create_native_t(0x4e8, "2+", PLUS2);
-    create_native_t(0x4f8, "2-", MINUS2);
-    create_native_t(0x50c, "RSHIFT", RSHIFT);
-    create_native_t(0x52a, "LSHIFT", LSHIFT);
+    native(SP_to_R);
+    native(R_to_SP);
+    native(R_to_SP_2);
+    native(EXECUTE);
+    native(ROT);
+    native(DUP);
+    native(CDUP);
+    native(DROP);
+    native(SWAP);
+    native(OVER);
+    native(PICK);
+    native(_roll_);
+    native(DROP2);
+    native(DUP2);
+    native(S0);
+    native(Saddr);
+    native(AND);
+    native(OR);
+    native(XOR);
+    native(NOT);
+    native(PLUS);
+    native(MINUS);
+    native(MULT);
+    native(DIVMOD);
+    native(STORE);
+    native(FETCH);
+    native(CSTORE);
+    native(CFETCH);
+    native(IO_OUT);
+    native(IO_IN);
+    native(RI);
+    native(RI_);
+    native(RJ);
+    native(BYE);
+    native(_resSP_);
+    native(_resRS_);
+    native(Seq);
+    native(CMP);
+    native(_find);
+    native(ZERO);
+    native(ONE);
+    native(MONE);
+    native(PLUS1);
+    native(MINUS1);
+    native(PLUS2);
+    native(MINUS2);
+    native(RSHIFT);
+    native(LSHIFT);
     vm.IP = gw(0x04) + 1; // BOOT
     sw(SYSVARS+0x02, gw(0x08)); // CURRENT
     sw(SYSVARS+0x04, gw(0x08)); // HERE
diff --git a/cvm/xcomp.fs b/cvm/xcomp.fs
new file mode 100644
index 0000000..85d056f
--- /dev/null
+++ b/cvm/xcomp.fs
@@ -0,0 +1,104 @@
+0xe800 CONSTANT RAMSTART
+0xff00 CONSTANT RS_ADDR
+0xfffa CONSTANT PS_ADDR
+: CODE ( natidx -- ) (entry) 0 C, C, ;
+VARIABLE ORG
+CREATE BIN( 0 ,
+: PC H@ ORG @ - ;
+262 LOAD  ( xcomp )
+270 LOAD  ( xcomp overrides )
+
+H@ ORG !
+ORG @ 0x3b + HERE !
+," EXIT"
+0 , ( prev ) 4 C,
+H@ XCURRENT ! ( set current tip of dict, 0x42 )
+0 C, 0 C,
+ORG @ 0x4c + HERE !
+0x01 CODE (br) ( 0x53 )
+ORG @ 0x5f + HERE !
+0x02 CODE (?br) ( 0x67 )
+ORG @ 0x77 + HERE !
+0x03 CODE (loop) ( 0x80 )
+ORG @ 0xa3 + HERE !
+0x04 CODE 2>R ( 0xa9 )
+ORG @ 0xb9 + HERE !
+0x05 CODE (n) ( 0xbf )
+ORG @ 0xce + HERE !
+0x06 CODE (s) ( 0xd4 )
+( END OF STABLE ABI )
+0x07 CODE >R
+0x08 CODE R>
+0x09 CODE 2R>
+0x0a CODE EXECUTE
+0x0b CODE ROT
+0x0c CODE DUP
+0x0d CODE ?DUP
+0x0e CODE DROP
+0x0f CODE SWAP
+0x10 CODE OVER
+0x11 CODE PICK
+0x12 CODE (roll)
+0x13 CODE 2DROP
+0x14 CODE 2DUP
+0x15 CODE S0
+0x16 CODE 'S
+0x17 CODE AND
+0x18 CODE OR
+0x19 CODE XOR
+0x1a CODE NOT
+0x1b CODE +
+0x1c CODE -
+0x1d CODE *
+0x1e CODE /MOD
+0x1f CODE !
+0x20 CODE @
+0x21 CODE C!
+0x22 CODE C@
+0x23 CODE PC!
+0x24 CODE PC@
+0x25 CODE I
+0x26 CODE I'
+0x27 CODE J
+0x28 CODE BYE
+0x29 CODE (resSP)
+0x2a CODE (resRS)
+0x2b CODE S=
+0x2c CODE CMP
+0x2d CODE _find
+0x2e CODE 0
+0x2f CODE 1
+0x30 CODE -1
+0x31 CODE 1+
+0x32 CODE 1-
+0x33 CODE 2+
+0x34 CODE 2-
+0x35 CODE RSHIFT
+0x36 CODE LSHIFT
+353 LOAD  ( xcomp core low )
+: (emit) 0 PC! ;
+: (key) 0 PC@ ;
+: EFS@
+    1 3 PC! ( read )
+    256 /MOD 3 PC! 3 PC! ( blkid )
+    BLK( 256 /MOD 3 PC! 3 PC! ( dest )
+;
+: EFS!
+    2 3 PC! ( write )
+    256 /MOD 3 PC! 3 PC! ( blkid )
+    BLK( 256 /MOD 3 PC! 3 PC! ( dest )
+;
+: COLS 80 ; : LINES 32 ;
+: AT-XY 6 PC! ( y ) 5 PC! ( x ) ;
+
+380 LOAD  ( xcomp core high )
+(entry) _
+( Update LATEST )
+PC ORG @ 8 + !
+," CURRENT @ HERE ! "
+," BLK$ "
+," ' EFS@ BLK@* ! "
+," ' EFS! BLK!* ! "
+EOT,
+ORG @ 256 /MOD 2 PC! 2 PC!
+H@ 256 /MOD 2 PC! 2 PC!