Mercurial > hg > Members > kono > os9 > sbc09

comparison examples_forth/meta09.4 @ 57:2088fd998865

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sbc09 directry clean up
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 23 Jul 2018 16:07:12 +0900
parents
children
comparison
equal deleted inserted replaced
56:4fa2bdb0c457 57:2088fd998865
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