Move icore to blkfs

The way is clear for complete stage1 bootstrapping on the RC2014
target!

blk/001

@@ -3,8 +3,8 @@ MASTER INDEX
   3 Usage                      30 Dictionary
  70 Implementation notes      100 Block editor
 200 Z80 assembler             260 Cross compilation
-280 Z80 boot code
+280 Z80 boot code             350 ACIA driver
-
+370 SD Card driver            390 Inner core
 
 
 

blk/350

@@ -0,0 +1,15 @@
+ACIA driver
+
+Manage I/O from an asynchronous communication interface adapter
+(ACIA). provides "EMIT" to put c char on the ACIA as well as
+an input buffer. You have to call "~ACIA" on interrupt for
+this module to work well.
+
+CONFIGURATION
+
+ACIA_CTL: IO port for the ACIA's control registers
+ACIA_IO: IO port for the ACIA's data registers
+ACIA_MEM: Address in memory that can be used variables shared
+          with ACIA's native words. 8 bytes used.
+
+Load z80 words with "352 LOAD" and Forth words with "357 LOAD".

blk/352

@@ -0,0 +1,15 @@
+( Save ACIA conf )
+ACIA_CTL
+: ACIA_CTL [ LITN ] ;
+ACIA_IO
+: ACIA_IO [ LITN ] ;
+ACIA_MEM
+: ACIA_MEM [ LITN ] ;
+( Memory layout
+  +0 ACIAR>
+  +2 ACIAW>
+  +4 ACIA(
+  +6 ACIA) )
+
+353 356 LOADR
+

blk/353

@@ -0,0 +1,16 @@
+(entry) ~ACIA
+    AF PUSHqq,
+    HL PUSHqq,
+    DE PUSHqq,
+	( Read our character from ACIA into our BUFIDX )
+    ACIA_CTL INAn,
+    0x01 ANDn,   ( is ACIA rcv buf full? )
+    IFNZ,
+        ( correct interrupt cause )
+        ( +2 == ACIAW> )
+        ACIA_MEM 2+ LDHL(nn),
+        ( is it == to ACIAR>? )
+        ( +0 == ACIAR> )
+        DE ACIA_MEM LDdd(nn),
+        ( carry cleared from ANDn above )
+        DE SBCHLss,                                   ( cont. )

blk/354

@@ -0,0 +1,16 @@
+        IFNZ, ( buffer full? )
+            ( no, continue )
+            DE ADDHLss, ( restore ACIAW> )
+            ( buffer not full, let's write )
+            ACIA_IO INAn,
+            (HL) A LDrr,
+            ( advance W> )
+            HL INCss,
+            ( +2 == ACIAW> )
+            ACIA_MEM 2+ LD(nn)HL,
+            ( +6 == ACIA) )
+            DE ACIA_MEM 6 + LDdd(nn),
+            DE SUBHLss,
+
+
+                                                      ( cont. )

blk/356

