Move link.fs to blkfs

blk/001

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

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
+;
+

emul/.gitignore

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

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
-;

recipes/rc2014/Makefile

@@ -5,16 +5,9 @@ EDIR = $(BASEDIR)/emul
 STAGE2 = $(EDIR)/stage2
 EMUL = $(BASEDIR)/emul/hw/rc2014/classic
 
-PATHS = $(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/run.fs

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

recipes/rc2014/xcomp.fs

@@ -29,4 +29,7 @@ H@ XOFF @ - XOFF @ 8 + !
 358 360 XPACKR ( acia.fs )
 442 445 XPACKR ( print )
 459 463 XPACKR ( fmt )
+123 132 XPACKR ( linker )
+," : x KEY DUP EMIT ; "
+," : _ ACIA$ (ok) ['] x 0x0c RAM+ ! ; _ "
 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;
-}