VM Maker: VMMaker.oscog-eem.232.mcz

 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.232.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.232
Author: eem
Time: 11 December 2012, 5:47:49.686 pm
UUID: 9ecffa1b-c204-4dbd-b148-79e209e6470a
Ancestors: VMMaker.oscog-eem.231

Merge LargeInteger primitive fixes from VMMaker-dtl.286 and
tests from VMMaker-dtl.289.

=============== Diff against VMMaker.oscog-eem.231 ===============

Item was changed:
+ TestCase subclass: #BitBltSimulationTest
- ProtoObject subclass: #BitBltSimulationTest
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-Tests'!
 
  !BitBltSimulationTest commentStamp: 'jmv 10/26/2009 09:03' prior: 0!
  These tests require VMMaker and should be considered part of it.!

Item was changed:
  VMClass subclass: #InterpreterPrimitives
  instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields'
  classVariableNames: 'CrossedX EndOfRun MillisecondClockMask'
  poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
  category: 'VMMaker-Interpreter'!
 
+ !InterpreterPrimitives commentStamp: 'eem 12/11/2012 17:11' prior: 0!
- !InterpreterPrimitives commentStamp: 'eem 9/29/2010 18:01' prior: 0!
  InterpreterPrimitives implements most of the VM's core primitives.  It is the root of the interpreter hierarchy so as to share the core primitives amongst the varioius interpreters.
 
  Instance Variables
+ argumentCount: <Integer>
+ messageSelector: <Integer>
- argumentCount: <Integer>
- messageSelector: <Integer>
  newMethod: <Integer>
  nextProfileTick: <Integer>
+ objectMemory: <ObjectMemory> (simulation only)
+ preemptionYields: <Boolean>
- objectMemory: <ObjectMemory>
- preemptionYields: <Boolean>
  primFailCode: <Integer>
  profileMethod: <Integer>
  profileProcess: <Integer>
+ profileSemaphore: <Integer>
 
  argumentCount
  - the number of arguments of the current message
 
  messageSelector
  - the oop of the selector of the current message
 
  newMethod
  - the oop of the result of looking up the current message
 
  nextProfileTick
  - the millisecond clock value of the next profile tick (if profiling is in effect)
 
  objectMemory
  - the memory manager and garbage collector that manages the heap
 
  preemptionYields
  - a boolean controlling the process primitives.  If true (old, incorrect, blue-book semantics) a preempted process is sent to the back of its run-queue.  If false, a process preempted by a higher-priority process is put back at the head of its run queue, hence preserving cooperative scheduling within priorities.
 
  primFailCode
  - primtiive success/failure flag, 0 for success, otherwise the reason code for failure
 
  profileMethod
  - the oop of the method at the time nextProfileTick was reached
 
  profileProcess
  - the oop of the activeProcess at the time nextProfileTick was reached
 
  profileSemaphore
  - the oop of the semaphore to signal when nextProfileTick is reached
  !

Item was added:
+ ----- Method: InterpreterPrimitives>>isNegativeIntegerValueOf: (in category 'primitive support') -----
+ isNegativeIntegerValueOf: oop
+ "Answer true if integer object is negative.
+ Fail if object pointed by oop i not an integer."
+ | ok smallInt |
+
+ (objectMemory isIntegerObject: oop)
+ ifTrue:
+ [smallInt := objectMemory integerValueOf: oop.
+ ^smallInt < 0].
+
+ ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargePositiveInteger)
+ compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ ok ifTrue: [^false].
+
+ ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
+ compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
+ ok ifTrue: [^true].
+ self primitiveFail.
+ ^false!

Item was added:
+ ----- 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 intValue highWord sz isSmall smallVal |
+ <var: 'magnitude' type: 'usqLong'>
+ <var: 'highWord' type: 'usqInt'>
+
+ isSmall := isNegative
+ ifTrue: [magnitude <= 16r40000000]
+ ifFalse: [magnitude < 16r40000000].
+ isSmall
+ ifTrue:
+ [smallVal := self cCoerce: magnitude to: #sqInt.
+ isNegative ifTrue: [smallVal := 0 - smallVal].
+ ^self integerObjectOf: smallVal].
+ isNegative
+ ifTrue:[ largeClass := self classLargeNegativeInteger]
+ ifFalse:[ largeClass := self classLargePositiveInteger].
+ highWord := self cCode: 'magnitude >> 32'. "shift is coerced to usqInt otherwise"
+ highWord = 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 := self instantiateClass: largeClass indexableSize:  sz.
+ 0 to: sz-1 do: [:i |
+ intValue := self cCode: '(magnitude >> (i * 8)) & 255'.
+ self storeByte: i ofObject: newLargeInteger withValue: intValue].
+ ^ newLargeInteger!

