-
Notifications
You must be signed in to change notification settings - Fork 68
/
VMStructType.class.st
382 lines (334 loc) · 13.3 KB
/
VMStructType.class.st
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
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
"
I am an absract superclass for classes which map to simple structs in C, Right now I merely serve to organize all the struct types. I would like to arrange that generated assignment accessors answer their argument to correspond with field assignment in C, but createInstVarAccessors is implemented by the browser not by ClassDescription.
"
Class {
#name : #VMStructType,
#superclass : #SlangStructType,
#category : #'VMMaker-Support'
}
{ #category : #'accessing class hierarchy' }
VMStructType class >> addSubclass: aSubclass [
self voidStructTypeCache.
^super addSubclass: aSubclass
]
{ #category : #'simulation only' }
VMStructType class >> alignedByteSizeOf: objectSymbolOrClass forClient: aVMClass [
^objectSymbolOrClass byteSizeForSimulator: aVMClass
]
{ #category : #'code generation' }
VMStructType class >> changedAccesorsForSurrogate: surrogateClass bytesPerWord: bytesPerWord [
"Answer the changed accessor methods for the fields of the receiver and the alignedByteSize class method."
"{CogBlockMethod changedAccesorsForSurrogate: CogBlockMethodSurrogate32 bytesPerWord: 4.
CogMethod changedAccesorsForSurrogate: CogMethodSurrogate32 bytesPerWord: 4.
CogBlockMethod changedAccesorsForSurrogate: CogBlockMethodSurrogate64 bytesPerWord: 8.
CogMethod changedAccesorsForSurrogate: CogMethodSurrogate64 bytesPerWord: 8}"
^Dictionary withAll: ((self fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord) associationsSelect:
[:a| a value ~= a key sourceString])
]
{ #category : #'code generation' }
VMStructType class >> checkGenerateSurrogate: surrogateClass bytesPerWord: bytesPerWord [
"Check the accessor methods for the fields of the receiver and if necessary install new
or updated versions in the surrogate class alpng with the alignedByteSize class method."
"CogBlockMethod checkGenerateSurrogate: CogBlockMethodSurrogate32 bytesPerWord: 4.
CogMethod checkGenerateSurrogate: CogMethodSurrogate32 bytesPerWord: 4.
CogBlockMethod checkGenerateSurrogate: CogBlockMethodSurrogate64 bytesPerWord: 8.
CogMethod checkGenerateSurrogate: CogMethodSurrogate64 bytesPerWord: 8"
| accessors oldBytesPerWord |
oldBytesPerWord := VMMakerConfiguration bytesPerWord.
accessors := [self fieldAccessorSourceFor: surrogateClass bytesPerWord: (VMMakerConfiguration bytesPerWord: bytesPerWord)]
ensure: [VMMakerConfiguration bytesPerWord: oldBytesPerWord].
accessors keysAndValuesDo:
[:mr :source|
source ~= mr sourceString ifTrue:
[mr actualClass compile: source classified: #accessing]]
"Dictionary withAll: ((self fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord) associationsSelect:
[:a| a value ~= a key sourceString])"
]
{ #category : #accessing }
VMStructType class >> constantClass [
^ VMClass constantClass
]
{ #category : #'code generation' }
VMStructType class >> fieldAccessorSourceFor: surrogateClass bytesPerWord: bytesPerWord [
"Answer a Dictionary of MethodReference to source for the accessors of the inst vars of the
receiver and the alignedByteSize class method in surrogateClass with the given word size."
"{CogBlockMethod fieldAccessorSourceFor: CogBlockMethodSurrogate32 bytesPerWord: 4.
CogMethod fieldAccessorSourceFor: CogMethodSurrogate32 bytesPerWord: 4.
CogBlockMethod fieldAccessorSourceFor: CogBlockMethodSurrogate64 bytesPerWord: 8.
CogMethod fieldAccessorSourceFor: CogMethodSurrogate64 bytesPerWord: 8}"
| methods bitPosition alignedByteSize currentOffset |
methods := Dictionary new.
bitPosition := 0.
(self fieldAccessorsForBytesPerWord: bytesPerWord) do:
[:spec|
"reset the bitPosition if the offset expression changes."
currentOffset ~= (self offsetForInstVar: spec first) ifTrue:
[bitPosition := 0.
currentOffset := self offsetForInstVar: spec first].
"If the accessor is already defined in a superclass don't redefine it in the subclass.
We assume it is correctly defined in the superclass."
(spec first ~= #unused
and: [(surrogateClass whichClassIncludesSelector: spec first asSymbol)
ifNil: [true]
ifNotNil: [:implementingClass|
self assert: (implementingClass inheritsFrom: Object).
implementingClass == surrogateClass]]) ifTrue:
[methods
at: (MethodReference class: surrogateClass selector: spec first asSymbol)
put: (self getter: spec first
bitPosition: bitPosition
bitWidth: spec second
type: (spec at: 3 ifAbsent: []));
at: (MethodReference class: surrogateClass selector: (spec first, ':') asSymbol)
put: (self setter: spec first
bitPosition: bitPosition
bitWidth: spec second
type: (spec at: 3 ifAbsent: []))].
bitPosition := bitPosition + spec second].
alignedByteSize := (self roundUpBitPosition: bitPosition toWordBoundary: bytesPerWord) / 8.
self assert: alignedByteSize isInteger.
methods
at: (MethodReference class: surrogateClass class selector: #alignedByteSize)
put: #alignedByteSize
, (String with: Character cr with: Character tab with: $^)
, alignedByteSize printString,
(currentOffset ifNil: [''] ifNotNil: [' + self ', currentOffset]).
^methods
]
{ #category : #'code generation' }
VMStructType class >> fieldAccessorsForBytesPerWord: bytesPerWord [
| fieldSpecs |
fieldSpecs := OrderedCollection new.
self instVarTypeDeclarationsDo:
[:ivn :typeTuple| | index replacement |
(index := typeTuple indexOf: #BytesPerWord ifAbsent: 0) > 0
ifTrue:
[(typeTuple at: index + 1) = bytesPerWord ifTrue:
[replacement := typeTuple copyReplaceFrom: index to: index + 1 with: #().
replacement size = 1 ifTrue:
[replacement := replacement first].
fieldSpecs add: { ivn. replacement }]]
ifFalse:
[fieldSpecs add: { ivn. typeTuple }]].
^fieldSpecs collect:
[:tuple|
[:ivn :typeTuple|
{ ('*unused*' match: ivn) ifTrue: [#unused] ifFalse: [ivn].
(typeTuple isArray and: ['unsigned' = typeTuple first])
ifTrue:
[Integer readFrom: (typeTuple last readStream skipTo: $:; skipSeparators)]
ifFalse:
[typeTuple
caseOf: {
[#char] -> [8].
[#'unsigned char'] -> [8].
[#short] -> [16].
[#'unsigned short'] -> [16].
[#int] -> [32].
[#'unsigned int'] -> [32] }
otherwise: [bytesPerWord * 8]].
typeTuple isArray
ifTrue:
[(typeTuple size >= 3 and: [typeTuple second = #Boolean]) ifTrue:
[#Boolean]]
ifFalse:
[typeTuple last = $* ifTrue:
[(typeTuple beginsWith: 'struct _') "remove struct tag if any"
ifTrue: [(typeTuple allButFirst: 8) asSymbol]
ifFalse: [typeTuple]]] }] valueWithArguments: tuple]
"#(4 8) collect: [:bpw| (CogBlockMethod fieldAccessorsForBytesPerWord: bpw) asArray]"
"#(4 8) collect: [:bpw| (CogMethod fieldAccessorsForBytesPerWord: bpw) asArray]"
]
{ #category : #translation }
VMStructType class >> filteredInstVarNames [
"Eliminate the obvious simulation-only inst vars"
^super filteredInstVarNames reject:
[:n|
Cogit isNonArgumentImplicitReceiverVariableName: n]
]
{ #category : #'code generation' }
VMStructType class >> getter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil [
^String streamContents:
[:s| | startByte endByte alignedPowerOf2 shift |
startByte := bitPosition // 8.
endByte := bitPosition + bitWidth - 1 // 8.
shift := bitPosition \\ 8.
alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
s nextPutAll: getter; crtab: 1.
(typeOrNil notNil and: [typeOrNil last = $*]) ifTrue:
[s nextPutAll: '| v |'; crtab: 1].
s nextPut: $^.
typeOrNil ifNotNil:
[s nextPut: $(.
typeOrNil last = $* ifTrue:
[s nextPutAll: 'v := ']].
alignedPowerOf2 ifFalse:
[s nextPut: $(].
shift ~= 0 ifTrue:
[s nextPut: $(].
s nextPutAll: 'memory unsigned';
nextPutAll: (#('Byte' 'Short' 'Long32' 'Long32')
at: endByte - startByte + 1
ifAbsent: ['Long64']);
nextPutAll: 'At: address + '; print: startByte.
(self offsetForInstVar: getter) ifNotNil:
[:offsetExpr| s nextPutAll: ' + '; nextPutAll: offsetExpr].
shift ~= 0 ifTrue:
[s nextPutAll: ') bitShift: -'; print: shift].
alignedPowerOf2 ifFalse:
[s nextPutAll: ') bitAnd: '; nextPutAll: ((1 << bitWidth) - 1) hex].
typeOrNil ifNotNil:
[s nextPutAll: ') ~= 0'.
typeOrNil last = $* ifTrue:
[s nextPutAll: ' ifTrue:';
crtab: 2;
nextPutAll: '[cogit cCoerceSimple: v to: ';
store: typeOrNil;
nextPut: $]]]]
]
{ #category : #translation }
VMStructType class >> implicitReturnTypeFor: aSelector [
"Answer the return type for methods that don't have an explicit return."
^#void
]
{ #category : #accessing }
VMStructType class >> initializationOptions [
^ VMClass initializationOptions
]
{ #category : #translation }
VMStructType class >> instVarNamesAndTypesForTranslationDo: aBinaryBlock [
"enumerate aBinaryBlock with the names and C type strings for the inst vars to include in a struct of this type."
self subclassResponsibility
]
{ #category : #translation }
VMStructType class >> instVarTypeDeclarationsDo: aBinaryBlock [
| instVarNameTypeDeclarations |
instVarNameTypeDeclarations := Dictionary new.
self instVarNamesAndTypesForTranslationDo: [ :ivn :type |
instVarNameTypeDeclarations at: ivn put: type ].
self filteredInstVarNames do: [ :ivn |
| typeDeclaration |
typeDeclaration := instVarNameTypeDeclarations at: ivn ifAbsent: [
TranslationError signal:
'Missing type declaration for instance variable '
, ivn ].
aBinaryBlock value: ivn value: typeDeclaration ]
]
{ #category : #accessing }
VMStructType class >> interpreterClass [
^ VMClass interpreterClass
]
{ #category : #'accessing class hierarchy' }
VMStructType class >> isAbstract [
^self == VMStructType
]
{ #category : #translation }
VMStructType class >> isNonArgumentImplicitReceiverVariableName: aString [
^Cogit isNonArgumentImplicitReceiverVariableName: aString
]
{ #category : #accessing }
VMStructType class >> objectMemoryClass [
^ VMClass objectMemoryClass
]
{ #category : #'code generation' }
VMStructType class >> offsetForInstVar: instVarName [
"Hack to offset accesses to variables by certain values."
^nil
]
{ #category : #'accessing class hierarchy' }
VMStructType class >> removeSubclass: aSubclass [
self voidStructTypeCache.
^super removeSubclass: aSubclass
]
{ #category : #'class name' }
VMStructType class >> rename: aString [
self voidStructTypeCache.
^super rename: aString
]
{ #category : #'code generation' }
VMStructType class >> roundUpBitPosition: bitPosition toWordBoundary: bytesPerWord [
^bitPosition + 7 // 8 + bytesPerWord - 1 // bytesPerWord * bytesPerWord * 8
]
{ #category : #'code generation' }
VMStructType class >> setter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil [
^String streamContents:
[:s| | startByte endByte shift alignedPowerOf2 accessor mask expr |
startByte := bitPosition // 8.
endByte := bitPosition + bitWidth - 1 // 8.
shift := bitPosition \\ 8.
alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
accessor := 'unsigned'
, (#('Byte' 'Short' 'Long32' 'Long32')
at: endByte - startByte + 1
ifAbsent: ['Long64'])
, 'At: address + '.
(self offsetForInstVar: getter) ifNotNil:
[:offsetExpr| accessor := accessor, offsetExpr, ' + '].
mask := #(16rFF 16rFFFF 16rFFFFFFFF 16rFFFFFFFF)
at: endByte - startByte + 1
ifAbsent: [(2 ** 64) - 1].
s nextPutAll: getter; nextPutAll: ': aValue'.
(typeOrNil notNil or: [alignedPowerOf2]) ifFalse:
[s crtab: 1; nextPutAll: 'self assert: (aValue between: 0 and: '; nextPutAll: ((1 << bitWidth) - 1) hex; nextPutAll: ').'].
s crtab: 1.
alignedPowerOf2 ifTrue:
[s nextPut: $^].
s nextPutAll: 'memory';
crtab: 2; nextPutAll: accessor; print: startByte.
s crtab: 2; nextPutAll: 'put: '.
typeOrNil ifNotNil:
[s nextPut: $(].
alignedPowerOf2 ifFalse:
[s nextPutAll: '((memory '; nextPutAll: accessor; print: startByte;
nextPutAll: ') bitAnd: '; nextPutAll: (mask - ((1 << bitWidth - 1) << shift)) hex;
nextPutAll: ') + '].
expr := typeOrNil caseOf: {
[nil] -> ['aValue'].
[#Boolean] -> ['(aValue ifTrue: [1] ifFalse: [0])'] }
otherwise: ['(aValue ifNotNil: [aValue asUnsignedInteger] ifNil: [0])'].
shift = 0
ifTrue:
[s nextPutAll: expr]
ifFalse:
[s nextPut: $(; nextPutAll: expr; nextPutAll: ' bitShift: '; print: shift; nextPut: $)].
typeOrNil notNil ifTrue:
[s nextPut: $)].
alignedPowerOf2 ifFalse:
[s nextPut: $.; crtab: 1; nextPutAll: '^aValue']]
]
{ #category : #accessors }
VMStructType class >> settersReturnValue [
"Override to get the browser to generate setters that return the
value set, which matches C semantics for field assignments."
^true
]
{ #category : #translation }
VMStructType class >> shouldBeGenerated [
^ true
]
{ #category : #accessing }
VMStructType class >> timeStamp [
^ VMClass timeStamp
]
{ #category : #translation }
VMStructType class >> typedef [
^String streamContents: [:s| self printTypedefOn: s]
]
{ #category : #'debug support' }
VMStructType >> logError: aMessage [
<doNotGenerate>
self logError: aMessage withArgs: #()
]
{ #category : #printing }
VMStructType >> printOn: aStream [
"A hook to allow subclasses to print their state if useful."
<doNotGenerate>
super printOn: aStream.
self printStateOn: aStream
]
{ #category : #printing }
VMStructType >> printStateOn: aStream [
"A hook to allow subclasses to print their state if useful."
<doNotGenerate>
^self
]