1
0
mirror of https://github.com/hsoft/collapseos.git synced 2024-11-26 14:38:05 +11:00

Compare commits

..

No commits in common. "b335e538b478616da949c37af8961fe385d290dd" and "1df9c4fc1b324cd65a25938526749c0edf494995" have entirely different histories.

16 changed files with 53 additions and 171 deletions

View File

@ -39,8 +39,6 @@ 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

@ -3,19 +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 UNTIL ; IMMEDIATE
: ( BEGIN LITS ) WORD SCMP NOT SKIP? AGAIN ; 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.
(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.
NOT: a bit convulted because we don't have IF yet )
@ -47,20 +48,3 @@
: > 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 0
.db 1 ; IMMEDIATE
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 -- Write number n as a literal.
LITN n -- *I* Inserts number from TOS 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,7 +91,6 @@ 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 --
@ -141,7 +140,6 @@ 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 ***

10
apps/forth/glue.asm Normal file
View File

@ -0,0 +1,10 @@
.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:

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,43 +6,6 @@
; 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
@ -94,38 +57,6 @@ 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

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 str.fs parse.fs fmt.fs
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
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)
@ -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) ../forth < forth/glue0.asm | tee $@ > /dev/null
$(ZASMBIN) $(KERNEL) $(APPS) < 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) ../forth forth/core.bin < forth/glue1.asm | tee $@ > /dev/null
$(ZASMBIN) $(KERNEL) $(APPS) 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,6 +15,8 @@
jp init
.inc "core.asm"
.inc "str.asm"
.equ STDIO_RAMSTART RAMSTART
.equ STDIO_GETC emulGetC
@ -22,10 +24,10 @@
.inc "stdio.asm"
.equ FORTH_RAMSTART STDIO_RAMEND
.inc "main.asm"
.inc "util.asm"
.inc "stack.asm"
.inc "dict.asm"
.inc "forth/main.asm"
.inc "forth/util.asm"
.inc "forth/stack.asm"
.inc "forth/dict.asm"
init:

View File

@ -6,16 +6,19 @@
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 "main.asm"
.inc "util.asm"
.inc "stack.asm"
.inc "dict.asm"
.inc "forth/main.asm"
.inc "forth/util.asm"
.inc "forth/stack.asm"
.inc "forth/dict.asm"
init:

View File

@ -1,55 +0,0 @@
( 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*) !

View File

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