[Vm-dev] VM Maker: VMMaker-dtl.339.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jan 27 20:34:29 UTC 2014 

David T. Lewis uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-dtl.339.mcz

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

Name: VMMaker-dtl.339
Author: dtl
Time: 27 January 2014, 3:23:29.887 pm
UUID: e3da01c0-18c5-4297-9fc2-3fc56d5db9d6
Ancestors: VMMaker-dtl.338

VMMaker 4.13.1

Add primitiveAllObjects, answering an array of all objects in the object memory at the time of calling the primitive, possibly excluding those that were garbage collected as a side effect of allocating the result array for the primitive.

Fix comment for ObjectMemory>>lengthOf:baseHeader:format: to indicate that length includes the fixed fields as well as indexable fields (the length of an OrderedCollection instance is 3, not 0).

Add shorten:toIndexableSize: with error checks and correct size logic for long arrays. Change the return value to be the number of bytes released to free memory, allowing sender to test for success. The implementation for ClassicObjectMemory is tested for both 32-bit and 64-bit object memories. The implementation for NewObjectMemory is based on this, but has not been tested.

Add primitiveTestShortenIndexableSize to allow shorten:toIndexableSize: to be exercised from the image. This primitive is for testing purposes only and will probably be removed in the future.

FT2Plugin to external plugins in VMMakerTool class>>defaultUnixSpec because some platforms (e.g. OS X) may not have the runtime library conveniently available.

=============== Diff against VMMaker-dtl.338 ===============

Item was changed:
  ----- Method: ClassicObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
  shorten: obj toIndexableSize: nSlots
+ 	"Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the
+ 	unused residual to a free chunk. Word and byte indexable objects are not changed.
+ 	Answer the number of bytes returned to free memory, which may be zero if no change
+ 	was possible."
+ 	| deltaBytes desiredLength fixedFields fmt hdr totalLength
+ 	 indexableFields |
+ 	(self isPointersNonInt: obj) ifFalse: [^0].
+ 	nSlots >  0
+ 		ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative"
- 	"Currently this works for pointer objects only, and is almost certainly wrong for 64 bits."
- 	| deltaBytes desiredLength fixedFields fmt hdr totalLength |
- 	(self isPointersNonInt: obj) ifFalse:
- 		[^obj].
  	hdr := self baseHeader: obj.
  	fmt := self formatOfHeader: hdr.
  	totalLength := self lengthOf: obj baseHeader: hdr format: fmt.
  	fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength.
+ 	indexableFields := totalLength - fixedFields.
+ 	nSlots >= indexableFields
+ 		ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk"
+ 	desiredLength := fixedFields + nSlots.		
- 	
- 	self cCode: '  printf("fixedFields is %d\n", fixedFields); fflush(stdout)  '.
- 	self cCode: '  printf("nSlots is %d\n", nSlots); fflush(stdout)  '.
- 	
- 	desiredLength := fixedFields + nSlots.
  	deltaBytes := (totalLength - desiredLength) * self bytesPerWord.
- 	
- 	self cCode: '  printf("desiredLength is %d\n", desiredLength); fflush(stdout)  '.
- 	self cCode: '  printf("deltaBytes is %d\n", deltaBytes); fflush(stdout)  '.
- 	
  	self setSizeOfFree: obj + self baseHeaderSize + (desiredLength * self bytesPerWord)
  		to: deltaBytes.
  	(self headerType: obj) caseOf:	{
  		[HeaderTypeSizeAndClass] ->
+ 			[self longAt: (obj - (self baseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes].
- 			[
- 				self cCode: '  printf("HeaderTypeSizeAndClass\n"); fflush(stdout)  '.
- 
- 			self longAt: obj put: hdr - deltaBytes].
  		[HeaderTypeClass] ->
+ 			[self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)].
- 			[
- 				self cCode: '  printf("HeaderTypeClass\n"); fflush(stdout)  '.
- 
- 			self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)].
  		[HeaderTypeShort] ->
+ 			[self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)] }.
+ 	^deltaBytes!
- 			[
- 				self cCode: '  printf("HeaderTypeShort\n"); fflush(stdout)  '.
- 
- 			self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)] }.
- 	^obj!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveAllObjects (in category 'object access primitives') -----
+ primitiveAllObjects
+ 	"Answer an array of all objects that exist when the primitive is called, excluding those
+ 	that may be garbage collected as a side effect of allocating the result array. The array
+ 	will contain at least one trailing integer zero that serves as a marker for end of valid
+ 	object references. Additional trailing zeros represent objects that were garbage
+ 	collected during execution of this primitive. Sender is responsible for ignoring all
+ 	trailing zero marker objects in the result array."
+ 
+ 	<export: true>
+ 	| count obj resultArray newCount |
+ 	self pop: argumentCount+1.
+ 	"Count the currently accessible objects"
+ 	count := 0.
+ 	obj := objectMemory firstAccessibleObject.
+ 	[obj = nil] whileFalse:
+ 		[count := count + 1.
+ 		obj := objectMemory accessibleObjectAfter: obj].
+ 	"Allocate result array, may cause GC"
+ 	resultArray := objectMemory instantiateClass: objectMemory classArray indexableSize: count.
+ 	resultArray = nil ifTrue:
+ 		[^self primitiveFailFor: PrimErrNoMemory].
+ 	"Store all objects in result array, excluding any reference to the result array 
+ 	itself, as may happen if garbage collection occurred during allocation of the array."
+ 	newCount := 0.
+ 	obj := objectMemory firstAccessibleObject.
+ 	[obj = nil or: [newCount >= count]] whileFalse:
+ 		[obj == resultArray
+ 			ifFalse: [newCount := newCount + 1.
+ 				self stObject: resultArray at: newCount put: obj ].
+ 		obj := objectMemory accessibleObjectAfter: obj].
+ 	"If GC occurred during result array allocation, truncate unused portion of result array"
+ 	newCount < count
+ 		ifTrue: [self shorten: resultArray toIndexableSize: newCount].
+ 	self push: resultArray!

