From 4143e2a6991f128363c3f4056c11cff595efbc85 Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 14 May 2020 09:45:42 -0400
Subject: [PATCH] Improve late-stage xcomp

---
 blk/263        |   3 +--
 blk/437        |  16 ++++++++--------
 blk/438        |  25 +++++++++----------------
 emul/forth.bin | Bin 5875 -> 5875 bytes
 4 files changed, 18 insertions(+), 26 deletions(-)

diff --git a/blk/263 b/blk/263
index bf2ad7b..b48b461 100644
--- a/blk/263
+++ b/blk/263
@@ -1,14 +1,13 @@
 VARIABLE XCURRENT
-
 : XCON XCURRENT CURRENT* ! ;
 : XCOFF 0x02 RAM+ CURRENT* ! ;
-
 : (xentry) XCON (entry) XCOFF ;
 : XCREATE (xentry) 11 C, ;
 : XCODE XCON CODE XCOFF ;
 : XIMM XCON IMMEDIATE XCOFF ;
 : _xapply ( a -- a-off )
     DUP ORG @ > IF ORG @ - BIN( @ + THEN ;
+: X' XCON ' XCOFF ;
 : X['] XCON ' _xapply LITA XCOFF ;
 : XCOMPILE
     XCON ' _xapply LITA
diff --git a/blk/437 b/blk/437
index 65a31d5..361aab2 100644
--- a/blk/437
+++ b/blk/437
@@ -3,11 +3,11 @@
 : LOOP COMPILE (loop) H@ - , ; IMMEDIATE
 ( LEAVE is implemented in low xcomp )
 : LITN 32 , , ( 32 == NUMBER ) ;
-
-( ';' can't have its name right away because, when created, it
-  is not an IMMEDIATE yet and will not be treated properly by
-  xcomp. )
-: _
-    ['] EXIT ,
-    R> DROP     ( exit : )
-; IMMEDIATE
+: _ ( : will get its name at the very end )
+    (entry)
+    [ 14 ( == compiledWord ) LITN ] C,
+    BEGIN
+        WORD (find)
+        IF ( is word ) DUP IMMED? IF EXECUTE ELSE , THEN
+        ELSE ( maybe number ) (parse) LITN THEN
+    AGAIN ;
diff --git a/blk/438 b/blk/438
index e109431..cb829de 100644
--- a/blk/438
+++ b/blk/438
@@ -1,16 +1,9 @@
-XCURRENT @ ( to PSP )
-: :
-    (entry)
-    ( We cannot use LITN as IMMEDIATE because of bootstrapping
-      issues. Same thing for ",".
-      32 == NUMBER 14 == compiledWord )
-    [ 32 H@ ! 2 ALLOT 14 H@ ! 2 ALLOT ] C,
-    BEGIN
-        WORD
-        (find)
-        ( is word )
-        IF DUP IMMED? IF EXECUTE ELSE , THEN
-        ( maybe number )
-        ELSE (parse) LITN THEN
-    AGAIN ;
-( from PSP ) ';' SWAP 4 - C!
+( ';' can't have its name right away because, when created, it
+  is not an IMMEDIATE yet and will not be treated properly by
+  xcomp. )
+: _
+    ['] EXIT ,
+    R> DROP     ( exit : )
+; IMMEDIATE
+';' XCURRENT @ 4 - C!
+':' X' _ 4 - C! ( give : its name )
diff --git a/emul/forth.bin b/emul/forth.bin
index 5c34ad74864896bc91556a3cc33c88fd82150ec8..cdb375150f1202f4037b482910861c61d0e666e5 100644
GIT binary patch
delta 39
vcmeyY`&oCxW)UVUp2^2V427)?7#jIh7@Qa+InObOGC48C^KJeq@{17w_;Cw@

delta 39
vcmeyY`&oCxW)Wd)9)?Cf6$U2;NzQW&qD)Q<R(zAUiWoA*8*Kh5@{17w=QIm(