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
|
'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6548] on 31 March 2005 at 3:46:37 pm'!
"Change Set: VMM38b4-64bit-vm2-ikp
Date: 2005-03-31
Author: ian.piumarta@squeakland.org
Changes relative to VMM38b4-64bit-vm1 that add 64-bit support to SmartSyntaxInterpreterPlugins. Needed to correctly translate the SocketPlugin."!
!Object class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:20'!
ccgDeclareCForVar: aSymbolOrString
^'sqInt ', aSymbolOrString! !
!Array class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:20'!
ccgDeclareCForVar: aSymbolOrString
^'sqInt *', aSymbolOrString! !
!Oop class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:20'!
ccgDeclareCForVar: aSymbolOrString
^'sqInt ', aSymbolOrString! !
!SmartSyntaxPluginCodeGenerator methodsFor: 'translating builtins' stamp: 'ikp 3/31/2005 15:46'!
generateCPtrAsOop: aNode on: aStream indent: anInteger
aStream nextPutAll: '((sqInt)(long)('.
self emitCExpression: aNode receiver on: aStream.
aStream nextPutAll: ') - sizeof(sqInt))'.! !
!SmartSyntaxPluginTMethod methodsFor: 'private' stamp: 'ikp 3/31/2005 14:23'!
oopVariable: aString
(locals includes: aString) ifFalse:
[locals add: aString.
declarations
at: aString
put: 'sqInt ', aString].
^TVariableNode new setName: aString! !
!SmartSyntaxPluginTMethod methodsFor: 'generating C code' stamp: 'ikp 3/31/2005 14:23'!
emitCHeaderOn: aStream generator: aCodeGen
"Emit a C function header for this method onto the given stream."
aStream cr.
self emitCFunctionPrototype: aStream generator: aCodeGen.
aStream nextPutAll: ' {'; cr.
locals do: [ :var |
aStream
tab;
nextPutAll: (declarations
at: var
ifAbsent: [ 'sqInt ', var]);
nextPut: $;;
cr].
locals isEmpty ifFalse: [ aStream cr ].! !
!SmartSyntaxPluginTMethod methodsFor: 'initializing' stamp: 'ikp 3/31/2005 14:01'!
setSelector: sel args: argList locals: localList block: aBlockNode primitive: aNumber
"Initialize this method using the given information."
selector _ sel.
returnType _ 'sqInt'. "assume return type is sqInt for now"
args _ argList asOrderedCollection collect: [:arg | arg key].
locals _ localList asOrderedCollection collect: [:arg | arg key].
declarations _ Dictionary new.
primitive _ aNumber.
parseTree _ aBlockNode asTranslatorNode.
labels _ OrderedCollection new.
complete _ false. "set to true when all possible inlining has been done"
export _ self extractExportDirective.
static _ self extractStaticDirective.
self extractSharedCase.
isPrimitive _ false. "set to true only if you find a primtive direction."
suppressingFailureGuards _ self extractSuppressFailureGuardDirective.
self recordDeclarations.
self extractPrimitiveDirectives.
! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:12'!
intToNetAddress: addr
"Convert the given 32-bit integer into an internet network address represented as a four-byte ByteArray."
| netAddressOop naPtr |
self var: #naPtr declareC: 'char * naPtr'.
netAddressOop _
interpreterProxy instantiateClass: interpreterProxy classByteArray
indexableSize: 4.
naPtr _ netAddressOop asCharPtr.
naPtr at: 0 put: (self cCoerce: ((addr >> 24) bitAnd: 16rFF) to: 'char').
naPtr at: 1 put: (self cCoerce: ((addr >> 16) bitAnd: 16rFF) to: 'char').
naPtr at: 2 put: (self cCoerce: ((addr >> 8) bitAnd: 16rFF) to: 'char').
naPtr at: 3 put: (self cCoerce: (addr bitAnd: 16rFF) to: 'char').
^ netAddressOop! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:03'!
primitiveSocket: socket getOptions: optionName
| s optionNameStart optionNameSize returnedValue errorCode results |
self var: #s declareC: 'SocketPtr s'.
self var: #optionNameStart declareC: 'char *optionNameStart'.
self primitive: 'primitiveSocketGetOptions'
parameters: #(Oop Oop).
s _ self socketValueOf: socket.
interpreterProxy success: (interpreterProxy isBytes: optionName).
optionNameStart _ self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'.
optionNameSize _ interpreterProxy slotSizeOf: optionName.
interpreterProxy failed ifTrue: [^nil].
returnedValue _ 0.
errorCode _ self sqSocketGetOptions: s
optionNameStart: optionNameStart
optionNameSize: optionNameSize
returnedValue: (self cCode: '&returnedValue').
interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj.
interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj.
interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2).
results _ interpreterProxy popRemappableOop.
interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
^ results! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:08'!
primitiveSocket: socket receiveDataBuf: array start: startIndex count: count
| s byteSize arrayBase bufStart bytesReceived |
self var: #s declareC: 'SocketPtr s'.
self var: #arrayBase declareC: 'char *arrayBase'.
self var: #bufStart declareC: 'char *bufStart'.
self primitive: 'primitiveSocketReceiveDataBufCount'
parameters: #(Oop Oop SmallInteger SmallInteger ).
s _ self socketValueOf: socket.
"buffer can be any indexable words or bytes object"
interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
(interpreterProxy isWords: array)
ifTrue: [byteSize _ 4]
ifFalse: [byteSize _ 1].
interpreterProxy success: (startIndex >= 1
and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
interpreterProxy failed
ifFalse: ["Note: adjust bufStart for zero-origin indexing"
arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
bufStart _ arrayBase + (startIndex - 1 * byteSize).
bytesReceived _ self
sqSocket: s
ReceiveDataBuf: bufStart
Count: count * byteSize].
^ (bytesReceived // byteSize) asSmallIntegerObj! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:09'!
primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count
| s byteSize arrayBase bufStart bytesReceived results address port moreFlag |
self var: #s declareC: 'SocketPtr s'.
self var: #arrayBase declareC: 'char *arrayBase'.
self var: #bufStart declareC: 'char *bufStart'.
self primitive: 'primitiveSocketReceiveUDPDataBufCount'
parameters: #(Oop Oop SmallInteger SmallInteger ).
s _ self socketValueOf: socket.
"buffer can be any indexable words or bytes object"
interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
(interpreterProxy isWords: array)
ifTrue: [byteSize _ 4]
ifFalse: [byteSize _ 1].
interpreterProxy success: (startIndex >= 1
and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
interpreterProxy failed
ifFalse: ["Note: adjust bufStart for zero-origin indexing"
arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
bufStart _ arrayBase + (startIndex - 1 * byteSize).
"allocate storage for results, remapping newly allocated
oops in case GC happens during allocation"
address _ 0.
port _ 0.
moreFlag _ 0.
bytesReceived _ self
sqSocket: s
ReceiveUDPDataBuf: bufStart
Count: count * byteSize
address: (self cCode: '&address')
port: (self cCode: '&port')
moreFlag: (self cCode: '&moreFlag').
interpreterProxy pushRemappableOop: port asSmallIntegerObj.
interpreterProxy pushRemappableOop: (self intToNetAddress: address).
interpreterProxy pushRemappableOop: (bytesReceived // byteSize) asSmallIntegerObj.
interpreterProxy pushRemappableOop:
(interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 4).
results _ interpreterProxy popRemappableOop.
interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
interpreterProxy storePointer: 2 ofObject: results withValue: interpreterProxy popRemappableOop.
moreFlag
ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
].
^ results! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:05'!
primitiveSocket: socket sendData: array start: startIndex count: count
| s byteSize arrayBase bufStart bytesSent |
self var: #s declareC: 'SocketPtr s'.
self var: #arrayBase declareC: 'char *arrayBase'.
self var: #bufStart declareC: 'char *bufStart'.
self primitive: 'primitiveSocketSendDataBufCount'
parameters: #(Oop Oop SmallInteger SmallInteger ).
s _ self socketValueOf: socket.
"buffer can be any indexable words or bytes object except CompiledMethod "
interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
(interpreterProxy isWords: array)
ifTrue: [byteSize _ 4]
ifFalse: [byteSize _ 1].
interpreterProxy success: (startIndex >= 1
and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
interpreterProxy failed
ifFalse: ["Note: adjust bufStart for zero-origin indexing"
arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
bufStart _ arrayBase + (startIndex - 1 * byteSize).
bytesSent _ self
sqSocket: s
SendDataBuf: bufStart
Count: count * byteSize].
^ (bytesSent // byteSize) asSmallIntegerObj! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:06'!
primitiveSocket: socket sendUDPData: array toHost: hostAddress port: portNumber start: startIndex count: count
| s byteSize arrayBase bufStart bytesSent address |
self var: #s declareC: 'SocketPtr s'.
self var: #arrayBase declareC: 'char *arrayBase'.
self var: #bufStart declareC: 'char *bufStart'.
self primitive: 'primitiveSocketSendUDPDataBufCount'
parameters: #(Oop Oop ByteArray SmallInteger SmallInteger SmallInteger ).
s _ self socketValueOf: socket.
"buffer can be any indexable words or bytes object except CompiledMethod "
interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
(interpreterProxy isWords: array)
ifTrue: [byteSize _ 4]
ifFalse: [byteSize _ 1].
interpreterProxy success: (startIndex >= 1
and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
interpreterProxy failed
ifFalse: ["Note: adjust bufStart for zero-origin indexing"
arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
bufStart _ arrayBase + (startIndex - 1 * byteSize).
address _ self netAddressToInt: (self cCoerce: hostAddress to: 'unsigned char *').
bytesSent _ self
sqSocket: s
toHost: address
port: portNumber
SendDataBuf: bufStart
Count: count * byteSize].
^ (bytesSent // byteSize) asSmallIntegerObj! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:06'!
primitiveSocket: socket setOptions: optionName value: optionValue
| s optionNameStart optionNameSize optionValueStart optionValueSize returnedValue errorCode results |
self var: #s declareC: 'SocketPtr s'.
self var: #optionNameStart declareC: 'char *optionNameStart'.
self var: #optionValueStart declareC: 'char *optionValueStart'.
self primitive: 'primitiveSocketSetOptions'
parameters: #(Oop Oop Oop).
s _ self socketValueOf: socket.
interpreterProxy success: (interpreterProxy isBytes: optionName).
optionNameStart _ self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'.
optionNameSize _ interpreterProxy slotSizeOf: optionName.
interpreterProxy success: (interpreterProxy isBytes: optionValue).
optionValueStart_ self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: 'char *'.
optionValueSize _ interpreterProxy slotSizeOf: optionValue.
interpreterProxy failed ifTrue: [^nil].
returnedValue _ 0.
errorCode _ self sqSocketSetOptions: s
optionNameStart: optionNameStart
optionNameSize: optionNameSize
optionValueStart: optionValueStart
optionValueSize: optionValueSize
returnedValue: (self cCode: '&returnedValue').
interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj.
interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj.
interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2).
results _ interpreterProxy popRemappableOop.
interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
^ results! !
!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:08'!
socketValueOf: socketOop
"Return a pointer to the first byte of of the socket record within the
given Smalltalk object, or nil if socketOop is not a socket record."
| socketIndex |
self returnTypeC: 'SQSocket *'.
self var: #socketIndex type: 'void *'.
interpreterProxy success: ((interpreterProxy isBytes: socketOop)
and: [(interpreterProxy byteSizeOf: socketOop)
= self socketRecordSize]).
interpreterProxy failed
ifTrue: [^ nil]
ifFalse: [socketIndex _ self cCoerce: (interpreterProxy firstIndexableField: socketOop) to: 'void *'.
^ self cCode: '(SQSocket *) socketIndex']! !
!SocketPlugin class methodsFor: 'translation' stamp: 'ikp 3/31/2005 13:43'!
declareCVarsIn: aCCodeGenerator
aCCodeGenerator var: 'sDSAfn' type: 'void *'.
aCCodeGenerator var: 'sHSAfn' type: 'void *'.
aCCodeGenerator var: 'sCCTPfn' type: 'void *'.
aCCodeGenerator var: 'sCCLOPfn' type: 'void *'.
aCCodeGenerator var: 'sCCSOTfn' type: 'void *'.
aCCodeGenerator addHeaderFile: '"SocketPlugin.h"'! !
!Unsigned methodsFor: 'as yet unclassified' stamp: 'ikp 3/31/2005 14:19'!
ccgDeclareCForVar: aSymbolOrString
^'unsigned int ', aSymbolOrString! !
!WordArray class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:19'!
ccgDeclareCForVar: aSymbolOrString
^'usqInt *', aSymbolOrString! !
|
