-
Notifications
You must be signed in to change notification settings - Fork 71
/
DoubleWordArray.extension.st
228 lines (213 loc) · 9.14 KB
/
DoubleWordArray.extension.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
Extension { #name : #DoubleWordArray }
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> byteAt: byteAddress [
"Extract a byte from a DoubleWordArray (little-endian version)"
| lowBits |
lowBits := byteAddress - 1 bitAnd: 7.
^((self at: byteAddress - 1 - lowBits // 8 + 1)
bitShift: lowBits * -8)
bitAnd: 16rFF
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> long64At: byteIndex [
| lowBits wordIndex value high low |
wordIndex := byteIndex - 1 // 8 + 1.
(lowBits := byteIndex - 1 \\ 8) = 0
ifTrue:
[value := self at: wordIndex]
ifFalse:
[high := ((self at: wordIndex + 1) bitAnd: (1 bitShift: (lowBits bitShift: 3)) - 1) bitShift: ((8 - lowBits) bitShift: 3).
low := (self at: wordIndex) bitShift: lowBits * -8.
high = 0 ifTrue:
[^low].
value := high + low].
^(value bitShift: -56) <= 127
ifTrue: [value]
ifFalse: [value - 16r10000000000000000]
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> long64At: byteIndex put: aValue [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits mask allOnes |
wordIndex := byteIndex - 1 // 8 + 1.
((aValue bitShift: -63) between: -1 and: 0) ifFalse:
[self errorImproperStore].
allOnes := 16rFFFFFFFFFFFFFFFF.
(lowBits := byteIndex - 1 bitAnd: 7) = 0 ifTrue:
[^self at: wordIndex put: (aValue >= 0 ifTrue: [aValue] ifFalse: [aValue bitAnd: allOnes])].
mask := allOnes bitShift: ((lowBits-8) bitShift:3).
self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: allOnes - mask)).
self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: allOnes - mask) bitXor: (allOnes bitAnd: ((aValue bitShift: ((lowBits-8) bitShift:3)) bitAnd: mask))).
^aValue
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> longAt: byteIndex [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits word hiWord |
wordIndex := byteIndex - 1 // 8 + 1.
lowBits := byteIndex - 1 bitAnd: 7.
word := (self at: wordIndex) bitShift: lowBits * -8.
lowBits > 4 ifTrue: "access straddles two words"
[hiWord := (self at: wordIndex + 1) bitShift: 8 - lowBits * 8.
word := word + hiWord].
word := word bitAnd: 16rFFFFFFFF.
(word bitShift: -24) > 127 ifTrue:
[word := word - 16r100000000].
^word
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> longAt: byteIndex bigEndian: bigEndian [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits word hiWord |
wordIndex := byteIndex - 1 // 8 + 1.
lowBits := byteIndex - 1 bitAnd: 7.
word := (self at: wordIndex) bitShift: lowBits * -8.
lowBits > 4 ifTrue: "access straddles two words"
[hiWord := (self at: wordIndex + 1) bitShift: 8 - lowBits * 8.
word := word + hiWord].
word := word bitAnd: 16rFFFFFFFF.
bigEndian ifTrue:
[word := ((word bitShift: -24) bitAnd: 16rFF)
+ ((word bitShift: -8) bitAnd: 16rFF00)
+ ((word bitAnd: 16rFF00) bitShift: 8)
+ ((word bitAnd: 16rFF) bitShift: 24)].
(word bitShift: -24) > 127 ifTrue:
[word := word - 16r100000000].
^word
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> longAt: byteIndex put: aValue [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits word allOnes loMask hiMask |
wordIndex := byteIndex - 1 // 8 + 1.
lowBits := byteIndex - 1 bitAnd: 7.
((aValue bitShift: -31) between: -1 and: 0) ifFalse:
[self errorImproperStore].
lowBits <= 4 ifTrue: "access fits in a single word"
[| mask |
mask := 16rFFFFFFFF bitShift: lowBits * 8.
word := self at: wordIndex.
self at: wordIndex put: ((word bitOr: mask) bitXor: (((aValue bitShift: lowBits * 8) bitAnd: mask) bitXor: mask)).
^aValue].
"access straddles two words; make lowMask ones where destination is unchanged to avoid overflow"
allOnes := 16rFFFFFFFFFFFFFFFF.
loMask := allOnes bitShift: 8 - lowBits * -8.
hiMask := 16rFFFFFFFF bitShift: 8 - lowBits * -8.
word := self at: wordIndex.
self at: wordIndex put: ((word bitAnd: loMask) bitOr: ((aValue bitAnd: (16rFFFFFFFF bitShift: (lowBits bitAnd: 3) * -8)) bitShift: lowBits * 8)).
word := self at: wordIndex + 1.
self at: wordIndex + 1 put: ((word bitOr: hiMask) bitXor: ((((aValue bitShift: 4 - (lowBits bitAnd: 3) * -8)) bitAnd: hiMask) bitXor: hiMask)).
^aValue
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedByteAt: byteAddress [
"Extract a byte from a 64-bit word array (little-endian version)"
| lowBits |
lowBits := byteAddress - 1 bitAnd: 7.
^((self at: byteAddress - 1 - lowBits // 8 + 1)
bitShift: lowBits * -8)
bitAnd: 16rFF
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedByteAt: byteAddress put: byte [
"Insert a byte into a 64-bit word (little-endian version)"
| longWord shift lowBits longAddr |
(byte < 0 or: [byte > 255]) ifTrue:[^self errorImproperStore].
lowBits := byteAddress - 1 bitAnd: 7.
longWord := self at: (longAddr := (byteAddress - 1 - lowBits) // 8 + 1).
shift := lowBits * 8.
longWord := longWord
- (longWord bitAnd: (16rFF bitShift: shift))
+ (byte bitShift: shift).
self at: longAddr put: longWord.
^byte
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedLong64At: byteIndex [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits high low |
wordIndex := byteIndex - 1 // 8 + 1.
(lowBits := byteIndex - 1 bitAnd: 7) = 0 ifTrue:
[^self at: wordIndex].
high := ((self at: wordIndex + 1) bitAnd: (1 bitShift: lowBits * 8) - 1) bitShift: 8 - lowBits * 8.
low := (self at: wordIndex) bitShift: lowBits * -8.
^high = 0 ifTrue: [low] ifFalse: [high + low]
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedLong64At: byteIndex put: aValue [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits mask allOnes |
wordIndex := byteIndex - 1 // 8 + 1.
(lowBits := byteIndex - 1 bitAnd: 7) = 0 ifTrue:
[^self at: wordIndex put: aValue].
(aValue bitShift: -64) = 0 ifFalse:
[self errorImproperStore].
mask := (allOnes := 16rFFFFFFFFFFFFFFFF) bitShift: 8 - lowBits * -8.
self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: allOnes - mask)).
self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: allOnes - mask) bitXor: (allOnes bitAnd: ((aValue bitShift: 8 - lowBits * -8) bitAnd: mask))).
^aValue
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedLongAt: byteIndex [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits word hiWord |
wordIndex := byteIndex - 1 // 8 + 1.
lowBits := byteIndex - 1 bitAnd: 7.
word := (self at: wordIndex) bitShift: lowBits * -8.
lowBits > 4 ifTrue: "access straddles two words"
[hiWord := (self at: wordIndex + 1) bitShift: 8 - lowBits * 8.
word := word + hiWord].
^word bitAnd: 16rFFFFFFFF
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedLongAt: byteIndex put: aValue [
"Compatiblity with the ByteArray & Alien methods of the same name."
| wordIndex lowBits word allOnes loMask hiMask |
wordIndex := byteIndex - 1 // 8 + 1.
lowBits := byteIndex - 1 bitAnd: 7.
(aValue bitShift: -32) ~= 0 ifTrue:
[self errorImproperStore].
lowBits <= 4 ifTrue: "access fits in a single word"
[| mask |
mask := 16rFFFFFFFF bitShift: lowBits * 8.
word := self at: wordIndex.
self at: wordIndex put: ((word bitOr: mask) bitXor: (((aValue bitShift: lowBits * 8) bitAnd: mask) bitXor: mask)).
^aValue].
"access straddles two words; make lowMask ones where destination is unchanged to avoid overflow"
allOnes := 16rFFFFFFFFFFFFFFFF.
loMask := allOnes bitShift: 8 - lowBits * -8.
hiMask := 16rFFFFFFFF bitShift: 8 - lowBits * -8.
word := self at: wordIndex.
self at: wordIndex put: ((word bitAnd: loMask) bitOr: ((aValue bitAnd: (16rFFFFFFFF bitShift: (lowBits bitAnd: 3) * -8)) bitShift: lowBits * 8)).
word := self at: wordIndex + 1.
self at: wordIndex + 1 put: ((word bitOr: hiMask) bitXor: ((((aValue bitShift: 4 - (lowBits bitAnd: 3) * -8)) bitAnd: hiMask) bitXor: hiMask)).
^aValue
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedShortAt: byteIndex [
"Compatiblity with the ByteArray & Alien methods of the same name."
| zi word |
zi := byteIndex - 1.
word := self at: zi // 8 + 1.
(zi bitAnd: 1) ~= 0 ifTrue:
[self notYetImplemented]. "i.e. odd access implies implementing straddling two words"
(zi bitAnd: 7) ~= 0 ifTrue:
[word := word bitShift: (zi bitAnd: 7) * -8].
^word bitAnd: 16rFFFF
]
{ #category : #'*VMMaker-JITSimulation' }
DoubleWordArray >> unsignedShortAt: byteAddress put: short [
"Insert a double byte into a 64-bit word (little-endian version)"
| longWord shift lowBits longAddr |
(short < 0 or: [short > 65535]) ifTrue:[^self errorImproperStore].
lowBits := byteAddress - 1 bitAnd: 7.
(lowBits bitAnd: 1) ~= 0 ifTrue:
[self notYetImplemented]. "i.e. odd access implies implementing straddling two words"
longWord := self at: (longAddr := (byteAddress - 1 - lowBits) // 8 + 1).
shift := lowBits * 8.
longWord := longWord
- (longWord bitAnd: (16rFFFF bitShift: shift))
+ (short bitShift: shift).
self at: longAddr put: longWord.
^short
]