1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 07:38:06 +11:00

Compare commits

...

2 Commits

Author SHA1 Message Date
Virgil Dupras
d6516e2122 forth: Forth-ify "2*" stack management words 2020-03-24 14:44:10 -04:00
Virgil Dupras
67c55b0b2f forth: Forth-ify ROT, a native word!
This requires us to significantly adjust our build process, which
now has 3 stages.
2020-03-24 13:46:05 -04:00
14 changed files with 197 additions and 133 deletions

2
emul/.gitignore vendored
View File

@ -1,6 +1,8 @@
/shell/shell
/forth/stage1
/forth/stage1dbg
/forth/stage2
/forth/stage2dbg
/forth/forth
/zasm/zasm
/zasm/avra

View File

@ -27,8 +27,8 @@ shell/shell-bin.h: shell/shell.bin
shell/shell: shell/shell.c $(SHELLOBJS) shell/shell-bin.h
$(CC) shell/shell.c $(SHELLOBJS) -o $@
forth/forth0.bin: forth/glue0.asm $(ZASMBIN)
$(ZASMBIN) $(KERNEL) ../forth < forth/glue0.asm | tee $@ > /dev/null
forth/forth0.bin: forth/stage0.asm $(ZASMBIN)
$(ZASMBIN) $(KERNEL) ../forth forth/stagec.asm < forth/stage0.asm | tee $@ > /dev/null
forth/forth0-bin.h: forth/forth0.bin
./bin2c.sh KERNEL < forth/forth0.bin | tee $@ > /dev/null
@ -39,16 +39,30 @@ forth/stage1: forth/stage.c $(OBJS) forth/forth0-bin.h
forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h
$(CC) -DDEBUG forth/stage.c $(OBJS) -o $@
forth/core.bin: $(FORTHSRC_PATHS) forth/stage1
cat $(FORTHSRC_PATHS) | ./forth/stage1 | tee $@ > /dev/null
forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN)
$(ZASMBIN) $(KERNEL) ../forth forth/core.bin < forth/glue1.asm | tee $@ > /dev/null
# z80c.bin is not in the prerequisites because its a bootstrap binary that
# should be updated manually through make fbootstrap.
forth/forth1.bin: forth/stage1.asm forth/forth0.bin $(ZASMBIN)
$(ZASMBIN) $(KERNEL) ../forth forth/z80c.bin forth/stagec.asm < forth/stage1.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
forth/stage2: forth/stage.c $(OBJS) forth/forth1-bin.h
$(CC) -DSTAGE2 forth/stage.c $(OBJS) -o $@
forth/stage2dbg: forth/stage.c $(OBJS) forth/forth1-bin.h
$(CC) -DSTAGE2 -DDEBUG forth/stage.c $(OBJS) -o $@
forth/core.bin: $(FORTHSRC_PATHS) forth/stage2
cat $(FORTHSRC_PATHS) | ./forth/stage2 | tee $@ > /dev/null
forth/forth2.bin: forth/stage2.asm forth/core.bin $(ZASMBIN)
$(ZASMBIN) $(KERNEL) ../forth forth/core.bin forth/z80c.bin forth/stagec.asm < forth/stage2.asm | tee $@ > /dev/null
forth/forth2-bin.h: forth/forth2.bin
./bin2c.sh KERNEL < forth/forth2.bin | tee $@ > /dev/null
forth/forth: forth/forth.c $(OBJS) forth/forth2-bin.h
$(CC) forth/forth.c $(OBJS) -o $@
zasm/kernel-bin.h: zasm/kernel.bin
@ -94,6 +108,10 @@ updatebootstrap: $(ZASMBIN)
$(ZASMBIN) $(KERNEL) < zasm/glue.asm > zasm/kernel.bin
$(ZASMBIN) $(KERNEL) $(APPS) zasm/user.h < $(APPS)/zasm/glue.asm > zasm/zasm.bin
.PHONY: fbootstrap
fbootstrap: forth/stage1
cat $(FORTHSRC_PATHS) ../forth/z80c.fs ../forth/dummy.fs | ./forth/stage1 | tee forth/z80c.bin > /dev/null
.PHONY: clean
clean:
rm -f $(TARGETS) $(SHELLTGTS) emul.o zasm/*-bin.h shell/*-bin.h

View File

@ -80,6 +80,39 @@ code of the program is the value of `A` when the program halts.
This is used for unit tests.
## forth
Collapse OS' Forth interpreter, which will probably soon replace the whole OS.
At this point, it is not yet entirely self-hosting, but will be eventually.
Because of that aim, it currently builds in a particular manner.
There are 3 build stages.
**Stage 0**: This stage is created with zasm by assembling `forth/forth.asm`
through `stage0.asm`. This yields `forth0.bin`. We then wrap this binary with
`stage.c` to create the `stage1` binary, which allows us to get to the next
stage.
The long term goal is to gradually extract contents from `forth.asm` and have
nothing but Forth source files.
**Stage 1**: The `stage1` binary allows us to augment `forth0.bin` with
contents from `z80c.fs`, which compiles native words using Forth's Z80
assembler. This yields `z80c.bin`.
This is where there's a chiken-and-egg issue: Forth's assembler needs our full
Forth interpreter, but that interpreter needs native words from `z80c.fs`. This
is why `z80c.bin` is committed into the git repo and it's built automatically
with `make`. Updating `z80c.bin` is a specific make rule, `fbootstrap`.
Then, from there, we augment `forth0.bin` with `z80c.bin` and yield
`forth1.bin`, from which we create `stage2`.
**Stage 2**: From there, the way is clear to compile the dict of our full Forth
interpreter, which we do using `stage2` and produce `forth2.bin`, from which we
can create our final `forth` executable.
## Problems?
If the libz80-wrapped zasm executable works badly (hangs, spew garbage, etc.),

View File

@ -3,7 +3,7 @@
#include <unistd.h>
#include <termios.h>
#include "../emul.h"
#include "forth1-bin.h"
#include "forth2-bin.h"
// in sync with glue.asm
#define RAMSTART 0x900

View File

@ -1,31 +0,0 @@
; Warning: The offsets of native dict entries must be exactly the same between
; glue0.asm and glue1.asm
.equ LATEST RAMSTART ; override
.equ STDIO_PORT 0x00
jp init
.equ GETC emulGetC
.equ PUTC emulPutC
.inc "forth.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
.out $ ; should be the same as in glue0
.bin "core.bin"
RAMSTART:

View File

@ -2,7 +2,11 @@
#include <stdio.h>
#include <unistd.h>
#include "../emul.h"
#ifdef STAGE2
#include "forth1-bin.h"
#else
#include "forth0-bin.h"
#endif
/* Staging binaries
@ -32,7 +36,11 @@ trouble of compiling defs to binary.
#define HERE_PORT 0x02
static int running;
static uint16_t ending_here = 0;
// 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()
{
@ -54,8 +62,10 @@ static void iowr_stdio(uint8_t val)
static void iowr_here(uint8_t val)
{
ending_here <<= 8;
ending_here |= val;
start_here <<=8;
start_here |= (end_here >> 8);
end_here <<= 8;
end_here |= val;
}
int main(int argc, char *argv[])
@ -76,8 +86,10 @@ int main(int argc, char *argv[])
#ifndef DEBUG
// We're done, now let's spit dict data
fprintf(stderr, "hey, %x\n", ending_here);
for (int i=sizeof(KERNEL); i<ending_here; i++) {
if (start_here == 0) {
start_here = sizeof(KERNEL);
}
for (int i=start_here; i<end_here; i++) {
putchar(m->mem[i]);
}
#endif

7
emul/forth/stage0.asm Normal file
View File

@ -0,0 +1,7 @@
jp init
.inc "stagec.asm"
.inc "forth.asm"
CODE_END:
.out $ ; should be the same as in stage{1,2}

8
emul/forth/stage1.asm Normal file
View File

@ -0,0 +1,8 @@
jp init
.inc "stagec.asm"
.inc "forth.asm"
.out $ ; should be the same as in stage{0,2}
.bin "z80c.bin"
CODE_END:

10
emul/forth/stage2.asm Normal file
View File

@ -0,0 +1,10 @@
jp init
.inc "stagec.asm"
.inc "forth.asm"
.out $ ; should be the same as in stage{0,1}
.bin "z80c.bin"
.bin "core.bin"
CODE_END:

View File

@ -1,13 +1,8 @@
.equ RAMSTART 0xe800
.equ HERE_INITIAL CODE_END ; override
.equ LATEST CODE_END ; override
.equ STDIO_PORT 0x00
jp init
.equ GETC emulGetC
.equ PUTC emulPutC
.inc "forth.asm"
init:
di
; setup stack
@ -25,6 +20,5 @@ emulPutC:
out (STDIO_PORT), a
ret
CODE_END:
.out LATEST
.out $ ; should be the same as in glue1
.equ GETC emulGetC
.equ PUTC emulPutC

BIN
emul/forth/z80c.bin Normal file

Binary file not shown.

View File

@ -1405,28 +1405,10 @@ SWAP:
push hl
jp next
; ( a b c d -- c d a b )
.db "2SWAP"
.fill 2
.dw $-SWAP
.db 0
SWAP2:
.dw nativeWord
pop de ; D
pop hl ; C
pop bc ; B
call chkPS
ex (sp), hl ; A in HL
push de ; D
push hl ; A
push bc ; B
jp next
; ( a -- a a )
.db "DUP"
.fill 4
.dw $-SWAP2
.dw $-SWAP
.db 0
DUP:
.dw nativeWord
@ -1436,26 +1418,10 @@ DUP:
push hl
jp next
; ( a b -- a b a b )
.db "2DUP"
.fill 3
.dw $-DUP
.db 0
DUP2:
.dw nativeWord
pop hl ; B
pop de ; A
call chkPS
push de
push hl
push de
push hl
jp next
; ( a b -- a b a )
.db "OVER"
.fill 3
.dw $-DUP2
.dw $-DUP
.db 0
OVER:
.dw nativeWord
@ -1467,45 +1433,9 @@ OVER:
push de
jp next
; ( a b c d -- a b c d a b )
.db "2OVER"
.fill 2
.dw $-OVER
.db 0
OVER2:
.dw nativeWord
pop hl ; D
pop de ; C
pop bc ; B
pop iy ; A
call chkPS
push iy ; A
push bc ; B
push de ; C
push hl ; D
push iy ; A
push bc ; B
jp next
; ( a b c -- b c a)
.db "ROT"
.fill 4
.dw $-OVER2
.db 0
ROT:
.dw nativeWord
pop hl ; C
pop de ; B
pop bc ; A
call chkPS
push de ; B
push hl ; C
push bc ; A
jp next
.db ">R"
.fill 5
.dw $-ROT
.dw $-OVER
.db 0
P2R:
.dw nativeWord

View File

@ -1,11 +1,5 @@
( Z80 assembler )
: CODE
( same as CREATE, but with ROUTINE V )
(entry)
ROUTINE V [LITN] ,
;
( Splits word into msb/lsb, lsb being on TOS )
: SPLITB
DUP 0x100 /
@ -28,6 +22,11 @@
3 CONSTANT AF
3 CONSTANT SP
( As a general rule, IX and IY are equivalent to spitting an
extra 0xdd / 0xfd and then spit the equivalent of HL )
: IX 0xdd A, HL ;
: IY 0xfd A, HL ;
( -- )
: OP1 CREATE C, DOES> C@ A, ;
0xc9 OP1 RET,
@ -130,3 +129,12 @@
( Specials )
: JRe, 0x18 A, 2 - A, ;
: JPNEXT, ROUTINE N [LITN] JPnn, ;
: CODE
( same as CREATE, but with ROUTINE V )
(entry)
ROUTINE V [LITN] ,
;
: ;CODE JPNEXT, ;

73
forth/z80c.fs Normal file
View File

@ -0,0 +1,73 @@
( Core words in z80. This requires a full Forth interpreter
to run, but is also necessary for core.fs. This means that
it needs to be compiled from a prior bootstrapped binary.
This stage is tricky due to the fact that references in
Forth are all absolute, except for prev word refs. This
means that there are severe limitations to the kind of code
you can put here.
You shouldn't define any word with reference to other words.
This means no regular definition. You can, however, execute
any word from our high level Forth, as long as it doesn't
spit word references.
ROUTINE stuff is fine. It's not supposed to change.
These restrictions are temporary, I'll figure something out
so that we can end up fully bootstrap Forth from within
itself.
)
( a b c -- b c a )
CODE ROT
HL POPqq, ( C )
DE POPqq, ( B )
BC POPqq, ( A )
ROUTINE P CALLnn,
DE PUSHqq, ( B )
HL PUSHqq, ( C )
BC PUSHqq, ( A )
;CODE
( a b -- a b a b )
CODE 2DUP
HL POPqq, ( B )
DE POPqq, ( A )
ROUTINE P CALLnn,
DE PUSHqq, ( A )
HL PUSHqq, ( B )
DE PUSHqq, ( A )
HL PUSHqq, ( B )
;CODE
( a b c d -- a b c d a b )
CODE 2OVER
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
IY POPqq, ( A )
ROUTINE P CALLnn,
IY PUSHqq, ( A )
BC PUSHqq, ( B )
DE PUSHqq, ( C )
HL PUSHqq, ( D )
IY PUSHqq, ( A )
BC PUSHqq, ( B )
;CODE
( a b c d -- c d a b )
CODE 2SWAP
HL POPqq, ( D )
DE POPqq, ( C )
BC POPqq, ( B )
IY POPqq, ( A )
ROUTINE P CALLnn,
DE PUSHqq, ( C )
HL PUSHqq, ( D )
IY PUSHqq, ( A )
BC PUSHqq, ( B )
;CODE