From 9451c599e0bd99162ccb9319d496a30eaf7ee327 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 17 Mar 2020 21:19:56 -0400
Subject: [PATCH] forth: Make (parse) indirect and Forth-ify (parsec)

---
 apps/forth/core.fs        | 18 ++++++++++++++++++
 apps/forth/dict.asm       | 27 ++++++++++++++++++++-------
 apps/forth/dictionary.txt |  2 ++
 apps/forth/main.asm       | 12 ++++++++++--
 apps/forth/util.asm       | 18 ------------------
 5 files changed, 50 insertions(+), 27 deletions(-)

diff --git a/apps/forth/core.fs b/apps/forth/core.fs
index 1c99ada..bfdeadd 100644
--- a/apps/forth/core.fs
+++ b/apps/forth/core.fs
@@ -49,6 +49,24 @@
 : / /MOD SWAP DROP ;
 : MOD /MOD DROP ;
 
+( Parse numbers )
+: (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*) !
+
 ( Format numbers )
 ( TODO FORGET this word )
 : PUSHDGTS
diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm
index e47b933..a8d8e38 100644
--- a/apps/forth/dict.asm
+++ b/apps/forth/dict.asm
@@ -339,7 +339,7 @@ COMPILE:
 	.db	0b10		; UNWORD
 .maybeNum:
 	.dw	compiledWord
-	.dw	PARSE
+	.dw	PARSEI
 	.dw	LITN
 	.dw	R2P		; exit COMPILE
 	.dw	DROP
@@ -554,10 +554,6 @@ PARSED:
 	.dw	nativeWord
 	pop	hl
 	call	chkPS
-	; temporary: run parseCharLit in here until it's implemented in Forth
-	; core.fs needs char literal parsing.
-	call	parseCharLit
-	jr	z, .success
 	call	parseDecimal
 	jr	z, .success
 	; error
@@ -573,7 +569,7 @@ PARSED:
 
 
 	.db	"(parse)"
-	.dw	WORD
+	.dw	PARSED
 	.db	0
 PARSE:
 	.dw	compiledWord
@@ -592,6 +588,16 @@ PARSE:
 	.dw	ABORT
 
 
+; Indirect parse caller. Reads PARSEPTR and calls
+	.db	0b10		; UNWORD
+PARSEI:
+	.dw	compiledWord
+	.dw	PARSEPTR_
+	.dw	FETCH
+	.dw	EXECUTE
+	.dw	EXIT
+
+
 	.db "CREATE"
 	.fill 1
 	.dw PARSE
@@ -622,9 +628,16 @@ CURRENT_:
 	.dw sysvarWord
 	.dw CURRENT
 
+	.db "(parse*"
+	.dw CURRENT_
+	.db 0
+PARSEPTR_:
+	.dw sysvarWord
+	.dw PARSEPTR
+
 	.db	"IN>"
 	.fill	4
-	.dw	CURRENT_
+	.dw	PARSEPTR_
 	.db	0
 INP:
 	.dw	sysvarWord
diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt
index cc3fb2d..581e54d 100644
--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@@ -176,6 +176,8 @@ core.
                             Parses string at a as a number and push the result
                             in n as well as whether parsing was a success in f
                             (0 = failure, 1 = success)
+(parse*)    -- a            Variable holding the current pointer for system
+                            number parsing. By default, (parse).
 (print)     a --            Print string at addr a.
 .           n --            Print n in its decimal form
 .X          n --            Print n in its hexadecimal form. In hex, numbers
diff --git a/apps/forth/main.asm b/apps/forth/main.asm
index 9c65c11..02518a3 100644
--- a/apps/forth/main.asm
+++ b/apps/forth/main.asm
@@ -25,7 +25,11 @@
 .equ	IP		@+2
 ; Pointer to where we currently are in the interpretation of the current line.
 .equ	INPUTPOS	@+2
-; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
+; Pointer to the system's number parsing function. It points to then entry that
+; had the "(parse)" name at startup. During stage0, it's out builtin PARSE,
+; but at stage1, it becomes "(parse)" from core.fs. It can also be changed at
+; runtime.
+.equ	PARSEPTR	@+2
 .equ	FORTH_RAMEND	@+2
 
 ; (HERE) usually starts at RAMEND, but in certain situations, such as in stage0,
@@ -84,6 +88,10 @@ forthMain:
 	ld	(INPUTPOS), hl
 	xor	a
 	ld	(hl), a
+	; Set up PARSEPTR
+	ld	hl, PARSE-CODELINK_OFFSET
+	call	find
+	ld	(PARSEPTR), de
 forthRdLine:
 	ld	hl, msgOk
 	call	printstr
@@ -106,7 +114,7 @@ INTERPRET:
 
 .maybeNum:
 	.dw	compiledWord
-	.dw	PARSE
+	.dw	PARSEI
 	.dw	R2P		; exit INTERPRET
 	.dw	DROP
 	.dw	EXIT
diff --git a/apps/forth/util.asm b/apps/forth/util.asm
index dbd980a..0c1e7cb 100644
--- a/apps/forth/util.asm
+++ b/apps/forth/util.asm
@@ -181,24 +181,6 @@ parseDecimal:
 	cp	a	; ensure Z
 	ret
 
-parseCharLit:
-	ld	a, (hl)
-	cp	0x27		; apostrophe
-	ret	nz
-
-	ld	d, 0		; preset
-	inc	hl
-	ld	e, (hl)		; our result
-	inc	hl
-	cp	(hl)
-	ret	z
-
-	; Z unset and there's an error
-	; In all error conditions, HL is advanced by 2. Rewind.
-	dec	hl \ dec hl
-	; NZ already set
-	ret
-
 ; *** Forth-specific part ***
 ; Return address of scratchpad in HL
 pad: