[Vm-dev] missed commit mails

Tobias Pape Das.Linux at gmx.de
Wed Oct 26 11:39:04 UTC 2016



Begin forwarded message:
> Date: Wed, 26 Oct 2016 00:16:34 0000
> From: commits at source.squeak.org
> To: vm-dev at lists.squeakfoundation.org
> Reply-To: vm-dev at lists.squeakfoundation.org
> Subject: VM Maker: VMMaker.oscog-eem.1962.mcz
> Message-Id: <E1bzBtl-0000dJ-Sn at andreas>
> 
> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1962.mcz
> 
> ==================== Summary ====================
> 
> Name: VMMaker.oscog-eem.1962
> Author: eem
> Time: 25 October 2016, 5:15:43.777031 pm
> UUID: acd846c2-7b7a-418a-9bf7-dc40c88aadff
> Ancestors: VMMaker.oscog-eem.1961
> 
> Fix subscripting in the interpreter for 64 & 16-bit indexable word arrays.
> 
> Fix primitiveVMProfileSamplesInto for 64-bit sample buffers.
> 
> Fix a return type clash for Spur64BitMemoryManager>>floatObjectOf:.
> 
> =============== Diff against VMMaker.oscog-eem.1961 ===============
> 
> Item was changed:
>  ----- Method: InterpreterPrimitives>>primitiveVMProfileSamplesInto (in category 'process primitives') -----
>  primitiveVMProfileSamplesInto
>  	"Primitive.
>  	 0 args: Answer whether the VM Profiler is running or not.
>  	 1 arg:	Copy the sample data into the supplied argument, which must be a Bitmap
>  			of suitable size. Answer the number of samples copied into the buffer."
> + 	| sampleBuffer running bufferSize numSamples |
> - 	| sampleBuffer sampleBufferAddress running bufferSize numSamples |
>  	<var: #bufferSize type: #long>
> + 	self ioNewProfile: (self addressOf: running put: [:v| running := v])
> + 		Status: (self addressOf: bufferSize put: [:v| bufferSize := v]).
> - 	<var: #sampleBufferAddress type: #'unsigned long *'>
> - 	self cCode: 'ioNewProfileStatus(&running,&bufferSize)'
> - 		inSmalltalk: [running := false. bufferSize := 0].
>  	argumentCount = 0 ifTrue:
>  		[^self pop: 1 thenPushBool: running].
> + 	argumentCount = 1 ifFalse:
> + 		[^self primitiveFailFor: PrimErrBadNumArgs].
> + 	sampleBuffer := self stackValue: 0.
> + 	((objectMemory isNonImmediate: sampleBuffer)
> + 	 and: [(objectMemory isPureBitsNonImm: sampleBuffer)
> + 	 and: [(objectMemory numBytesOf: sampleBuffer) >= (bufferSize * objectMemory wordSize)]]) ifFalse:
> + 		[^self primitiveFailFor: PrimErrBadArgument].
> + 	numSamples := self ioNewProfileSamplesInto: (objectMemory firstFixedField: sampleBuffer).
> - 	self success: argumentCount = 1.
> - 	self successful ifTrue:
> - 		[sampleBuffer := self stackObjectValue: 0].
> - 	self successful ifTrue:
> - 		[self assertClassOf: sampleBuffer is: (objectMemory splObj: ClassBitmap).
> - 		 self success: (objectMemory numSlotsOf: sampleBuffer) >= bufferSize].
> - 	self successful ifFalse:
> - 		[^nil].
> - 	sampleBufferAddress := objectMemory firstFixedField: sampleBuffer.
> - 	numSamples := self cCode: 'ioNewProfileSamplesInto(sampleBufferAddress)'
> - 						inSmalltalk: [sampleBufferAddress := sampleBufferAddress].
>  	self pop: argumentCount + 1 thenPushInteger: numSamples!
> 
> Item was added:
> + ----- Method: ObjectMemory>>isPureBitsFormat: (in category 'header formats') -----
> + isPureBitsFormat: format
> + 	^format >= self firstLongFormat
> + 	  and: [format < self firstCompiledMethodFormat]!
> 
> Item was added:
> + ----- Method: ObjectMemory>>isPureBitsNonImm: (in category 'object format') -----
> + isPureBitsNonImm: objOop
> + 	"Answer if the argument contains only indexable words (no oops). See comment in formatOf:"
> + 
> + 	^self isPureBitsFormat: (self formatOf: objOop)!
> 
> Item was changed:
>  ----- Method: Spur64BitMemoryManager>>smallFloatObjectOf: (in category 'interpreter access') -----
>  smallFloatObjectOf: aFloat
>  	"Encode the argument, aFloat in the SmallFloat range, as a tagged small float.
>  	 See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
> 
>  	 Encode:				[1s][     11 exponent     ][52mantissa] 
>  	 rot sign:				[     11 exponent     ][52mantissa][1s] 
>  	 sub exponent offset:	[ 000 ][8expsubset][52 mantissa][1s] 
>  	 shift:					[8expsubset][52 mantissa][1s][ 000 ] 
>  	 or/add tags:			[8expsubset][52mantissa][1s][3tags]"
>  	<inline: true>
> + 	<returnTypeC: #sqInt>
>  	<var: #aFloat type: #double>
>  	| rawFloat rot |
>  	<var: #rawFloat type: #usqLong>
>  	<var: #rot type: #usqLong>
>  	self assert: (self isSmallFloatValue: aFloat).
>  	self
>  		cCode: [self mem: (self addressOf: rawFloat) cp: (self addressOf: aFloat) y: (self sizeof: rawFloat)]
>  		inSmalltalk: [rawFloat := (aFloat at: 1) << 32 + (aFloat at: 2)].
>  	rot := self rotateLeft: rawFloat.
>  	rot > 1 ifTrue: "a.k.a. ~= +/-0.0"
>  		[rot := rot - (self smallFloatExponentOffset << (self smallFloatMantissaBits + 1)).
>  		 self assert: rot > 0].
>  	^self cCode: [rot << self numTagBits + self smallFloatTag]
>  		inSmalltalk: [((rot << self numTagBits) bitAnd: 16rFFFFFFFFFFFFFFFF) + self smallFloatTag]!
> 
> Item was added:
> + ----- Method: SpurMemoryManager>>isPureBitsNonImm: (in category 'object testing') -----
> + isPureBitsNonImm: objOop
> + 	"Answer if the argument contains only indexable words (no oops). See comment in formatOf:"
> + 
> + 	^self isPureBitsFormat: (self formatOf: objOop)!
> 
> Item was changed:
>  ----- Method: StackInterpreter>>commonVariable:at:cacheIndex: (in category 'indexing primitive support') -----
>  commonVariable: rcvr at: index cacheIndex: atIx 
>  	"This code assumes the receiver has been identified at location atIx in the atCache."
>  	| stSize fmt fixedFields result |
>  	<inline: true>
>  	stSize := atCache at: atIx+AtCacheSize.
>  	((self oop: index isGreaterThanOrEqualTo: 1)
>  	 and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
>  		[fmt := atCache at: atIx+AtCacheFmt.
>  		 fmt <= objectMemory weakArrayFormat ifTrue:
>  			[self assert: (objectMemory isContextNonImm: rcvr) not.
>  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
>  			 ^objectMemory fetchPointer: index + fixedFields - 1 ofObject: rcvr].
> + 		 fmt < objectMemory firstByteFormat ifTrue: "64, 32, & 16 bits"
> + 			[objectMemory hasSpurMemoryManagerAPI ifTrue:
> + 				[fmt >= objectMemory firstShortFormat ifTrue:
> + 					[^objectMemory integerObjectOf:
> + 						(objectMemory fetchShort16: index - 1 ofObject: rcvr)].
> + 				 fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
> + 					[^self positive64BitIntegerFor:
> + 						(objectMemory fetchLong64: index - 1 ofObject: rcvr)]].
> + 			 result := objectMemory fetchLong32: index - 1 ofObject: rcvr.
> - 		 fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
> - 			[result := objectMemory fetchLong32: index - 1 ofObject: rcvr.
>  			 ^self positive32BitIntegerFor: result].
>  		 fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
>  			ifTrue: "String"
> + 				["Spur supports the String at:[put:] primitives on WideString and DoubleByteString"
> - 				["Spur supports the String at:[put:] primitives on WideString"
>  				 result := (objectMemory hasSpurMemoryManagerAPI
> + 							and: [fmt < (objectMemory firstByteFormat + objectMemory firstStringyFakeFormat)])
> + 								ifTrue:
> + 									[fmt < (objectMemory firstShortFormat + objectMemory firstStringyFakeFormat)
> + 										ifTrue: [objectMemory fetchLong32: index - 1 ofObject: rcvr]
> + 										ifFalse: [objectMemory fetchShort16: index - 1 ofObject: rcvr]]
> - 							and: [fmt - objectMemory firstStringyFakeFormat < objectMemory firstByteFormat])
> - 								ifTrue: [objectMemory fetchLong32: index - 1 ofObject: rcvr]
>  								ifFalse: [objectMemory fetchByte: index - 1 ofObject: rcvr].
>  				^self characterForAscii: result]
>  			ifFalse:
>  				[(fmt < objectMemory firstCompiledMethodFormat "ByteArray"
>  				  or: [index >= (self firstByteIndexOfMethod: rcvr) "CompiledMethod"]) ifTrue:
>  					[^objectMemory integerObjectOf: (objectMemory fetchByte: index - 1 ofObject: rcvr)]]].
> 
>  	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
>  								ifFalse: [PrimErrBadReceiver]
>  								ifTrue: [PrimErrBadIndex])!
> 
> Item was changed:
>  ----- Method: StackInterpreter>>commonVariable:at:put:cacheIndex: (in category 'indexing primitive support') -----
>  commonVariable: rcvr at: index put: value cacheIndex: atIx
>  	"This code assumes the receiver has been identified at location atIx in the atCache."
>  	| stSize fmt fixedFields valToPut isCharacter |
>  	<inline: true>
>  	stSize := atCache at: atIx+AtCacheSize.
>  	((self oop: index isGreaterThanOrEqualTo: 1)
>  	  and: [self oop: index isLessThanOrEqualTo: stSize]) ifTrue:
>  		[fmt := atCache at: atIx+AtCacheFmt.
>  		fmt <= objectMemory weakArrayFormat ifTrue:
>  			[self assert: (objectMemory isContextNonImm: rcvr) not.
>  			 fixedFields := atCache at: atIx+AtCacheFixedFields.
>  			 ^objectMemory storePointer: index + fixedFields - 1 ofObject: rcvr withValue: value].
> + 		fmt < objectMemory firstByteFormat ifTrue:  "64, 32, & 16 bits"
> + 			[objectMemory hasSpurMemoryManagerAPI ifTrue:
> + 				[fmt >= objectMemory firstShortFormat ifTrue:
> + 					[valToPut := (objectMemory isIntegerObject: value)
> + 									ifTrue: [objectMemory integerValueOf: value]
> + 									ifFalse: [-1].
> + 					(valToPut >= 0 and: [valToPut <= 65535]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
> + 					^objectMemory storeShort16: index - 1 ofObject: rcvr withValue: valToPut].
> + 				 fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
> + 					[| val64ToPut |
> + 					 val64ToPut := self positive64BitValueOf: value.
> + 					 self successful ifTrue:
> + 						[^objectMemory storeLong64: index - 1 ofObject: rcvr withValue: val64ToPut].
> + 					 ^self primitiveFailFor: PrimErrBadArgument]].
> + 			 valToPut := self positive32BitValueOf: value.
> - 		fmt < objectMemory firstByteFormat ifTrue:  "Bitmap"
> - 			[valToPut := self positive32BitValueOf: value.
>  			 self successful ifTrue:
>  				[^objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut].
>  			 ^self primitiveFailFor: PrimErrBadArgument].
>  		fmt >= objectMemory firstStringyFakeFormat  "Note fmt >= firstStringyFormat is an artificial flag for strings"
>  			ifTrue:
>  				[isCharacter := objectMemory isCharacterObject: value.
>  				 isCharacter ifFalse:
>  					[^self primitiveFailFor: PrimErrBadArgument].
>  				 objectMemory hasSpurMemoryManagerAPI
>  					ifTrue: [valToPut := objectMemory characterValueOf: value]
>  					ifFalse:
>  						[valToPut := objectMemory fetchPointer: CharacterValueIndex ofObject: value.
>  						 valToPut := (objectMemory isIntegerObject: valToPut)
>  										ifTrue: [objectMemory integerValueOf: valToPut]
>  										ifFalse: [-1]].
> + 				 objectMemory hasSpurMemoryManagerAPI ifTrue:
> + 				 	[fmt < (objectMemory firstByteFormat + objectMemory firstStringyFakeFormat) ifTrue:
> + 						[fmt < (objectMemory firstShortFormat + objectMemory firstStringyFakeFormat)
> + 							ifTrue:
> + 								[self assert: fmt ~= (objectMemory sixtyFourBitIndexableFormat + objectMemory firstStringyFakeFormat).
> + 								 ^objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut]
> + 							ifFalse:
> + 								[(valToPut >= 0 and: [valToPut <= 65535]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
> + 								 ^objectMemory storeShort16: index - 1 ofObject: rcvr withValue: valToPut]]]]
> - 				 (objectMemory hasSpurMemoryManagerAPI
> - 				  and: [fmt - objectMemory firstStringyFakeFormat < objectMemory firstByteFormat]) ifTrue:
> - 					[^objectMemory storeLong32: index - 1 ofObject: rcvr withValue: valToPut]]
>  			ifFalse:
>  				[(fmt >= objectMemory firstCompiledMethodFormat
>  				  and: [index < (self firstByteIndexOfMethod: rcvr)]) ifTrue:
>  					[^self primitiveFailFor: PrimErrBadIndex].
>  				valToPut := (objectMemory isIntegerObject: value)
>  								ifTrue: [objectMemory integerValueOf: value]
>  								ifFalse: [-1]].
> + 		(valToPut >= 0 and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
> - 		((valToPut >= 0) and: [valToPut <= 255]) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
>  		^objectMemory storeByte: index - 1 ofObject: rcvr withValue: valToPut].
> 
>  	^self primitiveFailFor: ((objectMemory isIndexable: rcvr)
>  								ifFalse: [PrimErrBadReceiver]
>  								ifTrue: [PrimErrBadIndex])!
> 
> Item was changed:
>  ----- Method: StackInterpreter>>subscript:with:format: (in category 'indexing primitive support') -----
>  subscript: array with: index format: fmt
>  	"Note: This method assumes that the index is within bounds!!"
> 
>  	<inline: true>
>  	fmt <= objectMemory lastPointerFormat ifTrue:
>  		[^objectMemory fetchPointer: index - 1 ofObject: array].
>  	fmt >= objectMemory firstByteFormat ifTrue:
>  		[^objectMemory integerObjectOf:
>  			(objectMemory fetchByte: index - 1 ofObject: array)].
> + 	objectMemory hasSpurMemoryManagerAPI ifTrue:
> + 		[fmt >= objectMemory firstShortFormat ifTrue:
> + 			[^objectMemory integerObjectOf:
> + 				(objectMemory fetchShort16: index - 1 ofObject: array)].
> + 		 fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
> + 			[^self positive64BitIntegerFor:
> + 				(objectMemory fetchLong64: index - 1 ofObject: array)]].
> + 	"32bit-word type objects; for now assume no 64-bit indexable objects"
> - 	(objectMemory hasSpurMemoryManagerAPI
> - 	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
> - 		[^objectMemory integerObjectOf:
> - 			(objectMemory fetchShort16: index - 1 ofObject: array)].
> - 	"double-word type objects; for now assume no 64-bit indexable objects"
>  	^self positive32BitIntegerFor:
>  			(objectMemory fetchLong32: index - 1 ofObject: array)!
> 
> Item was changed:
>  ----- Method: StackInterpreter>>subscript:with:storing:format: (in category 'indexing primitive support') -----
>  subscript: array with: index storing: oopToStore format: fmt 
>  	"Note: This method assumes that the index is within bounds!!"
>  	| signedValueToStore unsignedValueToStore |
>  	<inline: true>
>  	fmt <= objectMemory lastPointerFormat ifTrue:
>  		[objectMemory storePointer: index - 1 ofObject: array withValue: oopToStore.
>  		 ^self].
>  	fmt >= objectMemory firstByteFormat ifTrue:
>  		[(objectMemory isIntegerObject: oopToStore) ifFalse:
>  			[primFailCode := PrimErrBadArgument.
>  			 ^self].
>  		 signedValueToStore := objectMemory integerValueOf: oopToStore.
>  		 (signedValueToStore >= 0 and: [signedValueToStore <= 255]) ifFalse:
>  			[primFailCode := PrimErrBadArgument.
>  			 ^self].
>  		 objectMemory storeByte: index - 1 ofObject: array withValue: signedValueToStore.
>  		 ^self].
> + 	objectMemory hasSpurMemoryManagerAPI ifTrue:
> + 		[fmt >= objectMemory firstShortFormat ifTrue:
> + 			[(objectMemory isIntegerObject: oopToStore) ifFalse:
> + 				[primFailCode := PrimErrBadArgument.
> + 				 ^self].
> + 			 signedValueToStore := objectMemory integerValueOf: oopToStore.
> + 			 (signedValueToStore >= 0 and: [signedValueToStore <= 65535]) ifFalse:
> + 				[primFailCode := PrimErrBadArgument.
> + 				 ^self].
> + 			 objectMemory storeShort16: index - 1 ofObject: array withValue: signedValueToStore.
> - 	(objectMemory hasSpurMemoryManagerAPI
> - 	 and: [fmt >= objectMemory firstShortFormat]) ifTrue:
> - 		[(objectMemory isIntegerObject: oopToStore) ifFalse:
> - 			[primFailCode := PrimErrBadArgument.
>  			 ^self].
> + 		 fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
> + 			[| unsigned64BitValueToStore |
> + 			 unsigned64BitValueToStore := self positive64BitValueOf: oopToStore.
> + 			 self successful ifTrue:
> + 				[objectMemory storeLong64: index - 1 ofObject: array withValue: unsigned64BitValueToStore].
> + 			 ^self]].
> + 	"32bit-word type objects"
> - 		 signedValueToStore := objectMemory integerValueOf: oopToStore.
> - 		 (signedValueToStore >= 0 and: [signedValueToStore <= 65535]) ifFalse:
> - 			[primFailCode := PrimErrBadArgument.
> - 			 ^self].
> - 		 objectMemory storeShort16: index - 1 ofObject: array withValue: signedValueToStore.
> - 		 ^self].
> - 	"double-word type objects; for now assume no 64-bit indexable objects"
>  	unsignedValueToStore := self positive32BitValueOf: oopToStore.
>  	self successful ifTrue:
>  		[objectMemory storeLong32: index - 1 ofObject: array withValue: unsignedValueToStore]!
> 



More information about the Vm-dev mailing list