[Vm-dev] VM Maker: VMMaker-dtl.286.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Sep 1 21:21:09 UTC 2012


David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.286.mcz

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

Name: VMMaker-dtl.286
Author: dtl
Time: 1 September 2012, 5:19:50.808 pm
UUID: ee3301f5-4cd4-469a-a49f-ada28111c85d
Ancestors: VMMaker-dtl.285

VMMaker 4.10.1

Incorporate fixes for large integer bugs by Nicolas Cellier.
Reference Mantis 7705: Three bugs in LargeInteger primitives
Patches provided by Nicolas in http://code.google.com/p/cog/issues/detail?id=92

With these changes, LargeNegativeIntegerTest>>testMinimumNegativeIntegerArithmetic passes. Performance is apparently improved by these changes (and is definitely not reduced).

Integration notes:

All changes are made in InterpreterPrimitives (not Interpreter, StackInterpreter etc as in original patches). This is because trunk VMM uses refactored Interpreter/StackInterpreter based in Eliot's original work, so all interpreters use common InterpreterPrimitives now.

The InterpreterProxy implementations provided in Nicolas' changes are not included because plugins do not currently require access to #isNegativeIntegerValueOf: #magnitude64BitIntegerFor:neg: or #magnitude64BitValueOf: and they are not declared in Cross/sqVirtualMachine.[ch]. These can be added later if needed.

=============== Diff against VMMaker-dtl.285 ===============

Item was added:
+ ----- Method: InterpreterPrimitives>>isNegativeIntegerValueOf: (in category 'primitive support') -----
+ isNegativeIntegerValueOf: oop
+ 	"Answer 1 if integer object is negative, 0 otherwise.
+ 	Fail if object pointed by oop i not an integer."
+ 	| ok smallInt |
+ 	<inline: false>
+ 	<returnTypeC: #usqInt>
+ 	<var: #smallInt type: #sqInt>
+ 	
+ 	(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 |
+ 	<inline: false>
+ 	<var: 'magnitude' type: 'usqLong'>
+ 	<var: 'isNegative' type: 'usqInt'>
+ 	<var: 'highWord' type: 'usqInt'>
+ 	<var: 'isSmall' type: 'usqInt'>
+ 	<var: 'smallVal' type: 'sqInt'>
+ 
+ 	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 |
+ 	<inline: false>
+ 	<returnTypeC: #usqLong>
+ 	<var: #value type: #usqLong>
+ 	<var: #smallIntValue type: #sqInt>
+ 	(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: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
+ 	<var: 'resultIsNegative' type: 'usqInt'>
- 	<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: 'shift' type: 'sqInt'>
+ 	<var: 'result' type: 'usqLong'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
- 	<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: (self cCode: 'shifted >> integerArg') = integerRcvr.
- 		] ifFalse: [
- 			"Right shift -- OK to lose bits"
- 			self success: integerArg > -64.
- 			shifted := self cCode: 'integerRcvr >> (0 - integerArg)'. "right shift coerces to usqInt"
- 		].
- 	].
  	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: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
- 	<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: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
- 	<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: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
- 	<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: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
- 	<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: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
- 	<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'>
+ 	<var: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
+ 
+ 	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: 'oopArg' type: 'usqInt'>
+ 	<var: 'oopRcvr' type: 'usqInt'>
+ 	<var: 'oopResult' type: 'usqInt'>
+ 	<var: 'aIsNegative' type: 'usqInt'>
+ 	<var: 'bIsNegative' type: 'usqInt'>
+ 	<var: 'resultIsNegative' type: 'usqInt'>
- 	<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:
+ ----- Method: ObjectMemory>>isClassOfNonImm:equalTo:compactClassIndex: (in category 'header access') -----
+ isClassOfNonImm: oop equalTo: classOop compactClassIndex: compactClassIndex
+ 	"Answer if the given (non-immediate) object is an instance of the given class
+ 	 that may have a compactClassIndex (if compactClassIndex is non-zero).
+ 	 N.B. Inlining and/or compiler optimization should result in classOop not being
+ 	 accessed if compactClassIndex is non-zero."
+ 
+ 	| ccIndex |
+ 	<inline: true>
+ 	<asmLabel: false>
+ 	self assert: (self isIntegerObject: oop) not.
+ 
+ 	ccIndex := self compactClassIndexOf: oop.
+ 	^compactClassIndex = 0
+ 		ifTrue:
+ 			[ccIndex = 0
+ 				ifTrue: [((self classHeader: oop) bitAnd: self allButTypeMask) = classOop]
+ 				ifFalse: [false]]
+ 		ifFalse:
+ 			[compactClassIndex == ccIndex]!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.10.1'!
- 	^'4.9.10'!



More information about the Vm-dev mailing list