@@ -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 | |||
@@ -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.) |
@@ -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" |
@@ -0,0 +1 @@ | |||
123 132 LOADR |
@@ -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+ | |||
; |
@@ -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. ) | |||
@@ -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 ; |
@@ -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. | |||
) | |||
@@ -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 | |||
; |
@@ -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. ) |
@@ -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. ) |
@@ -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 ; |
@@ -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,6 +3,5 @@ | |||
/stage2 | |||
/forth | |||
/*-bin.h | |||
/core.bin | |||
/forth?.bin | |||
/stage1.bin | |||
/blkfs |
@@ -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 | |||
; |
@@ -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): | |||
@@ -1,2 +0,0 @@ | |||
: x KEY DUP EMIT ; | |||
: _ ACIA$ (ok) ['] x 0x0c RAM+ ! ; _ |
@@ -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,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 | |||
@@ -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; | |||
} |