From 389b23fe1a2964ae315fe392e188033941258b81 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 25 Apr 2020 09:10:25 -0400
Subject: [PATCH] Change C<? mechanic

It's now a simple flag updated by the C< implementation. No more
routine pointer.

The goal is to avoid tons of "ok" during a LOAD operation.
---
 blk/083         |   6 +++---
 blk/398         |   2 +-
 emul/z80c.bin   | Bin 2250 -> 2236 bytes
 forth/blk.fs    |   8 ++++++--
 forth/readln.fs |  21 ++++++++++++---------
 5 files changed, 22 insertions(+), 15 deletions(-)

diff --git a/blk/083 b/blk/083
index 881a691..751f77a 100644
--- a/blk/083
+++ b/blk/083
@@ -1,5 +1,6 @@
-C<?* is a pointer to a word being called by C<?. If 0 or 1,
-will return that value as-is.
+C<? is a flag indicating whether a character is waiting in the
+input stream. 1 means yes, 0 means no. It is the responsibility
+of C<* to update that flag.
 
 WORDBUF is the buffer used by WORD
 
@@ -12,5 +13,4 @@ jump to this address. If you use one of those slots for an
 interrupt, write a jump to the appropriate offset in that RAM
 location.
 
-
                                                         (cont.)
diff --git a/blk/398 b/blk/398
index 7742b75..a544ed8 100644
--- a/blk/398
+++ b/blk/398
@@ -2,7 +2,7 @@
   for an abort message )
 : (parse) (parsed) NOT IF ABORT THEN ;
 
-: C<? 0x06 RAM+ @ DUP 2 > IF EXECUTE THEN ( 06 == C<?* ) ;
+: C<? 0x06 RAM+ @ ;
 : C<
     0x08 RAM+ @  ( 08 == C<* override )
     DUP NOT IF DROP 0x0c RAM+ @ THEN  ( 0c == C<* )
diff --git a/emul/z80c.bin b/emul/z80c.bin
index 58515b42ad5e81bcfca177f44f5fa3ab249c0298..0d91496386bccb4fcfecacfdaa0608e48ca9226c 100644
GIT binary patch
delta 245
zcmX>lxJPh92pg*tgR>3q<aD-N)@Zg_jO!=gWRurE%65|RKT`n<ScEN|;nRO{CItpQ
zh7BxE48hI;k?IUAe6tw!nP)Lho2<;P;>pW?g@vEFo@Ex}6_)=@+ZmTJf%w0Hco|b2
z+cY)^??00hgGOpzNl~Sy1p_<ZV>TmpCk9Wy5Z9o9AlDE922Q@mlP9nr5^ewr`*?=<
z6##8fU{GMFW2>8-%Aw?3$F_)hHKP-Q6(0j5UoJbyLDSeCvvISgGl((FVoc^pXW(F{
gVhm<r0cr_m;9@uebU+oOKSwabt^ZC8@g@w603Jm>t^fc4

delta 213
zcmdlZcuH_X2%GRMMg;~YhD_FU1{Q`YMkfYm8|lfBY`LtNY_k~mPCm^h&wH8eB;$Xk
z0v3qKcQ#qZC6h(jRT!lwTd_;)_OLBsyTZcH{F~)JlM{nRYF<fErKSY~JKsk(2X-e0
zPrne?pnxFP5CH~GzK@fe*bfQ!0fl`$L;MODSojne6c~EgdM1Z+C^`4AEn;2`bb%Eg
z10!EGy8;6r!xFZSY}`Pni80J#EaXUM-~c)?80gR*wqOP>h9f|0s~BTBf*Ef8cVdV)
HVPFIRj`=jl

diff --git a/forth/blk.fs b/forth/blk.fs
index 6ad8bae..365b98e 100644
--- a/forth/blk.fs
+++ b/forth/blk.fs
@@ -61,17 +61,21 @@
 ;
 
 : LOAD
-    ( save BLK>, C<* override and boot< ptr to RSP )
+    ( save restorable variables to RSP )
     BLK> @ >R
     0x08 RAM+ @ >R
-    0x2e RAM+ @ >R
+    0x06 RAM+ @ >R  ( C<? )
+    0x2e RAM+ @ >R  ( boot ptr )
     BLK@
     ( Point to beginning of BLK )
     BLK( 0x2e RAM+ !
     ( 08 == C<* override )
     ['] _ 0x08 RAM+ !
+    ( While we interpret, don't print "ok" after every word )
+    1 0x06 RAM+ !  ( 06 == C<? )
     INTERPRET
     R> 0x2e RAM+ !
+    R> 0x06 RAM+ !
     ( Before we restore C<* are we restoring it to "_"?
       if yes, it means we're in a nested LOAD which means we
       should also load back the saved BLK>. Otherwise, we can
diff --git a/forth/readln.fs b/forth/readln.fs
index 3822b57..a10a1ed 100644
--- a/forth/readln.fs
+++ b/forth/readln.fs
@@ -59,15 +59,18 @@
     LF IN( IN> !
 ;
 
-: RDLN<? IN> @ C@ ;
-
-( And finally, implement a replacement for the (c<) routine )
+( And finally, implement C<* )
 : RDLN<
-    RDLN<?                      ( c )
-    ( not EOL? good, inc and return )
-    DUP IF 1 IN> +! EXIT THEN   ( c )
-    ( EOL ? readline. we still return typed char though )
-    (rdln)                      ( c )
+    IN> @ C@
+    DUP IF
+        ( not EOL? good, inc and return )
+        1 IN> +!
+    ELSE
+        ( EOL ? readline. we still return null though )
+        (rdln)
+    THEN
+    ( update C<? flag )
+    IN> @ C@ 0 > 0x06 RAM+ !  ( 06 == C<? )
 ;
 
 ( Initializes the readln subsystem )
@@ -78,7 +81,7 @@
       the last typed 0x0a and one for the following NULL. )
     INBUFSZ 4 + ALLOT
     (infl)
-    ['] RDLN<? 0x06 RAM+ !
     ['] RDLN< 0x0c RAM+ !
+    1 0x06 RAM+ !  ( 06 == C<? )
 ;