6502.org

Posted: **Thu Mar 09, 2023 3:10 am**

[BEGIN] and [UNTIL] may not be needed on systems with EVALUATE .
Some source in ram block 1.

10
" CR DUP . 1- ?DUP 0= >IN !"
COUNT EVALUATE
CR .S

and the session log.

Code: Select all

1 RAM LOAD 
10 
9 
8 
7 
6 
5 
4 
3 
2 
1 
EMPTY  OK

When interpreting, " returns the address of a counted string. The Ansi Forth word S" returns the address of a string and its count.
Even with this taken into consideration, this example doesn't work with one of the versions of Gforth on my computers without further modification.

Code: Select all

10
S" CR DUP . 1- ?DUP 0= SOURCE NIP AND >IN !"
EVALUATE
CR .S

My Forth treats the value of >IN as unsigned. Any value of >IN greater or equal to the size of the text stream causes WORD to return a size of zero without causing an error.
My Forth's WORD uses a the word 'STREAM to obtain the address of the current location in the text stream and its remaining length.

Code: Select all

: 'STREAM  ( -- ADR N )
   BLK @ ?DUP
   IF
      BLOCK B/BUF
   ELSE
      TIB #TIB @
   THEN
   >IN @
   OVER UMIN /STRING ;

OVER UMIN clips the value fetched from >IN so it doesn't exceed the size of the text stream. UMIN returns the unsigned minimum of two numbers.
/STRING is a word from Ansi Forth which I found to be quite useful.

Code: Select all

/STRING   “slash-string”   STRING
   ( c-addr1 u1 n – – c-addr2 u2 )
   Adjust the character string at c-addr1 by n characters. The
   resulting character string, specified by c-addr2 u2, begins
   at c-addr1 plus n characters and is u1 minus n characters long.

Posted: **Thu Mar 09, 2023 3:20 am**

