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 0000000..26f2583 Binary files /dev/null and b/cvm/forth.bin differ 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 +#include +#include +#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; imem[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()<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!