mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 14:20:56 +11:00
Compare commits
5 Commits
1df9c4fc1b
...
b335e538b4
Author | SHA1 | Date | |
---|---|---|---|
|
b335e538b4 | ||
|
ae6334906c | ||
|
548facac0b | ||
|
d874f20278 | ||
|
587d1d0d69 |
@ -39,6 +39,8 @@ path to giving Collapse OS a try.
|
|||||||
through a serial port.
|
through a serial port.
|
||||||
* `emul`: Emulated applications, such as zasm and the shell.
|
* `emul`: Emulated applications, such as zasm and the shell.
|
||||||
* `tests`: Automated test suite for the whole project.
|
* `tests`: Automated test suite for the whole project.
|
||||||
|
* `forth`: Forth is slowly taking over this project (see issue #4). It comes
|
||||||
|
from this folder.
|
||||||
|
|
||||||
## Status
|
## Status
|
||||||
|
|
||||||
|
@ -1,10 +0,0 @@
|
|||||||
.inc "user.h"
|
|
||||||
jp forthMain
|
|
||||||
|
|
||||||
.inc "core.asm"
|
|
||||||
.equ FORTH_RAMSTART RAMSTART
|
|
||||||
.inc "forth/main.asm"
|
|
||||||
.inc "forth/util.asm"
|
|
||||||
.inc "forth/stack.asm"
|
|
||||||
.inc "forth/dict.asm"
|
|
||||||
RAMSTART:
|
|
@ -1,18 +0,0 @@
|
|||||||
( 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*) !
|
|
@ -7,8 +7,8 @@ AVRABIN = zasm/avra
|
|||||||
SHELLAPPS = zasm ed
|
SHELLAPPS = zasm ed
|
||||||
SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
|
SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
|
||||||
# Those Forth source files are in a particular order
|
# Those Forth source files are in a particular order
|
||||||
FORTHSRCS = core.fs parse.fs fmt.fs
|
FORTHSRCS = core.fs str.fs parse.fs fmt.fs
|
||||||
FORTHSRC_PATHS = ${FORTHSRCS:%=$(APPS)/forth/%}
|
FORTHSRC_PATHS = ${FORTHSRCS:%=../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)
|
||||||
@ -28,7 +28,7 @@ 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/glue0.asm $(ZASMBIN)
|
||||||
$(ZASMBIN) $(KERNEL) $(APPS) < forth/glue0.asm | tee $@ > /dev/null
|
$(ZASMBIN) $(KERNEL) ../forth < forth/glue0.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
|
||||||
@ -43,7 +43,7 @@ forth/core.bin: $(FORTHSRC_PATHS) forth/stage1
|
|||||||
cat $(FORTHSRC_PATHS) | ./forth/stage1 | 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) ../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
|
||||||
|
@ -15,8 +15,6 @@
|
|||||||
|
|
||||||
jp init
|
jp init
|
||||||
|
|
||||||
.inc "core.asm"
|
|
||||||
.inc "str.asm"
|
|
||||||
|
|
||||||
.equ STDIO_RAMSTART RAMSTART
|
.equ STDIO_RAMSTART RAMSTART
|
||||||
.equ STDIO_GETC emulGetC
|
.equ STDIO_GETC emulGetC
|
||||||
@ -24,10 +22,10 @@
|
|||||||
.inc "stdio.asm"
|
.inc "stdio.asm"
|
||||||
|
|
||||||
.equ FORTH_RAMSTART STDIO_RAMEND
|
.equ FORTH_RAMSTART STDIO_RAMEND
|
||||||
.inc "forth/main.asm"
|
.inc "main.asm"
|
||||||
.inc "forth/util.asm"
|
.inc "util.asm"
|
||||||
.inc "forth/stack.asm"
|
.inc "stack.asm"
|
||||||
.inc "forth/dict.asm"
|
.inc "dict.asm"
|
||||||
|
|
||||||
|
|
||||||
init:
|
init:
|
||||||
|
@ -6,19 +6,16 @@
|
|||||||
|
|
||||||
jp init
|
jp init
|
||||||
|
|
||||||
.inc "core.asm"
|
|
||||||
.inc "str.asm"
|
|
||||||
|
|
||||||
.equ STDIO_RAMSTART RAMSTART
|
.equ STDIO_RAMSTART RAMSTART
|
||||||
.equ STDIO_GETC emulGetC
|
.equ STDIO_GETC emulGetC
|
||||||
.equ STDIO_PUTC emulPutC
|
.equ STDIO_PUTC emulPutC
|
||||||
.inc "stdio.asm"
|
.inc "stdio.asm"
|
||||||
|
|
||||||
.equ FORTH_RAMSTART STDIO_RAMEND
|
.equ FORTH_RAMSTART STDIO_RAMEND
|
||||||
.inc "forth/main.asm"
|
.inc "main.asm"
|
||||||
.inc "forth/util.asm"
|
.inc "util.asm"
|
||||||
.inc "forth/stack.asm"
|
.inc "stack.asm"
|
||||||
.inc "forth/dict.asm"
|
.inc "dict.asm"
|
||||||
|
|
||||||
|
|
||||||
init:
|
init:
|
||||||
|
@ -3,20 +3,19 @@
|
|||||||
: +! SWAP OVER @ + SWAP ! ;
|
: +! SWAP OVER @ + SWAP ! ;
|
||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
: C, H C! 1 ALLOT ;
|
: C, H C! 1 ALLOT ;
|
||||||
|
: COMPILE ' LITN ['] , , ; IMMEDIATE
|
||||||
: BEGIN H ; IMMEDIATE
|
: BEGIN H ; IMMEDIATE
|
||||||
: COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE
|
|
||||||
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
|
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
|
||||||
|
: UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE
|
||||||
: NOT 1 SWAP SKIP? EXIT 0 * ;
|
: NOT 1 SWAP SKIP? EXIT 0 * ;
|
||||||
: ( BEGIN LITS ) WORD SCMP NOT SKIP? AGAIN ; IMMEDIATE
|
: ( BEGIN LITS ) WORD SCMP NOT UNTIL ; IMMEDIATE
|
||||||
( Hello, hello, krkrkrkr... do you hear me?
|
( Hello, hello, krkrkrkr... do you hear me?
|
||||||
Ah, voice at last! Some lines above need comments
|
Ah, voice at last! Some lines above need comments
|
||||||
BTW: Forth lines limited to 64 cols because of default
|
BTW: Forth lines limited to 64 cols because of default
|
||||||
input buffer size in Collapse OS
|
input buffer size in Collapse OS
|
||||||
|
|
||||||
COMPILE; Tough one. Get addr of caller word (example above
|
COMPILE; Tough one. Get addr of caller word (example above
|
||||||
(bbr)) and then call LITN on it. However, LITN is an
|
(bbr)) and then call LITN on it.
|
||||||
immediate and has to be indirectly executed. Then, write
|
|
||||||
a reference to "," so that this word is written to HERE.
|
|
||||||
|
|
||||||
NOT: a bit convulted because we don't have IF yet )
|
NOT: a bit convulted because we don't have IF yet )
|
||||||
|
|
||||||
@ -48,3 +47,20 @@
|
|||||||
: > CMP 1 = ;
|
: > CMP 1 = ;
|
||||||
: / /MOD SWAP DROP ;
|
: / /MOD SWAP DROP ;
|
||||||
: MOD /MOD DROP ;
|
: MOD /MOD DROP ;
|
||||||
|
|
||||||
|
( In addition to pushing H this compiles 2 >R so that loop variables are sent
|
||||||
|
to PS at runtime )
|
||||||
|
: DO
|
||||||
|
COMPILE SWAP COMPILE >R COMPILE >R
|
||||||
|
H
|
||||||
|
; IMMEDIATE
|
||||||
|
|
||||||
|
( One could think that we should have a sub word to avoid all these COMPILE,
|
||||||
|
but we can't because otherwise it messes with the RS )
|
||||||
|
: LOOP
|
||||||
|
COMPILE R> 1 LITN COMPILE + COMPILE DUP COMPILE >R
|
||||||
|
COMPILE I' COMPILE = COMPILE SKIP? COMPILE (bbr)
|
||||||
|
H -^ C,
|
||||||
|
COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
|
||||||
|
; IMMEDIATE
|
||||||
|
|
@ -444,7 +444,7 @@ ISIMMED:
|
|||||||
.db "LITN"
|
.db "LITN"
|
||||||
.fill 3
|
.fill 3
|
||||||
.dw ISIMMED
|
.dw ISIMMED
|
||||||
.db 1 ; IMMEDIATE
|
.db 0
|
||||||
LITN:
|
LITN:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
ld hl, (HERE)
|
ld hl, (HERE)
|
@ -50,7 +50,7 @@ CONSTANT x n -- Creates cell x that when called pushes its value
|
|||||||
DOES> -- See description at top of file
|
DOES> -- See description at top of file
|
||||||
IMMED? a -- f Checks whether wordref at a is immediate.
|
IMMED? a -- f Checks whether wordref at a is immediate.
|
||||||
IMMEDIATE -- Flag the latest defined word as immediate.
|
IMMEDIATE -- Flag the latest defined word as immediate.
|
||||||
LITN n -- *I* Inserts number from TOS as a literal
|
LITN n -- Write number n as a literal.
|
||||||
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
VARIABLE c -- Creates cell x with 2 bytes allocation.
|
||||||
|
|
||||||
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
|
Compilation vs meta-compilation. When you compile a word with "[COMPILE] foo",
|
||||||
@ -91,6 +91,7 @@ SKIP? f -- If f is true, skip the execution of the next atom.
|
|||||||
Use this right before ";" and you're gonna have a
|
Use this right before ";" and you're gonna have a
|
||||||
bad time.
|
bad time.
|
||||||
THEN I:a -- *I* Set branching cell at a.
|
THEN I:a -- *I* Set branching cell at a.
|
||||||
|
UNTIL f -- *I* Jump backwards to BEGIN if f is *false*.
|
||||||
|
|
||||||
*** Parameter Stack ***
|
*** Parameter Stack ***
|
||||||
DROP a --
|
DROP a --
|
||||||
@ -140,6 +141,7 @@ NOT f -- f Push the logical opposite of f
|
|||||||
*** Strings ***
|
*** Strings ***
|
||||||
LITS x -- a Read following LIT and push its addr to a
|
LITS x -- a Read following LIT and push its addr to a
|
||||||
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
|
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
|
||||||
|
SLEN a -- n Push length of str at a.
|
||||||
|
|
||||||
*** I/O ***
|
*** I/O ***
|
||||||
|
|
55
forth/parse.fs
Normal file
55
forth/parse.fs
Normal file
@ -0,0 +1,55 @@
|
|||||||
|
( requires core, str )
|
||||||
|
( string being sent to parse routines are always null
|
||||||
|
terminated )
|
||||||
|
|
||||||
|
: (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 )
|
||||||
|
;
|
||||||
|
|
||||||
|
( returns negative value on error )
|
||||||
|
: hexdig ( c -- n )
|
||||||
|
( '0' is ASCII 48 )
|
||||||
|
48 -
|
||||||
|
DUP 0 < IF EXIT THEN ( bad )
|
||||||
|
DUP 10 < IF EXIT THEN ( good )
|
||||||
|
( 'a' is ASCII 97. 59 = 97 - 48 )
|
||||||
|
49 -
|
||||||
|
DUP 0 < IF EXIT THEN ( bad )
|
||||||
|
DUP 6 < IF 10 + EXIT THEN ( good )
|
||||||
|
( bad )
|
||||||
|
255 -
|
||||||
|
;
|
||||||
|
|
||||||
|
: (parseh) ( a -- n f )
|
||||||
|
( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
|
||||||
|
DUP @ 30768 = NOT IF 0 EXIT THEN ( a 0 )
|
||||||
|
( We have "0x" suffix )
|
||||||
|
2 +
|
||||||
|
( validate slen )
|
||||||
|
DUP SLEN ( a l )
|
||||||
|
DUP 0 = IF DROP 0 EXIT THEN ( a 0 )
|
||||||
|
4 > IF DROP 0 EXIT THEN ( a 0 )
|
||||||
|
0 ( a r )
|
||||||
|
BEGIN
|
||||||
|
OVER C@
|
||||||
|
DUP 0 = IF DROP SWAP DROP 1 EXIT THEN ( r, 1 )
|
||||||
|
hexdig ( a r n )
|
||||||
|
DUP 0 < IF DROP DROP 1 EXIT THEN ( a 0 )
|
||||||
|
SWAP 16 * + ( a r*16+n )
|
||||||
|
SWAP 1 + SWAP ( a+1 r )
|
||||||
|
AGAIN
|
||||||
|
;
|
||||||
|
|
||||||
|
: (parse) ( a -- n )
|
||||||
|
(parsec) NOT SKIP? EXIT
|
||||||
|
(parseh) NOT SKIP? EXIT
|
||||||
|
(parsed) NOT SKIP? EXIT
|
||||||
|
( nothing works )
|
||||||
|
ABORT" unknown word! "
|
||||||
|
;
|
||||||
|
|
||||||
|
' (parse) (parse*) !
|
7
forth/str.fs
Normal file
7
forth/str.fs
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
: SLEN ( a -- n )
|
||||||
|
DUP ( astart aend )
|
||||||
|
BEGIN
|
||||||
|
DUP C@ 0 = IF -^ EXIT THEN
|
||||||
|
1 +
|
||||||
|
AGAIN
|
||||||
|
;
|
@ -6,6 +6,43 @@
|
|||||||
; give us an idea of Forth's compactness.
|
; give us an idea of Forth's compactness.
|
||||||
; These routines below are copy/paste from apps/lib.
|
; These routines below are copy/paste from apps/lib.
|
||||||
|
|
||||||
|
; Ensures that Z is unset (more complicated than it sounds...)
|
||||||
|
; There are often better inline alternatives, either replacing rets with
|
||||||
|
; appropriate jmps, or if an 8 bit register is known to not be 0, an inc
|
||||||
|
; then a dec. If a is nonzero, 'or a' is optimal.
|
||||||
|
unsetZ:
|
||||||
|
or a ;if a nonzero, Z reset
|
||||||
|
ret nz
|
||||||
|
cp 1 ;if a is zero, Z reset
|
||||||
|
ret
|
||||||
|
|
||||||
|
; copy (HL) into DE, then exchange the two, utilising the optimised HL instructions.
|
||||||
|
; ld must be done little endian, so least significant byte first.
|
||||||
|
intoHL:
|
||||||
|
push de
|
||||||
|
ld e, (hl)
|
||||||
|
inc hl
|
||||||
|
ld d, (hl)
|
||||||
|
ex de, hl
|
||||||
|
pop de
|
||||||
|
ret
|
||||||
|
|
||||||
|
intoDE:
|
||||||
|
ex de, hl
|
||||||
|
call intoHL
|
||||||
|
ex de, hl ; de preserved by intoHL, so no push/pop needed
|
||||||
|
ret
|
||||||
|
|
||||||
|
; add the value of A into HL
|
||||||
|
; affects carry flag according to the 16-bit addition, Z, S and P untouched.
|
||||||
|
addHL:
|
||||||
|
push de
|
||||||
|
ld d, 0
|
||||||
|
ld e, a
|
||||||
|
add hl, de
|
||||||
|
pop de
|
||||||
|
ret
|
||||||
|
|
||||||
; make Z the opposite of what it is now
|
; make Z the opposite of what it is now
|
||||||
toggleZ:
|
toggleZ:
|
||||||
jp z, unsetZ
|
jp z, unsetZ
|
||||||
@ -57,6 +94,38 @@ strcmp:
|
|||||||
; early, set otherwise)
|
; early, set otherwise)
|
||||||
ret
|
ret
|
||||||
|
|
||||||
|
; Compares strings pointed to by HL and DE up to A count of characters. If
|
||||||
|
; equal, Z is set. If not equal, Z is reset.
|
||||||
|
strncmp:
|
||||||
|
push bc
|
||||||
|
push hl
|
||||||
|
push de
|
||||||
|
|
||||||
|
ld b, a
|
||||||
|
.loop:
|
||||||
|
ld a, (de)
|
||||||
|
cp (hl)
|
||||||
|
jr nz, .end ; not equal? break early. NZ is carried out
|
||||||
|
; to the called
|
||||||
|
cp 0 ; If our chars are null, stop the cmp
|
||||||
|
jr z, .end ; The positive result will be carried to the
|
||||||
|
; caller
|
||||||
|
inc hl
|
||||||
|
inc de
|
||||||
|
djnz .loop
|
||||||
|
; We went through all chars with success, but our current Z flag is
|
||||||
|
; unset because of the cp 0. Let's do a dummy CP to set the Z flag.
|
||||||
|
cp a
|
||||||
|
|
||||||
|
.end:
|
||||||
|
pop de
|
||||||
|
pop hl
|
||||||
|
pop bc
|
||||||
|
; Because we don't call anything else than CP that modify the Z flag,
|
||||||
|
; our Z value will be that of the last cp (reset if we broke the loop
|
||||||
|
; early, set otherwise)
|
||||||
|
ret
|
||||||
|
|
||||||
; Given a string at (HL), move HL until it points to the end of that string.
|
; Given a string at (HL), move HL until it points to the end of that string.
|
||||||
strskip:
|
strskip:
|
||||||
push bc
|
push bc
|
Loading…
Reference in New Issue
Block a user