From 816563e2e352d904e7d199e43db1fd4d2382fac1 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Fri, 24 Apr 2020 14:10:40 -0400
Subject: [PATCH] Stop LOADing on ABORT

This is done by adding a "C<* override" layer that is reset to 0 on
ABORT.

The problem was that when ABORT happened during a LOAD, we had a
resetted RSP and started from a clean INTERPRET, but LOAD didn't
have the opportunity to restore C<*, which caused it to continue
interpreting from the faulty BLK.

With a C<* override, we don't need to *restore* C<*, we just need to
clear the override.
---
 blk/081             |   2 +-
 blk/082             |   4 ++--
 blk/393             |   6 +++++-
 blk/398             |   6 +++++-
 blk/405             |   1 +
 emul/forth/z80c.bin | Bin 2212 -> 2250 bytes
 forth/blk.fs        |  16 ++++++++--------
 7 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/blk/081 b/blk/081
index 8d000fa..83b8219 100644
--- a/blk/081
+++ b/blk/081
@@ -3,7 +3,7 @@ RAMSTART  INITIAL_SP    +53       readln's variables
 +02       CURRENT       +55       adev's variables
 +04       HERE          +57       blk's variables
 +06       C<?*          +59       z80a's variables
-+08       FUTURE USES   +5b       FUTURE USES
++08       C<* override  +5b       FUTURE USES
 +0a       PARSEPTR      +70       DRIVERS
 +0c       C<*           +80       RAMEND
 +0e       WORDBUF
diff --git a/blk/082 b/blk/082
index f55ef93..7253cf7 100644
--- a/blk/082
+++ b/blk/082
@@ -9,8 +9,8 @@ IP is the Interpreter Pointer
 
 PARSEPTR holds routine address called on (parse)
 
-C<* holds routine address called on C<
-
+C<* holds routine address called on C<. If the C<* override
+at 0x08 is nonzero, this routine is called instead.
 
 
                                                         (cont.)
diff --git a/blk/393 b/blk/393
index 0e211ef..1f0d04f 100644
--- a/blk/393
+++ b/blk/393
@@ -7,5 +7,9 @@
 ( w -- a f )
 : (find) CURRENT @ SWAP _find ;
 
-: QUIT (resRS) LIT< INTERPRET (find) DROP EXECUTE ;
+: QUIT
+    (resRS)
+    0 0x08 RAM+ !  ( 08 == C<* override )
+    LIT< INTERPRET (find) DROP EXECUTE
+;
 394 407 LOADR
diff --git a/blk/398 b/blk/398
index d4f296c..7742b75 100644
--- a/blk/398
+++ b/blk/398
@@ -3,7 +3,11 @@
 : (parse) (parsed) NOT IF ABORT THEN ;
 
 : C<? 0x06 RAM+ @ DUP 2 > IF EXECUTE THEN ( 06 == C<?* ) ;
-: C< 0x0c RAM+ @ EXECUTE ( 0c == C<* ) ;
+: C<
+    0x08 RAM+ @  ( 08 == C<* override )
+    DUP NOT IF DROP 0x0c RAM+ @ THEN  ( 0c == C<* )
+    EXECUTE
+;
 
 : , HERE @ ! HERE @ 2+ HERE ! ;
 
diff --git a/blk/405 b/blk/405
index a577231..57614bf 100644
--- a/blk/405
+++ b/blk/405
@@ -3,6 +3,7 @@
     LIT< (parse) (find) DROP (parse*) !
     ( 2e == SYSTEM SCRATCHPAD )
     CURRENT @ 0x2e RAM+ !
+    0 0x08 RAM+ !  ( 08 == C<* override )
     ( 0c == C<* )
     LIT< (boot<) (find) DROP 0x0c RAM+ !
     ( boot< always has a char waiting. 06 == C<?* )
diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 954c7841d164ba7401bdb6ed12877d50f028d4c2..58515b42ad5e81bcfca177f44f5fa3ab249c0298 100644
GIT binary patch
delta 498
zcmXX@ze{655T4n$KVrOl8V^qHL~cD)3@BPyNQmZ0Q1B_DCZrHWBuYpVo>36B5Dp;-
zk88GjrGzx$z%G@Yjn|%){sqD{XDjlYjW)~9H}lPW-%KO%Cvl}k+~XQzaK$5LwD^Lf
zCM5=oYa$DCaX|OQDRLW3rMrQ-8ltlbMce-FPN~!b(hX6=5NwJv^=M&{XF<ahG+Bs8
z?^ua2Th#>>^IJ@wtr6ZwwLX6k9<O7QwJ{4GZ{vjs(e~+Q9&uXOrkW5ZojU#Aa{nT$
zrj9LQjQKmYgT3SiDEC49WM$y6K+<yQOfNX3RFbD2$4+KYp_v>`h?N^j4|I%J%QkJ9
zA844S*CMuPT$`%&L`8;pZLa0FkALMYM$G4L$fF#@hEZym4Jb3AzRm`+A@7L$OiLtT
zd)33*adL)){g*#f78X|u^XseY^MzjMBB;BgR>DnZ+LAd}2eb$}f_YM@Prrz;yjWQA
zfs+XhfecJ0_B|KKOUK$yxpb9NrNM=Uw9U%!nfALMvzt4?JoyY{9^&uqw_<s?kLY64
FfUidMZMpye

delta 516
zcmYLG&r2IY7=1H4GrJmDe+29yO1D<9Qb7+bEoEDAgNSKSNrIph7D?ltT87w5a|z^<
z;H}Ipr?yBgxp>RbOE2wBu!s6Lc=9T;{bm(<7?|(9`QCfqH@_!OCQk#I%wcn@x?bKX
zuUC<i1J+~_)}rllbq3Nub7p0P*B+RE>$G`<@a|d@8-%|Z&G6l<SP66Bet@(U6BX+Z
z2esNbl;2|k9-(Z$%6$H#OyFU_Y9fNgM-ZE#TrO-7K1H||=dvU^tj~v(q9lf_Wtb|w
zZ^<4@aFtr84jT~nL?1Mc>Wlku{d3vo2?Rp2ErzQTa43bssTg;x2S-fm0(P!qSjaMt
zWvoS(d~>WyGFCnI-TYM#pAOY8mU1mJL?yURAMgM^HAJWsclH(_XryJ5?wZH${9dXq
z$fzZH>_VgzyU%TXL#NNR>SpW>F%-G}>2u@D;!BGBN6ov@|GiIOgrHnDhr&<lZL&4<
z%{?-+-t&Bep1#|xZXJ?yfB;%)Q}^bITK#bBDqi{Y3$bfMc9oS$FiqQi>)Bm5S%qfT
Ss)Esb;TK*7mnr?wGq8WEqjSCh

diff --git a/forth/blk.fs b/forth/blk.fs
index fa2fb19..6ad8bae 100644
--- a/forth/blk.fs
+++ b/forth/blk.fs
@@ -61,28 +61,28 @@
 ;
 
 : LOAD
-    ( save BLK>, CINPTR and boot< ptr to RSP )
+    ( save BLK>, C<* override and boot< ptr to RSP )
     BLK> @ >R
-    0x0c RAM+ @ >R
+    0x08 RAM+ @ >R
     0x2e RAM+ @ >R
     BLK@
     ( Point to beginning of BLK )
     BLK( 0x2e RAM+ !
-    ( 0c == CINPTR )
-    ['] _ 0x0c RAM+ !
+    ( 08 == C<* override )
+    ['] _ 0x08 RAM+ !
     INTERPRET
     R> 0x2e RAM+ !
-    ( Before we restore CINPTR, are we restoring it to "_"?
+    ( 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
       ignore the BLK> from RSP. )
-    I 0x0c RAM+ @ = IF
+    I 0x08 RAM+ @ = IF
         ( nested load )
-        R> DROP ( CINPTR )
+        R> DROP ( C<* )
         R> BLK@
     ELSE
         ( not nested )
-        R> 0x0c RAM+ !
+        R> 0x08 RAM+ !
         R> DROP ( BLK> )
     THEN
 ;