forth: Forth-ify ".""

emul/Makefile

@@ -7,7 +7,7 @@ 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 readln.fs fmt.fs
+FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o

forth/core.fs

@@ -44,17 +44,17 @@
 : > CMP 1 = ;
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
-: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
 
-( In addition to pushing H this compiles 2 >R so that loop variables are sent
+( In addition to pushing H this compiles 2 >R so that loop
-  to PS at runtime )
+  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,
+( One could think that we should have a sub word to avoid all
-  but we can't because otherwise it messes with the RS )
+  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)

forth/dictionary.txt

@@ -143,10 +143,13 @@ CMP         n1 n2 -- n      Compare n1 and n2 and set n to -1, 0, or 1.
 NOT         f -- f          Push the logical opposite of f
 
 *** Strings ***
+LIT         --              Write a LIT entry. You're expected to write actual
+                            string to HERE right afterwards.
 LIT< x      --              Read following word and write to HERE as a string
                             literal.
 LITS        a --            Write word at addr a as a atring literal.
 SCMP        a1 a2 -- n      Compare strings a1 and a2. See CMP
+SCPY        a --            Copy string at addr a into HERE.
 SLEN        a -- n          Push length of str at a.
 
 *** I/O ***

forth/forth.asm

@@ -754,42 +754,10 @@ PRINT:
 	inc	hl
 	jr	.loop
 
-
-	.db	'.', '"'
-	.fill	5
-	.dw	PRINT
-	.db	1		; IMMEDIATE
-PRINTI:
-	.dw	compiledWord
-	.dw	NUMBER
-	.dw	LIT
-	.dw	WR
-	; BBR mark
-	.dw	CIN
-	.dw	DUP
-	.dw	NUMBER
-	.dw	'"'
-	.dw	CMP
-	.dw	CSKIP
-	.dw	FBR
-	.db	6
-	.dw	CWR
-	.dw	BBR
-	.db	19
-	; FBR mark
-	; null terminate string
-	.dw	NUMBER
-	.dw	0
-	.dw	CWR
-	.dw	NUMBER
-	.dw	PRINT
-	.dw	WR
-	.dw	EXIT
-
 ; ( c port -- )
 	.db "PC!"
 	.fill 4
-	.dw PRINTI
+	.dw PRINT
 	.db 0
 PSTORE:
 	.dw nativeWord
@@ -895,29 +863,26 @@ DEFINE:
 	.dw	compiledWord
 	.dw	WORD
 	.dw	FIND_
+	.dw	NOT
 	.dw	CSKIP
-	.dw	.maybeNum
+	.dw	FBR
+	.db	7
+	; Maybe number
+	.dw	PARSEI
+	.dw	LITN
+	.dw	EXIT
+	; FBR mark
 	.dw	DUP
 	.dw	ISIMMED
 	.dw	CSKIP
-	.dw	.word
+	.dw	FBR
+	.db	5
 	; is immediate. just execute.
 	.dw	EXECUTE
 	.dw	EXIT
-
+	; FBR mark
-.word:
+	; just a word, write
-	.dw	compiledWord
 	.dw	WR
-	.dw	R2P		; exit .compile
-	.dw	DROP
-	.dw	EXIT
-
-.maybeNum:
-	.dw	compiledWord
-	.dw	PARSEI
-	.dw	LITN
-	.dw	R2P		; exit .compile
-	.dw	DROP
 	.dw	EXIT
 
 
@@ -988,19 +953,11 @@ LITN:
 	ld	(HERE), hl
 	jp	next
 
-	.db	"LITS"
+	.db	"SCPY"
 	.fill	3
 	.dw	LITN
-	.db	1		; IMMEDIATE
+	.db	0
-LITS:
+SCPY:
-	.dw	compiledWord
-	.dw	NUMBER
-	.dw	LIT
-	.dw	WR
-	.dw	.scpy
-	.dw	EXIT
-
-.scpy:
 	.dw	nativeWord
 	pop	hl
 	ld	de, (HERE)
@@ -1009,6 +966,28 @@ LITS:
 	jp	next
 
 
+	.db	"LIT"
+	.fill	4
+	.dw	SCPY
+	.db	0
+LIT_:
+	.dw	compiledWord
+	.dw	NUMBER
+	.dw	LIT
+	.dw	WR
+	.dw	EXIT
+
+	.db	"LITS"
+	.fill	3
+	.dw	LIT_
+	.db	0
+LITS:
+	.dw	compiledWord
+	.dw	LIT_
+	.dw	SCPY
+	.dw	EXIT
+
+
 	.db	"LIT<"
 	.fill	3
 	.dw	LITS