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

commits at source.squeak.org commits at source.squeak.org
Thu Aug 20 18:55:31 UTC 2020


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

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

Name: VMMaker.oscog-eem.2792
Author: eem
Time: 20 August 2020, 11:55:21.739123 am
UUID: f914b421-12d3-48b8-b510-833495378c66
Ancestors: VMMaker.oscog-eem.2791

Eliminate translation time type error warnings for extendedStoreBytecodePop: and fetchLong32:ofFloatObject:.

Simplify and correct the comments of some of the integer oop => value converison routines.  These routines can simply return values directly instead of assigning through a variable.

Eliminate unintentional duplication in inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid:

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

Item was changed:
  ----- Method: CoInterpreter>>extendedStoreBytecodePop: (in category 'stack bytecodes') -----
  extendedStoreBytecodePop: popBoolean
  	"Override to use itemporary:in:put:"
+ 	| descriptor variableIndex value |
- 	| descriptor variableType variableIndex value |
  	<inline: true>
  	descriptor := self fetchByte.
- 	variableType := descriptor >> 6 bitAnd: 3.
  	variableIndex := descriptor bitAnd: 63.
  	value := self internalStackTop.
+ 	popBoolean ifTrue: [self internalPop: 1].
+ 	(descriptor >> 6 bitAnd: 3) caseOf: {
+ 		[0] ->	[objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value].
+ 		[1] ->	[self itemporary: variableIndex in: localFP put: value].
+ 		[2] ->	[self error: 'illegal store'].
+ 		[3] ->	[self storeLiteralVariable: variableIndex withValue: value] }.
+ 	self fetchNextBytecode!
- 	popBoolean ifTrue: [ self internalPop: 1 ].
- 	variableType = 0 ifTrue:
- 		[objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value.
- 		^ self fetchNextBytecode.].
- 	variableType = 1 ifTrue:
- 		[ self fetchNextBytecode.
- 		^self itemporary: variableIndex in: localFP put: value].
- 	variableType = 3 ifTrue:
- 		[self storeLiteralVariable: variableIndex withValue: value.
- 		^ self fetchNextBytecode.].
- 	self error: 'illegal store'!

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 up to an eight-byte LargeInteger."
- 	The object may be either a positive SmallInteger or an eight-byte LargeInteger."
- 	| sz value ok smallIntValue |
  	<returnTypeC: #usqLong>
