Add xcomp unit for cross compilation

Memory mapping is a dead end too, solution has to be at a higher
level. xcomp is my new approach.

emul/Makefile

@@ -63,7 +63,7 @@ emul.o: emul.c
 .PHONY: updatebootstrap
 updatebootstrap: forth/stage2
 	cat ./forth/conf.fs ../forth/boot.fs | ./forth/stage2 | tee forth/boot.bin > /dev/null
-	cat ./forth/conf.fs ../forth/z80c.fs ../forth/icore.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
+	cat ./forth/conf.fs ../forth/xcomp.fs ./forth/xcomp.fs ../forth/z80c.fs ../forth/icore.fs | ./forth/stage2 | tee forth/z80c.bin > /dev/null
 
 .PHONY: clean
 clean:

emul/forth/xcomp.fs

@@ -0,0 +1,2 @@
+CURRENT @ XCURRENT !
+H@ ' _bend - 4 + XOFF !

forth/icore.fs

@@ -19,141 +19,114 @@
      by the full interpreter.
   5. When using words as immediates, make sure that they're
      not defined in icore or, if they are, make sure that
-     they contain no "_c" references.
+     they are *not* offsetted
 
-  All these rules make this unit a bit messy, but this is the
+  Those rules are mostly met by the "xcomp" unit, which is
-  price to pay for the awesomeness of self-bootstrapping.
+  expected to have been loaded prior to icore and redefines
+  ":" and other defining words. So, in other words, when
+  compiling icore, ":" doesn't means what you think it means,
+  go look in xcomp.
 )
 
-( When referencing words from native defs or this very unit,
-  use this compiling word, which subtract the proper offset
-  from the compiled word. That proper offset is:
-  1. Take ROT-header addr, the first native def.
-  2. Subtract _bend, boot's last word.
-  3. That will give us the offset to subtract to get the addr
-     of our word at runtime.
-
-  This means, of course, that any word compiling a _c word
-  can't be executed immediately.
-
-  Also note that because of that "_c" mechanism, it might
-  take two rounds of bootstrapping before the compiled
-  z80c.bin file is "stabilized". That's because the 2nd time
-  around, the recorded offset will have changed.
-)
-
-: _c
-    [
-    ' ROT
-    6 -         ( header )
-    ' _bend
-    -           ( our offset )
-    LITN
-    ]
-    '           ( get word )
-    -^          ( apply offset )
-    ,           ( write! )
-; IMMEDIATE
-
 : RAM+
-    [ RAMSTART LITN ] _c +
+    [ RAMSTART LITN ] +
 ;
 
-: FLAGS 0x08 _c RAM+ ;
+: FLAGS 0x08 RAM+ ;
-: (parse*) 0x0a _c RAM+ ;
+: (parse*) 0x0a RAM+ ;
-: HERE 0x04 _c RAM+ ;
+: HERE 0x04 RAM+ ;
-: CURRENT 0x02 _c RAM+ ;
+: CURRENT 0x02 RAM+ ;
-: (mmap*) 0x51 _c RAM+ ;
+: (mmap*) 0x51 RAM+ ;
 
 ( The goal here is to be as fast as possible *when there is
   no mmap*, which is the most frequent situation. That is why
   we don't DUP and we rather refetch. That is also why we
   use direct literal instead of RAM+ or (mmap*). )
 : (mmap)
-    [ RAMSTART 0x51 + LITN ] _c _@
+    [ RAMSTART 0x51 + LITN ] _@
     IF
-        [ RAMSTART 0x51 + LITN ] _c _@ EXECUTE
+        [ RAMSTART 0x51 + LITN ] _@ EXECUTE
     THEN
 ;
 
-: @ _c (mmap) _c _@ ;
+: @ (mmap) _@ ;
-: C@ _c (mmap) _c _C@ ;
+: C@ (mmap) _C@ ;
-: ! _c (mmap) _c _! ;
+: ! (mmap) _! ;
-: C! _c (mmap) _c _C! ;
+: C! (mmap) _C! ;
 
 : QUIT
-    0 _c FLAGS _c ! _c (resRS)
+    0 FLAGS ! (resRS)
-    LIT< INTERPRET _c (find) _c DROP EXECUTE
+    LIT< INTERPRET (find) DROP EXECUTE
 ;
 
