121 tab. |
121 tab. |
122 s nextPutAll:'self primitiveFailed'. |
122 s nextPutAll:'self primitiveFailed'. |
123 ]) |
123 ]) |
124 |
124 |
125 "Created: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>" |
125 "Created: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
126 ! |
|
127 |
|
128 sourceForStructFieldGetter:field |
|
129 ^ (String |
|
130 streamContents:[:s | |
|
131 s |
|
132 nextPutAll:(field smalltalkName); |
|
133 cr; |
|
134 cr; |
|
135 tab; |
|
136 nextPutAll:'^self'; |
|
137 space; |
|
138 nextPutAll:field stxStructFieldGetterSelector; |
|
139 nextPutAll:'1 + '; |
|
140 nextPutAll:(field offset / 8) printString |
|
141 ]) |
|
142 |
|
143 "Created: / 09-09-2008 / 21:25:16 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
144 ! |
|
145 |
|
146 sourceForStructFieldSetter:field |
|
147 |
|
148 field isCPointerToCStructure ifTrue: |
|
149 [self halt: 'Finish creation of ExternalStructure here']. |
|
150 |
|
151 ^ (String |
|
152 streamContents:[:s | |
|
153 s |
|
154 nextPutAll:(field smalltalkName , ':') asSymbol; |
|
155 space; |
|
156 nextPutAll:'value'; |
|
157 cr; |
|
158 cr; |
|
159 tab; |
|
160 nextPutAll:'self'; |
|
161 space; |
|
162 nextPutAll:field stxStructFieldSetterSelector keywords first; |
|
163 nextPutAll:'1 + '; |
|
164 nextPutAll:(field offset / 8) printString; |
|
165 space; |
|
166 nextPutAll:field stxStructFieldSetterSelector keywords second; |
|
167 nextPutAll:'value' |
|
168 ]) |
|
169 |
|
170 "Created: / 09-09-2008 / 21:26:07 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
171 ! |
|
172 |
|
173 sourceForStructSize: size |
|
174 |
|
175 ^String streamContents: |
|
176 [:s| |
|
177 s |
|
178 nextPutAll: 'structSize'; cr; cr; |
|
179 tab; |
|
180 nextPutAll: '^'; |
|
181 nextPutAll: size printString |
|
182 ] |
|
183 |
|
184 "Created: / 09-09-2008 / 17:12:01 / Jan Vrany <vranyj1@fel.cvut.cz>" |
126 ! ! |
185 ! ! |
127 |
186 |
128 !SmalltalkXGenerator methodsFor:'visiting'! |
187 !SmalltalkXGenerator methodsFor:'visiting'! |
129 |
188 |
130 visitCEnumNode: cEnumNode |
189 visitCEnumNode: cEnumNode |
196 |
255 |
197 "Created: / 03-07-2008 / 21:26:42 / Jan Vrany <vranyj1@fel.cvut.cz>" |
256 "Created: / 03-07-2008 / 21:26:42 / Jan Vrany <vranyj1@fel.cvut.cz>" |
198 "Modified: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>" |
257 "Modified: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>" |
199 ! |
258 ! |
200 |
259 |
201 visitCStructFieldNode:field |
260 visitCStructFieldNode:field |
202 |
261 (changeset add:MethodDefinitionChange new) |
203 (changeset add: MethodDefinitionChange new) |
262 className:(field owner smalltalkClassNameWithNamespace) asSymbol; |
204 className: (field owner smalltalkClassNameWithNamespace) asSymbol; |
263 category:'accessing'; |
205 category: 'accessing - primitives'; |
264 selector:(field smalltalkName) asSymbol; |
206 selector: ('prim' , field smalltalkName capitalized); |
265 source:(self sourceForStructFieldGetter:field). |
207 source: |
266 (changeset add:MethodDefinitionChange new) |
208 (String streamContents: |
267 className:(field owner smalltalkClassNameWithNamespace) asSymbol; |
209 [:s| |
268 category:'accessing'; |
210 s |
269 selector:(field smalltalkName , ':') asSymbol; |
211 nextPutAll:('prim' , field smalltalkName capitalized); cr; cr; |
270 source:(self sourceForStructFieldSetter:field) |
212 tab; nextPutAll: 'self'; space; |
271 |
213 nextPutAll: field smalltalkxValueExtractionSelector; |
272 "Modified: / 09-09-2008 / 21:39:33 / Jan Vrany <vranyj1@fel.cvut.cz>" |
214 nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString]). |
|
215 |
|
216 (changeset add: MethodDefinitionChange new) |
|
217 className: (field owner smalltalkClassNameWithNamespace) asSymbol; |
|
218 category: 'accessing - primitives'; |
|
219 selector: ('prim' , field smalltalkName capitalized, ':') asSymbol; |
|
220 source: |
|
221 (String streamContents: |
|
222 [:s| |
|
223 s |
|
224 nextPutAll:('prim' , field smalltalkName capitalized, ':') asSymbol; |
|
225 space; nextPutAll: 'value'; cr; cr; |
|
226 tab; nextPutAll: 'self'; space; |
|
227 nextPutAll: field smalltalkxValueSettingSelector keywords first; |
|
228 nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString; space; |
|
229 nextPutAll: field smalltalkxValueSettingSelector keywords second; |
|
230 nextPutAll: 'value']) |
|
231 |
|
232 "Created: / 09-07-2008 / 21:32:53 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
233 "Modified: / 10-07-2008 / 07:43:54 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
234 ! |
273 ! |
235 |
274 |
236 visitCStructNode: cStructNode |
275 visitCStructNode: cStructNode |
237 |
276 |
238 self visitCStructuredNode: cStructNode |
277 self visitCStructuredNode: cStructNode |
241 "Modified: / 10-07-2008 / 08:46:29 / Jan Vrany <vranyj1@fel.cvut.cz>" |
280 "Modified: / 10-07-2008 / 08:46:29 / Jan Vrany <vranyj1@fel.cvut.cz>" |
242 ! |
281 ! |
243 |
282 |
244 visitCStructuredNode: cStructNode |
283 visitCStructuredNode: cStructNode |
245 |
284 |
|
285 | smalltalkClass | |
|
286 |
246 cStructNode foreign ifTrue:[^self]. |
287 cStructNode foreign ifTrue:[^self]. |
247 |
288 |
248 cStructNode isAnonymous ifTrue:[^self]. |
289 cStructNode isAnonymous ifTrue:[^self]. |
249 |
290 |
250 (changeset add: ClassDefinitionChange new) |
291 smalltalkClass := Smalltalk at: cStructNode smalltalkClassNameWithNamespace ifAbsent:[nil]. |
251 superClassName: |
292 smalltalkClass |
252 ExternalStructure fullName; |
293 ifNil: |
253 className: |
294 [(changeset add: ClassDefinitionChange new) |
254 cStructNode smalltalkClassNameWithNamespace; |
295 superClassName: |
255 category: |
296 ExternalStructure fullName; |
256 cStructNode smalltalkCategory; |
297 className: |
257 package: |
298 cStructNode smalltalkClassNameWithNamespace; |
258 cStructNode smalltalkPackage. |
299 category: |
|
300 cStructNode smalltalkCategory; |
|
301 package: |
|
302 cStructNode smalltalkPackage] |
|
303 ifNotNil: |
|
304 [(smalltalkClass inheritsFrom: ExternalStructure) |
|
305 ifFalse: |
|
306 [self error:'Class ',smalltalkClass fullName,' should inherit from ExternalStructure']]. |
259 |
307 |
260 (changeset add:MethodDefinitionChange new) |
308 (changeset add:MethodDefinitionChange new) |
261 className:(cStructNode smalltalkClassNameWithNamespace , ' class') |
309 className:(cStructNode smalltalkClassNameWithNamespace , ' class') |
262 asSymbol; |
310 asSymbol; |
263 category:'accessing'; |
311 category:'accessing'; |
264 selector:#libraryName; |
312 selector:#libraryName; |
265 source:(self sourceForLibraryName). |
313 source:(self sourceForLibraryName). |
266 |
314 |
|
315 (changeset add:MethodDefinitionChange new) |
|
316 className:(cStructNode smalltalkClassNameWithNamespace , ' class') |
|
317 asSymbol; |
|
318 category:'accessing'; |
|
319 selector:#structSize; |
|
320 source:(self sourceForStructSize: cStructNode cByteSize). |
|
321 |
267 cStructNode fields do: |
322 cStructNode fields do: |
268 [:fieldNode|self visit: fieldNode] |
323 [:fieldNode|self visit: fieldNode] |
269 |
324 |
270 "Created: / 10-07-2008 / 08:46:12 / Jan Vrany <vranyj1@fel.cvut.cz>" |
325 "Created: / 10-07-2008 / 08:46:12 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
326 "Modified: / 09-09-2008 / 20:12:35 / Jan Vrany <vranyj1@fel.cvut.cz>" |
271 ! |
327 ! |
272 |
328 |
273 visitCTypedefNode: typedefNode |
329 visitCTypedefNode: typedefNode |
274 |
330 |
275 "Created: / 03-07-2008 / 22:00:49 / Jan Vrany <vranyj1@fel.cvut.cz>" |
331 "Created: / 03-07-2008 / 22:00:49 / Jan Vrany <vranyj1@fel.cvut.cz>" |