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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 7 02:40:48 UTC 2021


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

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

Name: VMMaker.oscog-eem.3060
Author: eem
Time: 6 September 2021, 7:40:34.416094 pm
UUID: 638e8714-df7b-4450-85ee-b5093d25822d
Ancestors: VMMaker.oscog-eem.3059

Fix a regression in image segment loading introduced by VMMaker.oscog-eem.2819.  The old image segment array shortening code created a header ambiguous with a slimbridge if the array was in new space.  In this case we also have to shorten the array's normal slot count so its header is taken as a slimbridge.

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

Item was changed:
  ----- Method: Spur32BitMemoryManager>>objectAfterMaybeSlimBridge:limit: (in category 'object enumeration-private') -----
  objectAfterMaybeSlimBridge: objOop limit: limit
  	"Object parsing.
  	1. all objects have at least a word following the header, for a forwarding pointer.
  	2. objects with an overflow size have a preceding word with a saturated numSlots.  If the word
  	   following an object doesn't have a saturated numSlots field it must be a single-header object.
  	   If the word following does have a saturated numSlots it must be the overflow size word.
  	This variation on objectAfter:limit: allows for a single (64-bit) word bridge which may be needed
  	to bridge from an almost full pastSpace to eden.  It is only used in the flat enumerators that use
  	startAddressForBridgedHeapEnumeration and enumerate over pastSpace, eden and oldSpace
  	in that order.  Note that the order for allObjects, and allInstances enumerates over oldSpace first.
  
  	This hack is cheap.  It increases the size of the objectAfter code, but saves two extra copies of
  	the inner loop, since the inner loop now enumerates over all of pastSpace, eden and oldSpace.
  	The test for a slim bridge is only performed if applied to an overflow header, and typically only
+ 	1 in 400 objects have overflow headers in 32-bits, 1 in 500 in 64-bits.  The complication is that
- 	 1 in 400 objects have overflow headers in 32-bits, 1 in 500 in 64-bits.  The complication is that
  	image segment loading evaporates the word array by setting the overflow slots to 1, and this
+ 	is ambiguous with a slimbridge.  The resolution is that if the segmentArray has an overflow header,
+ 	and is in new space, then it slot size can be zeroed and its overflow header changed to a slimbridge."
- 	is ambiguous with a slimbridge.  The resolution is that slimbridges are used only in new space."
  	<inline: true>
  	| followingWordAddress followingWord |
  	followingWordAddress := self addressAfter: objOop.
  	(self oop: followingWordAddress isGreaterThanOrEqualTo: limit) ifTrue:
  		[^limit].
  	self flag: #endianness.
  	followingWord := self longAt: followingWordAddress + 4.
  	^followingWord >> self numSlotsHalfShift = self numSlotsMask
  		ifTrue: [((self oop: objOop isLessThan: oldSpaceStart)
  				 and: [1 = (self longAt: followingWordAddress)]) "i.e. the raw overflow slots in the overflow word"
  					ifTrue: [followingWordAddress + self baseHeaderSize + self baseHeaderSize] "skip the one word slimbridge"
  					ifFalse: [followingWordAddress + self baseHeaderSize]]
  		ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>objectAfterMaybeSlimBridge:limit: (in category 'object enumeration-private') -----
  objectAfterMaybeSlimBridge: objOop limit: limit
  	"Object parsing.
  	1. all objects have at least a word following the header, for a forwarding pointer.
  	2. objects with an overflow size have a preceding word with a saturated numSlots.  If the word
  	   following an object doesn't have a saturated numSlots field it must be a single-header object.
  	   If the word following does have a saturated numSlots it must be the overflow size word.
  	This variation on objectAfter:limit: allows for a single (64-bit) word bridge which may be needed
  	to bridge from an almost full pastSpace to eden.  It is only used in the flat enumerators that use
  	startAddressForBridgedHeapEnumeration and enumerate over pastSpace, eden and oldSpace
  	in that order.  Note that the order for allObjects, and allInstances enumerates over oldSpace first.
  
  	This hack is cheap.  It increases the size of the objectAfter code, but saves two extra copies of
  	the inner loop, since the inner loop now enumerates over all of pastSpace, eden and oldSpace.
  	The test for a slim bridge is only performed if applied to an overflow header, and typically only
  	1 in 400 objects have overflow headers in 32-bits, 1 in 500 in 64-bits.  The complication is that
  	image segment loading evaporates the word array by setting the overflow slots to 1, and this
+ 	is ambiguous with a slimbridge.  The resolution is that if the segmentArray has an overflow header,
+ 	and is in new space, then it slot size can be zeroed and its overflow header changed to a slimbridge."
- 	is ambiguous with a slimbridge.  The resolution is that slimbridges are used only in new space."
  	<inline: true>
  	| followingWordAddress followingWord |
  	followingWordAddress := self addressAfter: objOop.
  	(self oop: followingWordAddress isGreaterThanOrEqualTo: limit) ifTrue:
  		[^limit].
  	self flag: #endianness.
  	followingWord := self longAt: followingWordAddress.
  	^followingWord >> self numSlotsFullShift = self numSlotsMask
  		ifTrue:
  			[((self oop: objOop isLessThan: oldSpaceStart)
  			 and: [(followingWord bitAnd: 16rFFFFFFFFFFFFFF) = 1])
  				ifTrue: [followingWordAddress + self baseHeaderSize + self baseHeaderSize] "skip the one word slimbridge"
  				ifFalse: [followingWordAddress + self baseHeaderSize]]
  		ifFalse: [followingWordAddress]!

