mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 19:28:06 +11:00
forth: split forth source into multiple files
This commit is contained in:
parent
9451c599e0
commit
1df9c4fc1b
@ -48,67 +48,3 @@
|
||||
: > CMP 1 = ;
|
||||
: / /MOD SWAP 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
46
apps/forth/fmt.fs
Normal 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
18
apps/forth/parse.fs
Normal 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*) !
|
@ -6,6 +6,9 @@ ZASMBIN = zasm/zasm
|
||||
AVRABIN = zasm/avra
|
||||
SHELLAPPS = zasm ed
|
||||
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
|
||||
OBJS = emul.o libz80/libz80.o
|
||||
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
|
||||
$(CC) -DDEBUG forth/stage1.c $(OBJS) -o $@
|
||||
|
||||
forth/core.bin: $(APPS)/forth/core.fs forth/stage1
|
||||
./forth/stage1 $(APPS)/forth/core.fs | tee $@ > /dev/null
|
||||
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) $(APPS) forth/core.bin < forth/glue1.asm | tee $@ > /dev/null
|
||||
|
@ -35,11 +35,10 @@ that wordref offsets correspond.
|
||||
#define CURRENT 0xe702
|
||||
|
||||
static int running;
|
||||
static FILE *fp;
|
||||
|
||||
static uint8_t iord_stdio()
|
||||
{
|
||||
int c = getc(fp);
|
||||
int c = getc(stdin);
|
||||
if (c == EOF) {
|
||||
running = 0;
|
||||
}
|
||||
@ -57,20 +56,6 @@ static void iowr_stdio(uint8_t val)
|
||||
|
||||
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();
|
||||
m->ramstart = RAMSTART;
|
||||
m->iord[STDIO_PORT] = iord_stdio;
|
||||
@ -84,8 +69,6 @@ int main(int argc, char *argv[])
|
||||
|
||||
while (running && emul_step());
|
||||
|
||||
fclose(fp);
|
||||
|
||||
#ifndef DEBUG
|
||||
// We're done, now let's spit dict data
|
||||
// let's start with LATEST spitting.
|
||||
|
Loading…
Reference in New Issue
Block a user