forth: split forth source into multiple files

This commit is contained in:
Virgil Dupras 2020-03-17 21:44:32 -04:00
parent 9451c599e0
commit 1df9c4fc1b
5 changed files with 70 additions and 84 deletions

View File

@ -48,67 +48,3 @@
: > CMP 1 = ; : > CMP 1 = ;
: / /MOD SWAP DROP ; : / /MOD SWAP DROP ;
: MOD /MOD DROP ; : MOD /MOD DROP ;
( Parse numbers )
: (parsec) ( a -- n f )
( apostrophe is ASCII 39 )
DUP C@ 39 = NOT IF 0 EXIT THEN ( -- a 0 )
DUP 2 + C@ 39 = NOT IF 0 EXIT THEN ( -- a 0 )
( surrounded by apos, good, return )
1 + C@ 1 ( -- n 1 )
;
: (parse) ( a -- n )
(parsec) NOT SKIP? EXIT
(parsed) NOT SKIP? EXIT
( nothing works )
ABORT" unknown word! "
;
' (parse) (parse*) !
( Format numbers )
( TODO FORGET this word )
: PUSHDGTS
999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
BEGIN
DUP 0 = IF DROP EXIT THEN
10 /MOD ( r q )
SWAP '0' + SWAP ( d q )
AGAIN
;
: . ( n -- )
( handle negative )
( that "0 1 -" thing is because we don't parse negative
number correctly yet. )
DUP 0 < IF '-' EMIT 0 1 - * THEN
PUSHDGTS
BEGIN
DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done )
EMIT
AGAIN
;
: PUSHDGTS
999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
BEGIN
DUP 0 = IF DROP EXIT THEN
16 /MOD ( r q )
SWAP ( r q )
DUP 9 > IF 10 - 'a' +
ELSE '0' + THEN ( q d )
SWAP ( d q )
AGAIN
;
: .X ( n -- )
( For hex display, there are no negatives )
PUSHDGTS
BEGIN
DUP 'f' > IF DROP EXIT THEN ( stop indicator, we're done )
EMIT
AGAIN
;

46
apps/forth/fmt.fs Normal file
View File

@ -0,0 +1,46 @@
( requires core, parse )
( TODO FORGET this word )
: PUSHDGTS
999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
BEGIN
DUP 0 = IF DROP EXIT THEN
10 /MOD ( r q )
SWAP '0' + SWAP ( d q )
AGAIN
;
: . ( n -- )
( handle negative )
( that "0 1 -" thing is because we don't parse negative
number correctly yet. )
DUP 0 < IF '-' EMIT 0 1 - * THEN
PUSHDGTS
BEGIN
DUP '9' > IF DROP EXIT THEN ( stop indicator, we're done )
EMIT
AGAIN
;
: PUSHDGTS
999 SWAP ( stop indicator )
DUP 0 = IF '0' EXIT THEN ( 0 is a special case )
BEGIN
DUP 0 = IF DROP EXIT THEN
16 /MOD ( r q )
SWAP ( r q )
DUP 9 > IF 10 - 'a' +
ELSE '0' + THEN ( q d )
SWAP ( d q )
AGAIN
;
: .X ( n -- )
( For hex display, there are no negatives )
PUSHDGTS
BEGIN
DUP 'f' > IF DROP EXIT THEN ( stop indicator, we're done )
EMIT
AGAIN
;

18
apps/forth/parse.fs Normal file
View File

@ -0,0 +1,18 @@
( requires core )
: (parsec) ( a -- n f )
( apostrophe is ASCII 39 )
DUP C@ 39 = NOT IF 0 EXIT THEN ( -- a 0 )
DUP 2 + C@ 39 = NOT IF 0 EXIT THEN ( -- a 0 )
( surrounded by apos, good, return )
1 + C@ 1 ( -- n 1 )
;
: (parse) ( a -- n )
(parsec) NOT SKIP? EXIT
(parsed) NOT SKIP? EXIT
( nothing works )
ABORT" unknown word! "
;
' (parse) (parse*) !

View File

@ -6,6 +6,9 @@ ZASMBIN = zasm/zasm
AVRABIN = zasm/avra AVRABIN = zasm/avra
SHELLAPPS = zasm ed SHELLAPPS = zasm ed
SHELLTGTS = ${SHELLAPPS:%=cfsin/%} SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
# Those Forth source files are in a particular order
FORTHSRCS = core.fs parse.fs fmt.fs
FORTHSRC_PATHS = ${FORTHSRCS:%=$(APPS)/forth/%}
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
OBJS = emul.o libz80/libz80.o OBJS = emul.o libz80/libz80.o
SHELLOBJS = $(OBJS) $(CFSPACK_OBJ) SHELLOBJS = $(OBJS) $(CFSPACK_OBJ)
@ -36,8 +39,8 @@ forth/stage1: forth/stage1.c $(OBJS) forth/forth0-bin.h
forth/stage1dbg: forth/stage1.c $(OBJS) forth/forth0-bin.h forth/stage1dbg: forth/stage1.c $(OBJS) forth/forth0-bin.h
$(CC) -DDEBUG forth/stage1.c $(OBJS) -o $@ $(CC) -DDEBUG forth/stage1.c $(OBJS) -o $@
forth/core.bin: $(APPS)/forth/core.fs forth/stage1 forth/core.bin: $(FORTHSRC_PATHS) forth/stage1
./forth/stage1 $(APPS)/forth/core.fs | tee $@ > /dev/null cat $(FORTHSRC_PATHS) | ./forth/stage1 | tee $@ > /dev/null
forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN) forth/forth1.bin: forth/glue1.asm forth/core.bin $(ZASMBIN)
$(ZASMBIN) $(KERNEL) $(APPS) forth/core.bin < forth/glue1.asm | tee $@ > /dev/null $(ZASMBIN) $(KERNEL) $(APPS) forth/core.bin < forth/glue1.asm | tee $@ > /dev/null

View File

@ -35,11 +35,10 @@ that wordref offsets correspond.
#define CURRENT 0xe702 #define CURRENT 0xe702
static int running; static int running;
static FILE *fp;
static uint8_t iord_stdio() static uint8_t iord_stdio()
{ {
int c = getc(fp); int c = getc(stdin);
if (c == EOF) { if (c == EOF) {
running = 0; running = 0;
} }
@ -57,20 +56,6 @@ static void iowr_stdio(uint8_t val)
int main(int argc, char *argv[]) int main(int argc, char *argv[])
{ {
#ifdef DEBUG
fp = stdin;
#else
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;
}
#endif
Machine *m = emul_init(); Machine *m = emul_init();
m->ramstart = RAMSTART; m->ramstart = RAMSTART;
m->iord[STDIO_PORT] = iord_stdio; m->iord[STDIO_PORT] = iord_stdio;
@ -84,8 +69,6 @@ int main(int argc, char *argv[])
while (running && emul_step()); while (running && emul_step());
fclose(fp);
#ifndef DEBUG #ifndef DEBUG
// We're done, now let's spit dict data // We're done, now let's spit dict data
// let's start with LATEST spitting. // let's start with LATEST spitting.