recipes/rc2014/selfhost: complete instructions

I have yet to test the whole process on real hardware. Soon.

blk/001

@@ -2,6 +2,8 @@ MASTER INDEX
 
   3 Usage                      30 Dictionary
  70 Implementation notes      100 Block editor
+120 Linker                    140 Addressed devices
+150 AT28 Driver
 200 Z80 assembler             260 Cross compilation
 280 Z80 boot code             350 ACIA driver
 370 SD Card driver            390 Inner core
@@ -13,4 +15,3 @@ MASTER INDEX
 
 
 
-

blk/120

@@ -0,0 +1,16 @@
+Linker
+
+Relink a dictionary by applying offsets to all word references
+in words of the "compiled" type.
+
+A typical usage of this unit would be to, right after a
+bootstrap-from-icore-from-source operation, identify the root
+word of the source part, probably "H@", and run " ' thatword
+RLDICT ". Then, take the resulting relinked binary, concatenate
+it to the boot binary, and write to boot media.
+
+LIMITATIONS
+
+This unit can't automatically detect all offsets needing
+relinking. This is a list of situations that aren't handled:
+                                                        (cont.)

blk/121

@@ -0,0 +1,8 @@
+Cells: It's not possible to know for sure whether a cellWord
+contains an address or a number. They are therefore not
+automatically relinked. You have to manually relink each of
+them with RLCELL. In the case of a DOES> word, PFA+2, which
+is always an offset, is automatically relinked, but not
+PFA+0.
+
+Load with "122 LOAD"

blk/122

@@ -0,0 +1 @@
+123 132 LOADR

blk/123

