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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.1453
Author: eem
Time: 14 September 2015, 6:02:22.862 pm
UUID: baf34f5d-4d8d-4f5f-b74a-1d76ecd08695
Ancestors: VMMaker.oscog-eem.1452

Fix bugs with 4-byte long integers in the 64-bit or machine word on 64-bit signed integer conversion routines.

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

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 |
  	<inline: false>
  	<returnTypeC: #sqLong>
  	<var: #value type: #sqLong>
  	(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:
  			[value := objectMemory fetchByte: sz - 1 ofObject: oop.
  			 sz - 2 to: 0 by: -1 do: [:i |
  				value := value << 8 + (objectMemory fetchByte: i ofObject: oop)]]
  		ifFalse:
  			[value := sz > 4
  						ifTrue: [objectMemory fetchLong64: 0 ofObject: oop]
+ 						ifFalse: [(objectMemory fetchLong32: 0 ofObject: oop) asUnsignedInteger]].
- 						ifFalse: [objectMemory fetchLong32: 0 ofObject: oop]].
  	"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 bits |
  	<var: #value type: #long>
  	(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:
  		[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:
  			[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]].
- 							[objectMemory fetchLong32: 0 ofObject: oop]].
  	
  	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]!