|
57
|
1 \ CROSS COMPILER FOR THE MOTORAOLA 6809 PROCESSOR
|
|
|
2 \ created 1995 by L.C. Benschop.
|
|
|
3 \ copyleft (c) 1995-2014 by the sbc09 team, see AUTHORS for more details.
|
|
|
4 \ license: GNU General Public License version 2, see LICENSE for more details.
|
|
|
5 \
|
|
|
6 \ This serves as an introduction to Forth cross compiling, so it is excessively
|
|
|
7 \ commented.
|
|
|
8 \
|
|
|
9 \ This cross compiler can be run on any ANS Forth with the necessary
|
|
|
10 \ extension wordset that is at least 16-bit, including Motorola 6809 Forth.
|
|
|
11 \
|
|
|
12 \ It creates the memory image of a new Forth system that is to be run
|
|
|
13 \ by the Motorola 6809 processor.
|
|
|
14 \
|
|
|
15 \ The cross compiler (or meta compiler or target compiler) is similar
|
|
|
16 \ to a regular Forth compiler, except that it builds definitions in
|
|
|
17 \ a dictionary in the memory image of a different Forth system.
|
|
|
18 \ We call this the target dictionary in the target space of the
|
|
|
19 \ target system.
|
|
|
20 \
|
|
|
21 \ As the new definitions are for a different Forth system, the cross
|
|
|
22 \ compiler cannot EXECUTE them. Neither can it easily find the new
|
|
|
23 \ definitions in the target dictionary. Hence a shadow definition
|
|
|
24 \ for each target definition is made in the normal Forth dictionary.
|
|
|
25 \
|
|
|
26 \ The names of the new definitions overlap with the names of existing
|
|
|
27 \ elementary. Forth words. Therefore they need to be in a wordlist
|
|
|
28 \ different from the normal Forth wordlist.
|
|
|
29
|
|
|
30 \ PART 1: THE VOCABULARIES.
|
|
|
31
|
|
|
32 VOCABULARY TARGET
|
|
|
33 \ This vocabulary will hold shadow definitions for all words that are in
|
|
|
34 \ the target dictionary. When a shadow definition is executed, it
|
|
|
35 \ performs the compile action in the target dictionary.
|
|
|
36
|
|
|
37 VOCABULARY TRANSIENT
|
|
|
38 \ This vocabulary will hold definitions that must be executed by the
|
|
|
39 \ host system ( the system on which the cross compiler runs) and that
|
|
|
40 \ compile to the target system.
|
|
|
41
|
|
|
42 \ Expl: The word IF occurs in all three vocabularies. The word IF in the
|
|
|
43 \ FORTH vocabulary is run by the host system and is used when
|
|
|
44 \ compiling host definitions. A different version is in the
|
|
|
45 \ TRANSIENT vocabulary. This one runs on the host system and
|
|
|
46 \ is used when compiling target definitions. The version in the
|
|
|
47 \ TARGET vocabulary is the version that will run on the target
|
|
|
48 \ system.
|
|
|
49
|
|
|
50 \ : \D ; \ Uncomment one of these. If uncommented, display debug info.
|
|
|
51 : \D POSTPONE \ ; IMMEDIATE
|
|
|
52
|
|
|
53 \ PART 2: THE TARGET DICTIONARY SPACE.
|
|
|
54
|
|
|
55 \ Next we need to define the target space and the words to access it.
|
|
|
56
|
|
|
57 1024 CONSTANT ORIGIN \ Start address of Forth image.
|
|
|
58 8192 CONSTANT IMAGE_SIZE
|
|
|
59
|
|
|
60
|
|
|
61 CREATE IMAGE IMAGE_SIZE CHARS ALLOT \ This space contains the target image.
|
|
|
62 IMAGE IMAGE_SIZE 0 FILL \ Initialize it to zero.
|
|
|
63
|
|
|
64 \ Fetch and store characters in the target space.
|
|
|
65 : C@-T ( t-addr --- c) ORIGIN - CHARS IMAGE + C@ ;
|
|
|
66 : C!-T ( c t-addr ---) ORIGIN - CHARS IMAGE + C! ;
|
|
|
67
|
|
|
68 \ Fetch and store cells in the target space.
|
|
|
69 \ M6809 is big endian 32 bit so store explicitly big-endian.
|
|
|
70 : @-T ( t-addr --- x)
|
|
|
71 ORIGIN - CHARS IMAGE + DUP C@ 8 LSHIFT SWAP 1 CHARS + C@ + ;
|
|
|
72
|
|
|
73 : !-T ( x t-addr ---)
|
|
|
74 ORIGIN - CHARS IMAGE + OVER 8 RSHIFT OVER C! 1 CHARS + C! ;
|
|
|
75
|
|
|
76 \ A dictionary is constructed in the target space. Here are the primitives
|
|
|
77 \ to maintain the dictionary pointer and to reserve space.
|
|
|
78
|
|
|
79 VARIABLE DP-T \ Dictionary pointer for target dictionary.
|
|
|
80 ORIGIN DP-T ! \ Initialize it to origin.
|
|
|
81 : THERE ( --- t-addr) DP-T @ ; \ Equivalent of HERE in target space.
|
|
|
82 : ALLOT-T ( n --- ) DP-T +! ; \ Reserve n bytes in the dictionary.
|
|
|
83 : CHARS-T ( n1 --- n2 ) ;
|
|
|
84 : CELLS-T ( n1 --- n2 ) 1 LSHIFT ; \ Cells are 2 chars.
|
|
|
85 : ALIGN-T ; \ No alignment used.
|
|
|
86 : ALIGNED-T ( n1 --- n2 ) ;
|
|
|
87 : C,-T ( c --- ) THERE C!-T 1 CHARS ALLOT-T ;
|
|
|
88 : ,-T ( x --- ) THERE !-T 1 CELLS-T ALLOT-T ;
|
|
|
89
|
|
|
90 : PLACE-T ( c-addr len t-addr --- ) \ Move counted string to target space.
|
|
|
91 OVER OVER C!-T 1+ CHARS ORIGIN - IMAGE + SWAP CHARS CMOVE ;
|
|
|
92
|
|
|
93 \ 6809 cross assembler already loaded, configure it for cross assembly.
|
|
|
94
|
|
|
95 FORTH ' ,-T ASSEMBLER IS ,
|
|
|
96 FORTH ' C,-T ASSEMBLER IS C,
|
|
|
97 FORTH ' !-T ASSEMBLER IS V!
|
|
|
98 FORTH ' @-T ASSEMBLER IS V@
|
|
|
99 FORTH ' C!-T ASSEMBLER IS VC!
|
|
|
100 FORTH ' C@-T ASSEMBLER IS VC@
|
|
|
101 FORTH ' THERE ASSEMBLER IS HERE
|
|
|
102 FORTH
|
|
|
103
|
|
|
104 \ PART 3: CREATING NEW DEFINITIONS IN THE TARGET SYSTEM.
|
|
|
105
|
|
|
106 \ These words create new target definitions, both the shadow definition
|
|
|
107 \ and the header in the target dictionary. The layout of target headers
|
|
|
108 \ can be changed but FIND in the target system must be changed accordingly.
|
|
|
109
|
|
|
110 \ All definitions are linked together in a number of threads. Each word
|
|
|
111 \ is linked in only one thread. Which thread the word is linked to, can be
|
|
|
112 \ determined from the name by a 'hash' code. To find a word, one can compute
|
|
|
113 \ the hash code and then one can search just one thread that contains a
|
|
|
114 \ small fraction of the words.
|
|
|
115
|
|
|
116 4 CONSTANT #THREADS \ Number of threads
|
|
|
117
|
|
|
118 CREATE TLINKS #THREADS CELLS ALLOT \ This array points to the names
|
|
|
119 \ of the last definition in each thread.
|
|
|
120 TLINKS #THREADS CELLS 0 FILL
|
|
|
121
|
|
|
122 VARIABLE LAST-T \ Address of last definition.
|
|
|
123
|
|
|
124 : HASH ( c-addr u #threads --- n)
|
|
|
125 >R OVER C@ 1 LSHIFT OVER 1 > IF ROT CHAR+ C@ 2 LSHIFT XOR ELSE ROT DROP
|
|
|
126 THEN XOR
|
|
|
127 R> 1- AND
|
|
|
128 ;
|
|
|
129
|
|
|
130 : "HEADER >IN @ CREATE >IN ! \ Create the shadow definition.
|
|
|
131 BL WORD
|
|
|
132 DUP COUNT #THREADS HASH >R \ Compute the hash code.
|
|
|
133 ALIGN-T TLINKS R@ CELLS + @ ,-T \ Lay out the link field.
|
|
|
134 \D DUP COUNT CR ." Creating: " TYPE ." Hash:" R@ .
|
|
|
135 COUNT DUP >R THERE PLACE-T \ Place name in target dictionary.
|
|
|
136 THERE TLINKS R> R> SWAP >R CELLS + !
|
|
|
137 THERE LAST-T !
|
|
|
138 THERE C@-T 128 OR THERE C!-T R> 1+ ALLOT-T ALIGN-T ;
|
|
|
139 \ Set bit 7 of count byte as a marker.
|
|
|
140
|
|
|
141 \ : "HEADER CREATE ALIGN-T ; \ Alternative for "HEADER in case the target system
|
|
|
142 \ is just an application without headers.
|
|
|
143
|
|
|
144
|
|
|
145 ALSO TRANSIENT DEFINITIONS
|
|
|
146 : IMMEDIATE LAST-T @ DUP C@-T 64 OR SWAP C!-T ;
|
|
|
147 \ Set the IMMEDIATE bit of last name.
|
|
|
148 PREVIOUS DEFINITIONS
|
|
|
149
|
|
|
150 \ PART 4: FORWARD REFERENCES
|
|
|
151
|
|
|
152 \ Some definitions are referenced before they are defined. A definition
|
|
|
153 \ in the TRANSIENT voc is created for each forward referenced definition.
|
|
|
154 \ This links all addresses together where the forward reference is used.
|
|
|
155 \ The word RESOLVE stores the real address everywhere it is needed.
|
|
|
156
|
|
|
157 : FORWARD
|
|
|
158 CREATE 0 , \ Store head of list in the definition.
|
|
|
159 DOES>
|
|
|
160 DUP @ ,-T THERE 1 CELLS-T - SWAP ! \ Reserve a cell in the dictionary
|
|
|
161 \ where the call to the forward definition must come.
|
|
|
162 \ As the call address is unknown, store link to next
|
|
|
163 \ reference instead.
|
|
|
164 ;
|
|
|
165
|
|
|
166 : RESOLVE
|
|
|
167 ALSO TARGET >IN @ ' >BODY @ >R >IN ! \ Find the resolving word in the
|
|
|
168 \ target voc. and take the CFA out of the definition.
|
|
|
169 \D >IN @ BL WORD COUNT CR ." Resolving: " TYPE >IN !
|
|
|
170 TRANSIENT ' >BODY @ \ Find the forward ref word in the
|
|
|
171 \ TRANSIENT VOC and take list head.
|
|
|
172 BEGIN
|
|
|
173 DUP \ Traverse all the links until end.
|
|
|
174 WHILE
|
|
|
175 DUP @-T \ Take address of next link from dict.
|
|
|
176 R@ ROT !-T \ Set resolved address in dict.
|
|
|
177 REPEAT DROP R> DROP PREVIOUS
|
|
|
178 ;
|
|
|
179
|
|
|
180
|
|
|
181 \ PART 5: CODE GENERATION
|
|
|
182
|
|
|
183 \ Motorola 6809 Forth is a direct threaded Forth. It uses the following
|
|
|
184 \ registers: S for stack pointer, Y for return stack pointer, U for
|
|
|
185 \ instruction pointer. NEXT is the single instruction PULU PC.
|
|
|
186 \ THe code field of a definition contains a JSR instruction.
|
|
|
187
|
|
|
188 : JSR, [ HEX ] BD C,-T [ DECIMAL ] ;
|
|
|
189
|
|
|
190 VARIABLE STATE-T 0 STATE-T ! \ State variable for cross compiler.
|
|
|
191 : T] 1 STATE-T ! ;
|
|
|
192 : T[ 0 STATE-T ! ;
|
|
|
193
|
|
|
194 VARIABLE CSP \ Stack pointer checking between : and ;
|
|
|
195 : !CSP DEPTH CSP ! ;
|
|
|
196 : ?CSP DEPTH CSP @ - ABORT" Incomplete control structure" ;
|
|
|
197
|
|
|
198 TRANSIENT DEFINITIONS FORTH
|
|
|
199 FORWARD LIT
|
|
|
200 FORWARD DOCOL
|
|
|
201 FORWARD DOCON
|
|
|
202 FORWARD DOVAR
|
|
|
203 FORWARD UNNEST
|
|
|
204 FORWARD BRANCH
|
|
|
205 FORWARD ?BRANCH
|
|
|
206 FORTH DEFINITIONS
|
|
|
207
|
|
|
208 : LITERAL-T ( n --- )
|
|
|
209 \D DUP ." Literal:" . CR
|
|
|
210 [ TRANSIENT ] LIT [ FORTH ] ,-T ;
|
|
|
211
|
|
|
212 TRANSIENT DEFINITIONS FORTH
|
|
|
213 \ Now define the words that do compile code.
|
|
|
214
|
|
|
215
|
|
|
216 : : !CSP "HEADER THERE , JSR, [ TRANSIENT ] DOCOL [ FORTH ] T]
|
|
|
217 DOES> @ ,-T ;
|
|
|
218
|
|
|
219 : ; [ TRANSIENT ] UNNEST [ FORTH ] \ Compile the unnest primitive.
|
|
|
220 T[ ?CSP \ Quit compilation state.
|
|
|
221 ;
|
|
|
222
|
|
|
223
|
|
|
224 : CODE "HEADER ASSEMBLE THERE ,
|
|
|
225 DOES> @ ,-T ;
|
|
|
226 : END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ;
|
|
|
227 : LABEL THERE CONSTANT ASSEMBLE ;
|
|
|
228
|
|
|
229 FORTH DEFINITIONS
|
|
|
230
|
|
|
231 \ PART 6: DEFINING WORDS.
|
|
|
232
|
|
|
233 TRANSIENT DEFINITIONS FORTH
|
|
|
234
|
|
|
235 : VARIABLE "HEADER THERE , JSR, [ TRANSIENT ] DOVAR [ FORTH ] 0 ,-T
|
|
|
236 \ Create a variable.
|
|
|
237 DOES> @ ,-T ;
|
|
|
238
|
|
|
239 : CONSTANT "HEADER THERE , JSR, [ TRANSIENT ] DOCON [ FORTH ]
|
|
|
240 ,-T
|
|
|
241 DOES> @ ,-T ;
|
|
|
242
|
|
|
243 FORTH DEFINITIONS
|
|
|
244
|
|
|
245 : T' ( --- t-addr) \ Find the execution token of a target definition.
|
|
|
246 ALSO TARGET '
|
|
|
247 \D ." T' shadow address, target address " DUP . DUP >BODY @ .
|
|
|
248 >BODY @ \ Get the address from the shadow definition.
|
|
|
249 PREVIOUS
|
|
|
250 ;
|
|
|
251
|
|
|
252 : >BODY-T ( t-addr1 --- t-addr2 ) \ Convert executing token to param address.
|
|
|
253 3 + ;
|
|
|
254
|
|
|
255 \ PART 7: COMPILING WORDS
|
|
|
256
|
|
|
257 TRANSIENT DEFINITIONS FORTH
|
|
|
258
|
|
|
259 \ The TRANSIENT definitions for IF, THEN etc. compile the
|
|
|
260 \ branch primitives BRAMCH and ?BRANCH.
|
|
|
261
|
|
|
262 : BEGIN THERE ;
|
|
|
263 : UNTIL [ TRANSIENT ] ?BRANCH [ FORTH ] ,-T ;
|
|
|
264 : IF [ TRANSIENT ] ?BRANCH [ FORTH ] THERE 1 CELLS-T ALLOT-T ;
|
|
|
265 : THEN THERE SWAP !-T ; TARGET
|
|
|
266 : ELSE [ TRANSIENT ] BRANCH THERE 1 CELLS-T ALLOT-T SWAP THEN [ FORTH ] ;
|
|
|
267 : WHILE [ TRANSIENT ] IF [ FORTH ] SWAP ; TARGET
|
|
|
268 : REPEAT [ TRANSIENT ] BRANCH ,-T THEN [ FORTH ] ;
|
|
|
269
|
|
|
270 FORWARD (DO)
|
|
|
271 FORWARD (LOOP)
|
|
|
272 FORWARD (.")
|
|
|
273 FORWARD (POSTPONE)
|
|
|
274
|
|
|
275 : DO [ TRANSIENT ] (DO) [ FORTH ] THERE ;
|
|
|
276 : LOOP [ TRANSIENT ] (LOOP) [ FORTH ] ,-T ;
|
|
|
277 : ." [ TRANSIENT ] (.") [ FORTH ] 34 WORD COUNT DUP 1+ >R
|
|
|
278 THERE PLACE-T R> ALLOT-T ALIGN-T ;
|
|
|
279 : POSTPONE [ TRANSIENT ] (POSTPONE) [ FORTH ] T' ,-T ;
|
|
|
280
|
|
|
281 : \ POSTPONE \ ; IMMEDIATE
|
|
|
282 : \G POSTPONE \ ; IMMEDIATE
|
|
|
283 : ( POSTPONE ( ; IMMEDIATE \ Move duplicates of comment words to TRANSIENT
|
|
|
284 : CHARS-T CHARS-T ; \ Also words that must be executed while cross compiling.
|
|
|
285 : CELLS-T CELLS-T ;
|
|
|
286 : ALLOT-T ALLOT-T ;
|
|
|
287 : ['] T' LITERAL-T ;
|
|
|
288
|
|
|
289 FORTH DEFINITIONS
|
|
|
290
|
|
|
291 \ PART 8: THE CROSS COMPILER ITSELF.
|
|
|
292
|
|
|
293 VARIABLE DPL
|
|
|
294 : NUMBER? ( c-addr ---- d f)
|
|
|
295 -1 DPL !
|
|
|
296 BASE @ >R
|
|
|
297 COUNT
|
|
|
298 OVER C@ 45 = DUP >R IF 1 - SWAP 1 + SWAP THEN \ Get any - sign
|
|
|
299 OVER C@ 36 = IF 16 BASE ! 1 - SWAP 1 + SWAP THEN \ $ sign for hex.
|
|
|
300 OVER C@ 35 = IF 10 BASE ! 1 - SWAP 1 + SWAP THEN \ # sign for decimal
|
|
|
301 DUP 0 > 0= IF R> DROP R> BASE ! 0 EXIT THEN \ Length 0 or less?
|
|
|
302 >R >R 0 0 R> R>
|
|
|
303 BEGIN
|
|
|
304 >NUMBER
|
|
|
305 DUP IF OVER C@ 46 = IF 1 - DUP DPL ! SWAP 1 + SWAP ELSE \ handle point.
|
|
|
306 R> DROP R> BASE ! 0 EXIT THEN \ Error if anything but point
|
|
|
307 THEN
|
|
|
308 DUP 0= UNTIL DROP DROP R> IF DNEGATE THEN
|
|
|
309 R> BASE ! -1
|
|
|
310 ;
|
|
|
311
|
|
|
312
|
|
|
313 : CROSS-COMPILE
|
|
|
314 ONLY TARGET DEFINITIONS ALSO TRANSIENT \ Restrict search order.
|
|
|
315 BEGIN
|
|
|
316 BL WORD
|
|
|
317 \D CR DUP COUNT TYPE
|
|
|
318 DUP C@ 0= IF \ Get new word
|
|
|
319 DROP REFILL DROP \ If empty, get new line.
|
|
|
320 ELSE
|
|
|
321 DUP COUNT S" END-CROSS" COMPARE 0= \ Exit cross compiler on END-CROSS
|
|
|
322 IF
|
|
|
323 ONLY FORTH ALSO DEFINITIONS \ Normal search order again.
|
|
|
324 DROP EXIT
|
|
|
325 THEN
|
|
|
326 FIND IF \ Execute if found.
|
|
|
327 EXECUTE
|
|
|
328 ELSE
|
|
|
329 NUMBER? 0= ABORT" Undefined word" DROP
|
|
|
330 STATE-T @ IF \ Parse it as a number.
|
|
|
331 LITERAL-T \ If compiling then compile as a literal.
|
|
|
332 THEN
|
|
|
333 THEN
|
|
|
334 THEN
|
|
|
335 0 UNTIL
|
|
|
336 ;
|
|
|
337
|
