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

commits at source.squeak.org commits at source.squeak.org
Wed Nov 19 18:04:27 UTC 2014


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

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

Name: VMMaker.oscog-eem.943
Author: eem
Time: 19 November 2014, 10:01:51.541 am
UUID: 3e35700d-2330-4eb4-96fb-22812be23140
Ancestors: VMMaker.oscog-eem.942

Fix the code generator for 64-bit Spur integerValueOf:.
Fix 64-bit integerValueOf: integerObjectOf: &
isIntegerValue:.
Use numBytesOf: instead of lengthOf: in the 64-bit
integer conversion routines.  Reorder cases in
Spur's numBytesOf: to put common case first.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateIntegerValueOf:on:indent: (in category 'C translation') -----
  generateIntegerValueOf: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
+ 	aStream nextPut: $(.
- 	aStream nextPutAll: '('.
  	self emitCExpression: msgNode args first on: aStream.
+ 	aStream nextPutAll: ' >> ';
+ 		print: vmClass objectMemoryClass numSmallIntegerTagBits;
+ 		nextPut: $).!
- 	aStream nextPutAll: ' >> 1)'.!

Item was changed:
  ----- 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].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[^self primitiveFail].
  
  	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 numBytesOf: oop.
- 	sz := objectMemory lengthOf: oop.
  	sz > (self sizeof: #sqLong) 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>>positive64BitValueOf: (in category 'primitive support') -----
  positive64BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
  
  	<returnTypeC: #usqLong>
  	| sz value ok |
  	<var: #value type: #usqLong>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[(objectMemory integerValueOf: oop) < 0 ifTrue:
  			[^self primitiveFail].
  		 ^objectMemory integerValueOf: oop].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ 	(ok and: [(sz := objectMemory numBytesOf: oop) <= (self sizeof: #sqLong)]) ifFalse:
- 	(ok and: [(sz := objectMemory lengthOf: oop) <= (self sizeof: #sqLong)]) ifFalse:
  		[self primitiveFail.
  		 ^0].
  
  	value := 0.
  	0 to: sz - 1 do: [:i |
  		value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #usqLong) <<  (i*8))].
  	^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') -----
  positiveMachineIntegerValueOf: oop
  	"Answer a value of an integer in address range, i.e up to the size of a machine word.
  	The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size."
  	<returnTypeC: #'unsigned long'>
  	<inline: true> "only two callers & one is primitiveNewWithArg"
  	| value bs ok |
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[value := objectMemory integerValueOf: oop.
  		 value < 0 ifTrue: [^self primitiveFail].
  		^value].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[^self primitiveFail].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ 	(ok and: [(bs := objectMemory numBytesOf: oop) <= (self sizeof: #'unsigned long')]) ifFalse:
- 	(ok and: [(bs := objectMemory lengthOf: oop) <= (self sizeof: #'unsigned long')]) ifFalse:
  		[^self primitiveFail].
  
  	((self sizeof: #'unsigned long') = 8
  	and: [bs > 4]) 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)].
  
  	^  (objectMemory fetchByte: 0 ofObject: oop)
  	+ ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
  	+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
  	+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)!

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."
- 	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].
  
  	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]].
+ 	sz := objectMemory numBytesOf: oop.
- 	sz := objectMemory lengthOf: oop.
  	sz > (self sizeof: #sqLong) ifTrue:
  		[^self primitiveFail].
  
  	value := 0.
  	0 to: sz - 1 do: [:i |
  		value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) <<  (i*8))].
  	"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."
- 		  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].
  	^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:
- 	(bs := objectMemory lengthOf: oop) > (self sizeof: #'unsigned long') ifTrue:
  		[^self primitiveFail].
  
  	((self sizeof: #'unsigned long') = 8
  	 and: [bs > 4])
  		ifTrue:
  			[value :=   (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:
  			[value :=   (objectMemory fetchByte: 0 ofObject: oop)
  					+ ((objectMemory fetchByte: 1 ofObject: oop) <<  8)
  					+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
  					+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)].
  
  	
  	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]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>integerObjectOf: (in category 'immediates') -----
  integerObjectOf: value
  	"Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object.
  	 In C, use a shift and an add to set the tag bit.
  	 In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns."
  	<returnTypeC: #sqInt>
  	^self
  		cCode: [value << self numTagBits + 1]
  		inSmalltalk: [value << self numTagBits
  					+ (value >= 0
  						ifTrue: [1]
+ 						ifFalse: [16r10000000000000001])]!
- 						ifFalse: [16r8000000000000001])]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>integerValueOf: (in category 'immediates') -----
  integerValueOf: oop
+ 	"Translator produces 'oop >> 3'"
- 	"Translator produces 'oop >> 1'"
  	^(oop bitShift: -63) = 1 "tests top bit"
  		ifTrue: "negative"
+ 			[((oop bitShift: self numTagBits negated) bitAnd: 16r1FFFFFFFFFFFFFFF) - 16r1FFFFFFFFFFFFFFF - 1  "Faster than -16r4000000000000000 (a LgInt)"]
- 			[((oop bitShift: self numTagBits negated) bitAnd: 16r3FFFFFFFFFFFFFFF) - 16r3FFFFFFFFFFFFFFF - 1  "Faster than -16r4000000000000000 (a LgInt)"]
  		ifFalse: "positive"
  			[oop bitShift: self numTagBits negated]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>isIntegerValue: (in category 'interpreter access') -----
  isIntegerValue: intValue
  	"Answer if the given value can be represented as a Smalltalk integer value.
  	 In 64-bits we use a 3 bit tag which leaves 61 bits for 2's complement signed
  	 integers. In C, use a shift add and mask to test if the top 4 bits are all the same."
  	<api>
  	^self
  		cCode: [(intValue >> 60 + 1 bitAnd: 16rF) <= 1]
+ 		inSmalltalk: [intValue >= -16r1000000000000000 and: [intValue <= 16rFFFFFFFFFFFFFFF]]!
- 		inSmalltalk: [intValue >= -16r2000000000000000 and: [intValue <= 16r1FFFFFFFFFFFFFFF]]!

Item was changed:
  ----- Method: SpurMemoryManager>>numBytesOf: (in category 'object access') -----
  numBytesOf: objOop 
  	"Answer the number of indexable bytes in the given non-immediate object.
  	 Does not adjust the size of contexts by stackPointer."
  	<api>
  	| fmt numBytes |
  	<inline: true>
  	fmt := self formatOf: objOop.
  	numBytes := self numSlotsOf: objOop.
  	numBytes := numBytes << self shiftForWord.
+ 	fmt >= self firstByteFormat ifTrue: "bytes (the common case), including CompiledMethod"
+ 		[^numBytes - (fmt bitAnd: 7)].
  	fmt <= self sixtyFourBitIndexableFormat ifTrue:
  		[^numBytes].
- 	fmt >= self firstByteFormat ifTrue: "bytes, including CompiledMethod"
- 		[^numBytes - (fmt bitAnd: 7)].
  	fmt >= self firstShortFormat ifTrue:
  		[^numBytes - ((fmt bitAnd: 3) << 1)].
  	"fmt >= self firstLongFormat"
  	^numBytes - ((fmt bitAnd: 1) << 2)!



More information about the Vm-dev mailing list