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

commits at source.squeak.org commits at source.squeak.org
Fri May 2 20:33:08 UTC 2014


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

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

Name: VMMaker.oscog-eem.697
Author: eem
Time: 2 May 2014, 1:30:27.626 pm
UUID: af7829f5-a388-4a1e-8c9b-5b78abd46b67
Ancestors: VMMaker.oscog-eem.696

Spur pig compact:
Fix a bug in free list enumeration in pigCompact.
sortedFreeListPairwiseReverseDo: must cope with the case
where moving s run of objects alters the free list.

Fix a bug in moveARunOfObjectsStartingAt:upTo: which
would not move the first object if it was the only object
in a run.

Fix a bug in freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact
which could leave a free object with a 0 slot count, which
falls foul of the object enumeration invariant that a header
word must be all zeros (for catching wild missteps).

Fix a bug in sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact
which would cause it to miss lots of forwarders.

VMMaker:
Update generateAllSpurConfigurations to include Spur Cog Sista.

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

Item was changed:
  ----- Method: SpurMemoryManager>>eliminateAndFreeForwardersForPigCompact (in category 'gc - global') -----
  eliminateAndFreeForwardersForPigCompact
  	"As the final phase of global garbage collect, sweep the heap to follow
  	 forwarders, then free forwarders, coalescing with free space as we go."
  	<inline: false>
  	self assert: (self isForwarded: nilObj) not.
  	self assert: (self isForwarded: falseObj) not.
  	self assert: (self isForwarded: trueObj) not.
  	self assert: (self isForwarded: self freeListsObj) not.
  	self assert: (self isForwarded: hiddenRootsObj) not.
  	self assert: (self isForwarded: classTableFirstPage) not.
  	self followSpecialObjectsOop.
  	"N.B. we don't have to explicitly do mapInterpreterOops
  	 since the scavenge below will do it."
  	self followForwardedObjStacks.
  	scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact.
  	self doScavenge: DontTenureButDoUnmark.
  	self sweepToFollowForwardersForPigCompact.
  	self sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact.
