diff examples_forth/meta09.4 @ 57:2088fd998865

sbc09 directry clean up
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 23 Jul 2018 16:07:12 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/examples_forth/meta09.4	Mon Jul 23 16:07:12 2018 +0900
@@ -0,0 +1,337 @@
+\ CROSS COMPILER FOR THE MOTORAOLA 6809 PROCESSOR
+\ created 1995 by L.C. Benschop.
+\ copyleft (c) 1995-2014 by the sbc09 team, see AUTHORS for more details.
+\ license: GNU General Public License version 2, see LICENSE for more details.
+\
+\ This serves as an introduction to Forth cross compiling, so it is excessively
+\ commented.
+\
+\ This cross compiler can be run on any ANS Forth with the necessary
+\ extension wordset that is at least 16-bit, including Motorola 6809 Forth.
+\
+\ It creates the memory image of a new Forth system that is to be run
+\ by the Motorola 6809 processor.
+\
+\ The cross compiler (or meta compiler or target compiler) is similar
+\ to a regular Forth compiler, except that it builds definitions in
+\ a dictionary in the memory image of a different Forth system.
+\ We call this the target dictionary in the target space of the
+\ target system.
+\
+\ As the new definitions are for a different Forth system, the cross
+\ compiler cannot EXECUTE them. Neither can it easily find the new
+\ definitions in the target dictionary. Hence a shadow definition
+\ for each target definition is made in the normal Forth dictionary.
+\
+\ The names of the new definitions overlap with the names of existing
+\ elementary. Forth words. Therefore they need to be in a wordlist
+\ different from the normal Forth wordlist.
+
+\ 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.
+
+\  : \D ; \ Uncomment one of these. If uncommented, display debug info.
+ : \D POSTPONE \ ; IMMEDIATE
+
+\ PART 2: THE TARGET DICTIONARY SPACE.
+
+\ Next we need to define the target space and the words to access it.
+
+1024 CONSTANT ORIGIN \ Start address of Forth image.
+8192 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) ORIGIN - CHARS IMAGE + C@ ;
+: C!-T ( c t-addr ---) ORIGIN - CHARS IMAGE + C! ;
+
+\ Fetch and store cells in the target space.
+\ M6809 is big endian 32 bit so store explicitly big-endian.
+: @-T  ( t-addr --- x)
+       ORIGIN - CHARS IMAGE + DUP C@ 8 LSHIFT SWAP 1 CHARS + C@ + ;
+
+: !-T  ( x t-addr ---)
+       ORIGIN - CHARS IMAGE + OVER 8 RSHIFT OVER C! 1 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.
+ORIGIN DP-T !                       \ Initialize it to origin.
+: 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 ) 1 LSHIFT ;  \ Cells are 2 chars.
+: ALIGN-T ;                          \ No alignment used.
+: ALIGNED-T ( n1 --- n2 ) ;
+: 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 ORIGIN - IMAGE + SWAP CHARS CMOVE ;
+
+\ 6809 cross assembler already loaded, configure it for cross assembly.
+
+FORTH ' ,-T ASSEMBLER IS ,
+FORTH ' C,-T ASSEMBLER IS C,
+FORTH ' !-T ASSEMBLER IS V!
+FORTH ' @-T ASSEMBLER IS V@
+FORTH ' C!-T ASSEMBLER IS VC!
+FORTH ' C@-T ASSEMBLER IS VC@
+FORTH ' THERE ASSEMBLER IS HERE
+FORTH
+
+\ 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.
+
+\ All definitions are linked together in a number of threads. Each word
+\ is linked in only one thread. Which thread the word is linked to, can be
+\ determined from the name by a 'hash' code. To find a word, one can compute
+\ the hash code and then one can search just one thread that contains a
+\ small fraction of the words.
+
+4 CONSTANT #THREADS \ Number of threads
+
+CREATE TLINKS #THREADS CELLS ALLOT   \ This array points to the names
+                           \ of the last definition in each thread.
+TLINKS #THREADS CELLS 0 FILL
+
+VARIABLE LAST-T          \ Address of last definition.
+
+: HASH ( c-addr u #threads --- n)
+  >R OVER C@ 1 LSHIFT OVER 1 > IF ROT CHAR+ C@ 2 LSHIFT XOR ELSE ROT DROP
+   THEN XOR
+  R> 1- AND
+;
+
+: "HEADER >IN @ CREATE >IN ! \ Create the shadow definition.
+  BL WORD
+  DUP COUNT #THREADS HASH >R \ Compute the hash code.
+  ALIGN-T TLINKS R@ CELLS + @ ,-T        \ Lay out the link field.
+\D  DUP COUNT CR ." Creating: " TYPE ."  Hash:" R@ .
+  COUNT DUP >R THERE PLACE-T  \ Place name in target dictionary.
+  THERE TLINKS R> R> SWAP >R CELLS + !
+  THERE LAST-T !
+  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 LAST-T @ DUP C@-T 64 OR SWAP C!-T ;
+            \ Set the IMMEDIATE bit of last name.
+PREVIOUS DEFINITIONS
+
+\ PART 4: 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 0 ,              \ 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.
+\D >IN @ BL WORD COUNT CR ." Resolving: " TYPE >IN !
+  TRANSIENT ' >BODY  @                 \ Find the forward ref word in the
+                                       \ TRANSIENT VOC and take list head.
+  BEGIN
+   DUP                              \ Traverse all the links until end.
+  WHILE
+   DUP @-T                             \ Take address of next link from dict.
+   R@ ROT !-T                           \ Set resolved address in dict.
+  REPEAT DROP R> DROP PREVIOUS
+;
+
+
+\ PART 5: CODE GENERATION
+
+\ Motorola 6809 Forth is a direct threaded Forth. It uses the following
+\ registers: S for stack pointer, Y for return stack pointer, U for
+\ instruction pointer. NEXT is the single instruction PULU PC.
+\ THe code field of a definition contains a JSR instruction.
+
+: JSR, [ HEX ] BD C,-T [ DECIMAL ] ;
+
+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" ;
+
+TRANSIENT DEFINITIONS FORTH
+FORWARD LIT
+FORWARD DOCOL
+FORWARD DOCON
+FORWARD DOVAR
+FORWARD UNNEST
+FORWARD BRANCH
+FORWARD ?BRANCH
+FORTH DEFINITIONS
+
+: LITERAL-T ( n --- )
+\D DUP ."  Literal:" . CR
+  [ TRANSIENT ] LIT [ FORTH ] ,-T ;
+
+TRANSIENT DEFINITIONS FORTH
+\ Now define the words that do compile code.
+
+
+: : !CSP "HEADER THERE , JSR, [ TRANSIENT ] DOCOL [ FORTH ]  T]
+    DOES> @ ,-T ;
+
+: ; [ TRANSIENT ] UNNEST [ FORTH ] \ Compile the unnest primitive.
+   T[ ?CSP \ Quit compilation state.
+  ;
+
+
+: CODE "HEADER ASSEMBLE THERE ,
+  DOES> @ ,-T ;
+: END-CODE  [ ASSEMBLER ] ENDASM [ FORTH ] ;
+: LABEL THERE CONSTANT ASSEMBLE ;
+
+FORTH DEFINITIONS
+
+\ PART 6: DEFINING WORDS.
+
+TRANSIENT DEFINITIONS FORTH
+
+: VARIABLE "HEADER THERE , JSR, [ TRANSIENT ] DOVAR [ FORTH ]  0 ,-T
+\ Create a variable.
+DOES> @ ,-T ;
+
+: CONSTANT "HEADER THERE , JSR, [ TRANSIENT ] DOCON [ FORTH ]
+  ,-T
+  DOES> @ ,-T ;
+
+FORTH DEFINITIONS
+
+: T' ( --- t-addr) \ Find the execution token of a target definition.
+  ALSO TARGET '
+\D ." T' shadow address, target address " DUP . DUP >BODY @ .
+  >BODY @ \ Get the address from the shadow definition.
+  PREVIOUS
+;
+
+: >BODY-T ( t-addr1 --- t-addr2 ) \ Convert executing token to param address.
+  3 + ;
+
+\ PART 7: COMPILING WORDS
+
+TRANSIENT DEFINITIONS FORTH
+
+\ The TRANSIENT definitions for IF, THEN etc. compile the
+\ branch primitives BRAMCH and ?BRANCH.
+
+: BEGIN  THERE ;
+: UNTIL  [ TRANSIENT ] ?BRANCH [ FORTH ] ,-T ;
+: IF [ TRANSIENT ] ?BRANCH [ FORTH ] THERE 1 CELLS-T ALLOT-T ;
+: THEN  THERE SWAP !-T ; TARGET
+: ELSE [ TRANSIENT ] BRANCH THERE 1 CELLS-T ALLOT-T SWAP THEN [ FORTH ] ;
+: WHILE [ TRANSIENT ] IF [ FORTH ] SWAP ; TARGET
+: REPEAT [ TRANSIENT ] BRANCH ,-T THEN [ FORTH ] ;
+
+FORWARD (DO)
+FORWARD (LOOP)
+FORWARD (.")
+FORWARD (POSTPONE)
+
+: DO [ TRANSIENT ] (DO) [ FORTH ] THERE ;
+: LOOP [ TRANSIENT ] (LOOP) [ FORTH ] ,-T ;
+: ." [ TRANSIENT ] (.") [ FORTH ] 34 WORD COUNT DUP 1+ >R
+      THERE PLACE-T R> ALLOT-T ALIGN-T ;
+: POSTPONE [ TRANSIENT ] (POSTPONE) [ FORTH ] T' ,-T ;
+
+: \ POSTPONE \ ; IMMEDIATE
+: \G 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
+ \D CR DUP COUNT TYPE
+   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
+;
+