-
Notifications
You must be signed in to change notification settings - Fork 29
/
meta.mu4
453 lines (322 loc) · 14.8 KB
/
meta.mu4
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
( This file is part of muforth: https://muforth.dev/
Copyright 2002-2024 David Frech. (Read the LICENSE for details.)
loading ARM meta compiler (main)
forth decimal
( The various token consumers for each mode.)
-: ." (assembling)" ;
-:
.assembler. find if execute ^ then
.labels. find if execute ^ then ( equates are in .labels.)
.meta. find if execute ^ then
.forth. find if execute ^ then ( utility words in .forth.)
number ;
mode __asm
-: ." (compiling an assembler macro)" ;
-:
.compiler. find if execute ^ then ( compiler's if/then/begin ...)
.assembler. find if , ^ then ( ... trump the the assembler's)
.meta. find if , ^ then
.forth. find if , ^ then ( utility words in .forth.)
number literal ;
mode __macro
( The meta-interpreter. We're in this mode when we're building the target
image, and when in between [ and ] when running the target colon
compiler.)
-: ." (meta)" ;
-:
.meta. find if execute ^ then
.forth. find if execute ^ then
number ;
mode __meta
( __meta-colon is for compiling new words that are part of the meta-compiler.
__meta-colon is to __meta as __macro is to __asm.)
-: ." (compiling a meta colon word)" ;
-:
.compiler. find if execute ^ then
.meta. find if , ^ then
.forth. find if , ^ then ( utility words in .forth.)
number literal ;
mode __meta-colon
variable 'target-number ( convert token to a number, specific to target)
variable 'target-literal ( compile a target literal)
( Finally, we have the definition of the meta-compiler's colon compiler.)
( Execution behaviour of .target. words is to compile themselves!)
-: ." (compiling a target colon word)" ;
-: .meta-compiler. find if execute ^ then
.target. find if execute ^ then
'target-number @execute 'target-literal @execute ;
mode __target-colon
( Common things we'll always want when meta-colon compiling.)
meta-compiler
: \ ( compile from target-compiler) .target-compiler. chain' execute ;
( executing the word compiles itself!)
: ( \f ( ; ( comments are nice!)
: -- \f -- ; ( ditto!)
: .if \ .if ; ( and conditional compilation is nice too)
: .else \ .else ;
: .then \ .then ;
: .ifdef \ .ifdef ;
: .ifndef \ .ifndef ;
: .def \ .def ;
meta
: { \ [ ; ( escape back to the host forth)
forth
: } __meta ; ( return to meta)
( XXX We use this one-line self-comment in the ARM kernel. Rather than
fixing up all the block comments therein - since I've removed this from
startup.mu4 - I'd just add it back in here.)
: make-comment create does> drop untoken comment ;
make-comment
===========================================================================
( Forward references for fundamental words.)
labels
( These are pointers to target CODE words.)
variable (branch)
variable (0branch)
variable (=0branch)
variable (for)
variable (?for)
variable (next)
variable (do)
variable (loop)
variable (+loop)
variable lit
variable ^
variable (")
variable type
variable (;code@) ( for target-resident defining words)
forth
( looks up a label or forward-reference variable, and executes it to push
its value or address)
: lookup ( look up next token as forward-ref variable or label)
.labels. chain' execute ( get addr) ;
( Fetch value of variable on stack - a primitive - and compile it if
defined, and complain if not yet defined.)
: (p,) ( var) @ =if \m a, ^ then error" primitive not yet defined" ;
compiler
( p, is a helper word that makes writing compiling words easier. It is used
to compile a target primitive into a target word. But it doesn't do all
the work at once. p, runs at the compile time of the compiling word. In
that phase it consumes a token from the input, assumes it is a variable
for a forward-referenced primitive, and compiles it; then it compiles
(p,) ( which will do the rest of the work at the -run-time- of the
compiling word!)
: p, .labels. \chain compile (p,) ;
forth
( Looking up and changing values of target words.)
( At metacompile time, do something with target words. We can't -execute-
them, because they are self-compiling. However, we can ' them and pull
out their guts, if we know what we're doing...)
meta
( We can't execute target words to get their address; they are
self-compiling! So we "cheat" and look into their bodies instead.)
: ' ( - target-cfa) .target. chain' >body @ ;
: addr \m ' \m cell+ ; ( find word, skip cfa, return pfa)
: value \m addr \m @ ; ( find word, skip cfa, read out value)
: is ( target-cfa) \m addr \m ! ;
( Compile a linked name field into the target image.)
( The distinction between last and last-code is a bit subtle. last captures
the cfa of the last word defined, no matter what kind of word it was.
last-code captures the cfa of code fields that have a "bl" instruction
compiled there, and that can be possibly "repointed" by a later ;code or
does>. Keeping them separate makes me feel better.)
forth
variable last ( cfa of last word defined)
variable last-code ( for ;code and does> to fix up)
2variable last-link ( address of vocab, link to newest word)
meta
-- : show last-link 2@ ! ( finally link in last word) ;
( code, doesn't bother to compile a bl since we're doing to patch the code
field later. We just need to make room and to set last-code so patch can
find us.)
: code, \m here last-code ! ( make a code field) 0 \m , ;
: token, token dup 1+ \m aligned \m allot ( room for name+len+padding)
dup \m here 1- \m c! ( len) \m here over 1+ - image+ swap cmove ;
( called from metac to fix up the target image variables .forth. and
.compiler. to point to the most recent names in the parallel host
dictionaries, .target. and .target-compiler. resp.
It looks up the following target chain name and stores the link field from
the host.)
: parallels ( host-chain) >parallel @ \m addr dup reloc \m ! ;
: 'link current @ >parallel ;
: link, \m here \m 'link dup @ \m z, ! ( last-link 2! ) ;
( name, creates a name, compiling the name string and a link field.)
: name, \m token, \m link, ;
: literal p, lit \m , ; ( make a target literal)
: aliteral p, lit \m a, ; ( make a target address literal,
which is relocated!)
meta-compiler
: ['] \m ' \m aliteral ;
meta
.meta. chain' literal 'target-literal ! ( patch colon compiler)
' number 'target-number ! ( ditto - use host's number)
: assemble pair off __asm ; ( init and run assembler)
: equ current preserve labels constant ;
( name creates a name -both- in the host's .target. chain, and in the
actual target memory image.
On the host, in .target., name creates a word that compiles itself into
the target image. At create time, this target word captures \m here - the
target cfa - and makes a "constant" out of it. At runtime, it fetches the
constant and compiles it, as a relocated value, into the target
dictionary [image].)
: name \m name, ( compile name into image)
untoken create ( NOTE: uses current unchanged)
\m here dup , last ! ( create constant, and set last)
does> @ ( target-cfa) ( compile itself!) \m a, ;
: label \m here \m equ ;
: code \m name \m assemble ;
: new \m name \m code, ; ( for words with code fields)
( implements looks up a forward-reference variable and stores the address
of the last cfa there.)
: implements last @ \f lookup ! ;
( Support for making new defining words.)
forth
( (patch) ( rewrites the bl instruction at cfa to call to 'code.)
: (patch) ( 'code cfa) tuck >branch-offset "eb000000 or ( op)
swap \m ! ;
: patch last-code @ (patch) ;
( This word, which is followed inline by a target code address, patches the
code field of the last last word compiled with a bl to the inline target address. It
essentially "repoints" previously defined words - defined by create,
variable, constant, etc - to point to new code. It gets -compiled- indirectly
by both ;calls and does>.)
: (;code@) pop @ patch ;
( <;code> is used to switch from compiling -host- code [that will later run
on the host, and build the target word] to compiling -target- code, that
will run when words defined by this defining word later execute. In order
to connect the two worlds, and to be able to patch up code fields to
point to this newly-defined behaviour, <;code> captures the target's
"here" value. Remember, we are about to start compiling target code at
"here".
<;code> runs at the compile time of a defining word, but it leaves it up
to its caller - ;calls or does> - to change the interpreter mode.)
: <;code> compile (;code@) \m here , show ;
compiler
-- : does> <;code> save-lr \m dodoes @ \a bl \m -] ( start meta-colon) ;
: ;code <;code> \m assemble ( start assembler) ;
meta-compiler
( ;calls is like ;code, but it is for creating target-resident defining
words that correspond to the defining words that were already defined in
the meta-compiler.
The issue is that the compilation of the defining word into the
meta-compiler already assembled the target machine code for this class of
word - whether docolon, dovar, doconst, or dodoes. We don't want to
repeat the code, so when we compile target-resident versions of the
defining words - : variable constant etc - we want to -refer- to the
previously assembled machine code, rather than assemble it again.
Thus this word is called ;calls rather than the more "usual" ;code,
because it is not followed by machine code, but instead by a -label- that
points to machine code.
Under the hood, it is the same as the metacompiler's ;code: both compile
-their version of- the word (;code@) ( which is followed by an inline
constant, which is the address of machine code - docolon, dovar, etc.
(;code@) ( patches the code field of the most-recently-defined word to
point to this machine code. It's simple - it just takes a lot of words to
explain!)
: ;calls p, (;code@) \f lookup \m a, __meta ;
forth
( It's nice to know where a code field is pointing. Actually this takes the
address of any b or bl instruction and shows its destination - with some
junk in the high-order bits that can be ignored.)
: >code ( a code-field) 2 + 2 << + ;
meta
: .code ( a) dup \m @ >code u. ;
forth
: field-width #field @ cells ;
: picky-type ( a u) ( print only "letter" characters)
?for dup 1+ swap c@ >letter emit next then drop ;
( Right justify in field of width #field @ * 4)
: |_field_cell| ( a u) #field @ cells over - spaces picky-type ;
( Print a name from a cell value.)
: .name-cfa ( cfa) ( cell is cfa; print its name)
\m cell- image+ link>name field-width min |_field_cell| ;
: .name-code-field ( a+ bl-to-code - a+)
( bl-to-code is the contents of a code field; follow bl and print name!)
over cell- swap >code .hex-cell ( don't have code names yet)
;
( The address passed is one past the address from which n was fetched.)
: .image-name ( a+ n - a+)
dup #image u< if .name-cfa ^ then
dup "eb000000 u< if drop field-width spaces ^ then
( prob chars, not an address) .name-code-field ;
' .image-name is .name ( hook into memory dumper)
assembler
: ;c __meta ;
( Compiling strings.)
meta
( Compile a counted string without a zero terminator.)
( Length is a cell, not a byte!)
: string, ( a u) dup \m , ( len - cell!)
\m here over \m allot \m align
image+ swap cmove ;
meta-compiler
: " p, (") ( compile (")
char " parse ( a u) \m string, ( compile the counted string) ;
: ." \mc " ( compile string)
p, type ( compile type) ;
( Control structures.)
( Resolve a forward or backward jump, from src to dest.)
( When using absolute branch addresses, this is easy: just store dest at src.)
( NOTE: when using absolute addresses for branches, we must mark them as
needing relocation, so we use a, . If instead we used relative branch
addresses we should use , .)
meta
: <resolve ( dest src) \m ! ;
: >resolve ( src dest) swap \m <resolve ;
: >mark \m here 0 \m a, ; ( mark addresss as relocating!!)
meta-compiler
: =if ( - src) p, (=0branch) \m >mark ;
: if ( - src) p, (0branch) \m >mark ;
: then ( src) \m here \m >resolve ;
: else ( src0 - src1) p, (branch) \m >mark
swap \mc then ;
: begin ( - dest) \m here ;
: =until ( dest -) \mc =if \m <resolve ;
: until ( dest -) \mc if \m <resolve ;
: again ( dest -) p, (branch) \m >mark \m <resolve ;
: =while ( dest - src dest) \mc =if swap ;
: while ( dest - src dest) \mc if swap ;
: repeat ( src dest -) \mc again \mc then ;
( n for .. next goes n times; 4 billion+ if n=0 )
( n ?for .. next then goes n times; 0 if n=0 )
: for ( - dest) p, (for) \mc begin ;
: ?for ( - src dest) p, (?for) \m >mark \mc begin ;
: next ( dest -) p, (next) \m >mark \m <resolve ;
( do, loop, +loop)
: do ( - src dest) p, (do) \m >mark \mc begin ;
: loop ( src dest) p, (loop) \m >mark \m <resolve \mc then ;
: +loop ( src dest) p, (+loop) \m >mark \m <resolve \mc then ;
forth
( Define useful colon compilers:
meta: for defining new target defining words!
macro: for defining assembler macros
compiler: for defining meta-compiler words
We define the another colon compiler - the actual target colon - in the
kernel, using our meta-defining words!)
meta
: meta: current preserve meta : __meta-colon ;
: compiler: current preserve compiler : __meta-colon ; ( XXX better name?)
: macro: : __macro ;
forth
( Making [ and ] work, finally.)
variable saved-state ( interpreter mode we came from)
variable which-literal ( the kind of literal to make when ] executes)
meta
: ] saved-state @ state ! ; ( return to saved state)
: #] \m ] which-literal @execute ;
forth
: _[ ( 'literal)
state @ saved-state ! ( so we know how to get back)
which-literal ! ( so #] knows how to make a literal)
__meta ; ( switch to __meta, not to host forth)
( Now define the different ways of leaving a colon compiler.)
( "Fix" host forth's [ and ; so they return to __meta)
compiler
: [ ['] literal _[ ; ( when we return, make a host literal)
: ; \ ^ show __meta ;
: ['] \m ' literal ;
meta-compiler
: [ 'target-literal @ _[ ; ( when we return, make a target literal)
: ^ p, ^ ; ( compile target's ^ - EXIT)
: ; \mc ^ __meta ;
forth