From 728e4ce1233b7a2217b088c5c1a5e16c2a0f75a8 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 15 Apr 2020 13:31:51 -0400
Subject: [PATCH] Bring EXECUTE word outside of stable ABI

---
 emul/forth/z80c.bin | Bin 2240 -> 2240 bytes
 forth/boot.fs       |  41 ++++++++++++++++++-----------------------
 forth/z80c.fs       |   3 +++
 3 files changed, 21 insertions(+), 23 deletions(-)

diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin
index 1e33cd5ae5bc2c409563ad996f31a117666d907f..f377d790c4722b055c3787e356b2999e5d75a9d8 100644
GIT binary patch
delta 288
zcmX>gctFtXa2LbjH4I>IxRCL1B;(<?42OR({C&xA*qHIK1Y-;1Bp_yBIPCZ0a2b^L
zWSnT`KXIWPM=QfwW`?VWjVB&YNM&Yx8_o0r!e@A@#qdHK2)4g1dU!$N@!h8n1sOhU
ze;af`;`&)xhO_EGwQMhvvW11;2D810Qx3cO_aRXHZyv+nG{(Qmf0bWqvAsAe$nf{+
zLuF+pwighIr-zLv*E1T5xJI}-hlaRXFtUpS9mx>nAHu<~c`IWLGt+9u&Bm;Tj37FV
z&5BWEHKPL1XNy=2m?IcC7`C%GGOuQwyoJ35s9>@cM~2*L#s~%$h8(sC1}><qH%A1+
Mt^dvp@um!n02L2sXaE2J

delta 288
zcmX>gctFtX@G^$OCm6usa0BDv493HpjE6-S|Gs26?9X`EgmE(CLLg>fIPCZ0a4Uoc
zDxPTO@8lZc>Kq#4D#O4o&hYo)Sy_g^c?^Hk82>8&RetH@?;pZo`0M}MVulxY6&XG#
zHoQ<`d7;I@pv3gzwc<jCv&;-v4^N!9I)O)?@ohBI3kZL*IHQ7&Gf;r-MN+n~@Y`Uv
z7jepAK!priY%k6VGW>n|P+3`t?FGc5r-vs_E?_id4e}3BVcfixv4)wcpJB5xt05zZ
zPGhrT6zOMB06KONive>40|&!)7DwiOhRIvlTYw5CTXAH_^)o~;urTDXMKEwdWxY8f
O7;gP{W{5XsU<3dt_F=97

diff --git a/forth/boot.fs b/forth/boot.fs
index d5d99f3..cebf372 100644
--- a/forth/boot.fs
+++ b/forth/boot.fs
@@ -31,13 +31,13 @@ RAMSTART 0x4e + JPnn, ( 28, RST 28 )
 0 JPnn,           ( 2b, doesWord )
 NOP, NOP,         ( 2e, unused )
 RAMSTART 0x4e + JPnn, ( RST 30 )
-NOP, NOP, NOP,    ( unused )
+0 JPnn,           ( 33, execute )
 NOP, NOP,         ( unused )
 RAMSTART 0x4e + JPnn, ( RST 38 )
 NOP,              ( unused )
 
 ( BOOT DICT
-  There are only 5 words in the boot dict, but these words'
+  There are only 3 words in the boot dict, but these words'
   offset need to be stable, so they're part of the "stable
   ABI"
 )
@@ -70,7 +70,7 @@ L2 BSET ( used in CBR )
 '(' A, '?' A, 'b' A, 'r' A, ')' A,
 PC L1 @ - A,, ( prev )
 5 A,
-L1 BSET ( CBR )
+H@ XCURRENT !        ( set current tip of dict )
     0x17 A,,         ( nativeWord )
     HL POPqq,
     chkPS,
@@ -84,22 +84,6 @@ L1 BSET ( CBR )
     RAMSTART 0x06 + LD(nn)HL, ( RAMSTART+0x06 == IP )
     JPNEXT,
 
-'E' A, 'X' A, 'E' A, 'C' A, 'U' A, 'T' A, 'E' A,
-PC L1 @ - A,, ( prev )
-7 A,
-H@ XCURRENT !        ( set current tip of dict )
-L2 BSET ( used frequently below )
-    0x17 A,,         ( nativeWord )
-    IY POPqq,        ( is a wordref )
-    chkPS,
-    L 0 IY+ LDrIXY,
-    H 1 IY+ LDrIXY,
-    ( HL points to code pointer )
-    IY INCss,
-    IY INCss,
-    ( IY points to PFA )
-    JP(HL),
-
 ( END OF STABLE ABI )
 
 ( Name of BOOT word )
@@ -130,7 +114,7 @@ PC ORG @ 1 + ! ( main )
     HL L1 @ LDddnn,
     0x03 CALLnn,        ( 03 == find )
     DE PUSHqq,
-    L2 @ 2 + JPnn,
+    0x33 JPnn,          ( 33 == execute )
 
 PC ORG @ 4 + ! ( find )
 ( Find the entry corresponding to word name where (HL) points
@@ -238,7 +222,7 @@ L1 BSET ( abortUnderflow )
     DE RAMSTART 0x02 + LDdd(nn),   ( RAM+02 == CURRENT )
     0x03 CALLnn, ( find )
     DE PUSHqq,
-    L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
+    0x33 JPnn,          ( 33 == execute )
 
 
 PC ORG @ 0x1e + ! ( chkPS )
@@ -282,7 +266,18 @@ PC ORG @ 0x1b + ! ( next )
     HL INCss,
     D (HL) LDrr,
     DE PUSHqq,
-    L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
+    ( continue to execute )
+
+PC ORG @ 0x34 + ! ( execute )
+    IY POPqq,        ( is a wordref )
+    chkPS,
+    L 0 IY+ LDrIXY,
+    H 1 IY+ LDrIXY,
+    ( HL points to code pointer )
+    IY INCss,
+    IY INCss,
+    ( IY points to PFA )
+    JP(HL),
 
 ( WORD ROUTINES )
 
@@ -302,7 +297,7 @@ PC ORG @ 0x0f + ! ( compiledWord )
     L 0 IY+ LDrIXY,
     H 1 IY+ LDrIXY,
     HL PUSHqq,      ( arg for EXECUTE )
-    L2 @ 2 + JPnn, ( EXECUTE, skip nativeWord )
+    0x33 JPnn,      ( 33 == execute )
 
 PC ORG @ 0x0c + ! ( cellWord )
 ( Pushes the PFA directly )
diff --git a/forth/z80c.fs b/forth/z80c.fs
index 200698c..2a5014b 100644
--- a/forth/z80c.fs
+++ b/forth/z80c.fs
@@ -14,6 +14,9 @@
   This unit expects the same conf as boot.fs.
 )
 
+CODE EXECUTE
+    0x33 JPnn,      ( 33 == execute )
+
 ( a b c -- b c a )
 CODE ROT
     HL POPqq,       ( C )