JimBoyd wrote:
The final cell is a chain linking all DEFINER words together, similar to how all vocabularies are linked in a chain pointed to by VOC-LINK . This new version of the metacompiler may not need the definer link. If it doesn't, I will remove it.
The chain linking all definer words together will not be needed. Here is the new source for DEFINER
Code:
: DEFINER ( CFA -- )
['] ORDER! >BODY >R
ORDER@ META DEFINITIONS
CREATE
, 0 , 0 , 0 ,
[ HERE 2+ >A ]
DOES>
DUP 2+ SWAP @ EXECUTE ;
A> CONSTANT DEFINER-WORD
The word START , used to start metacompiling, will have another word added to its definition. The word DEF-RESET clears all the DEFINER words prior to a new metacompiling session.
Code:
: DEF-RESET ( -- )
['] ORDER! >BODY >R
ORDER@ META WITH-WORDS
NAME> DUP @ DEFINER-WORD <>
IF DROP EXIT THEN
>BODY 2+ 6 ERASE ;
DEF-RESET uses WITH-WORDS on the META vocabulary. The original search order is saved with ORDER@ . The first line saves the PFA of ORDER! to the return stack. When WITH-WORDS is finished with all the words in the META vocabulary, DEF-RESET will exit into ORDER! which will exit into the caller of DEF-RESET .
For each word in the META vocabulary, its NFA will be left on the stack and the following Forth thread will be executed.
Code:
NAME> DUP @ DEFINER-WORD <>
IF DROP EXIT THEN
>BODY 2+ 6 ERASE ;
This will clear the last three cells of all the DEFINER words in the META vocabulary without affecting other words.
The metacompiler's version of DOES> compiles the appropriate data in virtual memory as well as patch all the child words of the CREATE DOES> word being defined in the target.
Code:
: DOES> ( TRUE -- TRUE )
META? ?BRANCH [ ' DOES> >BODY , ]
?CDP ?COMP DUP TRUE ?PAIRS
MCOMPILE DOES PATCH-CF
$4C VC,
" DO.DOES" FIND ?HUH
EXECUTE V, ; IMMEDIATE
META? returns a flag for the state of metacompiling. The metacompiler's version of DOES> will branch to the beginning of the original DOES> if metacompiling is off.
If metacompiling is on, it performs some housekeeping. ?CDP checks to see if the host dictionary size has changed. If it has, there is a problem. The phrase "DUP TRUE ?PAIRS" checks for any structure mismatches in the code between CREATE and DOES> . This also isolates the code between CREATE and DOES> from the code between DOES> and ; (semicolon). MCOMPILE uses the inline DOES (which is the regular Fleet Forth DOES , but this doesn't matter) for the search string to find the target version of DOES and compile it.
Code:
CODE MCOMPILE ( -- )
>FORTH
?COMP
R> DUP 2+ >R @
>NAME COUNT $1F AND >HERE CLIP
TFIND ?TARGET M, ;
The word which resolves and patches all the code fields for the latest CREATE DOES> word being defined is PATCH-CF .
The phrase "$4C VC," builds a jump instruction in the target and the next two lines find the subroutine DO.DOES and compiles its address into the target.
Now back to PATCH-CF
Code:
: PATCH-CF ( -- )
LATEST COUNT $1F AND >HERE CLIP
['] META >BODY VFIND
0= ABORT" DEFINER MISSING"
DUP @ DEFINER-WORD <>
ABORT" NOT A DEFINER WORD"
>BODY 2+ THERE OVER ! 2+
DUP MEND-CHAIN
@ ?DUP 0EXIT
BEGIN
DUP V@ THERE ROT V!
?DUP 0=
UNTIL ;
Code:
LATEST COUNT $1F AND >HERE CLIP
Take the latest name in the TARGET vocabulary and convert it to a search string at HERE .
Code:
['] META >BODY VFIND
Search only the META vocabulary for the DEFINER word with the same name.
Code:
0= ABORT" DEFINER MISSING"
DUP @ DEFINER-WORD <>
ABORT" NOT A DEFINER WORD"
If a word with the same name is not found or the word found is not a DEFINER word, abort with an appropriate message.
Code:
>BODY 2+ THERE OVER ! 2+
DUP MEND-CHAIN
Patch the second cell of the DEFINER word and mend the chain (just in case).
Code:
@ ?DUP 0EXIT
If there is no chain just exit. This is not an error, it just means the CREATE DOES> word was defined in the target's source before any child words were.
Code:
BEGIN
DUP V@ THERE ROT V!
?DUP 0=
UNTIL ;
Take apart the chain and patch the code field of each child word.
The metacompiler's ;CODE works similarly for CREATE ;CODE words.
Once this is done any new child words of this CREATE DOES> word will have its code built directly using the value from the second cell of the corresponding DEFINER word.
Code:
: CF, ( ADR -- )
DUP @
IF @ V, EXIT THEN
...
The new metacompiler is just about finished. There are a few tests to run and a few loose ends to tie up.