izaya/collapseos
1
0
Fork 0
mirror of https://github.com/hsoft/collapseos.git synced 2024-09-29 09:20:55 +10:00
Code Issues Releases Wiki Activity

link: handle doesWord

Browse Source
This commit is contained in:
Virgil Dupras 2020-04-11 16:38:45 -04:00
parent 13cf294201
commit bf447f58c5
3 changed files with 31 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
forth/link.fs
View File

@ -5,9 +5,21 @@
A typical usage of this unit would be to, right after a A typical usage of this unit would be to, right after a
bootstrap-from-icore-from-source operation, identify the bootstrap-from-icore-from-source operation, identify the
root word of the source part, probably "H@", and run root word of the source part, probably "H@", and run
" ' thatword COMPACT ". Then, take the resulting relinked " ' thatword RLDICT ". Then, take the resulting relinked
binary, concatenate it to the boot binary, and write to binary, concatenate it to the boot binary, and write to
boot media. 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. ) ( Skip atom, considering special atom types. )
@ -78,13 +90,17 @@
( ol o a1 a2 -- ) ( ol o a1 a2 -- )
: RLWORD : RLWORD
SWAP DUP @ ( ol o a2 a1 n ) SWAP DUP @ ( ol o a2 a1 n )
( 0e == compiledWord ) ( 0e == compiledWord, 2b == doesWord )
0x0e = NOT IF DUP <>{ 0x0e &= 0x2b |= <>} NOT IF
( unwind all args ) ( unwind all args )
2DROP 2DROP 2DROP 2DROP
EXIT EXIT
THEN THEN
( we have a compiled word, proceed ) ( 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 ) ( ol o a2 a1 )
2 + ( ol o a2 a1+2 ) 2 + ( ol o a2 a1+2 )
BEGIN ( ol o a2 a1 ) BEGIN ( ol o a2 a1 )
@ -101,6 +117,8 @@
AGAIN AGAIN
; ;
( TODO implement RLCELL )
( Get word's prev offset ) ( Get word's prev offset )
( a -- a ) ( a -- a )
: PREV : PREV
@ -125,7 +143,7 @@
can use H@+4 to printed addr. can use H@+4 to printed addr.
) )
( target -- ) ( target -- )
: COMPACT : RLDICT
( First of all, let's get our offset. It's easy, it's ( First of all, let's get our offset. It's easy, it's
target's prev field, which is already an offset, minus target's prev field, which is already an offset, minus
its name length. We expect, in COMPACT, that a target's its name length. We expect, in COMPACT, that a target's
@ -169,4 +187,10 @@
( Are we finished? We're finished if wr-4 <= H@ ) ( Are we finished? We're finished if wr-4 <= H@ )
DUP 4 - H@ <= DUP 4 - H@ <=
UNTIL UNTIL
H@ .X LF
;
( Relink a regular Forth full interpreter. )
: RLCORE
LIT< H@ (find) DROP RLDICT
; ;

2
recipes/rc2014/Makefile
View File

@ -20,8 +20,8 @@ PATHS = pre.fs \
$(FDIR)/parse.fs \ $(FDIR)/parse.fs \
$(BASEDIR)/drv/acia.fs \ $(BASEDIR)/drv/acia.fs \
$(FDIR)/print.fs \ $(FDIR)/print.fs \
$(FDIR)/readln.fs \
$(FDIR)/fmt.fs \ $(FDIR)/fmt.fs \
$(FDIR)/link.fs \
run.fs run.fs
SLATEST = $(BASEDIR)/tools/slatest SLATEST = $(BASEDIR)/tools/slatest
STRIPFC = $(BASEDIR)/tools/stripfc STRIPFC = $(BASEDIR)/tools/stripfc

2
recipes/rc2014/run.fs
View File

@ -1,6 +1,6 @@
: (c<) KEY DUP EMIT ;
: INIT : INIT
ACIA$ ACIA$
(c<$)
." Collapse OS" CR LF ." Collapse OS" CR LF
( 0c == CINPTR ) ( 0c == CINPTR )
['] (c<) 0x0c RAM+ ! ['] (c<) 0x0c RAM+ !