@@ -0,0 +1,15 @@
+( Skip atom, considering special atom types. )
+: ASKIP ( a -- a+n )
+    DUP @       ( a n )
+    ( ?br or br or NUMBER )
+    DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
+    IF DROP 4 + EXIT THEN
+    ( regular word )
+    0x22 = NOT IF 2+ EXIT THEN
+    ( it's a lit, skip to null char )
+    ( a )
+    1+  ( we skip by 2, but the loop below is pre-inc... )
+    BEGIN 1+ DUP C@ NOT UNTIL
+    ( skip null char )
+    1+
+;

blk/124

@@ -0,0 +1,11 @@
+( RLATOM pre-comment
+
+  Relink atom at a, applying offset o with limit ol.
+  Returns a, appropriately skipped.
+
+  0x24 = IF: 0x24 is an addrWord, which should be offsetted in
+  the same way that a regular word would. To achieve this, we
+  skip ASKIP and instead of skipping 4 bytes like a numberWord,
+  we skip only 2, which means that our number will be treated
+  like a regular wordref. )
+

blk/125

@@ -0,0 +1,16 @@
+: RLATOM ( a o ol -- a+n )
+    ROT             ( o ol a )
+    DUP @           ( o ol a n )
+    DUP 0x24 = IF
+        DROP 2+     ( o ol a+2 )
+        ROT ROT 2DROP ( a ) EXIT
+    THEN
+    ROT             ( o a n ol )
+    < IF  ( under limit, do nothing )
+        SWAP DROP    ( a )
+    ELSE ( o a )
+        SWAP OVER @  ( a o n )
+        -^           ( a n-o )
+        OVER !       ( a )
+    THEN
+    ASKIP ;

blk/126

@@ -0,0 +1,15 @@
+( RLWORD pre-comment
+
+  Relink a word with specified offset. If it's not of the type
+  "compiled word", ignore. If it is, advance in word until a2
+  is met, and for each word that is above ol, reduce that
+  reference by o.
+  Arguments: a1: wordref a2: word end addr o: offset to apply
+             ol: offset limit. don't apply on refs under it.
+
+  The 0x0e and 0x2b check at the beginning is to ensure we have
+  either a compiledWord or a doesWord. If we don't, we do
+  nothing. The further 0x2b check is because if we have a
+  doesWord, we start 2 bytes later.
+)
+

blk/127

@@ -0,0 +1,16 @@
+: RLWORD ( ol o a1 a2 -- )
+    SWAP DUP C@             ( ol o a2 a1 n )
+    DUP <>{ 0x0e &= 0x2b |= <>} NOT IF ( unwind all args )
+        2DROP 2DROP EXIT THEN
+    0x2b = IF 2+ THEN ( ol o a2 a1 )
+    1+                          ( ol o a2 a1+1 )
+    BEGIN                       ( ol o a2 a1 )
+        2OVER SWAP              ( ol o a2 a1 o ol )
+        RLATOM                  ( ol o a2 a+n )
+        2DUP < IF ABORT THEN    ( Something is very wrong )
+        2DUP =                  ( ol o a2 a+n f )
+        IF ( unwind )
+            2DROP 2DROP EXIT
+        THEN
+    AGAIN
+;

blk/128

@@ -0,0 +1,16 @@
+( RLDICT pre-comment: Copy dict from target wordref, including
+header, up to HERE.  We're going relocate those words by
+specified offset. To do this, we're copying this whole memory
+area in HERE and then iterate through that copied area and call
+RLWORD on each word. That results in a dict that can be
+concatenated to target's prev entry in a more compact way.
+
+  This copy of data doesn't allocate anything, so H@ doesn't
+move. Moreover, we reserve 4 bytes at H@ to write our target
+and offset because otherwise, things get too complicated with
+the PSP.
+
+  The output of this word is 3 numbers: top copied address, top
+copied CURRENT, and then the beginning of the copied dict at
+the end to indicate that we're finished processing.
+                                                        cont. )

blk/130

@@ -0,0 +1,16 @@
+( Note that the last word is always skipped because it's not
+possible to reliably detect its end. If you need that last
+word, define a dummy word before calling RLDICT.
+
+We first start by copying the affected area to H@+4. This is
+where the relinking will take place.
+
+Then we iterate the new dict from the top, keeping track of
+wr, the current wordref and we, wr's end offset.
+
+Initially, we get our wr and we, withH@ and CURRENT, which we
+offset by u+4. +4 before, remember, we're using 4 bytes
+as variable space.
+
+At each iteration, we becomes wr-header and wr is fetched from
+PREV field. )

blk/131

@@ -0,0 +1,16 @@
+: RLDICT ( target offset -- )
+    H@ 2+ ! H@ ! ( H@+2 == offset, H@ == target )
+    H@ @ WORD( DUP H@ -^        ( src u )
+    DUP ROT SWAP H@ 4 +         ( u src u dst )
+    SWAP MOVE                   ( u )
+    4 + DUP CURRENT @ WORD( +   ( u we )
+    DUP .X CRLF
+    SWAP CURRENT @ PREV + DUP .X CRLF ( we wr )
+    BEGIN                       ( we wr )
+        DUP ROT                 ( wr wr we )
+        H@ @ H@ 2+ @            ( wr wr we ol o )
+        2SWAP RLWORD            ( wr )
+        DUP PREV SWAP           ( wr oldwr )
+        WORD( SWAP              ( we wr )
+        DUP 4 - H@ <= ( are we finished? )
+    UNTIL H@ 4 + .X CRLF ;

blk/132

@@ -0,0 +1,9 @@
+( Relink a regular Forth full interpreter. )
+: RLCORE
+    LIT< H@ (find) DROP         ( target )
+    DUP 3 - @                   ( t prevoff )
+    ( subtract H@ name length )
+    2-                          ( t o )
+    RLDICT
+;
+

blk/140

@@ -0,0 +1,10 @@
+Addressed devices
+
+Abstractions to read and write to devices that allow addressed
+access. At all times, we have one active "fetch" device and
+one active "store" device, A@ and A!.
+
+Those words have the same signature as C@ and C!, and in fact,
+initially default to proxy of those words.
+
+Load with "142 LOAD"

blk/142

@@ -0,0 +1 @@
+143 144 LOADR

blk/143

@@ -0,0 +1,15 @@
+: ADEVMEM+ 0x55 RAM+ @ + ;
+: A@* 0 ADEVMEM+ ;
+: A!* 2 ADEVMEM+ ;
+
+: ADEV$
+    H@ 0x55 RAM+ !
+    4 ALLOT
+    ['] C@ A@* !
+    ['] C! A!* !
+;
+
+: A@ A@* @ EXECUTE ;
+: A! A!* @ EXECUTE ;
+
+

blk/144

@@ -0,0 +1,11 @@
+( Same as MOVE, but with A@ and A! )
+( src dst u -- )
+: AMOVE
+    ( u ) 0 DO
+        SWAP DUP I + A@   ( dst src x )
+        ROT SWAP OVER I + ( src dst x dst )
+        A!                ( src dst )
+    LOOP
+    2DROP
+;
+

blk/150

@@ -0,0 +1,6 @@
+AT28 Driver
+
+Write to an AT28 EEPROM while making sure that proper timing
+is followed and verify data integrity.
+
+Load with "151 LOAD"

blk/151

@@ -1,9 +1,7 @@
 ( With dst being assumed to be an AT28 EEPROM, perform !
   operation while doing the right thing. Checks data integrity
-  and ABORT on mismatch.
+  and ABORT on mismatch. )
-)
+: AT28! ( n a -- )
-( n a -- )
-: AT28!
     2DUP C!
     ( as long as writing operation is running, IO/6 will toggle at each
       read attempt. We know that write is finished when we read the same

blk/357

@@ -1,14 +1 @@
-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

@@ -1,16 +1,13 @@
-: ACIA$
+0x20 CONSTANT ACIABUFSZ
-    H@ DUP DUP ACIA( ! ACIAR> !
+
-    1+ ACIAW> !  ( write index starts one position later )
+( Points to ACIA buf )
-    ACIABUFSZ ALLOT
+: ACIA( [ ACIA_MEM 4 + LITN ] ;
-    H@ ACIA) !
+( Points to ACIA buf end )
-( setup ACIA
+: ACIA) [ ACIA_MEM 6 + LITN ] ;
-  CR7 (1) - Receive Interrupt enabled
+( Read buf pointer. Pre-inc )
-  CR6:5 (00) - RTS low, transmit interrupt disabled.
+: ACIAR> [ ACIA_MEM LITN ] ;
-  CR4:2 (101) - 8 bits + 1 stop bit
+( Write buf pointer. Post-inc )
-  CR1:0 (10) - Counter divide: 64 )
+: ACIAW> [ ACIA_MEM 2 + LITN ] ;
-    0b10010110 ACIA_CTL PC!
+( This means that if W> == R>, buffer is full.
-( setup interrupt )
+  If R>+1 == W>, buffer is empty. )
-    0xc3 0x4e RAM+ C!  ( c3==JP, 4e==INTJUMP )
+
-    ['] ~ACIA 0x4f RAM+ !
-    (im1)
-;

blk/359

@@ -1,14 +1,16 @@
-: KEY
+: ACIA$
-    ( inc then fetch )
+    H@ DUP DUP ACIA( ! ACIAR> !
-    ACIAR> @ 1+ DUP ACIA) @ = IF
+    1+ ACIAW> !  ( write index starts one position later )
-        DROP ACIA( @
+    ACIABUFSZ ALLOT
-    THEN
+    H@ ACIA) !
-
+( setup ACIA
-    ( As long as R> == W>-1, it means that buffer is empty )
+  CR7 (1) - Receive Interrupt enabled
-    BEGIN DUP ACIAW> @ = NOT UNTIL
+  CR6:5 (00) - RTS low, transmit interrupt disabled.
-
+  CR4:2 (101) - 8 bits + 1 stop bit
-    ACIAR> !
+  CR1:0 (10) - Counter divide: 64 )
-    ACIAR> @ C@
+    0b10010110 ACIA_CTL PC!
+( setup interrupt )
+    0xc3 0x4e RAM+ C!  ( c3==JP, 4e==INTJUMP )
+    ['] ~ACIA 0x4f RAM+ !
+    (im1)
 ;
-
-

blk/360

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

drv/acia.fs

@@ -1,69 +0,0 @@
-( ACIA
-
-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.
-)
-
-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. )
-
-
-: 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 )
-    ( 4e == INTJUMP )
-    0xc3 0x4e RAM+ C!  ( JP upcode )
-    ['] ~ACIA 0x4f RAM+ !
-    (im1)
-;
-
-: 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@
-;
-
-: 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!
-;
-

drv/sdc.fs

@@ -1,215 +0,0 @@
-( -- 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
-;
-
-( -- )
-( 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 ;
-
-( 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
-;
-
-( 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 ;
-
-( 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   ( a2 crc h l )
-    ROT            ( a2 h l crc )
-    _s+crc         ( a2 h crc )
-    _s+crc         ( a2 crc )
-    SWAP 256 /MOD  ( crc h l )
-    ROT            ( h l crc )
-    _s+crc         ( h crc )
-    _s+crc         ( crc )
-    ( send CRC )
-    0x01 OR        ( ensure stop bit )
-    _sdcSR DROP
-    ( And now we just have to wait for a valid response... )
-    _wait
-;
-
-( 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 * ( r h )
-    _idle +     ( r arg1 )
-    _idle 256 * ( r arg1 h )
-    _idle +     ( r arg1 arg2 )
-    _sdcDesel
-;
-
-: _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
-        0b01000000 0 0  ( CMD0 )
-        SDCMDR1
-        DUP 0x01 = IF LEAVE THEN
-    LOOP
-    0x01 = NOT IF _err THEN
-
-    ( Then comes the CMD8. We send it with a 0x01aa argument
-      and expect a 0x01aa argument back, along with a 0x01 R1
-      response. )
-    0b01001000 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 )
-
-    ( 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
-        0b01110111 0 0  ( CMD55 )
-        SDCMDR1
-        0x01 = NOT IF _err THEN
-        0b01101001 0x4000 0x0000  ( CMD41 )
-        SDCMDR1
-        DUP 0x01 > IF _err THEN
-    NOT UNTIL
-    ( Out of idle mode! Success! )
-;
-
-( dstaddr blkno -- )
-: _sdc@
-    _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          ( crc a a )
-        _idle        ( crc a a n )
-        DUP ROT      ( crc a n n a )
-        C!           ( crc a n )
-        ROT SWAP     ( a crc n )
-        _crc16       ( a crc )
-        SWAP 1+      ( crc a+1 )
-    LOOP
-    DROP             ( crc1 )
-    _idle 256 *
-    _idle +          ( crc2 )
-    _wait DROP
-    _sdcDesel
-    = NOT IF _err THEN
-;
-
-: SDC@
-    2 * DUP BLK( SWAP    ( b a b )
-    _sdc@
-    1+ BLK( 512 + SWAP
-    _sdc@
-;
-
-( srcaddr blkno -- )
-: _sdc!
-    _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      ( lsb )
-    _sdcSR DROP
-    _wait DROP
-    _sdcDesel
-;
-
-: SDC!
-    2 * DUP BLK( SWAP    ( b a b )
-    _sdc!
-    1+ BLK( 512 + SWAP
-    _sdc!
-;

emul/.gitignore

@@ -3,6 +3,5 @@
 /stage2
 /forth
 /*-bin.h
-/core.bin
+/stage1.bin
-/forth?.bin
 /blkfs

forth/README.md

@@ -1,7 +0,0 @@
-# Forth
-
-**WIP** A Forth interpreter. Far from complete, but you can do stuff like
-
-    KEY EMIT KEY EMIT
-
-See dictionary.txt for a word reference.

forth/adev.fs

@@ -1,34 +0,0 @@
-( Addressed devices.
-
-Abstractions to read and write to devices that allow addressed
-access. At all times, we have one active "fetch" device and
-one active "store" device, A@ and A!.
-
-Those words have the same signature as C@ and C!, and in fact,
-initially default to proxy of those words.
-)
-
-: ADEVMEM+ 0x55 RAM+ @ + ;
-: A@* 0 ADEVMEM+ ;
-: A!* 2 ADEVMEM+ ;
-
-: ADEV$
-    H@ 0x55 RAM+ !
-    4 ALLOT
-    ['] C@ A@* !
-    ['] C! A!* !
-;
-
-: A@ A@* @ EXECUTE ;
-: A! A!* @ EXECUTE ;
-
-( Same as MOVE, but with A@ and A! )
-( src dst u -- )
-: AMOVE
-    ( u ) 0 DO
-        SWAP DUP I + A@   ( dst src x )
-        ROT SWAP OVER I + ( src dst x dst )
-        A!                ( src dst )
-    LOOP
-    2DROP
-;

forth/blk.fs

@@ -1,95 +0,0 @@
-( I/O blocks )
-
-: BLKMEM+ 0x57 RAM+ @ + ;
-( n -- Fetches block n and write it to BLK( )
-: BLK@* 0 BLKMEM+ ;
-( n -- Write back BLK( to storage at block n )
-: BLK!* 2 BLKMEM+ ;
-( Current blk pointer in ( )
-: BLK> 4 BLKMEM+ ;
-( Whether buffer is dirty )
-: BLKDTY 6 BLKMEM+ ;
-: BLK( 8 BLKMEM+ ;
-
-: BLK$
-    H@ 0x57 RAM+ !
-    ( 1024 for the block, 8 for variables )
-    1032 ALLOT
-    ( LOAD detects end of block with ASCII EOT. This is why
-      we write it there. EOT == 0x04 )
-    4 C,
-    0 BLKDTY !
-    -1 BLK> !
-;
-
-( -- )
-: BLK!
-    BLK> @ BLK!* @ EXECUTE
-    0 BLKDTY !
-;
-
-( n -- )
-: BLK@
-    DUP BLK> @ = IF DROP EXIT THEN
-    BLKDTY @ IF BLK! THEN
-    DUP BLK> ! BLK@* @ EXECUTE
-;
-
-: BLK!! 1 BLKDTY ! ;
-
-: .2 DUP 10 < IF SPC THEN . ;
-
-: LIST
-    BLK@
-    16 0 DO
-        I 1+ .2 SPC
-        64 I * BLK( + (print)
-        CRLF
-    LOOP
-;
-
-: _
-    (boot<)
-    DUP 4 = IF
-        ( We drop our char, but also "a" from WORD: it won't
-          have the opportunity to balance PSP because we're
-          EXIT!ing. )
-        2DROP
-        ( We're finished interpreting )
-        EXIT!
-    THEN
-;
-
-: LOAD
-    ( save restorable variables to RSP )
-    BLK> @ >R
-    0x08 RAM+ @ >R
-    0x06 RAM+ @ >R  ( C<? )
-    0x2e RAM+ @ >R  ( boot ptr )
-    BLK@
-    ( Point to beginning of BLK )
-    BLK( 0x2e RAM+ !
-    ( 08 == C<* override )
-    ['] _ 0x08 RAM+ !
-    ( While we interpret, don't print "ok" after every word )
-    1 0x06 RAM+ !  ( 06 == C<? )
-    INTERPRET
-    R> 0x2e RAM+ !
-    R> 0x06 RAM+ !
-    ( Before we restore C<* are we restoring it to "_"?
-      if yes, it means we're in a nested LOAD which means we
-      should also load back the saved BLK>. Otherwise, we can
-      ignore the BLK> from RSP. )
-    I 0x08 RAM+ @ = IF
-        ( nested load )
-        R> DROP ( C<* )
-        R> BLK@
-    ELSE
-        ( not nested )
-        R> 0x08 RAM+ !
-        R> DROP ( BLK> )
-    THEN
-;
-
-( b1 b2 -- )
-: LOADR 1+ SWAP DO I DUP . CRLF LOAD LOOP ;

forth/cmp.fs

@@ -1,42 +0,0 @@
-( Words useful for complex comparison operations )
-
-: >= < NOT ;
-: <= > NOT ;
-: 0>= 0< NOT ;
-
-( n1 -- n1 true )
-: <>{ 1 ;
-
-( n1 f -- f )
-: <>} SWAP DROP ;
-
-
-: _|&
-    ( n1 n2 cell )
-    >R >R DUP R> R>          ( n1 n1 n2 cell )
-    @ EXECUTE                ( n1 f )
-;
-
-( n1 f n2 -- n1 f )
-: _|
-    CREATE , DOES>
-    ( n1 f n2 cell )
-    ROT IF 2DROP 1 EXIT THEN ( n1 true )
-    _|&
-;
-
-: _&
-    CREATE , DOES>
-    ( n1 f n2 cell )
-    ROT NOT IF 2DROP 0 EXIT THEN ( n1 true )
-    _|&
-;
-
-( All words below have this signature:
-  n1 f n2 -- n1 f )
-' = _| |=
-' = _& &=
-' > _| |>
-' > _& &>
-' < _| |<
-' < _& &<

forth/core.fs

@@ -1,203 +0,0 @@
-: H@ HERE @ ;
-: IMMEDIATE
-    CURRENT @ 1-
-    DUP C@ 128 OR SWAP C!
-;
-: [ INTERPRET ; IMMEDIATE
-: ] R> DROP ;
-: LITS 34 , SCPY ;
-: LIT< WORD LITS ; IMMEDIATE
-: LITA 36 , , ;
-: '
-    WORD (find) (?br) [ 4 , ] EXIT
-    LIT< (wnf) (find) DROP EXECUTE
-;
-: ['] ' LITA ; IMMEDIATE
-: COMPILE ' LITA ['] , , ; IMMEDIATE
-: [COMPILE] ' , ; IMMEDIATE
-: BEGIN H@ ; IMMEDIATE
-: AGAIN COMPILE (br) H@ - , ; IMMEDIATE
-: UNTIL COMPILE (?br) H@ - , ; IMMEDIATE
-: _ BEGIN LIT< ) WORD S= UNTIL ; IMMEDIATE
-40 CURRENT @ 4 - C!
-( Hello, hello, krkrkrkr... do you hear me?
-  Ah, voice at last! Some lines above need comments
-  BTW: Forth lines limited to 64 cols because of default
-  input buffer size in Collapse OS
-
-  "_": words starting with "_" are meant to be "private",
-  that is, only used by their immediate surrondings.
-
-  40 is ASCII for '('. We do this to simplify XPACK's task of
-  not mistakenly consider '(' definition as a comment.
-  LITS: 34 == litWord
-  LITA: 36 == addrWord
-  COMPILE: Tough one. Get addr of caller word (example above
-  (br)) and then call LITA on it. )
-
-: +! SWAP OVER @ + SWAP ! ;
-: -^ SWAP - ;
-: ALLOT HERE +! ;
-
-: IF                ( -- a | a: br cell addr )
-    COMPILE (?br)
-    H@              ( push a )
-    2 ALLOT         ( br cell allot )
-; IMMEDIATE
-
-: THEN              ( a -- | a: br cell addr )
-    DUP H@ -^ SWAP   ( a-H a )
-    !
-; IMMEDIATE
-
-: ELSE              ( a1 -- a2 | a1: IF cell a2: ELSE cell )
-    COMPILE (br)
-    2 ALLOT
-    DUP H@ -^ SWAP  ( a-H a )
-    !
-    H@ 2-          ( push a. -2 for allot offset )
-; IMMEDIATE
-
-( During a CASE, the stack grows by 1 at each ENDOF so that
-  we can fill all those ENDOF branching addrs. So that we
-  know when to stop, we put a 0 on PSP. That's our stopgap. )
-: CASE 0 COMPILE >R ; IMMEDIATE
-: OF
-    COMPILE I COMPILE =
-    [COMPILE] IF
-; IMMEDIATE
-: ENDOF [COMPILE] ELSE ; IMMEDIATE
-
-( At this point, we have something like "0 e1 e2 e3 val". We
-  want top drop val, and then call THEN as long as we don't
-  hit 0. )
-: ENDCASE
-    BEGIN
-        DUP NOT IF
-            DROP COMPILE R> COMPILE DROP EXIT
-        THEN
-        [COMPILE] THEN
-    AGAIN
-; IMMEDIATE
-
-: CREATE
-    (entry)            ( empty header with name )
-    11                 ( 11 == cellWord )
-    C,                 ( write it )
-;
-
-( We run this when we're in an entry creation context. Many
-  things we need to do.
-  1. Change the code link to doesWord
-  2. Leave 2 bytes for regular cell variable.
-  3. Write down RS' RTOS to entry.
-  4. exit parent definition
-)
-: DOES>
-    ( Overwrite cellWord in CURRENT )
-    ( 43 == doesWord )
-    43 CURRENT @ C!
-    ( When we have a DOES>, we forcefully place HERE to 4
-      bytes after CURRENT. This allows a DOES word to use ","
-      and "C," without messing everything up. )
-    CURRENT @ 3 + HERE !
-    ( HERE points to where we should write R> )
-    R> ,
-    ( We're done. Because we've popped RS, we'll exit parent
-      definition )
-;
-
-: VARIABLE CREATE 2 ALLOT ;
-: CONSTANT CREATE , DOES> @ ;
-: / /MOD SWAP DROP ;
-: MOD /MOD DROP ;
-
-( In addition to pushing H@ this compiles 2 >R so that loop
-  variables are sent to PS at runtime )
-: DO
-    COMPILE SWAP COMPILE >R COMPILE >R
-    H@
-; IMMEDIATE
-
-( Increase loop counter and returns whether we should loop. )
-: _
-    R>          ( IP, keep for later )
-    R> 1+       ( ip i+1 )
-    DUP >R      ( ip i )
-    I' =        ( ip f )
-    SWAP >R     ( f )
-;
-
-( One could think that we should have a sub word to avoid all
-  these COMPILE, but we can't because otherwise it messes with
-  the RS )
-: LOOP
-    COMPILE _ COMPILE (?br)
-    H@ - ,
-    COMPILE R> COMPILE DROP COMPILE R> COMPILE DROP
-; IMMEDIATE
-
-: LEAVE R> R> DROP I 1- >R >R ;
-
-: ROLL
-    DUP NOT IF EXIT THEN
-    1+ DUP PICK          ( n val )
-    SWAP 2 * (roll)      ( val )
-    SWAP DROP
-;
-
-: 2DUP OVER OVER ;
-: 2OVER 3 PICK 3 PICK ;
-: 2SWAP 3 ROLL 3 ROLL ;
-
-( a1 a2 u -- )
-: MOVE
-    ( u ) 0 DO
-        SWAP DUP I + C@   ( a2 a1 x )
-        ROT SWAP OVER I + ( a1 a2 x a2 )
-        C!                ( a1 a2 )
-    LOOP
-    2DROP
-;
-
-: DELW
-    1- 0 SWAP C!
-;
-
-: PREV
-    3 - DUP @                   ( a o )
-    -                           ( a-o )
-;
-
-: WORD(
-    DUP 1- C@   ( name len field )
-    127 AND     ( 0x7f. remove IMMEDIATE flag )
-    3 +         ( fixed header len )
-    -
-;
-
-: FORGET
-    ' DUP               ( w w )
-    ( HERE must be at the end of prev's word, that is, at the
-      beginning of w. )
-    WORD( HERE !  ( w )
-    PREV CURRENT !
-;
-
-: EMPTY
-    LIT< _sys (find) NOT IF ABORT THEN
-    DUP HERE ! CURRENT !
-;
-
-( Drop RSP until I-2 == INTERPRET. )
-: EXIT!
-    ['] INTERPRET       ( I )
-    BEGIN               ( I )
-    DUP                 ( I I )
-    R> DROP I 2- @     ( I I a )
-    = UNTIL
-    DROP
-;
-
-( a -- a+1 c )
-: C@+ DUP C@ SWAP 1+ SWAP ;

forth/fmt.fs

@@ -1,73 +0,0 @@
-( requires core, parse, cmp )
-
-: _
-    999 SWAP        ( stop indicator )
-    DUP 0 = IF '0' EXIT THEN    ( 0 is a special case )
-    BEGIN
-    DUP 0 = IF DROP EXIT THEN
-    10 /MOD         ( r q )
-    SWAP '0' + SWAP ( d q )
-    AGAIN
-;
-
-: .               ( n -- )
-    ( handle negative )
-    DUP 0< IF '-' EMIT -1 * THEN
-    _
-    BEGIN
-    DUP '9' > IF DROP EXIT THEN  ( stop indicator, we're done )
-    EMIT
-    AGAIN
-;
-
-: ? @ . ;
-
-: _
-    DUP 9 > IF 10 - 'a' +
-    ELSE '0' + THEN
-;
-
-( For hex display, there are no negatives )
-
-: .x
-    256 MOD     ( ensure < 0x100 )
-    16 /MOD     ( l h )
-    _ EMIT      ( l )
-    _ EMIT
-;
-
-: .X
-    256 /MOD    ( l h )
-    .x .x
-;
-
-( a -- a+8 )
-: _
-    DUP         ( save for 2nd loop )
-    ':' EMIT DUP .x SPC
-    4 0 DO
-        DUP @
-        256 /MOD SWAP
-        .x .x
-        SPC
-        2+
-    LOOP
-    DROP
-    8 0 DO
-        C@+
-        DUP <>{ 0x20 &< 0x7e |> <>}
-        IF DROP '.' THEN
-        EMIT
-    LOOP
-    CRLF
-;
-
-( n a -- )
-: DUMP
-    LF
-    BEGIN
-        OVER 1 < IF 2DROP EXIT THEN
-        _
-        SWAP 8 - SWAP
-    AGAIN
-;

forth/link.fs

@@ -1,185 +0,0 @@
-( depends: cmp, parse
-  Relink a dictionary by applying offsets to all word
-  references in words of the "compiled" type.
-
-  A typical usage of this unit would be to, right after a
-  bootstrap-from-icore-from-source operation, identify the
-  root word of the source part, probably "H@", and run
-  " ' thatword RLDICT ". Then, take the resulting relinked
-  binary, concatenate it to the boot binary, and write to
-  boot media.
-
-  LIMITATIONS
-
-  This unit can't automatically detect all offsets needing
-  relinking. This is a list of situations that aren't handled:
-
-  Cells: It's not possible to know for sure whether a cellWord
-  contains an address or a number. They are therefore not
-  automatically relinked. You have to manually relink each of
-  them with RLCELL. In the case of a DOES> word, PFA+2, which
-  is always an offset, is automatically relinked, but not
-  PFA+0.
-)
-
-( Skip atom, considering special atom types. )
-( a -- a+n )
-: ASKIP
-    DUP @       ( a n )
-    ( ?br or br or NUMBER )
-    DUP <>{ 0x67 &= 0x53 |= 0x20 |= 0x24 |= <>}
-    IF DROP 4 + EXIT THEN
-    ( regular word )
-    0x22 = NOT IF 2+ EXIT THEN
-    ( it's a lit, skip to null char )
-    ( a )
-    1+  ( we skip by 2, but the loop below is pre-inc... )
-    BEGIN 1+ DUP C@ NOT UNTIL
-    ( skip null char )
-    1+
-;
-
-( Relink atom at a, applying offset o with limit ol.
-  Returns a, appropriately skipped.
-)
-( a o ol -- a+n )
-: RLATOM
-    ROT             ( o ol a )
-    DUP @           ( o ol a n )
-    DUP 0x24 = IF
-        ( 0x24 is an addrWord, which should be offsetted in
-          the same way that a regular word would. To achieve
-          this, we skip ASKIP and instead of skipping 4 bytes
-          like a numberWord, we skip only 2, which means that
-          our number will be treated like a regular wordref.
-        )
-        DROP
-        2+          ( o ol a+2 )
-        ROT ROT 2DROP  ( a )
-        EXIT
-    THEN
-    ROT             ( o a n ol )
-    < IF  ( under limit, do nothing )
-        SWAP DROP    ( a )
-    ELSE
-        ( o a )
-        SWAP OVER @  ( a o n )
-        -^           ( a n-o )
-        OVER !       ( a )
-    THEN
-    ASKIP
-;
-
-( Relink a word with specified offset. If it's not of the type
-  "compiled word", ignore. If it is, advance in word until a2
-  is met, and for each word that is above ol, reduce that
-  reference by o.
-  Arguments: a1: wordref a2: word end addr o: offset to apply
-             ol: offset limit. don't apply on refs under it.
-)
-( ol o a1 a2 -- )
-: RLWORD
-    SWAP DUP C@             ( ol o a2 a1 n )
-    ( 0e == compiledWord, 2b == doesWord )
-    DUP <>{ 0x0e &= 0x2b |= <>} NOT IF
-        ( unwind all args )
-        2DROP 2DROP
-        EXIT
-    THEN
-    ( we have a compiled word or doesWord, proceed )
-    ( doesWord is processed exactly like a compiledWord, but
-      starts 2 bytes further. )
-    ( ol o a2 a1 n )
-    0x2b = IF 2+ THEN
-    ( ol o a2 a1 )
-    1+                          ( ol o a2 a1+1 )
-    BEGIN                       ( ol o a2 a1 )
-        2OVER                   ( ol o a2 a1 ol o )
-        SWAP                    ( ol o a2 a1 o ol )
-        RLATOM                  ( ol o a2 a+n )
-        2DUP < IF ABORT THEN    ( Something is very wrong )
-        2DUP =                  ( ol o a2 a+n f )
-        IF
-            ( unwind )
-            2DROP 2DROP
-            EXIT
-        THEN
-    AGAIN
-;
-
-( TODO implement RLCELL )
-
-( Copy dict from target wordref, including header, up to HERE.
-  We're going relocate those words by specified offset. To do
-  this, we're copying this whole memory area in HERE and then
-  iterate through that copied area and call RLWORD on each
-  word. That results in a dict that can be concatenated to
-  target's prev entry in a more compact way.
-
-  This copy of data doesn't allocate anything, so H@ doesn't
-  move. Moreover, we reserve 4 bytes at H@ to write our target
-  and offset because otherwise, things get too complicated
-  with the PSP.
-
-  The output of this word is 3 numbers: top copied address,
-  top copied CURRENT, and then the beginning of the copied dict
-  at the end to indicate that we're finished processing.
-
-  Note that the last word is always skipped because it's not
-  possible to reliably detect its end. If you need that last
-  word, define a dummy word before calling RLDICT.
-)
-( target offset -- )
-: RLDICT
-    ( First of all, let's get our offset. It's easy, it's
-      target's prev field, which is already an offset, minus
-      its name length. We expect, in RLDICT that a target's
-      prev word is a "hook word", that is, an empty word. )
-    ( H@+2 == offset )
-    H@ 2+ !                     ( target )
-    ( H@ == target )
-    H@ !                        ( )
-    ( We have our offset, now let's copy our memory chunk )
-    H@ @ WORD(                  ( src )
-    DUP H@ -^                   ( src u )
-    DUP ROT SWAP                ( u src u )
-    H@ 4 +                      ( u src u dst )
-    SWAP                        ( u src dst u )
-    MOVE                        ( u )
-    ( Now, let's iterate that dict down )
-    ( wr == wordref we == word end )
-    ( To get our wr and we, we use H@ and CURRENT, which we
-      offset by u+4. +4 before, remember, we're using 4 bytes
-      as variable space. )
-    4 +                         ( u+4 )
-    DUP CURRENT @ WORD( +       ( u we )
-    DUP .X CRLF
-    SWAP CURRENT @ PREV +       ( we wr )
-    DUP .X CRLF
-    BEGIN                       ( we wr )
-        DUP ROT                 ( wr wr we )
-        ( call RLWORD. we need a sig: ol o wr we )
-        H@ @                    ( wr wr we ol )
-        H@ 2+ @                 ( wr wr we ol o )
-        2SWAP                   ( wr ol o wr we )
-        RLWORD                  ( wr )
-        ( wr becomes wr's prev and we is wr-header )
-        DUP                     ( wr wr )
-        PREV                    ( oldwr newwr )
-        SWAP                    ( wr oldwr )
-        WORD(                   ( wr we )
-        SWAP                    ( we wr )
-        ( Are we finished? We're finished if wr-4 <= H@ )
-        DUP 4 - H@ <=
-    UNTIL
-    H@ 4 + .X CRLF
-;
-
-( Relink a regular Forth full interpreter. )
-: RLCORE
-    LIT< H@ (find) DROP         ( target )
-    DUP 3 - @                   ( t prevoff )
-    ( subtract H@ name length )
-    2-                          ( t o )
-    RLDICT
-;

forth/parse.fs

@@ -1,76 +0,0 @@
-( requires core, str )
-( string being sent to parse routines are always null
-  terminated )
-
-: (parsec)          ( a -- n f )
-    ( apostrophe is ASCII 39 )
-    DUP C@ 39 = NOT IF 0 EXIT THEN      ( a 0 )
-    DUP 2+ C@ 39 = NOT IF 0 EXIT THEN   ( a 0 )
-    ( surrounded by apos, good, return )
-    1+ C@ 1                             ( n 1 )
-;
-
-( returns negative value on error )
-: _            ( c -- n )
-    ( '0' is ASCII 48 )
-    48 -
-    DUP 0< IF EXIT THEN                 ( bad )
-    DUP 10 < IF EXIT THEN               ( good )
-    ( 'a' is ASCII 97. 59 = 97 - 48 )
-    49 -
-    DUP 0< IF EXIT THEN                 ( bad )
-    DUP 6 < IF 10 + EXIT THEN           ( good )
-    ( bad )
-    255 -
-;
-
-: (parseh)          ( a -- n f )
-    ( '0': ASCII 0x30 'x': 0x78 0x7830: 30768 )
-    DUP @ 30768 = NOT IF 0 EXIT THEN    ( a 0 )
-    ( We have "0x" prefix )
-    2+
-    0  ( a r )
-    BEGIN
-    SWAP C@+                            ( r a+1 c )
-    DUP NOT IF 2DROP 1 EXIT THEN        ( r, 1 )
-    _                                   ( r a n )
-    DUP 0< IF ROT 2DROP 0 EXIT THEN     ( a 0 )
-    ROT 16 * +                          ( a r*16+n )
-    AGAIN
-;
-
-( returns negative value on error )
-: _            ( c -- n )
-    ( '0' is ASCII 48 )
-    48 -
-    DUP 0< IF EXIT THEN                 ( bad )
-    DUP 2 < IF EXIT THEN                ( good )
-    ( bad )
-    255 -
-;
-
-: (parseb)          ( a -- n f )
-    ( '0': ASCII 0x30 'b': 0x62 0x6230: 25136 )
-    DUP @ 25136 = NOT IF 0 EXIT THEN    ( a 0 )
-    ( We have "0b" prefix )
-    2+
-    0  ( a r )
-    BEGIN
-    SWAP C@+                               ( r a+1 c )
-    DUP NOT IF 2DROP 1 EXIT THEN           ( r 1 )
-    _                                      ( r a n )
-    DUP 0< IF ROT 2DROP 0 EXIT THEN        ( a 0 )
-    ROT 2 * +                              ( a r*2+n )
-    AGAIN
-;
-
-: (parse)           ( a -- n )
-    (parsec) IF EXIT THEN
-    (parseh) IF EXIT THEN
-    (parseb) IF EXIT THEN
-    (parsed) IF EXIT THEN
-    ( nothing works )
-    LIT< (wnf) (find) IF EXECUTE ELSE ABORT THEN
-;
-
-' (parse) (parse*) !

forth/print.fs

@@ -1,38 +0,0 @@
-( Words allowing printing strings. Require core )
-( This used to be in core, but some drivers providing EMIT
-  are much much easier to write with access to core words,
-  and these words below need EMIT... )
-
-: (print)
-    BEGIN
-    C@+      ( a+1 c )
-    ( exit if null )
-    DUP NOT IF 2DROP EXIT THEN
-    EMIT     ( a )
-    AGAIN
-;
-
-: ,"
-    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" ;
-
-: BS 8 EMIT ;
-: LF 10 EMIT ;
-: CR 13 EMIT ;
-: CRLF CR LF ;
-: SPC 32 EMIT ;
-
-: (wnf) (print) SPC ABORT" word not found" ;
-: (ok) SPC ." ok" CRLF ;

forth/readln.fs

@@ -1,87 +0,0 @@
-( requires core, parse, print )
-
-( Managing variables in a core module is tricky. Sure, we
-  have (sysv), but here we need to allocate a big buffer, and
-  that cannot be done through (sysv). What we do is that we
-  allocate that buffer at runtime and use (sysv) to point to
-  it, a pointer that is set during the initialization
-  routine. )
-
-64 CONSTANT INBUFSZ
-: RDLNMEM+ 0x53 RAM+ @ + ;
-( current position in INBUF )
-: IN> 0 RDLNMEM+ ;
-( points to INBUF )
-: IN( 2 RDLNMEM+ ;
-( points to INBUF's end )
-: IN) INBUFSZ 2+ RDLNMEM+ ;
-
-( flush input buffer )
-( set IN> to IN( and set IN> @ to null )
-: (infl) 0 IN( DUP IN> ! ! ;
-
-( handle backspace: go back one char in IN>, if possible, then
-  emit SPC + BS )
-: (inbs)
-    ( already at IN( ? )
-    IN> @ IN( = IF EXIT THEN
-    IN> @ 1- IN> !
-    SPC BS
-;
-
-( read one char into input buffer and returns whether we
-  should continue, that is, whether CR was not met. )
-: (rdlnc)                   ( -- f )
-    ( buffer overflow? same as if we typed a newline )
-    IN> @ IN) = IF 0x0a ELSE KEY THEN     ( c )
-    ( del? same as backspace )
-    DUP 0x7f = IF DROP 0x8 THEN
-    ( lf? same as cr )
-    DUP 0x0a = IF DROP 0xd THEN
-    ( echo back )
-    DUP EMIT                    ( c )
-    ( bacspace? handle and exit )
-    DUP 0x8 = IF (inbs) EXIT THEN
-    ( write and advance )
-    DUP     ( keep as result )  ( c c )
-    ( Here, we take advantage of the fact that c's MSB is
-      always zero and thus ! automatically null-terminates
-      our string )
-    IN> @ ! 1 IN> +!            ( c )
-    ( if newline, replace with zero to indicate EOL )
-    DUP 0xd = IF DROP 0 THEN
-;
-
-( Read one line in input buffer and make IN> point to it )
-: (rdln)
-    (infl)
-    BEGIN (rdlnc) NOT UNTIL
-    LF IN( IN> !
-;
-
-( And finally, implement C<* )
-: RDLN<
-    IN> @ C@
-    DUP IF
-        ( not EOL? good, inc and return )
-        1 IN> +!
-    ELSE
-        ( EOL ? readline. we still return null though )
-        (rdln)
-    THEN
-    ( update C<? flag )
-    IN> @ C@ 0 > 0x06 RAM+ !  ( 06 == C<? )
-;
-
-( Initializes the readln subsystem )
-: RDLN$
-    ( 53 == rdln's memory )
-    H@ 0x53 RAM+ !
-    ( 2 for IN>, plus 2 for extra bytes after buffer: 1 for
-      the last typed 0x0a and one for the following NULL. )
-    INBUFSZ 4 + ALLOT
-    (infl)
-    ['] RDLN< 0x0c RAM+ !
-    1 0x06 RAM+ !  ( 06 == C<? )
-;
-

recipes/rc2014/Makefile

@@ -5,24 +5,9 @@ EDIR = $(BASEDIR)/emul
 STAGE2 = $(EDIR)/stage2
 EMUL = $(BASEDIR)/emul/hw/rc2014/classic
 
-PATHS = \
-	$(FDIR)/core.fs \
-	$(FDIR)/cmp.fs \
-	$(FDIR)/parse.fs \
-	$(BASEDIR)/drv/acia.fs \
-	$(FDIR)/print.fs \
-	$(FDIR)/fmt.fs \
-	$(FDIR)/link.fs \
-	run.fs
-STRIPFC = $(BASEDIR)/tools/stripfc
-
 .PHONY: all
 all: $(TARGET) 
-$(TARGET): z80c.bin $(PATHS)
+$(TARGET): xcomp.fs $(STAGE2)
-	cp z80c.bin $@
-	cat $(PATHS) | $(STRIPFC) >> $@
-
-z80c.bin: xcomp.fs
 	cat xcomp.fs | $(STAGE2) > $@
 
 $(SLATEST):

recipes/rc2014/README.md

@@ -64,12 +64,10 @@ We could have this recipe automate that 2 stage build process all automatically,
 but that would rob you of all your fun, right? Instead, we'll run that 2nd
 stage on the RC2014 itself!
 
-To build your stage 1, run `make` in this folder, this will yield `os.bin`.
+To build your stage 1, run `make` in this folder, this will yield `stage1.bin`.
 This will contain that tiny core and, appended to it, the Forth source code it
 needs to run to bootstrap itself. When it's finished bootstrapping, you will
-get a prompt to an almost-full Forth interpreter (there's not enough space in
+get a prompt to a full Forth interpreter.
-8K to fit both link.fs and readln.fs, so we ditch readln. Our prompt is raw. No
-backspace no buffer. Hardcore mode.)
 
 ### Emulate
 
@@ -122,15 +120,18 @@ Our stage 1 prompt is the result of Forth's inner core interpreting the source
 code of the Full Forth, which was appended to the binary inner core in ROM.
 This results in a compiled dictionary, in RAM, at address 0x8000+system RAM.
 
+Wouldn't it be great if we could save that compiled binary in ROM and save the
+system the trouble of recompiling itself on boot?
+
 Unfortunately, this compiled dictionary isn't usable as-is. Offsets compiled in
 there are compiled based on a 0x8000-or-so base offset. What we need is a
 0xa00-or-so base offset, that is, something suitable to be appended to the boot
 binary, in ROM, in binary form.
 
-Fortunately, inside the compiled source is the contents of link.fs which will
+Fortunately, inside the compiled source is the contents of the Linker (B120)
-allow us to relink our compiled dictionary so that in can be relocated in ROM,
+which will allow us to relink our compiled dictionary so that in can be
-next to our boot binary. I won't go into relinking details. Look at the source.
+relocated in ROM, next to our boot binary. I won't go into relinking details.
-For now, let's just use it:
+Look at the source.  For now, let's just use it:
 
     RLCORE
 
@@ -182,9 +183,15 @@ So, the end of our compiled dict is actually `99de`. Alright, let's extract it:
     dd if=memdump bs=1 skip=36192 count=3198 > dict.bin
 
 `36192` is `8d60` and `3198` is `99de-8d60`. This needs to be prepended by the
-boot binary. But that one, we already have. It's `z80c.bin`
+boot binary. We already have `stage1.bin`, but this binary contains bootstrap
+source code we don't need any more. To strip it, we'll need to `dd` it out to
+`LATEST`, in my case `098b`:
 
-    cat z80c.bin dict.bin > stage2.bin
+    dd if=stage1.bin bs=1 count=2443 > s1pre.bin
+
+Now we can combine our binaries:
+
+    cat s1pre.bin dict.bin > stage2.bin
 
 Is it ready to run yet? no. There are 3 adjustments we need to manually make
 using our hex editor.
@@ -202,7 +209,12 @@ using our hex editor.
 
 Now are we ready yet? ALMOST! There's one last thing we need to do: add runtime
 source. In our case, because we have a compiled dict, the only source we need
-to include is `run.fs`:
+to include is initialization code. We've stripped it from our stage1 earlier,
+we need to re-add it.
+
+Look at `xcomp.fs`. You see that `," bla bla bla"` line? That's initialization
+code. Copy it to a file like `run.fs` (without the `,"`) and build your final
+binary:
 
     cat stage2.bin run.fs > stage2r.bin
 
@@ -212,48 +224,6 @@ That's it! our binary is ready to run!
 
 And there you have it, a stage2 binary that you've assembled yourself.
 
-### Assembling stage 3
-
-Stage 2 gives you a useable prompt, but bare. Because 8K isn't a lot of space
-to cram source code, we're limited in what we can include for this stage.
-
-However, now that we have a usable prompt, we can do a lot (be cautious though:
-there is no `readln` yet, so you have no backspace), for example, build a
-stage 3 with `readln`.
-
-Copy the unit's source
-
-    cat ../../forth/readln.fs | ../../tools/stripfc | xclip
-
-and just paste it in your terminal. If you're doing the real thing and not
-using the emulator, pasting so much code at once might freeze up the RC2014, so
-it is recommended that you use `/tools/exec` that let the other side enough
-time to breathe.
-
-After your pasting, you'll have a compiled dict of that code in memory. You'll
-need to relocate it in the same way you did for stage 2, but instead of using
-`RLCORE`, which is a convenience word hardcoded for stage 1, we'll parametrize
-`RLDICT`, the word doing the real work.
-
-`RLDICT` takes 2 arguments, `target` and `offset`. `target` is the first word
-of your relocated dict. In our case, it's going to be `' INBUFSZ`. `offset` is
-the offset we'll apply to every eligible word references in our dict. In our
-case, that offset is the offset of the *beginning* of the `INBUFSZ` entry (that
-is, `' INBUFSZ WORD(` minus the offset of the last word (which should be a hook
-word) in the ROM binary.
-
-That offset can be conveniently fetched from code because it is the value of
-the `LATEST` constant in stable ABI, which is at offset `0x08`. Therefore, our
-offset value is:
-
-    ' INBUFSZ WORD( 0x08 @ -
-
-You can now run `RLDICT` and proceed with concatenation (and manual adjustments
-of course) as you did with stage 2. Don't forget to adjust `run.fs` so that it
-initializes `RDLN$` instead of creating a minimal `(c<)`.
-
-Keep that `stage3.bin` around, you will need it for further recipes.
-
 [rc2014]: https://rc2014.co.uk
 [romwrite]: https://github.com/hsoft/romwrite
 [stage2]: ../../emul

recipes/rc2014/eeprom/README.md

@@ -8,7 +8,7 @@ itself.
 ## Gathering parts
 
 * A RC2014 Classic
-* `stage3.bin` from the base recipe
+* `stage2.bin` from the base recipe
 * An extra AT28C64B
 * 1x 40106 inverter gates
 * Proto board, RC2014 header pins, wires, IC sockets, etc.
@@ -33,11 +33,46 @@ in write protection mode, but I preferred building my own module.
 
 I don't think you need a schematic. It's really simple.
 
-## Building your stage 4
+### Assembling stage 3
 
-Using the same technique as you used for building your stage 3, you can append
+Stage 2 gives you a full interpreter, but it's missing the "Addressed devices"
-required words to your boot binary. Required units are `forth/adev.fs` and
+module and the AT28 driver. We'll need to assemble a stage 3.
-`drv/at28.fs`.
+
+When you'll have a system with function disk block system, you'll be able to
+directly `LOAD` them, but for this recipe, we can't assume you have, so what
+you'll have to do is to manually paste the code from the appropriate blocks.
+
+Addressed devices are at B140. To know what you have to paste, open the loader
+block (B142) and see what blocks it loads. For each of the blocks, copy/paste
+the code in your interpreter.
+
+Do the same thing with the AT28 driver (B150)
+
+If you're doing the real thing and not using the emulator, pasting so much code
+at once might freeze up the RC2014, so it is recommended that you use
+`/tools/exec` that let the other side enough time to breathe.
+
+After your pasting, you'll have a compiled dict of that code in memory. You'll
+need to relocate it in the same way you did for stage 2, but instead of using
+`RLCORE`, which is a convenience word hardcoded for stage 1, we'll parametrize
+`RLDICT`, the word doing the real work.
+
+`RLDICT` takes 2 arguments, `target` and `offset`. `target` is the first word
+of your relocated dict. In our case, it's going to be `' ADEVMEM+`. `offset` is
+the offset we'll apply to every eligible word references in our dict. In our
+case, that offset is the offset of the *beginning* of the `ADEVMEM+` entry (that
+is, `' ADEVMEM+ WORD(` minus the offset of the last word (which should be a hook
+word) in the ROM binary.
+
+That offset can be conveniently fetched from code because it is the value of
+the `LATEST` constant in stable ABI, which is at offset `0x08`. Therefore, our
+offset value is:
+
+    ' ADEVMEM+ WORD( 0x08 @ -
+
+You can now run `RLDICT` and proceed with concatenation (and manual adjustments
+of course) as you did with stage 2. Don't forget to adjust `run.fs` so that it
+runs `ADEV$`.
 
 ## Writing contents to the AT28
 

recipes/rc2014/run.fs

@@ -1,2 +0,0 @@
-: x KEY DUP EMIT ;
-: _ ACIA$ (ok) ['] x 0x0c RAM+ ! ; _

recipes/rc2014/sdcard/README.md

@@ -19,7 +19,7 @@ design.
 ## Gathering parts
 
 * A RC2014 Classic
-* `stage3.bin` from the base recipe
+* `stage2.bin` from the base recipe
 * A MicroSD breakout board. I use Adafruit's.
 * A proto board + header pins with 39 positions so we can make a RC2014 card.
 * Diodes, resistors and stuff
@@ -69,20 +69,20 @@ matter. However, it *does* matter for the `SELECT` line, so I don't follow my
 own schematic with regards to the `M1` and `A2` lines and use two inverters
 instead.
 
-## Building your stage 4
+## Building your stage 3
 
-Using the same technique as you used for building your stage 3, you can append
+Using the same technique as you used in the `eeprom` recipe, you can append
-required words to your boot binary. Required units are `forth/blk.fs` and
+required words to your boot binary. Required units `blk` (B464) and the SD Card
-`drv/sdc.fs`. You also need `drv/sdc.z80` but to save you the troubles of
+driver (B370). You only need the Forth part. You of course actually need
-rebuilding from stage 1 for this recipe, we took the liberty of already having
+Z80 SDC words but to save you the troubles of rebuilding from stage 1 for this
-included it in the base recipe.
+recipe, we took the liberty of already having included it in the base recipe.
 
 ## Testing in the emulator
 
 The RC2014 emulator includes SDC emulation. You can attach a SD card image to
 it by invoking it with a second argument:
 
-    ../../../emul/hw/rc2014/classic stage4.bin ../../../emul/blkfs
+    ../../../emul/hw/rc2014/classic stage3.bin ../../../emul/blkfs
 
 You will then run with a SD card having the contents from `/blk`.
 

recipes/rc2014/selfhost/README.md

@@ -6,31 +6,60 @@ either for another RC2014 or for an OS upgrade.
 
 ## Gathering parts
 
-* stage4 from `sdcard` recipe. If you want to write to EEPROM as the final step,
+* stage3 from `sdcard` recipe. If you want to write to EEPROM as the final step,
-  you'll need a hybrid stage4 that also includes stuff from the `eeprom` recipe.
+  you'll need a hybrid stage3 that also includes stuff from the `eeprom` recipe.
 
 ## Building stage 1
 
-### Part 1
+Build Collapse OS' stage 1 from within Collapse OS is very similar to how we do
-
+it from the makefile. If you take the time to look at the base recipe
-Building the first part of stage 1 (the binary part, before the inlined-source
+`Makefile`, you'll see `cat xcomp.fs | $(STAGE2)`. That's the thing.  Open
-part) from within Collapse OS is actually very similar from building it from a
-modern environment. If you take the time to look at the base recipe `Makefile`,
-you'll see `cat xcomp.fs | $(STAGE2)`. That command builds part 1. Open
 `xcomp.fs` in a text editor and take a look at it.
 
 To assemble stage 1 from RC2014, all you need to do is to type those commands
 in the same order, and replace the `H@ 256 /MOD 2 PC! 2 PC!` lines with `H@ .X`.
 Those commands will inform you of the begin/end offsets of the assembled binary.
 
-The meaning of these commands is not explained here. You are encouraged to read
+I'm not going to explain in detail what each command do, but only give you an
-the in-system documentation for more information.
+overview of what is happening.  You are encouraged to read the in-system
+documentation for more information.
 
-However, one thing you should know is that because the SD card driver is a bit
+The first part is configuration of your new system. When RAM starts, where RSP
-slow, some of these commands take a long time. Multiple minutes. Be patient.
+starts, what ports to use for what device, etc. These configuration declarations
+are expected in the boot code and driver code.
+
+Then, we load the Z80 assembler and the cross compiler (xcomp for short), which
+we'll of course need for the task ahead.
+
+Then come xcomp overrides, which are needed for xcomp to be effective.
+
+At this point, we're about to begin spitting binary content, so we want to know
+where we're at. That's why you'll need to type `H@ .X` and write down the
+result. That's the starting offset.
+
+Then, we assemble the boot binary, drivers' native words, then inner core,
+close the binary with a hook word. We're finished with cross-compiling.
+
+We're at the offset that will be `CURRENT` on boot, so we update `LATEST`.
+
+Then, we spit the course code that will be interpreted by stage 1 on boot so
+that it bootstraps itself to a full interpreter. Not all units are there
+because they don't fit in 8K, but they're sufficient for our needs. We also
+need the linker so that we can relink ourselves to stage 2.
+
+Finally, we have initialization code, then a spit of the ending offset.
+
+Go ahead, run that.  However, one thing you should know is that because the SD
+card driver is a bit slow, some of these commands take a long time. Multiple
+minutes. Be patient.
 
 Once all your commands are run and that you have your begin/end offset (write
-them down somewhere), you're ready to assemble part 2.
+them down somewhere), you're at the same point as you were after the `make`
+part of the base recipe. The contents between your start and end offset is the
+exact same as the contents of `stage1.bin` when you run `make`. Continue your
+deployment from there.
+
+Good luck!
 
 ### What to do on SDerr?
 
@@ -48,7 +77,3 @@ You're looking at the offset of the last wordref of the *previous* LOAD
 operation. That offset is going in `XCURRENT`. Then, you're looking at the end
 of that word. That offset goes in `HERE`. Once you've done that, relaunch your
 LOAD.
-
-### Part 2
-
-TODO

recipes/rc2014/xcomp.fs

@@ -24,4 +24,11 @@ H@ XOFF !
 (entry) _
 ( Update LATEST )
 H@ XOFF @ - XOFF @ 8 + !
+422 441 XPACKR ( core cmp )
+446 452 XPACKR ( parse )
+358 360 XPACKR ( acia.fs )
+442 445 XPACKR ( print )
+453 463 XPACKR ( readln fmt )
+123 132 XPACKR ( linker )
+," : _ ACIA$ RDLN$ (ok) ; _ "
 H@ 256 /MOD 2 PC! 2 PC!

tools/Makefile

@@ -4,13 +4,12 @@ UPLOAD_TGT = upload
 FONTCOMPILE_TGT = fontcompile
 TTYSAFE_TGT = ttysafe
 PINGPONG_TGT = pingpong
-STRIPFC_TGT = stripfc
 BIN2C_TGT = bin2c
 EXEC_TGT = exec
 BLKPACK_TGT = blkpack
 BLKUNPACK_TGT = blkunpack
 TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
-	$(TTYSAFE_TGT) $(PINGPONG_TGT) $(STRIPFC_TGT) \
+	$(TTYSAFE_TGT) $(PINGPONG_TGT) \
 	$(BIN2C_TGT) $(EXEC_TGT) $(BLKPACK_TGT) $(BLKUNPACK_TGT)
 OBJS = common.o
 
@@ -26,7 +25,6 @@ $(UPLOAD_TGT): $(UPLOAD_TGT).c
 $(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
 $(TTYSAFE_TGT): $(TTYSAFE_TGT).c
 $(PINGPONG_TGT): $(PINGPONG_TGT).c
-$(STRIPFC_TGT): $(STRIPFC_TGT).c
 $(BIN2C_TGT): $(BIN2C_TGT).c
 $(EXEC_TGT): $(EXEC_TGT).c
 $(BLKPACK_TGT): $(BLKPACK_TGT).c

tools/stripfc.c

@@ -1,57 +0,0 @@
-#include <stdio.h>
-
-/* read stdin and strip Forth-style comments before spitting in stdout. This
-also deduplicate spaces and newlines.
-
-THIS PARSING IS IMPERFECT. Only a Forth interpreter can reliably detect
-comments. For example, a naive parser misinterprets the "(" word definition as
-a comment.
-
-We work around this by considering as a comment opener only "(" chars preceeded
-by more than once space or by a newline. Hackish, but works.
-*/
-
-int main()
-{
-    int spccnt = 1; // if the first char is a (, consider it a comment opener.
-    int incomment = 0;
-    int c;
-    c = getchar();
-    while ( c != EOF ) {
-        if (c == '\n') {
-            if (!incomment) {
-                // We still spit newlines whenever we see them, Forth interpreter
-                // doesn't like when they're not there...
-                putchar(c);
-            }
-            spccnt += 1;
-        } else if (c == ' ') {
-            spccnt++;
-        } else {
-            if (incomment) {
-                if ((c == ')') && spccnt) {
-                    incomment = 0;
-                }
-            } else {
-                if ((c == '(') && spccnt) {
-                    putchar(' ');
-                    spccnt = 0;
-                    int next = getchar();
-                    if (next <= ' ') {
-                        incomment = 1;
-                        continue;
-                    }
-                    putchar(c);
-                    c = next;
-                }
-                if (spccnt) {
-                    putchar(' ');
-                }
-                putchar(c);
-            }
-            spccnt = 0;
-        }
-        c = getchar();
-    }
-    return 0;
-}