/cross.4

\ Cross compiler to produce machine-independent binary image of RelF

\ (Relative Forth). Uses kernel.4.

\ Based on SOD32 by L.C. Benschop

\ Copyright 2001 - 2005, Kirill Timofeev, kt97679@gmail.com

\ The program is released under the GNU General Public License version 2.

\ There is NO WARRANTY.



\ PART 1: THE VOCABULARIES.



VOCABULARY TARGET

\ This vocabulary will hold shadow definitions for all words that are in

\ the target dictionary. When a shadow definition is executed, it

\ performs the compile action in the target dictionary.



VOCABULARY TRANSIENT

\ This vocabulary will hold definitions that must be executed by the

\ host system ( the system on which the cross compiler runs) and that

\ compile to the target system.



\ Expl: The word IF occurs in all three vocabularies. The word IF in the

\       FORTH vocabulary is run by the host system and is used when

\       compiling host definitions. A different version is in the

\       TRANSIENT vocabulary. This one runs on the host system and

\       is used when compiling target definitions. The version in the

\       TARGET vocabulary is the version that will run on the target

\       system.





\ PART 2: THE TARGET DICTIONARY SPACE.



\ Next we need to define the target space and the words to access it.



20000 CONSTANT IMAGE_SIZE



CREATE IMAGE IMAGE_SIZE CHARS ALLOT \ This space contains the target image.

       IMAGE IMAGE_SIZE 0 FILL      \ Initialize it to zero.



\ Fetch and store characters in the target space.

: C@-T ( t-addr --- c) CHARS IMAGE + C@ ;

: C!-T ( c t-addr ---) CHARS IMAGE + C! ;



\ Fetch and store cells in the target space.

\ SOD32 is big endian 32 bit so store explicitly big-endian.

: @-T  ( t-addr --- x)

       CHARS IMAGE + DUP C@ 24 LSHIFT OVER 1 CHARS + C@ 16 LSHIFT +

       OVER 2 CHARS + C@ 8 LSHIFT + SWAP 3 CHARS + C@ + ;

: !-T  ( x t-addr ---)

       CHARS IMAGE + OVER 24 RSHIFT OVER C! OVER 16 RSHIFT OVER 1 CHARS + C!

       OVER 8 RSHIFT OVER 2 CHARS + C! 3 CHARS + C! ;



\ A dictionary is constructed in the target space. Here are the primitives

\ to maintain the dictionary pointer and to reserve space.



VARIABLE DP-T                       \ Dictionary pointer for target dictionary.

0 DP-T !                            \ Initialize it to zero, SOD starts at 0.

: THERE ( --- t-addr) DP-T @ ;      \ Equivalent of HERE in target space.

: ALLOT-T ( n --- ) DP-T +! ;       \ Reserve n bytes in the dictionary.

: CHARS-T ( n1 --- n2 ) ;

: CELLS-T ( n1 --- n2 ) 2 LSHIFT ;  \ Cells are 4 chars.

: ALIGN-T                           \ SOD only accesses cells at aligned

                                    \ addresses.

  BEGIN THERE 3 AND WHILE 1 ALLOT-T REPEAT ;

: ALIGNED-T ( n1 --- n2 ) 3 + -4 AND ;

: C,-T  ( c --- )  THERE C!-T 1 CHARS ALLOT-T ;

: ,-T   ( x --- )  THERE !-T  1 CELLS-T ALLOT-T ;



: PLACE-T ( c-addr len t-addr --- ) \ Move counted string to target space.

  OVER OVER C!-T 1+ CHARS IMAGE + SWAP CHARS CMOVE ;



\ After the Forth system is constructed, its image must be saved.

: SAVE-IMAGE ( "name" --- )

  32 WORD COUNT W/O BIN CREATE-FILE ABORT" Can't create file" >R

  IMAGE THERE R@ WRITE-FILE ABORT" Can't write file"

  R> CLOSE-FILE ABORT" Can't close file" ;



\ PART 3: CREATING NEW DEFINITIONS IN THE TARGET SYSTEM.



\ These words create new target definitions, both the shadow definition

\ and the header in the target dictionary. The layout of target headers

\ can be changed but FIND in the target system must be changed accordingly.



VARIABLE TLINK 0 TLINK !   \ This variable points to the name

                           \ of the last definition.



: "HEADER >IN @ CREATE >IN ! \ Create the shadow definition.

  ALIGN-T

  TLINK @ IF

    TLINK @ THERE - ,-T        \ Lay out the link field.

  ELSE

    0 ,-T

  THEN

  BL WORD

  COUNT DUP >R THERE PLACE-T  \ Place name in target dictionary.

  THERE TLINK !

  THERE C@-T 128 OR THERE C!-T R> 1+ ALLOT-T ALIGN-T ;

      \ Set bit 7 of count byte as a marker.



