From 53024d88f5253d2f3b7418354086ac11b390ed38 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 7 Mar 2020 21:12:30 -0500
Subject: [PATCH] forth: add "DUP", "OVER", "SWAP", "?", "+!", "ALLOT"

---
 apps/forth/dict.asm       | 74 ++++++++++++++++++++++++++++++++++++++-
 apps/forth/dictionary.txt | 11 ++++++
 apps/forth/main.asm       |  2 +-
 3 files changed, 85 insertions(+), 2 deletions(-)

diff --git a/apps/forth/dict.asm b/apps/forth/dict.asm
index fc3e49e..5cc87e8 100644
--- a/apps/forth/dict.asm
+++ b/apps/forth/dict.asm
@@ -268,11 +268,46 @@ FETCH:
 	push	hl
 	jp	exit
 
+; ( a b -- b a )
+SWAP:
+	.db "SWAP"
+	.fill 4
+	.dw FETCH
+	.dw nativeWord
+	pop	hl
+	ex	(sp), hl
+	push	hl
+	jp	exit
+
+; ( a -- a a )
+DUP:
+	.db "DUP"
+	.fill 5
+	.dw SWAP
+	.dw nativeWord
+	pop	hl
+	push	hl
+	push	hl
+	jp	exit
+
+; ( a b -- a b a )
+OVER:
+	.db "OVER"
+	.fill 4
+	.dw DUP
+	.dw nativeWord
+	pop	hl	; B
+	pop	de	; A
+	push	de
+	push	hl
+	push	de
+	jp	exit
+
 ; ( a b -- c ) A + B
 PLUS:
 	.db "+"
 	.fill 7
-	.dw FETCH
+	.dw OVER
 	.dw nativeWord
 	pop	hl
 	pop	de
@@ -317,3 +352,40 @@ DIV:
 	push	bc
 	jp	exit
 
+; End of native words
+
+; ( a -- )
+; @ .
+FETCHDOT:
+	.db "?"
+	.fill 7
+	.dw DIV
+	.dw compiledWord
+	.dw FETCH+CODELINK_OFFSET
+	.dw DOT+CODELINK_OFFSET
+	.dw EXIT+CODELINK_OFFSET
+
+; ( n a -- )
+; SWAP OVER @ + SWAP !
+STOREINC:
+	.db "+!"
+	.fill 6
+	.dw FETCHDOT
+	.dw compiledWord
+	.dw SWAP+CODELINK_OFFSET
+	.dw OVER+CODELINK_OFFSET
+	.dw FETCH+CODELINK_OFFSET
+	.dw PLUS+CODELINK_OFFSET
+	.dw SWAP+CODELINK_OFFSET
+	.dw STORE+CODELINK_OFFSET
+	.dw EXIT+CODELINK_OFFSET
+
+; ( n -- )
+; HERE +!
+ALLOT:
+	.db "ALLOT", 0, 0, 0
+	.dw STOREINC
+	.dw compiledWord
+	.dw HERE_+CODELINK_OFFSET
+	.dw STOREINC+CODELINK_OFFSET
+	.dw EXIT+CODELINK_OFFSET
diff --git a/apps/forth/dictionary.txt b/apps/forth/dictionary.txt
index 5d8428d..c677d27 100644
--- a/apps/forth/dictionary.txt
+++ b/apps/forth/dictionary.txt
@@ -2,6 +2,8 @@ Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack
                 (TOS). For example, in "a b -- c d", b is TOS before, d is TOS
                 after. "R:" means that the Return Stack is modified.
 
+*** Native Words ***
+
 : x ... ;   --              Define a new word
 .           n --            Print n in its decimal form
 @           a -- n          Set n to value at address a
@@ -11,6 +13,7 @@ Stack notation: "<stack before> -- <stack after>". Rightmost is top of stack
 *           a b -- c        a * b -> c
 /           a b -- c        a / b -> c
 CREATE x    --              Create cell named x
+DUP         a -- a a
 EMIT        c --            Spit char c to stdout
 EXECUTE     a --            Execute word at addr a
 EXIT        R:I --          Exit a colon definition
@@ -19,3 +22,11 @@ QUIT        R:drop --       Return to interpreter promp immediately
 KEY         -- c            Get char c from stdin
 INTERPRET   --              Get a line from stdin, compile it in tmp memory,
                             then execute the compiled contents.
+OVER        a b -- a b a
+SWAP        a b -- b a
+
+*** Core-but-Forth Words ***
+
+?           a --            Print value of addr a
++!          n a --          Increase value of addr a by n
+ALLOT       n --            Move HERE by n bytes
diff --git a/apps/forth/main.asm b/apps/forth/main.asm
index 7dfc5da..2803341 100644
--- a/apps/forth/main.asm
+++ b/apps/forth/main.asm
@@ -57,7 +57,7 @@ forthMain:
 	; we check for stack underflow.
 	push	af \ push af \ push af
 	ld	(INITIAL_SP), sp
-	ld	hl, DIV		; last entry in hardcoded dict
+	ld	hl, ALLOT		; last entry in hardcoded dict
 	ld	(CURRENT), hl
 	ld	hl, FORTH_RAMEND
 	ld	(HERE), hl