Item was changed:
  ----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'image segment in/out') -----
  loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray
  	"This primitive is called from Smalltalk as...
  		<imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
  
  	"This primitive will load a binary image segment created by primitiveStoreImageSegment.
  	 It expects the outPointer array to be of the proper size, and the wordArray to be well formed.
  	 It will return as its value the original array of roots, and the segmentWordArray will become an
  	 array of the loaded objects.  If this primitive should fail, the segmentWordArray will, sadly, have
  	 been reduced to an unrecognizable and unusable jumble.  But what more could you have done
  	 with it anyway?
  
  	 The primitive, if it succeeds, also becomes the segmentWordArray into the array of loaded objects.
  	 This allows fixing up of loaded objects directly, without nextObject, which Spur doesn't support."
  
  	<inline: #never>
  	| segmentLimit segmentStart segVersion errorCode numLoadedObjects loadedObjectsArray |
  
  	segmentLimit := self numSlotsOf: segmentWordArray.
  	(self objectBytesForSlots: segmentLimit) < (self allocationUnit "version info" + self baseHeaderSize "one object header") ifTrue:
  		[^PrimErrBadArgument halt].
  
  	"Verify format.  If the format is wrong, word-swap (since ImageSegment data are 32-bit longs).
  	 If it is still wrong, undo the damage and fail."
  	segVersion := self longAt: segmentWordArray + self baseHeaderSize.
  	(coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse:
  		[self reverseBytesIn32BitWordsIn: segmentWordArray.
  		 segVersion := self longAt: segmentWordArray + self baseHeaderSize.
  		 (coInterpreter readableFormat: (segVersion bitAnd: 16rFFFFFF "low 3 bytes")) ifFalse:
  			[self reverseBytesIn32BitWordsIn: segmentWordArray.
  			 ^PrimErrBadArgument halt]].
  
  	segmentStart := segmentWordArray + self baseHeaderSize + self allocationUnit.
  	segmentLimit := segmentLimit * self bytesPerOop + segmentWordArray + self baseHeaderSize.
  
  	"Notionally reverse the Byte type objects if the data is from opposite endian machine.
  	 Test top byte.  $d on the Mac or $s on the PC.  Rest of word is equal.  If Spur is ever
  	 ported to big-endian machines then the segment may have to be byte/word swapped,
  	 but so far it only runs on little-endian machines, so for now just fail if endianness is wrong."
  	self flag: #endianness.
  	(segVersion >> 24 bitAnd: 16rFF) ~= (self imageSegmentVersion >> 24 bitAnd: 16rFF) ifTrue:
  		"Reverse the byte-type objects once"
  		[true
  			ifTrue: [^PrimErrBadArgument halt]
  			ifFalse:
  				[self byteSwapByteObjectsFrom: (self objectStartingAt: segmentStart)
  					to: segmentLimit
  					flipFloatsIf: false]].
  
  	"Avoid having to remember by arranging that there are no young outPointers if segment is in old space."
  	(self isOldObject: segmentWordArray) ifTrue:
  		[errorCode := self ensureNoNewObjectsIn: outPointerArray.
  		 errorCode ~= 0 ifTrue:
  			[^errorCode]].
  
  	"scan through mapping oops and validating class references. Defer entering any
  	 class objects into the class table and/or pinning objects until a second pass."
  	errorCode := self mapOopsAndValidateClassRefsFrom: segmentStart to: segmentLimit outPointers: outPointerArray.
  	errorCode > 0 ifTrue:
  		[^errorCode].
  	numLoadedObjects := errorCode negated.
  	loadedObjectsArray := self allocateSlots: numLoadedObjects format: self arrayFormat classIndex: ClassArrayCompactIndex.
  	loadedObjectsArray ifNil:
  		[^PrimErrNoMemory halt].
  
  	"Scan for classes contained in the segment, entering them into the class table.
  	 Classes are at the front, after the root array and have the remembered bit set."
  	errorCode := self enterClassesIntoClassTableFrom: segmentStart to: segmentLimit.
  	errorCode ~= 0 ifTrue:
  		[^errorCode].
  
  	"Make a final pass, assigning class indices and/or pinning pinned objects and collecting the loaded objects in loadedObjectsArray"
  	self assignClassIndicesAndPinFrom: segmentStart to: segmentLimit outPointers: outPointerArray filling: loadedObjectsArray.
  
  	"Evaporate the container, leaving the newly loaded objects in place."
  	(self hasOverflowHeader: segmentWordArray)
+ 		ifTrue: "N.B. setting the overflow slots to 1 creates a slimbridge in eden, so we also need to delete the overflow slot count in the segment itself"
+ 			[(self oop: segmentWordArray isLessThan: oldSpaceStart)
+ 				ifTrue:
+ 					[self rawOverflowSlotsOf: segmentWordArray put: 0.
+ 					 self rawNumSlotsOf: segmentWordArray put: 0]
+ 				ifFalse:
+ 					[self rawOverflowSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop]]
- 		ifTrue: [self rawOverflowSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop]
  		ifFalse: [self rawNumSlotsOf: segmentWordArray put: self allocationUnit / self bytesPerOop].
  
  	"Finally forward the segmentWordArray to the loadedObjectsArray"
  	self forward: segmentWordArray to: loadedObjectsArray.
  	
  	self runLeakCheckerFor: GCCheckImageSegment.
  
  	^self objectStartingAt: segmentStart!



More information about the Vm-dev mailing list