Fleet Forth metacompiler redesign

[JimBoyd]

I've already mentioned that Fleet Forth's metacompiler has words on the host in a TARGET FORTH vocabulary to serve as handles for the target system's words which are in virtual memory. The 'target words' have a body with three cells. The first cell holds the address of the actual target word in virtual memory. The second cell holds the address of this word's counterpart in the host system to be executed while interpreting. This includes immediate words when compiling. The third cell is for statistical data.
I've rewritten MFIND , the metacompiler's FIND , so that a target word is only found if it is to be compiled. This change will save two bytes (one cell) for each 'target word' in the TARGET FORTH vocabulary.

Code: Select all

: MFIND  ( ADR1 -- ADR2 F )
   COUNT >HERE
   TFIND DUP STATE @ =
   2PICK ?TW = AND
   ?DUP ?EXIT
   DROP HERE
   [META] ['] SHADOW >BODY (FIND)
   DUP STATE @ = 0EXIT
   2DROP  HERE 0 ;
HOST

The string at ADR1 may or may not be at HERE , although it normally is (but not when testing). COUNT >HERE moves the string at ADR1 to HERE to simplify the code. Even if the string is already at HERE , overwriting the string with itself will not be a problem.
TFIND only searches the TARGET FORTH vocabulary. The phrase

Code: Select all

DUP STATE @ =

results in a true flag under two conditions. The state is compiling and the found word is not immediate or the state is interpreting and the word was not found. That phrase followed by this one

Code: Select all

2PICK ?TW =

will result in a true flag if the word found is to be compiled and it is a 'target word' or the word is to be interpreted and it is not a 'target word'. This flag is ANDed with the flag returned by TFIND .
If the result is a true flag, MFIND exits with the address of the found word and the flag on the stack. If the result is false, the results are dropped and the search resumes with the SHADOW vocabulary and its parent vocabularies, if necessary. At this point any word found is not in the TARGET FORTH vocabulary so the following phrase

Code: Select all

   DUP STATE @ = 0EXIT

will exit if the word is immediate or the state is interpreting, otherwise the results are dropped and the address of the search string and a false flag are placed on the stack.

[JimBoyd]

After preliminary tests of this new version of MFIND , I found it doesn't work in actual use. When assembling, the metacompiler's ASSEMBLER vocabulary doesn't get searched.
Here is a revision which works.

Code: Select all

: MFIND  ( ADR -- ADR2 F )
   CONTEXT @
   BEGIN
      2DUP  VFIND
      DUP STATE @ =
      2PICK ?TW =  AND
      DUP 0=
   WHILE
      2DROP  2+ @ DUP 0=
   UNTIL
      EXIT
   THEN
   2NIP ;

This version searches the vocabularies one at a time starting with the CONTEXT vocabulary all the way down to the HOST FORTH vocabulary.
VFIND searches a vocabulary without searching parent vocabularies.
The test

Code: Select all

   DUP STATE @ =

returns a true flag if the found word is to be compiled. It also returns a true if interpreting and the sought after word was not found.
the test

Code: Select all

   2PICK ?TW

returns a true flag if the found word is a TARGET word. If these two flags are not equal, the flag returned by VFIND is cleared. If they are equal, the flag returned by VFIND is unaffected.
If the resulting flag is false, the search resumes with the parent vocabulary. Each time the search resumes, the old search results are dropped. The search might have been successful, yet this word should not be used if it is a target word which would not be compiled or a non-target word which would be compiled.

Here is the shortened version of HEADER .

Code: Select all

: HEADER  ( -- )
   >IN @ VHEADER >IN !
   HEAD ON
   CREATE
      THERE ,  0 ,
      [ HERE 2+ >A ]
   DOES>
      TRUE
      ABORT" TARGET WORD EXECUTED" ;
A> CONSTANT TARGET-WORD-CF

Although target words in this version of the metacompiler are not supposed to be executed, the ABORT" is there just in case.
Forth programmers normally prefer minimal error checking. I think a metacompiler should be an exception.

?TCOMP also needs modified to place the statistical data in the correct cell.

Code: Select all

: ?TCOMP  ( CFA -- )
   DUP ?TW ?TARGET
   >BODY 2+ 1 SWAP +! ;

I found Blazin' Forth's TRACE to be very handy in tracking down this bug. Fleet Forth's version of ID. was essential for this.

Code: Select all

: ID.  ( NFA -- )
   1+
   BEGIN
      COUNT $7F 2DUP AND QEMIT >
   UNTIL
   DROP ;

TRACE uses ID. to display a word's name and this version of ID. displays a word's name in place, which leaves PAD and HERE unaffected.
I was able to place a string at pad to test MFIND .

Code: Select all

" IF" MFIND

Making MFIND immediate for testing purposes allowed me to trace it while 'compiling'.

Code: Select all

" IF" ] MFIND [

[JimBoyd]

As I mentioned previously, when I added a new CREATE DOES> word to Fleet Forth's kernel it was necessary to add support for it in the metacompiler. Finding a better way to implement CREATE DOES> in the metacompiler is proving to be fiendishly difficult. I may have to settle for how the metacompiler currently handles it.
There is room for improvement in the current method and I will post the results shortly.

[JimBoyd]

I realize it has been a while. I've been busy and couldn't work on this until now.
One deficiency with my metacompiler concerns code words with no body. I use this method in the system loader to create a word with a code field pointing to code elsewhere.

Code: Select all

CREATE <NAME>
   ADDRESS LATEST NAME> !

Here is example one.

Code: Select all

CREATE CS-DUP
   ' 2DUP @ LATEST NAME> !
   IMMEDIATE

I use the following method in the source for Fleet Forth's kernel.

Code: Select all

CODE <NAME>
   -2 ALLOT ADDRESS ,  END-CODE

And example two.

Code: Select all

CODE LEAVE  ( -- )
   -2 ALLOT  LEAVE.BODY ,  END-CODE

There are two reasons for the difference.
1) The metacompiler's LATEST needed fixed.
2) Variables are defined before CREATE is defined (it's a chicken and egg problem) so all the CFA's for variables are in a chain. When CREATE is defined in the kernel, all the code fields in the chain are resolved to the newly compiled do.variable. The same is done for all colon words, all CONSTANTs, and anything which is not a CODE word. Each CREATE DOES> or CREATE ;CODE defining word has a chain linking the code fields of its child words which gets resolved when that defining word is defined in the kernel.
suppose the variables BLK >IN and CONTEXT are the first three variables to be defined. Here is a rough diagram of what gets compiled. The code fields get resolved when CREATE is defined.

Code: Select all

1000: XXXX          < Link Field (to previous header)
1002: 3             < Name Field count
1003: B L K         < Name Field text
1006: 0             < Code Field (first variable)
1008: ????          < Parameter Field

100A: 1000          < Link Field (to header of BLK)
100C: 3             < Name Field count
100D: > I N         < Name Field text
1010: 1006          < Code Field (points to code field of BLK)
1012: ????          < Parameter Field

1014: 100A          < Link Field (to header of >IN)
1016: 7             < Name Field count
1017: C O N T E X T < Name Field text
101E: 1010          < Code Field (points to code field of >IN)
1020: ????          < Parameter Field

Using the method shown in example one in the kernel would break the chain for do.create, yet that method seems natural. There is no need to invoke the assembler (meta assembler) since no code is to be assembled.
Here is a prototype form of chaining to allow in the kernel the method shown in example two.

Code: Select all

: MEND-CHAIN  ( ADR -- )
   DUP>R  2@ @ <>
   IF  R@ 2+ @ R@ !  THEN
   R@ @ R> 2+ ! ;
: ADD-CHAIN  ( ADR -- )
   DUP MEND-CHAIN ADD ;
2VARIABLE DUMMY
: DUNCE   CREATE DUMMY ADD-CHAIN ;
: TEST  ( -- )
   DUMMY DUP MEND-CHAIN
   BEGIN
      @ ?DUP
   WHILE
      DUP BODY> >NAME CR ID.
   REPEAT ;

This version of chaining requires two cells. It keeps the address of the latest link and the one prior to that.
If the latest link in the chain is altered, the word MEND-CHAIN used in ADD-CHAIN mends the chain.
The word DUNCE creates variables and chains together their parameter fields for testing purposes.
I neglected to log my test results, but the test was something like this.

Code: Select all

0 0 DUMMY 2!  OK   \ initialize DUMMY variable
DUNCE LARRY  OK
DUNCE SHIRLEY  OK
SHIRLEY OFF  OK    \ chain broken
DUNCE CURLY  OK    \ chain restored -- SHIRLEY removed from chain
DUNCE MOE  OK
DUNCE ABBOT  OK
DUNCE EDWIN  OK
42 EDWIN !  OK     \ chain broken
DUNCE COSTELLO  OK \ chain restored -- EDWIN removed from chain
TEST
COSTELLO
ABBOT
MOE
CURLY
LARRY OK

At this point COSTELLO is the latest DUNCE created. If I broke the chain at any other DUNCE it would remain broken.
As in the word TEST , the word to resolve the chain would also use MEND-CHAIN to remove the last link if it did not belong.

[JimBoyd]

I know it's been a while. Rest assured that I have not given up on the redesign. I haven't had the large blocks of free time needed to properly redesign the metacompiler's handling of CREATE DOES> .

As an example, here is the source for SARRAY (string array) in the Fleet Forth's kernel.

Code: Select all

: SARRAY
   CREATE
   DOES>  ( U -- )
      SWAP 0 ?DO  COUNT +  LOOP ;

This would be sufficient if there were no SARRAY child words in the kernel.
The following was added to the metacompiler to support child words of SARRAY in the kernel.

Code: Select all

: <MSARRAY>  ( ADR -- )
   HEADER CF, ;
' <MSARRAY>     DEFINER SARRAY

although it could be changed to this.

Code: Select all

:NONAME  ( ADR -- )
   HEADER CF, ; DEFINER SARRAY

This is relatively straight forward for two reasons.
1) The strings are added to a child word after it is defined.

