[Vm-dev] VM Maker: VMMaker.oscog-eem.232.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Dec 12 01:49:46 UTC 2012


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!



More information about the Vm-dev mailing list