[Vm-dev] VM Maker: VMMaker.oscog-nice.1732.mcz
Eliot Miranda
eliot.miranda at gmail.com
Fri Mar 18 20:40:23 UTC 2016
Hi Nicolas,
On Thu, Mar 17, 2016 at 3:24 PM, <commits at source.squeak.org> wrote:
>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1732.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-nice.1732
> Author: nice
> Time: 17 March 2016, 11:22:07.715 pm
> UUID: ea9dd158-4847-464e-9642-9786252797dc
> Ancestors: VMMaker.oscog-nice.1731
>
> Use little endian accelerators too for fetching 32 & 64 bits large
> integers value (like the ones used for storing value).
>
> Dramatically simplify fetching of signedInteger values by using an
> intermediate unsigned magnitude.
>
> Declare the positive32/64BitIntegerFor: and
> maybeInlinePositive32BitIntegerFor: parameter as unsigned since it is
> interpreted as positive.
>
> Use asUnsignedInteger in isIntegerValue: tests, integerObjectOf: and
> rotatedFloatBitsOf: in order to ban potential UB.
>
> Simplify bit operations using
> positiveMachineIntegerValueOf:/positiveMachineIntegerFor: rather than doing
> 32/64 bits dissertation.
>
> Fetch magnitude of positive large ints into an unsigned for large int bit
> ops.
>
In the following
----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in
category 'primitive support') -----
maybeInlinePositive32BitIntegerFor: integerValue
"N.B. will *not* cause a GC.
integerValue is interpreted as POSITIVE, e.g. as the result of
Bitmap>at:."
<notOption: #Spur64BitMemoryManager>
+ <var: 'integerValue' type: #'unsigned int'>
| newLargeInteger |
self deny: objectMemory hasSixtyFourBitImmediates.
+ integerValue <= objectMemory maxSmallInteger
+ ifTrue: [^ objectMemory integerObjectOf: integerValue].
- (integerValue asInteger >= 0
- and: [objectMemory isIntegerValue: integerValue]) ifTrue:
- [^objectMemory integerObjectOf: integerValue].
shouldn't we compare against minSmallInteger as well, because e.g.
-16r80000000 could overflow SmallInteger and answer 0?
P.S. Lovely seeing this code getting some good loving.
>
> =============== Diff against VMMaker.oscog-nice.1731 ===============
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>magnitude64BitIntegerFor:neg: (in
> category 'primitive support') -----
> magnitude64BitIntegerFor: magnitude neg: isNegative
> "Return a Large Integer object for the given integer magnitude and
> sign"
> | newLargeInteger largeClass highWord sz isSmall smallVal |
> <var: 'magnitude' type: #usqLong>
> <var: 'highWord' type: #usqInt>
>
> isSmall := isNegative
> ifTrue: [magnitude <= (objectMemory
> maxSmallInteger + 1)]
> ifFalse: [magnitude <= objectMemory
> maxSmallInteger].
> isSmall ifTrue:
> [smallVal := self cCoerceSimple: magnitude to: #sqInt.
> isNegative ifTrue: [smallVal := 0 - smallVal].
> ^objectMemory integerObjectOf: smallVal].
>
> largeClass := isNegative
> ifTrue: [objectMemory
> classLargeNegativeInteger]
> ifFalse: [objectMemory
> classLargePositiveInteger].
> objectMemory wordSize = 8
> ifTrue: [sz := 8]
> ifFalse:
> [(highWord := magnitude >> 32) = 0
> ifTrue: [sz := 4]
> ifFalse:
> [sz := 5.
> (highWord := highWord >> 8) = 0
> ifFalse:
> [sz := sz + 1.
> (highWord := highWord >>
> 8) = 0 ifFalse:
> [sz := sz + 1.
> (highWord :=
> highWord >> 8) = 0 ifFalse: [sz := sz + 1]]]]].
> newLargeInteger := objectMemory instantiateClass: largeClass
> indexableSize: sz.
> self cppIf: VMBIGENDIAN
> ifTrue:
> [sz > 4 ifTrue:
> [objectMemory
> storeByte: 7 ofObject:
> newLargeInteger withValue: (magnitude >> 56 bitAnd: 16rFF);
> storeByte: 6 ofObject:
> newLargeInteger withValue: (magnitude >> 48 bitAnd: 16rFF);
> storeByte: 5 ofObject:
> newLargeInteger withValue: (magnitude >> 40 bitAnd: 16rFF);
> storeByte: 4 ofObject:
> newLargeInteger withValue: (magnitude >> 32 bitAnd: 16rFF)].
> objectMemory
> storeByte: 3 ofObject: newLargeInteger
> withValue: (magnitude >> 24 bitAnd: 16rFF);
> storeByte: 2 ofObject: newLargeInteger
> withValue: (magnitude >> 16 bitAnd: 16rFF);
> storeByte: 1 ofObject: newLargeInteger
> withValue: (magnitude >> 8 bitAnd: 16rFF);
> storeByte: 0 ofObject: newLargeInteger
> withValue: (magnitude ">> 0" bitAnd: 16rFF)]
> ifFalse:
> + [sz > 4
> + ifTrue: [objectMemory storeLong64: 0
> ofObject: newLargeInteger withValue: magnitude]
> + ifFalse: [objectMemory storeLong32: 0
> ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk:
> [magnitude bitAnd: 16rFFFFFFFF])]].
> - [sz > 4 ifTrue:
> - [objectMemory storeLong32: 1 ofObject:
> newLargeInteger withValue: magnitude >> 32].
> - objectMemory
> - storeLong32: 0
> - ofObject: newLargeInteger
> - withValue: (self cCode: [magnitude]
> inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])].
>
> ^newLargeInteger!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>magnitude64BitValueOf: (in category
> 'primitive support') -----
> magnitude64BitValueOf: oop
> "Convert the given object into an integer value.
> The object may be either a positive SmallInteger or an eight-byte
> LargeInteger."
> | sz value ok smallIntValue |
> <returnTypeC: #usqLong>
> <var: #value type: #usqLong>
>
> (objectMemory isIntegerObject: oop) ifTrue:
> [smallIntValue := (objectMemory integerValueOf: oop).
> smallIntValue < 0 ifTrue: [smallIntValue := 0 -
> smallIntValue].
> ^self cCoerce: smallIntValue to: #usqLong].
>
> (objectMemory isNonIntegerImmediate: oop) ifTrue:
> [self primitiveFail.
> ^0].
>
> ok := objectMemory isClassOfNonImm: oop
> equalTo: (objectMemory splObj:
> ClassLargePositiveInteger)
> compactClassIndex:
> ClassLargePositiveIntegerCompactIndex.
> ok
> ifFalse:
> [ok := objectMemory isClassOfNonImm: oop
> equalTo:
> (objectMemory splObj: ClassLargeNegativeInteger)
> compactClassIndex:
> ClassLargeNegativeIntegerCompactIndex.
> ok ifFalse:
> [self primitiveFail.
> ^0]].
> sz := objectMemory numBytesOfBytes: oop.
> sz > (self sizeof: #sqLong) ifTrue:
> [self primitiveFail.
> ^0].
>
> + self cppIf: VMBIGENDIAN
> + ifTrue:
> + [value := objectMemory fetchByte: sz - 1 ofObject:
> oop.
> + sz - 2 to: 0 by: -1 do:
> + [:i | value := value << 8 + (objectMemory
> fetchByte: i ofObject: oop)]]
> + ifFalse:
> + [sz > 4
> + ifTrue: [value := self cCoerceSimple:
> (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong]
> + ifFalse: [value := self cCoerceSimple:
> (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].].
> - value := objectMemory fetchByte: sz - 1 ofObject: oop.
> - sz - 2 to: 0 by: -1 do:
> - [:i | value := value << 8 + (objectMemory fetchByte: i
> ofObject: oop)].
> ^value!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>positive64BitValueOf: (in category
> 'primitive support') -----
> positive64BitValueOf: oop
> "Convert the given object into an integer value.
> The object may be either a positive SmallInteger or an eight-byte
> LargePositiveInteger."
>
> <returnTypeC: #usqLong>
> | sz value ok |
> <var: #value type: #usqLong>
> (objectMemory isIntegerObject: oop) ifTrue:
> [(objectMemory integerValueOf: oop) < 0 ifTrue:
> [^self primitiveFail].
> ^objectMemory integerValueOf: oop].
>
> (objectMemory isNonIntegerImmediate: oop) ifTrue:
> [self primitiveFail.
> ^0].
>
> ok := objectMemory
> isClassOfNonImm: oop
> equalTo: (objectMemory splObj:
> ClassLargePositiveInteger)
> compactClassIndex:
> ClassLargePositiveIntegerCompactIndex.
> ok ifFalse:
> [self primitiveFail.
> ^0].
> sz := objectMemory numBytesOfBytes: oop.
> sz > (self sizeof: #sqLong) ifTrue:
> [self primitiveFail.
> ^0].
>
> + self cppIf: VMBIGENDIAN
> + ifTrue:
> + [value := 0.
> + 0 to: sz - 1 do: [:i |
> + value := value + ((self cCoerce:
> (objectMemory fetchByte: i ofObject: oop) to: #usqLong) << (i*8))]]
> + ifFalse:
> + [sz > 4
> + ifTrue: [value := self cCoerceSimple:
> (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong]
> + ifFalse: [value := self cCoerceSimple:
> (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].].
> - value := 0.
> - 0 to: sz - 1 do: [:i |
> - value := value + ((self cCoerce: (objectMemory fetchByte:
> i ofObject: oop) to: #usqLong) << (i*8))].
> ^value!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBitAnd (in category
> 'arithmetic integer primitives') -----
> primitiveBitAnd
> <inline: false>
> + <var: 'integerArgument' type: #usqInt>
> + <var: 'intergerReceiver' type: #usqInt>
> | integerReceiver integerArgument |
> integerArgument := self stackTop.
> integerReceiver := self stackValue: 1.
> "Comment out the short-cut. Either the inline interpreter
> bytecode or the JIT primitive will handle this case.
> ((objectMemory isIntegerObject: integerArgument)
> and: [objectMemory isIntegerObject: integerReceiver])
> ifTrue: [self pop: 2 thenPush: (integerArgument bitAnd:
> integerReceiver)]
> ifFalse:
> + ["
> + integerArgument := self
> positiveMachineIntegerValueOf: integerArgument.
> + integerReceiver := self
> positiveMachineIntegerValueOf: integerReceiver.
> + self successful ifTrue:
> + [self pop: 2 thenPush: (self
> positiveMachineIntegerFor: (integerArgument bitAnd: integerReceiver))]
> - ["objectMemory wordSize = 8
> - ifTrue:
> - [integerArgument := self
> positive64BitValueOf: integerArgument.
> - integerReceiver := self
> positive64BitValueOf: integerReceiver.
> - self successful ifTrue:
> - [self pop: 2 thenPush:
> (self positive64BitIntegerFor: (integerArgument bitAnd: integerReceiver))]]
> ifFalse:
> + []"]"!
> - [integerArgument := self
> positive32BitValueOf: integerArgument.
> - integerReceiver := self
> positive32BitValueOf: integerReceiver.
> - self successful ifTrue:
> - [self pop: 2 thenPush:
> (self positive32BitIntegerFor: (integerArgument bitAnd:
> integerReceiver))]]"]"!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBitAndLargeIntegers (in
> category 'arithmetic largeint primitives') -----
> primitiveBitAndLargeIntegers
> "Primitive logical operations for large integers in 64 bit range"
> | integerRcvr integerArg oopResult |
> <export: true>
> + <var: 'integerRcvr' type: 'usqLong'>
> + <var: 'integerArg' type: 'usqLong'>
> - <var: 'integerRcvr' type: 'sqLong'>
> - <var: 'integerArg' type: 'sqLong'>
>
> integerArg := self positive64BitValueOf: (self stackValue: 0).
> integerRcvr := self positive64BitValueOf: (self stackValue: 1).
> self successful ifFalse:[^nil].
>
> oopResult := self positive64BitIntegerFor: (integerRcvr bitAnd:
> integerArg).
> self successful ifTrue:[self pop: 2 thenPush: oopResult]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBitOr (in category
> 'arithmetic integer primitives') -----
> primitiveBitOr
> <inline: false>
> + <var: 'integerArgument' type: #usqInt>
> + <var: 'intergerReceiver' type: #usqInt>
> | integerReceiver integerArgument |
> integerArgument := self stackTop.
> integerReceiver := self stackValue: 1.
> "Comment out the short-cut. Either the inline interpreter
> bytecode or the JIT primitive will handle this case.
> ((objectMemory isIntegerObject: integerArgument)
> and: [objectMemory isIntegerObject: integerReceiver])
> ifTrue: [self pop: 2 thenPush: (integerArgument bitOr:
> integerReceiver)]
> ifFalse:
> + ["
> + integerArgument := self
> positiveMachineIntegerValueOf: integerArgument.
> + integerReceiver := self
> positiveMachineIntegerValueOf: integerReceiver.
> + self successful ifTrue:
> + [self pop: 2 thenPush: (self
> positiveMachineIntegerFor: (integerArgument bitOr: integerReceiver))]
> - ["objectMemory wordSize = 8
> - ifTrue:
> - [integerArgument := self
> positive64BitValueOf: integerArgument.
> - integerReceiver := self
> positive64BitValueOf: integerReceiver.
> - self successful ifTrue:
> - [self pop: 2 thenPush:
> (self positive64BitIntegerFor: (integerArgument bitOr: integerReceiver))]]
> ifFalse:
> + []"]"!
> - [integerArgument := self
> positive32BitValueOf: integerArgument.
> - integerReceiver := self
> positive32BitValueOf: integerReceiver.
> - self successful ifTrue:
> - [self pop: 2 thenPush:
> (self positive32BitIntegerFor: (integerArgument bitOr:
> integerReceiver))]]"]"!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBitOrLargeIntegers (in
> category 'arithmetic largeint primitives') -----
> primitiveBitOrLargeIntegers
> "Primitive logical operations for large integers in 64 bit range"
> | integerRcvr integerArg oopResult |
> <export: true>
> + <var: 'integerRcvr' type: 'usqLong'>
> + <var: 'integerArg' type: 'usqLong'>
> - <var: 'integerRcvr' type: 'sqLong'>
> - <var: 'integerArg' type: 'sqLong'>
>
> integerArg := self positive64BitValueOf: (self stackValue: 0).
> integerRcvr := self positive64BitValueOf: (self stackValue: 1).
> self successful ifFalse:[^nil].
>
> oopResult := self positive64BitIntegerFor: (integerRcvr bitOr:
> integerArg).
> self successful ifTrue:[self pop: 2 thenPush: oopResult]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBitXor (in category
> 'arithmetic integer primitives') -----
> primitiveBitXor
> <inline: false>
> | integerReceiver integerArgument |
> integerArgument := self stackTop.
> integerReceiver := self stackValue: 1.
> ((objectMemory isIntegerObject: integerArgument)
> and: [objectMemory isIntegerObject: integerReceiver])
> ifTrue: "xoring will leave the tag bits zero, whether the
> tag is 1 or zero, so add it back in."
> [self pop: 2 thenPush: (integerArgument bitXor:
> integerReceiver) + objectMemory smallIntegerTag]
> ifFalse:
> + [integerArgument := self
> positiveMachineIntegerValueOf: integerArgument.
> + integerReceiver := self
> positiveMachineIntegerValueOf: integerReceiver.
> + self successful ifTrue:
> + [self pop: 2 thenPush: (self
> positiveMachineIntegerFor: (integerArgument bitXor: integerReceiver))]]!
> - [objectMemory wordSize = 8
> - ifTrue:
> - [integerArgument := self
> positive64BitValueOf: integerArgument.
> - integerReceiver := self
> positive64BitValueOf: integerReceiver.
> - self successful ifTrue:
> - [self pop: 2 thenPush:
> (self positive64BitIntegerFor: (integerArgument bitXor: integerReceiver))]]
> - ifFalse:
> - [integerArgument := self
> positive32BitValueOf: integerArgument.
> - integerReceiver := self
> positive32BitValueOf: integerReceiver.
> - self successful ifTrue:
> - [self pop: 2 thenPush:
> (self positive32BitIntegerFor: (integerArgument bitXor:
> integerReceiver))]]]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>primitiveBitXorLargeIntegers (in
> category 'arithmetic largeint primitives') -----
> primitiveBitXorLargeIntegers
> "Primitive logical operations for large integers in 64 bit range"
> | integerRcvr integerArg oopResult |
> <export: true>
> + <var: 'integerRcvr' type: 'usqLong'>
> + <var: 'integerArg' type: 'usqLong'>
> - <var: 'integerRcvr' type: 'sqLong'>
> - <var: 'integerArg' type: 'sqLong'>
>
> integerArg := self positive64BitValueOf: (self stackValue: 0).
> integerRcvr := self positive64BitValueOf: (self stackValue: 1).
> self successful ifFalse:[^nil].
>
> oopResult := self positive64BitIntegerFor: (integerRcvr bitXor:
> integerArg).
> self successful ifTrue:[self pop: 2 thenPush: oopResult]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category
> 'primitive support') -----
> signed32BitValueOf: oop
> "Convert the given object into an integer value.
> The object may be either a positive SmallInteger or a four-byte
> LargeInteger."
> + | value negative ok magnitude |
> - | value negative ok |
> <inline: false>
> <returnTypeC: #int>
> <var: #value type: #int>
> + <var: #magnitude type: #'unsigned int'>
> <var: #value64 type: #long>
> (objectMemory isIntegerObject: oop) ifTrue:
> [objectMemory wordSize = 4
> ifTrue:
> [^objectMemory integerValueOf: oop]
> ifFalse: "Must fail for SmallIntegers with
> digitLength > 4"
> [| value64 |
> value64 := objectMemory integerValueOf:
> oop.
> (self cCode: [(self cCoerceSimple:
> value64 to: #int) ~= value64]
> inSmalltalk: [value64 >>
> 31 ~= 0 and: [value64 >> 31 ~= -1]]) ifTrue:
> [self primitiveFail. value64 := 0].
> ^value64]].
>
> (objectMemory isNonIntegerImmediate: oop) ifTrue:
> [self primitiveFail.
> ^0].
>
> ok := objectMemory
> isClassOfNonImm: oop
> equalTo: (objectMemory splObj:
> ClassLargePositiveInteger)
> compactClassIndex:
> ClassLargePositiveIntegerCompactIndex.
> ok
> ifTrue: [negative := false]
> ifFalse:
> [negative := true.
> ok := objectMemory isClassOfNonImm: oop
> equalTo:
> (objectMemory splObj: ClassLargeNegativeInteger)
> compactClassIndex:
> ClassLargeNegativeIntegerCompactIndex.
> ok ifFalse:
> [self primitiveFail.
> ^0]].
> (objectMemory numBytesOfBytes: oop) > 4 ifTrue:
> [^self primitiveFail].
>
> + magnitude := self cppIf: VMBIGENDIAN
> - value := self cppIf: VMBIGENDIAN
> ifTrue:
> [ (objectMemory fetchByte: 0
> ofObject: oop) +
> ((objectMemory fetchByte: 1
> ofObject: oop) << 8) +
> ((objectMemory fetchByte: 2
> ofObject: oop) << 16) +
> ((objectMemory fetchByte: 3
> ofObject: oop) << 24)]
> ifFalse:
> + [(objectMemory fetchLong32: 0
> ofObject: oop) asUnsignedInteger].
> +
> + (negative
> + ifTrue: [magnitude > 16r80000000]
> + ifFalse: [magnitude >= 16r80000000])
> + ifTrue:
> + [self primitiveFail.
> + ^0].
> + negative
> + ifTrue: [value := 0 - magnitude]
> + ifFalse: [value := magnitude].
> + ^value!
> - [objectMemory fetchLong32: 0
> ofObject: oop].
> - self cCode: []
> - inSmalltalk:
> - [(value anyMask: 16r80000000) ifTrue:
> - [value := value - 16r100000000]].
> - "Filter out values out of range for the signed interpretation such
> as
> - 16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative
> w/ bit
> - 32 set). Since the sign is implicit in the class we require that
> the high
> - bit of the magnitude is not set which is a simple test here.
> Note that
> - we have to handle the most negative 32-bit value -2147483648
> specially."
> - value < 0 ifTrue:
> - [self assert: (self sizeof: value) == 4.
> - "Don't fail for -16r80000000/-2147483648
> - Alas the simple (negative and: [value - 1 > 0]) isn't
> adequate since in C the result of signed integer
> - overflow is undefined and hence under optimization this
> may fail. The shift, however, is well-defined."
> - (negative and: [0 = (self cCode: [value << 1]
> -
> inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
> - [^value].
> - self primitiveFail.
> - ^0].
> - ^negative
> - ifTrue: [0 - value]
> - ifFalse: [value]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>signed64BitValueOf: (in category
> 'primitive support') -----
> signed64BitValueOf: oop
> "Convert the given object into an integer value.
> The object may be either a positive SmallInteger or a eight-byte
> LargeInteger."
> + | sz value negative ok magnitude |
> - | sz value negative ok |
> <inline: false>
> <returnTypeC: #sqLong>
> <var: #value type: #sqLong>
> + <var: #magnitude type: #usqLong>
> (objectMemory isIntegerObject: oop) ifTrue:
> [^self cCoerce: (objectMemory integerValueOf: oop) to:
> #sqLong].
>
> (objectMemory isNonIntegerImmediate: oop) ifTrue:
> [self primitiveFail.
> ^0].
>
> ok := objectMemory isClassOfNonImm: oop
> equalTo: (objectMemory splObj:
> ClassLargePositiveInteger)
> compactClassIndex:
> ClassLargePositiveIntegerCompactIndex.
> ok
> ifTrue: [negative := false]
> ifFalse:
> [negative := true.
> ok := objectMemory isClassOfNonImm: oop
> equalTo:
> (objectMemory splObj: ClassLargeNegativeInteger)
> compactClassIndex:
> ClassLargeNegativeIntegerCompactIndex.
> ok ifFalse:
> [self primitiveFail.
> ^0]].
> sz := objectMemory numBytesOfBytes: oop.
> sz > (self sizeof: #sqLong) ifTrue:
> [self primitiveFail.
> ^0].
>
> self cppIf: VMBIGENDIAN
> ifTrue:
> + [magnitude := objectMemory fetchByte: sz - 1
> ofObject: oop.
> - [value := objectMemory fetchByte: sz - 1 ofObject:
> oop.
> sz - 2 to: 0 by: -1 do: [:i |
> + magnitude := magnitude << 8 +
> (objectMemory fetchByte: i ofObject: oop)]]
> - value := value << 8 + (objectMemory
> fetchByte: i ofObject: oop)]]
> ifFalse:
> + [magnitude := sz > 4
> - [value := sz > 4
> ifTrue: [objectMemory
> fetchLong64: 0 ofObject: oop]
> ifFalse: [(objectMemory
> fetchLong32: 0 ofObject: oop) asUnsignedInteger]].
> +
> + (negative
> + ifTrue: [magnitude > 16r8000000000000000]
> + ifFalse: [magnitude >= 16r8000000000000000])
> + ifTrue: [self primitiveFail.
> + ^0].
> + negative
> + ifTrue: [value := 0 - magnitude]
> + ifFalse: [value := magnitude].
> + ^value!
> - "Filter out values out of range for the signed interpretation such
> as
> - 16rFFFFFFFF... (positive w/ bit 64 set) and -16rFFFFFFFF...
> (negative w/ bit
> - 64 set). Since the sign is implicit in the class we require that
> the high bit of
> - the magnitude is not set which is a simple test here. Note that
> we have to
> - handle the most negative 64-bit value -9223372036854775808
> specially."
> - self cCode: []
> - inSmalltalk:
> - [(value anyMask: 16r8000000000000000) ifTrue:
> - [value := value - 16r10000000000000000]].
> - value < 0 ifTrue:
> - [self cCode:
> - [self assert: (self sizeof: value) == 8.
> - self assert: (self sizeof: value << 1) == 8].
> - "Don't fail for -9223372036854775808/-16r8000000000000000.
> - Alas the simple (negative and: [value - 1 > 0]) isn't
> adequate since in C the result of signed integer
> - overflow is undefined and hence under optimization this
> may fail. The shift, however, is well-defined."
> - (negative and: [0 = (self cCode: [value << 1]
> -
> inSmalltalk: [value << 1 bitAnd: (1 << 64) - 1])]) ifTrue:
> - [^value].
> - self primitiveFail.
> - ^0].
> - ^negative
> - ifTrue:[0 - value]
> - ifFalse:[value]!
>
> Item was changed:
> ----- Method: InterpreterPrimitives>>signedMachineIntegerValueOf: (in
> category 'primitive support') -----
> signedMachineIntegerValueOf: oop
> "Answer a signed value of an integer up to the size of a machine
> word.
> The object may be either a positive SmallInteger or a LargeInteger
> of size <= word size."
> <returnTypeC: #'long'>
> + | negative ok bs value limit magnitude |
> - | negative ok bs value bits |
> <var: #value type: #long>
> + <var: #magnitude type: #usqInt>
> + <var: #limit type: #usqInt>
> (objectMemory isIntegerObject: oop) ifTrue:
> [^objectMemory integerValueOf: oop].
>
> (objectMemory isNonIntegerImmediate: oop) ifTrue:
> [^self primitiveFail].
>
> ok := objectMemory isClassOfNonImm: oop
> equalTo: (objectMemory splObj:
> ClassLargePositiveInteger)
> compactClassIndex:
> ClassLargePositiveIntegerCompactIndex.
> ok
> ifTrue: [negative := false]
> ifFalse:
> [negative := true.
> ok := objectMemory isClassOfNonImm: oop
> equalTo:
> (objectMemory splObj: ClassLargeNegativeInteger)
> compactClassIndex:
> ClassLargeNegativeIntegerCompactIndex.
> ok ifFalse: [^self primitiveFail]].
> bs := objectMemory numBytesOf: oop.
> bs > (self sizeof: #'unsigned long') ifTrue:
> [^self primitiveFail].
>
> ((self sizeof: #'unsigned long') = 8
> and: [bs > 4]) ifTrue:
> + [magnitude := self cppIf: VMBIGENDIAN
> - [value := self cppIf: VMBIGENDIAN
> ifTrue:
> [ (objectMemory
> fetchByte: 0 ofObject: oop)
> + ((objectMemory
> fetchByte: 1 ofObject: oop) << 8)
> + ((objectMemory
> fetchByte: 2 ofObject: oop) << 16)
> + ((objectMemory
> fetchByte: 3 ofObject: oop) << 24)
> + ((objectMemory
> fetchByte: 4 ofObject: oop) << 32)
> + ((objectMemory
> fetchByte: 5 ofObject: oop) << 40)
> + ((objectMemory
> fetchByte: 6 ofObject: oop) << 48)
> + ((objectMemory
> fetchByte: 7 ofObject: oop) << 56)]
> ifFalse:
> [objectMemory fetchLong64:
> 0 ofObject: oop]]
> ifFalse:
> + [magnitude := self cppIf: VMBIGENDIAN
> - [value := self cppIf: VMBIGENDIAN
> ifTrue:
> [ (objectMemory
> fetchByte: 0 ofObject: oop)
> + ((objectMemory
> fetchByte: 1 ofObject: oop) << 8)
> + ((objectMemory
> fetchByte: 2 ofObject: oop) << 16)
> + ((objectMemory
> fetchByte: 3 ofObject: oop) << 24)]
> ifFalse:
> [(objectMemory
> fetchLong32: 0 ofObject: oop) asUnsignedInteger]].
> +
> + limit := 1 asUnsignedInteger << ((self sizeof: #usqInt) * 8 - 1).
> + (negative
> + ifTrue: [magnitude > limit]
> + ifFalse: [magnitude >= limit])
> + ifTrue: [self primitiveFail.
> + ^0].
> + negative
> + ifTrue: [value := 0 - magnitude]
> + ifFalse: [value := magnitude].
> + ^value!
> -
> - self cCode: []
> - inSmalltalk:
> - [bits := (self sizeof: #long) * 8.
> - (value bitShift: 1 - bits) > 0 ifTrue:
> - [value := value - (1 bitShift: bits)]].
> - value < 0 ifTrue:
> - ["Don't fail for -16r80000000[00000000].
> - Alas the simple (negative and: [value - 1 > 0]) isn't
> adequate since in C the result of signed integer
> - overflow is undefined and hence under optimization this
> may fail. The shift, however, is well-defined."
> - (negative and: [0 = (self cCode: [value << 1]
> -
> inSmalltalk: [value << 1 bitAnd: (1 << bits) - 1])]) ifTrue:
> - [^value].
> - ^self primitiveFail].
> - ^negative
> - ifTrue: [0 - value]
> - ifFalse: [value]!
>
> Item was changed:
> ----- Method: InterpreterProxy>>positive32BitIntegerFor: (in category
> 'converting') -----
> positive32BitIntegerFor: integerValue
> + <var: 'integerValue' type: #'unsigned int'>
> integerValue isInteger ifFalse:[self error:'Not an Integer
> object'].
> ^integerValue > 0
> ifTrue:[integerValue]
> ifFalse:[ (1 bitShift: 32) + integerValue]!
>
> Item was changed:
> ----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category
> 'converting') -----
> positive64BitIntegerFor: integerValue
> <api>
> <returnTypeC: #sqInt> "...because answering the 64-bit argument
> causes the type inferencer to say this answers 64-bits."
> + <var: 'integerValue' type: #usqLong>
> - <var: 'integerValue' type: #sqLong>
> integerValue isInteger ifFalse:[self error:'Not an Integer
> object'].
> ^integerValue > 0
> ifTrue:[integerValue]
> ifFalse:[ (1 bitShift: 64) + integerValue]!
>
> Item was changed:
> ----- Method: ObjectMemory>>isIntegerValue: (in category 'interpreter
> access') -----
> isIntegerValue: intValue
> "Answer if the given value can be represented as a Smalltalk
> integer value.
> In C, use a shift and XOR to set the sign bit if and only if the
> top two bits of the given
> value are the same, then test the sign bit. Note that the top two
> bits are equal for
> exactly those integers in the range that can be represented in
> 31-bits or 63-bits."
> <api>
> ^self
> + cCode: [(intValue asUnsignedInteger bitXor: (intValue
> asUnsignedInteger << 1)) asInteger >= 0]
> + inSmalltalk: [intValue >= self minSmallInteger and:
> [intValue <= self maxSmallInteger]]!
> - cCode: [(intValue bitXor: (intValue << 1)) asInteger >= 0]
> - inSmalltalk: [intValue >= 16r-40000000 and: [intValue <=
> 16r3FFFFFFF]]!
>
> Item was changed:
> ----- Method: Spur32BitMemoryManager>>isIntegerValue: (in category
> 'interpreter access') -----
> isIntegerValue: intValue
> "Answer if the given value can be represented as a Smalltalk
> integer value.
> In C, use a shift and XOR to set the sign bit if and only if the
> top two bits of the given
> value are the same, then test the sign bit. Note that the top two
> bits are equal for
> exactly those integers in the range that can be represented in
> 31-bits or 63-bits."
> <api>
> ^self
> + cCode: [(intValue asUnsignedInteger bitXor: (intValue
> asUnsignedInteger << 1)) asInteger >= 0]
> + inSmalltalk: [intValue >= self minSmallInteger and:
> [intValue <= self maxSmallInteger]]!
> - cCode: [(intValue bitXor: (intValue << 1)) asInteger >= 0]
> - inSmalltalk: [intValue >= 16r-40000000 and: [intValue <=
> 16r3FFFFFFF]]!
>
> Item was changed:
> ----- Method: Spur64BitMemoryManager>>integerObjectOf: (in category
> 'immediates') -----
> integerObjectOf: value
> "Convert the integer value, assumed to be in SmallInteger range,
> into a tagged SmallInteger object.
> In C, use a shift and an add to set the tag bit.
> In Smalltalk we have to work harder because the simulator works
> with strictly positive bit patterns."
> <returnTypeC: #sqInt>
> ^self
> + cCode: [value asUnsignedInteger << self numTagBits + 1]
> - cCode: [value << self numTagBits + 1]
> inSmalltalk: [value << self numTagBits
> + (value >= 0
> ifTrue: [1]
> ifFalse:
> [16r10000000000000001])]!
>
> Item was changed:
> ----- Method: Spur64BitMemoryManager>>isIntegerValue: (in category
> 'interpreter access') -----
> isIntegerValue: intValue
> "Answer if the given value can be represented as a Smalltalk
> integer value.
> In 64-bits we use a 3 bit tag which leaves 61 bits for 2's
> complement signed
> integers. In C, use a shift add and mask to test if the top 4
> bits are all the same.
> Since 16rFFFFFFFFFFFFFFFF >> 60 = 16rF the computation intValue
> >> 60 + 1 bitAnd: 16rF
> maps in-range -ve values to 0 and in-range +ve values to 1."
> <api>
> ^self
> cCode: [(intValue >> 60 + 1 bitAnd: 16rF) <= 1] "N.B.
> (16rFFFFFFFFFFFFFFFF >> 60) + 1 = 16"
> + inSmalltalk: [intValue >= self minSmallInteger and:
> [intValue <= self maxSmallInteger]]!
> - inSmalltalk: [intValue >= -16r1000000000000000 and:
> [intValue <= 16rFFFFFFFFFFFFFFF]]!
>
> Item was changed:
> ----- Method: Spur64BitMemoryManager>>rotatedFloatBitsOf: (in category
> 'interpreter access') -----
> rotatedFloatBitsOf: oop
> "Answer the signed, but unadjusted value of a SmallFloat64,
> suitable for use as a hash.
> Keeping the exponent unadjusted keeps the value in the
> SmallInteger range.
> See section 61-bit Immediate Floats in the SpurMemoryManager
> class comment.
> msb
> lsb
> Decode:
> [8expsubset][52mantissa][1s][3tags]
> shift away tags & sign: [ 0000
> ][8expsubset][52mantissa]
> add sign: [ ssss
> ][8expsubset][52mantissa]"
> self assert: (self isImmediateFloat: oop).
> ^oop asUnsignedInteger >> (self numTagBits + 1)
> + ((oop anyMask: self smallFloatSignBit)
> + ifTrue: [-1 asUnsignedInteger << (64 - self numTagBits -
> 1)]
> - ifTrue: [-1 << (64 - self numTagBits - 1)]
> ifFalse: [0])!
>
> Item was changed:
> ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in
> category 'primitive support') -----
> maybeInlinePositive32BitIntegerFor: integerValue
> "N.B. will *not* cause a GC.
> integerValue is interpreted as POSITIVE, e.g. as the result of
> Bitmap>at:."
> <notOption: #Spur64BitMemoryManager>
> + <var: 'integerValue' type: #'unsigned int'>
> | newLargeInteger |
> self deny: objectMemory hasSixtyFourBitImmediates.
> + integerValue <= objectMemory maxSmallInteger
> + ifTrue: [^ objectMemory integerObjectOf: integerValue].
> - (integerValue asInteger >= 0
> - and: [objectMemory isIntegerValue: integerValue]) ifTrue:
> - [^objectMemory integerObjectOf: integerValue].
> newLargeInteger := objectMemory
>
> eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
> format:
> (objectMemory byteFormatForNumBytes: 4)
> numSlots: 1.
> self cppIf: VMBIGENDIAN
> ifTrue:
> [objectMemory
> storeByte: 3 ofObject: newLargeInteger
> withValue: (integerValue >> 24 bitAnd: 16rFF);
> storeByte: 2 ofObject: newLargeInteger
> withValue: (integerValue >> 16 bitAnd: 16rFF);
> storeByte: 1 ofObject: newLargeInteger
> withValue: (integerValue >> 8 bitAnd: 16rFF);
> storeByte: 0 ofObject: newLargeInteger
> withValue: (integerValue ">> 0" bitAnd: 16rFF)]
> ifFalse:
> [objectMemory storeLong32: 0 ofObject:
> newLargeInteger withValue: integerValue].
> ^newLargeInteger!
>
> Item was changed:
> ----- Method: StackInterpreter>>positive32BitIntegerFor: (in category
> 'primitive support') -----
> positive32BitIntegerFor: integerValue
> "integerValue is interpreted as POSITIVE, e.g. as the result of
> Bitmap>at:.
> N.B. Returning in each arm separately enables Slang inlining.
> /Don't/ return the ifTrue:ifFalse: unless Slang inlining of
> conditionals is fixed."
> <inline: true>
> + <var: 'integerValue' type: #'unsigned int'>
> objectMemory hasSixtyFourBitImmediates
> ifTrue:
> [^objectMemory integerObjectOf: (integerValue
> bitAnd: 16rFFFFFFFF)]
> ifFalse:
> [^self maybeInlinePositive32BitIntegerFor:
> integerValue]!
>
> Item was changed:
> ----- Method: StackInterpreter>>positive64BitIntegerFor: (in category
> 'primitive support') -----
> positive64BitIntegerFor: integerValue
> <api>
> + <var: 'integerValue' type: #usqLong>
> + <var: 'highWord' type: #'unsigned int'>
> - <var: 'integerValue' type: #sqLong>
> "Answer a Large Positive Integer object for the given integer
> value. N.B. will *not* cause a GC."
> | newLargeInteger highWord sz |
> objectMemory hasSixtyFourBitImmediates
> ifTrue:
> + [integerValue <= objectMemory maxSmallInteger
> ifTrue:
> - [(integerValue >= 0 and: [objectMemory
> isIntegerValue: integerValue]) ifTrue:
> [^objectMemory integerObjectOf:
> integerValue].
> sz := 8]
> ifFalse:
> + [(highWord := integerValue >> 32) = 0 ifTrue:
> - [(highWord := integerValue >>> 32) = 0 ifTrue:
> [^self positive32BitIntegerFor:
> integerValue].
> sz := 5.
> (highWord := highWord >> 8) = 0 ifFalse:
> [sz := sz + 1.
> (highWord := highWord >> 8) = 0 ifFalse:
> [sz := sz + 1.
> (highWord := highWord >> 8) = 0
> ifFalse:[sz := sz + 1]]]].
> newLargeInteger := objectMemory
>
> eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
> format:
> (objectMemory byteFormatForNumBytes: sz)
> numSlots: 8 /
> objectMemory bytesPerOop.
> self cppIf: VMBIGENDIAN
> ifTrue:
> [objectMemory
> storeByte: 7 ofObject: newLargeInteger
> withValue: (integerValue >> 56 bitAnd: 16rFF);
> storeByte: 6 ofObject: newLargeInteger
> withValue: (integerValue >> 48 bitAnd: 16rFF);
> storeByte: 5 ofObject: newLargeInteger
> withValue: (integerValue >> 40 bitAnd: 16rFF);
> storeByte: 4 ofObject: newLargeInteger
> withValue: (integerValue >> 32 bitAnd: 16rFF);
> storeByte: 3 ofObject: newLargeInteger
> withValue: (integerValue >> 24 bitAnd: 16rFF);
> storeByte: 2 ofObject: newLargeInteger
> withValue: (integerValue >> 16 bitAnd: 16rFF);
> storeByte: 1 ofObject: newLargeInteger
> withValue: (integerValue >> 8 bitAnd: 16rFF);
> storeByte: 0 ofObject: newLargeInteger
> withValue: (integerValue ">> 0" bitAnd: 16rFF)]
> ifFalse:
> [objectMemory storeLong64: 0 ofObject:
> newLargeInteger withValue: integerValue].
> ^newLargeInteger
> !
>
> Item was changed:
> ----- Method: StackInterpreter>>signed64BitIntegerFor: (in category
> 'primitive support') -----
> signed64BitIntegerFor: integerValue
> <var: 'integerValue' type: #sqLong>
> "Answer a Large Integer object for the given integer value. N.B.
> will *not* cause a GC."
> | newLargeInteger magnitude largeClass highWord sz |
> <inline: false>
> + <var: 'magnitude' type: #usqLong>
> - <var: 'magnitude' type: #sqLong>
> <var: 'highWord' type: #usqInt>
>
> - objectMemory wordSize = 8 ifTrue:
> - [(objectMemory isIntegerValue: integerValue) ifTrue:
> - [^objectMemory integerObjectOf: integerValue].
> - sz := 8].
> -
> integerValue < 0
> + ifTrue:[ integerValue >= objectMemory
> minSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue
> asInteger].
> + largeClass :=
> ClassLargeNegativeIntegerCompactIndex.
> + magnitude := 0 - (self cCoerceSimple:
> integerValue to: #usqLong)]
> + ifFalse:[ integerValue <= objectMemory
> maxSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue
> asInteger].
> + largeClass :=
> ClassLargePositiveIntegerCompactIndex.
> - ifTrue:[ largeClass :=
> ClassLargeNegativeIntegerCompactIndex.
> - magnitude := 0 - integerValue]
> - ifFalse:[ largeClass :=
> ClassLargePositiveIntegerCompactIndex.
> magnitude := integerValue].
>
> + objectMemory wordSize = 8
> + ifTrue: [sz := 8]
> + ifFalse: [
> - "Make sure to handle the most -ve value correctly. 0 - most -ve =
> most -ve and most -ve - 1
> - is +ve. Alas the simple (negative or: [integerValue - 1 < 0])
> fails with contemporary gcc and icc
> - versions with optimization and sometimes without. The shift
> works on all, touch wood."
> -
> - objectMemory wordSize = 4 ifTrue:
> - [(magnitude <= 16r7FFFFFFF
> - and: [integerValue >= 0
> - or: [0 ~= (self cCode: [integerValue << 1]
> - inSmalltalk:
> [integerValue << 1 bitAnd: (1 << 64) - 1])]]) ifTrue:
> - [^self signed32BitIntegerFor:
> integerValue].
> -
> (highWord := magnitude >> 32) = 0
> ifTrue: [sz := 4]
> ifFalse:
> [sz := 5.
> (highWord := highWord >> 8) = 0 ifFalse:
> [sz := sz + 1.
> (highWord := highWord >> 8) = 0
> ifFalse:
> [sz := sz + 1.
> (highWord := highWord >>
> 8) = 0 ifFalse:
> [sz := sz + 1]]]]].
>
> newLargeInteger := objectMemory
>
> eeInstantiateSmallClassIndex: largeClass
> format:
> (objectMemory byteFormatForNumBytes: sz)
> numSlots: sz + 3
> // objectMemory bytesPerOop.
> self cppIf: VMBIGENDIAN
> ifTrue:
> [sz > 4 ifTrue:
> [objectMemory
> storeByte: 7 ofObject:
> newLargeInteger withValue: (magnitude >> 56 bitAnd: 16rFF);
> storeByte: 6 ofObject:
> newLargeInteger withValue: (magnitude >> 48 bitAnd: 16rFF);
> storeByte: 5 ofObject:
> newLargeInteger withValue: (magnitude >> 40 bitAnd: 16rFF);
> storeByte: 4 ofObject:
> newLargeInteger withValue: (magnitude >> 32 bitAnd: 16rFF)].
> objectMemory
> storeByte: 3 ofObject: newLargeInteger
> withValue: (magnitude >> 24 bitAnd: 16rFF);
> storeByte: 2 ofObject: newLargeInteger
> withValue: (magnitude >> 16 bitAnd: 16rFF);
> storeByte: 1 ofObject: newLargeInteger
> withValue: (magnitude >> 8 bitAnd: 16rFF);
> storeByte: 0 ofObject: newLargeInteger
> withValue: (magnitude ">> 0" bitAnd: 16rFF)]
> ifFalse:
> + [sz > 4
> + ifTrue: [objectMemory storeLong64: 0
> ofObject: newLargeInteger withValue: magnitude]
> + ifFalse: [objectMemory storeLong32: 0
> ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk:
> [magnitude bitAnd: 16rFFFFFFFF])]].
> - [sz > 4 ifTrue:
> - [objectMemory storeLong32: 1 ofObject:
> newLargeInteger withValue: magnitude >> 32.
> - magnitude := magnitude bitAnd:
> 16rFFFFFFFF].
> - objectMemory storeLong32: 0 ofObject:
> newLargeInteger withValue: magnitude].
> ^newLargeInteger!
>
>
--
_,,,^..^,,,_
best, Eliot
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20160318/a296c979/attachment-0001.htm
More information about the Vm-dev
mailing list