Code: Select all

SARRAY SIOERR  ( U -- )

SARRAY's job is done. Now to add the strings.

Code: Select all

   ," TOO MANY OPEN FILES"
   ," FILE ALREADY OPEN"
   ," FILE NOT OPEN"
   ," FILE NOT FOUND"
   ," DEVICE NOT PRESENT"
   ," NOT INPUT FILE"
   ," NOT OUTPUT FILE"
   ," MISSING FILE NAME"
   ," ILLEGAL DEVICE NUMBER"

2) The child words of SARRAY are not executed while building the kernel.
Here is the source for CONSTANT and VALUE in the kernel.

Code: Select all

: CONSTANT  ( N -- )
   CREATE , ;CODE  ( -- N )
   LABEL DO.CONSTANT
   2 # LDY
   DEX  DEX
   (W)PUT JMP  END-CODE
: VALUE  ( N -- )
   CONSTANT  ;CODE  ( -- N )
   DO.CONSTANT JMP
   END-CODE

And the metacompiler support.

Code: Select all

: <MCONSTANT>  ( N ADR -- )
   >R ORDER@
   [SHADOW] SHADOW DEFINITIONS
   >IN @ OVER  CONSTANT
   ORDER!
   >IN !  HEADER
   R> CF, V, ;

' <MCONSTANT>   DEFINER CONSTANT
' <MCONSTANT>   DEFINER VALUE

