From d6516e2122335d411e27ae8bf6237dca118d5df6 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Tue, 24 Mar 2020 14:44:10 -0400
Subject: [PATCH] forth: Forth-ify "2*" stack management words

---
 emul/forth/z80c.bin | Bin 34 -> 117 bytes
 forth/forth.asm     |  60 +++-------------------------------------------------
 forth/z80a.fs       |   5 +++++
 forth/z80c.fs       |  40 +++++++++++++++++++++++++++++++++++
 4 files changed, 48 insertions(+), 57 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index b57f1b00b861d30c2c4c5e335a2775844c620f2d..5bd02a51d08014c450da372dfcad6c37ff00b3a3 100644
GIT binary patch
literal 117
zcmWIY4`BcTb_RxRj1Mm!Jlo57_36>Wa~X|XLIZ%}q7ZSg@YSavasM#aAh`I!zYl>@
ff1e(``V>fjq=Um9f%;^i#(||_a`6x#$-n>rFyb@X

delta 15
RcmXR_njpay4*{YK3;-k&1NZ;{

diff --git a/forth/forth.asm b/forth/forth.asm
index 1a45941..865ec23 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -1405,28 +1405,10 @@ SWAP:
 	push	hl
 	jp	next
 
-; ( a b c d -- c d a b )
-	.db "2SWAP"
-	.fill 2
-	.dw $-SWAP
-	.db 0
-SWAP2:
-	.dw nativeWord
-	pop	de		; D
-	pop	hl		; C
-	pop	bc		; B
-	call	chkPS
-
-	ex	(sp), hl	; A in HL
-	push	de		; D
-	push	hl		; A
-	push	bc		; B
-	jp	next
-
 ; ( a -- a a )
 	.db "DUP"
 	.fill 4
-	.dw $-SWAP2
+	.dw $-SWAP
 	.db 0
 DUP:
 	.dw nativeWord
@@ -1436,26 +1418,10 @@ DUP:
 	push	hl
 	jp	next
 
-; ( a b -- a b a b )
-	.db "2DUP"
-	.fill 3
-	.dw $-DUP
-	.db 0
-DUP2:
-	.dw nativeWord
-	pop	hl	; B
-	pop	de	; A
-	call	chkPS
-	push	de
-	push	hl
-	push	de
-	push	hl
-	jp	next
-
 ; ( a b -- a b a )
 	.db "OVER"
 	.fill 3
-	.dw $-DUP2
+	.dw $-DUP
 	.db 0
 OVER:
 	.dw nativeWord
@@ -1467,29 +1433,9 @@ OVER:
 	push	de
 	jp	next
 
-; ( a b c d -- a b c d a b )
-	.db "2OVER"
-	.fill 2
-	.dw $-OVER
-	.db 0
-OVER2:
-	.dw nativeWord
-	pop	hl	; D
-	pop	de	; C
-	pop	bc	; B
-	pop	iy	; A
-	call	chkPS
-	push	iy	; A
-	push	bc	; B
-	push	de	; C
-	push	hl	; D
-	push	iy	; A
-	push	bc	; B
-	jp	next
-
 	.db	">R"
 	.fill	5
-	.dw	$-OVER2
+	.dw	$-OVER
 	.db	0
 P2R:
 	.dw	nativeWord
diff --git a/forth/z80a.fs b/forth/z80a.fs
index 1f9cabc..331e86d 100644
--- a/forth/z80a.fs
+++ b/forth/z80a.fs
@@ -22,6 +22,11 @@
 3 CONSTANT AF
 3 CONSTANT SP
 
+( As a general rule, IX and IY are equivalent to spitting an
+  extra 0xdd / 0xfd and then spit the equivalent of HL )
+: IX 0xdd A, HL ;
+: IY 0xfd A, HL ;
+
 ( -- )
 : OP1 CREATE C, DOES> C@ A, ;
 0xc9 OP1 RET,
diff --git a/forth/z80c.fs b/forth/z80c.fs
index 4e2f89e..1e8c078 100644
--- a/forth/z80c.fs
+++ b/forth/z80c.fs
@@ -30,4 +30,44 @@ CODE ROT
     BC PUSHqq,      ( A )
 ;CODE
 
+( a b -- a b a b )
+CODE 2DUP
+    HL POPqq,       ( B )
+    DE POPqq,       ( A )
+    ROUTINE P CALLnn,
+    DE PUSHqq,      ( A )
+    HL PUSHqq,      ( B )
+    DE PUSHqq,      ( A )
+    HL PUSHqq,      ( B )
+;CODE
+
+( a b c d -- a b c d a b )
+
+CODE 2OVER
+    HL POPqq,       ( D )
+    DE POPqq,       ( C )
+    BC POPqq,       ( B )
+    IY POPqq,       ( A )
+    ROUTINE P CALLnn,
+    IY PUSHqq,      ( A )
+    BC PUSHqq,      ( B )
+    DE PUSHqq,      ( C )
+    HL PUSHqq,      ( D )
+    IY PUSHqq,      ( A )
+    BC PUSHqq,      ( B )
+;CODE
+
+( a b c d -- c d a b )
+
+CODE 2SWAP
+    HL POPqq,       ( D )
+    DE POPqq,       ( C )
+    BC POPqq,       ( B )
+    IY POPqq,       ( A )
+    ROUTINE P CALLnn,
+    DE PUSHqq,      ( C )
+    HL PUSHqq,      ( D )
+    IY PUSHqq,      ( A )
+    BC PUSHqq,      ( B )
+;CODE