@@ -0,0 +1,16 @@
+            IFZ, ( end of buffer reached? )
+                ( yes )
+                ( +4 == ACIA( )
+                ACIA_MEM 4 + LDHL(nn),
+                ( +2 == ACIAW> )
+                ACIA_MEM 2+ LD(nn)HL,
+            THEN,
+        THEN,
+    THEN,
+    DE POPqq,
+    HL POPqq,
+    AF POPqq,
+    EI,
+    RETI,
+
+

blk/357

@@ -0,0 +1,14 @@
+0x20 CONSTANT ACIABUFSZ
+
+( Points to ACIA buf )
+: ACIA( [ ACIA_MEM 4 + LITN ] ;
+( Points to ACIA buf end )
+: ACIA) [ ACIA_MEM 6 + LITN ] ;
+( Read buf pointer. Pre-inc )
+: ACIAR> [ ACIA_MEM LITN ] ;
+( Write buf pointer. Post-inc )
+: ACIAW> [ ACIA_MEM 2 + LITN ] ;
+( This means that if W> == R>, buffer is full.
+  If R>+1 == W>, buffer is empty. )
+
+358 360 LOADR

blk/358

@@ -0,0 +1,16 @@
+: ACIA$
+    H@ DUP DUP ACIA( ! ACIAR> !
+    1+ ACIAW> !  ( write index starts one position later )
+    ACIABUFSZ ALLOT
+    H@ ACIA) !
+( setup ACIA
+  CR7 (1) - Receive Interrupt enabled
+  CR6:5 (00) - RTS low, transmit interrupt disabled.
+  CR4:2 (101) - 8 bits + 1 stop bit
+  CR1:0 (10) - Counter divide: 64 )
+    0b10010110 ACIA_CTL PC!
+( setup interrupt )
+    0xc3 0x4e RAM+ C!  ( c3==JP, 4e==INTJUMP )
+    ['] ~ACIA 0x4f RAM+ !
+    (im1)
+;

blk/359

@@ -0,0 +1,14 @@
+: KEY
+    ( inc then fetch )
+    ACIAR> @ 1+ DUP ACIA) @ = IF
+        DROP ACIA( @
+    THEN
+
+    ( As long as R> == W>-1, it means that buffer is empty )
+    BEGIN DUP ACIAW> @ = NOT UNTIL
+
+    ACIAR> !
+    ACIAR> @ C@
+;
+
+

blk/360

@@ -0,0 +1,7 @@
+: EMIT
+    ( As long at CTL bit 1 is low, we are transmitting. wait )
+    BEGIN ACIA_CTL PC@ 0x02 AND UNTIL
+    ( The way is clear, go! )
+    ACIA_IO PC!
+;
+

blk/370

@@ -0,0 +1,4 @@
+SD Card driver
+
+Load the z80 part with "372 LOAD", the Forth part with
+"374 LOAD".

blk/372

@@ -1,7 +1,6 @@
-( n -- n )
 ( Initiate SPI exchange with the SD card. n is the data to
   send. )
-CODE _sdcSR
+CODE _sdcSR  ( n -- n )
     HL POPqq,
     chkPS,
     A L LDrr,
@@ -12,10 +11,4 @@ CODE _sdcSR
     HL PUSHqq,
 ;CODE
 
-CODE _sdcSel
+373 LOAD
-    SDC_CSLOW OUTnA,
-;CODE
-
-CODE _sdcDesel
-    SDC_CSHIGH OUTnA,
-;CODE

blk/373

@@ -0,0 +1,9 @@
+CODE _sdcSel
+    SDC_CSLOW OUTnA,
+;CODE
+
+CODE _sdcDesel
+    SDC_CSHIGH OUTnA,
+;CODE
+
+

blk/374

@@ -0,0 +1,16 @@
+( -- n )
+: _idle 0xff _sdcSR ;
+
+( -- n )
+( _sdcSR 0xff until the response is something else than 0xff
+  for a maximum of 20 times. Returns 0xff if no response. )
+: _wait
+    0  ( cnt )
+    BEGIN
+        _idle
+        DUP 0xff = IF DROP ELSE SWAP DROP EXIT THEN
+        1+
+    DUP 20 = UNTIL
+    DROP 0xff
+;
+375 386 LOADR

blk/375

@@ -0,0 +1,10 @@
+( -- )
+( The opposite of sdcWaitResp: we wait until response is 0xff.
+  After a successful read or write operation, the card will be
+  busy for a while. We need to give it time before interacting
+  with it again. Technically, we could continue processing on
+  our side while the card it busy, and maybe we will one day,
+  but at the moment, I'm having random write errors if I don't
+  do this right after a write, so I prefer to stay cautious
+  for now. )
+: _ready BEGIN _idle 0xff = UNTIL ;

blk/376

@@ -0,0 +1,16 @@
+( c n -- c )
+( Computes n into crc c with polynomial 0x09
+  Note that the result is "left aligned", that is, that 8th
+  bit to the "right" is insignificant (will be stop bit). )
+: _crc7
+    XOR           ( c )
+    8 0 DO
+        2 *       ( <<1 )
+        DUP 255 > IF
+            ( MSB was set, apply polynomial )
+            0xff AND
+            0x12 XOR  ( 0x09 << 1, we apply CRC on high bits )
+        THEN
+    LOOP
+;
+

blk/377

@@ -0,0 +1,16 @@
+( c n -- c )
+( Computes n into crc c with polynomial 0x1021 )
+: _crc16
+    SWAP DUP 256 /    ( n c c>>8 )
+    ROT XOR           ( c x )
+    DUP 16 / XOR      ( c x^x>>4 )
+    SWAP 256 *        ( x c<<8 )
+    OVER 4096 * XOR   ( x c^x<<12 )
+    OVER 32 * XOR     ( x c^x<<5 )
+    XOR               ( c )
+;
+
+( send-and-crc7 )
+( n c -- c )
+: _s+crc SWAP DUP _sdcSR DROP _crc7 ;
+

blk/378

@@ -0,0 +1,16 @@
+( cmd arg1 arg2 -- resp )
+( Sends a command to the SD card, along with arguments and
+  specified CRC fields. (CRC is only needed in initial commands
+  though). This does *not* handle CS. You have to
+  select/deselect the card outside this routine. )
+: _cmd
+    _wait DROP ROT    ( a1 a2 cmd )
+    0 _s+crc          ( a1 a2 crc )
+    ROT 256 /MOD ROT  ( a2 h l crc )
+    _s+crc _s+crc     ( a2 crc )
+    SWAP 256 /MOD ROT ( h l crc )
+    _s+crc _s+crc     ( crc )
+    0x01 OR           ( ensure stop bit )
+    _sdcSR DROP       ( send CRC )
+    _wait  ( wait for a valid response... )
+;

blk/379

@@ -0,0 +1,16 @@
+( cmd arg1 arg2 -- r )
+( Send a command that expects a R1 response, handling CS. )
+: SDCMDR1 _sdcSel _cmd _sdcDesel ;
+
+( cmd arg1 arg2 -- r arg1 arg2 )
+( Send a command that expects a R7 response, handling CS. A R7
+  is a R1 followed by 4 bytes. arg1 contains bytes 0:1, arg2
+  has 2:3 )
+: SDCMDR7
+    _sdcSel
+    _cmd                 ( r )
+    _idle 256 * _idle +  ( r arg1 )
+    _idle 256 * _idle +  ( r arg1 arg2 )
+    _sdcDesel
+;
+

blk/380

@@ -0,0 +1,16 @@
+: _err _sdcDesel ABORT" SDerr" ;
+
+( Initialize a SD card. This should be called at least 1ms
+  after the powering up of the card. )
+: SDC$
+( Wake the SD card up. After power up, a SD card has to receive
+  at least 74 dummy clocks with CS and DI high. We send 80. )
+    10 0 DO _idle DROP LOOP
+    ( call cmd0 and expect a 0x01 response (card idle)
+	  this should be called multiple times. we're actually
+      expected to. let's call this for a maximum of 10 times. )
+    0 ( dummy )
+    10 0 DO  ( r )
+        DROP 0x40 0 0 SDCMDR1  ( CMD0 )
+        DUP 0x01 = IF LEAVE THEN
+    LOOP 0x01 = NOT IF _err THEN                      ( cont. )

blk/381

@@ -0,0 +1,10 @@
+( Then comes the CMD8. We send it with a 0x01aa argument and
+  expect a 0x01aa argument back, along with a 0x01 R1
+  response. )
+    0x48 0 0x1aa  ( CMD8 )
+    SDCMDR7                     ( r arg1 arg2 )
+    0x1aa = NOT IF _err THEN    ( arg2 check )
+    0 = NOT IF _err THEN        ( arg1 check )
+    0x01 = NOT IF _err THEN     ( r check )
+
+                                                      ( cont. )

blk/382

@@ -0,0 +1,13 @@
+( Now we need to repeatedly run CMD55+CMD41 (0x40000000)
+  until the card goes out of idle mode, that is, when it stops
+  sending us 0x01 response and send us 0x00 instead. Any other
+  response means that initialization failed. )
+    BEGIN
+        0x77 0 0 SDCMDR1  ( CMD55 )
+        0x01 = NOT IF _err THEN
+        0x69 0x4000 0x0000 SDCMDR1  ( CMD41 )
+        DUP 0x01 > IF _err THEN
+    NOT UNTIL
+    ( Out of idle mode! Success! )
+;
+

blk/383

@@ -0,0 +1,15 @@
+: _sdc@  ( dstaddr blkno -- )
+    _sdcSel 0x51 ( CMD17 ) 0 ROT ( a cmd 0 blkno ) _cmd
+    IF _err THEN
+    _wait 0xfe = NOT IF _err THEN
+    0 SWAP               ( crc a )
+    512 0 DO             ( crc a )
+        DUP _idle        ( crc a a n )
+        DUP ROT C!       ( crc a n )
+        ROT SWAP _crc16  ( a crc )
+        SWAP 1+          ( crc a+1 )
+    LOOP
+    DROP                 ( crc1 )
+    _idle 256 * _idle +  ( crc2 )
+    _wait DROP _sdcDesel
+    = NOT IF _err THEN ;

blk/384

@@ -0,0 +1,7 @@
+: SDC@
+    2 * DUP BLK( SWAP    ( b a b )
+    _sdc@
+    1+ BLK( 512 + SWAP
+    _sdc@
+;
+

blk/385

@@ -0,0 +1,16 @@
+: _sdc!  ( srcaddr blkno -- )
+    _sdcSel 0x58 ( CMD24 ) 0 ROT ( a cmd 0 blkno ) _cmd
+    IF _err THEN
+    _idle DROP 0xfe _sdcSR DROP
+    0 SWAP           ( crc a )
+    512 0 DO         ( crc a )
+        C@+          ( crc a+1 n )
+        ROT OVER     ( a n crc n )
+        _crc16       ( a n crc )
+        SWAP         ( a crc n )
+        _sdcSR DROP  ( a crc )
+        SWAP         ( crc a )
+    LOOP
+    DROP ( crc ) 256 /MOD ( lsb msb )
+    _sdcSR DROP _sdcSR DROP
+    _wait DROP _sdcDesel ;

blk/386

@@ -0,0 +1,7 @@
+: SDC!
+    2 * DUP BLK( SWAP    ( b a b )
+    _sdc!
+    1+ BLK( 512 + SWAP
+    _sdc!
+;
+

blk/390

@@ -0,0 +1,16 @@
+Inner core
+
+This unit represents core definitions that happen right after
+native definitions. Before core.fs.
+
+Unlike core.fs and its followers, this unit isn't self-
+sustained. Like native defs it uses the machinery of a full
+Forth interpreter, notably for flow structures.
+
+Because of that, it has to obey specific rules:
+
+1. It cannot compile a word from higher layers. Using
+   immediates is fine though.
+
+
+                                                        (cont.)

blk/391

@@ -0,0 +1,16 @@
+2. If it references a word from this unit or from native
+   definitions, these need to be properly offsetted because
+   their offset at compile time are not the same as their
+   runtime offsets.
+3. Anything they refer to in the boot binary has to be properly
+   stabilized.
+4. Make sure that the words you compile are not overridden 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 are
+   *not* offsetted
+
+
+
+
+                                                        (cont.)

blk/392

@@ -0,0 +1,7 @@
+Those rules are mostly met by the "xcomp" unit, which is
+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
+B260.
+
+To load, run "393 LOAD".

blk/393

@@ -0,0 +1,15 @@
+: RAM+ [ RAMSTART LITN ] + ;
+: FLAGS 0x08 RAM+ ;
+: (parse*) 0x0a RAM+ ;
+: HERE 0x04 RAM+ ;
+: CURRENT* 0x51 RAM+ ;
+: CURRENT CURRENT* @ ;
+
+( w -- a f )
+: (find) CURRENT @ SWAP _find ;
+
+: QUIT
+    0 FLAGS ! (resRS)
+    LIT< INTERPRET (find) DROP EXECUTE
+;
+394 407 LOADR

blk/394

@@ -0,0 +1,8 @@
+: ABORT (resSP) QUIT ;
+
+: = CMP NOT ;
+: < CMP -1 = ;
+: > CMP 1 = ;
+: 0< 32767 > ;
+
+

blk/395

@@ -0,0 +1,15 @@
+( r c -- r f )
+( Parse digit c and accumulate into result r.
+  Flag f is 0 when c was a valid digit, 1 when c was WS,
+  -1 when c was an invalid digit. )
+: _pdacc
+    DUP 0x21 < IF DROP 1 EXIT THEN
+    ( parse char )
+    '0' -
+    ( if bad, return "r -1" )
+    DUP 0< IF DROP -1 EXIT THEN    ( bad )
+    DUP 9 > IF DROP -1 EXIT THEN   ( bad )
+    ( good, add to running result )
+    SWAP 10 * +                    ( r*10+n )
+    0                              ( good )
+;

blk/396

@@ -0,0 +1,11 @@
+( parsed is tight, all comments ahead. We read the first char
+  outside of the loop because it *has* to be nonzero, which
+  means _pdacc *has* to return 0.
+
+  Then, we check for '-'. If we get it, we advance by one,
+  recurse and invert result.
+
+  We loop until _pdacc is nonzero, which means either WS or
+  non-digit. 1 means WS, which means parsing was a success.
+  -1 means non-digit, which means we have a non-decimal. )
+

blk/397

@@ -0,0 +1,16 @@
+: (parsed)      ( a -- n f )
+    DUP C@                        ( a c )
+    DUP '-' = IF
+        DROP 1+ ( a+1 ) (parsed) 0 ROT ( f 0 n )
+        - SWAP EXIT                    ( 0-n f )
+    THEN
+    0 SWAP _pdacc                 ( a r f )
+    DUP IF 2DROP 0 EXIT THEN
+    BEGIN                         ( a r 0 )
+        DROP SWAP 1+              ( r a+1 )
+        DUP C@                    ( r a c )
+        ROT SWAP                  ( a r c )
+        _pdacc                    ( a r f )
+    DUP UNTIL
+    1 =         ( a r f )
+    ROT DROP    ( r f ) ;

blk/398

@@ -0,0 +1,11 @@
+( This is only the "early parser" in earlier stages. No need
+  for an abort message )
+: (parse) (parsed) NOT IF ABORT THEN ;
+
+: C< 0x0c RAM+ @ EXECUTE ( 0c == CINPTR ) ;
+
+: , HERE @ ! HERE @ 2+ HERE ! ;
+
+: C, HERE @ C! HERE @ 1+ HERE ! ;
+
+

blk/399

@@ -0,0 +1,12 @@
+( 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 CMP 1+ NOT ;
+
+: TOWORD
+    BEGIN
+        C< DUP WS? NOT IF EXIT THEN DROP
+    AGAIN
+;
+
+

blk/400

@@ -0,0 +1,16 @@
+( Read word from C<, copy to WORDBUF, null-terminate, and
+  return, make HL point to WORDBUF. )
+: WORD
+    0x0e RAM+  ( 0e == WORDBUF )
+    TOWORD     ( a c )
+    BEGIN
+        ( We take advantage of the fact that char MSB is
+          always zero to pre-write our null-termination )
+        OVER ! 1+            ( a+1 )
+        C<                   ( a c )
+        DUP WS?
+    UNTIL
+    ( a this point, PS is: a WS )
+    ( null-termination is already written )
+    2DROP
+    0x0e RAM+ ;

blk/401

@@ -0,0 +1,10 @@
+: SCPY
+    BEGIN         ( a )
+        DUP C@    ( a c )
+        DUP C,    ( a c )
+        NOT IF DROP EXIT THEN
+        1+        ( a+1 )
+    AGAIN
+;
+
+

blk/402

@@ -0,0 +1,15 @@
+: [entry]
+    HERE @       ( w h )
+    SWAP SCPY    ( h )
+    ( Adjust HERE -1 because SCPY copies the null )
+    HERE @ 1-    ( h h' )
+    DUP HERE !   ( h h' )
+    SWAP -       ( sz )
+    ( write prev value )
+    HERE @ CURRENT @ - ,
+    ( write size )
+    C,
+    HERE @ CURRENT !
+;
+
+: (entry) WORD [entry] ;

blk/403

@@ -0,0 +1,14 @@
+: INTERPRET
+    BEGIN
+    WORD
+    (find)
+    IF
+        1 FLAGS !
+        EXECUTE
+        0 FLAGS !
+    ELSE
+        (parse*) @ EXECUTE
+    THEN
+    AGAIN
+;
+

blk/404

@@ -0,0 +1,11 @@
+( system c< simply reads source from binary, starting at
+  LATEST. Convenient way to bootstrap a new system. )
+: (boot<)
+    ( 2e == BOOT C< PTR )
+    0x2e RAM+ @   ( a )
+    DUP C@        ( a c )
+    SWAP 1 +      ( c a+1 )
+    0x2e RAM+ !   ( c )
+;
+
+

blk/405

@@ -0,0 +1,12 @@
+: BOOT
+    0x02 RAM+ CURRENT* !
+    LIT< (parse) (find) DROP (parse*) !
+    ( 2e == SYSTEM SCRATCHPAD )
+    CURRENT @ 0x2e RAM+ !
+    ( 0c == CINPTR )
+    LIT< (boot<) (find) DROP 0x0c RAM+ !
+    LIT< INIT (find)
+    IF EXECUTE
+    ELSE DROP INTERPRET THEN
+;
+

blk/406

@@ -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/407

@@ -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*) @ EXECUTE LITN THEN
+    AGAIN ;
+( from PSP ) ';' SWAP 4 - C!

drv/acia.z80

@@ -1,60 +0,0 @@
-( Save ACIA conf )
-ACIA_CTL
-: ACIA_CTL [ LITN ] ;
-ACIA_IO
-: ACIA_IO [ LITN ] ;
-ACIA_MEM
-: ACIA_MEM [ LITN ] ;
-( Memory layout
-  +0 ACIAR>
-  +2 ACIAW>
-  +4 ACIA(
-  +6 ACIA)
-)
-
-(xentry) ~ACIA
-    AF PUSHqq,
-    HL PUSHqq,
-    DE PUSHqq,
-
-	( Read our character from ACIA into our BUFIDX )
-    ACIA_CTL INAn,
-    0x01 ANDn,   ( is ACIA rcv buf full? )
-    IFNZ,
-        ( correct interrupt cause )
-        ( +2 == ACIAW> )
-        ACIA_MEM 2+ LDHL(nn),
-        ( is it == to ACIAR>? )
-        ( +0 == ACIAR> )
-        DE ACIA_MEM LDdd(nn),
-        ( carry cleared from ANDn above )
-        DE SBCHLss,
-        IFNZ, ( buffer full? )
-            ( no, continue )
-            DE ADDHLss, ( restore ACIAW> )
-            ( buffer not full, let's write )
-            ACIA_IO INAn,
-            (HL) A LDrr,
-
-            ( advance W> )
-            HL INCss,
-            ( +2 == ACIAW> )
-            ACIA_MEM 2+ LD(nn)HL,
-            ( +6 == ACIA) )
-            DE ACIA_MEM 6 + LDdd(nn),
-            DE SUBHLss,
-            IFZ, ( end of buffer reached? )
-                ( yes )
-                ( +4 == ACIA( )
-                ACIA_MEM 4 + LDHL(nn),
-                ( +2 == ACIAW> )
-                ACIA_MEM 2+ LD(nn)HL,
-            THEN,
-        THEN,
-    THEN,
-
-    DE POPqq,
-    HL POPqq,
-    AF POPqq,
-    EI,
-    RETI,

emul/Makefile

@@ -1,10 +1,5 @@
-TARGETS = forth/forth
+TARGETS = forth/forth forth/stage2
 # Those Forth source files are in a particular order
-BOOTSRCS = ./forth/conf.fs \
-	./forth/xcomp.fs \
-	../forth/icore.fs \
-	./forth/xstop.fs
-
 FORTHSRCS = core.fs cmp.fs print.fs parse.fs readln.fs fmt.fs blk.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
 OBJS = emul.o libz80/libz80.o
@@ -76,7 +71,7 @@ emul.o: emul.c
 
 .PHONY: updatebootstrap
 updatebootstrap: forth/stage2
-	cat $(BOOTSRCS) | ./forth/stage2 > ./forth/z80c.bin
+	cat ./forth/xcomp.fs | ./forth/stage2 > ./forth/z80c.bin
 
 .PHONY: pack
 pack:

emul/forth/conf.fs

@@ -1,3 +0,0 @@
-212 LOAD  ( z80 assembler )
-0xe800 CONSTANT RAMSTART
-0xf000 CONSTANT RS_ADDR

emul/forth/xcomp.fs

@@ -1,6 +1,10 @@
+0xe800 CONSTANT RAMSTART
+0xf000 CONSTANT RS_ADDR
+212 LOAD  ( z80 assembler )
 262 LOAD  ( xcomp )
 : CODE XCODE ;
 : IMMEDIATE XIMM ;
+: (entry) (xentry) ;
 : : [ ' X: , ] ;
 
 CURRENT @ XCURRENT !
@@ -8,3 +12,6 @@ CURRENT @ XCURRENT !
 H@ 256 /MOD 2 PC! 2 PC!
 H@ XOFF !
 282 LOAD  ( boot.z80 )
+393 LOAD  ( icore )
+(entry) _
+H@ 256 /MOD 2 PC! 2 PC!

emul/forth/xstop.fs

@@ -1,3 +0,0 @@
-(xentry) _
-H@ 256 /MOD 2 PC! 2 PC!
-

forth/icore.fs

@@ -1,252 +0,0 @@
-( Inner core. This unit represents core definitions that
-  happen right after native definitions. Before core.fs.
-
-  Unlike core.fs and its followers, this unit isn't self-
-  sustained. Like native defs it uses the machinery of a
-  full Forth interpreter, notably for flow structures.
-
-  Because of that, it has to obey specific rules:
-
-  1. It cannot compile a word from higher layers. Using
-     immediates is fine though.
-  2. If it references a word from this unit or from native
-     definitions, these need to be properly offsetted
-     because their offset at compile time are not the same
-     as their runtime offsets.
-  3. Anything they refer to in the boot binary has to be
-     properly stabilized.
-  4. Make sure that the words you compile are not overridden
-     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 are *not* offsetted
-
-  Those rules are mostly met by the "xcomp" unit, which is
-  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 B260.
-)
-
-: RAM+
-    [ RAMSTART LITN ] +
-;
-
-: FLAGS 0x08 RAM+ ;
-: (parse*) 0x0a RAM+ ;
-: HERE 0x04 RAM+ ;
-: CURRENT* 0x51 RAM+ ;
-: CURRENT CURRENT* @ ;
-
-( w -- a f )
-: (find) CURRENT @ SWAP _find ;
-
-: QUIT
-    0 FLAGS ! (resRS)
-    LIT< INTERPRET (find) DROP EXECUTE
-;
-
-: ABORT (resSP) QUIT ;
-
-: = CMP NOT ;
-: < CMP -1 = ;
-: > CMP 1 = ;
-: 0< 32767 > ;
-
-( r c -- r f )
-( Parse digit c and accumulate into result r.
-  Flag f is 0 when c was a valid digit, 1 when c was WS,
-  -1 when c was an invalid digit. )
-: _pdacc
-    DUP 0x21 < IF DROP 1 EXIT THEN
-    ( parse char )
-    '0' -
-    ( if bad, return "r -1" )
-    DUP 0< IF DROP -1 EXIT THEN    ( bad )
-    DUP 9 > IF DROP -1 EXIT THEN   ( bad )
-    ( good, add to running result )
-    SWAP 10 * +                    ( r*10+n )
-    0                              ( good )
-;
-
-: (parsed)      ( a -- n f )
-    ( read first char outside of the loop. it *has* to be
-      nonzero. )
-    DUP C@                        ( a c )
-    ( special case: do we have a negative? )
-    DUP '-' = IF
-        ( Oh, a negative, let's recurse and reverse )
-        DROP 1+                   ( a+1 )
-        (parsed)                  ( n f )
-        0 ROT                     ( f 0 n )
-        - SWAP EXIT               ( 0-n f )
-    THEN
-    ( running result from first char )
-    0 SWAP                               ( a r c )
-    _pdacc                               ( a r f )
-    DUP IF
-        ( first char was not a valid digit )
-        2DROP 0 EXIT                     ( a 0 )
-    THEN
-    BEGIN                         ( a r 0 )
-        DROP SWAP 1+              ( r a+1 )
-        DUP C@                    ( r a c )
-        ROT SWAP                  ( a r c )
-        _pdacc                    ( a r f )
-    DUP UNTIL
-    ( a r f -- f is 1 on success, -1 on error, normalize
-      to bool. )
-    1 =         ( a r f )
-    ( we want "r f" )
-    ROT DROP
-;
-
-( This is only the "early parser" in earlier stages. No need
-  for an abort message )
-: (parse)
-    (parsed) NOT IF ABORT THEN
-;
-
-: C<
-    ( 0c == CINPTR )
-    0x0c RAM+ @ EXECUTE
-;
-
-: ,
-    HERE @ !
-    HERE @ 2+ HERE !
-;
-
-: 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 CMP 1+ NOT ;
-
-: TOWORD
-    BEGIN
-        C< DUP WS? NOT IF EXIT THEN DROP
-    AGAIN
-;
-
-( Read word from C<, copy to WORDBUF, null-terminate, and
-  return, make HL point to WORDBUF. )
-: WORD
-    ( 0e == WORDBUF )
-    0x0e RAM+        ( a )
-    TOWORD                   ( a c )
-    BEGIN
-        ( We take advantage of the fact that char MSB is
-          always zero to pre-write our null-termination )
-        OVER !               ( a )
-        1+                   ( a+1 )
-        C<                   ( a c )
-        DUP WS?
-    UNTIL
-    ( a this point, PS is: a WS )
-    ( null-termination is already written )
-    2DROP
-    0x0e RAM+
-;
-
-: SCPY
-    BEGIN               ( a )
-        DUP C@    ( a c )
-        DUP C,    ( a c )
-        NOT IF DROP EXIT THEN
-        1+        ( a+1 )
-    AGAIN
-;
-
-: [entry]
-    HERE @       ( w h )
-    SWAP SCPY    ( h )
-    ( Adjust HERE -1 because SCPY copies the null )
-    HERE @ 1-    ( h h' )
-    DUP HERE !   ( h h' )
-    SWAP -       ( sz )
-    ( write prev value )
-    HERE @ CURRENT @ - ,
-    ( write size )
-    C,
-    HERE @ CURRENT !
-;
-
-: (entry) WORD [entry] ;
-
-: INTERPRET
-    BEGIN
-    WORD
-    (find)
-    IF
-        1 FLAGS !
-        EXECUTE
-        0 FLAGS !
-    ELSE
-        (parse*) @ EXECUTE
-    THEN
-    AGAIN
-;
-
-( system c< simply reads source from binary, starting at
-  LATEST. Convenient way to bootstrap a new system. )
-: (boot<)
-    ( 2e == BOOT C< PTR )
-    0x2e RAM+ @   ( a )
-    DUP C@        ( a c )
-    SWAP 1 +      ( c a+1 )
-    0x2e RAM+ !   ( c )
-;
-
-: BOOT
-    0x02 RAM+ CURRENT* !
-    LIT< (parse) (find) DROP (parse*) !
-    ( 2e == SYSTEM SCRATCHPAD )
-    CURRENT @ 0x2e RAM+ !
-    ( 0c == CINPTR )
-    LIT< (boot<) (find) DROP 0x0c RAM+ !
-    LIT< INIT (find)
-    IF EXECUTE
-    ELSE DROP INTERPRET THEN
-;
-
-( LITN has to be defined after the last immediate usage of
-  it to avoid bootstrapping issues )
-: LITN
-    ( 32 == NUMBER )
-    32 , ,
-;
-
-: 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
-
-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*) @ EXECUTE LITN THEN
-    AGAIN
-;
-
-( from PSP ) ';' SWAP 4 - C!

recipes/rc2014/Makefile

@@ -4,12 +4,6 @@ FDIR = $(BASEDIR)/forth
 EDIR = $(BASEDIR)/emul/forth
 STAGE2 = $(EDIR)/stage2
 EMUL = $(BASEDIR)/emul/hw/rc2014/classic
-BOOTSRCS = conf.fs \
-	$(EDIR)/xcomp.fs \
-	$(BASEDIR)/drv/acia.z80 \
-	$(BASEDIR)/drv/sdc.z80 \
-	$(FDIR)/icore.fs \
-	$(EDIR)/xstop.fs
 
 PATHS = \
 	$(FDIR)/core.fs \
@@ -30,8 +24,8 @@ $(TARGET): z80c.bin $(SLATEST) $(PATHS)
 	$(SLATEST) $@
 	cat $(PATHS) | $(STRIPFC) >> $@
 
-z80c.bin: conf.fs
+z80c.bin: xcomp.fs
-	cat $(BOOTSRCS) | $(STAGE2) > $@
+	cat xcomp.fs | $(STAGE2) > $@
 
 $(SLATEST):
 	$(MAKE) -C $(BASEDIR)/tools

recipes/rc2014/conf.fs

@@ -1,10 +0,0 @@
-212 LOAD        ( z80a )
-0x8000 CONSTANT RAMSTART
-0xf000 CONSTANT RS_ADDR
-0x80   CONSTANT ACIA_CTL
-0x81   CONSTANT ACIA_IO
-4      CONSTANT SDC_SPI
-5      CONSTANT SDC_CSLOW
-6      CONSTANT SDC_CSHIGH
-RAMSTART 0x70 + CONSTANT ACIA_MEM
-

recipes/rc2014/xcomp.fs

@@ -0,0 +1,25 @@
+0x8000 CONSTANT RAMSTART
+0xf000 CONSTANT RS_ADDR
+0x80   CONSTANT ACIA_CTL
+0x81   CONSTANT ACIA_IO
+4      CONSTANT SDC_SPI
+5      CONSTANT SDC_CSLOW
+6      CONSTANT SDC_CSHIGH
+RAMSTART 0x70 + CONSTANT ACIA_MEM
+212 LOAD  ( z80 assembler )
+262 LOAD  ( xcomp )
+: CODE XCODE ;
+: IMMEDIATE XIMM ;
+: (entry) (xentry) ;
+: : [ ' X: , ] ;
+
+CURRENT @ XCURRENT !
+
+H@ 256 /MOD 2 PC! 2 PC!
+H@ XOFF !
+282 LOAD  ( boot.z80 )
+352 LOAD  ( acia.z80 )
+372 LOAD  ( sdc.z80 )
+393 LOAD  ( icore )
+(entry) _
+H@ 256 /MOD 2 PC! 2 PC!