Item was added:
+ ----- 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 a 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].
+
+ 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]].
+ sz := objectMemory lengthOf: oop.
+ sz > (self sizeof: #sqLong asSymbol) ifTrue:
+ [^self primitiveFail].
+
+ value := 0.
+ 0 to: sz - 1 do: [:i |
+ value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) <<  (i*8))].
+ ^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveAddLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveAddLargeIntegers
  "Primitive arithmetic operations for large integers in 64 bit range"
+ | a b result oopResult aIsNegative bIsNegative resultIsNegative oopArg oopRcvr |
- | integerRcvr integerArg result oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'result' type: 'sqLong'>
 
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
- integerArg := self signed64BitValueOf: (self stackValue: 0).
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
  self successful ifFalse:[^nil].
+ (aIsNegative = bIsNegative)
+ ifTrue:
+ ["Protect against overflow"
+ a > (16rFFFFFFFFFFFFFFFF - b) ifTrue: [self primitiveFail. ^nil].
+ result := a + b.
+ resultIsNegative := aIsNegative]
+ ifFalse:
+ [(a >= b)
+ ifTrue:
+ [result := a - b.
+ resultIsNegative := aIsNegative]
+ ifFalse:
+ [result := b - a.
+ resultIsNegative := bIsNegative]].
+ oopResult := self magnitude64BitIntegerFor: result neg: resultIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult].!
-
- "Compute the preliminary result (which may overflow)"
- result := integerRcvr + integerArg.
-
- "Now check overflow conditions. First is whether rcvr and arg are of the same sign.
- If they are we need to check for overflow more carefully."
- (integerRcvr bitXor: integerArg) < 0 ifFalse:[
- "Second is whether rcvr and result are of the same sign. If not, we have an overflow."
- (integerRcvr bitXor: result) < 0 ifTrue:[self primitiveFail]].
-
- self successful ifFalse:[^nil].
-
- oopResult := self signed64BitIntegerFor: result.
- self successful ifTrue:[self pop: 2 thenPush: oopResult]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveBitShiftLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveBitShiftLargeIntegers
+ "Primitive arithmetic operations for large integers in 64 bit range"
+ | a shift result oopResult aIsNegative oopRcvr |
- "Primitive logical operations for large integers in 64 bit range"
- | shifted integerArg integerRcvr oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'shifted' type: 'sqLong'>
 
+ shift := self stackIntegerValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ a := self magnitude64BitValueOf: oopRcvr.
- integerArg := self stackIntegerValue: 0.
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
-
- self successful ifTrue: [
- integerArg >= 0 ifTrue: [
- "Left shift -- must fail if we lose bits beyond 64"
- self success: integerArg < 64.
- shifted := integerRcvr << integerArg.
- self success: integerRcvr = (self cCode: 'shifted >> integerArg'
- inSmalltalk: [shifted >> integerArg]).
- ] ifFalse: [
- "Right shift -- OK to lose bits"
- self success: integerArg > -64.
- shifted := self cCode: 'integerRcvr >> (0 - integerArg)' "right shift coerces to usqInt"
- inSmalltalk: [integerRcvr >> (0 - integerArg)]
- ].
- ].
  self successful ifFalse:[^nil].
+ (shift >= 0)
+ ifTrue:
+ ["Protect against overflow"
+ result := 16rFFFFFFFFFFFFFFFF. "This is to avoid undue (usqInt) cast"
+ (shift >= 64 or: [a > (result >> shift)]) ifTrue: [self primitiveFail. ^nil].
+ result := a << shift]
+ ifFalse:
+ [shift := 0 - shift.
+ shift >= 64
+ ifTrue: [result := 0]
+ ifFalse: [result := a >> shift].
+ "Fake 2 complement for negative values"
+ (aIsNegative and: [result << shift ~= a]) ifTrue: [result := result + 1]].
+ oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult].!
- oopResult := self signed64BitIntegerFor: shifted.
- self successful ifTrue:[self pop: 2 thenPush: oopResult]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveDivLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveDivLargeIntegers
  "Primitive arithmetic operations for large integers in 64 bit range"
+ | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr rem |
- | integerRcvr integerArg result posArg posRcvr oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
+ <var: 'rem' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'posRcvr' type: 'sqLong'>
- <var: 'posArg' type: 'sqLong'>
- <var: 'result' type: 'sqLong'>
 
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
+ b = 0 ifTrue:[self primitiveFail].
- integerArg := self signed64BitValueOf: (self stackValue: 0).
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
- integerArg = 0 ifTrue:[self primitiveFail].
  self successful ifFalse:[^nil].
 
+ result := a // b.
+
+ a = 0
+ ifFalse: [bIsNegative = aIsNegative
+ ifFalse:
+ ["Round toward negative infinity"
+ rem := a \\ b.
+ rem = 0 ifFalse:
+ ["This can not overflow, because b > 1, otherwise rem = 0"
+ result := result + 1]]].
+
+ oopResult := self magnitude64BitIntegerFor: result neg: bIsNegative ~= aIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult].!
- integerRcvr > 0
- ifTrue: [integerArg > 0
- ifTrue: [result := integerRcvr // integerArg]
- ifFalse: ["round negative result toward negative infinity"
- posArg := 0 - integerArg.
- posRcvr := integerRcvr + (posArg - 1). "can overflow!!"
- posRcvr < 0 ifTrue:[self primitiveFail].
- result := 0 - (posRcvr // posArg)]]
- ifFalse: [posRcvr := 0 - integerRcvr.
- integerArg > 0
- ifTrue: ["round negative result toward negative infinity"
- posRcvr := posRcvr + (integerArg - 1). "can overflow!!"
- posRcvr < 0 ifTrue:[self primitiveFail].
- result := 0 - (posRcvr // integerArg)]
- ifFalse: [posArg := 0 - integerArg.
- result := posRcvr // posArg]].
- self successful ifTrue:[oopResult := self signed64BitIntegerFor: result].
- self successful ifTrue:[self pop: 2 thenPush: oopResult]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveDivideLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveDivideLargeIntegers
  "Primitive arithmetic operations for large integers in 64 bit range"
+ | a b result oopResult aIsNegative bIsNegative oopArg oopRcvr |
- | integerRcvr integerArg result oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'result' type: 'sqLong'>
 
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
- integerArg := self signed64BitValueOf: (self stackValue: 0).
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
- (integerArg ~= 0 and:[integerRcvr \\ integerArg = 0]) ifFalse:[self primitiveFail].
  self successful ifFalse:[^nil].
+
+ "check for exact division"
+ (b ~= 0 and:[a \\ b = 0]) ifFalse:[self primitiveFail. ^nil].
+
+ result := a // b.
+ oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative ~= bIsNegative.
+
+ self successful ifTrue:[self pop: 2 thenPush: oopResult].
+ !
- result := integerRcvr // integerArg.
- oopResult := self signed64BitIntegerFor: result.
- self successful ifTrue:[self pop: 2 thenPush: oopResult]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveModLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveModLargeIntegers
  "Primitive arithmetic operations for large integers in 64 bit range"
+ | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr |
- | integerRcvr integerArg result oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'result' type: 'sqLong'>
 
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
+ b = 0 ifTrue:[self primitiveFail].
- integerArg := self signed64BitValueOf: (self stackValue: 0).
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
- integerArg = 0 ifTrue:[self primitiveFail].
  self successful ifFalse:[^nil].
 
+ result := a \\ b.
- result := integerRcvr \\ integerArg.
 
+ "Handle remainder of same sign as argument"
+ result = 0
+ ifFalse: [bIsNegative = aIsNegative
+ ifFalse: [result := b - result]].
- "ensure that the result has the same sign as the integerArg"
- integerArg < 0
- ifTrue: [result > 0
- ifTrue: [result := result + integerArg]]
- ifFalse: [result < 0
- ifTrue: [result := result + integerArg]].
 
+ oopResult := self magnitude64BitIntegerFor: result neg: bIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult].
+ !
- oopResult := self signed64BitIntegerFor: result.
- self successful ifTrue:[self pop: 2 thenPush: oopResult]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveMultiplyLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveMultiplyLargeIntegers
  "Primitive arithmetic operations for large integers in 64 bit range"
+ | a b result oopResult aIsNegative bIsNegative oopArg oopRcvr |
- | integerRcvr integerArg result oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'result' type: 'sqLong'>
 
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
- integerArg := self signed64BitValueOf: (self stackValue: 0).
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
  self successful ifFalse:[^nil].
+
+ "check for overflow"
+ (a > 1 and: [b > 1 and: [a > (16rFFFFFFFFFFFFFFFF / b)]])
+ ifTrue: [self primitiveFail. ^nil].
 
+ result := a * b.
+ oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative ~= bIsNegative.
- result := self
- cCode: [integerRcvr * integerArg]
- inSmalltalk:
- [| twoToThe64 r |
- twoToThe64 := 2 raisedTo: 64.
- r := integerRcvr * integerArg bitAnd: twoToThe64 - 1.
- (r bitAt: 64) = 0 ifTrue: [r] ifFalse: [r - twoToThe64]].
- "check for C overflow by seeing if computation is reversible"
- ((integerArg = 0) or: [(result // integerArg) = integerRcvr])
- ifTrue:[oopResult := self signed64BitIntegerFor: result]
- ifFalse: [self primitiveFail].
 
+ self successful ifTrue:[self pop: 2 thenPush: oopResult].
+ !
- self successful ifTrue:[self pop: 2 thenPush: oopResult]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveQuoLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveQuoLargeIntegers
  "Primitive arithmetic operations for large integers in 64 bit range"
+ | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr |
- | integerRcvr integerArg result oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'result' type: 'sqLong'>
 
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
+ b = 0 ifTrue:[self primitiveFail].
- integerArg := self signed64BitValueOf: (self stackValue: 0).
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
- integerArg = 0 ifTrue:[self primitiveFail].
  self successful ifFalse:[^nil].
 
+ result := a // b.
- integerRcvr > 0 ifTrue: [
- integerArg > 0
- ifTrue: [result := integerRcvr // integerArg]
- ifFalse: [result := 0 - (integerRcvr // (0 - integerArg))].
- ] ifFalse: [
- integerArg > 0
- ifTrue: [result := 0 - ((0 - integerRcvr) // integerArg)]
- ifFalse: [result := (0 - integerRcvr) // (0 - integerArg)].
- ].
 
+ oopResult := self magnitude64BitIntegerFor: result neg: bIsNegative ~= aIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult].!
- oopResult := self signed64BitIntegerFor: result.
- self successful ifTrue:[self pop: 2 thenPush: oopResult]!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveRemLargeIntegers (in category 'arithmetic largeint primitives') -----
+ primitiveRemLargeIntegers
+ "Primitive arithmetic operations for large integers in 64 bit range"
+ | result oopResult a aIsNegative b bIsNegative oopArg oopRcvr |
+ <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
+
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
+ b = 0 ifTrue:[self primitiveFail].
+ self successful ifFalse:[^nil].
+
+ result := a \\ b.
+
+ oopResult := self magnitude64BitIntegerFor: result neg: aIsNegative ~= bIsNegative.
+ self successful ifTrue: [self pop: 2 thenPush: oopResult].!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSubtractLargeIntegers (in category 'arithmetic largeint primitives') -----
  primitiveSubtractLargeIntegers
  "Primitive arithmetic operations for large integers in 64 bit range"
+ | a b result oopResult aIsNegative bIsNegative resultIsNegative oopArg oopRcvr |
- | integerRcvr integerArg integerArgNegated result oopResult |
  <export: true>
+ <var: 'a' type: 'usqLong'>
+ <var: 'b' type: 'usqLong'>
+ <var: 'result' type: 'usqLong'>
- <var: 'integerRcvr' type: 'sqLong'>
- <var: 'integerArg' type: 'sqLong'>
- <var: 'integerArgNegated' type: 'sqLong'>
- <var: 'result' type: 'sqLong'>
 
+ oopArg := self stackValue: 0.
+ oopRcvr := self stackValue: 1.
+ aIsNegative := self isNegativeIntegerValueOf: oopRcvr.
+ bIsNegative := self isNegativeIntegerValueOf: oopArg.
+ a := self magnitude64BitValueOf: oopRcvr.
+ b := self magnitude64BitValueOf: oopArg.
+ self successful ifFalse:[^nil].
+ (aIsNegative ~= bIsNegative)
+ ifTrue:
+ ["Protect against overflow"
+ a > (16rFFFFFFFFFFFFFFFF - b) ifTrue: [self primitiveFail. ^nil].
+ result := a + b.
+ resultIsNegative := aIsNegative]
- integerArg := self signed64BitValueOf: (self stackValue: 0).
- integerRcvr := self signed64BitValueOf: (self stackValue: 1).
- self successful ifFalse:
- [^nil].
-
- "In the test for the argument being most -ve we would
- have to check for zero if we don't do so here.
- So do so here and short-circuit the whole subtraction."
- integerArg = 0
- ifTrue: [result := integerRcvr]
  ifFalse:
+ [(a >= b)
+ ifTrue:
+ [result := a - b.
+ resultIsNegative := aIsNegative]
+ ifFalse:
+ [result := b - a.
+ resultIsNegative := aIsNegative not]].
+ oopResult := self magnitude64BitIntegerFor: result neg: resultIsNegative.
+ self successful ifTrue:[self pop: 2 thenPush: oopResult].
+ !
- ["Reverse the argument so that we can recycle the overflow code from addition.
- But the most -ve 64-bit value can overflow, so check; 0 - most -ve = most -ve"
- integerArgNegated := 0 - integerArg.
- integerArgNegated = integerArg ifTrue:
- [^self primitiveFail].
-
- "Compute the preliminary result (which may overflow)"
- result := integerRcvr + integerArgNegated.
-
- "Now check overflow conditions. First is whether rcvr and arg are of the same sign.
- If they are we need to check for overflow more carefully."
- (integerRcvr bitXor: integerArgNegated) < 0 ifFalse:
- "Second is whether rcvr and result are of the same sign. If not, we have an overflow."
- [(integerRcvr bitXor: result) < 0 ifTrue:
- [^self primitiveFail]]].
-
- oopResult := self signed64BitIntegerFor: result.
- self successful ifTrue:
- [self pop: 2 thenPush: oopResult]!

Item was added:
+ TestCase subclass: #InterpreterPrimitivesTest
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-Tests'!
+
+ !InterpreterPrimitivesTest commentStamp: 'dtl 7/27/2011 11:32' prior: 0!
+ InterpreterPrimitivesTest provides test coverage for certain potentially problematic
+ primitives and methods in the interpreter.!

Item was added:
+ ----- Method: InterpreterPrimitivesTest>>expectedFailures (in category 'testing') -----
+ expectedFailures
+ ^#("testPrimitiveSubtractLargeIntegersParameterBounds")!

Item was added:
+ ----- Method: InterpreterPrimitivesTest>>testPrimitiveSubtractLargeIntegersParameterBounds (in category 'testing - primitiveSubtractLargeIntegers') -----
+ testPrimitiveSubtractLargeIntegersParameterBounds
+ "Prior to VMMaker VMMaker 4.10.1 enhancement by Nicolas Cellier, range was
+ restricted and this test would fail."
+
+ | intOne intTwo |
+ "LargeNegativeInteger at lower range boundary"
+ intOne := -16r8000000000000000. "maximum negative 64 bit value"
+ intTwo := -16r7FFFFFFFFFFFFFFF.
+ self shouldnt: [intTwo minus64: intOne]
+ raise: Error.
+ !

Item was added:
+ ----- Method: InterpreterPrimitivesTest>>testSigned64BitValueOfLargeNegativeInteger (in category 'testing - signed64BitValueOf') -----
+ testSigned64BitValueOfLargeNegativeInteger
+ "Exercise #signed64BitValueOf: using a LargeNegativeInteger at the maximum of
+ its range. Note, IntegerArrayTest provides coverage of 32-bit equivalent."
+
+ | intOne diff intTwo |
+ "LargeNegativeInteger at lower range boundary"
+ intOne := -16r8000000000000000. "maximum negative 64 bit value"
+ intTwo := -16r7FFFFFFFFFFFFFFF.
+ self shouldnt: [diff := intOne minus64: intTwo]
+ raise: Error.
+ self assert: diff = -1.
+
+ "See testPrimitiveSubtractLargeIntegersParameterBounds"
+ "self shouldnt: [diff := intTwo minus64: intOne]
+ raise: Error.
+ self assert: diff = 1."
+
+ self shouldnt: [diff := intOne minus64: -1]
+ raise: Error.
+ self assert: diff = intTwo.
+
+ "Parameters exceeding allowable range"
+ "Prior to VMMaker VMMaker 4.10.1 enhancement by Nicolas Cellier, range was
+ restricted and the following would raise errors."
+ intOne := -16r8000000000000000 - 1. "exceed most negative 64 bit twos complement"
+ intTwo := -16r7FFFFFFFFFFFFFFF.
+ diff := intOne minus64: intTwo.
+ self assert: diff = -2.
+ diff := intTwo minus64: intOne.
+ self assert: diff = 2.
+ "Full 64 bit magnitude range is now available"
+ intOne := -16rFFFFFFFFFFFFFFFF. ""
+ intTwo := -16rFFFFFFFFFFFFFFFE.
+ diff := intOne minus64: intTwo.
+ self assert: diff = -1.
+ diff := intTwo minus64: intOne.
+ self assert: diff = 1.
+ intOne := 16rFFFFFFFFFFFFFFFF. ""
+ intTwo := 16rFFFFFFFFFFFFFFFE.
+ diff := intOne minus64: intTwo.
+ self assert: diff = 1.
+ diff := intTwo minus64: intOne.
+ self assert: diff = -1.
+ "Out of range"
+ intOne := -16rFFFFFFFFFFFFFFFF - 1. "exceed most negative 64 bit unsigned magnitude"
+ intTwo := -16rFFFFFFFFFFFFFFFF.
+ self should: [intOne minus64: intTwo]
+ raise: Error.
+ self should: [intTwo minus64: intOne]
+ raise: Error.
+ !

Item was added:
+ ----- Method: InterpreterPrimitivesTest>>testSigned64BitValueOfLargePositiveInteger (in category 'testing - signed64BitValueOf') -----
+ testSigned64BitValueOfLargePositiveInteger
+ "Exercise #signed64BitValueOf: using a LargePositiveInteger at the maximum of
+ its range. Note, IntegerArrayTest provides coverage of 32-bit equivalent."
+
+ | intOne diff intTwo |
+ "LargePositiveInteger at upper range boundary"
+ intOne := 16r7FFFFFFFFFFFFFFF. "maximum 64 bit positive"
+ intTwo := 16r7FFFFFFFFFFFFFFE.
+ self shouldnt: [diff := intOne minus64: intTwo]
+ raise: Error.
+ self assert: diff = 1.
+ self shouldnt: [diff := intTwo minus64: intOne]
+ raise: Error.
+ self assert: diff = -1.
+ self shouldnt: [diff := intOne minus64: 1]
+ raise: Error.
+ self assert: diff = intTwo.
+
+ "Parameters exceeding allowable range"
+ "Prior to VMMaker VMMaker 4.10.1 enhancement by Nicolas Cellier, range was
+ restricted and the following would raise errors."
+ intOne := 16r7FFFFFFFFFFFFFFF + 1.  "exceed maximum 64 bit twos complement positive"
+ intTwo := 16r7FFFFFFFFFFFFFFE.
+ diff := intOne minus64: intTwo.
+ self should: diff = 2.
+ diff := intTwo minus64: intOne.
+ self should: diff = -2.
+
+ "Full 64 bit magnitude range is now available"
+ intOne := 16rFFFFFFFFFFFFFFFF.
+ intTwo := 16rFFFFFFFFFFFFFFFE.
+ diff := intOne minus64: intTwo.
+ self should: diff = 1.
+ diff := intTwo minus64: intOne.
+ self should: diff = -1.
+
+ intOne := 16rFFFFFFFFFFFFFFFF + 1. "exceed maximum 64 bit unsigned magnitude"
+ intTwo := 16rFFFFFFFFFFFFFFFE.
+ self should: [intOne minus64: intTwo]
+ raise: Error.
+ self should: [intTwo minus64: intOne]
+ raise: Error.
+ !

Item was added:
+ ----- Method: LargePositiveInteger>>minus64: (in category '*VMMaker-Tests') -----
+ minus64: anInteger
+ "For unit test support only. Subtract two large integers, raising an error on failure."
+
+ <primitive: 22>
+ ^self primitiveFailed!