The two differences with SARRAY are:
1) CONSTANT and VALUE compile the data, it is not added after the fact.
2) The child words of CONSTANT and VALUE can run while the target is being built. Not really, an alias in the shadow vocabulary is created. It is this alias which runs.

Code: Select all

LRU  #BUF 6 * -   CONSTANT MRU

The 'system value' LRU and the value #BUF are used to determine the initial value of the 'system value' MRU .
Since MRU gets initialized during cold-start, the ability to run target constants isn't necessary and I've thought about removing the ability to execute them during metacompilation; however, if CREATE DOES> child words can not be executed during metacompilation, that would eliminate the ability to have child words which create other child words in the target. Such words could be added to the target system after it is running. This is not needed in the kernel and I have not used this technique before, but I seem to recall mention of it with object oriented Forth systems.

By the way, I've posted on other subjects recently because they did not require the amount of uninterrupted spare time needed for metacompiler redesign.

[JimBoyd]

I will refer to the metacompiler's version of CREATE DOES> and CREATE ;CODE words as definer words.
I have not found a better way to implement the definer words, so I will use the same idea from my original version of the metacompiler; however, I will try to clean up the code.
Two words from the last post which have not been defined are CF, and DEFINER . HEADER , shown previously, creates a word in the target vocabulary and a header in virtual memory. It does not build the code field.

Code: Select all

VARIABLE DEF-LINK  DEF-LINK OFF
: CF,  ( ADR -- )
   DUP @
   IF  @ V,  EXIT  THEN
   2+ ADD-CHAIN ;
