From 7beac94b5a7f285f866f3433c57eac857758e28c Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 25 Mar 2020 17:07:15 -0400
Subject: [PATCH] forth: Forth-ify "PC!"

---
 emul/forth/z80c.bin | Bin 144 -> 166 bytes
 forth/forth.asm     |  20 +-------------------
 forth/z80a.fs       |  15 ++++++++++++++-
 forth/z80c.fs       |   7 +++++++
 4 files changed, 22 insertions(+), 20 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 04a30e5549a578505aff6f991d08655a8ea409eb..5bed93b31e2cba344d9553eb7e246ddf7fcbae87 100644
GIT binary patch
delta 39
pcmbQhxQuZ^n?iuIA_EXeFfeRmJoxaeEW_K(!%__K5FpIJ007}l3ta#J

delta 17
UcmZ3+IDv6O8&^C8NH8z}05l>63IG5A

diff --git a/forth/forth.asm b/forth/forth.asm
index 8fc7cdc..a8a2788 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -21,11 +21,6 @@
 ;
 ; PutC: Write character specified in A onto the device.
 ;
-; *** ASCII ***
-.equ	BS	0x08
-.equ	CR	0x0d
-.equ	LF	0x0a
-.equ	DEL	0x7f
 ; *** Const ***
 ; Base of the Return Stack
 .equ	RS_ADDR		0xf000
@@ -738,23 +733,10 @@ PRINT:
 	inc	hl
 	jr	.loop
 
-; ( c port -- )
-	.db "PC!"
-	.fill 4
-	.dw $-PRINT
-	.db 0
-PSTORE:
-	.dw nativeWord
-	pop	bc
-	pop	hl
-	call	chkPS
-	out	(c), l
-	jp	next
-
 ; ( port -- c )
 	.db "PC@"
 	.fill 4
-	.dw $-PSTORE
+	.dw $-PRINT
 	.db 0
 PFETCH:
 	.dw nativeWord
diff --git a/forth/z80a.fs b/forth/z80a.fs
index 46b58d6..411021e 100644
--- a/forth/z80a.fs
+++ b/forth/z80a.fs
@@ -107,12 +107,25 @@
     C@              ( b r op )
     ROT             ( r op b )
     8 *             ( r op b<<3 )
-    OR OR Z,
+    OR OR A,
 ;
 0xc0 OP2br SETbr,
 0x80 OP2br RESbr,
 0x40 OP2br BITbr,
 
+( cell contains both bytes. MSB is spit as-is, LSB is ORed with r )
+( r -- )
+: OP2r
+    CREATE ,
+    DOES>
+    @ 256 /MOD      ( r lsb msb )
+    A,              ( r lsb )
+    SWAP 8 *        ( lsb r<<3 )
+    OR A,
+;
+0xed41 OP2r OUT(C)r,
+0xeb40 OP2r INr(C),
+
 ( dd nn -- )
 : OP3ddnn
     CREATE C,
diff --git a/forth/z80c.fs b/forth/z80c.fs
index 2c55819..61fc883 100644
--- a/forth/z80c.fs
+++ b/forth/z80c.fs
@@ -83,3 +83,10 @@ CODE AND
     H A LDrr,
     HL PUSHqq,
 ;CODE
+
+CODE PC!
+    BC POPqq,
+    HL POPqq,
+    chkPS,
+    L OUT(C)r,
+;CODE