|
- ( 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 <>{ 0x70 &= 0x58 |= 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 +
- ;
-
- ( Get word addr, starting at name's address )
- : '< ' DUP WHLEN - ;
-
- ( 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 @ ( 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 )
- 2 + ( ol o a2 a1+2 )
- 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 to compact the space between that word and its
- prev word. 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.
- )
- ( target -- )
- : 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@ == target )
- DUP H@ !
- DUP 1 - C@ 0x7f AND ( t namelen )
- SWAP 3 - @ ( namelen po )
- -^ ( o )
- ( H@+2 == offset )
- H@ 2 + ! ( )
- ( We have our offset, now let's copy our memory chunk )
- H@ @ DUP WHLEN - ( 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 H@ + ( u we )
- DUP .X LF
- SWAP CURRENT @ + ( we wr )
- DUP .X LF
- 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 )
- DUP WHLEN - ( wr we )
- SWAP ( we wr )
- ( Are we finished? We're finished if wr-4 <= H@ )
- DUP 4 - H@ <=
- UNTIL
- H@ 4 + .X LF
- ;
-
- ( Relink a regular Forth full interpreter. )
- : RLCORE
- LIT< H@ (find) DROP RLDICT
- ;
|