From 799ea72974432c5acf4074e30315d6bf67c27cc5 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 27 Mar 2020 16:16:57 -0400
Subject: [PATCH] forth: Forth-ify ":"!!!

Lifting ourselves by the bootstraps!
---
 emul/forth/z80c.bin | Bin 610 -> 661 bytes
 forth/forth.asm     |  67 ++++++--------------------------------------
 forth/icore.fs      |  27 ++++++++++++++----
 forth/z80c.fs       |   8 +++---
 4 files changed, 34 insertions(+), 68 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 2685946584fd73bb8e5ab6d805d3535dbcdab454..022ce5e69813811933d46ac6d909745f200aed19 100644
GIT binary patch
delta 96
zcmaFFGL?11aYnY4f=jt{xh9`wtoF51W@voHIEPh%fscWM`8!Ju%R4qZc9C#4O)!J4
tgV~OqnFC00zGGDd@|;=1+0`7GtW7}L6c`+tIGF!)Sh6`X#q%>T0szu>79aos

delta 45
ycmbQr`iN!2aYnWT!5FS5oRiNoR!dncGc>+pRA6vq;$Z&IVaW!<j!f~w42%Fq+zc}S

diff --git a/forth/forth.asm b/forth/forth.asm
index 33f4e37..1c2d973 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -115,8 +115,9 @@
 ; change bootstrap binaries have to be adjusted because they rely on them.
 ; We're at 0 here
 	jp	forthMain
-.fill 0x11-$
+.fill 0x0e-$
 JUMPTBL:
+	jp	compiledWord
 	jp	pushRS
 	jp	popRS
 	jp	nativeWord
@@ -768,10 +769,10 @@ ROUTINE:
 	ld	de, JUMPTBL
 	cp	'J'
 	jr	z, .end
-	ld	de, JUMPTBL+6
+	ld	de, JUMPTBL+9
 	cp	'V'
 	jr	z, .end
-	ld	de, JUMPTBL+9
+	ld	de, JUMPTBL+12
 	cp	'N'
 	jr	z, .end
 	ld	de, sysvarWord
@@ -786,7 +787,7 @@ ROUTINE:
 	ld	de, NUMBER
 	cp	'M'
 	jr	z, .end
-	ld	de, JUMPTBL+12
+	ld	de, JUMPTBL+15
 	cp	'P'
 	jr	nz, .notgood
 	; continue to end on match
@@ -822,52 +823,10 @@ EXECUTE:
 	jp	(hl)	; go!
 
 
-.fill 22
-	.db	":"
-	.dw	$-EXECUTE
-	.db	0x81		; IMMEDIATE
-DEFINE:
-	.dw	compiledWord
-	.dw	ENTRYHEAD
-	.dw	NUMBER
-	.dw	compiledWord
-	.dw	WR
-	; BBR branch mark
-	.dw	.compile
-	.dw	BBR
-	.db	4
-	; no need for EXIT, ENDDEF takes care of taking us out
-
-.compile:
-	.dw	compiledWord
-	.dw	WORD
-	.dw	FIND_
-	.dw	NOT
-	.dw	CSKIP
-	.dw	FBR
-	.db	7
-	; Maybe number
-	.dw	PARSEI
-	.dw	LITN
-	.dw	EXIT
-	; FBR mark
-	.dw	DUP
-	.dw	ISIMMED
-	.dw	CSKIP
-	.dw	FBR
-	.db	5
-	; is immediate. just execute.
-	.dw	EXECUTE
-	.dw	EXIT
-	; FBR mark
-	; just a word, write
-	.dw	WR
-	.dw	EXIT
-
-
+.fill 77
 
 	.db "DOES>"
-	.dw $-DEFINE
+	.dw $-EXECUTE
 	.db 5
 DOES:
 	.dw nativeWord
@@ -1104,17 +1063,7 @@ PARSED:
 	jp	next
 
 
-.fill 41
-
-
-; Indirect parse caller. Reads PARSEPTR and calls
-PARSEI:
-	.dw	compiledWord
-	.dw	PARSEPTR_
-	.dw	FETCH
-	.dw	EXECUTE
-	.dw	EXIT
-
+.fill 51
 
 ; Spit name (in (HL)) + prev in (HERE) and adjust (HERE) and (CURRENT)
 ; HL points to new (HERE)
diff --git a/forth/icore.fs b/forth/icore.fs
index be38c92..efceffc 100644
--- a/forth/icore.fs
+++ b/forth/icore.fs
@@ -81,13 +81,30 @@
     AGAIN
 ;
 
-( ; has to be defined last because it can't be executed now )
-: X             ( can't have its real name now )
+( : and ; have to be defined last because it can't be
+  executed now also, they can't have their real name
+  right away )
+
+: X
+    (entry)
+    ( JUMPTBL+0 == compiledWord )
+    [ ROUTINE J LITN ] ,
+    BEGIN
+    WORD
+    (find)
+    ( is word )
+    IF DUP IMMED? IF EXECUTE ELSE , THEN
+    ( maybe number )
+    ELSE (parse*) @ EXECUTE LITN THEN
+    AGAIN
+; IMMEDIATE
+
+: Y
     ['] EXIT ,
-    _c R> DROP     ( exit COMPILE )
     _c R> DROP     ( exit : )
 ; IMMEDIATE
 
-( Give ";" its real name )
-';' CURRENT @ 4 - C!
+( Give ":" and ";" their real name )
+':' ' X 4 - C!
+';' ' Y 4 - C!
 
diff --git a/forth/z80c.fs b/forth/z80c.fs
index dd81f4b..557cfad 100644
--- a/forth/z80c.fs
+++ b/forth/z80c.fs
@@ -220,12 +220,12 @@ CODE J
 CODE >R
     HL POPqq,
     chkPS,
-    ( JUMPTBL+0 == pushRS )
-    ROUTINE J CALLnn,
+    ( JUMPTBL+3 == pushRS )
+    ROUTINE J 3 + CALLnn,
 ;CODE
 
 CODE R>
-    ( JUMPTBL+3 == popRS )
-    ROUTINE J 3 + CALLnn,
+    ( JUMPTBL+6 == popRS )
+    ROUTINE J 6 + CALLnn,
     HL PUSHqq,
 ;CODE