very interesting idea (in a sense looping in a string that's being interpreted) !

Posted: **Thu Mar 09, 2023 3:51 am**

There are a few places in the source for Fleet Forth where I use EVALUATE .
The following fills in the table holding the default vector for all the deferred words defined in Fleet Forth's kernel. This is done after the vectors for the deferred words have been set.

Code: Select all

START.I&F
" TARGET  DUP @ @ OVER 2+ ! 4 +
  END.FORGET OVER 2+ U<
  HOST >IN !"
COUNT EVALUATE  TARGET
DROP

I also use EVALUATEd strings to automate defining parameters to use while building the kernel. For example, in the source for the kernel there is the following:

Code: Select all

$63E DEFINE DR.OFFSET

That number is the largest number of blocks a dual disk version of the 1581 drive could hold, if such a device existed. The EVALUATEd strings which follow round that number up to the closest power of 2 and set other parameters used to define words such as R/W , RAM and DR+ .

Code: Select all

// BLOCK SUBSYSTEM PARAMETERS
// THESE PARAMETERS ARE DETERMINED
// BY THE VALUE DR.OFFSET
DR.OFFSET $100 UMAX $8000
" HOST 1 RSHIFT 2DUP SWAP U< >IN !"
COUNT EVALUATE  TARGET
NIP 7 RSHIFT DEFINE DR.OFS.HI
0 DR.OFS.HI
" HOST 1 UNDER+ 2/ ?DUP 0= >IN !"
COUNT EVALUATE  TARGET  7 + 0
HEX <# #S ASCII $ HOLD #> DECIMAL
MACRO DR.OFS.PWR
#DRIVES DR.OFS.PWR LSHIFT 0
HEX <# #S ASCII $ HOLD #> DECIMAL
MACRO RAM.OFFSET

Posted: **Sun Mar 19, 2023 10:47 pm**

The source for R/W , RAM and DR+ . Note: RR/W and DR/W are DEFERred words.

Code: Select all

CODE R/W  ( ADR BLK# R/WF CNT -- )
   BEGIN
      SEC  5 ,X LDA  DR.OFS.HI # SBC
   CS WHILE
      5 ,X STA  INY  #DRIVES # CPY
   0= UNTIL
      ' RR/W SPLIT SWAP
      # LDA  # LDY
      (EXECUTE) 0= NOT BRAN
   THEN
   DRB STY
   ' DR/W SPLIT SWAP
   # LDA  # LDY
   (EXECUTE) 0= NOT BRAN  END-CODE

: RAM  ( BLK#1 -- BLK#2 )
   RAM.OFFSET + ;

: DR+  ( BLK#1 #DR -- BLK#2 )
   7 AND  DR.OFS.PWR LSHIFT  + ;

and what gets assembled and compiled.

Code: Select all

R/W
  3931          SEC
  3932     5 ,X LDA
  3934     8  # SBC
  3936  3951    BCC
  3938     5 ,X STA
  3940          INY
  3941     8  # CPY
  3943  3931 ^^ BNE
  3945   184  # LDA
  3947    11  # LDY
  3949  3920 ^^ BNE ' EXECUTE >BODY 6 +
  3951  2686    STY ' DRB >BODY
  3954   173  # LDA
  3956    11  # LDY
  3958  3920 ^^ BNE ' EXECUTE >BODY 6 +
29 

RAM
  9988  2497 LIT 16384 
  9992  4944 +
  9994  2469 EXIT
8 

DR+
 12004  3308 CLIT 7 
 12007  4556 AND
 12009  3308 CLIT 11 
 12012  5268 LSHIFT
 12014  4944 +
 12016  2469 EXIT
14

The use of RAM and DR+ is mentioned here.
R/W is Fleet Forth's BLOCK reading and writing word.

Posted: **Thu Mar 23, 2023 2:25 am**

The redesign of Fleet Forth's metacompiler is complete. I'm fairly certain I presented all the source and covered everything.
Any questions?

Posted: **Thu Mar 23, 2023 2:30 am**

Just use it a lot to wring out any bugs, and write a good manual for it.

Posted: **Tue Mar 28, 2023 1:52 am**

The new metacompiler's first big test was metacompiling an existing version of Fleet Forth. Since I'm using VICE instead of a real Commodore 64, the disks are actually disk images and the disk image with the new kernel was identical to the one created with the original metacompiler. I also have SEEALL to test kernels I build. Successfully loading the system loader and the utilities is a test. SEEALL showing the expected disassembly/decompilation is another.

Code: Select all

: (SEE)  ( CFA -- )
   DUP CR .NAME
   SETWIDTH <SEE> ;
: SEE  ( -- )  ' (SEE) ;
: SEEALL  ( -- )
   WITH-WORDS  NAME> (SEE)
   COLS ?CR ;

I've simplified some of the more obscure code for the metacompiler by adding two new words. These new words use the coroutine word CO

Code: Select all

: >META  ( -- )
   ORDER@
   META DEFINITIONS
   CO ORDER! ;
: >SHADOW  ( -- )
   ORDER@
   [SHADOW] SHADOW DEFINITIONS
   CO ORDER! ;

The word >META saves the values of CONTEXT and CURRENT to the auxiliary stack then changes the search and compile vocabularies to META . CO causes the rest of >META to run after >META's caller exits. That last part of >META restores the CONTEXT and CURRENT vocabularies.
>SHADOW does the same thing for the SHADOW vocabulary.
This source

Code: Select all

: DEFINE  ( W -- )
   ORDER@
   [SHADOW] SHADOW DEFINITIONS
   CONSTANT  ORDER! ;

META DEFINITIONS
: MACRO  ( ADR CNT -- )
   ORDER@
   [SHADOW] SHADOW DEFINITIONS
   [HOST] MACRO ORDER! ;
HOST

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

is simplified to this

Code: Select all

: DEFINE  ( W -- )
   >SHADOW CONSTANT ;

META DEFINITIONS
: MACRO  ( ADR CNT -- )
   >SHADOW MACRO ;
HOST

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

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

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

0 VALUE MUSER-CF
: <MUSER>  ( C ADR -- )
   >IN @  HEADER  >IN !  CF,
   DUP VC,
   >SHADOW
   CREATE
      C,
      [ HERE 2+ TO MUSER-CF ]
   DOES>
      C@ USER.AREA + ;

Likewise, this source

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

: DEF-RESET  ( -- )
   ['] ORDER! >BODY >R
   ORDER@ META WITH-WORDS
   NAME> DUP @ DEFINER-WORD <>
   IF  DROP EXIT  THEN
   >BODY 2+ 6 ERASE ;

: 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" ;

is simplified to this

Code: Select all

: DEFINER  ( CFA -- )
   >META
   CREATE
      ,  0 ,  0 , 0 ,
   [ HERE 2+ >A ]
   DOES>
      DUP 2+ SWAP @ EXECUTE ;
   A> CONSTANT DEFINER-WORD

: DEF-RESET  ( -- )
   >META WITH-WORDS
   NAME> DUP @ DEFINER-WORD <>
   IF  DROP EXIT  THEN
   >BODY 2+ 6 ERASE ;

: VERIFY  ( -- )
   >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" ;

The metacompiler built with these changes successfully metacompiled Fleet Forth's kernel.

Posted: **Tue Mar 28, 2023 8:48 am**

That's quite the milestone - congratulations!

Posted: **Thu Apr 06, 2023 2:03 am**

I mentioned that the metacompiler supports LABELs because the target is built in virtual memory. The version of LABEL which is used to test compile target source on the host uses VALUE's which are defined before the test code. The HOST version of LABEL was defined like this:

Code: Select all

: LABEL  ( -- )
  CONTEXT @
  FORTH // HOST FORTH VOCABULARY
  HERE ' DUP @
  [ ' #BUF @ ] LITERAL <>
  ABORT" NOT A LABEL"
  >BODY !  CONTEXT ! ; IMMEDIATE

I was testing a modification to Fleet Forth. Some of the words branch to NEXT . This version of LABEL wasn't going to work since I needed some of the test words to branch to the address for NEXT in one of the test words. I needed a VALUE defined in the host assembler to successfully test the new code.
This is the new definition of the HOST version of LABEL .

Code: Select all

: LABEL  ( -- )
  HERE ' DUP @
  [ ' #BUF @ ] LITERAL <>
  ABORT" NOT A LABEL"
  >BODY ! ; IMMEDIATE

To test the modification to Fleet Forth on the HOST , I needed to be able to alter the address of NEXT in the HOST ASSEMBLER yet be able to EMPTY the dictionary back to its pre test state and have NEXT assume its former contents.

Code: Select all

ASSEMBLER DEFINITIONS
NEXT VALUE NEXT
FORTH DEFINITIONS

Once a VALUE is defined for each label in the test code, the test code (including NEXT and the word which passes through it) is loaded.
Testing then commences; although, the first test was loading the source to see if all the intended branches to NEXT were within range. Fleet Forth's assembler and the metacompiler's assembler both abort with an error message if the intended branch is out of range.
BO for branch offset.

Code: Select all

: BO  ( DEST SOURCE -- BRANCH.OFFSET )
   1+ - DUP 0< OVER ABS +  7F >
   ABORT" BRANCH RANGE EXCEEDED" ;

Once testing is done EMPTY is used to prune back the dictionary and forget the VALUE NEXT which exposes the original CONSTANT NEXT .

Posted: **Sun Apr 16, 2023 8:51 pm**

Another test run called for another modification to one of the metacompiler words.
Fleet Forth has SUBR to create a word which returns its own PFA like a VARIABLE . Unlike a variable, no storage is allotted, the assembler is invoked. For example, (>FORTH) returns the address of the code used to transition from a code word to high level Forth.

Code: Select all

SUBR (>FORTH)  ( -- )
   CLC
   PLA  1 # ADC  TAY
   PLA  0 # ADC
   LABEL (CO)
   N STA
   IP 1+ LDA  PHA
   IP    LDA  PHA
   N LDA  IP STY
   ' EXIT @ 4 + JMP
   END-CODE

>FORTH assembles a JSR to (>FORTH) as well as setting STATE to compiling and setting CONTEXT equal to CURRENT .

Code: Select all

: >FORTH  ( -- )
   ?EXEC
   (>FORTH) JSR
   [ FORTH ]
   CURRENT @ CONTEXT !
   ] ; IMMEDIATE

A SUBR or subroutine in Fleet Forth is a word which returns the address of a routine which is exactly that, a subroutine.

Code: Select all

SUBR ROUTINE1
   <SOME ASSEMBLY>
   RTS END-CODE

CODE TESTWORD
   ROUTINE1 JSR
   <SOME MORE ASSEMBLY>
   NEXT JMP  END-CODE

The metacompiler's SUBR works as expected.The metacompiler also supports HSUBRs, subroutines without headers. Since there is no header, there is no need for a code field. HSUBR creates a CONSTANT on the host containing the address of the routine in virtual memory.
The problem arose when testing target source on the host. When testing code on the host, HSUBR would just call the host assembler's SUBR . This normally works. When it didn't work was when there was a branch in range on the target because there was no header or code field to get in the way, but the test on the host didn't assemble because the branch was out of range. The header and code field got in the way. The new version of HSUBR works the same as the old when metacompiling. When testing on the host, it requires the name which follows in the text stream to be a predefined VALUE just like the host version of LABEL . Now there is no header or code field to get in the way of code during testing on the host.

Code: Select all

0 VALUE DOUBLE.COMPARE  \ These definitions are only needed
0 VALUE POP3.TRUE       \ when testing on the host
0 VALUE POP3.FALSE      \ not when metacompiling

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

CODE D<  ( D1 D2 -- F )
   DOUBLE.COMPARE JSR
   VS IF  $80 # EOR  THEN
   POP3.TRUE 0< BRAN
   POP3.FALSE 0< NOT BRAN

Source for the new HSUBR .

Code: Select all

: HSUBR  ( -- )
   META?
   IF
      THERE CONSTANT ASSEMBLE EXIT
   THEN
   [COMPILE] LABEL [ ASSEMBLER ]
   W TRUE ASSEMBLER MEM ;

I found out about this problem when testing a modification for source close to NEXT . The modification should have worked. I tested it on the host before committing to building a new kernel with the metacompiler. When I did, I got the dreaded "BRANCH RANGE EXCEEDED" error.
I did not get that error when testing with the new version of HSUBR .

Posted: **Mon Jul 03, 2023 11:39 pm**

As I've already mentioned, for each type of CREATE DOES> or CREATE ;CODE word supported by the metacompiler, all the code fields for a given class of word are linked in a chain until the parent word of that type is defined for the target. CODE words are the only exception. I also mentioned the problem I ran into with trying to use CREATE rather than CODE for code words with no body. There is another problem which only occurs when trying to minimize the amount of virtual memory needed to build the Forth kernel. Some Commodore 64s may not have a Ram Expansion Unit. In this case, it is possible to write a version of (RR/W) to access the ram underneath the kernal ROM and I/O.
A reminder, this is how the current build of Fleet Forth maps blocks on the computer to blocks on devices.

Code: Select all

Blocks:    Device:  Range seen by device:
    0 -  $7FF   8      0 - $7FF
 $800 -  $FFF   9      0 - $7FF
                .
                .
                .
$3800 - $3FFF  15      0 - $7FF
$4000 - $FFFF  REU     0 - $BFFF

Each disk drive "sees" the blocks in the range 0 to 2047 and none of them have the capacity for 2048 blocks. Most have considerably less.

The target built by the metacompiler loads at location $801 so the first $801 bytes of virtual memory are not used to build it. On a Commodore 64 without a Ram Expansion Unit, virtual memory could be set to start two blocks below the start of blocks used from ram by setting VOFFSET like this:

Code: Select all

-2 RAM TO VOFFSET

This will reduce by two the number of blocks needed for virtual memory; however, the first $800 bytes of virtual memory are mapped to blocks $3FFE - $3FFF and are no longer accessible.
There is a side effect with the version of chains which uses two cells, one for the latest link and one for the previous link. Initialization causes a read from memory location zero in virtual memory. I could have written a test to avoid this, but it was easier to just remove the unnecessary feature form the metacompiler.
MEND-CHAIN and ADD-CHAIN were removed. The following words were rewritten.

Code: Select all

: CF,  ( ADR -- )
   DUP @
   IF  @ V,  EXIT  THEN
   2+ VADD ;

: DEFINER  ( CFA -- )
   >META
   CREATE
      ,  0 ,  0 ,
      // CFA OF META WORD TO EXECUTE
      // FLAG -- ZERO OR TARGET CFA
      // CHAIN OF WORDS
   [ HERE 2+ >A ]
   DOES>
      DUP 2+ SWAP @ EXECUTE ;
   A> CONSTANT DEFINER-WORD

: 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+ @
   BEGIN
      ?DUP  0EXIT
      DUP  V@  THERE ROT V!
   AGAIN -;

: DEF-RESET  ( -- )
   >META WITH-WORDS
   NAME> DUP @ DEFINER-WORD <>
   IF  DROP EXIT  THEN
   >BODY 2+ 4 ERASE ;

The code field patching portion of PATCH-CF is slightly smaller. I also improved VTRAVERSE .

Code: Select all

: VTRAVERSE  ( VADR DIR -- VADR2 )
   BEGIN
      DUP UNDER+ OVER VC@ $7F >
   UNTIL
   DROP ;

I have already tested these changes to the metacompiler by building a Forth kernel and comparing it to the latest build. They were identical.

Posted: **Tue Sep 12, 2023 6:36 pm**

The DO LOOP run-time words are not specifically mentioned in the Forth-83 Standard and could have different names. A DO LOOP run-time word could even have the same name as the word which compiles it; however, the metacompiler does not allow redefinitions in the TARGET vocabulary.
To summarize the previous posts, while metacompiling is on:
When a target word is found which is to be interpreted, because STATE is off or the word is immediate, the search continues with the parent vocabulary.
When a NON target word is found which is to be compiled, the search continues with the parent vocabulary.
Only non-immediate target words can be compiled without the use of [COMPILE] and only non-target words can be interpreted.

Consider simply changing the name of (DO) to DO .

Code: Select all

CODE DO  ( LIMIT START -- )
   ...
   ...
   END-CODE

There could be DO LOOPs in the source before the compiling word DO is defined. Indeed, DO and the other DO LOOP compiling words might not even be defined in the source for the Forth kernel. They could just as easily be defined in the system loader which is loaded by the new kernel. Rather than encountering the immediate word DO and continuing the search in a parent vocabulary, the non-immediate run-time DO would be compiled. The DO LOOPs would not be compiled correctly.
In spite of this, there is a way to give the run-time for DO the same name. A helper word needs added to the metacompiler.

Code: Select all

ALIAS DO
CODE (DO)  ( LIMIT START -- )
   ...
   ...
   END-CODE

The TARGET FORTH vocabulary on the host will now have the name (DO) but the target in virtual memory will have the name DO .
This will work; however, there is one gotcha. When the system is built on this new kernel and the metacompiler lexicon built on top of that, the metacompiler on the new system will not be able to compile DO LOOPs.
In solving this problem I came up with two different solutions which resulted in two versions of the metacompiler. They were the same except for what feature was added.
Both versions of the metacompiler worked. I tested each one by metacompiling the new kernel then building the system and metacompiler on top of that. The new metacompiler on the new system was then used to metacompile a kernel again. The kernels were identical. All four of them.

Access to the DO LOOP run-time words was still needed to build the high level portion of SEE . The run-time words are defined before the word FORTH-83 and the DO LOOP compiling words are defined after FORTH-83 . Fleet Forth's FIND searches the CONTEXT vocabulary (and parents) then, if necessary, searches the CURRENT vocabulary.

Code: Select all

: FIND  ( ADR -- ADR2 F )
   CONTEXT @ (FIND)
   ?DUP ?EXIT
   CURRENT @ VFIND ;

To access the DO LOOP run-time words a false vocabulary was created and CONTEXT was pointed to it.

Code: Select all

' FORTH-83 >LINK 2 ! 4 OFF \ Create false vocabulary starting at FORTH-83
2 CONTEXT !                \ and point CONTEXT there.
AMONG (?BRAN)
   ] BRANCH ?BRANCH
   DO ?DO LOOP +LOOP
   [ 0 ,

CONTEXT was reset after the word (?BRAN) was created.

SEE works fine on the new system.

Code: Select all

 OK
: TEST 
   5 0 
   DO  CR I .  LOOP ;  OK
TEST 
0 
1 
2 
3 
4  OK
SEE TEST 
TEST
 23855  3332 CLIT 5 
 23858  3317 0
 23860  2313 DO 23874 
 23864  6753 CR
 23866  2417 I
 23868  7492 .
 23870  2195 LOOP 23864 
 23874  2472 EXIT
21 
 OK
SEE DO 
DO IMMEDIATE
 11718  8406 COMPILE
 11720  2313 DO
 11722 11474 >MARK
 11724  4843 2+
 11726 11494 <MARK
 11728  4843 2+
 11730  2472 EXIT
14 
 OK
2313 (SEE) 
DO
  2315          INY
  2316   251 )Y LDA IP
  2318          PHA
  2319          DEY
  2320   251 )Y LDA IP
  2322          PHA
  2323          CLC
  2324     3 ,X LDA
  2326   128  # ADC
  2328          PHA
  2329     3 ,X STA
  2331     2 ,X LDA
  2333          PHA
  2334          SEC
  2335     0 ,X LDA
  2337     2 ,X SBC
  2339          TAY
  2340     1 ,X LDA
  2342     3 ,X SBC
  2344          PHA
  2345          TYA
  2346          PHA
  2347          INX
  2348          INX
  2349          INX
  2350          INX
  2351  2275 ^^ BPL ' ?BRANCH >BODY 8 +
  2353  2250 ^^ BMI ' ! >BODY 20 +
40 
 OK

Although it is a little odd to SEE DO and notice that DO compiles DO .

Posted: **Sun Sep 17, 2023 6:49 pm**

JimBoyd wrote:

In solving this problem I came up with two different solutions which resulted in two versions of the metacompiler. They were the same except for what feature was added.

For reference I will refer to the version of the metacompiler without either of these solutions as the base metacompiler. It is this base upon which version A and version B are built.
First, some words in the base metacompiler were cleaned up.
The original source for PNAME and VHEADER .

Code: Select all

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

: VHEADER  ( >IN -- >IN )
   VNAME TFIND NIP
   ABORT" REDEFINITION IN TARGET"
   HEAD @
   IF
      DUP >IN !
      HERE C@ THERE + 4 +
      SPLIT DROP 0=
      IF  PNAME  THEN
      WLINK VADD
      VNAME C@  THERE $80 VTOGGLE
      VALLOT  THERE $80 VTOGGLE
      1 VALLOT
      EXIT
   THEN
   THERE 1+ SPLIT DROP 0=
   IF  PNAME  THEN
   1 HEADLESS +! ;
HOST

and the improved source.

Code: Select all

: PNAME  ( ADR -- )
   1+ SPLIT DROP ?EXIT      \ If the low byte of the address is not $FF then exit.
   1 VALLOT  1 PADDED +!    \ Pad the virtual header and increment the padded count.
   COLS ?CR ." PADDED: R"   \ If not at left column perform carriage return
   HERE S? CR ;             \ before displaying the name of the padded word.

: VHEADER  ( -- )
   >IN @  VNAME TFIND NIP           \ Save >IN. If the parsed name already exists
   ABORT" REDEFINITION IN TARGET"   \ in the target vocabulary then abort.
   HEAD @                           \ If HEAD is on
   IF                               \ create header.
      >IN !                         \ Restore >IN to parse the name again.
      HERE C@ THERE + 2+ 1+ PNAME   \ Avoid the indirect jump bug.
      WLINK VADD                    \ Create the link field.
      VNAME C@  THERE $80 VTOGGLE   \ Create the name field with high bit set
      VALLOT  THERE $80 VTOGGLE     \ for count and last character.
      1 VALLOT                      \
      EXIT
   THEN                             \ If HEAD is off
   DROP  1 HEADLESS +!              \ increment the count of headerless words
   THERE PNAME ;                    \ and avoid the indirect jump bug.

PNAME now takes an address and pads the header, if necessary, to avoid the code field straddling a page boundary.
VHEADER now no longer requires the value of >IN on the data stack and it returns nothing.

I will present the first solution, metacompiler A.
Here is the base metacompiler's vocabulary structure.

Code: Select all

FORTH
  META
    SHADOW
      FORTH
        ASSEMBLER
  EDITOR
  ASSEMBLER

The vocabulary RUN is added to the META vocabulary.

Code: Select all

FORTH
  META
    SHADOW
      FORTH
        ASSEMBLER
    RUN
  EDITOR
  ASSEMBLER

The variable ALIASES is added to keep a count of how many words have an alias.
The new word ALIAS creates a header in virtual memory and a target word (a handle) in the RUN vocabulary. ALIAS also switches off header creation in virtual memory for the next word with NH .

Code: Select all

: ALIAS  ( ++ )
   ORDER@ [META] RUN DEFINITIONS     \ Save the search order and 
   HEADER NH                         \ create header in RUN vocabulary.
   ORDER!                            \ Restore the search order.
   TRUE HEADLESS +!  1 ALIASES +! ;  \ Correct the headless count and
                                     \ increment the count of aliases.

ALIAS is used like this:

Code: Select all

ALIAS DO
CODE (DO)  ( LIMIT START -- )
   ...
   ...
   END-CODE

Here is the base metacompiler's MCOMPILE .

Code: Select all

CODE MCOMPILE  ( -- )
   >FORTH                           \ Shift to high level Forth.
   ?COMP                            \ Abort if not compiling.
   R> DUP 2+ >R @                   \ Get the CFA of next word in Forth thread containing MCOMPILE
   >NAME COUNT $1F AND >HERE CLIP   \ and use the name field to create a search string at HERE .
   TFIND ?TARGET M, ;               \ Search the TARGET FORTH vocabulary and abort if not found.
                                    \ If found, compile to virtual memory with M, .

and the modified MCOMPILE .

Code: Select all

CODE MCOMPILE  ( -- )
   >FORTH                           \ Shift to high level Forth.
   ?COMP                            \ Abort if not compiling.
   R> DUP 2+ >R @                   \ Get the CFA of next word in Forth thread containing MCOMPILE
   >NAME COUNT $1F AND >HERE CLIP   \ and use the name field to create a search string at HERE .
   TFIND TRUE <>                    \ If not found or if immediate
   IF
      DROP  HERE [META]             \ drop the result and use the string at HERE
      [ ' RUN >BODY ] LITERAL       \ to search the RUN vocabulary.
      VFIND TRUE <>                 \ If still not found
      ABORT" RUN-TIME NOT FOUND"    \ abort.
   THEN
   M, ;                             \ If found, compile to virtual memory.

The modified MCOMPILE for metacompiler A still creates a search string from the name field of the next word in it's definition.

Code: Select all

: TEST
   MCOMPILE (TEST) ; IMMEDIATE

When TEST is executed, MCOMPILE will create the search string "(TEST)" at HERE .
The TARGET FORTH vocabulary is searched by TFIND .If the sought word is not found or if it is immediate, the result is dropped and the RUN vocabulary is searched. Once more, the result has to be for a word which is not immediate.
VFIND does not search parent vocabularies.

This version of the metacompiler allows changing the names of run-time words with ALIAS ; however, there is one downside.
Using DO and it's run-time as an example.

Code: Select all

ALIAS DO
CODE (DO)  ( LIMIT START -- )
   ...
   ...
   END-CODE

There are now two handles on the host system for the same target word in virtual memory, this is not the problem. If the name of the run-time for DO on the host system does not match either one, a new alias is needed.

Code: Select all

ALIAS DO   \ Name of run-time for new kernel. Creates handle DO in RUN vocabulary and header DO in virtual memory.
ALIAS D    \ Name of run-time in host system. Creates handle D in RUN vocabulary. header creation in virtual memory suppressed.
CODE (DO)  \ Name of run-time used in kernel source. Creates handle (DO) in TARGET FORTH vocabulary. header creation in virtual memory suppressed.
   ...
   ...
   END-CODE

This creates three handles for the same word in virtual memory, one in the TARGET FORTH vocabulary and two in the RUN vocabulary.
There is only one header created in virtual memory for this word since ALIAS suppresses header creation in the following word.

Posted: **Sun Sep 17, 2023 8:52 pm**

I will now present the second solution, metacompiler B.
No new metacompiler vocabularies are added. This metacompiler's ALIAS does not create a target word. It creates a header in virtual memory. It does use NH to switch off header creation in virtual memory for the next word.

Code: Select all

: ALIAS  ( -- )
   VHEADER NH
   TRUE HEADLESS +!  1 ALIASES +! ;

ALIAS is used in this metacompiler just like the other version.

Code: Select all

ALIAS DO
CODE (DO)  ( LIMIT START -- )
   ...
   ...
   END-CODE

MCOMPILE was modified slightly so the search only succeeds if the word found is not immediate.

Code: Select all

CODE MCOMPILE  ( -- )
   >FORTH                           \ Shift to high level Forth.
   ?COMP                            \ Abort if not compiling.
   R> DUP 2+ >R @                   \ Get the CFA of next word in Forth thread containing MCOMPILE
   >NAME COUNT $1F AND >HERE CLIP   \ and use the name field to create a search string at HERE .
   TFIND TRUE <>                    \ If not found or if immediate
   ABORT" RUN-TIME NOT FOUND"       \ abort.
   M, ;                             \ If found, compile to virtual memory.

With these modifications it is possible to create a kernel where each of the DO LOOP run-time words has the same name as it's compiling word. The next addition to metacompiler B will allow it to work when built on the new system.
The word :: (double colon) is an alias for the host colon. This will allow accessing colon's functionality while defining words in the META vocabulary, where colon was redefined.

Code: Select all

: ::  ( -- ADR TRUE )
   : ;  // ACCESS TO HOST COLON

These words defined in the META vocabulary are stubs. They don't get compiled or metacompiled. MCOMPILE uses their names to find the corresponding word in the TARGET FORTH vocabulary.

Code: Select all

META DEFINITIONS
:: (DO)   ;
:: (?DO)   ;
:: (LOOP)   ;
:: (+LOOP)   ;
HOST DEFINITIONS

These are metacompiler B's DO LOOP compiling words.

Code: Select all

META DEFINITIONS
:: DO  ( -- >SYSL <SYSL )
   MCOMPILE (DO)
   >MARK 2+ 2+
   <MARK 2+ 2+ ; IMMEDIATE
:: ?DO  ( -- >SYSL <SYSL )
   MCOMPILE (?DO)
   >MARK 2+ 2+
   <MARK 2+ 2+ ; IMMEDIATE
:: LOOP  ( >SYSL <SYSL -- )
   MCOMPILE (LOOP)
   2- 2- <RESOLVE
   2- 2- >RESOLVE ; IMMEDIATE
:: +LOOP  ( >SYSL <SYSL -- )
   MCOMPILE (+LOOP)
   2- 2- <RESOLVE
   2- 2- >RESOLVE ; IMMEDIATE
HOST

Recall that the new semicolon will behave just like the host semicolon when metacompiling is off.
I could have defined these metacompiler DO LOOP compiling words with COMPILE since COMPILE gets patched when metacompiling.
This version of the metacompiler works well; however, there is a slight downside. If I want to rename the run-time for ." so it has the same name as ." , I will need to define a stub for the run-time and a metacompiler version of ." . The same is true for any run-time I wish to rename.

Code: Select all

META DEFINITIONS
:: (.")   ;
:: (ABORT")   ;

:: ."  ( -- )
   COMPILE (.")
   ," ; IMMEDIATE
:: ABORT"  ( -- )
   COMPILE (ABORT")
   ," ; IMMEDIATE
HOST

or

Code: Select all

META DEFINITIONS
:: (.")   ;
:: (ABORT")   ;

:: ."  ( -- )
   MCOMPILE (.")
   V," ; IMMEDIATE
:: ABORT"  ( -- )
   MCOMPILE (ABORT")
   V," ; IMMEDIATE
HOST

I thought of yet another approach to this problem and I think it will yield the best version of the metacompiler.

Posted: **Sun Sep 17, 2023 9:53 pm**

Metacompiler C, the, hopefully, last solution to this problem.
The only differences with metacompiler B:
:: (double colon) is not defined.
MCOMPILE is different.

Code: Select all

: CFA>STR  ( CFA -- HERE )
   >NAME COUNT $1F AND >HERE CLIP ;  \ Use CFA to generate a search string 
                                     \ from a word's name field.
CODE MCOMPILE  ( -- )
   >FORTH
   ?COMP  R> DUP 2+ >R @ CFA>STR     \ Get CFA of next word in definition
                                     \ to generate search string.
   TFIND TRUE <>                     \ If the word is not found or is
   IF                                \ immediate
      DROP  R@ 2- 2- BODY>  CFA>STR  \ Back up to CFA of the word containing
      ASCII ) OVER COUNT + C!        \ MCOMPILE to generate a search string
      DUP DUP 1+ BL MOVE             \ and modify string to be enclosed in
      ASCII ( OVER 1+ C!             \ parenthesis.
      2 OVER +!  TFIND TRUE <>       \ Search the TARGET FORTH vocabulary
      ABORT" RUN-TIME NOT FOUND"     \ and abort if not found.
   THEN
   M, ;                              \ If found, compile to virtual memory.

CFA>STR takes the CFA of a word and generates a string at HERE which is the same as the word's name.
MCOMPILE still generates a search string based on the name of the word to be metacompiled by MCOMPILE . If the search is unsuccessful or the word found is immediate, MCOMPILE will generate a search string from the name of the word which contains METACOMPILE . This search string will be the compiling word's name enclosed in parenthesis.
Using DO as an example.
Suppose the run-time for DO on the host system is still named (DO) .
MCOMPILE generates the string "(DO)" and searches for this string in the TARGET FORTH vocabulary. It will be found and the address for (DO) in virtual memory will be compiled to virtual memory.
Suppose the run-time for DO on the host has a different name. Let's suppose it is something absurd like DO.RUNTIME .
MCOMPILE tries to find DO.RUNTIME in the TARGET FORTH vocabulary and fails.
MCOMPILE then generates a string from the name field of the compiling word, in this case DO . The string will have parenthesis added.
Here is a sample test.

Code: Select all

: TESTWORD
   MCOMPILE FOOBAR ; IMMEDIATE

FOOBAR does not exist in the TARGET FORTH vocabulary. In this example, (TESTWORD) does exist in the TARGET FORTH vocabulary.
MCOMPILE tries to find the target word FOOBAR in the TARGET FORTH vocabulary. When that fails, it tries to find (TESTWORD) in the TARGET FORTH vocabulary and succeeds.
Run-time words with the same name in the host system and the source used by the metacompiler work fine.
Examples are ?BRANCH and BRANCH used by most of the control flow words.
Run-time words with different names in the host system and the source used by the metacompiler will work if the name of the run-time in the source is a parenthesized version of the compiling word's name.
Examples are (DO) compiled by DO and (LOOP) compiled by LOOP . These run-time words can be given a different name on the target being built in virtual memory by using the word ALIAS .

At present, I don't see a downside to this version of the metacompiler

6502.org

Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign

Re: Fleet Forth metacompiler redesign