From 80f63cd185397bde6e100aad33c48fe469bd626e Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 11 Mar 2020 21:58:16 -0400
Subject: [PATCH] forth: add words "2DUP", "2SWAP", "2OVER"

---
 apps/forth/dict.asm       | 55 ++++++++++++++++++++++++++++++++++++---
 apps/forth/dictionary.txt |  3 +++
 2 files changed, 54 insertions(+), 4 deletions(-)

diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm
index 98949f4..2f501fc 100644
--- a/apps/forth/dict.asm
+++ b/apps/forth/dict.asm
@@ -421,10 +421,26 @@ SWAP:
 	push	hl
 	jp	exit
 
+; ( a b c d -- c d a b )
+	.db "2SWAP"
+	.fill 3
+	.dw SWAP
+SWAP2:
+	.dw nativeWord
+	pop	de		; D
+	pop	hl		; C
+	pop	bc		; B
+
+	ex	(sp), hl	; A in HL
+	push	de		; D
+	push	hl		; A
+	push	bc		; B
+	jp	exit
+
 ; ( a -- a a )
 	.db "DUP"
 	.fill 5
-	.dw SWAP
+	.dw SWAP2
 DUP:
 	.dw nativeWord
 	pop	hl
@@ -432,10 +448,24 @@ DUP:
 	push	hl
 	jp	exit
 
+; ( a b -- a b a b )
+	.db "2DUP"
+	.fill 4
+	.dw DUP
+DUP2:
+	.dw nativeWord
+	pop	hl	; B
+	pop	de	; A
+	push	de
+	push	hl
+	push	de
+	push	hl
+	jp	exit
+
 ; ( a b -- a b a )
 	.db "OVER"
 	.fill 4
-	.dw DUP
+	.dw DUP2
 OVER:
 	.dw nativeWord
 	pop	hl	; B
@@ -445,10 +475,28 @@ OVER:
 	push	de
 	jp	exit
 
+; ( a b c d -- a b c d a b )
+	.db "2OVER"
+	.fill 3
+	.dw OVER
+OVER2:
+	.dw nativeWord
+	pop	hl	; D
+	pop	de	; C
+	pop	bc	; B
+	pop	iy	; A
+	push	iy	; A
+	push	bc	; B
+	push	de	; C
+	push	hl	; D
+	push	iy	; A
+	push	bc	; B
+	jp	exit
+
 ; ( a b -- c ) A + B
 	.db "+"
 	.fill 7
-	.dw OVER
+	.dw OVER2
 PLUS:
 	.dw nativeWord
 	pop	hl
@@ -712,4 +760,3 @@ LATEST:
 	.dw NUMBER
 	.dw 1
 	.dw EQ
-	.dw EXIT
diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt
index 1f38a65..d8296a2 100644
--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@@ -51,6 +51,9 @@ THEN        --              Does nothing. Serves as a branching merker for IF
 DUP         a -- a a
 OVER        a b -- a b a
 SWAP        a b -- b a
+2DUP        a b -- a b a b
+2OVER       a b c d -- a b c d a b
+2SWAP       a b c d -- c d a b
 
 *** Memory ***
 @           a -- n          Set n to value at address a