\ : "HEADER CREATE ALIGN-T ;  \ Alternative for "HEADER in case the target system

                      \ is just an application without headers.



ALSO TRANSIENT DEFINITIONS



: IMMEDIATE TLINK @ DUP C@-T 64 OR SWAP C!-T ;

            \ Set the IMMEDIATE bit of last name.



PREVIOUS DEFINITIONS





\ PART 4: CODE GENERATION



VARIABLE STATE-T 0 STATE-T ! \ State variable for cross compiler.

: T] 1 STATE-T ! ;

: T[ 0 STATE-T ! ;



VARIABLE CSP   \ Stack pointer checking between : and ;

: !CSP DEPTH CSP ! ;

: ?CSP DEPTH CSP @ - ABORT" Incomplete control structure" ;



VARIABLE LAST-PRIMITIVE 1 LAST-PRIMITIVE !



: LITERAL-T ( n --- ) 9 ,-T ,-T ;



ONLY FORTH ALSO TRANSIENT DEFINITIONS FORTH

\ Now define the words that do compile code.



: PRIMITIVE ( c --- )

  LAST-PRIMITIVE @ DUP 4 LAST-PRIMITIVE +!

  "HEADER DUP , ,-T 5 ,-T          \ Create an executable target definition.

  TLINK @ DUP C@-T 32 OR SWAP C!-T   \ Set the MACRO bit of last name. 

  DOES> @ ,-T

;



: : !CSP "HEADER THERE , T] DOES> @ THERE - 4 - ,-T ;



: ; 5 ,-T T[ ?CSP ; \ Compile EXIT (5). Quit compilation state.



FORTH DEFINITIONS



\ PART 5: FORWARD REFERENCES



\ Some definitions are referenced before they are defined. A definition

\ in the TRANSIENT voc is created for each forward referenced definition.

\ This links all addresses together where the forward reference is used.

\ The word RESOLVE stores the real address everywhere it is needed.



: FORWARD

  CREATE -1 ,              \ Store head of list in the definition.

  DOES> 

        DUP @ ,-T THERE 1 CELLS-T - SWAP ! \ Reserve a cell in the dictionary

                  \ where the call to the forward definition must come.

                  \ As the call address is unknown, store link to next

                  \ reference instead.

;



: RESOLVE

  ALSO TARGET >IN @ ' >BODY @ >R >IN ! \ Find the resolving word in the

                          \ target voc. and take the CFA out of the definition.

  TRANSIENT ' >BODY  @                 \ Find the forward ref word in the

                                       \ TRANSIENT VOC and take list head.

  BEGIN

   DUP -1 -                            \ Traverse all the links until end.

  WHILE

   DUP @-T                             \ Take address of next link from dict.

   R@ ROT SWAP OVER - 4 - SWAP !-T         \ Set resolved address in dict.

  REPEAT DROP R> DROP PREVIOUS

;



\ PART 6: DEFINING WORDS.



TRANSIENT DEFINITIONS FORTH



FORWARD DOVAR \ Dovar is the runtime part of a variable.



: VARIABLE "HEADER THERE , [ TRANSIENT ] DOVAR [ FORTH ]  0 ,-T

\ Create a variable.

  DOES> @ THERE - 4 - ,-T ;



: CONSTANT "HEADER THERE ,

  9 ,-T ,-T 5 ,-T \ Assemble the instruction LIT (9) with EXIT (5).

  DOES> @ 4 + @-T LITERAL-T \ Compile const as a literal for speed.

;



FORTH DEFINITIONS



: T' ( --- t-addr) \ Find the execution token of a target definition.

  ALSO TARGET ' >BODY @ \ Get the address from the shadow definition.

  PREVIOUS

;



: >BODY-T ( t-addr1 --- t-addr2 ) \ Convert executing token to param address.

  1 CELLS + ;



\ PART 7: COMPILING WORDS



TRANSIENT DEFINITIONS FORTH



: BEGIN THERE ;

: UNTIL 17 ,-T THERE - ,-T ;        \ 17 - conditional jump

: IF 17 ,-T THERE 1 CELLS ALLOT-T ; \ 13 - unconditional jump

: THEN THERE OVER - SWAP !-T ;

: ELSE 13 ,-T THERE 1 CELLS ALLOT-T SWAP THERE OVER - SWAP !-T ;

: WHILE 17 ,-T THERE 1 CELLS ALLOT-T SWAP ;

: REPEAT 13 ,-T THERE - ,-T THERE OVER - SWAP !-T ;



FORWARD (DO)

FORWARD (LOOP)

FORWARD (.")

FORWARD (ABORT")

FORWARD (POSTPONE)



: DO [ TRANSIENT ] (DO) [ FORTH ] THERE ;

: LOOP [ TRANSIENT ] (LOOP) [ FORTH ] THERE - ,-T ;

: ." [ TRANSIENT ] (.") [ FORTH ] 34 WORD COUNT DUP 1+ >R

      THERE PLACE-T R> ALLOT-T ALIGN-T ;

: POSTPONE [ TRANSIENT ] (POSTPONE) [ FORTH ] T' THERE - ,-T ;

: ABORT" [ TRANSIENT ] (ABORT") [ FORTH ] 34 WORD COUNT DUP 1+ >R

      THERE PLACE-T R> ALLOT-T ALIGN-T ;



: \ POSTPONE \ ; IMMEDIATE

: ( POSTPONE ( ; IMMEDIATE \ Move duplicates of comment words to TRANSIENT

: CHARS-T CHARS-T ; \ Also words that must be executed while cross compiling.

: CELLS-T CELLS-T ;

: ALLOT-T ALLOT-T ;

: ['] T' LITERAL-T ;



FORTH DEFINITIONS



\ PART 8: THE CROSS COMPILER ITSELF.



VARIABLE DPL

: NUMBER? ( c-addr ---- d f)

  -1 DPL !

  BASE @ >R

  COUNT

  OVER C@ 45 = DUP >R IF 1 - SWAP 1 + SWAP THEN \ Get any - sign

  OVER C@ 36 = IF 16 BASE ! 1 - SWAP 1 + SWAP THEN   \ $ sign for hex.

  OVER C@ 35 = IF 10 BASE ! 1 - SWAP 1 + SWAP THEN   \ # sign for decimal

  DUP  0 > 0= IF  R> DROP R> BASE ! 0 EXIT THEN   \ Length 0 or less?

  >R >R 0 0 R> R>

  BEGIN

   >NUMBER

   DUP IF OVER C@ 46 = IF 1 - DUP DPL ! SWAP 1 + SWAP ELSE \ handle point.

         R> DROP R> BASE ! 0 EXIT THEN   \ Error if anything but point

       THEN

  DUP 0= UNTIL DROP DROP R> IF DNEGATE THEN

  R> BASE ! -1

;





: CROSS-COMPILE

  ONLY TARGET DEFINITIONS ALSO TRANSIENT \ Restrict search order.

  BEGIN

   BL WORD

   DUP C@ 0= IF \ Get new word

    DROP REFILL DROP                      \ If empty, get new line.

   ELSE

    DUP COUNT S" END-CROSS" COMPARE 0=    \ Exit cross compiler on END-CROSS

    IF

     ONLY FORTH ALSO DEFINITIONS          \ Normal search order again.

     DROP EXIT

    THEN

    FIND IF                               \ Execute if found.

     EXECUTE

    ELSE

     NUMBER? 0= ABORT" Undefined word" DROP

     STATE-T @ IF \ Parse it as a number.

      LITERAL-T   \ If compiling then compile as a literal.

     THEN

    THEN

   THEN

  0 UNTIL

;



\ PART 9: CROSS COMPILING THE KERNEL



\ Up till now not a single byte of the new Forth kernel has actually been

\ compiled.



TRANSIENT DEFINITIONS

FORWARD COLD

FORWARD WARM

FORWARD DIV-EX

FORWARD BREAK-EX

FORWARD TIMER-EX

FORWARD THROW

FORTH DEFINITIONS



S" kernel.4" INCLUDED



\ PART 10: FINISHING AND SAVING THE TARGET IMAGE.



\ Resolve the forward references created by the cross compiler.

RESOLVE (DO)

RESOLVE DOVAR

RESOLVE (LOOP)

RESOLVE (.")

RESOLVE (ABORT")

RESOLVE COLD

RESOLVE WARM

\  RESOLVE DIV-EX

\  RESOLVE BREAK-EX

\  RESOLVE TIMER-EX

RESOLVE THROW

RESOLVE (POSTPONE)



\ Store appropriate values into some of the new Forth's variables.

TLINK @ T' FORTH-WORDLIST >BODY-T !-T

THERE   T' DP             >BODY-T !-T



SAVE-IMAGE kernel.img \ Save the newly constructed Forth system to disk.



BYE