From 839021e0f8e3523b0916c8a57215f3c651ecd793 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 27 Mar 2020 12:36:10 -0400
Subject: [PATCH] forth: Forth-ify "(print)"

---
 emul/forth/z80c.bin | Bin 578 -> 622 bytes
 forth/forth.asm     |  57 ++++++++++++++++++----------------------------------
 forth/icore.fs      |  12 +++++++++++
 3 files changed, 31 insertions(+), 38 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index a5478a333ee1034890dd4d53ccc65fa00ba182c2..785a2009467d37b2ffbefbbc728f60a55c864306 100644
GIT binary patch
delta 100
zcmX@a@{VQ0aYn(*5(*4#45g9^3<d0^l95~=Cf{HTaMLI#%FHX#6l7q3#Td@k$`Q_X
znB^Ut9Xq=vn<bkg(?%u*21bUNY~k#(j!f3d42`cC6&M_uIGF!)Sh9hzBU8LE10w)(
CV;GhI

delta 56
zcmaFIa)@QaaYn(t5(*4#4Dpf*3<d1*lFnSWCf{HTkh11xXne(}z~IQl!Tg`Yk`06%
Jnc{^R7y-i!4kG{n

diff --git a/forth/forth.asm b/forth/forth.asm
index fa708fb..65c51b0 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -66,6 +66,8 @@
 .equ	CINPTR		@+2
 ; Pointer to (emit) word
 .equ	EMITPTR		@+2
+; Pointer to (print) word
+.equ	PRINTPTR	@+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
@@ -151,6 +153,10 @@ forthMain:
 	ld	hl, .emitName
 	call	find
 	ld	(EMITPTR), de
+	; Set up PRINTPTR
+	ld	hl, .printName
+	call	find
+	ld	(PRINTPTR), de
 	; Set up CINPTR
 	; do we have a (c<) impl?
 	ld	hl, .cinName
@@ -174,6 +180,8 @@ forthMain:
 	.db	"(c<)", 0
 .emitName:
 	.db	"(emit)", 0
+.printName:
+	.db	"(print)", 0
 .keyName:
 	.db	"KEY", 0
 
@@ -195,7 +203,7 @@ INTERPRET:
 	.dw	DROP
 	.dw	EXECUTE
 
-.fill 31
+.fill 13
 
 ; *** Collapse OS lib copy ***
 ; In the process of Forth-ifying Collapse OS, apps will be slowly rewritten to
@@ -681,8 +689,11 @@ abortUnderflow:
 .word:
 	.dw	compiledWord
 	.dw	LIT
-	.db	"stack underflow", 0
-	.dw	PRINT
+	.db	"stack underfl", 0
+	.dw	NUMBER
+	.dw	PRINTPTR
+	.dw	FETCH
+	.dw	EXECUTE
 	.dw	ABORT
 
 	.db "BYE"
@@ -692,6 +703,9 @@ BYE:
 	.dw nativeWord
 	halt
 
+; STABLE ABI
+; Offset: 02aa
+.out $
 ; ( c -- )
 	.db "EMIT"
 	.dw $-BYE
@@ -705,43 +719,10 @@ EMIT:
 	.dw	EXIT
 
 
-	.db	"(print)"
-	.dw	$-EMIT
-	.db	7
-PRINT:
-	.dw	compiledWord	; a
-	; BBR mark
-	.dw	DUP		; a a
-	.dw	.getc		; a c
-	.dw	DUP		; a c f
-	.dw	CSKIP		; a c
-	; zero, end of string
-	.dw	FBR
-	.db	12
-	.dw	EMIT		; a
-	.dw	NUMBER		; a 1
-	.dw	1
-	.dw	PLUS		; a+1
-	.dw	BBR
-	.db	21
-	; FBR mark
-	.dw	DROP
-	.dw	DROP
-	.dw	EXIT
-
-; Yes, very much like C@, but it has already been Forth-ified...
-.getc:
-	.dw	nativeWord
-	pop	hl
-	call	chkPS
-	ld	l, (hl)
-	ld	h, 0
-	push	hl
-	jp	next
-
+.fill 49
 
 	.db	"C,"
-	.dw	$-PRINT
+	.dw	$-EMIT
 	.db	2
 CWR:
 	.dw	nativeWord
diff --git a/forth/icore.fs b/forth/icore.fs
index e042293..713babf 100644
--- a/forth/icore.fs
+++ b/forth/icore.fs
@@ -61,6 +61,18 @@
     (parsed) SKIP? ABORT
 ;
 
+( a -- )
+: (print)
+    BEGIN
+    DUP         ( a a )
+    _c C@       ( a c )
+    ( exit if null )
+    DUP NOT IF DROP DROP EXIT THEN
+    EMIT        ( a )
+    1 +         ( a+1 )
+    AGAIN
+;
+
 ( ; has to be defined last because it can't be executed now )
 : X             ( can't have its real name now )
     ['] EXIT ,