[Vm-dev] VM Maker: VMMaker.oscog-eem.2286.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Dec 6 19:31:29 UTC 2017
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2286.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2286
Author: eem
Time: 6 December 2017, 11:30:07.090643 am
UUID: 71ca5d81-dc4e-42db-901a-f69e462b6da1
Ancestors: VMMaker.oscog-eem.2285
Simulation on 64-bit Squeak.
Update DoubleWordArray with the low level accessors. Extend MemoryTests to test these accessors in DoubleWordArray. Beef up the tests to test all the classes that support the accessors more thoroughly. Add 64-bit access in Bitmap (which is big endian) as the expected failure.
Have ByteArray use integerAt:[put:]size:signed: for 32 and 64 bit access as these primitives are fast.
Change the oop range in CurrentImageCoInterpreterFacadeFor64BitSpurObjectRepresentation so that it matches code produced by the real JIT on Mac OS X. Fix a bug in the oop<->object mapping (actually its artguably a bug in IdentityDictionary). Add IdentityDictionary>>keyAtNonIdentityValue:ifAbsent: to fix the bug.
Slang generation:
Extract logging to a method and have it include the target directory.
=============== Diff against VMMaker.oscog-eem.2285 ===============
Item was changed:
----- 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: lowBits * -8.
- 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: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.
+ (aValue bitShift: -32) = 0 ifFalse:
+ [^self errorImproperStore].
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!
Item was changed:
----- Method: ByteArray>>long64At: (in category '*VMMaker-accessing') -----
long64At: index
"Answer a 64-bit integer in Smalltalk order (little-endian)."
+ ^self integerAt: index size: 8 signed: true!
- | n1 n2 |
- n1 := self unsignedLongAt: index bigEndian: false.
- n2 := self unsignedLongAt: index+4 bigEndian: false.
- ^(n2 bitShift: 32) + n1!
Item was changed:
----- Method: ByteArray>>long64At:put: (in category '*VMMaker-accessing') -----
+ long64At: index put: value
- long64At: index put: val
"I store 64-bit integers in Smalltalk (little-endian) order."
+ ^self integerAt: index put: value size: 8 signed: true!
- self unsignedLongAt: index put: (val bitAnd: 16rFFFFFFFF) bigEndian: false.
- self unsignedLongAt: index+4 put: (val bitShift: -32) bigEndian: false.
- ^val
- !
Item was changed:
----- Method: ByteArray>>longAt: (in category '*VMMaker-accessing') -----
longAt: byteIndex
+ "Store a 32bit signed integer starting at the given byte offset"
+ ^self integerAt: byteIndex size: 4 signed: true!
- ^self signedLongAt: byteIndex!
Item was changed:
----- Method: ByteArray>>longAt:put: (in category '*VMMaker-accessing') -----
longAt: byteIndex put: aValue
+ "Store a 32bit signed integer starting at the given byte offset"
+ ^self integerAt: byteIndex put: aValue size: 4 signed: true!
- ^self signedLongAt: byteIndex put: aValue!
Item was added:
+ ----- Method: ByteArray>>unsignedLong64At: (in category '*VMMaker-accessing') -----
+ unsignedLong64At: byteOffset
+ "Answer a 64-bit integer in Smalltalk order (little-endian)."
+ ^self integerAt: byteOffset size: 8 signed: false!
Item was added:
+ ----- Method: ByteArray>>unsignedLong64At:put: (in category '*VMMaker-accessing') -----
+ unsignedLong64At: byteOffset put: value
+ "I store 64-bit integers in Smalltalk (little-endian) order."
+ ^self integerAt: byteOffset put: value size: 8 signed: false!
Item was changed:
----- Method: CurrentImageCoInterpreterFacadeFor64BitSpurObjectRepresentation>>objectForOop: (in category 'private-cacheing') -----
objectForOop: anOop
"This is a keyAtValue: search and so needs speeding up either by a reverse map or a simple cache."
^(anOop bitAnd: 7) caseOf: {
[0] -> [anOop = cachedOop
ifTrue: [cachedObject]
+ ifFalse: [cachedObject := objectMap keyAtNonIdentityValue: anOop. "may raise Error"
- ifFalse: [cachedObject := objectMap keyAtValue: anOop. "may raise Error"
cachedOop := anOop. "Don't assign until accessed without error"
cachedObject]].
[1] -> [anOop signedIntFromLong64 >> 3].
[2] -> [Character value: anOop >> 3].
[4] -> [objectMemory smallFloatValueOf: anOop] }!
Item was changed:
----- Method: CurrentImageCoInterpreterFacadeFor64BitSpurObjectRepresentation>>oopForObject: (in category 'object map') -----
oopForObject: o
o isNumber
ifTrue:
[o isInteger
ifTrue:
[(o between: objectMemory minSmallInteger and: objectMemory maxSmallInteger) ifTrue:
[^objectMemory integerObjectOf: o asInteger]]
ifFalse:
[o isFloat ifTrue:
[(objectMemory isSmallFloatValue: o) ifTrue:
+ [^objectMemory smallFloatObjectOf: o]]]]
- [^objectMemory smallFloatValueOf: o]]]]
ifFalse:
[o isCharacter ifTrue:
[^objectMemory characterObjectOf: o asInteger]].
+ ^objectMap at: o ifAbsentPut: [objectMap size * 8 + (1024 * 1024 * 1024 * 4)]!
- ^objectMap at: o ifAbsentPut: [objectMap size * 8 + (1024 * 1024)]!
Item was added:
+ ----- Method: DoubleWordArray class>>defaultIntegerBaseInDebugger (in category '*VMMaker-debugger') -----
+ defaultIntegerBaseInDebugger
+ ^16!
Item was added:
+ ----- Method: DoubleWordArray>>byteAt: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>long64At: (in category '*VMMaker-JITSimulation') -----
+ 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) bitShift: 8 - lowBits * 8.
+ low := (self at: wordIndex) bitShift: lowBits * -8.
+ high = 0 ifTrue:
+ [^low].
+ value := high + low].
+ ^(value bitShift: -56) <= 127
+ ifTrue: [value]
+ ifFalse: [value - 16r10000000000000000]!
Item was added:
+ ----- Method: DoubleWordArray>>long64At:put: (in category '*VMMaker-JITSimulation') -----
+ 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: 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!
Item was added:
+ ----- Method: DoubleWordArray>>longAt: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>longAt:put: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedByteAt: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedByteAt:put: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedLong64At: (in category '*VMMaker-JITSimulation') -----
+ 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) bitShift: 8 - lowBits * 8.
+ low := (self at: wordIndex) bitShift: lowBits * -8.
+ ^high = 0 ifTrue: [low] ifFalse: [high + low]!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedLong64At:put: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedLongAt: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedLongAt:put: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedShortAt: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: DoubleWordArray>>unsignedShortAt:put: (in category '*VMMaker-JITSimulation') -----
+ 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!
Item was added:
+ ----- Method: IdentityDictionary>>keyAtNonIdentityValue: (in category '*VMMaker-accessing') -----
+ keyAtNonIdentityValue: value
+ "Answer the key that is the external name for the argument, value. If
+ there is none, answer the result of evaluating exceptionBlock.
+ Use =, not ==, so strings like 'this' can be found."
+
+ ^self keyAtNonIdentityValue: value ifAbsent: [self errorValueNotFound]!
Item was added:
+ ----- Method: IdentityDictionary>>keyAtNonIdentityValue:ifAbsent: (in category '*VMMaker-accessing') -----
+ keyAtNonIdentityValue: value ifAbsent: exceptionBlock
+ "Answer the key that is the external name for the argument, value. If
+ there is none, answer the result of evaluating exceptionBlock.
+ Use =, not ==, so strings like 'this' can be found."
+
+ self associationsDo:
+ [:association | value = association value ifTrue: [^association key]].
+ ^exceptionBlock value!
Item was changed:
----- Method: LittleEndianBitmap>>asByteArray (in category 'converting') -----
asByteArray
"Faster way to make a byte array from me.
copyFromByteArray: makes equal Bitmap."
| f bytes hack |
+ Smalltalk isLittleEndian ifTrue:
+ [bytes := self shallowCopy.
+ ByteArray adoptInstance: bytes.
+ ^bytes].
f := Form extent: 4 at self size depth: 8 bits: self.
bytes := ByteArray new: self size * 4.
hack := Form new hackBits: bytes.
+ hack swapEndianness.
- SmalltalkImage current isBigEndian ifTrue:[hack swapEndianness].
hack copyBits: f boundingBox
from: f
+ at: 0 at 0
- at: (0 at 0)
clippingBox: hack boundingBox
rule: Form over
fillColor: nil
map: nil.
-
"f displayOn: hack."
+ ^bytes
+ "| v | v := LittleEndianBitmap withAll: (1 to: 4).
+ [v asByteArray] bench '19,700,000 per second. 50.8 nanoseconds per run.'"
+ "| v | v := Bitmap withAll: (1 to: 4).
+ [v asByteArray] bench '977,000 per second. 1.02 microseconds per run.'"!
- ^bytes!
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 := byteIndex - 1 bitAnd: 3.
wordIndex := byteIndex - 1 // 4 + 1.
aValue < 0
ifTrue:
[aValue < -2147483648 ifTrue:
[^self errorImproperStore]]
ifFalse:
[16r7FFFFFFF < aValue ifTrue:
[^self errorImproperStore]].
lowBits = 0 ifTrue:
[self at: wordIndex put: (16rFFFFFFFF bitAnd: aValue).
^aValue].
+ mask := 16rFFFFFFFF bitShift: 4 - lowBits * -8.
- 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)).
^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>>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].
+ (aValue bitShift: -32) = 0 ifFalse:
+ [^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: (((self at: wordIndex + 1) bitAnd: mask bitInvert32) bitXor: (16rFFFFFFFF bitAnd: ((aValue bitShift: 4 - lowBits * -8) bitAnd: mask))).
- 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!
Item was added:
+ ----- Method: MemoryTests>>expectedFailures (in category 'testing') -----
+ expectedFailures
+ "As yet we don't support Spur on any big endian platforms, let alone 64-bit ones."
+ ^#(testBitmap64BitLongs)!
Item was removed:
- ----- 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>>testByteArray16BitShorts (in category 'testing') -----
+ testByteArray16BitShorts
+ "Test that ByteArray provides little-endian access for 16-bit accessors"
+ self testLittleEndianShortAccessFor: ByteArray!
Item was added:
+ ----- Method: MemoryTests>>testByteArray32BitLongs (in category 'testing') -----
+ testByteArray32BitLongs
+ "Test that ByteArray provides big-endian access for 32-bit accessors"
+ self testLittleEndian32BitLongAccessFor: ByteArray!
Item was added:
+ ----- Method: MemoryTests>>testByteArray64BitLongs (in category 'testing') -----
+ testByteArray64BitLongs
+ "Test that ByteArray provides big-endian access for 64-bit accessors"
+ self testLittleEndian64BitLongAccessFor: ByteArray!
Item was added:
+ ----- Method: MemoryTests>>testDoubleWordArray16BitShorts (in category 'testing') -----
+ testDoubleWordArray16BitShorts
+ "Test that DoubleWordArray provides little-endian access for 16-bit accessors"
+ self testLittleEndianShortAccessFor: DoubleWordArray!
Item was added:
+ ----- Method: MemoryTests>>testDoubleWordArray32BitLongs (in category 'testing') -----
+ testDoubleWordArray32BitLongs
+ "Test that DoubleWordArray provides little-endian access for 32-bit accessors"
+ self testLittleEndian32BitLongAccessFor: DoubleWordArray!
Item was added:
+ ----- Method: MemoryTests>>testDoubleWordArray64BitLongs (in category 'testing') -----
+ testDoubleWordArray64BitLongs
+ "Test that DoubleWordArray provides little-endian access for 64-bit accessors"
+ self testLittleEndian64BitLongAccessFor: DoubleWordArray!
Item was added:
+ ----- Method: MemoryTests>>testLittleEndian32BitLongAccessFor: (in category 'test support') -----
+ testLittleEndian32BitLongAccessFor: aClass
+ "Test that ByteArray provides big-endian access for 32-bit accessors"
+ "memory copy changeClassTo: ByteArray"
+ | memory |
+ memory := aClass new: 64 / (aClass new: 0) bytesPerElement.
+ "signed access"
+ 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).
+ "aligned store"
+ 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).
+ "check bytes either side have not been changed"
+ 5 to: 6 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 11 to: 15 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ "unaligned store"
+ memory
+ longAt: 6 put: 16r55550000;
+ longAt: 10 put: 16r00005555.
+ self assert: 16r55555555 equals: (memory longAt: 8).
+ memory longAt: 8 put: value.
+ self assert: value equals: (memory longAt: 8).
+ "check bytes either side have not been changed"
+ 5 to: 7 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 12 to: 15 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)]]].
+ "unsigned access"
+ 0 to: 31 do:
+ [:shift| | value |
+ value := 1 bitShift: shift.
+ memory unsignedLongAt: 1 put: value.
+ self assert: value equals: (memory unsignedLongAt: 1).
+ "aligned store"
+ 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).
+ "check bytes either side have not been changed"
+ 5 to: 6 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 11 to: 15 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ "unaligned store"
+ memory
+ longAt: 6 put: 16r55550000;
+ longAt: 10 put: 16r00005555.
+ self assert: 16r55555555 equals: (memory unsignedLongAt: 8).
+ memory unsignedLongAt: 8 put: value.
+ self assert: value equals: (memory unsignedLongAt: 8).
+ "check bytes either side have not been changed"
+ 5 to: 7 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 12 to: 15 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)]]!
Item was added:
+ ----- Method: MemoryTests>>testLittleEndian64BitLongAccessFor: (in category 'test support') -----
+ testLittleEndian64BitLongAccessFor: aClass
+ "Test that the given class provides little-endian access for 64-bit accessors"
+ "memory copy changeClassTo: ByteArray"
+ | memory |
+ memory := aClass new: 64 / (aClass new: 0) bytesPerElement.
+ "signed access"
+ 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).
+ "aligned store"
+ memory
+ long64At: 9 put: 16r5555550000000000;
+ long64At: 17 put: 16r0000005555555555.
+ self assert: 16r5555555555555555 equals: (memory long64At: 14).
+ memory long64At: 14 put: value.
+ self assert: value equals: (memory long64At: 14).
+ "check bytes either side have not been changed"
+ 9 to: 13 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 22 to: 31 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ "unaligned store"
+ memory
+ long64At: 10 put: 16r5555550000000000;
+ long64At: 18 put: 16r0000005555555555.
+ self assert: 16r5555555555555555 equals: (memory long64At: 15).
+ memory long64At: 15 put: value.
+ self assert: value equals: (memory long64At: 15).
+ "check bytes either side have not been changed"
+ 9 to: 14 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 23 to: 31 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)]]].
+ "unsigned access"
+ 0 to: 63 do:
+ [:shift| | value |
+ value := 1 bitShift: shift.
+ memory unsignedLong64At: 1 put: value.
+ self assert: value equals: (memory unsignedLong64At: 1).
+ "aligned store"
+ memory
+ unsignedLong64At: 9 put: 16r5555550000000000;
+ unsignedLong64At: 17 put: 16r0000005555555555.
+ self assert: 16r5555555555555555 equals: (memory unsignedLong64At: 14).
+ memory unsignedLong64At: 14 put: value.
+ self assert: value equals: (memory unsignedLong64At: 14).
+ "check bytes either side have not been changed"
+ 9 to: 13 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 22 to: 31 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ "unaligned store"
+ memory
+ unsignedLong64At: 10 put: 16r5555550000000000;
+ unsignedLong64At: 18 put: 16r0000005555555555.
+ self assert: 16r5555555555555555 equals: (memory unsignedLong64At: 15).
+ memory unsignedLong64At: 15 put: value.
+ self assert: value equals: (memory unsignedLong64At: 15).
+ "check bytes either side have not been changed"
+ 9 to: 14 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)].
+ 23 to: 31 do:
+ [:i| self assert: 0 equals: (memory byteAt: i)]]!
Item was added:
+ ----- Method: MemoryTests>>testLittleEndianBitmap16BitShorts (in category 'testing') -----
+ testLittleEndianBitmap16BitShorts
+ "Test that LittleEndianBitmap provides little-endian access for 16-bit accessors"
+ self testLittleEndianShortAccessFor: LittleEndianBitmap!
Item was changed:
----- Method: MemoryTests>>testLittleEndianBitmap32BitLongs (in category 'testing') -----
testLittleEndianBitmap32BitLongs
"Test that LittleEndianBitmap provides little-endian access for 32-bit accessors"
+ self testLittleEndian32BitLongAccessFor: LittleEndianBitmap!
- | 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 changed:
----- Method: MemoryTests>>testLittleEndianBitmap64BitLongs (in category 'testing') -----
testLittleEndianBitmap64BitLongs
+ "Test that LittleEndianBitmap provides little-endian access for 64-bit accessors"
+ self testLittleEndian64BitLongAccessFor: LittleEndianBitmap!
- "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 added:
+ ----- Method: MemoryTests>>testLittleEndianShortAccessFor: (in category 'test support') -----
+ testLittleEndianShortAccessFor: aClass
+ | memory |
+ 1 to: 9 by: 2 do:
+ [:i|
+ memory := aClass new: 64 / (aClass new: 0) bytesPerElement.
+ memory unsignedShortAt: i put: 16r7FFF.
+ 1 to: i - 1 do:
+ [:j| self assert: 0 equals: (memory byteAt: j)].
+ self assert: 16rFF equals: (memory byteAt: i).
+ self assert: 16r7F equals: (memory byteAt: i + 1).
+ (i + 2 to: 8) do:
+ [:j| self assert: 0 equals: (memory byteAt: j)]].
+
+ 16 to: 32 do:
+ [:shift|
+ self should: [memory unsignedShortAt: 1 put: -1 << shift - 1] raise: Error.
+ self should: [memory unsignedShortAt: 1 put: 1 << shift] raise: Error].
+ !
Item was added:
+ ----- Method: MemoryTests>>testSignedOutOfRangeAccess (in category 'testing') -----
+ testSignedOutOfRangeAccess
+ {ByteArray. Bitmap. LittleEndianBitmap. DoubleWordArray} do:
+ [:class| | bytesPerElement memory |
+ bytesPerElement := (class new: 0) bytesPerElement.
+ memory := class new: 64 / bytesPerElement.
+ 1 to: 16 do:
+ [:i|
+ self should: [memory byteAt: i put: 1 << 8] raise: Error.
+ self should: [memory byteAt: i put: -1 << 7 - 1] raise: Error.
+ self should: [memory shortAt: i put: 1 << 16] raise: Error.
+ self should: [memory shortAt: i put: -1 << 15 - 1] raise: Error.
+ self should: [memory longAt: i put: 1 << 32] raise: Error.
+ self should: [memory longAt: i put: -1 << 31 - 1] raise: Error.
+ self should: [memory long64At: i put: 1 << 64] raise: Error.
+ self should: [memory long64At: i put: -1 << 63 - 1] raise: Error].
+ 1 to: memory size do:
+ [:i|
+ self assert: 0 equals: (memory at: i)]]!
Item was added:
+ ----- Method: MemoryTests>>testUnsignedOutOfRangeAccess (in category 'testing') -----
+ testUnsignedOutOfRangeAccess
+ {ByteArray. Bitmap. LittleEndianBitmap. DoubleWordArray} do:
+ [:class| | bytesPerElement memory |
+ bytesPerElement := (class new: 0) bytesPerElement.
+ memory := class new: 64 / bytesPerElement.
+ 1 to: 16 do:
+ [:i|
+ self should: [memory unsignedByteAt: i put: 1 << 8] raise: Error.
+ self should: [memory unsignedByteAt: i put: -1] raise: Error.
+ self should: [memory unsignedShortAt: i put: 1 << 16] raise: Error.
+ self should: [memory unsignedShortAt: i put: -1] raise: Error.
+ self should: [memory unsignedLongAt: i put: 1 << 32] raise: Error.
+ self should: [memory unsignedLongAt: i put: -1] raise: Error.
+ self should: [memory unsignedLong64At: i put: 1 << 64] raise: Error.
+ self should: [memory unsignedLong64At: i put: -1] raise: Error].
+ 1 to: memory size do:
+ [:i|
+ self assert: 0 equals: (memory at: i)]]!
Item was changed:
----- Method: Spur64BitCoMemoryManager class>>simulatorClass (in category 'simulation') -----
simulatorClass
+ ^Spur64BitMMLECoSimulatorFor64Bits basicNew memoryClass
+ ifNil: [Spur64BitMMLECoSimulator]
+ ifNotNil: [Spur64BitMMLECoSimulatorFor64Bits]!
- ^Spur64BitMMLECoSimulator!
Item was changed:
----- Method: VMMaker>>generateEntire (in category 'generate sources') -----
generateEntire
"Generate the interp, internal plugins and exports as well as the external plugins.
+ If this comes from a generator method, log it for convenience."
- If this comes from a generator, log it for convenience."
abortBlock := [^self].
+ self logGeneration.
- self configurationGeneratorNameOrNil ifNotNil:
- [:generator|
- logger cr; nextPutAll: (generator selector copyReplaceAll: 'generate' with: '').
- interpreterClassName ifNotNil:
- [logger space; nextPutAll: (CCodeGenerator shortMonticelloDescriptionForClass: (Smalltalk classNamed: interpreterClassName))].
- logger cr; flush].
self generateMainVM.
self generateExternalPlugins!
Item was changed:
----- Method: VMMaker>>generatePlugins (in category 'generate sources') -----
generatePlugins
"Generate the ``external'' plugins.
+ If this comes from a generator method, log it for convenience."
- If this comes from a generator, log it for convenience."
abortBlock := [^self].
+ self logGeneration.
- self configurationGeneratorNameOrNil ifNotNil:
- [:generator|
- logger cr; nextPutAll: (generator selector copyReplaceAll: 'generate' with: '').
- interpreterClassName ifNotNil:
- [logger space; nextPutAll: (CCodeGenerator shortMonticelloDescriptionForClass: (Smalltalk classNamed: interpreterClassName))].
- logger cr; flush].
self generateExternalPlugins!
Item was added:
+ ----- Method: VMMaker>>logGeneration (in category 'generate sources') -----
+ logGeneration
+ self configurationGeneratorNameOrNil ifNotNil:
+ [:generator|
+ logger cr; nextPutAll: (generator selector copyReplaceAll: 'generate' with: '').
+ interpreterClassName ifNotNil:
+ [logger space; nextPutAll: (CCodeGenerator shortMonticelloDescriptionForClass: (Smalltalk classNamed: interpreterClassName))].
+ sourceDirName ifNotNil:
+ [logger nextPutAll: ' to '; nextPutAll: sourceDirName].
+ logger cr; flush]!
More information about the Vm-dev
mailing list