izaya/collapseos
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Move link.fs to blkfs

Browse Source
This commit is contained in:
Virgil Dupras 2020-04-26 14:37:54 -04:00
parent 4d8574c1fe
commit dee7eea497
20 changed files with 162 additions and 257 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
blk/001
View File

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

16
blk/120 Normal file
View File

@ -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.)

8
blk/121 Normal file
View File

@ -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"

1
blk/122 Normal file
View File

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

15
blk/123 Normal file
View File

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

11
blk/124 Normal file
View File

@ -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. )

16
blk/125 Normal file
View File

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

15
blk/126 Normal file
View File

@ -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.
)

16
blk/127 Normal file
View File

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

16
blk/128 Normal file
View File

@ -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. )

16
blk/130 Normal file
View File

@ -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. )

16
blk/131 Normal file
View File

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

9
blk/132 Normal file
View File

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

3
emul/.gitignore vendored
View File

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

185
forth/link.fs
View File

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

9
recipes/rc2014/Makefile
View File

@ -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):

2
recipes/rc2014/run.fs
View File

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

3
recipes/rc2014/xcomp.fs
View File

@ -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!

4
tools/Makefile
View File

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

57
tools/stripfc.c
View File

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