From 33e47d4938010a3f1ab2fb7e689035dec8e77805 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 21 Mar 2020 21:23:13 -0400
Subject: [PATCH] forth: begin z80 assembler

---
 emul/Makefile        |   2 +-
 forth/dictionary.txt |   1 +
 forth/forth.asm      |  18 ++++++-
 forth/z80a.fs        | 124 +++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 143 insertions(+), 2 deletions(-)
 create mode 100644 forth/z80a.fs

diff --git a/emul/Makefile b/emul/Makefile
index a36ec88..b1338eb 100644
--- a/emul/Makefile
+++ b/emul/Makefile
@@ -7,7 +7,7 @@ AVRABIN = zasm/avra
 SHELLAPPS = zasm ed
 SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
 # Those Forth source files are in a particular order
-FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs
+FORTHSRCS = core.fs str.fs parse.fs readln.fs fmt.fs high.fs z80a.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o
diff --git a/forth/dictionary.txt b/forth/dictionary.txt
index 8f28c62..9499b1a 100644
--- a/forth/dictionary.txt
+++ b/forth/dictionary.txt
@@ -98,6 +98,7 @@ UNTIL       f --            *I* Jump backwards to BEGIN if f is *false*.
 DROP        a --
 DUP         a -- a a
 OVER        a b -- a b a
+ROT         a b c -- b c a
 SWAP        a b -- b a
 2DUP        a b -- a b a b
 2OVER       a b c d -- a b c d a b
diff --git a/forth/forth.asm b/forth/forth.asm
index 3acd258..45b80f1 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -1456,9 +1456,25 @@ OVER2:
 	push	bc	; B
 	jp	next
 
+; ( a b c -- b c a)
+	.db "ROT"
+	.fill 4
+	.dw OVER2
+	.db 0
+ROT:
+	.dw nativeWord
+	pop	hl	; C
+	pop	de	; B
+	pop	bc	; A
+	call	chkPS
+	push	de	; B
+	push	hl	; C
+	push	bc	; A
+	jp	next
+
 	.db	">R"
 	.fill	5
-	.dw	OVER2
+	.dw	ROT
 	.db	0
 P2R:
 	.dw	nativeWord
diff --git a/forth/z80a.fs b/forth/z80a.fs
new file mode 100644
index 0000000..ef095a7
--- /dev/null
+++ b/forth/z80a.fs
@@ -0,0 +1,124 @@
+( Z80 assembler )
+
+( Splits word into msb/lsb, lsb being on TOS )
+: SPLITB
+    DUP 0x100 /
+    SWAP 0xff AND
+;
+
+: A, .X ;
+7 CONSTANT A
+0 CONSTANT B
+1 CONSTANT C
+2 CONSTANT D
+3 CONSTANT E
+4 CONSTANT H
+5 CONSTANT L
+6 CONSTANT (HL)
+0 CONSTANT BC
+1 CONSTANT DE
+2 CONSTANT HL
+3 CONSTANT AF
+3 CONSTANT SP
+
+( -- )
+: OP1 CREATE C, DOES> C@ A, ;
+0xc9 OP1 RET,
+0x76 OP1 HALT,
+
+( r -- )
+: OP1r
+    CREATE C,
+    DOES>
+    C@              ( r op )
+    SWAP            ( op r )
+    8 *             ( op r<<3 )
+    OR A,
+;
+0x04 OP1r INCr,
+0x46 OP1r LDr(HL),
+0x70 OP1r LD(HL)r,
+
+( qq -- also works for ss )
+: OP1qq
+    CREATE C,
+    DOES>
+    C@              ( qq op )
+    SWAP            ( op qq )
+    16 *            ( op qq<<4 )
+    OR A,
+;
+0xc5 OP1qq PUSHqq,
+0xc1 OP1qq POPqq,
+0x03 OP1qq INCss,
+0x09 OP1qq ADHLss,
+
+( rd rr )
+: OP1rr
+    CREATE C,
+    DOES>
+    C@              ( rd rr op )
+    ROT             ( rr op rd )
+    8 *             ( rr op rd<<3 )
+    OR OR A,
+;
+0x40 OP1rr LDrr,
+
+( n -- )
+: OP2n
+    CREATE C,
+    DOES>
+    C@ A, A,
+;
+0xd3 OP2n OUTAn,
+0xdb OP2n INAn,
+
+( r n -- )
+: OP2rn
+    CREATE C,
+    DOES>
+    C@              ( r n op )
+    ROT             ( n op r )
+    8 *             ( n op r<<3 )
+    OR A, A,
+;
+0x06 OP2rn LDrn,
+
+( b r -- )
+: OP2br
+    CREATE C,
+    DOES>
+    0xcb A,
+    C@              ( b r op )
+    ROT             ( r op b )
+    8 *             ( r op b<<3 )
+    OR OR Z,
+;
+0xc0 OP2br SETbr,
+0x80 OP2br RESbr,
+0x40 OP2br BITbr,
+
+( dd nn -- )
+: OP3ddnn
+    CREATE C,
+    DOES>
+    C@              ( dd nn op )
+    ROT             ( nn op dd )
+    16 *            ( nn op dd<<4 )
+    OR A,
+    SPLITB A, A,
+;
+0x01 OP2ddnn LDddnn,
+
+( nn -- )
+: OP3nn
+    CREATE C,
+    DOES>
+    C@ A,
+    SPLITB A, A,
+;
+0xcd OP3nn CALLnn,
+0xc3 OP3nn JPnn,
+
+( Specials )
+: JRe, 0x18 A, 2 - A, ;