mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-24 01:58:06 +11:00
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.
This commit is contained in:
parent
f89e7bd503
commit
a8e573c84a
9
apps/forth/core.fth
Normal file
9
apps/forth/core.fth
Normal file
@ -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 = ;
|
@ -663,123 +663,5 @@ RECURSE:
|
|||||||
push hl \ pop iy
|
push hl \ pop iy
|
||||||
jp compiledWord
|
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:
|
LATEST:
|
||||||
.dw compiledWord
|
.dw RECURSE
|
||||||
.dw CMP
|
|
||||||
.dw NUMBER
|
|
||||||
.dw 1
|
|
||||||
.dw EQ
|
|
||||||
|
@ -21,6 +21,10 @@
|
|||||||
.equ COMPBUF @+2
|
.equ COMPBUF @+2
|
||||||
.equ FORTH_RAMEND @+0x40
|
.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
|
; EXECUTION MODEL
|
||||||
; After having read a line through stdioReadLine, we want to interpret it. As
|
; After having read a line through stdioReadLine, we want to interpret it. As
|
||||||
; a general rule, we go like this:
|
; a general rule, we go like this:
|
||||||
@ -51,9 +55,14 @@ forthMain:
|
|||||||
; we check for stack underflow.
|
; we check for stack underflow.
|
||||||
push af \ push af \ push af
|
push af \ push af \ push af
|
||||||
ld (INITIAL_SP), sp
|
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
|
ld hl, LATEST
|
||||||
|
call intoHL
|
||||||
ld (CURRENT), hl
|
ld (CURRENT), hl
|
||||||
ld hl, FORTH_RAMEND
|
ld hl, HERE_INITIAL
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
forthRdLine:
|
forthRdLine:
|
||||||
ld hl, msgOk
|
ld hl, msgOk
|
||||||
|
1
emul/.gitignore
vendored
1
emul/.gitignore
vendored
@ -1,4 +1,5 @@
|
|||||||
/shell/shell
|
/shell/shell
|
||||||
|
/forth/stage1
|
||||||
/forth/forth
|
/forth/forth
|
||||||
/zasm/zasm
|
/zasm/zasm
|
||||||
/zasm/avra
|
/zasm/avra
|
||||||
|
@ -24,13 +24,25 @@ shell/shell-bin.h: shell/shell.bin
|
|||||||
shell/shell: shell/shell.c $(SHELLOBJS) shell/shell-bin.h
|
shell/shell: shell/shell.c $(SHELLOBJS) shell/shell-bin.h
|
||||||
$(CC) shell/shell.c $(SHELLOBJS) -o $@
|
$(CC) shell/shell.c $(SHELLOBJS) -o $@
|
||||||
|
|
||||||
forth/forth.bin: forth/glue.asm $(ZASMBIN)
|
forth/forth0.bin: forth/glue0.asm $(ZASMBIN)
|
||||||
$(ZASMBIN) $(KERNEL) $(APPS) < forth/glue.asm | tee $@ > /dev/null
|
$(ZASMBIN) $(KERNEL) $(APPS) < forth/glue0.asm | tee $@ > /dev/null
|
||||||
|
|
||||||
forth/forth-bin.h: forth/forth.bin
|
forth/forth0-bin.h: forth/forth0.bin
|
||||||
./bin2c.sh KERNEL < forth/forth.bin | tee $@ > /dev/null
|
./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 $@
|
$(CC) forth/forth.c $(OBJS) -o $@
|
||||||
|
|
||||||
zasm/kernel-bin.h: zasm/kernel.bin
|
zasm/kernel-bin.h: zasm/kernel.bin
|
||||||
|
@ -3,10 +3,10 @@
|
|||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
#include <termios.h>
|
#include <termios.h>
|
||||||
#include "../emul.h"
|
#include "../emul.h"
|
||||||
#include "forth-bin.h"
|
#include "forth1-bin.h"
|
||||||
|
|
||||||
// in sync with glue.asm
|
// in sync with glue.asm
|
||||||
#define RAMSTART 0x2000
|
#define RAMSTART 0x900
|
||||||
#define STDIO_PORT 0x00
|
#define STDIO_PORT 0x00
|
||||||
|
|
||||||
static int running;
|
static int running;
|
||||||
|
56
emul/forth/glue0.asm
Normal file
56
emul/forth/glue0.asm
Normal file
@ -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
|
@ -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"
|
.inc "ascii.h"
|
||||||
.equ RAMSTART 0x2000
|
|
||||||
.equ STDIO_PORT 0x00
|
.equ STDIO_PORT 0x00
|
||||||
|
|
||||||
jp init
|
jp init
|
||||||
@ -22,6 +24,7 @@
|
|||||||
.inc "forth/stack.asm"
|
.inc "forth/stack.asm"
|
||||||
.inc "forth/dict.asm"
|
.inc "forth/dict.asm"
|
||||||
|
|
||||||
|
|
||||||
init:
|
init:
|
||||||
di
|
di
|
||||||
; setup stack
|
; setup stack
|
||||||
@ -38,3 +41,10 @@ emulGetC:
|
|||||||
emulPutC:
|
emulPutC:
|
||||||
out (STDIO_PORT), a
|
out (STDIO_PORT), a
|
||||||
ret
|
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:
|
87
emul/forth/stage1.c
Normal file
87
emul/forth/stage1.c
Normal file
@ -0,0 +1,87 @@
|
|||||||
|
#include <stdint.h>
|
||||||
|
#include <stdio.h>
|
||||||
|
#include <unistd.h>
|
||||||
|
#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; i<sizeof(KERNEL); i++) {
|
||||||
|
m->mem[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); i<here; i++) {
|
||||||
|
putchar(m->mem[i]);
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user