1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-02 10:20:55 +11:00

Compare commits

...

5 Commits

Author SHA1 Message Date
Virgil Dupras
b335e538b4 Move "forth" folder to project's root folder
It's not really an App.
2020-03-18 22:25:44 -04:00
Virgil Dupras
ae6334906c forth: inline kernel's core and str units 2020-03-18 22:18:07 -04:00
Virgil Dupras
548facac0b forth: Implement "(parseh)" 2020-03-18 21:52:55 -04:00
Virgil Dupras
d874f20278 forth: Add "DO" and "LOOP"
Also, un-IMMEDIATE "LITN" it didn't make any sense.
2020-03-18 20:04:44 -04:00
Virgil Dupras
587d1d0d69 forth: add word "UNTIL" 2020-03-18 16:39:22 -04:00
16 changed files with 171 additions and 53 deletions

View File

@ -39,6 +39,8 @@ path to giving Collapse OS a try.
through a serial port.
* `emul`: Emulated applications, such as zasm and the shell.
* `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

View File

@ -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:

View File

@ -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*) !

View File

@ -7,8 +7,8 @@ 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/%}
FORTHSRCS = core.fs str.fs parse.fs fmt.fs
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
OBJS = emul.o libz80/libz80.o
SHELLOBJS = $(OBJS) $(CFSPACK_OBJ)
@ -28,7 +28,7 @@ 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) $(APPS) < forth/glue0.asm | tee $@ > /dev/null
$(ZASMBIN) $(KERNEL) ../forth < forth/glue0.asm | tee $@ > /dev/null
forth/forth0-bin.h: forth/forth0.bin
./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
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
./bin2c.sh KERNEL < forth/forth1.bin | tee $@ > /dev/null

View File

@ -15,8 +15,6 @@
jp init
.inc "core.asm"
.inc "str.asm"
.equ STDIO_RAMSTART RAMSTART
.equ STDIO_GETC emulGetC
@ -24,10 +22,10 @@
.inc "stdio.asm"
.equ FORTH_RAMSTART STDIO_RAMEND
.inc "forth/main.asm"
.inc "forth/util.asm"
.inc "forth/stack.asm"
.inc "forth/dict.asm"
.inc "main.asm"
.inc "util.asm"
.inc "stack.asm"
.inc "dict.asm"
init:

View File

@ -6,19 +6,16 @@
jp init
.inc "core.asm"
.inc "str.asm"
.equ STDIO_RAMSTART RAMSTART
.equ STDIO_GETC emulGetC
.equ STDIO_PUTC emulPutC
.inc "stdio.asm"
.equ FORTH_RAMSTART STDIO_RAMEND
.inc "forth/main.asm"
.inc "forth/util.asm"
.inc "forth/stack.asm"
.inc "forth/dict.asm"
.inc "main.asm"
.inc "util.asm"
.inc "stack.asm"
.inc "dict.asm"
init:

View File

@ -3,21 +3,20 @@
: +! SWAP OVER @ + SWAP ! ;
: ALLOT HERE +! ;
: C, H C! 1 ALLOT ;
: COMPILE ' LITN ['] , , ; IMMEDIATE
: BEGIN H ; IMMEDIATE
: COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE
: AGAIN COMPILE (bbr) H -^ C, ; IMMEDIATE
: UNTIL COMPILE SKIP? COMPILE (bbr) H -^ C, ; IMMEDIATE
: 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?
Ah, voice at last! Some lines above need comments
BTW: Forth lines limited to 64 cols because of default
input buffer size in Collapse OS
COMPILE; Tough one. Get addr of caller word (example above
(bbr)) and then call LITN on it. However, LITN is an
immediate and has to be indirectly executed. Then, write
a reference to "," so that this word is written to HERE.
(bbr)) and then call LITN on it.
NOT: a bit convulted because we don't have IF yet )
: IF ( -- a | a: br cell addr )
@ -48,3 +47,20 @@
: > CMP 1 = ;
: / /MOD SWAP 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

View File

@ -444,7 +444,7 @@ ISIMMED:
.db "LITN"
.fill 3
.dw ISIMMED
.db 1 ; IMMEDIATE
.db 0
LITN:
.dw nativeWord
ld hl, (HERE)

View File

@ -50,7 +50,7 @@ CONSTANT x n -- Creates cell x that when called pushes its value
DOES> -- See description at top of file
IMMED? a -- f Checks whether wordref at a is 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.
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
bad time.
THEN I:a -- *I* Set branching cell at a.
UNTIL f -- *I* Jump backwards to BEGIN if f is *false*.
*** Parameter Stack ***
DROP a --
@ -140,6 +141,7 @@ NOT f -- f Push the logical opposite of f
*** Strings ***
LITS x -- a Read following LIT and push its addr to a
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
SLEN a -- n Push length of str at a.
*** I/O ***

55
forth/parse.fs Normal file
View 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
View File

@ -0,0 +1,7 @@
: SLEN ( a -- n )
DUP ( astart aend )
BEGIN
DUP C@ 0 = IF -^ EXIT THEN
1 +
AGAIN
;

View File

@ -6,6 +6,43 @@
; give us an idea of Forth's compactness.
; 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
toggleZ:
jp z, unsetZ
@ -57,6 +94,38 @@ strcmp:
; early, set otherwise)
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.
strskip:
push bc