-: ABORT _c (resSP) _c QUIT ;
+: ABORT (resSP) QUIT ;
 
-: = _c CMP _c NOT ;
+: = CMP NOT ;
-: < _c CMP -1 _c = ;
+: < CMP -1 = ;
-: > _c CMP 1 _c = ;
+: > CMP 1 = ;
 
 : (parsed)      ( a -- n f )
     ( read first char outside of the loop. it *has* to be
       nonzero. )
-    _c DUP _c C@                    ( a c )
+    DUP C@                    ( a c )
-    _c DUP _c NOT IF EXIT THEN      ( a 0 )
+    DUP NOT IF EXIT THEN      ( a 0 )
     ( special case: do we have a negative? )
-    _c DUP '-' _c = IF
+    DUP '-' = IF
         ( Oh, a negative, let's recurse and reverse )
-        _c DROP 1 _c +                  ( a+1 )
+        DROP 1 +                  ( a+1 )
-        _c (parsed)                     ( n f )
+        (parsed)                     ( n f )
-        _c SWAP 0 _c SWAP               ( f 0 n )
+        SWAP 0 SWAP               ( f 0 n )
-        _c - _c SWAP EXIT               ( 0-n f )
+        - SWAP EXIT               ( 0-n f )
     THEN
     ( running result, staring at zero )
-    0 _c SWAP                               ( a r c )
+    0 SWAP                               ( a r c )
     ( Loop over chars )
     BEGIN
     ( parse char )
-    '0' _c -
+    '0' -
     ( if bad, return "a 0" )
-    _c DUP 0 _c < IF _c 2DROP 0 EXIT THEN   ( bad )
+    DUP 0 < IF 2DROP 0 EXIT THEN   ( bad )
-    _c DUP 9 _c > IF _c 2DROP 0 EXIT THEN   ( bad )
+    DUP 9 > IF 2DROP 0 EXIT THEN   ( bad )
     ( good, add to running result )
-    _c SWAP 10 _c * _c +                    ( a r*10+n )
+    SWAP 10 * +                    ( a r*10+n )
-    _c SWAP 1 _c + _c SWAP                  ( a+1 r )
+    SWAP 1 + SWAP                  ( a+1 r )
     ( read next char )
-    _c OVER _c C@
+    OVER C@
-    _c DUP _c NOT UNTIL
+    DUP NOT UNTIL
     ( we're done and it's a success. We have "a r c", we want
       "r 1". )
-    _c DROP _c SWAP _c DROP 1
+    DROP SWAP DROP 1
 ;
 
 ( This is only the "early parser" in earlier stages. No need
   for an abort message )
 : (parse)
-    _c (parsed) _c NOT IF _c ABORT THEN
+    (parsed) NOT IF ABORT THEN
 ;
 
 : C<
     ( 0c == CINPTR )
-    0x0c _c RAM+ _c @ EXECUTE
+    0x0c RAM+ @ EXECUTE
 ;
 
 : ,
-    _c HERE _c @ _c !
+    HERE @ !
-    _c HERE _c @ 2 _c + _c HERE _c !
+    HERE @ 2 + HERE !
 ;
 
 : C,
-    _c HERE _c @ _c C!
+    HERE @ C!
-    _c HERE _c @ 1 _c + _c HERE _c !
+    HERE @ 1 + HERE !
 ;
 
 ( The NOT is to normalize the negative/positive numbers to 1
   or 0. Hadn't we wanted to normalize, we'd have written:
   32 CMP 1 - )
-: WS? 33 _c CMP 1 _c + _c NOT ;
+: WS? 33 CMP 1 + NOT ;
 
 : TOWORD
     BEGIN
-    _c C< _c DUP _c WS? _c NOT IF EXIT THEN _c DROP
+        C< DUP WS? NOT IF EXIT THEN DROP
     AGAIN
 ;
 
@@ -161,56 +134,56 @@
   return, make HL point to WORDBUF. )
 : WORD
     ( 0e == WORDBUF )
-    0x0e _c RAM+        ( a )
+    0x0e RAM+        ( a )
-    _c TOWORD                   ( a c )
+    TOWORD                   ( a c )
     BEGIN
         ( We take advantage of the fact that char MSB is
           always zero to pre-write our null-termination )