Item was added:
+ ----- Method: InterpreterPrimitives>>primitiveTestShortenIndexableSize (in category 'object access primitives') -----
+ primitiveTestShortenIndexableSize
+ 	"Given an object with indexable pointer fields, reduce the size of the indexable fields
+ 	to the requested size. Answer the number of bytes freed, or zero if the object cannot
+ 	be shortened."
+ 
+ 	<export: true>
+ 	| array newSize bytesFreed |
+ 	newSize := self stackIntegerValue: 0.
+ 	array := self stackValue: 1.
+ 	self pop: argumentCount + 1.
+ 	bytesFreed := self shorten: array toIndexableSize: newSize.
+ 	self pushInteger: bytesFreed!

Item was added:
+ ----- Method: NewObjectMemory>>maybeFillWithAllocationCheckFillerFrom:to: (in category 'allocation') -----
+ maybeFillWithAllocationCheckFillerFrom: start to: end
+ 	"Fill free memory with a bit pattern for checking if the last object has been overwritten."
+ 	<inline: true>
+ 	<var: 'start' type: #usqInt>
+ 	<var: 'end' type: #usqInt>
+ 	<var: 'i' type: #usqInt>
+ 	AllocationCheckFiller ~= 0 ifTrue:
+ 		[start to: end by: self bytesPerWord do:
+ 			[:i|
+ 			self longAt: i put: (AllocationCheckFiller = 16rADD4E55
+ 									ifTrue: [i]
+ 									ifFalse: [AllocationCheckFiller])]]!

Item was changed:
  ----- Method: NewObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
  shorten: obj toIndexableSize: nSlots
+ 	"Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the
+ 	unused residual to a free chunk. Word and byte indexable objects are not changed.
+ 	Answer the number of bytes returned to free memory, which may be zero if no change
+ 	was possible."
+ 	| deltaBytes desiredLength fixedFields fmt hdr totalLength
+ 	 indexableFields |
+ 	(self isPointersNonInt: obj) ifFalse: [^0].
+ 	nSlots >  0
+ 		ifFalse: [^0]. "no change if nSlots is zero, error if nSlots is negative"
- 	"Currently this works for pointer objects only, and is almost certainly wrong for 64 bits."
- 	| deltaBytes desiredLength fixedFields fmt hdr totalLength |
- 	(self isPointersNonImm: obj) ifFalse:
- 		[^obj].
  	hdr := self baseHeader: obj.
  	fmt := self formatOfHeader: hdr.
  	totalLength := self lengthOf: obj baseHeader: hdr format: fmt.
  	fixedFields := self fixedFieldsOf: obj format: fmt length: totalLength.
+ 	indexableFields := totalLength - fixedFields.
+ 	nSlots >= indexableFields
+ 		ifTrue: [^0]. "no change, or error if attempting to increase size into next chunk"
+ 	desiredLength := fixedFields + nSlots.		
- 	desiredLength := fixedFields + nSlots.
  	deltaBytes := (totalLength - desiredLength) * self bytesPerWord.
  	obj + self baseHeaderSize + (totalLength * self bytesPerWord) = freeStart
  		ifTrue: "Shortening the last object.  Need to reduce freeStart."
  			[self maybeFillWithAllocationCheckFillerFrom: obj + self baseHeaderSize + (desiredLength * self bytesPerWord) to: freeStart.
  			freeStart := obj + self baseHeaderSize + (desiredLength * self bytesPerWord)]
  		ifFalse: "Shortening some interior object.  Need to create a free block."
  			[self setSizeOfFree: obj + self baseHeaderSize + (desiredLength * self bytesPerWord)
  				to: deltaBytes].
  	(self headerType: obj) caseOf:	{
  		[HeaderTypeSizeAndClass] ->
+ 			[self longAt: (obj - (self baseHeaderSize * 2)) put: (self sizeHeader: obj) - deltaBytes].
- 			[self longAt: obj put: hdr - deltaBytes].
  		[HeaderTypeClass] ->
  			[self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)].
  		[HeaderTypeShort] ->
  			[self longAt: obj put: ((hdr bitClear: self sizeMask) bitOr: (hdr bitAnd: self sizeMask) - deltaBytes)] }.
