-
Notifications
You must be signed in to change notification settings - Fork 68
/
MiscPrimitivePlugin.class.st
380 lines (361 loc) · 15.4 KB
/
MiscPrimitivePlugin.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
"
This plugin pulls together a number of string and array related primitives. In the olden days these primitives were generated as ""translated primitives"", which generated the primitive versions form methods in the image. In 2018 they were rewritten to use conventional Slang.
"
Class {
#name : #MiscPrimitivePlugin,
#superclass : #InterpreterPlugin,
#category : #'VMMaker-Plugins'
}
{ #category : #'helper functions' }
MiscPrimitivePlugin >> encodeBytesOf: anInt in: ba at: i [
"Copy the integer anInt into byteArray ba at index i, and answer the next index"
<inline: #always>
<var: #ba type: #'unsigned char *'>
0 to: 3 do:
[:j | ba at: i + j put: (anInt >> (3 - j * 8) bitAnd: 16rFF)].
^i + 4
]
{ #category : #'helper functions' }
MiscPrimitivePlugin >> encodeInt: anInt in: ba at: i [
"Encode the integer anInt in byteArray ba at index i, and answer the next index.
The encoding is as follows...
0-223 0-223
224-254 (0-30) * 256 + next byte (0-7935)
255 next 4 bytes"
<inline: #always>
<var: #ba declareC: 'unsigned char *ba'>
anInt <= 223 ifTrue: [ba at: i put: anInt. ^i + 1].
anInt <= 7935 ifTrue: [ba at: i put: anInt // 256 + 224. ba at: i + 1 put: anInt \\ 256. ^i + 2].
ba at: i put: 255.
^self encodeBytesOf: anInt in: ba at: i + 1
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveCompareString [
"ByteString (class) compare: string1 with: string2 collated: order"
<export: true>
| len1 len2 order string1 string2 orderOop string1Oop string2Oop |
<var: 'order' type: #'unsigned char *'>
<var: 'string1' type: #'unsigned char *'>
<var: 'string2' type: #'unsigned char *'>
orderOop := interpreterProxy stackValue: 0.
string2Oop := interpreterProxy stackValue: 1.
string1Oop := interpreterProxy stackValue: 2.
((interpreterProxy isBytes: orderOop)
and: [(interpreterProxy isBytes: string2Oop)
and: [interpreterProxy isBytes: string1Oop]]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
order := interpreterProxy firstIndexableField: orderOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: order) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
string1 := interpreterProxy firstIndexableField: string1Oop.
string2 := interpreterProxy firstIndexableField: string2Oop.
len1 := interpreterProxy sizeOfSTArrayFromCPrimitive: string1.
len2 := interpreterProxy sizeOfSTArrayFromCPrimitive: string2.
0 to: (len1 min: len2) - 1 do:
[ :i | | c1 c2 |
c1 := order at: (string1 at: i).
c2 := order at: (string2 at: i).
c1 = c2 ifFalse:
[^interpreterProxy methodReturnInteger: (c1 < c2 ifTrue: [1] ifFalse: [3])]].
interpreterProxy methodReturnInteger:
(len1 = len2 ifTrue: [2] ifFalse: [len1 < len2 ifTrue: [1] ifFalse: [3]])
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveCompressToByteArray [
"Bitmap compress: bm toByteArray: ba"
<export: true>
| bm ba eqBytes i j k lowByte size destSize word |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1)]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 1))
to: #'int *'].
interpreterProxy failed ifTrue: [^nil].
(interpreterProxy isBytes: (interpreterProxy stackValue: 0)) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: (interpreterProxy stackValue: 0)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 0).
size := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
destSize := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
destSize < ((size * 4) + 7 + (size // 1984 * 3)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrUnsupported]. "Size may be OK but we don't know, hence fail with unsupported"
i := self encodeInt: size in: ba at: 0.
k := 0.
[k < size] whileTrue:
[word := bm at: k.
lowByte := word bitAnd: 255.
eqBytes := (word >> 8 bitAnd: 255) = lowByte and: [(word >> 16 bitAnd: 255) = lowByte and: [(word >> 24 bitAnd: 255) = lowByte]].
j := k.
[j + 1 < size and: [word = (bm at: j + 1)]] whileTrue: [j := j + 1].
j > k
ifTrue:
[eqBytes
ifTrue:
[i := self encodeInt: j - k + 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1]
ifFalse:
[i := self encodeInt: j - k + 1 * 4 + 2 in: ba at: i.
i := self encodeBytesOf: word in: ba at: i].
k := j + 1]
ifFalse:
[eqBytes
ifTrue:
[i := self encodeInt: 1 * 4 + 1 in: ba at: i.
ba at: i put: lowByte.
i := i + 1.
k := k + 1]
ifFalse:
[[j + 1 < size and: [(bm at: j) ~= (bm at: j + 1)]] whileTrue: [j := j + 1].
j + 1 = size ifTrue: [j := j + 1].
i := self encodeInt: j - k * 4 + 3 in: ba at: i.
k to: j - 1 by: 1 do: [ :m | i := self encodeBytesOf: (bm at: m) in: ba at: i].
k := j]]].
interpreterProxy methodReturnInteger: i
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveConvert8BitSigned [
"SampledSound (class) convert8bitSignedFrom: aByteArray to16Bit: aSoundBuffer"
<export: true>
| aByteArray aSoundBuffer arraySize byteArrayOop soundBufferOop |
<var: 'aByteArray' type: #'unsigned char *'>
<var: 'aSoundBuffer' type: #'unsigned short *'>
byteArrayOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: byteArrayOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
soundBufferOop := interpreterProxy stackValue: 0.
aSoundBuffer := self
cCode: [interpreterProxy arrayValueOf: soundBufferOop]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: soundBufferOop)
to: #'unsigned short *'].
interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: soundBufferOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
arraySize := interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray.
(interpreterProxy byteSizeOf: soundBufferOop) < (2 * arraySize) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
0 to: arraySize - 1 do:
[ :i | | s |
s := aByteArray at: i.
aSoundBuffer
at: i
put: (s > 127
ifTrue: [s - 256 bitShift: 8]
ifFalse: [s bitShift: 8])].
interpreterProxy methodReturnReceiver
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveDecompressFromByteArray [
"Bitmap decompress: bm fromByteArray: ba at: index"
<export: true>
| bm ba index i anInt code data end k n pastEnd |
<var: 'ba' type: #'unsigned char *'>
<var: 'bm' type: #'int *'>
<var: 'anInt' type: #'unsigned int'>
<var: 'code' type: #'unsigned int'>
<var: 'data' type: #'unsigned int'>
<var: 'n' type: #'unsigned int'>
bm := self cCode: [interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2)]
inSmalltalk: [interpreterProxy
cCoerce: (interpreterProxy arrayValueOf: (interpreterProxy stackValue: 2))
to: #'int *'].
(interpreterProxy isOopImmutable: (interpreterProxy stackValue: 2)) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
(interpreterProxy isBytes: (interpreterProxy stackValue: 1)) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
ba := interpreterProxy firstIndexableField: (interpreterProxy stackValue: 1).
index := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue: [^nil].
i := index - 1.
k := 0.
end := interpreterProxy sizeOfSTArrayFromCPrimitive: ba.
pastEnd := interpreterProxy sizeOfSTArrayFromCPrimitive: bm.
[i < end] whileTrue:
[anInt := ba at: i.
i := i + 1.
anInt <= 223 ifFalse:
[anInt <= 254
ifTrue:
[anInt := anInt - 224 * 256 + (ba at: i).
i := i + 1]
ifFalse:
[anInt := 0.
1 to: 4 by: 1 do:
[ :j | anInt := (anInt bitShift: 8) + (ba at: i).
i := i + 1]]].
n := anInt >> 2.
k + n > pastEnd ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
code := anInt bitAnd: 3.
"code = 0 ifTrue: [nil]."
code = 1 ifTrue:
[data := ba at: i.
i := i + 1.
data := data bitOr: (data bitShift: 8).
data := data bitOr: (data bitShift: 16).
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 2 ifTrue:
[data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
1 to: n do:
[ :j |
bm at: k put: data.
k := k + 1]].
code = 3 ifTrue:
[1 to: n do:
[ :m |
data := 0.
1 to: 4 do:
[ :j |
data := (data bitShift: 8) bitOr: (ba at: i).
i := i + 1].
bm at: k put: data.
k := k + 1]]].
interpreterProxy pop: interpreterProxy methodArgumentCount
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveFindFirstInString [
"ByteString (class) findFirstInString: aString inSet: inclusionMap startingAt: start"
<export: true>
| aString i inclusionMap stringSize aStringOop inclusionMapOop |
<var: 'aString' type: #'unsigned char *'>
<var: 'inclusionMap' type: #'unsigned char *'>
aStringOop := interpreterProxy stackValue: 2.
(interpreterProxy isBytes: aStringOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
inclusionMapOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: inclusionMapOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
i := i - 1. "Convert to 0-based index."
i < 0 ifTrue: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
inclusionMap := interpreterProxy firstIndexableField: inclusionMapOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: inclusionMap) ~= 256 ifTrue:
[^interpreterProxy methodReturnInteger: 0].
aString := interpreterProxy firstIndexableField: aStringOop.
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
[i < stringSize and: [(inclusionMap at: (aString at: i)) = 0]] whileTrue:
[i := i + 1].
interpreterProxy methodReturnInteger: (i >= stringSize ifTrue: [0] ifFalse: [i + 1])
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveFindSubstring [
"ByteString findSubstring: key in: body startingAt: start matchTable: matchTable"
<export: true>
| body key keySize matchTable start bodyOop keyOop matchTableOop |
<var: #key type: #'unsigned char *'>
<var: #body type: #'unsigned char *'>
<var: #matchTable type: #'unsigned char *'>
keyOop := interpreterProxy stackValue: 3.
(interpreterProxy isBytes: keyOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
bodyOop := interpreterProxy stackValue: 2.
(interpreterProxy isBytes: bodyOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
matchTableOop := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: matchTableOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
matchTable := interpreterProxy firstIndexableField: matchTableOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: matchTable) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
key := interpreterProxy firstIndexableField: keyOop.
(keySize := interpreterProxy sizeOfSTArrayFromCPrimitive: key) > 0 ifTrue:
[keySize := keySize - 1. "adjust for zero relative indexes"
start := start - 1 max: 0. "adjust for zero relative indexes"
body := interpreterProxy firstIndexableField: bodyOop.
start to: (interpreterProxy sizeOfSTArrayFromCPrimitive: body) - 1 - keySize do:
[ :startIndex | | index |
index := 0.
[(matchTable at: (body at: startIndex + index)) = (matchTable at: (key at: index))] whileTrue:
[index = keySize ifTrue:
[^interpreterProxy methodReturnInteger: startIndex + 1].
index := index + 1]]].
^interpreterProxy methodReturnInteger: 0
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveIndexOfAsciiInString [
"ByteString indexOfAscii: anInteger inString: aString startingAt: start"
<export: true>
| anInteger aString start stringSize aStringOop |
<var: #aString type: #'unsigned char *'>
anInteger := interpreterProxy stackIntegerValue: 2.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aStringOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: aStringOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start >= 1 ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
aString := interpreterProxy firstIndexableField: aStringOop.
stringSize := interpreterProxy sizeOfSTArrayFromCPrimitive: aString.
start - 1 to: stringSize - 1 do:
[ :pos |
(aString at: pos) = anInteger ifTrue:
[^interpreterProxy methodReturnInteger: pos + 1]].
^interpreterProxy methodReturnInteger: 0
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveStringHash [
"ByteArray (class) hashBytes: aByteArray startingWith: speciesHash"
<export: true>
| aByteArray hash byteArrayOop |
<var: 'aByteArray' type: #'unsigned char *'>
<var: 'hash' type: #'unsigned int'>
hash := interpreterProxy stackIntegerValue: 0.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
byteArrayOop := interpreterProxy stackValue: 1.
(interpreterProxy isBytes: byteArrayOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aByteArray := interpreterProxy firstIndexableField: byteArrayOop.
0 to: (interpreterProxy sizeOfSTArrayFromCPrimitive: aByteArray) - 1 do:
[ :pos |
hash := hash + (aByteArray at: pos) * 16r19660D ].
interpreterProxy methodReturnInteger: (hash bitAnd: 16r0FFFFFFF)
]
{ #category : #primitives }
MiscPrimitivePlugin >> primitiveTranslateStringWithTable [
"ByteString (class) translate: aString from: start to: stop table: table"
<export: true>
| aString start stop table aStringOop tableOop |
<var: #table type: #'unsigned char *'>
<var: #aString type: #'unsigned char *'>
aStringOop := interpreterProxy stackValue: 3.
(interpreterProxy isBytes: aStringOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
(interpreterProxy isOopImmutable: aStringOop) ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoModification].
start := interpreterProxy stackIntegerValue: 2.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
stop := interpreterProxy stackIntegerValue: 1.
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
tableOop := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: tableOop) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
aString := interpreterProxy firstIndexableField: aStringOop.
(start >= 1 and: [stop <= (interpreterProxy sizeOfSTArrayFromCPrimitive: aString)]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
table := interpreterProxy firstIndexableField: tableOop.
(interpreterProxy sizeOfSTArrayFromCPrimitive: table) < 256 ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
start - 1 to: stop - 1 do: [ :i | aString at: i put: (table at: (aString at: i))].
interpreterProxy methodReturnReceiver
]