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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 14 17:59:38 UTC 2015


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

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

Name: VMMaker.oscog-eem.1449
Author: eem
Time: 14 September 2015, 10:57:17.94 am
UUID: d4ac7710-be23-4445-8a3c-1d95713d5f26
Ancestors: VMMaker.oscog-eem.1448

Fix positive32BitValueOf: & signed32BitValueOf: for 64-bit Spur; these must fail for SmallIntegers with digitLength > 4.

Modify secret primtiive 161, primitiveSetIdentityHash so that with 0 args it answers whether an object has an identity hash.  This is vacuously true for V3, but is meaningful in Spur.

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

Item was changed:
  ----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') -----
  positive32BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
  	<returnTypeC: #usqInt>
  	| value ok sz |
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[value := objectMemory integerValueOf: oop.
+ 		 (value < 0
+ 		  or: [objectMemory wordSize > 4
+ 		  and: [self cCode: [(self cCoerceSimple: value to: #'unsigned int') ~= value]
+ 					inSmalltalk: [value >> 32 ~= 0]]]) ifTrue:
+ 			[self primitiveFail. value := 0].
- 		 value < 0 ifTrue: [self primitiveFail. value := 0].
  		 ^value].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
+ 	ok := objectMemory
+ 			isClassOfNonImm: oop
- 	ok := objectMemory isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok ifFalse:
  		[self primitiveFail.
  		 ^0].
  	sz := objectMemory numBytesOfBytes: oop.
  	sz > 4 ifTrue:
  		[self primitiveFail.
  		 ^0].
  	^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]!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveSetOrHasIdentityHash (in category 'object access primitives') -----
+ primitiveSetOrHasIdentityHash
+ 	| hash oldHash thisReceiver |
+ 	argumentCount = 0 ifTrue:
+ 		[| hasHash |
+ 		 hasHash := (objectMemory isNonImmediate: self stackTop)
+ 						and: [objectMemory hasIdentityHash: self stackTop].
+ 		 self pop: argumentCount + 1 thenPushBool: hasHash].
+ 	hash := self stackIntegerValue: 0.
+ 	thisReceiver := self stackObjectValue: 1.
+ 	self successful ifTrue:
+ 		[oldHash := objectMemory hashBitsOf: thisReceiver.
+ 		 objectMemory setHashBitsOf: thisReceiver to: hash.
+ 		 self pop: argumentCount + 1 thenPushInteger: oldHash]!

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 |
  	<inline: false>
  	<returnTypeC: #int>
  	<var: #value type: #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 integerValueOf: oop].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
+ 	ok := objectMemory
+ 			isClassOfNonImm: oop
+ 			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
+ 			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- 	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].
  
  	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].
  	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 added:
+ ----- Method: ObjectMemory>>hasIdentityHash: (in category 'header access') -----
+ hasIdentityHash: objOop
+ 	"Objects gain their identityHash on instantiation in V3."
+ 	<inline: true>
+ 	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>hasIdentityHash: (in category 'header access') -----
+ hasIdentityHash: objOop
+ 	<inline: true>
+ 	^self cCode: [self rawHashBitsOf: objOop]
+ 		inSmalltalk: [(self rawHashBitsOf: objOop) ~= 0]!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)



More information about the Vm-dev mailing list