diff --git a/emul/Makefile b/emul/Makefile index 2f4d0cb..4046335 100644 --- a/emul/Makefile +++ b/emul/Makefile @@ -9,7 +9,8 @@ BOOTSRCS = ./forth/conf.fs \ ../forth/icore.fs \ ./forth/xstop.fs -FORTHSRCS = core.fs cmp.fs print.fs str.fs parse.fs readln.fs fmt.fs z80a.fs +FORTHSRCS = core.fs cmp.fs print.fs str.fs parse.fs readln.fs fmt.fs z80a.fs \ + link.fs FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs OBJS = emul.o libz80/libz80.o SLATEST = ../tools/slatest diff --git a/forth/dict.fs b/forth/dict.fs deleted file mode 100644 index 4b4ef59..0000000 --- a/forth/dict.fs +++ /dev/null @@ -1,18 +0,0 @@ -( Get word header length from wordref. That is, name length - + 3. a is a wordref ) -( a -- n ) -: WHLEN - 1 - C@ ( name len field ) - 0x7f AND ( remove IMMEDIATE flag ) - 3 + ( fixed header len ) -; - -( Get word addr, starting at name's address ) -: '< ' DUP WHLEN - ; - -( Get word's prev offset ) -( a -- a ) -: PREV - 3 - DUP @ ( a o ) - - ( a-o ) -; diff --git a/forth/link.fs b/forth/link.fs new file mode 100644 index 0000000..bdc434d --- /dev/null +++ b/forth/link.fs @@ -0,0 +1,162 @@ +( 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 COMPACT ". Then, take the resulting relinked + binary, concatenate it to the boot binary, and write to + boot media. +) + +( Skip atom, considering special atom types. ) +( a -- a+n ) +: ASKIP + DUP @ ( a n ) + ( ?br or br or NUMBER ) + DUP <>{ 0x70 &= 0x58 |= 0x20 |= <>} + 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 header length from wordref. That is, name length + + 3. a is a wordref ) +( a -- n ) +: WHLEN + 1 - C@ ( name len field ) + 0x7f AND ( remove IMMEDIATE flag ) + 3 + ( fixed header len ) +; + +( 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 ) + 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 ) + 0x0e = NOT IF + ( unwind all args ) + 2DROP 2DROP + EXIT + THEN + ( we have a compiled word, proceed ) + ( 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 +; + +( Get word's prev offset ) +( a -- a ) +: PREV + 3 - DUP @ ( a o ) + - ( a-o ) +; + +( 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. + + This word prints the top copied address, so when comes the + time to concat boot binary with this relinked dict, you + can use H@+4 to printed addr. +) +( target -- ) +: COMPACT + ( 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 COMPACT, 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 ) + 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 +; diff --git a/recipes/rc2014/Makefile b/recipes/rc2014/Makefile index 8c90203..bfd3d0a 100644 --- a/recipes/rc2014/Makefile +++ b/recipes/rc2014/Makefile @@ -6,7 +6,6 @@ STAGE2 = $(EDIR)/stage2 EMUL = $(BASEDIR)/emul/hw/rc2014/classic PATHS = pre.fs \ $(FDIR)/core.fs \ - $(FDIR)/cmp.fs \ $(FDIR)/str.fs \ $(FDIR)/parse.fs \ $(BASEDIR)/drv/acia.fs \ diff --git a/recipes/rc2014/pre.fs b/recipes/rc2014/pre.fs index a2b807a..ce990dd 100644 --- a/recipes/rc2014/pre.fs +++ b/recipes/rc2014/pre.fs @@ -1 +1 @@ -112 RAM+ HERE ! +96 RAM+ HERE !