1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 16:10:55 +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 /shell/shell
/forth/stage1 /forth/stage1
/forth/stage1dbg /forth/stage1dbg
/forth/stage2
/forth/stage2dbg
/forth/forth /forth/forth
/zasm/zasm /zasm/zasm
/zasm/avra /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 shell/shell: shell/shell.c $(SHELLOBJS) shell/shell-bin.h
$(CC) shell/shell.c $(SHELLOBJS) -o $@ $(CC) shell/shell.c $(SHELLOBJS) -o $@
forth/forth0.bin: forth/glue0.asm $(ZASMBIN) forth/forth0.bin: forth/stage0.asm $(ZASMBIN)
$(ZASMBIN) $(KERNEL) ../forth < forth/glue0.asm | tee $@ > /dev/null $(ZASMBIN) $(KERNEL) ../forth forth/stagec.asm < forth/stage0.asm | tee $@ > /dev/null
forth/forth0-bin.h: forth/forth0.bin forth/forth0-bin.h: forth/forth0.bin
./bin2c.sh KERNEL < forth/forth0.bin | tee $@ > /dev/null ./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 forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h
$(CC) -DDEBUG forth/stage.c $(OBJS) -o $@ $(CC) -DDEBUG forth/stage.c $(OBJS) -o $@
forth/core.bin: $(FORTHSRC_PATHS) forth/stage1 # z80c.bin is not in the prerequisites because its a bootstrap binary that
cat $(FORTHSRC_PATHS) | ./forth/stage1 | tee $@ > /dev/null # should be updated manually through make fbootstrap.
forth/forth1.bin: forth/stage1.asm forth/forth0.bin $(ZASMBIN)
forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN) $(ZASMBIN) $(KERNEL) ../forth forth/z80c.bin forth/stagec.asm < forth/stage1.asm | tee $@ > /dev/null
$(ZASMBIN) $(KERNEL) ../forth forth/core.bin < forth/glue1.asm | tee $@ > /dev/null
forth/forth1-bin.h: forth/forth1.bin forth/forth1-bin.h: forth/forth1.bin
./bin2c.sh KERNEL < forth/forth1.bin | tee $@ > /dev/null ./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 $@ $(CC) forth/forth.c $(OBJS) -o $@
zasm/kernel-bin.h: zasm/kernel.bin zasm/kernel-bin.h: zasm/kernel.bin
@ -94,6 +108,10 @@ updatebootstrap: $(ZASMBIN)
$(ZASMBIN) $(KERNEL) < zasm/glue.asm > zasm/kernel.bin $(ZASMBIN) $(KERNEL) < zasm/glue.asm > zasm/kernel.bin
$(ZASMBIN) $(KERNEL) $(APPS) zasm/user.h < $(APPS)/zasm/glue.asm > zasm/zasm.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 .PHONY: clean
clean: clean:
rm -f $(TARGETS) $(SHELLTGTS) emul.o zasm/*-bin.h shell/*-bin.h 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. 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? ## Problems?
If the libz80-wrapped zasm executable works badly (hangs, spew garbage, etc.), If the libz80-wrapped zasm executable works badly (hangs, spew garbage, etc.),

View File

@ -3,7 +3,7 @@
#include <unistd.h> #include <unistd.h>
#include <termios.h> #include <termios.h>
#include "../emul.h" #include "../emul.h"
#include "forth1-bin.h" #include "forth2-bin.h"
// in sync with glue.asm // in sync with glue.asm
#define RAMSTART 0x900 #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 <stdio.h>
#include <unistd.h> #include <unistd.h>
#include "../emul.h" #include "../emul.h"
#ifdef STAGE2
#include "forth1-bin.h"
#else
#include "forth0-bin.h" #include "forth0-bin.h"
#endif
/* Staging binaries /* Staging binaries
@ -32,7 +36,11 @@ trouble of compiling defs to binary.
#define HERE_PORT 0x02 #define HERE_PORT 0x02
static int running; 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() static uint8_t iord_stdio()
{ {
@ -54,8 +62,10 @@ static void iowr_stdio(uint8_t val)
static void iowr_here(uint8_t val) static void iowr_here(uint8_t val)
{ {
ending_here <<= 8; start_here <<=8;
ending_here |= val; start_here |= (end_here >> 8);
end_here <<= 8;
end_here |= val;
} }
int main(int argc, char *argv[]) int main(int argc, char *argv[])
@ -76,8 +86,10 @@ int main(int argc, char *argv[])
#ifndef DEBUG #ifndef DEBUG
// We're done, now let's spit dict data // We're done, now let's spit dict data
fprintf(stderr, "hey, %x\n", ending_here); if (start_here == 0) {
for (int i=sizeof(KERNEL); i<ending_here; i++) { start_here = sizeof(KERNEL);
}
for (int i=start_here; i<end_here; i++) {
putchar(m->mem[i]); putchar(m->mem[i]);
} }
#endif #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 RAMSTART 0xe800
.equ HERE_INITIAL CODE_END ; override .equ HERE_INITIAL CODE_END ; override
.equ LATEST CODE_END ; override
.equ STDIO_PORT 0x00 .equ STDIO_PORT 0x00
jp init
.equ GETC emulGetC
.equ PUTC emulPutC
.inc "forth.asm"
init: init:
di di
; setup stack ; setup stack
@ -25,6 +20,5 @@ emulPutC:
out (STDIO_PORT), a out (STDIO_PORT), a
ret ret
CODE_END: .equ GETC emulGetC
.out LATEST .equ PUTC emulPutC
.out $ ; should be the same as in glue1

BIN
emul/forth/z80c.bin Normal file

Binary file not shown.

View File

@ -1405,28 +1405,10 @@ SWAP:
push hl push hl
jp next 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 ) ; ( a -- a a )
.db "DUP" .db "DUP"
.fill 4 .fill 4
.dw $-SWAP2 .dw $-SWAP
.db 0 .db 0
DUP: DUP:
.dw nativeWord .dw nativeWord
@ -1436,26 +1418,10 @@ DUP:
push hl push hl
jp next 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 ) ; ( a b -- a b a )
.db "OVER" .db "OVER"
.fill 3 .fill 3
.dw $-DUP2 .dw $-DUP
.db 0 .db 0
OVER: OVER:
.dw nativeWord .dw nativeWord
@ -1467,45 +1433,9 @@ OVER:
push de push de
jp next 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" .db ">R"
.fill 5 .fill 5
.dw $-ROT .dw $-OVER
.db 0 .db 0
P2R: P2R:
.dw nativeWord .dw nativeWord

View File

@ -1,11 +1,5 @@
( Z80 assembler ) ( Z80 assembler )
: CODE
( same as CREATE, but with ROUTINE V )
(entry)
ROUTINE V [LITN] ,
;
( Splits word into msb/lsb, lsb being on TOS ) ( Splits word into msb/lsb, lsb being on TOS )
: SPLITB : SPLITB
DUP 0x100 / DUP 0x100 /
@ -28,6 +22,11 @@
3 CONSTANT AF 3 CONSTANT AF
3 CONSTANT SP 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, ; : OP1 CREATE C, DOES> C@ A, ;
0xc9 OP1 RET, 0xc9 OP1 RET,
@ -130,3 +129,12 @@
( Specials ) ( Specials )
: JRe, 0x18 A, 2 - A, ; : JRe, 0x18 A, 2 - A, ;
: JPNEXT, ROUTINE N [LITN] JPnn, ; : 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