: DEFINER  ( CFA -- )
   ['] ORDER! >BODY >R
   ORDER@  META DEFINITIONS
   CREATE
      ,  0 ,  0 , 0 ,
      DEF-LINK ADD
   [ HERE 2+ >A ]
   DOES>
      DUP 2+ SWAP @ EXECUTE ;
   A> CONSTANT DEFINER-WORD

DEFINER is a CREATE DOES> word which defines its child words in the META vocabulary. The body of ORDER! is placed on the return stack so the search and compile orders saved by ORDER@ will be restored when DOES> finishes execution.
The first cell of a definer word is the address of a word to execute to build the header in virtual memory as well as the handle in the TARGET VOCABULARY . This is handled by a separate word because some definer words also perform other actions such as creating an alias in the SHADOW vocabulary or changing STATE .
The second cell serves as a flag and the address of the code to compile in virtual memory for the code field. The value is initially zero and CF, adds the virtual memory version of HERE to a chain of addresses to be resolved when the value for the code field is set.
When the corresponding CREATE DOES> or CREATE ;CODE word is defined in the target's source, this cell is set by the metacompiler version of DOES> or ;CODE and the chain of addresses is resolved so they all point to this value. From this point on, any child word for this definer will have this value compiled for its code field.
The next two cells hold the address for the chain and its previous link. Saving the previous link allows the following usage in the target's source:

Code: Select all

CREATE LEAVE  ( -- )
   LEAVE.BODY LATEST NAME> !

as opposed to this:

Code: Select all

CODE LEAVE  ( -- )
   -2 ALLOT  LEAVE.BODY ,  END-CODE

Altering LEAVE's CFA breaks the chain; however, the next time a variable is created in the target, or the chain is resolved, the chain is mended. This may not seem like a big deal; however, the former is used in the system loader to remove a dependency on the cell size.

Code: Select all

CREATE CS-DUP  ( ADR N -- ADR N ADR N )
   ' 2DUP @ LATEST NAME> !
   IMMEDIATE

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.
One of the last actions to perform when metacompiling is to verify that all the definer words were defined in the target's source, or at least to verify that the ones used in the source were defined.

Code: Select all

: VERIFY  ( -- )
   ['] ORDER! >BODY >R
   ORDER@ META WITH-WORDS
   DUP NAME> DUP @ DEFINER-WORD <>
   IF  2DROP EXIT  THEN
   >BODY 2+ @
   IF  DROP EXIT  THEN
   CR RON ID.
   ." . NOT DEFINED IN TARGET" ;

VERIFY will show the name of each definer word which was not defined in the target's source.
Fleet Forth is block based and the source for the kernel spans two C64 single sided disks. When I metacompile a new Fleet Forth kernel I get the following message when the first disk is done:
2CONSTANT NOT DEFINED IN TARGET
This is because 2CONSTANT is defined on the second disk and is not a problem since metacompiling is not done.

[JimBoyd]

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: Select all

: 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: Select all

: 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: Select all

   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: Select all

: 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: Select all

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: Select all

: 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: Select all

   LATEST COUNT $1F AND >HERE CLIP

Take the latest name in the TARGET vocabulary and convert it to a search string at HERE .

Code: Select all

   ['] META >BODY VFIND

Search only the META vocabulary for the DEFINER word with the same name.

Code: Select all

   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: Select all

   >BODY 2+ THERE OVER ! 2+
   DUP MEND-CHAIN

Patch the second cell of the DEFINER word and mend the chain (just in case).

Code: Select all

   @ ?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: Select all

   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: Select all

: 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.

[JimBoyd]

Two corrections for the new metacompiler's source.

The version of label I presented will not work if used outside definitions and it is used in the Forth kernel source outside a definition seven times.

Code: Select all

META DEFINITIONS
: LABEL  ( -- )
   ?CDP THERE DEFINE !CDP ;
   IMMEDIATE
HOST

The check of the dictionary pointer with ?CDP will cause an error. Here is a working version.

Code: Select all

META DEFINITIONS
: LABEL  ( -- )
   HERE THERE DEFINE
   HERE SWAP - CDP +! ; IMMEDIATE
HOST

!CDP and ?CDP are a 'sanity check' to make certain that the source is built in virtual memory and not in the host memory by mistake. Metacompiling is rather complicated so I may have been a little aggressive with the error checking.

There is also an error in the word V,"

Code: Select all

CODE V,"  ( -- )
   >FORTH
   ASCII " CHAR
   >THERE C@ 1+ VALLOT ;

>THERE leaves the address of THERE on the stack; therefore, the count should be fetched from virtual memory and C@ should be VC@

Code: Select all

CODE V,"  ( -- )
   >FORTH
   ASCII " CHAR
   >THERE VC@ 1+ VALLOT ;

[JimBoyd]

These are the words used as parameters for the DEFINER words. They are all defined in the host FORTH vocabulary.

Code: Select all

: <MCONSTANT>  ( N ADR -- )
   >IN @  HEADER  >IN !
   CF,  DUP V,
   ORDER@
   [SHADOW] SHADOW DEFINITIONS [HOST]
   CONSTANT
   ORDER! ;

: <M2CONSTANT>  ( D ADR -- )
   >IN @  HEADER  >IN !
   CF,  2DUP V, V,
   ORDER@
   [SHADOW] SHADOW [HOST]
   DEFINITIONS  2CONSTANT
   ORDER! ;

: <MCREATE>  ( ADR -- )
   >IN @ HEADER >IN !  CF,
   ORDER@
   [SHADOW] SHADOW DEFINITIONS
   THERE CONSTANT
   ORDER! ;

: <<MUSER>>  ( C -- )
   CREATE
      C,
      [ HERE 2+ >A ]
   DOES>
      C@ USER.AREA + ;
: <MUSER>  ( C ADR -- )
   >IN @  HEADER  >IN !  CF,
   DUP VC,
   ORDER@
   [SHADOW] SHADOW [HOST]
   DEFINITIONS
   <<MUSER>>
   ORDER! ;
A> CONSTANT MUSER-CF

: <M:>  ( ADR -- )
   CURRENT @ CONTEXT !
   HEADER CF, LATEST TRUE OVER TSB
   !CDP  ] ;
: <MDEFER>  ( ADR -- )
   HEADER CF, 0 V, ;

: <MVOCABULARY>  ( ADR -- )
   HEADER CF,
   0 V, MCURRENT @ V,
   THERE MVOC-LINK DUP @ V, ! ;
: <MSARRAY>  ( ADR -- )
   HEADER CF, ;

Notice that <M:> smudges the LATEST word. This has to be the handle created in the TARGET vocabulary; therefore, the metacompiler's version of LATEST is defined in the META vocabulary to keep it out of the way until metacompiling.

Code: Select all

META DEFINITIONS
: LATEST  ( -- NFA )
   LATEST  META? 0EXIT
   NAME> DUP ?TW ?TARGET
   >BODY @ V>NAME ;
HOST

Here are the corresponding DEFINER words and a few others. DEFINER creates it's child word in the META vocabulary regardless of the values of CURRENT and CONTEXT .

Code: Select all

' <MCREATE>     DEFINER CREATE
META DEFINITIONS
: VARIABLE
   CREATE  0 V, ;
: 2VARIABLE
   VARIABLE  0 V, ;
: SUBR
   CREATE  ASSEMBLE  ;
HOST
: HSUBR  ( -- )
   META?
   IF
      THERE CONSTANT ASSEMBLE EXIT
   THEN
   SUBR ;

' <MUSER>       DEFINER USER
' <M:>          DEFINER :
' <MDEFER>      DEFINER DEFER
' <MVOCABULARY> DEFINER VOCABULARY
' <MSARRAY>     DEFINER SARRAY
' <MCONSTANT>   DEFINER CONSTANT
' <MCONSTANT>   DEFINER VALUE
' <M2CONSTANT>  DEFINER 2CONSTANT

Since HSUBR (headerless subroutine) is defined in the host FORTH vocabulary, the version of SUBR which is compiled is the host version. This is so the source for words to be metacompiled can be tested on the host system.

Here are the rest of the meta assembler words.

Code: Select all

META DEFINITIONS
: ;CODE  ( TRUE -- TRUE )
   ?METACOMP
   ?CDP ?COMP DUP TRUE ?PAIRS
   MCOMPILE DOES
   PATCH-CF  [COMPILE] [
   [ASSEMBLER] ASSEMBLER MEM ;
   IMMEDIATE

TARGET ASSEMBLER DEFINITIONS
: >FORTH  ( -- )
   ?METACOMP
   ?EXEC  " (>FORTH)" COUNT EVALUATE
   JSR
   [HOST]  CURRENT @ CONTEXT !
   ] ; IMMEDIATE

META DEFINITIONS
: >ASSEM  ( -- )
   ?METACOMP
   ?COMP  MCOMPILE (>ASSEM)
   [ASSEMBLER] MEM ASSEMBLER
   [COMPILE] [ ; IMMEDIATE
HOST

There is a new error handling word ?METACOMP . This word aborts if not metacompiling (or meta interpreting).

Code: Select all

: META?  ( -- F )
   ['] LITERAL @  [ ' : @ ] LITERAL
   <> ;
: ?METACOMP  ( -- )
   META? 0=
   ABORT" FOR METACOMPILING" ;

META? returns TRUE if metacompiling.

The metacompiler redesign is almost done. There are still more tests.

I'm still wondering if there is a better way to deal with the CREATE DOES> and CREATE ;CODE words. This really isn't a problem unless a CREATE DOES> or CREATE ;CODE word is defined in the target source which does not yet have support in the metacompiler. An example is when I added string arrays to the Forth kernel.

Code: Select all

: SARRAY  ( -- )
   CREATE  DOES>  ( U -- )
      SWAP 0 ?DO  COUNT +  LOOP
      S? ;

The following was added to the metacompiler to support string arrays in the Forth kernel.

Code: Select all

: <MSARRAY>  ( ADR -- )
   HEADER CF, ;

' <MSARRAY>     DEFINER SARRAY

This case was relatively straight forward. Some of the support for CREATE DOES> words is a bit more complicated.
As I've already mentioned, part of the complexity is because user variables, variables, constants and colon definitions are defined before USER , VARIABLE , CONSTANT or : (colon) are defined.
The other part of the complexity is that the user variables and other child words can not be executed on the target while it is being built. They exist in virtual memory, yet they have to be available.

Code: Select all

CODE ]
   DEY
   STATE    STY
   STATE 1+ STY
   NEXT JMP  END-CODE

The variable STATE needs to leave its address while this word is being assembled. This is why there are shadow definitions in the SHADOW vocabulary. The shadow definition for the target system's variable STATE is a constant which holds the virtual memory address for the body of STATE .

[JimBoyd]

There are a few things I overlooked when posting.
Here are some variables and values used by the metacompiler.

Code: Select all

0 VALUE USER.AREA
0 VALUE 'THERE
VARIABLE MVOC-LINK
VARIABLE MCURRENT

USER.AREA will be set in the kernel source and holds the address on the target for user variables. It is used by the word <<MUSER>> which is executed by the word <MUSER> which is executed by the DEFINER word USER .
'THERE is used in the kernel source to hold the address of the location for the coldstart dictionary size.
Both of these values are set in the kernel source.
The next two, MVOC-LINK and MCURRENT are metacompiler stand-ins for VOC-LINK and CURRENT and are used to set the values of VOC-LINK and CURRENT when metacompilation is finished.

When ?TFIND was renamed to ?TARGET the flag was changed.

Code: Select all

: ?TARGET  ( -F -- )
   0= ABORT" NOT IN TARGET" ;

In the word PNAME the 'R' in the string is actually the Commodore 64's reverse print character. It shows on the screen as a reverse 'R' but prints (and print dumps to a text file) as a normal 'R'. A carriage return clears the C64's reverse video mode.

Code: Select all

: PNAME  ( -- )
   1 VALLOT  1 PNAMES +!
   COLS ?CR ." PADDED: R"
   HERE S? CR ;

I don't think I showed the definition of ?TW . It returns a true flag if the CFA passed to it is for a TARGET word.

Code: Select all

: ?TW  ( CFA -- F )
   @ TARGET-WORD-CF = ;

Although I showed the source for the CDP words:

Code: Select all

VARIABLE CDP
: !CDP  ( -- )  HERE CDP ! ;
: ?CDP  ( -- )  HERE CDP @ <>
   ABORT" COMPILED TO HOST" ;

I only gave a brief mention of their purpose. Metacompiling is tricky enough that I added error checking to make sure that compiling to the host didn't take place when compiling to virtual memory is intended. These words use an idea from other Forth's. Rather than record and check the stack depth, they record and check the host dictionary size.

Here is the source for the metacompiler's ; and -;

Code: Select all

: ;  ( ADR TRUE -- )
   META?
   ?BRANCH [ ' ; >BODY , ]
   ?CDP ?COMP  MCOMPILE EXIT
   [COMPILE] [
   TRUE ?PAIRS TSB ; IMMEDIATE
: -;  ( ADR TRUE -- )
   META?
   ?BRANCH [ ' -; >BODY , ]
   ?CDP ?COMP
   [COMPILE] [
   TRUE ?PAIRS TSB ; IMMEDIATE

The host system's version of -; would work with the metacompiler; however, there would be no check for a change in the size of the host dictionary.
Metacompiling colon definitions which end with ; would not work without the metacompiler's version. It is needed to compile the target version of EXIT .

' (tick) now uses ?TCOMP to improve the stats on word usage for the new kernel.

Code: Select all

: '  ( -- N 
   '  META?  0EXIT
   DUP ?TCOMP >BODY @ ;

And [COMPILE] was changed so it performs the normal comma if not metacompiling.

Code: Select all

: [COMPILE]  ( -- )
   ?COMP  ' META?
   ?BRANCH [ ' , >BODY , ]
   V, ; IMMEDIATE

The former could have been defined as:

Code: Select all

: [COMPILE]  ( -- )
   ?COMP  ' META?
   IF  V,  ELSE  ,  THEN ; IMMEDIATE

or even

Code: Select all

: [COMPILE]  ( -- )
   ?COMP  ' META?
   IF  V,  EXIT  THEN
   , ; IMMEDIATE

but the first is smaller.

Here are MEND-CHAIN and ADD-CHAIN modified for the metacompiler.

Code: Select all

: MEND-CHAIN  ( ADR -- )
   DUP>R  2@ V@ <>
   IF  R@ 2+ @ R@ !  THEN
   R@ @ R> 2+ ! ;
: ADD-CHAIN  ( ADR -- )
   DUP MEND-CHAIN VADD ;

Another word needed to build the kernel is the metacompiler version of IMMEDIATE

Code: Select all

: IMMEDIATE
   IMMEDIATE
   LATEST NAME> ?TW 0EXIT
   LATEST NAME> >BODY @ V>NAME
   " IBIT" FIND 0=
   ABORT" IBIT NOT DEFINED IN SOURCE"
   >BODY C@ VTOGGLE ;

This version of IMMEDIATE , like the original, will make the latest word immediate. It will also check the latest word to see if it is a TARGET word. For a TARGET word, it will fetch the address of the target's code field in virtual memory to get to the name field and toggle the immediate bit for this word in virtual memory.
IBIT is a definer which is defined in the target's source.

The metacompiler's assembler is loaded before the aliases in the META vocabulary are defined.
The following aliases are not even needed:

Code: Select all

: N>LINK   VN>LINK ;
: L>NAME   VL>NAME ;
: >BODY   V>BODY ;
: BODY>   VBODY> ;

META-STATUS has been redefined:

Code: Select all

: META-STATUS
   SETWIDTH
   CR ." METACOMPILING "  RON META?
   IF  ." ON"  ELSE  ." OFF"  THEN
   ROFF
   CR ."    STATE: " STATE @ U.W
   CR ."    WLINK: " WLINK @ U.W
   CR ."     HEAD: " HEAD @ U.W
   CR ."    HEADS: " HEADS @ U.W
   CR ." HEADLESS: " HEADLESS @ U.W
   CR ."   ORIGIN: " (ORIGIN) @ U.W
   CR ."    THERE: " TDP @ U.W
   CR ."   'THERE: " 'THERE U.W
   CR ."   PADDED: " PNAMES @ U.W
   ORDER ; IMMEDIATE

META-STATUS now displays the status "ON" or "OFF" in reverse video to make it stand out from all the other data.

U.W is a word defined in Fleet Forth because its functionality was used so much:

Code: Select all

10 VALUE 32BITS
: 16BITS  ( -- U )
   32BITS 1+ 2/ ;
: 8BITS  ( -- U )
   16BITS 1+ 2/ ;
: SETWIDTH  ( -- )
   TRUE TRUE <# #S #> NIP
   (IS) 32BITS ;
: U.W  ( U -- )
   16BITS U.R SPACE ;

That should be everything I overlooked or changed.
There are a few more words to cover. It's getting late and I'll present them next time.

[JimBoyd]

I have another problem to report.
The following will not work for code words with no body:

Code: Select all

CREATE 1  ( -- 1 )
   PUSH.ONE  LATEST NAME> !

and the reason has nothing to do with the chaining of the code fields together until they are resolved. That part works as expected.
So that I can use variables like this:

Code: Select all

CODE ]  ( -- )
   DEY
   STATE    STY
   STATE 1+ STY
   NEXT JMP  END-CODE

there has to be a word with the same name as the variable which returns the address of the variable. This is why there is a SHADOW vocabulary and why the DEFINER word CREATE creates a shadow constant for each CREATE word. This was also the case before redesigning the metacompiler.
This normally works quite well.
The word 1 is a code word with no body in Fleet Forth. Its code field points to a place in (FIND) which pushes a one on the data stack. This is smaller than a CONSTANT with the name 1 .

Consider the source for 1 shown above.

Code: Select all

CREATE  ( -- 1 )

At this point there is a VARIABLE named 1 and a SHADOW CONSTANT of the same name. When 1 is found while interpreting, such as assembling a code word with the meta assembler, the address of this VARIABLE will be placed on the stack by the SHADOW CONSTANT 1.
The following will change 1 to a code word with no body.

Code: Select all

   PUSH.ONE  LATEST NAME> !

The shadow definition of 1 will still exist and will place the address of what was the VARIABLE 1 on the data stack whenever the number 1 is encountered.

When 1 is defined in the target like this:

Code: Select all

CODE 1  END-CODE  ( -- 1 )
   PUSH.ONE  LATEST NAME> !

or even like this:

Code: Select all

CODE 1  ( -- 1 )
   PUSH.ONE  LATEST NAME> !
   END-CODE

no shadow constant will be created since they are not needed for code words. In the following example the host system's 1 will be found or the search string will be converted to a number. Either way a one will still be placed on the stack as intended.

Code: Select all

CODE SPLIT  ( U -- LOBYTE HIBYTE )
   1 ,X LDA  1 ,X STY
   AYPUSH JMP  END-CODE

At least with the metacompiler version of LATEST working properly I can do this:

Code: Select all

CODE 1  ( -- 1 )
   PUSH.ONE  LATEST NAME> !
   END-CODE

rather than this:

Code: Select all

CODE 1  ( -- 1 )
   -2 ALLOT  END-CODE
   PUSH.ONE ,

[JimBoyd]

JimBoyd wrote:

Here is the source for the metacompiler's ; and -;

Code: Select all

: ;  ( ADR TRUE -- )
   META?
   ?BRANCH [ ' ; >BODY , ]
   ?CDP ?COMP  MCOMPILE EXIT
   [COMPILE] [
   TRUE ?PAIRS TSB ; IMMEDIATE
: -;  ( ADR TRUE -- )
   META?
   ?BRANCH [ ' -; >BODY , ]
   ?CDP ?COMP
   [COMPILE] [
   TRUE ?PAIRS TSB ; IMMEDIATE

The host system's version of -; would work with the metacompiler; however, there would be no check for a change in the size of the host dictionary.
Metacompiling colon definitions which end with ; would not work without the metacompiler's version. It is needed to compile the target version of EXIT .

The only difference between the metacompiler's version of hyphen semicolon and the host version of hyphen semicolon is the check to see if the host dictionary changed. The metacompiler's hyphen semicolon can be streamlined.

Code: Select all

: -;  ( ADR TRUE -- )
   META?
   IF  ?CDP  THEN
   [COMPILE] -; ; IMMEDIATE

The metacompiler's semicolon can be streamlined a little as well.

Code: Select all

: ;  ( ADR TRUE -- )
   META?  ?BRANCH [ ' ; >BODY , ]
   MCOMPILE EXIT
   [COMPILE] -; ; IMMEDIATE

The host version of hyphen semicolon is used in the metacompiler's version of hyphen semicolon.
The metacompiler's version of hyphen semicolon is used in the metacompiler's version of semicolon.

[JimBoyd]

Only a few more words are needed to make the metacompiler functional.
SMUDGE-TEST checks the TARGET VOCABULARY for any smudged words. If any are smudged, something went wrong while metacompiling. Smudging a word by setting its smudge-bit cannot hide it from WITH-WORDS .

Code: Select all

: SMUDGE-TEST  ( -- )
   WITH-WORDS
      DUP C@ $20 AND
      IF
         CR ." SMUDGED: "
         RON ID. ROFF  EXIT
      THEN
      DROP ;

SMUDGE-TEST is included in FINISH-FORTH .

PATCH-FORTH makes the target ready for use.

Code: Select all

: PATCH-FORTH  ( -- )
   THERE 'THERE V!
   " FORTH" TFIND ?TARGET
   >BODY @ V>BODY WLINK @ OVER V!
   DUP " CURRENT" TFIND ?TARGET
   >BODY @ V>BODY V!
   DUP " CONTEXT" TFIND ?TARGET
   >BODY @ V>BODY V!
   2+ 2+
   " VOC-LINK" TFIND ?TARGET
   >BODY @ V>BODY V! ;

'THERE (tick there) points to the address in virtual memory the target will use for the coldstart value of DP , Forth's dictionary pointer.
The address in WLINK is stored in the body of the vocabulary FORTH in the target. The target's CURRENT and CONTEXT are also set to point to the target's FORTH . Setting the target's CONTEXT and CURRENT isn't strictly necessary since the target's cold start routine executes FORTH DEFINITIONS as part of the high level startup. I left this in so the new kernel image will be identical to the one created with the older metacompiler.
Finally, the target's VOC-LINK is set to point to the third cell in the target's FORTH .

FINISH-FORTH executes PATCH-FORTH , runs a few checks and switches off metacompiling.

Code: Select all

: FINISH-FORTH  ( -- )
   PATCH-FORTH VERIFY
   [TARGET] FORTH [HOST]
   SMUDGE-TEST
   [COMPILE] FINISH
   [COMPILE] META-STATUS
   'THERE 0= ABORT" 'THERE IS ZERO"
   USER.AREA 0= ABORT" NO USER AREA"
   ; IMMEDIATE

Unless I overlooked mentioning something in the source, that will be everything needed for metacompilation. I've tested this metacompiler with the source for Fleet Forth to build a new kernel. The new kernel is identical to the original so by that measure the new metacompiler is a success.
Now to start metacompiling by inserting the first source disk.

Code: Select all

DOPEN 1 LOAD 

Here is the load block for the first source disk for Fleet Forth's kernel.

Code: Select all

// LOAD BLOCK FOR FLEET FORTH
START
  1 FH #164 FH THRU
HEX
FINISH-FORTH

FH is 'from here' and adds the current blocks number to the number on the stack. Since the load block is block 1, this will load blocks 2 thru 165 inclusive.
When FINISH-FORTH executes, this is displayed:

Code: Select all

2CONSTANT NOT DEFINED IN TARGET
ELAPSED TIME
 00:14:03.4 
FINISHED
METACOMPILING OFF
   STATE:    0 
   WLINK: 276D 
    HEAD: FFFF 
   HEADS:    0 
HEADLESS:    7 
  ORIGIN:  801 
   THERE: 277D 
  'THERE:  81D 
  PADDED:    2 
CONTEXT: FORTH

CURRENT: FORTH

This is not all of the source and 2CONSTANT is not defined in the target at this point. At this point, I flush the buffers and close the disk.

Code: Select all

FLUSH  OK
DCLOSE  OK

and place the second source disk in the drive and start metacompiling.

Code: Select all

DOPEN 1 LOAD 

Here is the load block for the second source disk.

Code: Select all

RESUME
  1 FH #37 FH THRU // REST OF KERNEL
HEX
FINISH-FORTH

Note that RESUME is used rather than START.
A similar message is displayed when finished.

Code: Select all

ELAPSED TIME
 00:03:15.9 
FINISHED
METACOMPILING OFF
   STATE:    0 
   WLINK: 2EC8 
    HEAD: FFFF 
   HEADS:    0 
HEADLESS:   10 
  ORIGIN:  801 
   THERE: 2EDE 
  'THERE:  81D 
  PADDED:    2 
CONTEXT: FORTH

CURRENT: FORTH

All that's left is to flush the buffers, close the disk for block access and insert a destination disk for the program file.

Code: Select all

FLUSH  OK
DCLOSE  OK

Then save the target.

Code: Select all

TSAVE 
FILENAME? 
KERNEL  OK

TSAVE prompts for a filename.

That's about it. There are two more words for the metacompiler.
GLOSSARY displays all the words in a given vocabulary, each on its own line with some statistical data.
TLOCATE is used to locate the source for a word in the TARGET vocabulary.

[JimBoyd]

Here is the source for GLOSSARY

Code: Select all

: GLOSSARY  ( -- )
   SETWIDTH WITH-WORDS
   CR DUP ID. TAB  NAME>
   DUP @ MACRO-CF =
   IF  >BODY COUNT QTYPE EXIT  THEN
   DUP @ TARGET-WORD-CF =
   IF
      >BODY DUP @ 16BITS U.R
      ." :" 2+ @ U.W  EXIT
   THEN
   DUP @ MUSER-CF =
   IF  >BODY C@ 8BITS .R  EXIT
   THEN
   >BODY @ U.W ;

GLOSSARY will display a MACRO's internal string.
It will display the CFA of a target word and the count of how many times that word was compiled.
If a word is the shadow of a USER VARIABLE , GLOSSARY will display its offset into the user area.
For all other words, GLOSSARY displays the contents of the first cell of the word's PFA.

Code: Select all

TARGET GLOSSARY
   ...
LIT              9C1:  15 
BRANCH           9B9:  17 
DROP             9AE:   8 
EXIT             9A5:  71 
J                990:   0 
I                96E:   9 
LEAVE            968:   0 
UNLOOP           955:   1 
(?DO)            936:   B 
(DO)             904:   4 
?BRANCH          8D3:  1C 
2DROP            8BC:   3 
(+LOOP)          8A4:   2 
(LOOP)           865:   B 
?LEAVE           850:   1 
0EXIT            83B:   7 
?EXIT            827:   6 
   ...

Code: Select all

SHADOW GLOSSARY
   ...
BOOT             80E 
FUSE             80B 
AUTO.SCROLL.DN  $292
KBD.BUFFER      $277
LFN-1           $258
QUOTE.MODE      $D4
   ...

The source for TLOCATE

Code: Select all

: TLOCATE  ( -- )
   [TARGET] FORTH [HOST]
   LOCATE ;

This word is used like LOCATE . If I run into a problem while metacompiling, I can check the source of a suspect word with TLOCATE

Code: Select all

TLOCATE ?STACK

This switches to the EDITOR vocabulary and displays the screen with the source for ?STACK .

Those are all the words for the metacompiler. I recently made changes to Fleet Forth's kernel and built the new kernel with the new metacompiler. Everything seems to work fine.
Any questions?

[JimBoyd]

A few more words I glossed over.
I used ORIGIN in some of the examples. It takes a number from the data stack and makes that the value for THERE by setting TDP , target DP. The lowest value used for ORIGIN is retained in (ORIGIN) and used as the start address when saving the target with TSAVE .

I mentioned that the metacompiler has the following vocabulary structure:

Code: Select all

FORTH
  META
    SHADOW
      FORTH
        ASSEMBLER
  EDITOR
  ASSEMBLER

I already showed the source for some words to navigate this vocabulary tree. The following seven words are immediate.
HOST makes the host FORTH vocabulary the CONTEXT and CURRENT vocabulary.
TARGET makes the target FORTH vocabulary the CONTEXT and CURRENT vocabulary.
The following words only set the CONTEXT vocabulary.
[HOST] sets it to the host FORTH vocabulary. Note the brackets.
[TARGET] sets it to the target FORTH vocabulary.
[META] sets it to the META vocabulary.
[SHADOW] sets it to the SHADOW vocabulary.
[ASSEMBLER] sets it to the metacompiler's ASSEMBLER vocabulary.
These seven words are defined in the host FORTH vocabulary so they can be found from any other vocabulary.

The variable HEADLESS is used to count the number of headerless words. PNAMES is used to count the number of padded words.

The constant DEFINER-WORD is used by the word DEF-RESET to reset the definer words. It is also used by VERIFY to show which definer words were not defined in the target source. It is also used by PATCH-CF to check if the latest word defined in the target is actually a definer word.

The constant TARGET-WORD-CF is used to determine if a word is a target word.
TARGET-WORD-CF and the constants MACRO-CF and MUSER-CF are used by GLOSSARY to display appropriate data for target words, macros and the shadows of user variables.

HSUBR is defined in the host FORTH vocabulary.

Code: Select all

: HSUBR  ( -- )
   META?
   IF
      THERE CONSTANT ASSEMBLE EXIT
   THEN
   SUBR ;

If not metacompiling, it acts as an alias for SUBR , a word in the host system. This is so that even subroutines defined with HSUBR can be tested on the host system.
If metacompiling, it will create a constant in the TARGET vocabulary which holds the current address of THERE , target HERE . It then switches to assembling.
No header or code field is created.
The subroutine DOUBLE.COMPARE is used by four code words. This example just shows one.

Code: Select all

HSUBR DOUBLE.COMPARE
   6 ,X LDA  2 ,X CMP
   7 ,X LDA  3 ,X SBC
   4 ,X LDA  0 ,X SBC
   5 ,X LDA  1 ,X SBC
   RTS  END-CODE
CODE DU<  ( UD1 UD2 -- F )
   DOUBLE.COMPARE JSR
   CS NOT IF
      LABEL POP3.TRUE
      DEY
      LABEL POP3.FALSE
   THEN
   6 ,X STY  7 ,X STY  INX  INX
   POPTWO JMP  END-CODE

DOUBLE.COMPARE has no header and no code field. Its address is found by using the constant DOUBLE.COMPARE in the TARGET vocabulary which is on the host.