[Vm-dev] VM Maker: VMMaker.oscog-eem.1488.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Oct 2 19:49:41 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1488.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1488
Author: eem
Time: 2 October 2015, 12:47:53.132 pm
UUID: f4dff9b3-beb7-46b5-8e92-ad9e59b7f402
Ancestors: VMMaker.oscog-cb.1487
Cogit:
Fix bug in Spur machine-code at:put: on 32-bit bits objects; method failed to fail for negative values.
Simplify and correct CogIA32Compiler>>shiftSetsConditionCodesFor:.
Simulator:
Harmonize the [LittleEndian]Bitmap>>[unsigned]Long[64]At:[put:] methods, allowing them all to support unaligned accesses. Add MemoryTests to test these. Update the accessor generation code to use unsignedLong64At:[put:] and update the relevant surrogates. Further, streamline the accessors, eliminating use of >> & << sicne these have an extra activation and since the sign is always determinable via some constant the convenience isn't necessary.
Add code to allow ByteArrays to print themselves in hex in the debugger.
Extend the click step scheme to ask if one wants to halt when making a run-time call, hence kind of supporting step into run-time. But this really needs a trinary choice dialog.
=============== Diff against VMMaker.oscog-cb.1487 ===============
Item was added:
+ ----- Method: Bitmap>>long64At: (in category '*VMMaker-JITSimulation') -----
+ long64At: byteAddress
+ | lowBits hiWord loWord midWord mask wordIndex result signBit |
+ wordIndex := byteAddress - 1 // 4 + 1.
+ (lowBits := byteAddress - 1 \\ 4) = 0 ifTrue:
+ [hiWord := self at: wordIndex.
+ loWord := self at: wordIndex + 1.
+ ^hiWord = 0
+ ifTrue: [loWord]
+ ifFalse: [(hiWord signedIntFromLong bitShift: 32) + loWord]].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
+ hiWord := (self at: wordIndex) bitAnd: mask.
+ midWord := self at: wordIndex + 1.
+ loWord := (self at: wordIndex + 2) bitAnd: mask bitInvert32.
+ result := loWord bitShift: lowBits * -8.
+ midWord ~= 0 ifTrue:
+ [result := result + (midWord bitShift: (4 - lowBits * 8))].
+ hiWord ~= 0 ifTrue:
+ [signBit := 1 << (lowBits * 8 - 1).
+ (signBit anyMask: hiWord) ifTrue:
+ [hiWord := hiWord - signBit - signBit].
+ result := result + (hiWord bitShift: (4 - lowBits + 4 * 8))].
+ ^result!
Item was added:
+ ----- Method: Bitmap>>long64At:put: (in category '*VMMaker-JITSimulation') -----
+ long64At: byteIndex put: aValue
+ | lowBits mask wordIndex |
+ (lowBits := byteIndex - 1 \\ 4) = 0 ifTrue:
+ [self "N.B. Do the access that can fail first, before altering the receiver"
+ longAt: byteIndex put: (aValue bitShift: -32);
+ unsignedLongAt: byteIndex + 4 put: (aValue bitAnd: 16rffffffff).
+ ^aValue].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ wordIndex := byteIndex - 1 // 4 + 1.
+ aValue < 0
+ ifTrue:
+ [(aValue bitShift: -32) < -2147483648 ifTrue:
+ [^self errorImproperStore]]
+ ifFalse:
+ [16r7FFFFFFF < (aValue bitShift: -32) ifTrue:
+ [^self errorImproperStore]].
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
+ self at: wordIndex + 2 put: (((self at: wordIndex + 2) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: mask bitInvert32)).
+ self at: wordIndex + 1 put: ((aValue bitShift: lowBits * -8) bitAnd: 16rFFFFFFFF).
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert32) bitXor: ((aValue bitShift: 4 - lowBits + 4 * -8) bitAnd: mask)).
+ "(wordIndex to: wordIndex + 2) collect: [:i| (self at: i) hex]"
+ ^aValue!
Item was added:
+ ----- Method: Bitmap>>longAt: (in category '*VMMaker-JITSimulation') -----
+ longAt: byteIndex
+ "Default bigEndian access"
+ | lowBits wordIndex value word0 word1 |
+ lowBits := byteIndex - 1 bitAnd: 3.
+ wordIndex := byteIndex - 1 // 4 + 1.
+ lowBits = 0
+ ifTrue:
+ [value := self at: wordIndex]
+ ifFalse:
+ [word0 := self at: wordIndex.
+ word1 := self at: wordIndex + 1.
+ value := 16rFFFFFFFF bitAnd: (word0 bitShift: (lowBits * 8)) + (word1 bitShift: 0 - (4 - lowBits * 8))].
+ (16r80000000 bitAnd: value) ~= 0 ifTrue:
+ [value := (16r7FFFFFFF bitAnd: value) - 16r80000000].
+ ^value!
Item was changed:
----- Method: Bitmap>>longAt:bigEndian: (in category '*VMMaker-JITSimulation') -----
longAt: byteIndex bigEndian: bigEndian
"Compatibility with the ByteArray method of the same name."
| lowBits wordIndex value word0 word1 |
lowBits := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
lowBits = 0
ifTrue:
[value := self at: wordIndex]
ifFalse:
[word0 := self at: wordIndex.
word1 := self at: wordIndex + 1.
+ value := 16rFFFFFFFF bitAnd: (word0 bitShift: (lowBits * 8)) + (word1 bitShift: 4 - lowBits * -8)].
- value := 16rFFFFFFFF bitAnd: word0 << (lowBits * 8) + (word1 >> (4 - lowBits * 8))].
bigEndian ifFalse:
+ [value := ((value bitShift: -24) bitAnd: 16rFF)
+ + ((value bitShift: -8) bitAnd: 16rFF00)
+ + ((value bitAnd: 16rFF00) bitShift: 8)
+ + ((value bitAnd: 16rFF) bitShift: 24)].
- [value := (value >> 24 bitAnd: 16rFF)
- + (value >> 8 bitAnd: 16rFF00)
- + ((value bitAnd: 16rFF00) << 8)
- + ((value bitAnd: 16rFF) << 24)].
(16r80000000 bitAnd: value) ~= 0 ifTrue:
[value := (16r7FFFFFFF bitAnd: value) - 16r80000000].
^value
"| bm ba |
(bm := Bitmap new: 4)
at: 1 put: 16r01234567;
at: 2 put: 16r89ABCDEF;
at: 3 put: 16r89ABCDEF;
at: 4 put: 16r01234567.
ba := bm asByteArray.
(((1 to: 5), (9 to: 13) select:
[:bi| (bm longAt: bi bigEndian: true) ~= (ba longAt: bi bigEndian: true)]) collect:
[:i| { i. (bm longAt: i bigEndian: true) hex. (ba longAt: i bigEndian: true) hex}]),
(((1 to: 5), (9 to: 13) select:
[:bi| (bm longAt: bi bigEndian: false) ~= (ba longAt: bi bigEndian: false)]) collect:
[:i| { i. (bm longAt: i bigEndian: false) hex. (ba longAt: i bigEndian: false) hex}])"!
Item was added:
+ ----- Method: Bitmap>>longAt:put: (in category '*VMMaker-JITSimulation') -----
+ longAt: byteIndex put: aValue
+ "Default bigEndian access"
+ | lowBits wordIndex value mask |
+ wordIndex := byteIndex - 1 // 4 + 1.
+ aValue < 0
+ ifTrue:
+ [aValue < -2147483648 ifTrue:
+ [^self errorImproperStore].
+ value := 16rFFFFFFFF bitAnd: aValue]
+ ifFalse:
+ [16r7FFFFFFF < aValue ifTrue:
+ [^self errorImproperStore].
+ value := aValue].
+ (lowBits := byteIndex - 1 bitAnd: 3) = 0 ifTrue:
+ [self at: wordIndex put: value.
+ ^aValue].
+ mask := 16rFFFFFFFF bitShift: lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: ((value bitShift: lowBits * -8) bitAnd: mask)).
+ self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (16rFFFFFFFF bitAnd: ((value bitShift: (4 - lowBits * 8)) bitAnd: mask bitInvert))).
+ ^aValue!
Item was changed:
----- Method: Bitmap>>longAt:put:bigEndian: (in category '*VMMaker-JITSimulation') -----
longAt: byteIndex put: aValue bigEndian: bigEndian
"Compatibility with the ByteArray method of the same name."
| lowBits wordIndex value mask |
lowBits := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
+ aValue < 0
+ ifTrue:
+ [value := 16rFFFFFFFF bitAnd: aValue.
+ value = 0 ifTrue:
+ [self errorImproperStore]]
+ ifFalse:
+ [16rFFFFFFFF < aValue ifTrue:
+ [self errorImproperStore].
+ value := aValue].
- value := aValue < 0
- ifTrue: [16rFFFFFFFF bitAnd: value]
- ifFalse: [16rFFFFFFFF < aValue ifTrue:
- [self errorImproperStore].
- aValue].
bigEndian ifFalse:
+ [value := ((value bitShift: -24) bitAnd: 16rFF)
+ + ((value bitShift: -8) bitAnd: 16rFF00)
+ + ((value bitAnd: 16rFF00) bitShift: 8)
+ + ((value bitAnd: 16rFF) bitShift: 24)].
- [value := (value >> 24 bitAnd: 16rFF)
- + (value >> 8 bitAnd: 16rFF00)
- + ((value bitAnd: 16rFF00) << 8)
- + ((value bitAnd: 16rFF) << 24)].
lowBits = 0 ifTrue:
[self at: wordIndex put: value.
^aValue].
+ mask := 16rFFFFFFFF bitShift: lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: ((value bitShift: lowBits * -8) bitAnd: mask)).
+ self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (16rFFFFFFFF bitAnd: ((value bitShift: 4 - lowBits * 8) bitAnd: mask bitInvert))).
- mask := 16rFFFFFFFF bitAnd: 16rFFFFFFFF >> (lowBits * 8).
- self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: (value >> (lowBits * 8) bitAnd: mask)).
- self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (16rFFFFFFFF bitAnd: (value << (4 - lowBits * 8) bitAnd: mask bitInvert))).
^aValue
"(1 to: 8) collect:
[:ba| | bm |
bm := Bitmap new: 4.
bm at: 1 put: 16r55555555.
bm at: 2 put: 16rAAAAAAAA.
bm longAt: ba put: 16r04030201 bigEndian: true.
{ (bm at: 1) hex. (bm at: 2) hex }]"
"(1 to: 8) collect:
[:ba| | bm |
bm := Bitmap new: 4.
bm at: 1 put: 16r55555555.
bm at: 2 put: 16rAAAAAAAA.
bm longAt: ba put: 16r01020304 bigEndian: false.
{ (bm at: 1) hex. (bm at: 2) hex }]"!
Item was added:
+ ----- Method: Bitmap>>unsignedLong64At: (in category '*VMMaker-JITSimulation') -----
+ unsignedLong64At: byteAddress
+ "memory is a Bitmap, a 32-bit indexable array of bits"
+ | lowBits hiWord loWord midWord mask wordIndex result |
+ wordIndex := byteAddress - 1 // 4 + 1.
+ (lowBits := byteAddress - 1 \\ 4) = 0 ifTrue:
+ [hiWord := self at: wordIndex.
+ loWord := self at: wordIndex + 1.
+ ^hiWord = 0
+ ifTrue: [loWord]
+ ifFalse: [(hiWord bitShift: 32) + loWord]].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ mask := 16rFFFFFFFF bitShift: (4 - lowBits) * -8.
+ hiWord := (self at: wordIndex) bitAnd: mask.
+ midWord := self at: wordIndex + 1.
+ loWord := (self at: wordIndex + 2) bitAnd: mask bitInvert32.
+ result := loWord bitShift: lowBits * -8.
+ midWord ~= 0 ifTrue:
+ [result := result + (midWord bitShift: (4 - lowBits * 8))].
+ hiWord ~= 0 ifTrue:
+ [result := result + (hiWord bitShift: (4 - lowBits + 4 * 8))].
+ ^result!
Item was added:
+ ----- Method: Bitmap>>unsignedLong64At:put: (in category '*VMMaker-JITSimulation') -----
+ unsignedLong64At: byteIndex put: aValue
+ | lowBits mask wordIndex |
+ (lowBits := byteIndex - 1 \\ 4) = 0 ifTrue:
+ [self "N.B. Do the access that can fail first, before altering the receiver"
+ unsignedLongAt: byteIndex put: (aValue bitShift: -32);
+ unsignedLongAt: byteIndex + 4 put: (aValue bitAnd: 16rffffffff).
+ ^aValue].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ wordIndex := byteIndex - 1 // 4 + 1.
+ (aValue bitShift: -64) ~= 0 ifTrue:
+ [^self errorImproperStore].
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
+ self at: wordIndex + 2 put: (((self at: wordIndex + 2) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: mask bitInvert32)).
+ self at: wordIndex + 1 put: ((aValue bitShift: lowBits * -8) bitAnd: 16rFFFFFFFF).
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert32) bitXor: ((aValue bitShift: 4 - lowBits + 4 * -8) bitAnd: mask)).
+ "(wordIndex to: wordIndex + 2) collect: [:i| (self at: i) hex]"
+ ^aValue!
Item was changed:
----- Method: Bitmap>>unsignedLongAt:bigEndian: (in category '*VMMaker-JITSimulation') -----
unsignedLongAt: byteIndex bigEndian: bigEndian
"Compatiblity with the ByteArray method of the same name."
| lowBits wordIndex value word0 word1 |
lowBits := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
lowBits = 0
ifTrue:
[value := self at: wordIndex]
ifFalse:
[word0 := self at: wordIndex.
word1 := self at: wordIndex + 1.
+ value := 16rFFFFFFFF bitAnd: (word0 bitShift: lowBits * 8) + (word1 bitShift: 4 - lowBits * -8)].
- value := 16rFFFFFFFF bitAnd: word0 << (lowBits * 8) + (word1 >> (4 - lowBits * 8))].
bigEndian ifFalse:
+ [value := ((value bitShift: -24) bitAnd: 16rFF)
+ + ((value bitShift: -8) bitAnd: 16rFF00)
+ + ((value bitAnd: 16rFF00) bitShift: 8)
+ + ((value bitAnd: 16rFF) bitShift: 24)].
- [value := (value >> 24 bitAnd: 16rFF)
- + (value >> 8 bitAnd: 16rFF00)
- + ((value bitAnd: 16rFF00) << 8)
- + ((value bitAnd: 16rFF) << 24)].
^value
"| bm ba |
(bm := Bitmap new: 4)
at: 1 put: 16r01234567;
at: 2 put: 16r89ABCDEF;
at: 3 put: 16r89ABCDEF;
at: 4 put: 16r01234567.
ba := bm asByteArray.
(((1 to: 5), (9 to: 13) select:
[:bi| (bm unsignedLongAt: bi bigEndian: true) ~= (ba unsignedLongAt: bi bigEndian: true)]) collect:
[:i| { i. (bm unsignedLongAt: i bigEndian: true) hex. (ba unsignedLongAt: i bigEndian: true) hex}]),
(((1 to: 5), (9 to: 13) select:
[:bi| (bm unsignedLongAt: bi bigEndian: false) ~= (ba unsignedLongAt: bi bigEndian: false)]) collect:
[:i| { i. (bm unsignedLongAt: i bigEndian: false) hex. (ba unsignedLongAt: i bigEndian: false) hex}])"!
Item was changed:
----- Method: Bitmap>>unsignedLongAt:put: (in category '*VMMaker-JITSimulation') -----
unsignedLongAt: byteIndex put: aValue
"Compatiblity with the ByteArray & Alien methods of the same name."
+ | lowBits mask wordIndex |
+ wordIndex := byteIndex - 1 // 4 + 1.
+ (lowBits := byteIndex - 1 bitAnd: 3) = 0 ifTrue:
+ [^self at: wordIndex put: aValue].
+ mask := 16rFFFFFFFF bitShift: lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: ((aValue bitShift: lowBits * -8) bitAnd: mask)).
+ self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (16rFFFFFFFF bitAnd: ((aValue bitShift: (4 - lowBits * 8)) bitAnd: mask bitInvert))).
+ ^aValue!
- ^(byteIndex - 1 bitAnd: 3) = 0
- ifTrue: [self at: byteIndex - 1 // 4 + 1 put: aValue]
- ifFalse: [self notYetImplemented]!
Item was added:
+ ----- Method: ByteArray>>storeOn:base: (in category '*VMMaker-printing') -----
+ storeOn: aStream base: base
+ aStream nextPutAll: '#['.
+ self
+ do: [:each| each storeOn: aStream base: base]
+ separatedBy: [aStream nextPut: $ ].
+ aStream nextPut: $]!
Item was changed:
----- Method: CogBlockMethodSurrogate64>>padToWord (in category 'accessing') -----
padToWord
+ ^memory unsignedLong64At: address + 5!
- ^memory unsignedLongLongAt: address + 5!
Item was changed:
----- Method: CogBlockMethodSurrogate64>>padToWord: (in category 'accessing') -----
padToWord: aValue
^memory
+ unsignedLong64At: address + 5
- unsignedLongLongAt: address + 5
put: aValue!
Item was changed:
----- Method: CogIA32Compiler>>shiftSetsConditionCodesFor: (in category 'testing') -----
shiftSetsConditionCodesFor: aConditionalJumpOpcode
+ "OF flag only guaranteed to be set for 1-bit shifts. See [1] p 490.
+ Only SF, ZF & PF set according to result. Since the question is currently
+ asked only for Zero and Negative use the following simplification."
+ <inline: true>
+ ^(aConditionalJumpOpcode between: JumpZero and: JumpNonNegative)!
- "OF flag only guaranteed to be set for 1-bit shifts. See [1] p 490"
- ^(opcode = ArithmeticShiftRightCqR or: [opcode = LogicalShiftLeftCqR])
- and: [(operands at: 0) = 1]!
Item was changed:
----- Method: CogMethodSurrogate64>>methodHeader (in category 'accessing') -----
methodHeader
+ ^memory unsignedLong64At: address + 17 + baseHeaderSize!
- ^memory unsignedLongLongAt: address + 17 + baseHeaderSize!
Item was changed:
----- Method: CogMethodSurrogate64>>methodHeader: (in category 'accessing') -----
methodHeader: aValue
^memory
+ unsignedLong64At: address + baseHeaderSize + 17
- unsignedLongLongAt: address + baseHeaderSize + 17
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate64>>methodObject (in category 'accessing') -----
methodObject
+ ^memory unsignedLong64At: address + 9 + baseHeaderSize!
- ^memory unsignedLongLongAt: address + 9 + baseHeaderSize!
Item was changed:
----- Method: CogMethodSurrogate64>>methodObject: (in category 'accessing') -----
methodObject: aValue
^memory
+ unsignedLong64At: address + baseHeaderSize + 9
- unsignedLongLongAt: address + baseHeaderSize + 9
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate64>>selector (in category 'accessing') -----
selector
+ ^memory unsignedLong64At: address + 25 + baseHeaderSize!
- ^memory unsignedLongLongAt: address + 25 + baseHeaderSize!
Item was changed:
----- Method: CogMethodSurrogate64>>selector: (in category 'accessing') -----
selector: aValue
^memory
+ unsignedLong64At: address + baseHeaderSize + 25
- unsignedLongLongAt: address + baseHeaderSize + 25
put: aValue!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAtPut: (in category 'primitive generators') -----
genInnerPrimitiveAtPut: retNoffset
"Implement the guts of primitiveAtPut"
| formatReg jumpImmediate jumpBadIndex
jumpNotIndexablePointers jumpNotIndexableBits
jumpIsContext jumpIsCompiledMethod jumpIsBytes jumpHasFixedFields
jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds
jumpWordsOutOfBounds jumpBytesOutOfBounds jumpBytesOutOfRange
+ jumpNonSmallIntegerValue jumpNegative jumpShortsUnsupported jumpNotPointers
- jumpNonSmallIntegerValue jumpShortsUnsupported jumpNotPointers
|
<inline: true>
"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
<var: #jumpIsBytes type: #'AbstractInstruction *'>
+ <var: #jumpNegative type: #'AbstractInstruction *'>
<var: #jumpBadIndex type: #'AbstractInstruction *'>
<var: #jumpIsContext type: #'AbstractInstruction *'>
<var: #jumpImmediate type: #'AbstractInstruction *'>
<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
<var: #jumpNotIndexableBits type: #'AbstractInstruction *'>
<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpShortsUnsupported type: #'AbstractInstruction *'>
<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpNotIndexablePointers type: #'AbstractInstruction *'>
jumpImmediate := self genJumpImmediate: ReceiverResultReg.
jumpBadIndex := self genJumpNotSmallInteger: Arg0Reg scratchReg: TempReg.
self genConvertSmallIntegerToIntegerInReg: Arg0Reg.
cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
"formatReg := self formatOf: ReceiverResultReg"
self genGetFormatOf: ReceiverResultReg
into: (formatReg := SendNumArgsReg)
leastSignificantHalfOfBaseHeaderIntoScratch: nil.
self genGetNumSlotsOf: ReceiverResultReg into: ClassReg.
"dispatch on format in a combination of highest dynamic frequency order first and convenience.
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 unused, reserved for exotic pointer objects?
7 Forwarded Object, 1st field is pointer, rest of fields are ignored
8 unused, reserved for exotic non-pointer objects?
9 (?) 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
jumpNotPointers := cogit JumpAbove: 0.
"optimistic store check; assume index in range (almost always is)."
self genStoreCheckReceiverReg: ReceiverResultReg
valueReg: Arg1Reg
scratchReg: TempReg
inFrame: false.
cogit CmpCq: objectMemory arrayFormat R: formatReg.
jumpNotIndexablePointers := cogit JumpBelow: 0.
jumpHasFixedFields := cogit JumpNonZero: 0.
cogit CmpR: Arg0Reg R: ClassReg.
jumpArrayOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
cogit RetN: retNoffset.
jumpHasFixedFields jmpTarget: cogit Label.
self genGetClassIndexOfNonImm: ReceiverResultReg into: formatReg.
cogit CmpCq: ClassMethodContextCompactIndex R: formatReg.
jumpIsContext := cogit JumpZero: 0.
"get # fixed fields in formatReg"
cogit PushR: ClassReg.
self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
cogit PopR: ClassReg.
self genConvertSmallIntegerToIntegerInReg: formatReg.
cogit AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg.
cogit SubR: formatReg R: ClassReg.
cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: formatReg.
cogit CmpR: Arg0Reg R: ClassReg.
jumpFixedFieldsOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit AddR: formatReg R: Arg0Reg.
cogit MoveR: Arg1Reg Xwr: Arg0Reg R: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
cogit RetN: retNoffset.
jumpNotPointers jmpTarget:
(cogit CmpCq: objectMemory firstCompiledMethodFormat R: formatReg).
jumpIsCompiledMethod := cogit JumpAboveOrEqual: 0.
jumpNonSmallIntegerValue := self genJumpNotSmallInteger: Arg1Reg scratchReg: TempReg.
cogit CmpCq: objectMemory firstByteFormat R: formatReg.
jumpIsBytes := cogit JumpAboveOrEqual: 0.
cogit CmpCq: objectMemory firstShortFormat R: formatReg.
jumpShortsUnsupported := cogit JumpAboveOrEqual: 0.
cogit CmpCq: objectMemory firstLongFormat R: formatReg.
"For now ignore 64-bit indexability."
jumpNotIndexableBits := cogit JumpBelow: 0.
cogit CmpR: Arg0Reg R: ClassReg.
jumpWordsOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit MoveR: Arg1Reg R: TempReg.
self genConvertSmallIntegerToIntegerInReg: TempReg.
+ (self lastOpcode setsConditionCodesFor: JumpNegative) ifFalse:
+ [self CmpCq: 0 R: ClassReg]. "N.B. FLAGS := ClassReg - 0"
+ jumpNegative := cogit JumpNegative: 0.
cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
cogit MoveR: TempReg Xwr: Arg0Reg R: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
cogit RetN: retNoffset.
jumpIsBytes jmpTarget:
(cogit CmpCq: (objectMemory integerObjectOf: 255) R: Arg1Reg).
jumpBytesOutOfRange := cogit JumpAbove: 0.
cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg.
cogit AndCq: objectMemory wordSize - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
CmpR: Arg0Reg R: ClassReg.
jumpBytesOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit MoveR: Arg1Reg R: TempReg.
self genConvertSmallIntegerToIntegerInReg: TempReg.
cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
cogit MoveR: TempReg Xbr: Arg0Reg R: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
cogit RetN: retNoffset.
"there are no shorts as yet. so this is dead code:
jumpIsShorts jmpTarget:
(cogit CmpCq: (objectMemory integerObjectOf: 65535) R: Arg1Reg).
jumpShortsOutOfRange := cogit JumpAbove: 0.
cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg.
cogit AndCq: 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
CmpR: Arg0Reg R: ClassReg.
jumpShortsOutOfBounds := cogit JumpBelowOrEqual: 0.
cogit MoveR: Arg1Reg R: TempReg.
cogit genConvertSmallIntegerToIntegerInReg: TempReg.
cogit AddR: Arg0Reg R: ReceiverResultReg.
cogit MoveR: TempReg M16: objectMemory baseHeaderSize r: ReceiverResultReg.
cogit MoveR: Arg1Reg R: ReceiverResultReg.
jumpShortsDone := cogit Jump: 0."
jumpIsContext jmpTarget:
+ (jumpNegative jmpTarget:
(jumpNotIndexableBits jmpTarget:
(jumpBytesOutOfRange jmpTarget:
(jumpIsCompiledMethod jmpTarget:
(jumpArrayOutOfBounds jmpTarget:
(jumpBytesOutOfBounds jmpTarget:
(jumpShortsUnsupported jmpTarget:
(jumpWordsOutOfBounds jmpTarget:
(jumpNotIndexablePointers jmpTarget:
(jumpNonSmallIntegerValue jmpTarget:
+ (jumpFixedFieldsOutOfBounds jmpTarget: cogit Label))))))))))).
- (jumpFixedFieldsOutOfBounds jmpTarget: cogit Label)))))))))).
cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
self genConvertIntegerToSmallIntegerInReg: Arg0Reg.
jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label).
^0!
Item was changed:
----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
<doNotGenerate>
| evaluable function result savedFramePointer savedStackPointer savedArgumentCount rpc |
evaluable := simulatedTrampolines at: aProcessorSimulationTrap address.
function := evaluable isBlock
ifTrue: ['aBlock; probably some plugin primitive']
ifFalse:
[evaluable receiver == backEnd ifTrue:
[^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
evaluable selector].
function ~~ #ceBaseFrameReturn: ifTrue:
[coInterpreter assertValidExternalStackPointers].
(function beginsWith: 'ceShort') ifTrue:
[^self perform: function with: aProcessorSimulationTrap].
aProcessorSimulationTrap type = #call
ifTrue:
[processor
simulateCallOf: aProcessorSimulationTrap address
nextpc: aProcessorSimulationTrap nextpc
memory: coInterpreter memory.
self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}]
ifFalse:
[processor
simulateJumpCallOf: aProcessorSimulationTrap address
memory: coInterpreter memory.
self recordInstruction: {'(simulated jump to '. aProcessorSimulationTrap address. '/'. function. ')'}].
savedFramePointer := coInterpreter framePointer.
savedStackPointer := coInterpreter stackPointer.
savedArgumentCount := coInterpreter argumentCount.
result := ["self halt: evaluable selector."
+ ((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
+ [(self confirm: 'skip run-time call?') ifFalse:
+ [self halt]].
evaluable valueWithArguments: (processor
postCallArgumentsNumArgs: evaluable numArgs
in: coInterpreter memory)]
on: ReenterMachineCode
do: [:ex| ex return: ex returnValue].
coInterpreter assertValidExternalStackPointers.
"Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
not called something that has built a frame, such as closure value or evaluate method, or
switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
(function beginsWith: 'primitive') ifTrue:
[coInterpreter checkForLastObjectOverwrite.
coInterpreter primFailCode = 0
ifTrue: [(#( primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
primitiveExecuteMethodArgsArray primitiveExecuteMethod
primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs)
includes: function) ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
= coInterpreter stackPointer]]
ifFalse:
[self assert: savedFramePointer = coInterpreter framePointer.
self assert: savedStackPointer = coInterpreter stackPointer]].
result ~~ #continueNoReturn ifTrue:
[self recordInstruction: {'(simulated return to '. processor retpcIn: coInterpreter memory. ')'}.
rpc := processor retpcIn: coInterpreter memory.
self assert: (rpc >= codeBase and: [rpc < methodZone freeStart]).
processor
smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize;
simulateReturnIn: coInterpreter memory].
self assert: (result isInteger "an oop result"
or: [result == coInterpreter
or: [result == objectMemory
or: [#(nil continue continueNoReturn) includes: result]]]).
processor cResultRegister: (result
ifNil: [0]
ifNotNil: [result isInteger
ifTrue: [result]
ifFalse: [16rF00BA222]])
"coInterpreter cr.
processor sp + 32 to: processor sp - 32 by: -4 do:
[:sp|
sp = processor sp
ifTrue: [coInterpreter print: 'sp->'; tab]
ifFalse: [coInterpreter printHex: sp].
coInterpreter tab; printHex: (coInterpreter longAt: sp); cr]"!
Item was added:
+ ----- Method: Collection>>storeStringBase: (in category '*VMMaker-printing') -----
+ storeStringBase: base
+ "This for bit/byte/word collections."
+ ^String streamContents: [:strm | self storeOn: strm base: base]!
Item was changed:
----- Method: LittleEndianBitmap>>long64At: (in category 'accessing') -----
long64At: byteAddress
+ | lowBits hiWord loWord midWord mask wordIndex result signBit |
+ wordIndex := byteAddress - 1 // 4 + 1.
+ (lowBits := byteAddress - 1 \\ 4) = 0 ifTrue:
+ [loWord := self at: wordIndex.
+ hiWord := self at: wordIndex + 1.
+ ^hiWord = 0
+ ifTrue: [loWord]
+ ifFalse: [(hiWord signedIntFromLong bitShift: 32) + loWord]].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
+ loWord := (self at: wordIndex) bitAnd: mask bitInvert32.
+ midWord := self at: wordIndex + 1.
+ hiWord := (self at: wordIndex + 2) bitAnd: mask.
+ result := loWord bitShift: lowBits * -8.
+ midWord ~= 0 ifTrue:
+ [result := result + (midWord bitShift: (4 - lowBits * 8))].
+ hiWord ~= 0 ifTrue:
+ [signBit := 1 << (lowBits * 8 - 1).
+ (signBit anyMask: hiWord) ifTrue:
+ [hiWord := hiWord - signBit - signBit].
+ result := result + (hiWord bitShift: (4 - lowBits + 4 * 8))].
+ ^result!
- "memory is a Bitmap, a 32-bit indexable array of bits"
- | hiWord loWord |
- byteAddress - 1 \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- loWord := self at: byteAddress - 1 // 4 + 1.
- hiWord := self at: byteAddress - 1 // 4 + 2.
- ^hiWord = 0
- ifTrue: [loWord]
- ifFalse: [(hiWord signedIntFromLong bitShift: 32) + loWord]!
Item was changed:
----- Method: LittleEndianBitmap>>long64At:put: (in category 'accessing') -----
+ long64At: byteIndex put: aValue
+ | lowBits mask wordIndex |
+ (lowBits := byteIndex - 1 \\ 4) = 0 ifTrue:
+ [self "N.B. Do the access that can fail first, before altering the receiver"
+ longAt: byteIndex + 4 put: (aValue bitShift: -32);
+ unsignedLongAt: byteIndex put: (aValue bitAnd: 16rffffffff).
+ ^aValue].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ wordIndex := byteIndex - 1 // 4 + 1.
+ aValue < 0
+ ifTrue:
+ [(aValue bitShift: -32) < -2147483648 ifTrue:
+ [^self errorImproperStore]]
+ ifFalse:
+ [16r7FFFFFFF < (aValue bitShift: -32) ifTrue:
+ [^self errorImproperStore]].
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: mask bitInvert32)).
+ self at: wordIndex + 1 put: ((aValue bitShift: 4 - lowBits * -8) bitAnd: 16rFFFFFFFF).
+ self at: wordIndex + 2 put: (((self at: wordIndex + 2) bitAnd: mask bitInvert32) bitXor: ((aValue bitShift: 4 - lowBits + 4 * -8) bitAnd: mask)).
+ ^aValue!
- long64At: byteAddress put: a64BitValue
- byteAddress - 1 \\ 8 ~= 0 ifTrue: [self unalignedAccessError].
- self
- longAt: byteAddress put: (a64BitValue bitAnd: 16rffffffff);
- longAt: byteAddress + 4 put: a64BitValue >> 32.
- ^a64BitValue!
Item was changed:
----- Method: LittleEndianBitmap>>longAt:bigEndian: (in category 'accessing') -----
longAt: byteIndex bigEndian: bigEndian
"Compatibility with the ByteArray method of the same name."
| lowBits wordIndex value word0 word1 |
lowBits := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
lowBits = 0
ifTrue:
[value := self at: wordIndex]
ifFalse:
[word0 := self at: wordIndex.
word1 := self at: wordIndex + 1.
+ value := 16rFFFFFFFF bitAnd: (word0 bitShift: lowBits * -8) + (word1 bitShift: 4 - lowBits * 8)].
- value := 16rFFFFFFFF bitAnd: word0 >> (lowBits * 8) + (word1 << (4 - lowBits * 8))].
bigEndian ifTrue:
+ [value := ((value bitShift: -24) bitAnd: 16rFF)
+ + ((value bitShift: -8) bitAnd: 16rFF00)
+ + ((value bitAnd: 16rFF00) bitShift: 8)
+ + ((value bitAnd: 16rFF) bitShift: 24)].
- [value := (value >> 24 bitAnd: 16rFF)
- + (value >> 8 bitAnd: 16rFF00)
- + ((value bitAnd: 16rFF00) << 8)
- + ((value bitAnd: 16rFF) << 24)].
(16r80000000 bitAnd: value) ~= 0 ifTrue:
[value := (16r7FFFFFFF bitAnd: value) - 16r80000000].
^value
"| bm ba |
(bm := LittleEndianBitmap new: 4)
at: 1 put: 16r01234567;
at: 2 put: 16r89ABCDEF;
at: 3 put: 16r89ABCDEF;
at: 4 put: 16r01234567.
ba := bm asByteArray.
(((1 to: 5), (9 to: 13) select:
[:bi| (bm longAt: bi bigEndian: true) ~= (ba longAt: bi bigEndian: true)]) collect:
[:i| { i. (bm longAt: i bigEndian: true) hex. (ba longAt: i bigEndian: true) hex}]),
(((1 to: 5), (9 to: 13) select:
[:bi| (bm longAt: bi bigEndian: false) ~= (ba longAt: bi bigEndian: false)]) collect:
[:i| { i. (bm longAt: i bigEndian: false) hex. (ba longAt: i bigEndian: false) hex}])"!
Item was changed:
----- Method: LittleEndianBitmap>>longAt:put: (in category 'accessing') -----
longAt: byteIndex put: aValue
"Compatibility with the ByteArray method of the same name."
+ | lowBits wordIndex mask |
- | lowBits wordIndex value mask |
lowBits := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
+ aValue < 0
+ ifTrue:
+ [aValue < -2147483648 ifTrue:
+ [^self errorImproperStore]]
+ ifFalse:
+ [16r7FFFFFFF < aValue ifTrue:
+ [^self errorImproperStore]].
- value := aValue < 0
- ifTrue: [16rFFFFFFFF bitAnd: aValue]
- ifFalse: [16rFFFFFFFF < aValue ifTrue:
- [self errorImproperStore].
- aValue].
lowBits = 0 ifTrue:
+ [self at: wordIndex put: (16rFFFFFFFF bitAnd: aValue).
- [self at: wordIndex put: value.
^aValue].
+ mask := 16rFFFFFFFF bitShift: lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: mask bitInvert32)).
+ self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask bitInvert32) bitXor: ((aValue bitShift: 4 - lowBits * -8) bitAnd: mask)).
- mask := 16rFFFFFFFF bitAnd: 16rFFFFFFFF << (lowBits * 8).
- self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: (value << (lowBits * 8) bitAnd: mask)).
- self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (value >> (4 - lowBits * 8) bitAnd: mask bitInvert)).
^aValue
"(1 to: 8) collect:
[:ba| | bm |
bm := LittleEndianBitmap new: 4.
bm at: 1 put: 16r55555555.
bm at: 2 put: 16rAAAAAAAA.
bm longAt: ba put: 16r04030201.
{ (bm at: 1) hex. (bm at: 2) hex }]"!
Item was changed:
----- Method: LittleEndianBitmap>>longAt:put:bigEndian: (in category 'accessing') -----
longAt: byteIndex put: aValue bigEndian: bigEndian
"Compatibility with the ByteArray method of the same name."
| lowBits wordIndex value mask |
lowBits := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
value := aValue < 0
ifTrue: [16rFFFFFFFF bitAnd: aValue]
ifFalse: [16rFFFFFFFF < aValue ifTrue:
[self errorImproperStore].
aValue].
bigEndian ifTrue:
+ [value := ((value bitShift: -24) bitAnd: 16rFF)
+ + ((value bitShift: -8) bitAnd: 16rFF00)
+ + ((value bitAnd: 16rFF00) bitShift: 8)
+ + ((value bitAnd: 16rFF) bitShift: 24)].
- [value := (value >> 24 bitAnd: 16rFF)
- + (value >> 8 bitAnd: 16rFF00)
- + ((value bitAnd: 16rFF00) << 8)
- + ((value bitAnd: 16rFF) << 24)].
lowBits = 0 ifTrue:
[self at: wordIndex put: value.
^aValue].
+ mask := 16rFFFFFFFF bitShift: lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((value bitShift: lowBits * 8) bitAnd: mask bitInvert32)).
+ self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask bitInvert32) bitXor: ((value bitShift: 4 - lowBits * -8) bitAnd: mask)).
- mask := 16rFFFFFFFF bitAnd: 16rFFFFFFFF << (lowBits * 8).
- self at: wordIndex put: (((self at: wordIndex) bitAnd: mask bitInvert) bitXor: (value << (lowBits * 8) bitAnd: mask)).
- self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask) bitXor: (value >> (4 - lowBits * 8) bitAnd: mask bitInvert)).
^aValue
"(1 to: 8) collect:
[:ba| | bm |
bm := LittleEndianBitmap new: 4.
bm at: 1 put: 16r55555555.
bm at: 2 put: 16rAAAAAAAA.
bm longAt: ba put: 16r04030201 bigEndian: false.
{ (bm at: 1) hex. (bm at: 2) hex }]"
"(1 to: 8) collect:
[:ba| | bm |
bm := LittleEndianBitmap new: 4.
bm at: 1 put: 16r55555555.
bm at: 2 put: 16rAAAAAAAA.
bm longAt: ba put: 16r01020304 bigEndian: true.
{ (bm at: 1) hex. (bm at: 2) hex }]"!
Item was added:
+ ----- Method: LittleEndianBitmap>>unsignedLong64At: (in category 'accessing') -----
+ unsignedLong64At: byteAddress
+ "memory is a Bitmap, a 32-bit indexable array of bits"
+ | lowBits hiWord loWord midWord mask wordIndex result |
+ wordIndex := byteAddress - 1 // 4 + 1.
+ (lowBits := byteAddress - 1 \\ 4) = 0 ifTrue:
+ [loWord := self at: wordIndex.
+ hiWord := self at: wordIndex + 1.
+ ^hiWord = 0
+ ifTrue: [loWord]
+ ifFalse: [(hiWord bitShift: 32) + loWord]].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
+ loWord := (self at: wordIndex) bitAnd: mask bitInvert32.
+ midWord := self at: wordIndex + 1.
+ hiWord := (self at: wordIndex + 2) bitAnd: mask.
+ result := loWord bitShift: lowBits * -8.
+ midWord ~= 0 ifTrue:
+ [result := result + (midWord bitShift: (4 - lowBits * 8))].
+ hiWord ~= 0 ifTrue:
+ [result := result + (hiWord bitShift: (4 - lowBits + 4 * 8))].
+ ^result!
Item was added:
+ ----- Method: LittleEndianBitmap>>unsignedLong64At:put: (in category 'accessing') -----
+ unsignedLong64At: byteIndex put: aValue
+ | lowBits mask wordIndex |
+ (lowBits := byteIndex - 1 \\ 4) = 0 ifTrue:
+ [self "N.B. Do the access that can fail first, before altering the receiver"
+ unsignedLongAt: byteIndex + 4 put: (aValue bitShift: -32);
+ unsignedLongAt: byteIndex put: (aValue bitAnd: 16rffffffff).
+ ^aValue].
+ "There will always be three accesses; two partial words and a full word in the middle"
+ wordIndex := byteIndex - 1 // 4 + 1.
+ (aValue bitShift: -64) ~= 0 ifTrue:
+ [^self errorImproperStore].
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: lowBits * 8) bitAnd: mask bitInvert32)).
+ self at: wordIndex + 1 put: ((aValue bitShift: 4 - lowBits * -8) bitAnd: 16rFFFFFFFF).
+ self at: wordIndex + 2 put: (((self at: wordIndex + 2) bitAnd: mask bitInvert32) bitXor: ((aValue bitShift: 4 - lowBits + 4 * -8) bitAnd: mask)).
+ ^aValue!
Item was changed:
----- Method: LittleEndianBitmap>>unsignedLongAt:bigEndian: (in category 'accessing') -----
unsignedLongAt: byteIndex bigEndian: bigEndian
"Compatiblity with the ByteArray method of the same name."
| lowBits wordIndex value word0 word1 |
lowBits := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
lowBits = 0
ifTrue:
[value := self at: wordIndex]
ifFalse:
[word0 := self at: wordIndex.
word1 := self at: wordIndex + 1.
+ value := 16rFFFFFFFF bitAnd: (word0 bitShift: lowBits * -8) + (word1 bitShift: 4 - lowBits * 8)].
- value := 16rFFFFFFFF bitAnd: word0 >> (lowBits * 8) + (word1 << (4 - lowBits * 8))].
bigEndian ifTrue:
+ [value := ((value bitShift: -24) bitAnd: 16rFF)
+ + ((value bitShift: -8) bitAnd: 16rFF00)
+ + ((value bitAnd: 16rFF00) bitShift: 8)
+ + ((value bitAnd: 16rFF) bitShift: 24)].
- [value := (value >> 24 bitAnd: 16rFF)
- + (value >> 8 bitAnd: 16rFF00)
- + ((value bitAnd: 16rFF00) << 8)
- + ((value bitAnd: 16rFF) << 24)].
^value
"| bm ba |
(bm := LittleEndianBitmap new: 4)
at: 1 put: 16r01234567;
at: 2 put: 16r89ABCDEF;
at: 3 put: 16r89ABCDEF;
at: 4 put: 16r01234567.
ba := bm asByteArray.
(((1 to: 5), (9 to: 13) select:
[:bi| (bm unsignedLongAt: bi bigEndian: true) ~= (ba unsignedLongAt: bi bigEndian: true)]) collect:
[:i| { i. (bm unsignedLongAt: i bigEndian: true) hex. (ba unsignedLongAt: i bigEndian: true) hex}]),
(((1 to: 5), (9 to: 13) select:
[:bi| (bm unsignedLongAt: bi bigEndian: false) ~= (ba unsignedLongAt: bi bigEndian: false)]) collect:
[:i| { i. (bm unsignedLongAt: i bigEndian: false) hex. (ba unsignedLongAt: i bigEndian: false) hex}])"!
Item was changed:
----- Method: LittleEndianBitmap>>unsignedLongAt:put: (in category 'accessing') -----
unsignedLongAt: byteIndex put: aValue
"Compatiblity with the ByteArray & Alien methods of the same name."
+ | lowBits mask wordIndex |
+ wordIndex := byteIndex - 1 // 4 + 1.
+ (lowBits := byteIndex - 1 bitAnd: 3) = 0 ifTrue:
+ [^self at: wordIndex put: aValue].
+ mask := 16rFFFFFFFF bitShift: lowBits * -8.
+ self at: wordIndex put: (((self at: wordIndex) bitAnd: mask) bitXor: ((aValue bitShift: 4 - lowBits * 8) bitAnd: mask bitInvert32)).
+ self at: wordIndex + 1 put: (((self at: wordIndex + 1) bitAnd: mask bitInvert32) bitXor: (16rFFFFFFFF bitAnd: ((aValue bitShift: lowBits * -8) bitAnd: mask))).
+ ^aValue!
- ^(byteIndex - 1 bitAnd: 3) = 0
- ifTrue: [self at: byteIndex - 1 // 4 + 1 put: aValue]
- ifFalse: [self notYetImplemented]!
Item was added:
+ TestCase subclass: #MemoryTests
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Tests'!
Item was added:
+ ----- Method: MemoryTests class>>defaultIntegerBaseInDebugger (in category 'debugger') -----
+ defaultIntegerBaseInDebugger
+ ^16!
Item was added:
+ ----- Method: MemoryTests>>test64BitBitmapAccessViaByteArray (in category 'testing') -----
+ test64BitBitmapAccessViaByteArray
+ "MemoryTests new test64BitBitmapAccessViaByteArray"
+ "(1 to: bits size) collect: [:i| (bits at: i) hex] #('16r23456700' '16rABCDEF01' '16r89' '16r0')"
+ | bigPositive littlePositive bigNegative littleNegative |
+ ByteArray adoptInstance: ((bigPositive := Bitmap new: 2)
+ at: 1 put: 16r01234567;
+ at: 2 put: 16r89ABCDEF;
+ yourself).
+ ByteArray adoptInstance: ((bigNegative := Bitmap new: 2)
+ at: 1 put: 16rFEDCBA98;
+ at: 2 put: 16r76543210;
+ yourself).
+ ByteArray adoptInstance: ((littlePositive := LittleEndianBitmap new: 2)
+ at: 1 put: 16r89ABCDEF;
+ at: 2 put: 16r01234567;
+ yourself).
+ ByteArray adoptInstance: ((littleNegative := LittleEndianBitmap new: 2)
+ at: 1 put: 16r76543210;
+ at: 2 put: 16rFEDCBA98;
+ yourself).
+ 1 to: 8 do:
+ [:i|
+ (0 to: 7) do: [:j| | bytes bits | "In a true block so that one can restart"
+ "BigEndian is just plain perverse, sigh..."
+ i + j - 1 \\ 4 = 0 ifTrue:
+ [(bytes := ByteArray new: 32)
+ replaceFrom: i + j
+ to: i + j + 7
+ with: bigPositive
+ startingAt: 1.
+ Bitmap adoptInstance: (bits := bytes copy).
+ self assert: 16r0123456789ABCDEF equals: (bits unsignedLong64At: i + j).
+ self assert: 16r0123456789ABCDEF equals: (bits long64At: i + j).
+ (bytes := ByteArray new: 32)
+ replaceFrom: i + j
+ to: i + j + 7
+ with: bigNegative
+ startingAt: 1.
+ Bitmap adoptInstance: (bits := bytes copy).
+ self assert: 16rFEDCBA9876543210 equals: (bits unsignedLong64At: i + j).
+ self assert: (bits long64At: i + j) < 0.
+ self assert: 16rFEDCBA9876543210 equals: ((bits long64At: i + j) bitAnd: 16rFFFFFFFFFFFFFFFF)].
+ (bytes := ByteArray new: 32)
+ replaceFrom: i + j
+ to: i + j + 7
+ with: littlePositive
+ startingAt: 1.
+ LittleEndianBitmap adoptInstance: (bits := bytes copy).
+ self assert: 16r0123456789ABCDEF equals: (bits unsignedLong64At: i + j).
+ self assert: 16r0123456789ABCDEF equals: (bits long64At: i + j).
+ (bytes := ByteArray new: 32)
+ replaceFrom: i + j
+ to: i + j + 7
+ with: littleNegative
+ startingAt: 1.
+ LittleEndianBitmap adoptInstance: (bits := bytes copy).
+ self assert: 16rFEDCBA9876543210 equals: (bits unsignedLong64At: i + j).
+ self assert: (bits long64At: i + j) < 0.
+ self assert: 16rFEDCBA9876543210 equals: ((bits long64At: i + j) bitAnd: 16rFFFFFFFFFFFFFFFF)]]!
Item was added:
+ ----- Method: MemoryTests>>testBitmap32BitLongs (in category 'testing') -----
+ testBitmap32BitLongs
+ "Test that Bitmap provides big-endian access for 32-bit accessors"
+ | memory |
+ memory := Bitmap new: 64.
+ 0 to: 30 do:
+ [:shift|
+ #(-1 1) do:
+ [:initial| | value |
+ value := initial bitShift: shift.
+ memory longAt: 1 put: value.
+ self assert: value equals: (memory longAt: 1).
+ memory
+ longAt: 5 put: 16r00005555;
+ longAt: 9 put: 16r55550000.
+ self assert: 16r55555555 equals: (memory longAt: 7).
+ memory longAt: 7 put: value.
+ self assert: (memory longAt: 7) equals: value.
+ self assert: (memory at: (shift <= 15 = (initial >= 0) ifTrue: [5] ifFalse: [9])) equals: 0]].
+ 31 to: 32 do:
+ [:shift|
+ self should: [memory longAt: 1 put: -1 << shift - 1] raise: Error.
+ self should: [memory longAt: 1 put: 1 << shift] raise: Error].
+ 0 to: 31 do:
+ [:shift| | value |
+ value := 1 bitShift: shift.
+ memory unsignedLongAt: 1 put: value.
+ self assert: value equals: (memory unsignedLongAt: 1).
+ memory
+ longAt: 5 put: 16r00005555;
+ longAt: 9 put: 16r55550000.
+ self assert: 16r55555555 equals: (memory longAt: 7).
+ memory unsignedLongAt: 7 put: value.
+ self assert: value equals: (memory unsignedLongAt: 7).
+ self assert: 0 equals: (memory at: (shift <= 15 ifTrue: [5] ifFalse: [9]))].
+ self should: [memory unsignedLongAt: 1 put: -1] raise: Error.
+ 32 to: 33 do:
+ [:shift|
+ self should: [memory unsignedLongAt: 1 put: 1 << shift] raise: Error]!
Item was added:
+ ----- Method: MemoryTests>>testBitmap64BitLongs (in category 'testing') -----
+ testBitmap64BitLongs
+ "Test that Bitmap provides big-endian access for 64-bit accessors"
+ | memory |
+ memory := Bitmap new: 64.
+ 0 to: 62 do:
+ [:shift|
+ #(-1 1) do:
+ [:initial| | value |
+ memory atAllPut: 0.
+ value := initial bitShift: shift.
+ memory long64At: 1 put: value.
+ self assert: value equals: (memory long64At: 1).
+ memory
+ long64At: 10 put: 16r0000000000555555;
+ long64At: 18 put: 16r5555555555000000.
+ self assert: 16r5555555555555555 equals: (memory long64At: 15).
+ "(1 to: 7) collect: [:i| (memory at: i) hex]"
+ memory long64At: 13 put: value.
+ self assert: value equals: (memory long64At: 13).
+ self assert: 0 equals: (memory at: (shift <= 15 = (initial >= 0) ifTrue: [9] ifFalse: [17])).
+ self assert: 0 equals: (memory at: (shift <= 15 = (initial >= 0) ifTrue: [13] ifFalse: [21]))]].
+ 63 to: 64 do:
+ [:shift|
+ self should: [memory long64At: 1 put: -1 << shift - 1] raise: Error.
+ self should: [memory long64At: 1 put: 1 << shift] raise: Error].
+ 0 to: 63 do:
+ [:shift| | value |
+ value := 1 bitShift: shift.
+ memory unsignedLong64At: 1 put: value.
+ self assert: value equals: (memory unsignedLong64At: 1).
+ memory
+ unsignedLong64At: 10 put: 16r0000000000555555;
+ unsignedLong64At: 18 put: 16r5555555555000000.
+ self assert: 16r5555555555555555 equals: (memory unsignedLong64At: 15).
+ memory unsignedLong64At: 7 put: value.
+ self assert: value equals: (memory unsignedLong64At: 7).
+ self assert: 0 equals: (memory at: (shift <= 31 ifTrue: [9] ifFalse: [17])).
+ self assert: 0 equals: (memory at: (shift <= 31 ifTrue: [13] ifFalse: [21]))].
+ self should: [memory unsignedLong64At: 1 put: -1] raise: Error.
+ 64 to: 65 do:
+ [:shift|
+ self should: [memory unsignedLong64At: 1 put: 1 << shift] raise: Error]!
Item was added:
+ ----- Method: MemoryTests>>testLittleEndianBitmap32BitLongs (in category 'testing') -----
+ testLittleEndianBitmap32BitLongs
+ "Test that LittleEndianBitmap provides little-endian access for 32-bit accessors"
+ | memory |
+ memory := LittleEndianBitmap new: 64.
+ 0 to: 30 do:
+ [:shift|
+ #(-1 1) do:
+ [:initial| | value |
+ value := initial bitShift: shift.
+ memory longAt: 1 put: value.
+ self assert: value equals: (memory longAt: 1).
+ memory
+ longAt: 5 put: 16r55550000;
+ longAt: 9 put: 16r00005555.
+ self assert: 16r55555555 equals: (memory longAt: 7).
+ memory longAt: 7 put: value.
+ self assert: value equals: (memory longAt: 7).
+ self assert: 0 equals: (memory at: (shift <= 15 = (initial >= 0) ifTrue: [9] ifFalse: [5]))]].
+ 31 to: 32 do:
+ [:shift|
+ self should: [memory longAt: 1 put: -1 << shift - 1] raise: Error.
+ self should: [memory longAt: 1 put: 1 << shift] raise: Error].
+ 0 to: 31 do:
+ [:shift| | value |
+ value := 1 bitShift: shift.
+ memory unsignedLongAt: 1 put: value.
+ self assert: value equals: (memory unsignedLongAt: 1).
+ memory
+ longAt: 5 put: 16r55550000;
+ longAt: 9 put: 16r00005555.
+ self assert: 16r55555555 equals: (memory unsignedLongAt: 7).
+ memory unsignedLongAt: 7 put: value.
+ self assert: value equals: (memory unsignedLongAt: 7).
+ self assert: 0 equals: (memory at: (shift <= 15 ifTrue: [9] ifFalse: [5]))].
+ self should: [memory unsignedLongAt: 1 put: -1] raise: Error.
+ 32 to: 33 do:
+ [:shift|
+ self should: [memory unsignedLongAt: 1 put: 1 << shift] raise: Error]!
Item was added:
+ ----- Method: MemoryTests>>testLittleEndianBitmap64BitLongs (in category 'testing') -----
+ testLittleEndianBitmap64BitLongs
+ "Test that Bitmap provides little-endian access for 64-bit accessors"
+ | memory |
+ memory := LittleEndianBitmap new: 64.
+ 0 to: 62 do:
+ [:shift|
+ #(-1 1) do:
+ [:initial| | value |
+ value := initial bitShift: shift.
+ memory long64At: 1 put: value.
+ self assert: value equals: (memory long64At: 1).
+ memory
+ long64At: 10 put: 16r5555550000000000;
+ long64At: 18 put: 16r0000005555555555.
+ self assert: 16r5555555555555555 equals: (memory long64At: 15).
+ "(1 to: 6) collect: [:i| (memory at: i) hex]"
+ memory long64At: 13 put: value.
+ self assert: value equals: (memory long64At: 13).
+ self assert: 0 equals: (memory at: (shift <= 15 = (initial >= 0) ifTrue: [17] ifFalse: [13])).
+ self assert: 0 equals: (memory at: (shift <= 15 = (initial >= 0) ifTrue: [21] ifFalse: [13]))]].
+ 63 to: 64 do:
+ [:shift|
+ self should: [memory long64At: 1 put: -1 << shift - 1] raise: Error.
+ self should: [memory long64At: 1 put: 1 << shift] raise: Error].
+ 0 to: 63 do:
+ [:shift| | value |
+ value := 1 bitShift: shift.
+ memory unsignedLong64At: 1 put: value.
+ self assert: value equals: (memory unsignedLong64At: 1).
+ memory
+ unsignedLong64At: 10 put: 16r5555550000000000;
+ unsignedLong64At: 18 put: 16r0000005555555555.
+ self assert: 16r5555555555555555 equals: (memory unsignedLong64At: 15).
+ memory unsignedLong64At: 7 put: value.
+ self assert: value equals: (memory unsignedLong64At: 7).
+ self assert: 0 equals: (memory at: (shift <= 31 ifTrue: [17] ifFalse: [9])).
+ self assert: 0 equals: (memory at: (shift <= 31 ifTrue: [21] ifFalse: [13]))].
+ self should: [memory unsignedLong64At: 1 put: -1] raise: Error.
+ 64 to: 65 do:
+ [:shift|
+ self should: [memory unsignedLong64At: 1 put: 1 << shift] raise: Error]!
Item was changed:
----- Method: NSSendCacheSurrogate64>>classTag (in category 'accessing') -----
classTag
+ ^memory unsignedLong64At: address + 1!
- ^memory unsignedLongLongAt: address + 1!
Item was changed:
----- Method: NSSendCacheSurrogate64>>classTag: (in category 'accessing') -----
classTag: aValue
^memory
+ unsignedLong64At: address + 1
- unsignedLongLongAt: address + 1
put: aValue!
Item was changed:
----- Method: NSSendCacheSurrogate64>>depth (in category 'accessing') -----
depth
+ ^memory unsignedLong64At: address + 41!
- ^memory unsignedLongLongAt: address + 41!
Item was changed:
----- Method: NSSendCacheSurrogate64>>depth: (in category 'accessing') -----
depth: aValue
^memory
+ unsignedLong64At: address + 41
- unsignedLongLongAt: address + 41
put: aValue!
Item was changed:
----- Method: NSSendCacheSurrogate64>>enclosingObject (in category 'accessing') -----
enclosingObject
+ ^memory unsignedLong64At: address + 9!
- ^memory unsignedLongLongAt: address + 9!
Item was changed:
----- Method: NSSendCacheSurrogate64>>enclosingObject: (in category 'accessing') -----
enclosingObject: aValue
^memory
+ unsignedLong64At: address + 9
- unsignedLongLongAt: address + 9
put: aValue!
Item was changed:
----- Method: NSSendCacheSurrogate64>>numArgs (in category 'accessing') -----
numArgs
+ ^memory unsignedLong64At: address + 33!
- ^memory unsignedLongLongAt: address + 33!
Item was changed:
----- Method: NSSendCacheSurrogate64>>numArgs: (in category 'accessing') -----
numArgs: aValue
^memory
+ unsignedLong64At: address + 33
- unsignedLongLongAt: address + 33
put: aValue!
Item was changed:
----- Method: NSSendCacheSurrogate64>>selector (in category 'accessing') -----
selector
+ ^memory unsignedLong64At: address + 25!
- ^memory unsignedLongLongAt: address + 25!
Item was changed:
----- Method: NSSendCacheSurrogate64>>selector: (in category 'accessing') -----
selector: aValue
^memory
+ unsignedLong64At: address + 25
- unsignedLongLongAt: address + 25
put: aValue!
Item was changed:
----- Method: NSSendCacheSurrogate64>>target (in category 'accessing') -----
target
+ ^memory unsignedLong64At: address + 17!
- ^memory unsignedLongLongAt: address + 17!
Item was changed:
----- Method: NSSendCacheSurrogate64>>target: (in category 'accessing') -----
target: aValue
^memory
+ unsignedLong64At: address + 17
- unsignedLongLongAt: address + 17
put: aValue!
Item was changed:
----- Method: NewspeakCogMethodSurrogate64>>nextMethodOrIRCs (in category 'accessing') -----
nextMethodOrIRCs
+ ^memory unsignedLong64At: address + 33 + baseHeaderSize!
- ^memory long64At: address + 33 + baseHeaderSize!
Item was changed:
----- Method: NewspeakCogMethodSurrogate64>>nextMethodOrIRCs: (in category 'accessing') -----
nextMethodOrIRCs: aValue
^memory
+ unsignedLong64At: address + baseHeaderSize + 33
- long64At: address + baseHeaderSize + 33
put: aValue!
More information about the Vm-dev
mailing list