58 |
58 |
59 super process: node. |
59 super process: node. |
60 ^changeset |
60 ^changeset |
61 |
61 |
62 "Created: / 03-07-2008 / 21:01:19 / Jan Vrany <vranyj1@fel.cvut.cz>" |
62 "Created: / 03-07-2008 / 21:01:19 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
63 ! ! |
|
64 |
|
65 !SmalltalkXGenerator methodsFor:'sources'! |
|
66 |
|
67 sourceForLibraryName |
|
68 |
|
69 ^String streamContents: |
|
70 [:s| |
|
71 s |
|
72 nextPutAll: 'libraryName'; cr; cr; |
|
73 tab; |
|
74 nextPutAll: 'OperatingSystem isUNIXlike ifTrue:[^'; |
|
75 nextPutAll: unixLibraryName storeString; |
|
76 nextPutAll: '].'; |
|
77 cr; cr; |
|
78 tab; |
|
79 nextPutAll: 'OperatingSystem isMSWINDOWSlike ifTrue:[^'; |
|
80 nextPutAll: win32LibraryName storeString; |
|
81 nextPutAll: '].'; |
|
82 cr; cr; |
|
83 tab; |
|
84 nextPutAll:'self error:''Library name for host OS is not known'''. |
|
85 |
|
86 ] |
|
87 |
|
88 "Created: / 10-07-2008 / 09:04:56 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
89 ! |
|
90 |
|
91 sourceForPrimitive:functionNode |
|
92 ^ (String |
|
93 streamContents:[:s | |
|
94 s nextPutAll:functionNode |
|
95 smalltalkPrimitiveSelectorIterlacedWithArgumentNames. |
|
96 s |
|
97 cr; |
|
98 cr; |
|
99 tab; |
|
100 nextPutAll:'<cdecl:'; |
|
101 space; |
|
102 nextPutAll:functionNode return ffiTypeSymbol; |
|
103 space; |
|
104 nextPut:$"; |
|
105 nextPutAll:functionNode cName; |
|
106 nextPut:$"; |
|
107 space; |
|
108 nextPut:$(; |
|
109 space. |
|
110 functionNode arguments do:[:argument | |
|
111 s |
|
112 nextPutAll:argument type ffiTypeSymbol; |
|
113 space |
|
114 ]. |
|
115 s |
|
116 nextPut:$); |
|
117 space. |
|
118 s nextPut:$>. |
|
119 s |
|
120 cr; |
|
121 tab. |
|
122 s nextPutAll:'self primitiveFailed'. |
|
123 ]) |
|
124 |
|
125 "Created: / 10-07-2008 / 09:00:06 / Jan Vrany <vranyj1@fel.cvut.cz>" |
63 ! ! |
126 ! ! |
64 |
127 |
65 !SmalltalkXGenerator methodsFor:'visiting'! |
128 !SmalltalkXGenerator methodsFor:'visiting'! |
66 |
129 |
67 visitCEnumNode: cEnumNode |
130 visitCEnumNode: cEnumNode |
121 |
184 |
122 "Created: / 03-07-2008 / 20:10:34 / Jan Vrany <vranyj1@fel.cvut.cz>" |
185 "Created: / 03-07-2008 / 20:10:34 / Jan Vrany <vranyj1@fel.cvut.cz>" |
123 "Modified: / 04-07-2008 / 11:58:27 / Jan Vrany <vranyj1@fel.cvut.cz>" |
186 "Modified: / 04-07-2008 / 11:58:27 / Jan Vrany <vranyj1@fel.cvut.cz>" |
124 ! |
187 ! |
125 |
188 |
126 visitCFunctionNode:functionNode |
189 visitCFunctionNode:functionNode |
|
190 (changeset add:MethodDefinitionChange new) |
|
191 className:(functionNode smalltalkClassNameWithNamespace , ' class') |
|
192 asSymbol; |
|
193 category:'primitives'; |
|
194 selector:functionNode smalltalkPrimitiveSelector; |
|
195 source:(self sourceForPrimitive:functionNode). |
|
196 |
|
197 "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>" |
|
199 ! |
|
200 |
|
201 visitCStructFieldNode:field |
|
202 |
|
203 (changeset add: MethodDefinitionChange new) |
|
204 className: (field owner smalltalkClassNameWithNamespace) asSymbol; |
|
205 category: 'accessing - primitives'; |
|
206 selector: ('prim' , field smalltalkName capitalized); |
|
207 source: |
|
208 (String streamContents: |
|
209 [:s| |
|
210 s |
|
211 nextPutAll:('prim' , field smalltalkName capitalized); cr; cr; |
|
212 tab; nextPutAll: 'self'; space; |
|
213 nextPutAll: field smalltalkxValueExtractionSelector; |
|
214 nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString]). |
127 |
215 |
128 (changeset add: MethodDefinitionChange new) |
216 (changeset add: MethodDefinitionChange new) |
129 className: (functionNode smalltalkClassNameWithNamespace , ' class') asSymbol; |
217 className: (field owner smalltalkClassNameWithNamespace) asSymbol; |
130 category: 'primitives'; |
218 category: 'accessing - primitives'; |
131 selector: ('prim' , functionNode smalltalkSelector capitalized); |
219 selector: ('prim' , field smalltalkName capitalized, ':') asSymbol; |
132 source: |
220 source: |
133 (String streamContents: |
221 (String streamContents: |
134 [:s| |
222 [:s| |
135 | primSelector | |
|
136 primSelector := ('prim' , functionNode smalltalkSelector capitalized) asSymbol. |
|
137 functionNode arguments size > 0 |
|
138 ifTrue: |
|
139 [primSelector keywords with: functionNode arguments do: |
|
140 [:keyword :argument| |
|
141 s nextPutAll: keyword; space; nextPutAll: argument cName; space]] |
|
142 ifFalse: |
|
143 [s nextPutAll: primSelector]. |
|
144 s cr; cr; tab; |
|
145 nextPutAll: '<cdecl:'; |
|
146 space; |
|
147 nextPutAll: functionNode return ffiTypeSymbol; |
|
148 space; |
|
149 nextPut:$"; |
|
150 nextPutAll: functionNode cName; |
|
151 nextPut:$"; |
|
152 space; |
|
153 nextPut:$(; |
|
154 space. |
|
155 functionNode arguments do: |
|
156 [:argument| |
|
157 s nextPutAll: argument type ffiTypeSymbol; space]. |
|
158 s |
223 s |
159 nextPut:$); |
224 nextPutAll:('prim' , field smalltalkName capitalized, ':') asSymbol; |
160 space. |
225 space; nextPutAll: 'value'; cr; cr; |
161 module ifNotNil:[ |
226 tab; nextPutAll: 'self'; space; |
162 s |
227 nextPutAll: field smalltalkxValueSettingSelector keywords first; |
163 nextPutAll:'module:'; |
228 nextPutAll: '1 + '; nextPutAll: (field offset / 8) printString; space; |
164 space; |
229 nextPutAll: field smalltalkxValueSettingSelector keywords second; |
165 nextPut:$"; |
230 nextPutAll: 'value']) |
166 nextPutAll: module; |
231 |
167 nextPut:$"; |
232 "Created: / 09-07-2008 / 21:32:53 / Jan Vrany <vranyj1@fel.cvut.cz>" |
168 space]. |
233 "Modified: / 10-07-2008 / 07:43:54 / Jan Vrany <vranyj1@fel.cvut.cz>" |
169 s |
|
170 nextPut:$>. |
|
171 s cr; tab. |
|
172 s nextPutAll:'self primitiveFailed'. |
|
173 ]). |
|
174 |
|
175 "Created: / 03-07-2008 / 21:26:42 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
176 "Modified: / 04-07-2008 / 08:36:25 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
177 ! |
234 ! |
178 |
235 |
179 visitCStructNode: cStructNode |
236 visitCStructNode: cStructNode |
|
237 |
|
238 self visitCStructuredNode: cStructNode |
|
239 |
|
240 "Created: / 03-07-2008 / 21:31:31 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
241 "Modified: / 10-07-2008 / 08:46:29 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
242 ! |
|
243 |
|
244 visitCStructuredNode: cStructNode |
180 |
245 |
181 cStructNode foreign ifTrue:[^self]. |
246 cStructNode foreign ifTrue:[^self]. |
182 |
247 |
183 cStructNode isAnonymous ifTrue:[^self]. |
248 cStructNode isAnonymous ifTrue:[^self]. |
184 |
249 |
190 category: |
255 category: |
191 cStructNode smalltalkCategory; |
256 cStructNode smalltalkCategory; |
192 package: |
257 package: |
193 cStructNode smalltalkPackage. |
258 cStructNode smalltalkPackage. |
194 |
259 |
195 "Created: / 03-07-2008 / 21:31:31 / Jan Vrany <vranyj1@fel.cvut.cz>" |
260 (changeset add:MethodDefinitionChange new) |
196 "Modified: / 04-07-2008 / 09:24:55 / Jan Vrany <vranyj1@fel.cvut.cz>" |
261 className:(cStructNode smalltalkClassNameWithNamespace , ' class') |
|
262 asSymbol; |
|
263 category:'accessing'; |
|
264 selector:#libraryName; |
|
265 source:(self sourceForLibraryName). |
|
266 |
|
267 cStructNode fields do: |
|
268 [:fieldNode|self visit: fieldNode] |
|
269 |
|
270 "Created: / 10-07-2008 / 08:46:12 / Jan Vrany <vranyj1@fel.cvut.cz>" |
197 ! |
271 ! |
198 |
272 |
199 visitCTypedefNode: typedefNode |
273 visitCTypedefNode: typedefNode |
200 |
274 |
201 "Created: / 03-07-2008 / 22:00:49 / Jan Vrany <vranyj1@fel.cvut.cz>" |
275 "Created: / 03-07-2008 / 22:00:49 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
276 ! |
|
277 |
|
278 visitCUnionNode: cStructNode |
|
279 |
|
280 self visitCStructuredNode: cStructNode |
|
281 |
|
282 "Created: / 09-07-2008 / 22:30:14 / Jan Vrany <vranyj1@fel.cvut.cz>" |
|
283 "Modified: / 10-07-2008 / 08:46:43 / Jan Vrany <vranyj1@fel.cvut.cz>" |
202 ! ! |
284 ! ! |
203 |
285 |
204 !SmalltalkXGenerator class methodsFor:'documentation'! |
286 !SmalltalkXGenerator class methodsFor:'documentation'! |
205 |
287 |
206 version |
288 version |