From 636407969d8c5d6efe418b47344cd727f25f9ebb Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 26 Mar 2020 12:05:48 -0400
Subject: [PATCH] forth: Forth-ify "(emit)"

---
 emul/Makefile         |   2 +-
 emul/forth/emul.fs    |  10 ++++++++++
 emul/forth/stagec.asm |   5 -----
 emul/forth/z80c.bin   | Bin 280 -> 301 bytes
 forth/forth.asm       |  21 +++++++++++++++------
 forth/z80a.fs         |   3 ++-
 forth/z80c.fs         |   3 +++
 7 files changed, 31 insertions(+), 13 deletions(-)
 create mode 100644 emul/forth/emul.fs

diff --git a/emul/Makefile b/emul/Makefile
index a228eb8..2229452 100644
--- a/emul/Makefile
+++ b/emul/Makefile
@@ -103,7 +103,7 @@ updatebootstrap: $(ZASMBIN)
 # words and they write to HERE at initialization.
 .PHONY: fbootstrap
 fbootstrap: forth/stage2
-	cat ../forth/dummy.fs ../forth/z80c.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
+	cat ../forth/dummy.fs ../forth/z80c.fs forth/emul.fs ../forth/dummy.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
 
 .PHONY: clean
 clean:
diff --git a/emul/forth/emul.fs b/emul/forth/emul.fs
new file mode 100644
index 0000000..bf4a857
--- /dev/null
+++ b/emul/forth/emul.fs
@@ -0,0 +1,10 @@
+( Implementation fo KEY and EMIT in the emulator
+  stdio port is 0
+)
+
+CODE (emit)
+    HL POPqq,
+    chkPS,
+    A L LDrr,
+    0 OUTnA,
+;CODE
diff --git a/emul/forth/stagec.asm b/emul/forth/stagec.asm
index 1cbea79..0488a8b 100644
--- a/emul/forth/stagec.asm
+++ b/emul/forth/stagec.asm
@@ -16,9 +16,4 @@ emulGetC:
 	cp	a		; ensure Z
 	ret
 
-emulPutC:
-	out	(STDIO_PORT), a
-	ret
-
 .equ	GETC	emulGetC
-.equ	PUTC	emulPutC
diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 1910686376eea062896e9f6a179c458fd38befc6..48ac1db1d71efd0d06f93a228319f6ca12338c56 100644
GIT binary patch
delta 33
pcmbQiw3cau2&1G%YHntUrU(O@IK#uUvJADC84gP^#Pc#R0sx*J2)+OS

delta 12
TcmZ3>G=ph_2qQ~8KLaBG77zl0

diff --git a/forth/forth.asm b/forth/forth.asm
index ac5e6c2..813e260 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -56,6 +56,8 @@
 ; interface in Forth, which we plug in during init. If "(c<)" exists in the
 ; dict, CINPTR is set to it. Otherwise, we set KEY
 .equ	CINPTR		@+2
+; Pointer to (emit) word
+.equ	EMITPTR		@+2
 .equ	WORDBUF		@+2
 ; Sys Vars are variables with their value living in the system RAM segment. We
 ; need this mechanisms for core Forth source needing variables. Because core
@@ -129,6 +131,10 @@ forthMain:
 	ld	hl, .parseName
 	call	find
 	ld	(PARSEPTR), de
+	; Set up EMITPTR
+	ld	hl, .emitName
+	call	find
+	ld	(EMITPTR), de
 	; Set up CINPTR
 	; do we have a (c<) impl?
 	ld	hl, .cinName
@@ -149,6 +155,8 @@ forthMain:
 	.db	"(parse)", 0
 .cinName:
 	.db	"(c<)", 0
+.emitName:
+	.db	"(emit)", 0
 
 BEGIN:
 	.dw	compiledWord
@@ -685,12 +693,13 @@ BYE:
 	.dw $-BYE
 	.db 4
 EMIT:
-	.dw nativeWord
-	pop	hl
-	call	chkPS
-	ld	a, l
-	call	PUTC
-	jp	next
+	.dw	compiledWord
+	.dw	NUMBER
+	.dw	EMITPTR
+	.dw	FETCH
+	.dw	EXECUTE
+	.dw	EXIT
+
 
 	.db	"(print)"
 	.dw	$-EMIT
diff --git a/forth/z80a.fs b/forth/z80a.fs
index 1261bbe..acaba0e 100644
--- a/forth/z80a.fs
+++ b/forth/z80a.fs
@@ -61,6 +61,7 @@
 0xa0 OP1r0 ANDr,
 0xb0 OP1r0 ORr,
 0xa8 OP1r0 XORr,
+0xb8 OP1r0 CPr,
 
 ( qq -- also works for ss )
 : OP1qq
@@ -93,7 +94,7 @@
     DOES>
     C@ A, A,
 ;
-0xd3 OP2n OUTAn,
+0xd3 OP2n OUTnA,
 0xdb OP2n INAn,
 
 ( r n -- )
diff --git a/forth/z80c.fs b/forth/z80c.fs
index 027fb69..d3ebe28 100644
--- a/forth/z80c.fs
+++ b/forth/z80c.fs
@@ -17,6 +17,9 @@
   These restrictions are temporary, I'll figure something out
   so that we can end up fully bootstrap Forth from within
   itself.
+
+  Oh, also: KEY and EMIT are not defined here. There're
+  expected to be defined in platform-specific code.
 )
 
 ( a b c -- b c a )