From a8e573c84a5773d2280e57f3f0fce53fd2307eed Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Thu, 12 Mar 2020 00:14:44 -0400 Subject: [PATCH] forth: add bin dict compilation stage! Big one. This allows us to write higher order words directly in Forth, which is much more convenient than writing post-immediate (see "NOT" structure in diff if you want to see what I mean) structures in ASM. These structures can then be written to ROM (rather than loaded in RAM for definitions loaded at run-time). That's quite a bit of tooling that was added, 2 compilations stages, but I think it's well worth it. --- apps/forth/core.fth | 9 +++ apps/forth/dict.asm | 120 +---------------------------- apps/forth/main.asm | 11 ++- emul/.gitignore | 1 + emul/Makefile | 22 ++++-- emul/forth/forth.c | 4 +- emul/forth/glue0.asm | 56 ++++++++++++++ emul/forth/{glue.asm => glue1.asm} | 12 ++- emul/forth/stage1.c | 87 +++++++++++++++++++++ 9 files changed, 194 insertions(+), 128 deletions(-) create mode 100644 apps/forth/core.fth create mode 100644 emul/forth/glue0.asm rename emul/forth/{glue.asm => glue1.asm} (59%) create mode 100644 emul/forth/stage1.c diff --git a/apps/forth/core.fth b/apps/forth/core.fth new file mode 100644 index 0000000..5f3860f --- /dev/null +++ b/apps/forth/core.fth @@ -0,0 +1,9 @@ +: ? @ . ; +: +! SWAP OVER @ + SWAP ! ; +: ALLOT HERE +! ; +: VARIABLE CREATE 2 ALLOT ; +: CONSTANT CREATE HERE @ ! DOES> @ ; +: NOT IF 0 ELSE 1 THEN ; +: = CMP NOT ; +: < CMP 0 1 - = ; +: > CMP 1 = ; diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm index e555f65..219b598 100644 --- a/apps/forth/dict.asm +++ b/apps/forth/dict.asm @@ -663,123 +663,5 @@ RECURSE: push hl \ pop iy jp compiledWord -; End of native words - -; ( a -- ) -; @ . - .db "?" - .fill 7 - .dw RECURSE -FETCHDOT: - .dw compiledWord - .dw FETCH - .dw DOT - .dw EXIT - -; ( n a -- ) -; SWAP OVER @ + SWAP ! - .db "+!" - .fill 6 - .dw FETCHDOT -STOREINC: - .dw compiledWord - .dw SWAP - .dw OVER - .dw FETCH - .dw PLUS - .dw SWAP - .dw STORE - .dw EXIT - -; ( n -- ) -; HERE +! - .db "ALLOT" - .fill 3 - .dw STOREINC -ALLOT: - .dw compiledWord - .dw HERE_ - .dw STOREINC - .dw EXIT - -; CREATE 2 ALLOT - .db "VARIABL" - .db 0 - .dw ALLOT -VARIABLE: - .dw compiledWord - .dw CREATE - .dw NUMBER - .dw 2 - .dw ALLOT - .dw EXIT - -; ( n -- ) -; CREATE HERE @ ! DOES> @ - .db "CONSTAN" - .db 0 - .dw VARIABLE -CONSTANT: - .dw compiledWord - .dw CREATE - .dw HERE_ - .dw FETCH - .dw STORE - .dw DOES - .dw FETCH - .dw EXIT - -; TODO: find a way to express IF/THEN/ELSE in core dict more easily. -; ( f -- f ) -; IF 0 ELSE 1 THEN - .db "NOT" - .fill 5 - .dw CONSTANT -NOT: - .dw compiledWord - .dw CBRANCH - .db 8 - .dw NUMBER - .dw 0 - .dw BRANCH - .db 5 - .dw NUMBER - .dw 1 - .dw EXIT - -; ( n1 n2 -- f ) -; CMP NOT - .db "=" - .fill 7 - .dw NOT -EQ: - .dw compiledWord - .dw CMP - .dw NOT - .dw EXIT - -; ( n1 n2 -- f ) -; CMP -1 = - .db "<" - .fill 7 - .dw EQ -LT: - .dw compiledWord - .dw CMP - .dw NUMBER - .dw -1 - .dw EQ - .dw EXIT - -; ( n1 n2 -- f ) -; CMP 1 = - .db ">" - .fill 7 - .dw LT -GT: LATEST: - .dw compiledWord - .dw CMP - .dw NUMBER - .dw 1 - .dw EQ + .dw RECURSE diff --git a/apps/forth/main.asm b/apps/forth/main.asm index a793218..b3bf1e1 100644 --- a/apps/forth/main.asm +++ b/apps/forth/main.asm @@ -21,6 +21,10 @@ .equ COMPBUF @+2 .equ FORTH_RAMEND @+0x40 +; (HERE) usually starts at RAMEND, but in certain situations, such as in stage0, +; (HERE) will begin at a strategic place. +.equ HERE_INITIAL FORTH_RAMEND + ; EXECUTION MODEL ; After having read a line through stdioReadLine, we want to interpret it. As ; a general rule, we go like this: @@ -51,9 +55,14 @@ forthMain: ; we check for stack underflow. push af \ push af \ push af ld (INITIAL_SP), sp + ; LATEST is a *indirect* label to the latest entry of the dict. See + ; default at the bottom of dict.asm. This indirection allows us to + ; override latest to a value set in a binary dict compiled separately, + ; for example by the stage0 bin. ld hl, LATEST + call intoHL ld (CURRENT), hl - ld hl, FORTH_RAMEND + ld hl, HERE_INITIAL ld (HERE), hl forthRdLine: ld hl, msgOk diff --git a/emul/.gitignore b/emul/.gitignore index c099a28..88d5e2c 100644 --- a/emul/.gitignore +++ b/emul/.gitignore @@ -1,4 +1,5 @@ /shell/shell +/forth/stage1 /forth/forth /zasm/zasm /zasm/avra diff --git a/emul/Makefile b/emul/Makefile index 3bd7dde..1ea7d1e 100644 --- a/emul/Makefile +++ b/emul/Makefile @@ -24,13 +24,25 @@ shell/shell-bin.h: shell/shell.bin shell/shell: shell/shell.c $(SHELLOBJS) shell/shell-bin.h $(CC) shell/shell.c $(SHELLOBJS) -o $@ -forth/forth.bin: forth/glue.asm $(ZASMBIN) - $(ZASMBIN) $(KERNEL) $(APPS) < forth/glue.asm | tee $@ > /dev/null +forth/forth0.bin: forth/glue0.asm $(ZASMBIN) + $(ZASMBIN) $(KERNEL) $(APPS) < forth/glue0.asm | tee $@ > /dev/null -forth/forth-bin.h: forth/forth.bin - ./bin2c.sh KERNEL < forth/forth.bin | tee $@ > /dev/null +forth/forth0-bin.h: forth/forth0.bin + ./bin2c.sh KERNEL < forth/forth0.bin | tee $@ > /dev/null -forth/forth: forth/forth.c $(OBJS) forth/forth-bin.h +forth/stage1: forth/stage1.c $(OBJS) forth/forth0-bin.h + $(CC) forth/stage1.c $(OBJS) -o $@ + +forth/core.bin: $(APPS)/forth/core.fth forth/stage1 + ./forth/stage1 $(APPS)/forth/core.fth | tee $@ > /dev/null + +forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN) + $(ZASMBIN) $(KERNEL) $(APPS) forth/core.bin < forth/glue1.asm | tee $@ > /dev/null + +forth/forth1-bin.h: forth/forth1.bin + ./bin2c.sh KERNEL < forth/forth1.bin | tee $@ > /dev/null + +forth/forth: forth/forth.c $(OBJS) forth/forth1-bin.h $(CC) forth/forth.c $(OBJS) -o $@ zasm/kernel-bin.h: zasm/kernel.bin diff --git a/emul/forth/forth.c b/emul/forth/forth.c index dd1ba9e..739f550 100644 --- a/emul/forth/forth.c +++ b/emul/forth/forth.c @@ -3,10 +3,10 @@ #include #include #include "../emul.h" -#include "forth-bin.h" +#include "forth1-bin.h" // in sync with glue.asm -#define RAMSTART 0x2000 +#define RAMSTART 0x900 #define STDIO_PORT 0x00 static int running; diff --git a/emul/forth/glue0.asm b/emul/forth/glue0.asm new file mode 100644 index 0000000..f7d9591 --- /dev/null +++ b/emul/forth/glue0.asm @@ -0,0 +1,56 @@ +; RAM disposition +; +; Because this glue code also serves stage0 which needs HERE to start right +; after the code, we have a peculiar RAM setup here: it lives at the very end +; of the address space, just under RS_ADDR at 0xf000 +; Warning: The offsets of native dict entries must be exactly the same between +; glue0.asm and glue1.asm +.equ RAMSTART 0xe800 +.equ HERE 0xe700 ; override, in sync with stage1.c +.equ CURRENT 0xe702 ; override, in sync with stage1.c +.equ HERE_INITIAL CODE_END ; override + +.inc "ascii.h" +.equ STDIO_PORT 0x00 + + jp init + +.inc "core.asm" +.inc "str.asm" + +.equ STDIO_RAMSTART RAMSTART +.equ STDIO_GETC emulGetC +.equ STDIO_PUTC emulPutC +.inc "stdio.asm" + +.inc "lib/util.asm" +.inc "lib/parse.asm" +.inc "lib/ari.asm" +.inc "lib/fmt.asm" +.equ FORTH_RAMSTART STDIO_RAMEND +.inc "forth/main.asm" +.inc "forth/util.asm" +.inc "forth/stack.asm" +.inc "forth/dict.asm" + + +init: + di + ; setup stack + ld sp, 0xffff + call forthMain + halt + +emulGetC: + ; Blocks until a char is returned + in a, (STDIO_PORT) + cp a ; ensure Z + ret + +emulPutC: + out (STDIO_PORT), a + ret + +.dw 0 ; placeholder used in glue1. +CODE_END: +.out $ ; should be the same as in glue1 diff --git a/emul/forth/glue.asm b/emul/forth/glue1.asm similarity index 59% rename from emul/forth/glue.asm rename to emul/forth/glue1.asm index d46846d..2bbdc89 100644 --- a/emul/forth/glue.asm +++ b/emul/forth/glue1.asm @@ -1,5 +1,7 @@ +; Warning: The offsets of native dict entries must be exactly the same between +; glue0.asm and glue1.asm +.equ LATEST CODE_END ; override .inc "ascii.h" -.equ RAMSTART 0x2000 .equ STDIO_PORT 0x00 jp init @@ -22,6 +24,7 @@ .inc "forth/stack.asm" .inc "forth/dict.asm" + init: di ; setup stack @@ -38,3 +41,10 @@ emulGetC: emulPutC: out (STDIO_PORT), a ret + +.out $ ; should be the same as in glue0, minus 2 +; stage0 spits, at the beginning of the binary, the address of the latest word +; Therefore, we can set the LATEST label to here and we should be good. +CODE_END: +.bin "core.bin" +RAMSTART: diff --git a/emul/forth/stage1.c b/emul/forth/stage1.c new file mode 100644 index 0000000..a4c24c5 --- /dev/null +++ b/emul/forth/stage1.c @@ -0,0 +1,87 @@ +#include +#include +#include +#include "../emul.h" +#include "forth0-bin.h" + +/* Stage 1 + +The role of the stage 1 executable is to start from a bare Forth executable +(stage 0) that will compile core non-native definitions into binary form and +append this to existing bootstrap binary to form our final Forth bin. + +We could, if we wanted, run only with the bootstrap binary and compile core +defs at runtime, but that would mean that those defs live in RAM. In may system, +RAM is much more constrained than ROM, so it's worth it to give ourselves the +trouble of compiling defs to binary. + +This stage 0 executable has to be layed out in a particular manner: HERE must +directly follow executable's last byte so that we don't waste spce and also +that wordref offsets correspond. +*/ + +// in sync with glue.asm +#define RAMSTART 0x900 +#define STDIO_PORT 0x00 +// In sync with glue code. This way, we can know where HERE was when we stopped +// running +#define HERE 0xe700 +// We also need to know what CURRENT is so we can write our first two bytes +#define CURRENT 0xe702 + +static int running; +static FILE *fp; + +static uint8_t iord_stdio() +{ + int c = getc(fp); + if (c == EOF) { + running = 0; + } + return (uint8_t)c; +} + +static void iowr_stdio(uint8_t val) +{ + // we don't output stdout in stage0 +} + +int main(int argc, char *argv[]) +{ + bool tty = false; + if (argc == 2) { + fp = fopen(argv[1], "r"); + if (fp == NULL) { + fprintf(stderr, "Can't open %s\n", argv[1]); + return 1; + } + } else { + fprintf(stderr, "Usage: ./stage0 filename\n"); + return 1; + } + Machine *m = emul_init(); + m->ramstart = RAMSTART; + m->iord[STDIO_PORT] = iord_stdio; + m->iowr[STDIO_PORT] = iowr_stdio; + // initialize memory + for (int i=0; imem[i] = KERNEL[i]; + } + // Run! + running = 1; + + while (running && emul_step()); + + fclose(fp); + + // We're done, now let's spit dict data + // let's start with LATEST spitting. + putchar(m->mem[CURRENT]); + putchar(m->mem[CURRENT+1]); + uint16_t here = m->mem[HERE] + (m->mem[HERE+1] << 8); + for (int i=sizeof(KERNEL); imem[i]); + } + return 0; +} +