|
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 Object subclass:#PPCCodeGen |
|
6 instanceVariableNames:'compilerStack compiledParser methodCache currentMethod constants |
|
7 returnVariable arguments idCache' |
|
8 classVariableNames:'' |
|
9 poolDictionaries:'' |
|
10 category:'PetitCompiler-Compiler-Codegen' |
|
11 ! |
|
12 |
|
13 !PPCCodeGen class methodsFor:'instance creation'! |
|
14 |
|
15 new |
|
16 "return an initialized instance" |
|
17 |
|
18 ^ self on: PPCArguments default |
|
19 ! |
|
20 |
|
21 on: aPPCArguments |
|
22 "return an initialized instance" |
|
23 |
|
24 ^ self basicNew |
|
25 initialize; |
|
26 arguments: aPPCArguments |
|
27 ! ! |
|
28 |
|
29 !PPCCodeGen methodsFor:'accessing'! |
|
30 |
|
31 arguments: args |
|
32 arguments := args |
|
33 ! |
|
34 |
|
35 constants |
|
36 ^ constants |
|
37 ! |
|
38 |
|
39 currentMethod |
|
40 ^ currentMethod |
|
41 ! |
|
42 |
|
43 currentNonInlineMethod |
|
44 ^ compilerStack |
|
45 detect:[:m | m isInline not ] |
|
46 ifNone:[ self error: 'No non-inlined method'] |
|
47 |
|
48 "Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
49 ! |
|
50 |
|
51 currentReturnVariable |
|
52 ^ currentMethod returnVariable |
|
53 ! |
|
54 |
|
55 ids |
|
56 ^ idCache keys |
|
57 ! |
|
58 |
|
59 methodCategory |
|
60 ^ 'generated' |
|
61 ! |
|
62 |
|
63 methodDictionary |
|
64 ^ methodCache |
|
65 ! |
|
66 |
|
67 methodFor: object |
|
68 | id | |
|
69 id := self idFor: object. |
|
70 ^ methodCache at: id ifAbsent: [ nil ] |
|
71 ! ! |
|
72 |
|
73 !PPCCodeGen methodsFor:'code generation'! |
|
74 |
|
75 add: string |
|
76 currentMethod add: string. |
|
77 ! |
|
78 |
|
79 addConstant: value as: name |
|
80 (constants includesKey: name) ifTrue:[ |
|
81 (constants at: name) ~= value ifTrue:[ |
|
82 self error:'Duplicate constant!!'. |
|
83 ]. |
|
84 ^ self. |
|
85 ]. |
|
86 constants at: name put: value |
|
87 |
|
88 "Modified: / 29-05-2015 / 07:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
89 ! |
|
90 |
|
91 addOnLine: string |
|
92 currentMethod addOnLine: string. |
|
93 ! |
|
94 |
|
95 addVariable: name |
|
96 ^ self currentNonInlineMethod addVariable: name |
|
97 |
|
98 "Modified: / 23-04-2015 / 17:34:02 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
99 ! |
|
100 |
|
101 call: anotherMethod |
|
102 currentMethod add: anotherMethod call. |
|
103 ! |
|
104 |
|
105 callOnLine: anotherMethod |
|
106 currentMethod addOnLine: anotherMethod call. |
|
107 ! |
|
108 |
|
109 dedent |
|
110 currentMethod dedent |
|
111 ! |
|
112 |
|
113 indent |
|
114 currentMethod indent |
|
115 ! |
|
116 |
|
117 nl |
|
118 currentMethod nl |
|
119 ! |
|
120 |
|
121 smartRemember: parser to: variableName |
|
122 parser isContextFree ifTrue: [ |
|
123 self codeAssign: 'context lwRemember.' |
|
124 to: variableName. |
|
125 ] ifFalse: [ |
|
126 self codeAssign: 'context remember.' |
|
127 to: variableName. |
|
128 ] |
|
129 ! |
|
130 |
|
131 smartRestore: parser from: mementoName |
|
132 parser isContextFree ifTrue: [ |
|
133 self add: 'context lwRestore: ', mementoName, '.'. |
|
134 ] ifFalse: [ |
|
135 self add: 'context restore: ', mementoName, '.'. |
|
136 ] |
|
137 ! ! |
|
138 |
|
139 !PPCCodeGen methodsFor:'coding'! |
|
140 |
|
141 code:aStringOrBlockOrRBParseNode |
|
142 currentMethod code: aStringOrBlockOrRBParseNode |
|
143 |
|
144 "Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
145 ! |
|
146 |
|
147 codeAssign: code to: variable |
|
148 self assert: variable isNil not. |
|
149 |
|
150 "TODO JK: Hack alert, whatever is magic constant!!" |
|
151 (variable == #whatever) ifFalse: [ |
|
152 "Do not assign, if somebody does not care!!" |
|
153 self add: variable ,' := ', code. |
|
154 ] |
|
155 ! |
|
156 |
|
157 codeAssignParsedValueOf:aBlock to:aString |
|
158 | tmpVarirable method | |
|
159 |
|
160 self assert:aBlock isBlock. |
|
161 self assert:aString isNil not. |
|
162 tmpVarirable := returnVariable. |
|
163 returnVariable := aString. |
|
164 method := [ |
|
165 aBlock value |
|
166 ] ensure:[ returnVariable := tmpVarirable ]. |
|
167 method isInline ifTrue:[ |
|
168 self callOnLine:method |
|
169 ] ifFalse:[ |
|
170 self codeEvaluateAndAssign:(method call) to:aString. |
|
171 ] |
|
172 |
|
173 "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
174 ! |
|
175 |
|
176 codeBlock: contents |
|
177 currentMethod codeBlock: contents |
|
178 |
|
179 "Created: / 01-06-2015 / 22:35:32 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
180 ! |
|
181 |
|
182 codeClearError |
|
183 self add: 'self clearError.'. |
|
184 ! |
|
185 |
|
186 codeComment: string |
|
187 currentMethod add: '"', string, '"'. |
|
188 ! |
|
189 |
|
190 codeDot |
|
191 self addOnLine:'.'. |
|
192 |
|
193 "Created: / 16-06-2015 / 06:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
194 ! |
|
195 |
|
196 codeError |
|
197 self add: 'self error: ''message notspecified''.'. |
|
198 ! |
|
199 |
|
200 codeError: errorMessage |
|
201 self add: 'self error: ''', errorMessage, '''.' |
|
202 ! |
|
203 |
|
204 codeError: errorMessage at: position |
|
205 self add: 'self error: ''', errorMessage, ''' at: ', position asString, '.' |
|
206 ! |
|
207 |
|
208 codeEvaluate: selector argument: argument on: variable |
|
209 self assert: variable isNil not. |
|
210 |
|
211 "TODO JK: Hack alert, whatever is magic constant!!" |
|
212 (variable == #whatever) ifFalse: [ |
|
213 "Do not assign, if somebody does not care!!" |
|
214 self add: variable, ' ', selector,' ', argument. |
|
215 ] ifTrue: [ |
|
216 "In case argument has a side effect" |
|
217 self add: argument |
|
218 ] |
|
219 ! |
|
220 |
|
221 codeEvaluateAndAssign: argument to: variable |
|
222 self assert: variable isNil not. |
|
223 |
|
224 "TODO JK: Hack alert, whatever is magic constant!!" |
|
225 (variable == #whatever) ifFalse: [ |
|
226 "Do not assign, if somebody does not care!!" |
|
227 self add: variable ,' := ', argument. |
|
228 ] ifTrue: [ |
|
229 "In case an argument has a side effect" |
|
230 self add: argument. |
|
231 ] |
|
232 ! |
|
233 |
|
234 codeHalt |
|
235 self add: 'self halt. ' |
|
236 ! |
|
237 |
|
238 codeHaltIfShiftPressed |
|
239 arguments debug ifTrue: [ |
|
240 ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[ |
|
241 self add: 'Halt ifShiftPressed.' |
|
242 ] |
|
243 ] |
|
244 |
|
245 "Modified: / 10-05-2015 / 07:39:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
246 ! |
|
247 |
|
248 codeIf: condition then: then |
|
249 self codeIf: condition then: then else: nil |
|
250 |
|
251 "Created: / 16-06-2015 / 06:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
252 ! |
|
253 |
|
254 codeIf: condition then: then else: else |
|
255 currentMethod |
|
256 add: '('; |
|
257 code: condition; |
|
258 addOnLine: ')'. |
|
259 then notNil ifTrue:[ |
|
260 currentMethod |
|
261 addOnLine:' ifTrue:'; |
|
262 codeBlock: then. |
|
263 ]. |
|
264 else notNil ifTrue:[ |
|
265 currentMethod |
|
266 addOnLine:' ifFalse:'; |
|
267 codeBlock: else. |
|
268 ]. |
|
269 self codeDot. |
|
270 |
|
271 "Created: / 01-06-2015 / 22:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
272 "Modified: / 16-06-2015 / 06:09:33 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
273 ! |
|
274 |
|
275 codeIfErrorThen: then |
|
276 ^ self codeIf: 'error' then: then else: nil |
|
277 |
|
278 "Created: / 16-06-2015 / 06:06:44 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
279 ! |
|
280 |
|
281 codeIfErrorThen: then else: else |
|
282 ^ self codeIf: 'error' then: then else: else |
|
283 |
|
284 "Created: / 16-06-2015 / 06:05:56 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
285 ! |
|
286 |
|
287 codeNextToken |
|
288 self add: 'self nextToken.' |
|
289 |
|
290 "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
291 "Modified: / 23-04-2015 / 20:51:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
292 ! |
|
293 |
|
294 codeProfileStart |
|
295 self add: 'context methodInvoked: #', currentMethod methodName, '.' |
|
296 |
|
297 "Created: / 01-06-2015 / 21:17:19 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
298 ! |
|
299 |
|
300 codeProfileStop |
|
301 self add: 'context methodFinished: #', currentMethod methodName, '.' |
|
302 |
|
303 "Created: / 01-06-2015 / 21:19:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
304 ! |
|
305 |
|
306 codeReturn |
|
307 currentMethod isInline ifTrue: [ |
|
308 "If inlined, the return variable already holds the value" |
|
309 ] ifFalse: [ |
|
310 arguments profile ifTrue:[ |
|
311 self codeProfileStop. |
|
312 ]. |
|
313 self add: '^ ', currentMethod returnVariable |
|
314 ]. |
|
315 |
|
316 "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
317 "Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
318 ! |
|
319 |
|
320 codeReturn: code |
|
321 " - returns whatever is in code OR |
|
322 - assigns whatever is in code into the returnVariable" |
|
323 currentMethod isInline ifTrue:[ |
|
324 self codeEvaluateAndAssign: code to: currentMethod returnVariable. |
|
325 ] ifFalse: [ |
|
326 arguments profile ifTrue:[ |
|
327 self codeProfileStop. |
|
328 ]. |
|
329 self add: '^ ', code |
|
330 ] |
|
331 |
|
332 "Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
333 "Modified: / 01-06-2015 / 21:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
334 ! |
|
335 |
|
336 codeStoreValueOf: aBlock intoVariable: aString |
|
337 | tmpVarirable method | |
|
338 self assert: aBlock isBlock. |
|
339 self assert: aString isNil not. |
|
340 |
|
341 tmpVarirable := returnVariable. |
|
342 returnVariable := aString. |
|
343 method := [ |
|
344 aBlock value |
|
345 ] ensure: [ |
|
346 returnVariable := tmpVarirable |
|
347 ]. |
|
348 |
|
349 method isInline ifTrue: [ |
|
350 self callOnLine: method |
|
351 ] ifFalse: [ |
|
352 self codeEvaluateAndAssign: (method call) to: aString. |
|
353 ] |
|
354 |
|
355 "Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
356 ! |
|
357 |
|
358 codeTokenGuard: node ifFalse: codeBlock |
|
359 | guard id | |
|
360 guard := PPCTokenGuard on: node. |
|
361 (guard makesSense) ifTrue: [ |
|
362 id := self idFor: guard firstToken. |
|
363 |
|
364 self add: 'self ', id asString, ' ifFalse: ['. |
|
365 self indent. |
|
366 codeBlock value. |
|
367 self dedent. |
|
368 self add: '].'. |
|
369 ] |
|
370 ! |
|
371 |
|
372 codeTranscriptShow: text |
|
373 (arguments profile) ifTrue: [ |
|
374 self add: 'Transcript show: ', text storeString, '; cr.'. |
|
375 ] |
|
376 ! ! |
|
377 |
|
378 !PPCCodeGen methodsFor:'ids'! |
|
379 |
|
380 asSelector: string |
|
381 "e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432" |
|
382 |
|
383 | toUse | |
|
384 |
|
385 toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ]. |
|
386 (toUse isEmpty or: [ toUse first isLetter not ]) |
|
387 ifTrue: [ toUse := 'v', toUse ]. |
|
388 toUse first isUppercase ifFalse:[ |
|
389 toUse := toUse copy. |
|
390 toUse at: 1 put: toUse first asLowercase |
|
391 ]. |
|
392 ^toUse |
|
393 |
|
394 "Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
395 ! |
|
396 |
|
397 idFor: object |
|
398 self assert: (object canHavePPCId). |
|
399 ^ self idFor: object prefixed: object prefix suffixed: object suffix |
|
400 ! |
|
401 |
|
402 idFor: object prefixed: prefix |
|
403 ^ self idFor: object prefixed: prefix suffixed: '' |
|
404 ! |
|
405 |
|
406 idFor: object prefixed: prefix suffixed: suffix |
|
407 | name id | |
|
408 ^ idCache at: object ifAbsentPut: [ |
|
409 ((object canHavePPCId) and: [object name isNotNil]) ifTrue: [ |
|
410 "Do not use prefix, if there is a name" |
|
411 name := self asSelector: (object name asString). |
|
412 id := (name, suffix) asSymbol. |
|
413 |
|
414 "Make sure, that the generated ID is uniqe!!" |
|
415 (idCache includes: id) ifTrue: [ |
|
416 (id, '_', idCache size asString) asSymbol |
|
417 ] ifFalse: [ |
|
418 id |
|
419 ] |
|
420 ] ifFalse: [ |
|
421 (prefix, '_', (idCache size asString), suffix) asSymbol |
|
422 ] |
|
423 ] |
|
424 ! |
|
425 |
|
426 idFor: object suffixed: suffix |
|
427 self assert: (object isKindOf: PPCNode) description: 'Shold use PPCNode for ids'. |
|
428 ^ self idFor: object prefixed: object prefix suffixed: suffix effect: #none |
|
429 ! ! |
|
430 |
|
431 !PPCCodeGen methodsFor:'initialization'! |
|
432 |
|
433 copy: parser |
|
434 self halt: 'deprecated?'. |
|
435 ^ parser transform: [ :p | p copy ]. |
|
436 ! |
|
437 |
|
438 initialize |
|
439 super initialize. |
|
440 |
|
441 compilerStack := Stack new. |
|
442 methodCache := IdentityDictionary new. |
|
443 constants := Dictionary new. |
|
444 idCache := IdentityDictionary new. |
|
445 ! ! |
|
446 |
|
447 !PPCCodeGen methodsFor:'profiling'! |
|
448 |
|
449 profileTokenRead: tokenName |
|
450 arguments profile ifTrue: [ |
|
451 self add: 'context tokenRead: ', tokenName storeString, '.' |
|
452 ] |
|
453 ! ! |
|
454 |
|
455 !PPCCodeGen methodsFor:'support'! |
|
456 |
|
457 cache: id as: value |
|
458 methodCache at: id put: value. |
|
459 ! |
|
460 |
|
461 cachedValue: id |
|
462 ^ methodCache at: id ifAbsent: [ nil ] |
|
463 ! |
|
464 |
|
465 cachedValue: id ifPresent: block |
|
466 ^ methodCache at: id ifPresent: block |
|
467 ! |
|
468 |
|
469 checkCache: id |
|
470 | method | |
|
471 |
|
472 "self halt: 'deprecated?'." |
|
473 |
|
474 "Check if method is hand written" |
|
475 method := compiledParser ifNotNil: [ compiledParser compiledMethodAt: id ifAbsent: [ nil ] ]. |
|
476 method ifNotNil: [ ^ PPCCompiledMethod new id: id; yourself ]. |
|
477 |
|
478 ^ self cachedValue: id |
|
479 ! |
|
480 |
|
481 pop |
|
482 | retval | |
|
483 retval := compilerStack pop. |
|
484 currentMethod := compilerStack isEmpty |
|
485 ifTrue: [ nil ] |
|
486 ifFalse: [ compilerStack top ]. |
|
487 ^ retval |
|
488 |
|
489 "Modified: / 21-11-2014 / 12:27:25 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
490 ! |
|
491 |
|
492 push |
|
493 compilerStack push: currentMethod. |
|
494 (compilerStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ] |
|
495 |
|
496 "Modified: / 21-11-2014 / 12:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
497 ! |
|
498 |
|
499 startInline: id |
|
500 | indentationLevel | |
|
501 (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ]. |
|
502 indentationLevel := currentMethod indentationLevel. |
|
503 |
|
504 currentMethod := PPCInlinedMethod new. |
|
505 currentMethod id: id. |
|
506 currentMethod returnVariable: returnVariable. |
|
507 currentMethod indentationLevel: indentationLevel. |
|
508 self push. |
|
509 |
|
510 "Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
511 ! |
|
512 |
|
513 startMethod: id |
|
514 (methodCache includesKey: id) ifTrue: [ self error: 'OOOUPS!!' ]. |
|
515 |
|
516 currentMethod := PPCMethod new. |
|
517 currentMethod id: id. |
|
518 currentMethod category: self methodCategory. |
|
519 |
|
520 arguments profile ifTrue:[ |
|
521 self codeProfileStart. |
|
522 ]. |
|
523 self push. |
|
524 |
|
525 self cache: id as: currentMethod. |
|
526 |
|
527 "Modified: / 01-06-2015 / 21:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
528 ! |
|
529 |
|
530 stopInline |
|
531 ^ self pop. |
|
532 |
|
533 "Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
534 ! |
|
535 |
|
536 stopMethod |
|
537 self cache: currentMethod methodName as: currentMethod. |
|
538 |
|
539 "arguments profile ifTrue: [ Transcript show: currentMethod code; cr. ]." |
|
540 ^ self pop. |
|
541 |
|
542 "Modified: / 01-06-2015 / 21:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
543 ! |
|
544 |
|
545 top |
|
546 ^ compilerStack top |
|
547 ! ! |
|
548 |
|
549 !PPCCodeGen methodsFor:'variables'! |
|
550 |
|
551 allocateReturnVariable |
|
552 ^ self allocateReturnVariableNamed: 'retval' |
|
553 |
|
554 "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
555 "Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
556 ! |
|
557 |
|
558 allocateReturnVariableNamed: name |
|
559 "Allocate (or return previously allocated one) temporary variable used for |
|
560 storing a parser's return value (the parsed object)" |
|
561 ^ currentMethod allocateReturnVariableNamed: name |
|
562 |
|
563 "Created: / 15-06-2015 / 18:04:48 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
564 ! |
|
565 |
|
566 allocateTemporaryVariableNamed: preferredName |
|
567 "Allocate a new variable with (preferably) given name. |
|
568 Returns a real variable name that should be used." |
|
569 |
|
570 ^ self currentNonInlineMethod allocateTemporaryVariableNamed: preferredName |
|
571 |
|
572 "Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
573 ! ! |
|
574 |