xcomp: add XCOMPILE and X[COMPILE]

This allows us to move words like ABORT" to xcomp-core, which is
I think the last roadblock before being able to unify all drivers
into a single xcomp layer.

blk/263

@@ -5,7 +5,11 @@ VARIABLE XCURRENT
 
 : (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 ;
+: XCOMPILE
+    XCON ' _xapply LITA
+    LIT< , (find) DROP _xapply , XCOFF ;
+: X[COMPILE] XCON ' _xapply , XCOFF ;

blk/265

@@ -4,7 +4,7 @@
     XCURRENT @ SWAP ( xcur w ) _find ( a f )
     IF   ( a )
         DUP IMMED? IF ABORT THEN
-        DUP ORG @ > IF ORG @ - BIN( @ + THEN ,
+        _xapply ,
     ELSE ( w )
         0x02 RAM+ @ SWAP ( cur w ) _find ( a f )
         IF DUP IMMED? NOT IF ABORT THEN EXECUTE

blk/288

@@ -1,4 +1,4 @@
-PC ORG @ 0x22 + ! ( litWord, 0xf7, very tight on the 0x100 limit )
+PC ORG @ 0x22 + ! ( litWord, 0xf7, tight on the 0x100 limit )
 ( Like numberWord, but instead of being followed by a 2 bytes
   number, it's followed by a null-terminated string. When
   called, puts the string's address on PS )

blk/415

@@ -1 +1 @@
-1 2 LOADR+
+1 4 LOADR+

blk/416

@@ -1,14 +1,14 @@
-( LITN has to be defined after the last immediate usage of
+: EMIT
-  it to avoid bootstrapping issues )
+    ( 0x53==(emit) override )
-: LITN 32 , , ( 32 == NUMBER ) ;
+    0x53 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
 
-: IMMED? 1- C@ 0x80 AND ;
+: (print)
+    BEGIN
+        C@+      ( a+1 c )
+        ( exit if null or 0xd )
+        DUP 0xd = OVER NOT OR IF 2DROP EXIT THEN
+        EMIT     ( a )
+    AGAIN
+;
 
-( ';' 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
 

blk/417

@@ -1,16 +1,13 @@
-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
+        C<
-        (find)
+        ( 34 is ASCII for " )
-        ( is word )
+        DUP 34 = IF DROP EXIT THEN C,
-        IF DUP IMMED? IF EXECUTE ELSE , THEN
-        ( maybe number )
-        ELSE (parse) LITN THEN
     AGAIN ;
-( from PSP ) ';' SWAP 4 - C!
+
+: ."
+    34 , ( 34 == litWord ) ," 0 C,
+    COMPILE (print)
+; IMMEDIATE
+
+: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE

blk/418

@@ -0,0 +1,14 @@
+( LITN has to be defined after the last immediate usage of
+  it to avoid bootstrapping issues )
+: LITN 32 , , ( 32 == NUMBER ) ;
+
+: IMMED? 1- C@ 0x80 AND ;
+
+( ';' 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
+

blk/419

@@ -0,0 +1,16 @@
+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!

blk/420

@@ -8,6 +8,6 @@ itself to a full intepreter, which can then be relinked with
 the Relinker. There is no loader for these libraries because
 you will typically XPACK (B267) them.
 
-422 core                       438 print
+422 core                       440 print
 442 fmt                        447 readln
 453 blk

blk/438

@@ -1,13 +0,0 @@
-: EMIT
-    ( 0x53==(emit) override )
-    83 RAM+ @ DUP IF EXECUTE ELSE DROP (emit) THEN ;
-
-: (print)
-    BEGIN
-        C@+      ( a+1 c )
-        ( exit if null or 0xd )
-        DUP 13 = OVER NOT OR IF 2DROP EXIT THEN
-        EMIT     ( a )
-    AGAIN
-;
-

blk/439

@@ -1,16 +0,0 @@
-: ,"
-    BEGIN
-        C<
-        ( 34 is ASCII for " )
-        DUP 34 = IF DROP EXIT THEN C,
-    AGAIN ;
-
-: ."
-    34 , ( 34 == litWord ) ," 0 C,
-    COMPILE (print)
-; IMMEDIATE
-
-: ABORT" [COMPILE] ." COMPILE ABORT ; IMMEDIATE
-
-: (uflw) ABORT" stack underflow" ;
-

blk/440

@@ -1,3 +1,4 @@
+: (uflw) ABORT" stack underflow" ;
 : BS 8 EMIT ;
 : LF 10 EMIT ;
 : CR 13 EMIT ;

emul/xcomp.fs

@@ -4,6 +4,8 @@
 212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : : [ ' X: , ] ;

recipes/rc2014/xcomp.fs

@@ -10,6 +10,8 @@ RAMSTART 0x70 + CONSTANT ACIA_MEM
 212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : CREATE XCREATE ;

recipes/ti84/xcomp.fs

@@ -9,6 +9,8 @@ RAMSTART 0x72 + CONSTANT KBD_MEM
 262 LOAD  ( xcomp )
 522 LOAD  ( font compiler )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : CREATE XCREATE ; ( for KBD tbls )

recipes/trs80/xcomp.fs

@@ -4,6 +4,8 @@ RS_ADDR 0x80 - CONSTANT RAMSTART
 212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
+: COMPILE XCOMPILE ; IMMEDIATE
+: [COMPILE] X[COMPILE] ; IMMEDIATE
 : IMMEDIATE XIMM ;
 : (entry) (xentry) ;
 : : [ ' X: , ] ;