From cc4700e389b282152c7886832b8670dc13884cf2 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 30 Mar 2020 08:02:20 -0400
Subject: [PATCH] forth: Forth-ify "DUP"

---
 emul/forth/z80c.bin | Bin 1134 -> 1151 bytes
 forth/forth.asm     |  16 ++--------------
 forth/icore.fs      |  12 ++++++------
 forth/z80c.fs       |   8 ++++++++
 4 files changed, 16 insertions(+), 20 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 22f9c50a057e6e18f79b54d81b37f0a4e6f0f2fd..17e83588a4d2caf3b6e032621f36c72031e2050b 100644
GIT binary patch
delta 339
zcmaFI@t<RYh?q-gfFJ|2IK#uUvJ6k39+qP84|5IT-zXW#B(_BOH+MZZ2eTuSqmzG7
zh%f^y9|H^L<OU`Q&1z0ZCXIrk%)Am!Q3iHC1`c)$4i5IiEccl>7%bT=*&LaiITaWf
z8Fo)T$fP2(loO=hSx1I}iI3qTt16oY2Z)3yU}P4S)rKer8sNwj;veoG<RZbq#>X&|
zg@c`!YqBA;tdItm6uSUK2Rl?afmxPu_vAWeaeH^JBo>%~r`b8!FR}`-xv`xF(yDCt
zffy*p{GJoS69Br+(=Ws|C?Lo+#GZkZkHLNN6=o093tWy&R<aC@d<=bD3JgFWF}ris
t0R1Bd^xJI?kiR;Z>zP=9;`K~i4DW!Zb}*Mr4rCGL+Qb3!Z#+K(BLHQNM{)oF

delta 358
zcmey*@s4AH2&;dXYmm@Jtw1KRdf{u_QQRENj!ceD{y`za46J+%pE)K^WRlR#;&f!v
zC@9LzE725XVCQ29XH(}0XFJStpNWIPlFgFMk;#Ztfq{`>)#OV|D)m!1LF%1#WEhzE
z7%sA^vWatmNU#F-i>v}b<>A5h(hSUe3<?a23{nuS?1xz#nL_--{exU27})q2X0n8{
z{ow@J!NTCkWXV>~^zJ`UBT!m~fd!<K?}a!QC%XXDT!`}fKt+>FnI#!lP3~tFS2g2G
zVu4w`i#?nTWVsvLE}$b++3o}JE_M#)dy`KC)tgOz%Ip!epUaWSN|vFKkD-<eXaNHU
zvl&+n&;?>ZAD`j?`L=_(9_StpAj!q>4roFLb23*w(=DLOtW81s6o78!U|z@p3X^z#
G21WoD{!dE)

diff --git a/forth/forth.asm b/forth/forth.asm
index 455d6a3..3a7ae57 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -940,22 +940,10 @@ SWAP:
 	push	hl
 	jp	next
 
-; ( a -- a a )
-	.db "DUP"
-	.dw $-SWAP
-	.db 3
-DUP:
-	.dw nativeWord
-	pop	hl
-	call	chkPS
-	push	hl
-	push	hl
-	jp	next
-
-.fill 132
+.fill 149
 
 	.db	"_bend"
-	.dw	$-DUP
+	.dw	$-SWAP
 	.db	5
 ; Offset: 06ee
 .out $
diff --git a/forth/icore.fs b/forth/icore.fs
index cbc22c2..fa3220b 100644
--- a/forth/icore.fs
+++ b/forth/icore.fs
@@ -60,10 +60,10 @@
 ( a -- )
 : (print)
     BEGIN
-    DUP         ( a a )
+    _c DUP      ( a a )
     _c C@       ( a c )
     ( exit if null )
-    DUP NOT IF DROP DROP EXIT THEN
+    _c DUP NOT IF DROP DROP EXIT THEN
     _c EMIT     ( a )
     1 _c +         ( a+1 )
     AGAIN
@@ -85,7 +85,7 @@
 
 : TOWORD
     BEGIN
-    C< DUP _c WS? NOT IF EXIT THEN DROP
+    C< _c DUP _c WS? NOT IF EXIT THEN DROP
     AGAIN
 ;
 
@@ -101,7 +101,7 @@
         _c OVER !               ( a )
         1 _c +                  ( a+1 )
         C<                      ( a c )
-        DUP _c WS?
+        _c DUP _c WS?
     UNTIL
     ( a this point, PS is: a WS )
     ( null-termination is already written )
@@ -121,7 +121,7 @@
     SCPY            ( h )
     ( Adjust HERE -1 because SCPY copies the null )
     HERE @ 1 _c -   ( h h' )
-    DUP HERE !      ( h h' )
+    _c DUP HERE !   ( h h' )
     SWAP _c -       ( sz )
     ( write prev value )
     HERE @ CURRENT @ _c - ,
@@ -162,7 +162,7 @@
     _c WORD
     (find)
     ( is word )
-    IF DUP _c IMMED? IF EXECUTE ELSE , THEN
+    IF _c DUP _c IMMED? IF EXECUTE ELSE , THEN
     ( maybe number )
     ELSE (parse*) @ EXECUTE _c LITN THEN
     AGAIN
diff --git a/forth/z80c.fs b/forth/z80c.fs
index bfca503..f04556d 100644
--- a/forth/z80c.fs
+++ b/forth/z80c.fs
@@ -31,6 +31,14 @@ CODE ROT
     BC PUSHqq,      ( A )
 ;CODE
 
+( a -- a a )
+CODE DUP
+    HL POPqq,       ( A )
+    chkPS,
+    HL PUSHqq,      ( A )
+    HL PUSHqq,      ( A )
+;CODE
+
 ( a b -- a b a )
 CODE OVER
     HL POPqq,       ( B )