From 395eb04fac22bb3e2c911f6c296150d0451fc4c1 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 30 Mar 2020 08:37:33 -0400
Subject: [PATCH] forth: Forth-ify "C<"

---
 emul/forth/z80c.bin | Bin 1228 -> 1276 bytes
 forth/forth.asm     |  35 ++++-------------------------------
 forth/icore.fs      |  12 ++++++++++--
 3 files changed, 14 insertions(+), 33 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 1b87eeb6ccb22a878eecbc196aa3c1ab1d83bf7c..b5545dd8bb25e959a88cea4ded9bd0229969d72c 100644
GIT binary patch
delta 189
zcmX@Z`G<4ELMB!LkptW=lb10q5w?+GVB%v?VBmS7%GSZ`$mFcUH`#~TmUSv;BHNM4
zeav!#_c`0x1lSZ97#Y;rA)<Sk%^3ep{=%#*y^QlBt18=lRsl9gCQrW**PwtP*AROK
zPCkZzlZ{x+oi!P1SPrw?XX0T{V(@m21oA9_Ch@!wU{hkyNVZV{$=_$<VCZ13XJTQn
jWNYVgWU{hhXyjvX<x*haW8h%^H@TNZkx_f{dKOs#<2@}e

delta 141
zcmeyvd4_YtLMGOa!V9@oCof}K!lWZJIhNU$btX$9+vdshndJn}akjAuuqiMwGN`jd
zM9(psF}|J5%AzbimGdI2D%*Wl0X9b_Prne?pnxFP5PJqrK8ClGomtFPR5TfCSne}%
rFmy22GqEsOvXyZ;GFizoH1aW+a49hGF>o-yoxGPtkx^>$eHK{&<e?*|

diff --git a/forth/forth.asm b/forth/forth.asm
index ce5732c..a8c4f71 100644
--- a/forth/forth.asm
+++ b/forth/forth.asm
@@ -126,6 +126,7 @@ LIT:
 ; 35
 	jp	strcmp
 	.dw	RS_ADDR
+	.dw	CINPTR
 
 ; *** Code ***
 forthMain:
@@ -149,16 +150,6 @@ forthMain:
 	ld	hl, .parseName
 	call	find
 	ld	(PARSEPTR), de
-	; Set up CINPTR
-	; do we have a (c<) impl?
-	ld	hl, .cinName
-	call	find
-	jr	z, .skip
-	; no? then use KEY
-	ld	hl, .keyName
-	call	find
-.skip:
-	ld	(CINPTR), de
 	; Set up SYSVNXT
 	ld	hl, SYSVBUF
 	ld	(SYSVNXT), hl
@@ -169,14 +160,10 @@ forthMain:
 
 .parseName:
 	.db	"(parse)", 0
-.cinName:
-	.db	"(c<)", 0
-.keyName:
-	.db	"KEY", 0
 .bootName:
 	.db	"BOOT", 0
 
-.fill 68
+.fill 93
 
 ; STABLE ABI
 ; Offset: 00cd
@@ -764,24 +751,10 @@ FIND_:
 	push	de
 	jp	next
 
-; This is an indirect word that can be redirected through "CINPTR"
-; code: it is replaced in readln.fs.
-	.db "C<"
-	.dw $-FIND_
-	.db 2
-CIN:
-	.dw	compiledWord
-	.dw	NUMBER
-	.dw	CINPTR
-	.dw	FETCH
-	.dw	EXECUTE
-	.dw	EXIT
-
-
-.fill 24
+.fill 41
 
 	.db	"NOT"
-	.dw	$-CIN
+	.dw	$-FIND_
 	.db	3
 NOT:
 	.dw	nativeWord
diff --git a/forth/icore.fs b/forth/icore.fs
index 0f31198..2ae132d 100644
--- a/forth/icore.fs
+++ b/forth/icore.fs
@@ -75,6 +75,11 @@
     LIT< stack-underflow _c (print) _c ABORT
 ;
 
+: C<
+    ( JTBL+40 == CINPTR )
+    [ JTBL 40 + @ LITN ] @ EXECUTE
+;
+
 : C,
     HERE @ _c C!
     HERE @ 1 _c + HERE !
@@ -87,7 +92,7 @@
 
 : TOWORD
     BEGIN
-    C< _c DUP _c WS? NOT IF EXIT THEN DROP
+    _c C< _c DUP _c WS? NOT IF EXIT THEN DROP
     AGAIN
 ;
 
@@ -102,7 +107,7 @@
           always zero to pre-write our null-termination )
         _c OVER !               ( a )
         1 _c +                  ( a+1 )
-        C<                      ( a c )
+        _c C<                   ( a c )
         _c DUP _c WS?
     UNTIL
     ( a this point, PS is: a WS )
@@ -147,6 +152,9 @@
 ;
 
 : BOOT
+    LIT< (c<) (find) NOT IF LIT< KEY (find) DROP THEN
+    ( JTBL+40 == CINPTR )
+    [ JTBL 40 + @ LITN ] !
     LIT< (c<$) (find) IF EXECUTE ELSE DROP THEN
     _c INTERPRET
 ;