-        _c OVER _c !            ( a )
+        OVER !            ( a )
-        1 _c +                  ( a+1 )
+        1 +                  ( a+1 )
-        _c C<                   ( a c )
+        C<                   ( a c )
-        _c DUP _c WS?
+        DUP WS?
     UNTIL
     ( a this point, PS is: a WS )
     ( null-termination is already written )
-    _c 2DROP
+    2DROP
-    0x0e _c RAM+
+    0x0e RAM+
 ;
 
 : SCPY
     BEGIN               ( a )
-        _c DUP _c C@    ( a c )
+        DUP C@    ( a c )
-        _c DUP _c C,    ( a c )
+        DUP C,    ( a c )
-        _c NOT IF _c DROP EXIT THEN
+        NOT IF DROP EXIT THEN
-        1 _c +          ( a+1 )
+        1 +          ( a+1 )
     AGAIN
 ;
 
 : (entry)
-    _c HERE _c @    ( h )
+    HERE @    ( h )
-    _c WORD         ( h s )
+    WORD         ( h s )
-    _c SCPY         ( h )
+    SCPY         ( h )
     ( Adjust HERE -1 because SCPY copies the null )
-    _c HERE _c @ 1 _c - ( h h' )
+    HERE @ 1 - ( h h' )
-    _c DUP _c HERE _c ! ( h h' )
+    DUP HERE ! ( h h' )
-    _c SWAP _c -       ( sz )
+    SWAP -       ( sz )
     ( write prev value )
-    _c HERE _c @ _c CURRENT _c @ _c - _c ,
+    HERE @ CURRENT @ - ,
     ( write size )
-    _c C,
+    C,
-    _c HERE _c @ _c CURRENT _c !
+    HERE @ CURRENT !
 ;
 
 : INTERPRET
     BEGIN
-    _c WORD
+    WORD
-    _c (find)
+    (find)
     IF
-        1 _c FLAGS _c !
+        1 FLAGS !
         EXECUTE
-        0 _c FLAGS _c !
+        0 FLAGS !
     ELSE
-        _c (parse*) _c @ EXECUTE
+        (parse*) @ EXECUTE
     THEN
     AGAIN
 ;
@@ -219,32 +192,32 @@
   LATEST. Convenient way to bootstrap a new system. )
 : (c<)
     ( 60 == SYSTEM SCRATCHPAD )
-    0x60 _c RAM+ _c @   ( a )
+    0x60 RAM+ @   ( a )
-    _c DUP _c C@        ( a c )
+    DUP C@        ( a c )
-    _c SWAP 1 _c +      ( c a+1 )
+    SWAP 1 +      ( c a+1 )
-    0x60 _c RAM+ _c !   ( c )
+    0x60 RAM+ !   ( c )
 ;
 
 : BOOT
-    0 0x51 _c RAM+ _c _!
+    0 0x51 RAM+ _!
-    LIT< (parse) _c (find) _c DROP _c (parse*) _c !
+    LIT< (parse) (find) DROP (parse*) !
     ( 60 == SYSTEM SCRATCHPAD )
-    _c CURRENT _c @ 0x60 _c RAM+ _c !
+    CURRENT @ 0x60 RAM+ !
     ( 0c == CINPTR )
-    LIT< (c<) _c (find) _c DROP 0x0c _c RAM+ _c !
+    LIT< (c<) (find) DROP 0x0c RAM+ !
-    LIT< INIT _c (find)
+    LIT< INIT (find)
     IF EXECUTE
-    ELSE _c DROP _c INTERPRET THEN
+    ELSE DROP INTERPRET THEN
 ;
 
 ( LITN has to be defined after the last immediate usage of
   it to avoid bootstrapping issues )
 : LITN
     ( 32 == NUMBER )
-    32 _c , _c ,
+    32 , ,
 ;
 
-: IMMED? 1 _c - _c C@ 0x80 _c AND ;
+: IMMED? 1 - C@ 0x80 AND ;
 
 ( : and ; have to be defined last because it can't be
   executed now also, they can't have their real name
@@ -252,32 +225,31 @@
 )
 
 : X
-    _c (entry)
+    (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 ,
+    [ 32 H@ _! 2 ALLOT 14 H@ _! 2 ALLOT ] ,
     BEGIN
-    _c WORD
+    WORD
-    _c (find)
+    (find)
     ( is word )
-    IF _c DUP _c IMMED? IF EXECUTE ELSE _c , THEN
+    IF DUP IMMED? IF EXECUTE ELSE , THEN
     ( maybe number )
-    ELSE _c (parse*) _c @ EXECUTE _c LITN THEN
+    ELSE (parse*) @ EXECUTE LITN THEN
     AGAIN
 ; IMMEDIATE
 
+XCURRENT @      ( to PSP )
+
 : Y
-    ['] EXIT _c ,
+    ['] EXIT ,
-    _c R> _c DROP     ( exit : )
+    R> DROP     ( exit : )
 ; IMMEDIATE
 
 ( Give ":" and ";" their real name )
-':' ' X 4 - _C!
+';' XCURRENT @ 4 - _C!
-';' ' Y 4 - _C!
+':' SWAP ( from PSP ) 4 - _C!
-
-( Add dummy entry. we use CREATE because (entry) is, at this
-  point, broken. Adjust H@ durint port 2 ping. )
-CREATE _
-H@ 2 - 256 /MOD 2 PC! 2 PC!
 
+(xentry) _
+H@ 256 /MOD 2 PC! 2 PC!

forth/xcomp.fs

@@ -0,0 +1,91 @@
+( Do dictionary cross compilation.
+  Include this file right before your cross compilation, then
+  set XCURRENT to CURRENT and XOFF to H@ - your target hook.
+  Example: H@ ' _bend - XOFF !
+
+  This redefines defining words to achieve cross compilation.
+  The goal is two-fold:
+
+  1. Add an offset to all word references in definitions.
+  2. Don't shadow important words we need right now.
+
+  New defining words establish a new XCURRENT, a copy of
+  CURRENT. From now on, CURRENT doesn't move. This means that
+  "'" and friends will *not* find words you're about to
+  define. Only (xfind) will.
+
+  See example in /emul/forth/xcomp.fs
+)
+
+VARIABLE XCURRENT
+VARIABLE XOFF
+
+: (xentry)
+    H@           ( h )
+    WORD         ( h s )
+    SCPY         ( h )
+    ( Adjust HERE -1 because SCPY copies the null )
+    H@ 1 -       ( h h' )
+    DUP HERE !   ( h h' )
+    -^           ( sz )
+    ( write prev value )
+    H@ XCURRENT @ - ,
+    ( write size )
+    C,
+    H@ XCURRENT !
+;
+
+( Finds in *both* CURRENT and XCURRENT )
+( w -- a f xa xf )
+: (xfind)
+    DUP                     ( w w )
+    (find)                  ( w a f )
+    ROT                     ( a f w )
+    CURRENT @               ( a f w cur )
+    XCURRENT @ CURRENT !
+    SWAP                    ( a f cur w )
+    (find)                  ( a f cur xa xf )
+    ROT                     ( a f xa xf cur )
+    CURRENT !               ( a f xa xf )
+;
+
+: CODE
+    (xentry) 23 ,
+;
+
+: _IMM IMMEDIATE ;
+
+: IMMEDIATE
+    XCURRENT @ 1 -
+    DUP C@ 128 OR SWAP C!
+;
+
+: :
+    (xentry)
+    ( 0e == compiledWord )
+    [ 0x0e LITN ] ,
+    BEGIN
+    WORD
+    (xfind)
+    IF  ( a f xa )
+        ( is word )
+        DUP IMMED?
+        IF  ( a f xa )
+            ( When encountering IMMEDIATE, we exec the *host*
+              word. )
+            DROP    ( a f )
+            NOT IF ABORT THEN   ( a )
+            EXECUTE
+        ELSE
+            ( when compiling, we don't care about the host
+              find. )
+            DUP 0x100 > IF XOFF @ - THEN
+            , 2DROP
+        THEN
+    ELSE ( w f xa )
+        ( maybe number )
+        2DROP   ( w )
+        (parse*) @ EXECUTE LITN
+    THEN
+    AGAIN
+; _IMM

forth/z80c.fs

@@ -23,7 +23,7 @@
 )
 
 ( dummy entry for dict hook )
-(entry) _
+(xentry) _
 H@ 256 /MOD 2 PC! 2 PC!
 
 ( a b c -- b c a )