From 005dd98fc2b309afbca2b5d2857eec941d428606 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 27 Mar 2020 11:27:40 -0400
Subject: [PATCH] forth: Forth-ify "R>" and ">R"

---
 emul/forth/z80c.bin  | Bin 509 -> 620 bytes
 forth/dictionary.txt |   2 +-
 forth/forth.asm      |  34 ++++++++++------------------------
 forth/icore.fs       |  20 +++++++++++---------
 forth/z80c.fs        |  13 +++++++++++++
 5 files changed, 35 insertions(+), 34 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index accf95172cdc0811a486456f93f8bc3b16efc965..532dc5ad02ef8e761d8fb3235e4a1b8353ff522d 100644
GIT binary patch
delta 209
zcmey%{Dx&iI-{Ch5FZ1RIK#uUvJ7Vh84gP^1lfTF&WbQR1@bgfb2Cdc`6uTwYSbr5
zC@`=wtYiykQ($0V)Ra_UU|}eNlLhR^GOS=35cz@=p`Hya3L@)~MA^ZjAd-XGk;&69
z#5E`&$Tg&xf%6sPca|EKcWid-VhRkCZ!^kCS?e$~zG75haAe|Oe#>FW2EvX^@xly@
E0JXg-asU7T

delta 83
zcmaFE@|Sr-IwQMAYHntUrqJYGMh&wJ2?Yi=hLvmz3<c~f+1_!sa&j;`GFeMAG`?a~
kU~pvOVD4eFWCLMGCQrW**PwtP*AVH+s!X~p@j48Q0FFWva{vGU

diff --git a/forth/dictionary.txt b/forth/dictionary.txt
index 74db846..f94ae58 100644
--- a/forth/dictionary.txt
+++ b/forth/dictionary.txt
@@ -54,7 +54,7 @@ IMMEDIATE   --              Flag the latest defined word as immediate.
 LITN        n --            Write number n as a literal.
 [LITN]      n --            *I* Immediate version of LITN.
 ROUTINE x   -- a            Push the addr of the specified core routine
-                            C=cellWord L=compiledWord V=nativeWord N=next S=LIT
+                            C=cellWord J=JUMPTBL V=nativeWord N=next S=LIT
                             M=NUMBER Y=sysvarWord D=doesWord
 VARIABLE c  --              Creates cell x with 2 bytes allocation.
 
diff --git a/forth/forth.asm b/forth/forth.asm
index 873880c..0b4ef89 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -113,8 +113,10 @@
 ; change bootstrap binaries have to be adjusted because they rely on them.
 ; We're at 0 here
 	jp	forthMain
-.fill 0x17-$
+.fill 0x11-$
 JUMPTBL:
+	jp	pushRS
+	jp	popRS
 	jp	nativeWord
 	jp	next
 	jp	chkPS
@@ -782,13 +784,13 @@ ROUTINE:
 	ld	de, cellWord
 	cp	'C'
 	jr	z, .end
-	ld	de, compiledWord
-	cp	'L'
-	jr	z, .end
 	ld	de, JUMPTBL
+	cp	'J'
+	jr	z, .end
+	ld	de, JUMPTBL+6
 	cp	'V'
 	jr	z, .end
-	ld	de, JUMPTBL+3
+	ld	de, JUMPTBL+9
 	cp	'N'
 	jr	z, .end
 	ld	de, sysvarWord
@@ -803,7 +805,7 @@ ROUTINE:
 	ld	de, NUMBER
 	cp	'M'
 	jr	z, .end
-	ld	de, JUMPTBL+6
+	ld	de, JUMPTBL+12
 	cp	'P'
 	jr	nz, .notgood
 	; continue to end on match
@@ -1300,28 +1302,12 @@ OVER:
 	push	de
 	jp	next
 
-	.db	">R"
-	.dw	$-OVER
-	.db	2
-P2R:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	call	pushRS
-	jp	next
 
-	.db	"R>"
-	.dw	$-P2R
-	.db	2
-R2P:
-	.dw	nativeWord
-	call	popRS
-	push	hl
-	jp	next
+.fill 31
 
 ; ( a b -- c ) A + B
 	.db "+"
-	.dw $-R2P
+	.dw $-OVER
 	.db 1
 PLUS:
 	.dw nativeWord
diff --git a/forth/icore.fs b/forth/icore.fs
index f2f8882..d7ab7ba 100644
--- a/forth/icore.fs
+++ b/forth/icore.fs
@@ -41,15 +41,6 @@
     ,           ( write! )
 ; IMMEDIATE
 
-: X             ( can't have its real name now )
-    ['] EXIT ,
-    R> DROP     ( exit COMPILE )
-    R> DROP     ( exit : )
-; IMMEDIATE
-
-( Give ";" its real name )
-';' CURRENT @ 4 - C!
-
 : INTERPRET
     BEGIN
     WORD
@@ -63,3 +54,14 @@
     THEN
     AGAIN
 ;
+
+( ; has to be defined last because it can't be executed now )
+: X             ( can't have its real name now )
+    ['] EXIT ,
+    _c R> DROP     ( exit COMPILE )
+    _c R> DROP     ( exit : )
+; IMMEDIATE
+
+( Give ";" its real name )
+';' CURRENT @ 4 - C!
+
diff --git a/forth/z80c.fs b/forth/z80c.fs
index 183d848..e55364d 100644
--- a/forth/z80c.fs
+++ b/forth/z80c.fs
@@ -207,3 +207,16 @@ CODE J
     H 3 IX- LDrIXY,
     HL PUSHqq,
 ;CODE
+
+CODE >R
+    HL POPqq,
+    chkPS,
+    ( JUMPTBL+0 == pushRS )
+    ROUTINE J CALLnn,
+;CODE
+
+CODE R>
+    ( JUMPTBL+3 == popRS )
+    ROUTINE J 3 + CALLnn,
+    HL PUSHqq,
+;CODE