+ 	^deltaBytes!
- 	^obj!

Item was changed:
  ----- Method: ObjectMemory>>lengthOf:baseHeader:format: (in category 'indexing primitive support') -----
  lengthOf: oop baseHeader: hdr format: fmt
+ 	"Return the number of fixed and indexable bytes, words, or object pointers in the
+ 	given object. Assume the given oop is not an integer. For a CompiledMethod, the size
+ 	of the method header (in bytes) should be subtracted from the result of this method."
- 	"Return the number of indexable bytes or words in the given object. Assume the given oop is not an integer. For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result of this method."
  
  	| sz |
  	<inline: true>
  	<asmLabel: false> 
  	(hdr bitAnd: TypeMask) = HeaderTypeSizeAndClass
  		ifTrue: [ sz := (self sizeHeader: oop) bitAnd: self longSizeMask ]
  		ifFalse: [ sz := (hdr bitAnd: self sizeMask)].
  	sz := sz - (hdr bitAnd: self size4Bit).
  	fmt <= 4
  		ifTrue: [ ^ (sz - self baseHeaderSize) >> self shiftForWord "words"].
  	fmt < 8
  		ifTrue: [ ^ (sz - self baseHeaderSize) >> 2 "32-bit longs"]
  		ifFalse: [ ^ (sz - self baseHeaderSize) - (fmt bitAnd: 3) "bytes"]!

Item was changed:
  ----- Method: ObjectMemory>>shorten:toIndexableSize: (in category 'allocation') -----
  shorten: obj toIndexableSize: nSlots
+ 	"Reduce the number if indexable fields in obj, a pointer object, to nSlots. Convert the
+ 	unused residual to a free chunk. Word and byte indexable objects are not changed.
+ 	Answer the number of bytes returned to free memory, which may be zero if no change
+ 	was possible."
- 	"Shorten the length of a pointer object to nSlots, marking free memory and adjusting
- 	end of memory as required."
  
  	self subclassResponsibility!

Item was changed:
  ----- Method: VMMaker class>>versionString (in category 'version testing') -----
  versionString
  
  	"VMMaker versionString"
  
+ 	^'4.13.1'!
- 	^'4.12.14'!

Item was changed:
  ----- Method: VMMakerTool class>>defaultUnixSpec (in category 'configurations') -----
  defaultUnixSpec
  	"Typical VMMaker spec for a unix/linux target platform"
  
  	"VMMakerTool defaultUnixSpec"
  
  	^#(
  		#(	"internal plugins"
  			#ADPCMCodecPlugin
  			#AsynchFilePlugin
  			#BMPReadWriterPlugin
  			#BalloonEnginePlugin
  			#BitBltSimulation
  			#CroquetPlugin
  			#DSAPlugin
  			#DeflatePlugin
  			#DropPlugin
  			#FFTPlugin
- 			#FT2Plugin
  			#FilePlugin
  			#FloatArrayPlugin
  			#FloatMathPlugin
  			#GeniePlugin
  			#JPEGReadWriter2Plugin
  			#JPEGReaderPlugin
  			#JoystickTabletPlugin
  			#KlattSynthesizerPlugin
  			#LargeIntegersPlugin
  			#LocalePlugin
  			#MD5Plugin
  			#Matrix2x3Plugin
  			#MiscPrimitivePlugin
  			#RandPlugin
  			#RePlugin
  			#SHA256Plugin
  			#SecurityPlugin
  			#SerialPlugin
  			#SlangTestPlugin
  			#SlangTestSupportPlugin
  			#SocketPlugin
  			#SoundCodecPlugin
  			#SoundGenerationPlugin
  			#SoundPlugin
  			#StarSqueakPlugin
  			#SurfacePlugin
  		)
  		#(	"external plugins"
  			#B3DAcceleratorPlugin
  			#B3DEnginePlugin
  			#ClipboardExtendedPlugin
  			#DBusPlugin
  			#FFIPlugin
  			#FileCopyPlugin
+ 			#FT2Plugin
  			#GStreamerPlugin
  			#HostWindowPlugin
  			#KedamaPlugin
  			#KedamaPlugin2
  			#MIDIPlugin
  			#Mpeg3Plugin
  			#RomePlugin
  			#UUIDPlugin
  			#UnixAioPlugin
  			#UnixOSProcessPlugin
  			#XDisplayControlPlugin
  			#CameraPlugin
  			#ScratchPlugin
  			#UnicodePlugin
  			#WeDoPlugin
  			#SqueakSSLPlugin
  		)
  		true			"inline flag"
  		false			"forBrowser flag"
  		'unix'			"platform"
  		'src'			"source directory for generated sources"
  		'platforms'		"path to platform sources"
  		4				"unused, was bytesPerWord which is now a compile time definition"
  		true			"unused, was flag for source directtory pathname is relative"
  		true			"unused, was flag for platforms directory path is relative"
  		'Interpreter'	"interpreter class name"
  	)!

More information about the Vm-dev mailing list