+ 	self checkFreeSpace.
+ 	self assert: self numberOfForwarders = 0!
- 	self checkFreeSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'gc - global') -----
  freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact
  	"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
  
  	 Doubly-link the free chunks in address order through the freeChunkNextIndex field using the
  	 xor trick to use only one field, see e.g.
  		The Art of Computer Programming, Vol 1, D.E. Knuth, 3rd Ed, Sec 2.2.4 `Circular Lists', exercise. 18
  		http://en.wikipedia.org/wiki/XOR_linked_list.
  	 Record the lowest free object in firstFreeChunk and the highest in lastFreeChunk.
  
  	 Let the segmentManager mark which segments contain pinned objects via notePinned:."
  
  	| prevPrevFree prevFree |
  	<inline: false>
  	self checkFreeSpace.
  	scavenger forgetUnmarkedRememberedObjects.
  	segmentManager prepareForGlobalSweep."for notePinned:"
  	"throw away the list heads, including the tree."
  	self resetFreeListHeads.
  	firstFreeChunk := prevPrevFree := prevFree := 0.
  	self allOldSpaceEntitiesForCoalescingDo:
  		[:o|
  		 self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
  		 (self isMarked: o)
  			ifTrue: "forwarders should have been followed in markAndTrace:"
  				[self assert: (self isForwarded: o) not.
  				 self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
  				 (self isPinned: o) ifTrue:
  					[segmentManager notePinned: o]]
  			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
  				[| here |
  				 self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
  				 here := self coallesceFreeChunk: o.
+ 				 self setObjectFree: here.
- 				 self setFree: here.
  				 self inSortedFreeListLink: prevFree to: here given: prevPrevFree.
  				 prevPrevFree := prevFree.
  				 prevFree := here]].
  	prevFree ~= firstFreeChunk ifTrue:
  		[self storePointer: self freeChunkNextIndex
  			ofFreeChunk: prevFree
  			withValue: prevPrevFree].
  	lastFreeChunk := prevFree.
  	self cCode: [] inSmalltalk: [self checkTraversableSortedFreeList]!

Item was changed:
  ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  	self runLeakCheckerForFullGC: true.
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self markObjects.
  	self expungeDuplicateAndUnmarkedClasses: true.
  	self nilUnmarkedWeaklingSlots.
  	self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
  
  	"Mid-way the leak check must be more lenient.  Unmarked classes will have been
  	 expunged from the table, but unmarked instances will not yet have been reclaimed."
  	self runLeakCheckerForFullGC: true
  		excludeUnmarkedNewSpaceObjs: true
  		classIndicesShouldBeValid: true.
  
+ 	"At least for pigCompact it is worth repeating these two phases to get better compaction,
+ 	 for example during snapshot.  In which case the code needs to be reorganized to not
+ 	 rebuild the free list after compact, but instead just coallesce, and maintain the sorted free
+ 	 list until compaction has been repeated sufficiently (an experiment showed no improvement
+ 	 after 3 repetitions, but a useful gain of ~ 200k in a small image on the third iteration."
+ 	self flag: 'future work'.
  	self compact.
  	self eliminateAndFreeForwarders.
  
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self allObjectsUnmarked.
  	self runLeakCheckerForFullGC: true!

Item was changed:
  ----- Method: SpurMemoryManager>>isMobileObjectHeader: (in category 'object enumeration') -----
  isMobileObjectHeader: objHeader
  	"Answer if an object with header objHeader should be moved during compaction.
  	 Non-objects (free chunks & bridges), forwarders and pinned objects are excluded."
  	<inline: true>
+ 	^(objHeader >> self pinnedBitShift bitAnd: 1) = 0
+ 	  and: [(self classIndexOfHeader: objHeader) > self isForwardedObjectClassIndexPun]!
- 	^(objHeader >> self pinnedBitShift bitAnd: 1) ~= 0
- 		ifTrue: [false]
- 		ifFalse: [(self classIndexOfHeader: objHeader) > self isForwardedObjectClassIndexPun]!

Item was changed:
  ----- Method: SpurMemoryManager>>moveARunOfObjectsStartingAt:upTo: (in category 'compaction') -----
  moveARunOfObjectsStartingAt: startAddress upTo: limit 
  	"Move the sequence of movable objects starting at startAddress.  Answer the start
  	 of the next sequence of movable objects after a possible run of unmovable objects,
  	 or the limit, if there are no more movable objects, or 0 if no more compaction can be
  	 done. Compaction is done when the search through the freeList has reached the
  	 address from which objects are being moved from.
  
  	 There are two broad cases to be dealt with here.  One is a run of smallish objects
  	 that can easily be moved into free chunks.  The other is a large object that is unlikely
  	 to fit in the typical free chunk. This second pig needs careful handling; it needs to be
  	 moved to the lowest place it will fit and not cause the scan to skip lots of smaller
  	 free chunks looking in vain for somewhere to put it."
+ 	| here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk |
- 	| here prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk |
  	here := startAddress.
+ 	hereObj := self objectStartingAt: startAddress.
+ 	hereObjHeader := self atLeastClassIndexHalfHeader: hereObj.
  	prevPrevFreeChunk := prevFreeChunk := 0.
  	thisFreeChunk := maxFreeChunk := firstFreeChunk.
  	[thisFreeChunk ~= 0] whileTrue:
+ 		[| freeBytes endOfFree nextFree destination there moved |
- 		[| freeBytes endOfFree nextFree destination hereObj hereObjHeader there moved |
  
+ 		 [(self isMobileObjectHeader: hereObjHeader)] whileFalse:
- 		 [hereObj := self objectStartingAt: here.
- 		  hereObjHeader := self atLeastClassIndexHalfHeader: hereObj.
- 		  (self isMobileObjectHeader: hereObjHeader)] whileFalse:
  			[here := self addressAfter: hereObj.
  			 here >= limit ifTrue:
+ 				[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]].
+ 			 hereObj := self objectStartingAt: here.
+ 			  hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
- 				[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]]].
  
  		 freeBytes		:= self bytesInObject: thisFreeChunk.
  		 nextFree		:= self nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk.
  		 destination	:= self startOfObject: thisFreeChunk.
  		 endOfFree		:= destination + freeBytes.
  		 moved			:= false.
  		 maxFreeChunk	:= maxFreeChunk max: nextFree.
  
  		"move as many objects as will fit in freeBytes..."
  		 [there := self addressAfter: hereObj.
  		  (self isMobileObjectHeader: hereObjHeader)
  		  and: [there - here < (freeBytes - self allocationUnit)
  			    or: [there - here = freeBytes]]] whileTrue:
  			[moved := true.
  			 self mem: destination cp: here y: there - here.
  			 self forward: hereObj to: destination + (hereObj - here).
  			 destination := destination + (there - here).
  			 freeBytes := freeBytes - (there - here).
  			 hereObj := self objectStartingAt: there.
  			 here := there.
  			 hereObjHeader := self atLeastClassIndexHalfHeader: hereObj].
  
  		 moved
  			ifTrue: "need to repair the free list"
  				[| nextNextFree |
  				 nextFree ~= 0 ifTrue:
  					[nextNextFree  := self nextInSortedFreeListLink: nextFree given: thisFreeChunk].
  				 (destination > thisFreeChunk "if false couldn't move anything"
  				  and: [destination < endOfFree]) "if false, filled entire free chunk"
  					ifTrue:
  						[thisFreeChunk := self initFreeChunkWithBytes: endOfFree - destination at: destination.
  						 self inSortedFreeListLink: prevFreeChunk to: thisFreeChunk given: prevPrevFreeChunk.
  						 self inSortedFreeListLink: thisFreeChunk to: nextFree given: prevFreeChunk.
  						 nextFree ~= 0 ifTrue:
  							[self inSortedFreeListLink: nextFree to: nextNextFree given: thisFreeChunk].
  						 prevPrevFreeChunk := prevFreeChunk.
  						 prevFreeChunk := thisFreeChunk.
  						 thisFreeChunk := nextFree]
  					ifFalse:
  						[self inSortedFreeListLink: prevFreeChunk to: nextFree given: prevPrevFreeChunk.
  						 nextFree ~= 0 ifTrue:
  							[self inSortedFreeListLink: nextFree to: nextNextFree given: prevFreeChunk.
  						 thisFreeChunk := nextFree]].
  				 "self checkTraversableSortedFreeList"]
  			ifFalse: "out of space (or immobile object); move on up the free list..."
  				[prevPrevFreeChunk := prevFreeChunk.
  				 prevFreeChunk := thisFreeChunk.
  				 thisFreeChunk := nextFree].
  
  		 (self isMobileObjectHeader: hereObjHeader) ifFalse:
  			[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]].
  
  		 "Was the loop stopped by a pig? If so, try and find space for it"
  		 there - here >= (self averageObjectSizeInBytes * 8) ifTrue: "256b in 32 bit, 512b in 64 bit"
  			[| usedChunk |
  			 usedChunk := self tryToMovePig: hereObj at: here end: there.
  			"if it couldn't be moved we need to advance, so always
  			 set here to there whether the pig was moved or not."
+ 			 hereObj := self objectStartingAt: there.
  			 here := there.
+ 			 hereObjHeader := self atLeastClassIndexHalfHeader: hereObj.
  			 "In general it's a bad idea to reset the enumeration; it leads to N^2 behaviour
  			  when encountering pigs.  But if the move affected the enumeration this is
  			  simpler than resetting the list pointers."
  			 (usedChunk = prevPrevFreeChunk
  			  or: [usedChunk = prevFreeChunk
  			  or: [usedChunk = thisFreeChunk]]) ifTrue: "a bad idea; leads to N^2 behaviour when encountering pigs"
  				["reset the scan for free space back to the start of the list"
  				 prevPrevFreeChunk := prevFreeChunk := 0.
  				 thisFreeChunk := firstFreeChunk]].
  
+ 		((here > startAddress and: [there >= limit])
- 		(there >= limit
  		 or: [maxFreeChunk >= startAddress]) ifTrue:
  			[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].!

Item was added:
+ ----- Method: SpurMemoryManager>>noForwardersBelowFirstFreeChunk (in category 'gc - global') -----
+ noForwardersBelowFirstFreeChunk
+ 	self allOldSpaceEntitiesDo:
+ 		[:o|
+ 		 o >= firstFreeChunk ifTrue:
+ 			[^true].
+ 		 (self isForwarded: o) ifTrue:
+ 			[^false]].
+ 	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>numberOfForwarders (in category 'debug support') -----
+ numberOfForwarders
+ 	| n |
+ 	n := 0.
+ 	self allHeapEntitiesDo:
+ 		[:o|
+ 		(self isForwarded: o) ifTrue:
+ 			[n := n + 1]].
+ 	^n!

Item was changed:
  ----- Method: SpurMemoryManager>>pigCompact (in category 'compaction') -----
  pigCompact
  	"Traverse the sorted free list, moving objects from the high-end of
  	 memory to the free objects in the low end of memory.  Return when
  	 the address at which objects are being copiecd to meets the address
  	 from which objects are being copied from."
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'pig compacting...'; flush].
  	self sortedFreeListPairwiseReverseDo:
  		[:low :high| | scanAddress |
+ 		 self cCode: '' inSmalltalk: [coInterpreter transcript nextPut: $.; flush].
  		 scanAddress := self addressAfter: low.
  		 [scanAddress < high] whileTrue:
  			[scanAddress := self moveARunOfObjectsStartingAt: scanAddress upTo: high.
  			 scanAddress = 0 ifTrue:
  				[^self]]]!

Item was added:
+ ----- Method: SpurMemoryManager>>printFreeTree (in category 'debug printing') -----
+ printFreeTree
+ 	<api>
+ 	self printFreeTree: (freeLists at: 0)!

Item was added:
+ ----- Method: SpurMemoryManager>>printFreeTree: (in category 'debug printing') -----
+ printFreeTree: chunkOrZero
+ 	chunkOrZero > 0 ifTrue:
+ 		[self printFreeTree: (self fetchPointer: self freeChunkSmallerIndex ofObject: chunkOrZero).
+ 		 self printFreeChunk: chunkOrZero.
+ 		 self printFreeTree: (self fetchPointer: self freeChunkLargerIndex ofObject: chunkOrZero)]!

Item was added:
+ ----- Method: SpurMemoryManager>>setObjectFree: (in category 'free space') -----
+ setObjectFree: objOop
+ 	"Mark an object free, but do not add it to the free lists.  The wrinkle here
+ 	 is that we don't tolerate a zero-slot count in a free object so that the
+ 	 (self long64At: objOop) ~= 0 assert in isEnumerableObject: isn't triggered."
+ 		 
+ 	(self rawNumSlotsOf: objOop) = 0 ifTrue:
+ 		[self setRawNumSlotsOf: objOop to: 1].
+ 	self setFree: objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>sortedFreeListPairwiseReverseDo: (in category 'compaction') -----
  sortedFreeListPairwiseReverseDo: aBinaryBlock
  	"Evaluate aBinaryBlock with adjacent entries in the free list, from
  	 high address to low address.  The second argument is in fact the
  	 start of the next free chunk, not the free chunk itself.  Use
  	 endOfMemory - bridgeSize as the second argument in the first evaluation."
+ 	| free nextFree prevFree prevPrevFree |
- 	| free prevFree nextFree |
  	free := lastFreeChunk.
+ 	prevPrevFree := prevFree := 0.
- 	prevFree := 0.
  	[free ~= 0] whileTrue:
  		[nextFree := self nextInSortedFreeListLink: free given: prevFree.
+ 		 self assert: (free = 0 or: [self isFreeObject: free]).
- 		 self assert: (nextFree = 0 or: [self isFreeObject: nextFree]).
  		 self assert: (prevFree = 0 or: [prevFree > free]).
  	 	 aBinaryBlock value: free value: (prevFree = 0
  											ifTrue: [endOfMemory - self bridgeSize]
  											ifFalse: [self startOfObject: prevFree]).
+ 		 self assert: (prevFree = 0 or: [self isFreeObject: prevFree]).
+ 		 self assert: (prevPrevFree = 0 or: [self isFreeObject: prevPrevFree]).
+ 		 (self isFreeObject: free) ifFalse:
+ 			[free := self nextInSortedFreeListLink: prevFree given: prevPrevFree].
+ 		 (self isFreeObject: nextFree)
+ 			ifTrue:
+ 				[prevPrevFree := prevFree.
+ 				 prevFree := free.
+ 				 free := nextFree]
+ 			ifFalse:
+ 				[free := lastFreeChunk.
+ 				 prevPrevFree := prevFree := 0.
+ 				 [free > nextFree] whileTrue:
+ 					[nextFree := self nextInSortedFreeListLink: free given: prevFree.
+ 					 self assert: (self isFreeObject: nextFree).
+ 					 prevPrevFree := prevFree.
+ 					 prevFree := free.
+ 					 free := nextFree]]]!
- 		 prevFree := free.
- 		 free := nextFree]!

Item was changed:
  ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact (in category 'gc - global') -----
  sweepToCoallesceFreeSpaceAndRebuildFreeListsForPigCompact
  	"Coallesce free chunks and forwarders and rebuild the free list."
  	| firstFree firstFreeStart lastFree |
+ 	self assert: (self noForwardersBelowFirstFreeChunk).
- 	self checkNoForwardersBelowFirstFreeChunk.
  	firstFree := totalFreeOldSpace := 0.
  	self allOldSpaceEntitiesFrom: firstFreeChunk do:
  		[:o|
  		((self isFreeObject: o) or: [self isForwarded: o])
  			ifTrue:
  				[firstFree = 0 ifTrue:
+ 					[firstFree := o.
+ 					 firstFreeStart := self startOfObject: o].
+ 				 lastFree := o]
- 					[firstFree := o].
- 					 lastFree := o.
- 					 firstFreeStart := self startOfObject: o]
  			ifFalse:
  				[firstFree ~= 0 ifTrue:
  					[| bytes |
  					 bytes := (self addressAfter: lastFree) - firstFreeStart.
  					 self addFreeChunkWithBytes: bytes at: firstFreeStart].
  				 firstFree := 0]].
  	firstFree ~= 0 ifTrue:
  		[| bytes |
  		 bytes := (self addressAfter: lastFree) - firstFreeStart.
  		 self addFreeChunkWithBytes: bytes at: firstFreeStart].
  	firstFreeChunk := lastFreeChunk := 0!

Item was changed:
  ----- Method: VMMaker class>>generateAllSpurConfigurations (in category 'configurations') -----
  generateAllSpurConfigurations
  	self generateNewspeakSpurCogVM;
  		generateNewspeakSpurStackVM;
  		generateSqueakSpurCogVM;
+ 		generateSqueakSpurCogSistaVM;
  		generateSqueakSpurStackVM!



More information about the Vm-dev mailing list