From 707f1dbae13bf0fc2be7c75cb29a2f70ae473411 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 17 Mar 2020 17:29:03 -0400
Subject: [PATCH] forth: Word-ify "[COMPILE]"

---
 apps/forth/core.fs        |   1 -
 apps/forth/dict.asm       | 102 ++++++++++++++++++++++++++------------
 apps/forth/dictionary.txt |   1 +
 apps/forth/stack.asm      |   5 ++
 apps/forth/util.asm       |   8 ---
 5 files changed, 76 insertions(+), 41 deletions(-)

diff --git a/apps/forth/core.fs b/apps/forth/core.fs
index a29cebb..1c99ada 100644
--- a/apps/forth/core.fs
+++ b/apps/forth/core.fs
@@ -2,7 +2,6 @@
 : -^ SWAP - ;
 : +! SWAP OVER @ + SWAP ! ;
 : ALLOT HERE +! ;
-: , H ! 2 ALLOT ;
 : C, H C! 1 ALLOT ;
 : BEGIN H ; IMMEDIATE
 : COMPILE ' ['] LITN EXECUTE ['] , , ; IMMEDIATE
diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm
index ca4f22a..bf1eedf 100644
--- a/apps/forth/dict.asm
+++ b/apps/forth/dict.asm
@@ -119,8 +119,7 @@ LIT:
 	.db	0
 EXIT:
 	.dw nativeWord
-	call	popRS
-	ld	(IP), hl
+	call	popRSIP
 	jp	next
 
 ; ( R:I -- )
@@ -130,7 +129,6 @@ EXIT:
 	.db 0
 QUIT:
 	.dw nativeWord
-quit:
 	jp	forthRdLine
 
 	.db "ABORT"
@@ -283,9 +281,23 @@ PFETCH:
 	push	hl
 	jp	next
 
+	.db	","
+	.fill	6
+	.dw	PFETCH
+	.db	0
+WR:
+	.dw	nativeWord
+	pop	de
+	call	chkPS
+	ld	hl, (HERE)
+	call	DEinHL
+	ld	(HERE), hl
+	jp	next
+
+
 ; ( addr -- )
 	.db "EXECUTE"
-	.dw PFETCH
+	.dw WR
 	.db 0
 EXECUTE:
 	.dw nativeWord
@@ -304,41 +316,50 @@ EXECUTE:
 	.dw	EXECUTE
 	.db	1		; IMMEDIATE
 COMPILE:
-	.dw	nativeWord
-	call	readword
-	call	find
-	jr	nz, .maybeNum
-	ex	de, hl
-	call	HLisIMMED
-	jr	z, .immed
-	ex	de, hl
-	call	.writeDE
-	jp	next
+	.dw	compiledWord
+	.dw	FIND_
+	.dw	CSKIP
+	.dw	.maybeNum
+	.dw	DUP
+	.dw	ISIMMED
+	.dw	CSKIP
+	.dw	.word
+	; is immediate. just execute.
+	.dw	EXECUTE
+	.dw	EXIT
+
+	.db	0b10		; UNWORD
+.word:
+	.dw	compiledWord
+	.dw	WR
+	.dw	R2P		; exit COMPILE
+	.dw	DROP
+	.dw	EXIT
+
+	.db	0b10		; UNWORD
 .maybeNum:
+	.dw	compiledWord
+	.dw	.parseNum
+	.dw	LITN
+	.dw	R2P		; exit COMPILE
+	.dw	DROP
+	.dw	EXIT
+
+
+	.db	0b10		; UNWORD
+.parseNum:
+	.dw	nativeWord
+	pop	hl		; string addr
 	push	hl		; --> lvl 1. save string addr
 	call	parseLiteral
 	pop	hl		; <-- lvl 1
 	jr	nz, .undef
 	; a valid number in DE!
-	ex	de, hl
-	ld	de, NUMBER
-	call	.writeDE
-	ex	de, hl		; number in DE
-	call	.writeDE
+	push	de
 	jp	next
 .undef:
 	call	printstr
 	jp	abortUnknownWord
-.immed:
-	push	hl
-	jp	EXECUTE+2
-.writeDE:
-	push	hl
-	ld	hl, (HERE)
-	call	DEinHL
-	ld	(HERE), hl
-	pop	hl
-	ret
 
 
 	.db	":"
@@ -381,8 +402,7 @@ DEFINE:
 .retRef:
 	.dw	$+2
 	.dw	$+2
-	call	popRS
-	ld	(IP), hl
+	call	popRSIP
 	jr	.loop
 
 
@@ -418,10 +438,28 @@ IMMEDIATE:
 	set	FLAG_IMMED, (hl)
 	jp	next
 
+
+	.db	"IMMED?"
+	.fill	1
+	.dw	IMMEDIATE
+	.db	0
+ISIMMED:
+	.dw	nativeWord
+	pop	hl
+	call	chkPS
+	dec	hl
+	ld	de, 0
+	bit	FLAG_IMMED, (hl)
+	jr	z, .notset
+	inc	de
+.notset:
+	push	de
+	jp	next
+
 ; ( n -- )
 	.db	"LITN"
 	.fill	3
-	.dw	IMMEDIATE
+	.dw	ISIMMED
 	.db	1		; IMMEDIATE
 LITN:
 	.dw nativeWord
diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt
index 7aa130f..c3d074e 100644
--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@@ -48,6 +48,7 @@ CREATE x    --              Create cell named x. Doesn't allocate a PF.
 COMPILE x   --              Meta compiles. Kind of blows the mind. See below.
 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
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
diff --git a/apps/forth/stack.asm b/apps/forth/stack.asm
index d4e3ec4..4aa2c72 100644
--- a/apps/forth/stack.asm
+++ b/apps/forth/stack.asm
@@ -25,6 +25,11 @@ popRS:
 	dec ix
 	ret
 
+popRSIP:
+	call	popRS
+	ld	(IP), hl
+	ret
+
 ; Skip the next two bytes in RS' TOS
 skipRS:
 	push	hl
diff --git a/apps/forth/util.asm b/apps/forth/util.asm
index 1607e06..6d070b4 100644
--- a/apps/forth/util.asm
+++ b/apps/forth/util.asm
@@ -519,14 +519,6 @@ HLisIMMED:
 	; We need an invert flag. We want to Z to be set when flag is non-zero.
 	jp	toggleZ
 
-; Sets Z if wordref at (HL) is of the IMMEDIATE type
-HLPointsIMMED:
-	push	hl
-	call	intoHL
-	call	HLisIMMED
-	pop	hl
-	ret
-
 ; Sets Z if wordref at HL is of the UNWORD type
 HLisUNWORD:
 	dec	hl