Move "forth" folder to project's root folder

It's not really an App.

README.md

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

apps/forth/glue.asm

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

apps/forth/parse.fs

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

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

emul/forth/glue0.asm

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

emul/forth/glue1.asm

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

forth/core.fs

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

forth/dict.asm

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

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

forth/parse.fs

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

forth/str.fs

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

forth/util.asm

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