mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 10:20:55 +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.
|
||||
* `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
|
||||
|
||||
|
@ -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
|
||||
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
|
||||
|
@ -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:
|
||||
|
@ -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:
|
||||
|
@ -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
|
||||
|
@ -444,7 +444,7 @@ ISIMMED:
|
||||
.db "LITN"
|
||||
.fill 3
|
||||
.dw ISIMMED
|
||||
.db 1 ; IMMEDIATE
|
||||
.db 0
|
||||
LITN:
|
||||
.dw nativeWord
|
||||
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
|
||||
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
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.
|
||||
; 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
|
Loading…
Reference in New Issue
Block a user