From dee7eea4973ac20444b3c978b7cfb8f77363db7f Mon Sep 17 00:00:00 2001 From: Virgil Dupras Date: Sun, 26 Apr 2020 14:37:54 -0400 Subject: [PATCH] Move link.fs to blkfs --- blk/001 | 1 + blk/120 | 16 ++++ blk/121 | 8 ++ blk/122 | 1 + blk/123 | 15 ++++ blk/124 | 11 +++ blk/125 | 16 ++++ blk/126 | 15 ++++ blk/127 | 16 ++++ blk/128 | 16 ++++ blk/130 | 16 ++++ blk/131 | 16 ++++ blk/132 | 9 ++ emul/.gitignore | 3 +- forth/link.fs | 185 ---------------------------------------- recipes/rc2014/Makefile | 9 +- recipes/rc2014/run.fs | 2 - recipes/rc2014/xcomp.fs | 3 + tools/Makefile | 4 +- tools/stripfc.c | 57 ------------- 20 files changed, 162 insertions(+), 257 deletions(-) create mode 100644 blk/120 create mode 100644 blk/121 create mode 100644 blk/122 create mode 100644 blk/123 create mode 100644 blk/124 create mode 100644 blk/125 create mode 100644 blk/126 create mode 100644 blk/127 create mode 100644 blk/128 create mode 100644 blk/130 create mode 100644 blk/131 create mode 100644 blk/132 delete mode 100644 forth/link.fs delete mode 100644 recipes/rc2014/run.fs delete mode 100644 tools/stripfc.c diff --git a/blk/001 b/blk/001 index 36ec4a4..8e9b1de 100644 --- a/blk/001 +++ b/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 diff --git a/blk/120 b/blk/120 new file mode 100644 index 0000000..a58afe2 --- /dev/null +++ b/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.) diff --git a/blk/121 b/blk/121 new file mode 100644 index 0000000..7d63ca2 --- /dev/null +++ b/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" diff --git a/blk/122 b/blk/122 new file mode 100644 index 0000000..72ede88 --- /dev/null +++ b/blk/122 @@ -0,0 +1 @@ +123 132 LOADR diff --git a/blk/123 b/blk/123 new file mode 100644 index 0000000..9c27211 --- /dev/null +++ b/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+ +; diff --git a/blk/124 b/blk/124 new file mode 100644 index 0000000..1e7b618 --- /dev/null +++ b/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. ) + diff --git a/blk/125 b/blk/125 new file mode 100644 index 0000000..7a2e7d2 --- /dev/null +++ b/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 ; diff --git a/blk/126 b/blk/126 new file mode 100644 index 0000000..2bce355 --- /dev/null +++ b/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. +) + diff --git a/blk/127 b/blk/127 new file mode 100644 index 0000000..d343e58 --- /dev/null +++ b/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 +; diff --git a/blk/128 b/blk/128 new file mode 100644 index 0000000..bb1fb90 --- /dev/null +++ b/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. ) diff --git a/blk/130 b/blk/130 new file mode 100644 index 0000000..8ab643b --- /dev/null +++ b/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. ) diff --git a/blk/131 b/blk/131 new file mode 100644 index 0000000..8689095 --- /dev/null +++ b/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 ; diff --git a/blk/132 b/blk/132 new file mode 100644 index 0000000..2e4efdd --- /dev/null +++ b/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 +; + diff --git a/emul/.gitignore b/emul/.gitignore index 026de97..ae9e1d9 100644 --- a/emul/.gitignore +++ b/emul/.gitignore @@ -3,6 +3,5 @@ /stage2 /forth /*-bin.h -/core.bin -/forth?.bin +/stage1.bin /blkfs diff --git a/forth/link.fs b/forth/link.fs deleted file mode 100644 index e13fa8d..0000000 --- a/forth/link.fs +++ /dev/null @@ -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 -; diff --git a/recipes/rc2014/Makefile b/recipes/rc2014/Makefile index 8846423..a0592f0 100644 --- a/recipes/rc2014/Makefile +++ b/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) - cp z80c.bin $@ - cat $(PATHS) | $(STRIPFC) >> $@ - -z80c.bin: xcomp.fs +$(TARGET): xcomp.fs $(STAGE2) cat xcomp.fs | $(STAGE2) > $@ $(SLATEST): diff --git a/recipes/rc2014/run.fs b/recipes/rc2014/run.fs deleted file mode 100644 index 66dfe6a..0000000 --- a/recipes/rc2014/run.fs +++ /dev/null @@ -1,2 +0,0 @@ -: x KEY DUP EMIT ; -: _ ACIA$ (ok) ['] x 0x0c RAM+ ! ; _ diff --git a/recipes/rc2014/xcomp.fs b/recipes/rc2014/xcomp.fs index 6618429..47041d2 100644 --- a/recipes/rc2014/xcomp.fs +++ b/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! diff --git a/tools/Makefile b/tools/Makefile index 96609a5..69a0d59 100644 --- a/tools/Makefile +++ b/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 diff --git a/tools/stripfc.c b/tools/stripfc.c deleted file mode 100644 index e994de5..0000000 --- a/tools/stripfc.c +++ /dev/null @@ -1,57 +0,0 @@ -#include - -/* 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; -}