blk/001

@@ -2,7 +2,7 @@ MASTER INDEX
 
   3 Usage                      30 Dictionary
  70 Implementation notes      100 Block editor
-150 Extra words
+120 Linker                    150 Extra words
 200 Z80 assembler             260 Cross compilation
 280 Z80 boot code             350 Core words
 410 PS/2 keyboard subsystem   420 Bootstrap guide

blk/058

@@ -5,6 +5,9 @@ LIT    --         Write a LIT entry. You're expected to write
 LIT< x --         Read following word and write to HERE as a
                   string literal.
 S=     a1 a2 -- f Returns whether string a1 == a2.
+SCPY   a --       Copy string at addr a into HERE, without
+                  NULL termination.
+
 
 
 

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 @@
+1 9 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 = OVER 0x53 = OR OVER 0x20 = OR OVER 0x24 = OR
+    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 )
+        NIP          ( a )
+    ELSE ( o a )
+        TUCK @       ( 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 = OVER 0x2b = OR 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/129

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

@@ -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 NL
+    SWAP CURRENT @ PREV + DUP .X NL ( 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 NL ;

blk/262

@@ -1 +1 @@
-1 LOAD+ 3 LOAD+ 6 LOAD+ 
+1 LOAD+ 3 LOAD+ 6 LOAD+ 7 LOAD+

blk/267

@@ -0,0 +1,6 @@
+XPACK - pack source code
+
+The goal of this word is to pack source code in tight places,
+such as on the boot section of an EEPROM. It takes a block
+number, reads it and packs it to HERE. It normalizes all
+whitespaces to a single space and ignore comments.

blk/268

@@ -0,0 +1,16 @@
+: XPACK ( blkno -- )
+    BLK@
+    BLK( 0x2e RAM+ ! ( boot ptr )
+    ['] (boot<) 0x08 RAM+ ! ( C<* override )
+    BEGIN
+        WORD
+        0x2e RAM+ @ BLK( 1024 + < IF
+            DUP LIT< ( S= IF
+                DROP [COMPILE] (
+            ELSE
+                SCPY 0x20 C,
+            THEN 0 ( loop again )
+        ELSE 1 ( stop looping ) THEN
+    UNTIL
+    0 0x08 RAM+ !
+;

blk/269

@@ -0,0 +1,3 @@
+( b1 b2 -- )
+: XPACKR 1+ SWAP DO I DUP . NL XPACK LOOP ;
+

blk/367

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

blk/368

@@ -1,7 +1,5 @@
-: +! TUCK @ + SWAP ! ;
 : [entry] ( w -- )
-    H@ SWAP
+    H@ SWAP SCPY  ( h )
-    BEGIN C@+ ( w+1 c ) ?DUP IF C, 0 ELSE 1 THEN UNTIL DROP
     H@ SWAP - ( sz )
     ( write prev value )
     H@ CURRENT @ - ,

blk/369

@@ -1,7 +1,11 @@
+( Words here until the end of the low part, unlike words
+  preceeding them, aren't immediately needed for boot. But its
+  better to have as many words as possible in the xcomp part. )
 : IMMEDIATE
     CURRENT @ 1-
     DUP C@ 128 OR SWAP C! ;
 : IMMED? 1- C@ 0x80 AND ;
+: +! TUCK @ + SWAP ! ;
 : -^ SWAP - ;
 : / /MOD NIP ;
 : MOD /MOD DROP ;

blk/399

@@ -1,9 +1,9 @@
-: LIT< WORD 34 , BEGIN C@+ DUP C, NOT UNTIL DROP ; IMMEDIATE
 : BEGIN H@ ; IMMEDIATE
 : AGAIN COMPILE (br) H@ - _bchk , ; IMMEDIATE
 : UNTIL COMPILE (?br) H@ - _bchk , ; IMMEDIATE
 : [ INTERPRET ; IMMEDIATE
 : ] R> DROP ;
+: LIT< WORD 34 , SCPY 0 C, ; IMMEDIATE
 : LITA 36 , , ;
 : COMPILE ' LITA ['] , , ; IMMEDIATE
 : [COMPILE] ' , ; IMMEDIATE