1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
1 "{ Package: 'stx:goodies/petitparser/compiler' }" |
2 |
2 |
3 "{ NameSpace: Smalltalk }" |
3 "{ NameSpace: Smalltalk }" |
4 |
4 |
5 Object subclass:#PPCMethod |
5 Object subclass:#PPCMethod |
6 instanceVariableNames:'buffer variables indentation id profile variableForReturn |
6 instanceVariableNames:'buffer id variableForReturn category' |
7 category' |
|
8 classVariableNames:'' |
7 classVariableNames:'' |
9 poolDictionaries:'' |
8 poolDictionaries:'' |
10 category:'PetitCompiler-Core' |
9 category:'PetitCompiler-Compiler-Codegen' |
11 ! |
10 ! |
12 |
11 |
13 |
12 |
14 !PPCMethod class methodsFor:'as yet unclassified'! |
13 !PPCMethod class methodsFor:'as yet unclassified'! |
15 |
14 |
39 category: value |
38 category: value |
40 category := value |
39 category := value |
41 ! |
40 ! |
42 |
41 |
43 code |
42 code |
44 ^ self methodName, Character cr asString, |
43 ^ String streamContents: [ :s | |
45 self variables, Character cr asString, |
44 s nextPutAll: self methodName; cr. |
46 self profilingBegin, Character cr asString, |
45 buffer codeOn: s. |
47 self body, Character cr asString |
46 ] |
48 " self profilingEnd" |
|
49 |
47 |
50 "Modified: / 23-04-2015 / 19:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
48 "Modified: / 01-06-2015 / 21:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
51 ! |
49 ! |
52 |
50 |
53 id: value |
51 id: value |
54 id := value |
52 id := value |
55 ! |
53 ! |
56 |
54 |
|
55 indentationLevel |
|
56 ^ buffer indentationLevel |
|
57 |
|
58 "Created: / 01-06-2015 / 21:38:31 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
59 ! |
|
60 |
|
61 indentationLevel: anInteger |
|
62 buffer indentationLevel: anInteger |
|
63 |
|
64 "Created: / 01-06-2015 / 21:38:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
65 ! |
|
66 |
57 methodName |
67 methodName |
58 ^ id |
68 ^ id |
59 ! |
|
60 |
|
61 profile |
|
62 ^ profile |
|
63 ! |
|
64 |
|
65 profile: aBoolean |
|
66 profile := aBoolean |
|
67 ! ! |
69 ! ! |
68 |
70 |
69 !PPCMethod methodsFor:'as yet unclassified'! |
71 !PPCMethod methodsFor:'as yet unclassified'! |
70 |
72 |
71 add: string |
73 add: string |
72 self nl. |
74 buffer add: string |
73 ((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ |
|
74 indentation * 4 timesRepeat: [ buffer nextPut: Character space ]. |
|
75 ] ifFalse:[ |
|
76 indentation timesRepeat: [ buffer nextPut: Character tab ]. |
|
77 ]. |
|
78 self addOnLine: string. |
|
79 |
75 |
80 "Modified: / 21-05-2015 / 15:42:18 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
76 "Modified: / 01-06-2015 / 21:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
81 ! |
77 ! |
82 |
78 |
83 addOnLine: string |
79 addOnLine: string |
84 buffer nextPutAll: string. |
80 buffer addOnLine: string |
|
81 |
|
82 "Modified: / 01-06-2015 / 21:09:20 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
85 ! |
83 ! |
86 |
84 |
87 call |
85 call |
88 ^ 'self ', self methodName, '.'. |
86 ^ 'self ', self methodName, '.'. |
89 ! |
|
90 |
|
91 nl |
|
92 ^ buffer nextPut: Character cr |
|
93 ! |
87 ! |
94 |
88 |
95 profilingBegin |
89 profilingBegin |
96 self profile ifTrue: [ |
90 self profile ifTrue: [ |
97 ^ ' context methodInvoked: #', id, '.' |
91 ^ ' context methodInvoked: #', id, '.' |
104 ^ ' context methodFinished: #', id, '.' |
98 ^ ' context methodFinished: #', id, '.' |
105 ]. |
99 ]. |
106 ^ '' |
100 ^ '' |
107 ! ! |
101 ! ! |
108 |
102 |
|
103 !PPCMethod methodsFor:'code generation - indenting'! |
|
104 |
|
105 dedent |
|
106 buffer dedent |
|
107 |
|
108 "Created: / 01-06-2015 / 21:32:28 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
109 ! |
|
110 |
|
111 indent |
|
112 buffer indent |
|
113 |
|
114 "Created: / 01-06-2015 / 21:32:22 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
115 ! |
|
116 |
|
117 nl |
|
118 |
|
119 buffer nl |
|
120 |
|
121 "Created: / 01-06-2015 / 21:52:31 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
122 ! ! |
|
123 |
109 !PPCMethod methodsFor:'code generation - variables'! |
124 !PPCMethod methodsFor:'code generation - variables'! |
110 |
125 |
111 addVariable: name |
126 allocateReturnVariable |
112 (variables includes: name) ifTrue:[ |
127 ^ variableForReturn isNil ifTrue:[ |
113 self error:'Duplicate variable name, must rename'. |
128 variableForReturn := self allocateTemporaryVariableNamed: 'retval' |
|
129 ] ifFalse:[ |
|
130 variableForReturn |
114 ]. |
131 ]. |
115 variables add: name. |
|
116 |
|
117 "Modified: / 23-04-2015 / 12:29:58 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
118 ! |
|
119 |
|
120 allocateReturnVariable |
|
121 |
|
122 ^ variableForReturn isNil ifTrue:[ |
|
123 variableForReturn := self allocateTemporaryVariableNamed: 'retval' |
|
124 ] ifFalse:[ |
|
125 variableForReturn |
|
126 ]. |
|
127 |
132 |
128 "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
133 "Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
134 "Modified (format): / 01-06-2015 / 21:01:29 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
129 ! |
135 ! |
130 |
136 |
131 allocateTemporaryVariableNamed:preferredName |
137 allocateTemporaryVariableNamed:preferredName |
132 "Allocate a new variable with (preferably) given name. |
138 "Allocate a new variable with (preferably) given name. |
133 Returns a real variable name that should be used." |
139 Returns a real variable name that should be used." |
134 |
|
135 (variables includes:preferredName) ifFalse:[ |
|
136 variables add:preferredName. |
|
137 ^ preferredName |
|
138 ] ifTrue:[ |
|
139 | name | |
|
140 |
140 |
141 name := preferredName , '_' , (variables size + 1) printString. |
141 ^ buffer allocateTemporaryVariableNamed: preferredName |
142 variables add:name. |
|
143 ^ name |
|
144 ]. |
|
145 |
142 |
146 "Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
143 "Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
144 "Modified: / 01-06-2015 / 21:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
147 ! |
145 ! |
148 |
146 |
149 returnVariable |
147 returnVariable |
150 ^ variableForReturn |
148 ^ variableForReturn |
151 |
149 |
155 returnVariable: aString |
153 returnVariable: aString |
156 ^ variableForReturn := aString |
154 ^ variableForReturn := aString |
157 |
155 |
158 "Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
156 "Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
159 "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
157 "Modified: / 23-04-2015 / 21:08:54 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
160 ! |
|
161 |
|
162 variables |
|
163 ^ ' | ', (variables inject: '' into: [ :s :e | s, ' ', e]), ' |' |
|
164 ! ! |
|
165 |
|
166 !PPCMethod methodsFor:'indentation'! |
|
167 |
|
168 dedent |
|
169 indentation := indentation - 1 |
|
170 ! |
|
171 |
|
172 indent |
|
173 indentation := indentation + 1 |
|
174 ! |
|
175 |
|
176 indentationLevel |
|
177 ^ indentation |
|
178 ! |
|
179 |
|
180 indentationLevel: value |
|
181 indentation := value |
|
182 ! ! |
158 ! ! |
183 |
159 |
184 !PPCMethod methodsFor:'initialization'! |
160 !PPCMethod methodsFor:'initialization'! |
185 |
161 |
186 initialize |
162 initialize |
187 buffer := WriteStream on: ''. |
163 buffer := PPCCodeBlock new. |
188 indentation := 1. |
164 |
189 variables := OrderedCollection new. |
165 "Modified: / 01-06-2015 / 21:33:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
190 ! ! |
166 ! ! |
191 |
167 |
192 !PPCMethod methodsFor:'printing'! |
168 !PPCMethod methodsFor:'printing'! |
193 |
169 |
194 printOn:aStream |
170 printOn:aStream |