+ 	| sz ok smallIntValue |
- 	<var: #value type: #usqLong>
  
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[smallIntValue := (objectMemory integerValueOf: oop).
+ 		 smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue].
+ 		^smallIntValue].
- 		smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue].
- 		^self cCoerce: smallIntValue to: #usqLong].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
+ 	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.
+ 			 ^0]].
- 	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.
- 				 ^0]].
  	sz := objectMemory numBytesOfBytes: oop.
  	sz > (self sizeof: #sqLong) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
+ 	sz > 4 ifTrue:
+ 		[^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)].
+ 	^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop))
+ 		to: #'unsigned int'!
- 	"self cppIf: SPURVM
- 		ifTrue:
- 			[""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes""
- 			value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
- 		ifFalse:
- 			["sz > 4
- 				ifTrue: [value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
- 				ifFalse: [value := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]".
- 	^value!

Item was changed:
  ----- Method: InterpreterPrimitives>>maybeInlinePositive32BitValueOf: (in category 'primitive support') -----
  maybeInlinePositive32BitValueOf: oop
  	"Convert the given object into an integer value.
  	The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
  	<notOption: #Spur64BitMemoryManager>
  	<returnTypeC: #'unsigned int'>
  	| value ok sz |
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[value := objectMemory integerValueOf: oop.
  		 (value < 0) ifTrue:
  			[self primitiveFail. value := 0].
  		 ^value].
  
+ 	(objectMemory isNonIntegerImmediate: oop) ifTrue:
+ 		[self primitiveFail.
+ 		 ^0].
+ 	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 cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop))
+ 		to: #'unsigned int'!
- 	(objectMemory isNonIntegerImmediate: oop)
- 		ifTrue:
- 			[self primitiveFail.
- 			 ^0]
- 		ifFalse:
- 			[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 cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']!

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 up to an eight-byte LargePositiveInteger."
- 	The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
  
  	<returnTypeC: #usqLong>
+ 	| sz ok smallIntValue |
- 	| sz value ok |
- 	<var: #value type: #usqLong>
  	(objectMemory isIntegerObject: oop) ifTrue:
+ 		[smallIntValue := objectMemory integerValueOf: oop.
+ 		 smallIntValue < 0 ifTrue:
- 		[(objectMemory integerValueOf: oop) < 0 ifTrue:
  			[^self primitiveFail].
+ 		 ^smallIntValue].
- 		 ^objectMemory integerValueOf: oop].
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok ifFalse:
  		[self primitiveFail.
  		 ^0].
  	sz := objectMemory numBytesOfBytes: oop.
  	sz > (self sizeof: #sqLong) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
+ 	sz > 4 ifTrue:
+ 		[^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)].
+ 	^self
+ 		cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop))
+ 		to: #'unsigned int'!
- 	"self cppIf: SPURVM
- 		ifTrue:
- 			[""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes""
- 			value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
- 		ifFalse:
- 			["sz > 4
- 				ifTrue: [value := objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
- 				ifFalse: [value := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]".
- 	^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: #'usqIntptr_t'>
  	<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.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok ifFalse:
  		[self primitiveFail.
  		 ^0].
  	bs := objectMemory numBytesOfBytes: oop.
  	bs > (self sizeof: #'usqIntptr_t') ifTrue:
  		[self primitiveFail.
  		 ^0].
  
+ 	((self sizeof: #'usqIntptr_t') = 8
+ 	 and: [bs > 4]) ifTrue:
+ 		[^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)].
+ 	^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int'!
- 	"self cppIf: SPURVM
- 		ifTrue: [""Memory is 8 byte aligned in Spur and oversized bytes are set to zero, so we can safely fetch 8 bytes""
- 			^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
- 		ifFalse: ["((self sizeof: #'usqIntptr_t') = 8
- 			and: [bs > 4])
- 				ifTrue:
- 					[^objectMemory byteSwapped64IfBigEndian: (objectMemory fetchLong64: 0 ofObject: oop)]
- 				ifFalse:
- 					[^self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int']"]"!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>fetchLong32:ofFloatObject: (in category 'object access') -----
  fetchLong32: fieldIndex ofFloatObject: oop
  	"index by word size, and return a pointer as long as the word size"
+ 	<returnTypeC: #'unsigned int'>
- 	
  	| bits |
  	(self isImmediateFloat: oop) ifFalse:
  		[^self fetchLong32: fieldIndex ofObject: oop].
  	bits := self smallFloatBitsOf: oop.
  	^fieldIndex = 0
  		ifTrue: [bits bitAnd: 16rFFFFFFFF]
  		ifFalse: [bits >> 32]!

Item was changed:
  ----- Method: SpurMemoryManager>>inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') -----
  inLineRunLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
  	<inline: true>
  	(gcModes anyMask: checkForLeaks) ifTrue:
  		[(gcModes anyMask: GCModeFull)
  			ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
  			ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
  		 self clearLeakMapAndMapAccessibleObjects.
  		 self asserta: (self checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid).
  		 self asserta: coInterpreter checkInterpreterIntegrity = 0.
- 		 self asserta: coInterpreter checkInterpreterIntegrity = 0.
  		 self asserta: coInterpreter checkStackIntegrity.
  		 self asserta: (coInterpreter checkCodeIntegrity: gcModes).
  		 (gcModes anyMask: GCModeFreeSpace) ifTrue:
  			[self clearLeakMapAndMapAccessibleFreeSpace.
  			 self asserta: self checkHeapFreeSpaceIntegrity]]!

Item was changed:
  ----- Method: StackInterpreter>>extendedStoreBytecodePop: (in category 'stack bytecodes') -----
  extendedStoreBytecodePop: popBoolean
+ 	| descriptor variableIndex value |
- 	| descriptor variableType variableIndex value |
  	<inline: true>
  	descriptor := self fetchByte.
- 	variableType := descriptor >> 6 bitAnd: 3.
  	variableIndex := descriptor bitAnd: 63.
  	value := self internalStackTop.
+ 	popBoolean ifTrue: [self internalPop: 1].
+ 	(descriptor >> 6 bitAnd: 3) caseOf: {
+ 		[0] ->	[objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value].
+ 		[1] ->	[self temporary: variableIndex in: localFP put: value].
+ 		[2] ->	[self error: 'illegal store'].
+ 		[3] ->	[self storeLiteralVariable: variableIndex withValue: value] }.
+ 	self fetchNextBytecode!
- 	popBoolean ifTrue: [ self internalPop: 1 ].
- 	variableType = 0 ifTrue:
- 		[objectMemory storePointerImmutabilityCheck: variableIndex ofObject: self receiver withValue: value.
- 		^ self fetchNextBytecode].
- 	variableType = 1 ifTrue:
- 		[ self fetchNextBytecode.
- 		^self temporary: variableIndex in: localFP put: value].
- 	variableType = 3 ifTrue:
- 		[self storeLiteralVariable: variableIndex withValue: value.
- 		^ self fetchNextBytecode].
- 	self error: 'illegal store'
- !



More information about the Vm-dev mailing list