README.md

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

apps/forth/core.fs

@@ -3,20 +3,21 @@
 : +! 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 )
 
 : IF                ( -- a | a: br cell addr )
@@ -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
-

apps/forth/dict.asm

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

apps/forth/dictionary.txt

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

apps/forth/glue.asm

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

apps/forth/parse.fs

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

apps/forth/util.asm

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

emul/Makefile

@@ -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
+FORTHSRCS = core.fs parse.fs fmt.fs
-FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
+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

emul/forth/glue0.asm

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

emul/forth/glue1.asm

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

forth/parse.fs

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

forth/str.fs

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