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

commits at source.squeak.org commits at source.squeak.org
Sat Dec 17 01:01:19 UTC 2016


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

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

Name: VMMaker.oscog-eem.2041
Author: eem
Time: 16 December 2016, 5:00:36.536969 pm
UUID: 89811978-7175-44e6-86c2-bdc85c2e9ecf
Ancestors: VMMaker.oscog-eem.2040

Extract the pig compaction algorithm into its own class, allowing experimentation and hopefully prompt replacement.

Nuke a few unused methods in SpurMemoryManager.

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

Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>classTableFirstPage (in category 'debug support') -----
- classTableFirstPage
- 	^classTableFirstPage!

Item was changed:
  ----- Method: Spur32BitMMLECoSimulator>>coInterpreter:cogit: (in category 'initialization') -----
  coInterpreter: aCoInterpreter cogit: aCogit
  	coInterpreter := aCoInterpreter.
  	cogit := aCogit.
+ 	scavenger coInterpreter: aCoInterpreter.
+ 	compactor coInterpreter: aCoInterpreter!
- 	scavenger coInterpreter: aCoInterpreter!

Item was removed:
- ----- Method: Spur64BitMMLECoSimulator>>classTableFirstPage (in category 'debug support') -----
- classTableFirstPage
- 	^classTableFirstPage!

Item was changed:
  ----- Method: Spur64BitMMLECoSimulator>>coInterpreter:cogit: (in category 'initialization') -----
  coInterpreter: aCoInterpreter cogit: aCogit
  	coInterpreter := aCoInterpreter.
  	cogit := aCogit.
+ 	scavenger coInterpreter: aCoInterpreter.
+ 	compactor coInterpreter: aCoInterpreter!
- 	scavenger coInterpreter: aCoInterpreter!

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager class>>ancilliaryClasses: (in category 'translation') -----
  ancilliaryClasses: options
+ 	^{	SpurGenerationScavenger. SpurSegmentManager. SpurSegmentInfo. self compactorClass },
- 	^{	SpurGenerationScavenger. SpurSegmentManager. SpurSegmentInfo },
  		SpurNewSpaceSpace withAllSubclasses!

Item was added:
+ ----- Method: SpurMemoryManager class>>compactorClass (in category 'accessing class hierarchy') -----
+ compactorClass
+ 	"Answer the compaction algorithm to use."
+ 	^SpurPigCompactor!

Item was changed:
  ----- Method: SpurMemoryManager class>>initialize (in category 'class initialization') -----
  initialize
  	"SpurMemoryManager initialize"
  	BitsPerByte := 8.
  
  	"Initialize at least the become constants for the Spur bootstrap where the
  	 old ObjectMemory simulator is used before a Spur simulator is created.."
  	self initializeSpurObjectRepresentationConstants.
  
- 	"Pig compact can be repeated to compact better.  Experience shows that 3 times
- 	 compacts very well, desirable for snapshots.  But this is overkill for normal GCs."
- 	CompactionPassesForGC := 2.
- 	CompactionPassesForSnapshot := 3.
- 
  	"An obj stack is a stack of objects stored in a hidden root slot, such as
  	 the markStack or the ephemeronQueue.  It is a linked list of segments,
  	 with the hot end at the head of the list.  It is a word object.  The stack
  	 pointer is in ObjStackTopx and 0 means empty.  The list goes through
  	 ObjStackNextx. We don't want to shrink objStacks, since they're used
  	 in GC and it's good to keep their memory around.  So unused pages
  	 created by popping emptied pages are kept on the ObjStackFreex list.
  	 ObjStackNextx must be the last field for swizzleObjStackAt:."
  	ObjStackPageSlots := 4092. "+ double header = 16k bytes per page in 32-bits"
  	ObjStackTopx := 0.
  	ObjStackMyx := 1.
  	ObjStackFreex := 2.
  	ObjStackNextx := 3.
  	ObjStackFixedSlots := 4.
  	ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
  	"The hiddenHootsObject contains the classTable pages and up to 8 additional objects.
  	 Currently we use four; the three objStacks, the mark stack, the weaklings and the
  	 mourn queue, and the rememberedSet."
  	MarkStackRootIndex := self basicNew classTableRootSlots.
  	WeaklingStackRootIndex := MarkStackRootIndex + 1.
  	MournQueueRootIndex := MarkStackRootIndex + 2.
  	RememberedSetRootIndex := MarkStackRootIndex + 3.
  
  	MarkObjectsForEnumerationPrimitives := false.
  
  	"The remap buffer support is for compatibility; Spur doesn't GC during allocation.
  	 Eventually this should die."
  	RemapBufferSize := 25.
  
  	"Extra roots are for plugin support."
  	ExtraRootsSize := 2048 "max. # of external roots"!

Item was changed:
  ----- Method: SpurMemoryManager class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
  isNonArgumentImplicitReceiverVariableName: aString
+ 	^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'compactor' 'heapMap') includes: aString!
- 	^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'heapMap') includes: aString!

Item was removed:
- ----- Method: SpurMemoryManager>>abstractPigCompaction (in category 'compaction - analysis') -----
- abstractPigCompaction
- 	"This method answers a rough estimate of compactibility using a pig (a large free chunk)."
- 	<doNotGenerate>
- 	| pig pork moved unmoved nmoved nunmoved |
- 	pig := self findAPig.
- 	pork := self bytesInObject: pig.
- 	moved := unmoved := nmoved := nunmoved := 0.
- 	self allOldSpaceObjectsFrom: pig do:
- 		[:o| | bytes |
- 		bytes := self bytesInObject: o.
- 		bytes <= pork
- 			ifTrue:
- 				[moved := moved + bytes.
- 				 nmoved := nmoved + 1.
- 				 pork := pork - bytes]
- 			ifFalse:
- 				[unmoved := unmoved + bytes.
- 				 nunmoved := nunmoved + 1]].
- 	^{ self bytesInObject: pig. pork. moved. nmoved. unmoved. nunmoved }!

Item was changed:
  ----- Method: SpurMemoryManager>>allocateMemoryOfSize:newSpaceSize:stackSize:codeSize: (in category 'spur bootstrap') -----
  allocateMemoryOfSize: memoryBytes newSpaceSize: newSpaceBytes stackSize: stackBytes codeSize: codeBytes
  	"Intialize the receiver for bootsraping an image.
  	 Set up a large oldSpace and an empty newSpace and set-up freeStart and scavengeThreshold
  	 to allocate in oldSpace.  Later on (in initializePostBootstrap) freeStart and scavengeThreshold
  	 will be set to sane values."
  	<doNotGenerate>
  	self assert: (memoryBytes \\ self allocationUnit = 0
  				and: [newSpaceBytes \\ self allocationUnit = 0
  				and: [codeBytes \\ self allocationUnit = 0]]).
  	self allocateMemoryOfSize: memoryBytes + newSpaceBytes + codeBytes + stackBytes.
  	newSpaceStart := codeBytes + stackBytes.
  	endOfMemory := freeOldSpaceStart := memoryBytes + newSpaceBytes + codeBytes + stackBytes.
  	"leave newSpace empty for the bootstrap"
  	freeStart := newSpaceBytes + newSpaceStart.
  	oldSpaceStart := newSpaceLimit := newSpaceBytes + newSpaceStart.
  	scavengeThreshold := memory size * memory bytesPerElement. "i.e. /don't/ scavenge."
  	scavenger := SpurGenerationScavengerSimulator new.
  	scavenger manager: self.
  	scavenger newSpaceStart: newSpaceStart
  				newSpaceBytes: newSpaceBytes
+ 				survivorBytes: newSpaceBytes // self scavengerDenominator.
+ 	compactor := self class compactorClass new manager: self; yourself.!
- 				survivorBytes: newSpaceBytes // self scavengerDenominator!

Item was removed:
- ----- Method: SpurMemoryManager>>checkNoForwardersBelowFirstFreeChunk (in category 'gc - global') -----
- checkNoForwardersBelowFirstFreeChunk
- 	self allOldSpaceEntitiesDo:
- 		[:o|
- 		(self oop: o isGreaterThanOrEqualTo: firstFreeChunk) ifTrue:
- 			[^true].
- 		(self asserta: (self isForwarded: o) not) ifFalse:
- 			[^false]].
- 	^true!

Item was removed:
- ----- Method: SpurMemoryManager>>checkTraversableSortedFreeList (in category 'simulation only') -----
- checkTraversableSortedFreeList
- 	| prevFree prevPrevFree freeChunk |
- 	<api>
- 	<inline: false>
- 	prevFree := prevPrevFree := 0.
- 	firstFreeChunk = 0 ifTrue:
- 		[^lastFreeChunk = 0].
- 	freeChunk := firstFreeChunk.
- 	self allOldSpaceEntitiesDo:
- 		[:o| | objOop next limit |
- 		(self isFreeObject: o) ifTrue:
- 			[self assert: o = freeChunk.
- 			 next := self nextInSortedFreeListLink: freeChunk given: prevFree.
- 			 limit := next = 0 ifTrue: [endOfMemory] ifFalse: [next].
- 			 "coInterpreter transcript cr; print: freeChunk; tab; print: o; tab; print: prevFree; nextPutAll: '<->'; print: next; flush."
- 			 objOop := freeChunk.
- 			 [self oop: (objOop := self objectAfter: objOop) isLessThan: limit] whileTrue:
- 				[self assert: (self isFreeObject: objOop) not].
- 			 prevPrevFree := prevFree.
- 			 prevFree := freeChunk.
- 			 freeChunk := next]].
- 	self assert: prevFree = lastFreeChunk.
- 	self assert: (self nextInSortedFreeListLink: lastFreeChunk given: 0) = prevPrevFree.
- 	self assert: freeChunk = 0.
- 	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>classTableFirstPage (in category 'accessing') -----
+ classTableFirstPage
+ 	<cmacro>
+ 	^classTableFirstPage!

Item was changed:
  ----- Method: SpurMemoryManager>>coInterpreter: (in category 'simulation') -----
  coInterpreter: aCoInterpreter
  	<doNotGenerate>
  	coInterpreter := aCoInterpreter.
  	scavenger ifNotNil:
+ 		[scavenger coInterpreter: aCoInterpreter].
+ 	compactor ifNotNil:
+ 		[compactor coInterpreter: aCoInterpreter]!
- 		[scavenger coInterpreter: aCoInterpreter]!

Item was removed:
- ----- Method: SpurMemoryManager>>compact (in category 'compaction') -----
- compact
- 	"We'd like to use exact fit followed by best or first fit, but it doesn't work
- 	 well enough in practice.  So use pig compact.  Fill large free objects starting
- 	 from low memory with objects taken from the end of memory."
- 	<inline: #never> "for profiling"
- 	statCompactPassCount := statCompactPassCount + 1.
- 	self assert: (firstFreeChunk = 0 or: [self isFreeObject: firstFreeChunk]).
- 	1 to: numCompactionPasses do:
- 		[:i|
- 		 self pigCompact.
- 		 self eliminateAndFreeForwardersForPigCompact].
- 	
- 	"The free lists are zeroed in freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
- 	 They should still be zero here"
- 	self assert: self freeListHeadsEmpty.
- 	self rebuildFreeListsForPigCompact!

Item was removed:
- ----- 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>
- 	| lowestForwarder |
- 	<var: #lowestForwarder type: #usqInt>
- 	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.
- 	self followForwardedObjStacks.
- 	coInterpreter mapInterpreterOops.
- 	scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact.
- 	self unmarkSurvivingObjectsForPigCompact.
- 	lowestForwarder := self sweepToFollowForwardersForPigCompact.
- 	self sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder.
- 	self assert: self numberOfForwarders = 0!

Item was removed:
- ----- Method: SpurMemoryManager>>findAPig (in category 'compaction - analysis') -----
- findAPig
- 	"Answer a large low free chuink."
- 	<doNotGenerate>
- 	| pig |
- 	self allObjectsInFreeTreeDo:
- 		[:f|
- 		(self bytesInObject: f) >= 1000000 ifTrue:
- 			[(pig isNil or: [pig > f]) ifTrue:
- 				[pig := f]]].
- 	^pig!

Item was removed:
- ----- 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: #never> "for profiling"
- 	self checkFreeSpace: GCModeFull.
- 	scavenger forgetUnmarkedRememberedObjects.
- 	self doScavenge: MarkOnTenure.
- 	segmentManager prepareForGlobalSweep."for notePinned:"
- 	"throw away the list heads, including the tree."
- 	self resetFreeListHeads.
- 	firstFreeChunk := prevPrevFree := prevFree := 0.
- 	self allOldSpaceEntitiesForCoalescingFrom: self firstObject do:
- 		[: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 inSortedFreeListLink: prevFree to: here given: prevPrevFree.
- 				 prevPrevFree := prevFree.
- 				 prevFree := here]].
- 	prevFree ~= firstFreeChunk ifTrue:
- 		[self storePointer: self freeChunkNextIndex
- 			ofFreeChunk: prevFree
- 			withValue: prevPrevFree].
- 	lastFreeChunk := prevFree.
- 	self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
- 	self assert: self checkTraversableSortedFreeList!

Item was changed:
  ----- Method: SpurMemoryManager>>garbageCollectForSnapshot (in category 'snapshot') -----
  garbageCollectForSnapshot
  	self flushNewSpace. "There is no place to put newSpace in the snapshot file."
  	self flag: 'If we wanted to shrink the rememberedSet prior to snapshot this is the place to do it.'.
+ 	compactor biasForSnapshot.
- 	numCompactionPasses := CompactionPassesForSnapshot.
  	self fullGC.
+ 	compactor biasForGC.
- 	numCompactionPasses := CompactionPassesForGC.
  	segmentManager prepareForSnapshot.
  	self checkFreeSpace: GCModeFull!

Item was changed:
  ----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
  globalGarbageCollect
  	<inline: true> "inline into fullGC"
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self markObjects: true.
+ 	compactor freeUnmarkedObjectsAndPrepareFreeSpace.
- 	self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
  
  	"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 runLeakCheckerFor: GCModeFull
  		excludeUnmarkedNewSpaceObjs: true
  		classIndicesShouldBeValid: true.
  
+ 	compactor compact.
- 	self compact.
  	self setHeapSizeAtPreviousGC.
  
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self allObjectsUnmarked.
  	self runLeakCheckerFor: GCModeFull!

Item was added:
+ ----- Method: SpurMemoryManager>>hiddenRootsObject (in category 'accessing') -----
+ hiddenRootsObject
+ 	^hiddenRootsObj!

Item was removed:
- ----- Method: SpurMemoryManager>>inSortedFreeListLink:to:given: (in category 'compaction') -----
- inSortedFreeListLink: freeChunk to: nextFree given: prevFree
- 	 "Doubly-link the free chunk 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."
- 	freeChunk = 0
- 		ifTrue:
- 			[firstFreeChunk := nextFree]
- 		ifFalse:
- 			[self storePointer: self freeChunkNextIndex
- 				ofFreeChunk: freeChunk
- 				withUncheckedValue: (prevFree bitXor: nextFree)]!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	"We can put all initializations that set something to 0 or to false here.
  	 In C all global variables are initialized to 0, and 0 is false."
  	remapBuffer := Array new: RemapBufferSize.
  	remapBufferCount := extraRootCount := 0. "see below"
  	freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
  	becomeEffectsFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  	statGrowMemory := statShrinkMemory := statRootTableCount := 0.
  	statRootTableOverflows := statMarkCount := statCompactPassCount := statCoalesces := 0.
  
  	"We can initialize things that are allocated but are lazily initialized."
  	unscannedEphemerons := SpurContiguousObjStack new.
  
  	"we can initialize things that are virtual in C."
  	scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
  	segmentManager := SpurSegmentManager new manager: self; yourself.
+ 	compactor := self class compactorClass new manager: self; yourself.
  
  	"We can also initialize here anything that is only for simulation."
  	heapMap := CogCheck32BitHeapMap new.
  
  	"N.B. We *don't* initialize extraRoots because we don't simulate it."
  	maxOldSpaceSize := self class initializationOptions
  							ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]]
  							ifNil: [0]!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
  initializeObjectMemory: bytesToShift
  	"Initialize object memory variables at startup time. Assume endOfMemory at al are
  	 initialised by the image-reading code via setHeapBase:memoryLimit:endOfMemory:.
  	 endOfMemory is assumed to point to the end of the last object in the image.
  	 Assume: image reader also initializes the following variables:
  		specialObjectsOop
  		lastHash"
  	<inline: false>
  	| freeListObj |
  	"Catch mis-initializations leading to bad translations to C"
  	self assert: self baseHeaderSize = self baseHeaderSize.
  	self assert: (self maxSlotsForAlloc * self wordSize) asInteger > 0.
  	self bootstrapping ifFalse:
  		[self
  			initSegmentBridgeWithBytes: self bridgeSize
  			at: endOfMemory - self bridgeSize].
  	segmentManager adjustSegmentSwizzlesBy: bytesToShift.
  	"image may be at a different address; adjust oops for new location"
  	self adjustAllOopsBy: bytesToShift.
  	specialObjectsOop := segmentManager swizzleObj: specialObjectsOop.
  
  	"heavily used special objects"
  	nilObj		:= self splObj: NilObject.
  	falseObj	:= self splObj: FalseObject.
  	trueObj		:= self splObj: TrueObject.
  
  	"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
  	 conditional branch code as a result).  In addition, Spur places the free lists and
  	 class table root page immediately following them."
  	self assert: nilObj = oldSpaceStart.
  	self assert: falseObj = (self objectAfter: nilObj).
  	self assert: trueObj = (self objectAfter: falseObj).
  	freeListObj := self objectAfter: trueObj.
  	self setHiddenRootsObj: (self objectAfter: freeListObj).
  	markStack := self swizzleObjStackAt: MarkStackRootIndex.
  	weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex.
  	mournQueue := self swizzleObjStackAt: MournQueueRootIndex.
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self initializeFreeSpacePostLoad: freeListObj.
  	segmentManager collapseSegmentsPostSwizzle.
  	self computeFreeSpacePostSwizzle.
  	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart, free space"
  	self initializeNewSpaceVariables.
  	scavenger initializeRememberedSet.
  	segmentManager checkSegments.
+ 	compactor biasForGC.
  
- 	numCompactionPasses := CompactionPassesForGC.
- 
  	"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
  	growHeadroom := 16*1024*1024.		"headroom when growing"
  	shrinkThreshold := 32*1024*1024.		"free space before shrinking"
  	self setHeapSizeAtPreviousGC.
  	heapGrowthToSizeGCRatio := 0.333333. "By default GC after scavenge if heap has grown by a third since the last GC"!

Item was removed:
- ----- 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."
- 	<var: #startAddress type: #usqInt>
- 	<var: #limit type: #usqInt>
- 	<inline: false>
- 	| here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk |
- 	<var: #here type: #usqInt>
- 	<var: #there type: #usqInt>
- 	<var: #nextFree type: #usqInt>
- 	<var: #endOfFree type: #usqInt>
- 	<var: #destination type: #usqInt>
- 	<var: #maxFreeChunk type: #usqInt>
- 	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 |
- 
- 		 "skip any initial immobile objects"
- 		 [(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].
- 
- 		 "grab a free chunk, and the following one, because we want to overwrite this one."
- 		 self assert: ((self isFreeObject: firstFreeChunk) and: [self isFreeObject: thisFreeChunk]).
- 		 freeBytes		:= self bytesInObject: thisFreeChunk.
- 		 nextFree		:= self nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk.
- 		 destination	:= self startOfObject: thisFreeChunk.
- 		 endOfFree		:= destination + freeBytes.
- 		 moved			:= false.
- 		 maxFreeChunk	:= maxFreeChunk max: nextFree.
- 		 self assert: (nextFree = 0 or: [self isFreeObject: nextFree]).
- 
- 		"move as many objects as will fit in freeBytes..."
- 		 [there := self addressAfter: hereObj.
- 		  "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when freeBytes = 0"
- 		  (self isMobileObjectHeader: hereObjHeader)
- 		  and: [freeBytes > (there - here + self allocationUnit)
- 			    or: [freeBytes = (there - here)]]] whileTrue:
- 			[moved := true.
- 			 self mem: destination asVoidPointer cp: here asVoidPointer y: there - here.
- 			 self forwardUnchecked: 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: "we did overwrite it; we need to repair the free list"
- 				[| nextNextFree |
- 				 nextFree ~= 0 ifTrue:
- 					[nextNextFree  := self nextInSortedFreeListLink: nextFree given: thisFreeChunk.
- 					 self assert: (self isFreeObject: nextFree)].
- 				 (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]]
- 			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:
- 				["reset the scan for free space back to the start of the list"
- 				 prevPrevFreeChunk := prevFreeChunk := 0.
- 				 thisFreeChunk := firstFreeChunk]].
- 
- 		((here > startAddress and: [there >= limit])
- 		 or: [maxFreeChunk >= startAddress]) ifTrue:
- 			[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].
- 	^here!

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

Item was removed:
- ----- 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.
- 		 [self oop: scanAddress isLessThan: high] whileTrue:
- 			[scanAddress := self moveARunOfObjectsStartingAt: scanAddress upTo: high.
- 			 scanAddress = 0 ifTrue:
- 				[^self]]].
- 	self assert: self checkTraversableSortedFreeList!

Item was removed:
- ----- Method: SpurMemoryManager>>printSortedFreeList (in category 'debug printing') -----
- printSortedFreeList
- 	<api>
- 	| freeChunk prevFree nextFree |
- 	(firstFreeChunk > 0 and: [lastFreeChunk > firstFreeChunk]) ifFalse:
- 		[coInterpreter print: 'sorted free list empty or corrupt'; cr.
- 		 ^self].
- 	freeChunk := firstFreeChunk.
- 	prevFree := 0.
- 	[((self addressCouldBeObj: freeChunk)
- 	 and: [self isFreeObject: freeChunk]) ifFalse:
- 		[coInterpreter printHexnp: freeChunk; print: ' is not a free chunk!!' ; cr.
- 		 ^self].
- 	 self printFreeChunk: freeChunk printAsTreeNode: false.
- 	 freeChunk ~= lastFreeChunk] whileTrue:
- 		[nextFree := self nextInSortedFreeListLink: freeChunk given: prevFree.
- 		 prevFree := freeChunk.
- 		 freeChunk := nextFree]!

Item was removed:
- ----- Method: SpurMemoryManager>>rebuildFreeListsForPigCompact (in category 'compaction') -----
- rebuildFreeListsForPigCompact
- 	"Rebuild the free lists from the doubly-linked free list."
- 	<inline: false>
- 	self assert: self checkTraversableSortedFreeList.
- 	totalFreeOldSpace := 0.
- 	self sortedFreeListDo:
- 		[:freeObj| | start bytes |
- 		 bytes := (self bytesInObject: freeObj).
- 		 start := self startOfObject: freeObj.
- 		 self addFreeChunkWithBytes: bytes at: start].
- 	self checkFreeSpace: GCModeFull!

Item was removed:
- ----- Method: SpurMemoryManager>>sortedFreeListDo: (in category 'compaction') -----
- sortedFreeListDo: aBlock
- 	"Evaluate aBlock with ascending entries in the free list"
- 	| free nextFree prevFree prevPrevFree |
- 	<var: #free type: #usqInt>
- 	<var: #nextFree type: #usqInt>
- 	<var: #prevFree type: #usqInt>
- 	<var: #prevPrevFree type: #usqInt>
- 	<inline: true>
- 	free := firstFreeChunk.
- 	prevPrevFree := prevFree := 0.
- 	[free ~= 0] whileTrue:
- 		[nextFree := self nextInSortedFreeListLink: free given: prevFree.
- 		 self assert: (self isFreeObject: free).
- 		 self assert: (nextFree = 0 or: [nextFree > free and: [self isFreeObject: nextFree]]).
- 		 self assert: (prevFree = 0 or: [prevFree < free]).
- 	 	 aBlock value: free.
- 		 prevPrevFree := prevFree.
- 		 prevFree := free.
- 		 free := nextFree]!

Item was removed:
- ----- 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 prevFree prevPrevFree |
- 	<var: #free type: #usqInt>
- 	<var: #prevFree type: #usqInt>
- 	<var: #prevPrevFree type: #usqInt>
- 	<inline: true>
- 	free := lastFreeChunk.
- 	prevPrevFree := prevFree := 0.
- 	[free ~= 0] whileTrue:
- 		[aBinaryBlock value: free value: (prevFree = 0
- 											ifTrue: [endOfMemory - self bridgeSize]
- 											ifFalse: [self startOfObject: prevFree]).
- 		 "post evaluation of aBinaryBlock the value of free may be invalid
- 		  because moveARunOfObjectsStartingAt:upTo: may have filled it.
- 		  So reconstruct the position in the enumeration."
- 		 prevFree = 0
- 			ifTrue:
- 				[self assert: free = lastFreeChunk.
- 				 prevFree := lastFreeChunk.
- 				 free := self nextInSortedFreeListLink: lastFreeChunk given: 0]
- 			ifFalse:
- 				[self assert: (self isFreeObject: prevFree).
- 				 prevPrevFree = 0
- 					ifTrue:
- 						[prevPrevFree := lastFreeChunk.
- 						 prevFree := self nextInSortedFreeListLink: lastFreeChunk given: 0]
- 					ifFalse:
- 						[self assert: (self isFreeObject: prevPrevFree).
- 						 free := self nextInSortedFreeListLink: prevFree given: prevPrevFree.
- 						 prevPrevFree := prevFree.
- 						 prevFree := free].
- 				 free := self nextInSortedFreeListLink: prevFree given: prevPrevFree]]!

Item was removed:
- ----- Method: SpurMemoryManager>>sortedFreeObject: (in category 'free space') -----
- sortedFreeObject: objOop
- 	self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>statCompactPassCount (in category 'accessing') -----
+ statCompactPassCount
+ 	^statCompactPassCount!

Item was added:
+ ----- Method: SpurMemoryManager>>statCompactPassCount: (in category 'accessing') -----
+ statCompactPassCount: anInteger
+ 	^statCompactPassCount := anInteger!

Item was removed:
- ----- Method: SpurMemoryManager>>sweepToCoallesceFreeSpaceForPigCompactFrom: (in category 'compaction') -----
- sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder
- 	"Coallesce free chunks and forwarders, maintaining the doubly-linked free list."
- 	| lowest firstOfFreeRun startOfFreeRun endOfFreeRun prevPrevFree prevFree |
- 	<var: #lowestForwarder type: #usqInt>
- 	lowest := (lowestForwarder = 0 ifTrue: [endOfMemory] ifFalse: [lowestForwarder])
- 				min: (firstFreeChunk = 0 ifTrue: [endOfMemory] ifFalse: [firstFreeChunk]).
- 	firstOfFreeRun := prevPrevFree := prevFree := 0.
- 	self allOldSpaceEntitiesFrom: lowest do:
- 		[:o|
- 		((self isFreeObject: o) or: [self isForwarded: o])
- 			ifTrue:
- 				[firstOfFreeRun = 0 ifTrue:
- 					[self setObjectFree: o.
- 					 firstOfFreeRun := o.
- 					 startOfFreeRun := self startOfObject: o].
- 				 endOfFreeRun := o]
- 			ifFalse:
- 				[firstOfFreeRun ~= 0 ifTrue:
- 					[| bytes |
- 					 bytes := (self addressAfter: endOfFreeRun) - startOfFreeRun.
- 					 firstOfFreeRun := self initFreeChunkWithBytes: bytes at: startOfFreeRun.
- 					 self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
- 					 prevPrevFree := prevFree.
- 					 prevFree := firstOfFreeRun.
- 					 firstOfFreeRun := 0]]].
- 	firstOfFreeRun ~= 0 ifTrue:
- 		[| bytes |
- 		 bytes := (self addressAfter: endOfFreeRun) - startOfFreeRun.
- 		 firstOfFreeRun := self initFreeChunkWithBytes: bytes at: startOfFreeRun.
- 		 self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
- 		 prevPrevFree := prevFree.
- 		 prevFree := firstOfFreeRun.
- 		 firstOfFreeRun := 0].
- 	prevFree ~= firstFreeChunk ifTrue:
- 		[self storePointer: self freeChunkNextIndex
- 			ofFreeChunk: prevFree
- 			withValue: prevPrevFree].
- 	lastFreeChunk := prevFree.
- 	self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
- 	self assert: self checkTraversableSortedFreeList!

Item was removed:
- ----- Method: SpurMemoryManager>>sweepToFollowForwardersForPigCompact (in category 'compaction') -----
- sweepToFollowForwardersForPigCompact
- 	"Sweep, following forwarders in all live objects.
- 	 Answer the lowest forwarder in oldSpace."
- 	| lowestForwarder |
- 	<var: #lowestForwarder type: #usqInt>
- 	self assert: (freeStart = scavenger eden start
- 				  and: [scavenger futureSurvivorStart = scavenger futureSpace start]).
- 	self allPastSpaceObjectsDo:
- 		[:o|
- 		(self isForwarded: o) ifFalse:
- 			[0 to: (self numPointerSlotsOf: o) - 1 do:
- 				[:i| | f |
- 				f := self fetchPointer: i ofObject: o.
- 				(self isOopForwarded: f) ifTrue:
- 					[f := self followForwarded: f.
- 					 self storePointerUnchecked: i ofObject: o withValue: f]]]].
- 	lowestForwarder := 0.
- 	self allOldSpaceObjectsDo:
- 		[:o|
- 		(self isForwarded: o)
- 			ifTrue:
- 				[lowestForwarder = 0 ifTrue:
- 					[lowestForwarder := o]]
- 			ifFalse:
- 				[0 to: (self numPointerSlotsOf: o) - 1 do:
- 					[:i| | f |
- 					f := self fetchPointer: i ofObject: o.
- 					(self isOopForwarded: f) ifTrue:
- 						[f := self followForwarded: f.
- 						 self storePointer: i ofObject: o withValue: f]]]].
- 	^lowestForwarder!

Item was added:
+ ----- Method: SpurMemoryManager>>totalFreeOldSpace: (in category 'accessing') -----
+ totalFreeOldSpace: anInteger
+ 	totalFreeOldSpace := anInteger!

Item was removed:
- ----- Method: SpurMemoryManager>>tryToMovePig:at:end: (in category 'compaction') -----
- tryToMovePig: pigObj at: pigStart end: pigEnd
- 	"Try to move a pig (a largish object) to a free chunk in low memory.
- 	 Answer the freeChunk that was used to house the moved pig, or
- 	 0 if no free chunk could be found."
- 	| freeChunk prevFree prevPrevFree pigBytes nextNext |
- 	prevPrevFree := prevFree := 0.
- 	freeChunk := firstFreeChunk.
- 	pigBytes := pigEnd - pigStart.
- 	[freeChunk ~= 0 and: [freeChunk < pigObj]] whileTrue:
- 		[| next dest chunkBytes newChunk |
- 		 next			:= self nextInSortedFreeListLink: freeChunk given: prevFree.
- 		 dest			:= self startOfObject: freeChunk.
- 		 chunkBytes	:= (self addressAfter: freeChunk) - dest.
- 		 "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when chunkBytes = 0"
- 		 (chunkBytes = pigBytes
- 		  or: [chunkBytes > (pigBytes + self allocationUnit)]) ifTrue:
- 			[self mem: dest asVoidPointer cp: pigStart asVoidPointer y: pigBytes.
- 			 self forwardUnchecked: pigObj to: dest + (pigObj - pigStart).
- 			 next ~= 0 ifTrue:
- 				[nextNext  := self nextInSortedFreeListLink: next given: freeChunk].
- 			 "now either shorten the chunk, or remove it, adjusting the links to keep the list sorted."
- 			 pigBytes < chunkBytes "if false, filled entire free chunk"
- 				ifTrue:
- 					[newChunk := self initFreeChunkWithBytes: chunkBytes - pigBytes at: dest + pigBytes.
- 					 self inSortedFreeListLink: prevFree to: newChunk given: prevPrevFree.
- 					 self inSortedFreeListLink: newChunk to: next given: prevFree.
- 					 next ~= 0 ifTrue:
- 						[self inSortedFreeListLink: next to: nextNext given: newChunk]]
- 				ifFalse:
- 					[self inSortedFreeListLink: prevFree to: next given: prevPrevFree.
- 					 next ~= 0 ifTrue:
- 						[self inSortedFreeListLink: next to: nextNext given: prevFree]].
- 			 "self checkTraversableSortedFreeList".
- 			 ^freeChunk].
- 		 prevPrevFree := prevFree.
- 		 prevFree := freeChunk.
- 		 freeChunk := next].
- 	^0!

Item was removed:
- ----- Method: SpurMemoryManager>>unmarkSurvivingObjectsForPigCompact (in category 'gc - global') -----
- unmarkSurvivingObjectsForPigCompact
- 	self allPastSpaceObjectsDo:
- 		[:objOop|
- 		(self isMarked: objOop) ifTrue:
- 			[self setIsMarkedOf: objOop to: false]]!

Item was added:
+ CogClass subclass: #SpurPigCompactor
+ 	instanceVariableNames: 'manager scavenger coInterpreter firstFreeChunk lastFreeChunk numCompactionPasses'
+ 	classVariableNames: 'CompactionPassesForGC CompactionPassesForSnapshot'
+ 	poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMSpurObjectRepresentationConstants'
+ 	category: 'VMMaker-SpurMemoryManager'!
+ 
+ !SpurPigCompactor commentStamp: 'eem 12/16/2016 16:20' prior: 0!
+ SpurPigCompactor implements the second compactioon algorithm implemented for Spur.  It attempts to move ovbjects down from the end of memory to occupy free chunks in low memory.  It uses Knuth's xor-encoding technique to encode a doubly-linked list in the forwarding field of each free chunk (free chunks, like Spiur objects, being known to have at least one field).  This algorithm has poor performance for two reasons.  First, it does not preserve object order, scrambling the order of objects as it moves the highest objects down to the lowest free chunks.  Second it appears to perform badly, occasionally causing very long pauses.
+ 
+ Instance Variables
+ 	coInterpreter:				<StackInterpreter>
+ 	firstFreeChunk:				<Integer>
+ 	lastFreeChunk:				<Integer>
+ 	manager:					<SpurMemoryManager>
+ 	numCompactionPasses:		<Integer>
+ 	scavenger:					<SpurGenerationScavenger>
+ 
+ firstFreeChunk
+ 	- oop of freeChunk or 0
+ 
+ lastFreeChunk
+ 	- oop of freeChunk or 0
+ 
+ numCompactionPasses
+ 	- 2 for normal GC, 3 for snapshot!

Item was added:
+ ----- Method: SpurPigCompactor class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Pig compact can be repeated to compact better.  Experience shows that 3 times
+ 	 compacts very well, desirable for snapshots.  But this is overkill for normal GCs."
+ 	CompactionPassesForGC := 2.
+ 	CompactionPassesForSnapshot := 3!

Item was added:
+ ----- Method: SpurPigCompactor>>abstractPigCompaction (in category 'compaction - analysis') -----
+ abstractPigCompaction
+ 	"This method answers a rough estimate of compactibility using a pig (a large free chunk)."
+ 	<doNotGenerate>
+ 	| pig pork moved unmoved nmoved nunmoved |
+ 	pig := self findAPig.
+ 	pork := manager bytesInObject: pig.
+ 	moved := unmoved := nmoved := nunmoved := 0.
+ 	manager allOldSpaceObjectsFrom: pig do:
+ 		[:o| | bytes |
+ 		bytes := manager bytesInObject: o.
+ 		bytes <= pork
+ 			ifTrue:
+ 				[moved := moved + bytes.
+ 				 nmoved := nmoved + 1.
+ 				 pork := pork - bytes]
+ 			ifFalse:
+ 				[unmoved := unmoved + bytes.
+ 				 nunmoved := nunmoved + 1]].
+ 	^{ manager bytesInObject: pig. pork. moved. nmoved. unmoved. nunmoved }!

Item was added:
+ ----- Method: SpurPigCompactor>>biasForGC (in category 'compaction - api') -----
+ biasForGC
+ 	numCompactionPasses := CompactionPassesForGC!

Item was added:
+ ----- Method: SpurPigCompactor>>biasForSnapshot (in category 'compaction - api') -----
+ biasForSnapshot
+ 	numCompactionPasses := CompactionPassesForSnapshot!

Item was added:
+ ----- Method: SpurPigCompactor>>checkNoForwardersBelowFirstFreeChunk (in category 'compaction - asserts') -----
+ checkNoForwardersBelowFirstFreeChunk
+ 	manager allOldSpaceEntitiesDo:
+ 		[:o|
+ 		(self oop: o isGreaterThanOrEqualTo: firstFreeChunk) ifTrue:
+ 			[^true].
+ 		(self asserta: (manager isForwarded: o) not) ifFalse:
+ 			[^false]].
+ 	^true!

Item was added:
+ ----- Method: SpurPigCompactor>>checkTraversableSortedFreeList (in category 'compaction - asserts') -----
+ checkTraversableSortedFreeList
+ 	| prevFree prevPrevFree freeChunk |
+ 	<api>
+ 	<inline: false>
+ 	prevFree := prevPrevFree := 0.
+ 	firstFreeChunk = 0 ifTrue:
+ 		[^lastFreeChunk = 0].
+ 	freeChunk := firstFreeChunk.
+ 	manager allOldSpaceEntitiesDo:
+ 		[:o| | objOop next limit |
+ 		(manager isFreeObject: o) ifTrue:
+ 			[self assert: o = freeChunk.
+ 			 next := manager nextInSortedFreeListLink: freeChunk given: prevFree.
+ 			 limit := next = 0 ifTrue: [manager endOfMemory] ifFalse: [next].
+ 			 "coInterpreter transcript cr; print: freeChunk; tab; print: o; tab; print: prevFree; nextPutAll: '<->'; print: next; flush."
+ 			 objOop := freeChunk.
+ 			 [self oop: (objOop := manager objectAfter: objOop) isLessThan: limit] whileTrue:
+ 				[self assert: (manager isFreeObject: objOop) not].
+ 			 prevPrevFree := prevFree.
+ 			 prevFree := freeChunk.
+ 			 freeChunk := next]].
+ 	self assert: prevFree = lastFreeChunk.
+ 	self assert: (manager nextInSortedFreeListLink: lastFreeChunk given: 0) = prevPrevFree.
+ 	self assert: freeChunk = 0.
+ 	^true!

Item was added:
+ ----- Method: SpurPigCompactor>>coInterpreter: (in category 'initialization') -----
+ coInterpreter: aVMSimulator
+ 	<doNotGenerate>
+ 	coInterpreter := aVMSimulator!

Item was added:
+ ----- Method: SpurPigCompactor>>compact (in category 'compaction - api') -----
+ compact
+ 	"We'd like to use exact fit followed by best or first fit, but it doesn't work
+ 	 well enough in practice.  So use pig compact.  Fill large free objects starting
+ 	 from low memory with objects taken from the end of memory."
+ 	<inline: #never> "for profiling"
+ 	manager statCompactPassCount: manager statCompactPassCount + 1.
+ 	self assert: (firstFreeChunk = 0 or: [manager isFreeObject: firstFreeChunk]).
+ 	1 to: numCompactionPasses do:
+ 		[:i|
+ 		 self pigCompact.
+ 		 self eliminateAndFreeForwardersForPigCompact].
+ 	
+ 	"The free lists are zeroed in freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact.
+ 	 They should still be zero here"
+ 	self assert: manager freeListHeadsEmpty.
+ 	self rebuildFreeListsForPigCompact!

Item was added:
+ ----- Method: SpurPigCompactor>>eliminateAndFreeForwardersForPigCompact (in category 'compaction') -----
+ 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>
+ 	| lowestForwarder |
+ 	<var: #lowestForwarder type: #usqInt>
+ 	self assert: (manager isForwarded: manager nilObject) not.
+ 	self assert: (manager isForwarded: manager falseObject) not.
+ 	self assert: (manager isForwarded: manager trueObject) not.
+ 	self assert: (manager isForwarded: manager freeListsObj) not.
+ 	self assert: (manager isForwarded: manager hiddenRootsObject) not.
+ 	self assert: (manager isForwarded: manager classTableFirstPage) not.
+ 	manager followSpecialObjectsOop.
+ 	manager followForwardedObjStacks.
+ 	coInterpreter mapInterpreterOops.
+ 	scavenger followRememberedForwardersAndForgetFreeObjectsForPigCompact.
+ 	self unmarkSurvivingObjectsForPigCompact.
+ 	lowestForwarder := self sweepToFollowForwardersForPigCompact.
+ 	self sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder.
+ 	self assert: manager numberOfForwarders = 0!

Item was added:
+ ----- Method: SpurPigCompactor>>findAPig (in category 'compaction - analysis') -----
+ findAPig
+ 	"Answer a large low free chunk."
+ 	<doNotGenerate>
+ 	| pig |
+ 	manager allObjectsInFreeTreeDo:
+ 		[:f|
+ 		(manager bytesInObject: f) >= 1000000 ifTrue:
+ 			[(pig isNil or: [pig > f]) ifTrue:
+ 				[pig := f]]].
+ 	^pig!

Item was added:
+ ----- Method: SpurPigCompactor>>freeUnmarkedObjectsAndPrepareFreeSpace (in category 'compaction - api') -----
+ freeUnmarkedObjectsAndPrepareFreeSpace
+ 	<inline: true>
+ 	self freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact!

Item was added:
+ ----- Method: SpurPigCompactor>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpaceForPigCompact (in category 'compaction') -----
+ 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: #never> "for profiling"
+ 	manager checkFreeSpace: GCModeFull.
+ 	scavenger forgetUnmarkedRememberedObjects.
+ 	manager doScavenge: MarkOnTenure.
+ 	manager segmentManager prepareForGlobalSweep."for notePinned:"
+ 	"throw away the list heads, including the tree."
+ 	manager resetFreeListHeads.
+ 	firstFreeChunk := prevPrevFree := prevFree := 0.
+ 	manager allOldSpaceEntitiesForCoalescingFrom: manager firstObject do:
+ 		[:o|
+ 		 self assert: (firstFreeChunk = 0 or: [manager isFreeObject: firstFreeChunk]).
+ 		 (manager isMarked: o)
+ 			ifTrue: "forwarders should have been followed in markAndTrace:"
+ 				[self assert: (manager isForwarded: o) not.
+ 				 manager setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
+ 				 (manager isPinned: o) ifTrue:
+ 					[manager segmentManager notePinned: o]]
+ 			ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
+ 				[| here |
+ 				 self assert: (manager isRemembered: o) not. "scavenger should have cleared this above"
+ 				 here := manager coallesceFreeChunk: o.
+ 				 manager setObjectFree: here.
+ 				 self inSortedFreeListLink: prevFree to: here given: prevPrevFree.
+ 				 prevPrevFree := prevFree.
+ 				 prevFree := here]].
+ 	prevFree ~= firstFreeChunk ifTrue:
+ 		[manager storePointer: manager freeChunkNextIndex
+ 			ofFreeChunk: prevFree
+ 			withValue: prevPrevFree].
+ 	lastFreeChunk := prevFree.
+ 	self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
+ 	self assert: self checkTraversableSortedFreeList!

Item was added:
+ ----- Method: SpurPigCompactor>>inSortedFreeListLink:to:given: (in category 'compaction') -----
+ inSortedFreeListLink: freeChunk to: nextFree given: prevFree
+ 	 "Doubly-link the free chunk 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."
+ 	freeChunk = 0
+ 		ifTrue:
+ 			[firstFreeChunk := nextFree]
+ 		ifFalse:
+ 			[manager storePointer: manager freeChunkNextIndex
+ 				ofFreeChunk: freeChunk
+ 				withUncheckedValue: (prevFree bitXor: nextFree)]!

Item was added:
+ ----- Method: SpurPigCompactor>>manager: (in category 'initialization') -----
+ manager: aSpurNBitMMXEndianSimulator
+ 	<doNotGenerate>
+ 	manager := aSpurNBitMMXEndianSimulator.
+ 	aSpurNBitMMXEndianSimulator coInterpreter ifNotNil:
+ 		[:coint| coInterpreter := coint].
+ 	aSpurNBitMMXEndianSimulator scavenger ifNotNil:
+ 		[:scav| scavenger := scav]!

Item was added:
+ ----- Method: SpurPigCompactor>>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."
+ 	<var: #startAddress type: #usqInt>
+ 	<var: #limit type: #usqInt>
+ 	<inline: false>
+ 	| here hereObj hereObjHeader prevPrevFreeChunk prevFreeChunk thisFreeChunk maxFreeChunk |
+ 	<var: #here type: #usqInt>
+ 	<var: #there type: #usqInt>
+ 	<var: #nextFree type: #usqInt>
+ 	<var: #endOfFree type: #usqInt>
+ 	<var: #destination type: #usqInt>
+ 	<var: #maxFreeChunk type: #usqInt>
+ 	here := startAddress.
+ 	hereObj := manager objectStartingAt: startAddress.
+ 	hereObjHeader := manager atLeastClassIndexHalfHeader: hereObj.
+ 	prevPrevFreeChunk := prevFreeChunk := 0.
+ 	thisFreeChunk := maxFreeChunk := firstFreeChunk.
+ 	[thisFreeChunk ~= 0] whileTrue:
+ 		[| freeBytes endOfFree nextFree destination there moved |
+ 
+ 		 "skip any initial immobile objects"
+ 		 [(manager isMobileObjectHeader: hereObjHeader)] whileFalse:
+ 			[here := manager addressAfter: hereObj.
+ 			 here >= limit ifTrue:
+ 				[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [limit]].
+ 			 hereObj := manager objectStartingAt: here.
+ 			 hereObjHeader := manager atLeastClassIndexHalfHeader: hereObj].
+ 
+ 		 "grab a free chunk, and the following one, because we want to overwrite this one."
+ 		 self assert: ((manager isFreeObject: firstFreeChunk) and: [manager isFreeObject: thisFreeChunk]).
+ 		 freeBytes		:= manager bytesInObject: thisFreeChunk.
+ 		 nextFree		:= manager nextInSortedFreeListLink: thisFreeChunk given: prevFreeChunk.
+ 		 destination	:= manager startOfObject: thisFreeChunk.
+ 		 endOfFree		:= destination + freeBytes.
+ 		 moved			:= false.
+ 		 maxFreeChunk	:= maxFreeChunk max: nextFree.
+ 		 self assert: (nextFree = 0 or: [manager isFreeObject: nextFree]).
+ 
+ 		"move as many objects as will fit in freeBytes..."
+ 		 [there := manager addressAfter: hereObj.
+ 		  "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when freeBytes = 0"
+ 		  (manager isMobileObjectHeader: hereObjHeader)
+ 		  and: [freeBytes > (there - here + manager allocationUnit)
+ 			    or: [freeBytes = (there - here)]]] whileTrue:
+ 			[moved := true.
+ 			 manager mem: destination asVoidPointer cp: here asVoidPointer y: there - here.
+ 			 manager forwardUnchecked: hereObj to: destination + (hereObj - here).
+ 			 destination := destination + (there - here).
+ 			 freeBytes := freeBytes - (there - here).
+ 			 hereObj := manager objectStartingAt: there.
+ 			 here := there.
+ 			 hereObjHeader := manager atLeastClassIndexHalfHeader: hereObj].
+ 
+ 		 moved
+ 			ifTrue: "we did overwrite it; we need to repair the free list"
+ 				[| nextNextFree |
+ 				 nextFree ~= 0 ifTrue:
+ 					[nextNextFree  := manager nextInSortedFreeListLink: nextFree given: thisFreeChunk.
+ 					 self assert: (manager isFreeObject: nextFree)].
+ 				 (destination > thisFreeChunk "if false couldn't move anything"
+ 				  and: [destination < endOfFree]) "if false, filled entire free chunk"
+ 					ifTrue:
+ 						[thisFreeChunk := manager 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]]
+ 			ifFalse: "out of space (or immobile object); move on up the free list..."
+ 				[prevPrevFreeChunk := prevFreeChunk.
+ 				 prevFreeChunk := thisFreeChunk.
+ 				 thisFreeChunk := nextFree].
+ 
+ 		 (manager 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 >= (manager 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 := manager objectStartingAt: there.
+ 			 here := there.
+ 			 hereObjHeader := manager 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:
+ 				["reset the scan for free space back to the start of the list"
+ 				 prevPrevFreeChunk := prevFreeChunk := 0.
+ 				 thisFreeChunk := firstFreeChunk]].
+ 
+ 		((here > startAddress and: [there >= limit])
+ 		 or: [maxFreeChunk >= startAddress]) ifTrue:
+ 			[^maxFreeChunk >= startAddress ifTrue: [0] ifFalse: [there]]].
+ 	^here!

Item was added:
+ ----- Method: SpurPigCompactor>>noForwardersBelowFirstFreeChunk (in category 'compaction - asserts') -----
+ noForwardersBelowFirstFreeChunk
+ 	manager allOldSpaceEntitiesDo:
+ 		[:o|
+ 		 (self oop: o isGreaterThanOrEqualTo: firstFreeChunk) ifTrue:
+ 			[^true].
+ 		 (manager isForwarded: o) ifTrue:
+ 			[^false]].
+ 	^true!

Item was added:
+ ----- Method: SpurPigCompactor>>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 := manager addressAfter: low.
+ 		 [self oop: scanAddress isLessThan: high] whileTrue:
+ 			[scanAddress := self moveARunOfObjectsStartingAt: scanAddress upTo: high.
+ 			 scanAddress = 0 ifTrue:
+ 				[^self]]].
+ 	self assert: self checkTraversableSortedFreeList!

Item was added:
+ ----- Method: SpurPigCompactor>>printSortedFreeList (in category 'debug printing') -----
+ printSortedFreeList
+ 	<api>
+ 	| freeChunk prevFree nextFree |
+ 	(firstFreeChunk > 0 and: [lastFreeChunk > firstFreeChunk]) ifFalse:
+ 		[coInterpreter print: 'sorted free list empty or corrupt'; cr.
+ 		 ^self].
+ 	freeChunk := firstFreeChunk.
+ 	prevFree := 0.
+ 	[((manager addressCouldBeObj: freeChunk)
+ 	 and: [manager isFreeObject: freeChunk]) ifFalse:
+ 		[coInterpreter printHexnp: freeChunk; print: ' is not a free chunk!!' ; cr.
+ 		 ^self].
+ 	 manager printFreeChunk: freeChunk printAsTreeNode: false.
+ 	 freeChunk ~= lastFreeChunk] whileTrue:
+ 		[nextFree := manager nextInSortedFreeListLink: freeChunk given: prevFree.
+ 		 prevFree := freeChunk.
+ 		 freeChunk := nextFree]!

Item was added:
+ ----- Method: SpurPigCompactor>>rebuildFreeListsForPigCompact (in category 'compaction') -----
+ rebuildFreeListsForPigCompact
+ 	"Rebuild the free lists from the doubly-linked free list."
+ 	<inline: false>
+ 	self assert: self checkTraversableSortedFreeList.
+ 	manager totalFreeOldSpace: 0.
+ 	self sortedFreeListDo:
+ 		[:freeObj| | start bytes |
+ 		 bytes := (manager bytesInObject: freeObj).
+ 		 start := manager startOfObject: freeObj.
+ 		 manager addFreeChunkWithBytes: bytes at: start].
+ 	manager checkFreeSpace: GCModeFull!

Item was added:
+ ----- Method: SpurPigCompactor>>sortedFreeListDo: (in category 'compaction') -----
+ sortedFreeListDo: aBlock
+ 	"Evaluate aBlock with ascending entries in the free list"
+ 	| free nextFree prevFree prevPrevFree |
+ 	<var: #free type: #usqInt>
+ 	<var: #nextFree type: #usqInt>
+ 	<var: #prevFree type: #usqInt>
+ 	<var: #prevPrevFree type: #usqInt>
+ 	<inline: true>
+ 	free := firstFreeChunk.
+ 	prevPrevFree := prevFree := 0.
+ 	[free ~= 0] whileTrue:
+ 		[nextFree := manager nextInSortedFreeListLink: free given: prevFree.
+ 		 self assert: (manager isFreeObject: free).
+ 		 self assert: (nextFree = 0 or: [nextFree > free and: [manager isFreeObject: nextFree]]).
+ 		 self assert: (prevFree = 0 or: [prevFree < free]).
+ 	 	 aBlock value: free.
+ 		 prevPrevFree := prevFree.
+ 		 prevFree := free.
+ 		 free := nextFree]!

Item was added:
+ ----- Method: SpurPigCompactor>>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 prevFree prevPrevFree |
+ 	<var: #free type: #usqInt>
+ 	<var: #prevFree type: #usqInt>
+ 	<var: #prevPrevFree type: #usqInt>
+ 	<inline: true>
+ 	free := lastFreeChunk.
+ 	prevPrevFree := prevFree := 0.
+ 	[free ~= 0] whileTrue:
+ 		[aBinaryBlock value: free value: (prevFree = 0
+ 											ifTrue: [manager endOfMemory - manager bridgeSize]
+ 											ifFalse: [manager startOfObject: prevFree]).
+ 		 "post evaluation of aBinaryBlock the value of free may be invalid
+ 		  because moveARunOfObjectsStartingAt:upTo: may have filled it.
+ 		  So reconstruct the position in the enumeration."
+ 		 prevFree = 0
+ 			ifTrue:
+ 				[self assert: free = lastFreeChunk.
+ 				 prevFree := lastFreeChunk.
+ 				 free := manager nextInSortedFreeListLink: lastFreeChunk given: 0]
+ 			ifFalse:
+ 				[self assert: (manager isFreeObject: prevFree).
+ 				 prevPrevFree = 0
+ 					ifTrue:
+ 						[prevPrevFree := lastFreeChunk.
+ 						 prevFree := manager nextInSortedFreeListLink: lastFreeChunk given: 0]
+ 					ifFalse:
+ 						[self assert: (manager isFreeObject: prevPrevFree).
+ 						 free := manager nextInSortedFreeListLink: prevFree given: prevPrevFree.
+ 						 prevPrevFree := prevFree.
+ 						 prevFree := free].
+ 				 free := manager nextInSortedFreeListLink: prevFree given: prevPrevFree]]!

Item was added:
+ ----- Method: SpurPigCompactor>>sweepToCoallesceFreeSpaceForPigCompactFrom: (in category 'compaction') -----
+ sweepToCoallesceFreeSpaceForPigCompactFrom: lowestForwarder
+ 	"Coallesce free chunks and forwarders, maintaining the doubly-linked free list."
+ 	| lowest firstOfFreeRun startOfFreeRun endOfFreeRun prevPrevFree prevFree |
+ 	<var: #lowestForwarder type: #usqInt>
+ 	lowest := (lowestForwarder = 0 ifTrue: [manager endOfMemory] ifFalse: [lowestForwarder])
+ 				min: (firstFreeChunk = 0 ifTrue: [manager endOfMemory] ifFalse: [firstFreeChunk]).
+ 	firstOfFreeRun := prevPrevFree := prevFree := 0.
+ 	manager allOldSpaceEntitiesFrom: lowest do:
+ 		[:o|
+ 		((manager isFreeObject: o) or: [manager isForwarded: o])
+ 			ifTrue:
+ 				[firstOfFreeRun = 0 ifTrue:
+ 					[manager setObjectFree: o.
+ 					 firstOfFreeRun := o.
+ 					 startOfFreeRun := manager startOfObject: o].
+ 				 endOfFreeRun := o]
+ 			ifFalse:
+ 				[firstOfFreeRun ~= 0 ifTrue:
+ 					[| bytes |
+ 					 bytes := (manager addressAfter: endOfFreeRun) - startOfFreeRun.
+ 					 firstOfFreeRun := manager initFreeChunkWithBytes: bytes at: startOfFreeRun.
+ 					 self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
+ 					 prevPrevFree := prevFree.
+ 					 prevFree := firstOfFreeRun.
+ 					 firstOfFreeRun := 0]]].
+ 	firstOfFreeRun ~= 0 ifTrue:
+ 		[| bytes |
+ 		 bytes := (manager addressAfter: endOfFreeRun) - startOfFreeRun.
+ 		 firstOfFreeRun := manager initFreeChunkWithBytes: bytes at: startOfFreeRun.
+ 		 self inSortedFreeListLink: prevFree to: firstOfFreeRun given: prevPrevFree.
+ 		 prevPrevFree := prevFree.
+ 		 prevFree := firstOfFreeRun.
+ 		 firstOfFreeRun := 0].
+ 	prevFree ~= firstFreeChunk ifTrue:
+ 		[manager storePointer: manager freeChunkNextIndex
+ 			ofFreeChunk: prevFree
+ 			withValue: prevPrevFree].
+ 	lastFreeChunk := prevFree.
+ 	self inSortedFreeListLink: lastFreeChunk to: 0 given: prevPrevFree.
+ 	self assert: self checkTraversableSortedFreeList!

Item was added:
+ ----- Method: SpurPigCompactor>>sweepToFollowForwardersForPigCompact (in category 'compaction') -----
+ sweepToFollowForwardersForPigCompact
+ 	"Sweep, following forwarders in all live objects.
+ 	 Answer the lowest forwarder in oldSpace."
+ 	| lowestForwarder |
+ 	<var: #lowestForwarder type: #usqInt>
+ 	self assert: (manager freeStart = scavenger eden start
+ 				  and: [scavenger futureSurvivorStart = scavenger futureSpace start]).
+ 	manager allPastSpaceObjectsDo:
+ 		[:o|
+ 		(manager isForwarded: o) ifFalse:
+ 			[0 to: (manager numPointerSlotsOf: o) - 1 do:
+ 				[:i| | f |
+ 				f := manager fetchPointer: i ofObject: o.
+ 				(manager isOopForwarded: f) ifTrue:
+ 					[f := manager followForwarded: f.
+ 					 manager storePointerUnchecked: i ofObject: o withValue: f]]]].
+ 	lowestForwarder := 0.
+ 	manager allOldSpaceObjectsDo:
+ 		[:o|
+ 		(manager isForwarded: o)
+ 			ifTrue:
+ 				[lowestForwarder = 0 ifTrue:
+ 					[lowestForwarder := o]]
+ 			ifFalse:
+ 				[0 to: (manager numPointerSlotsOf: o) - 1 do:
+ 					[:i| | f |
+ 					f := manager fetchPointer: i ofObject: o.
+ 					(manager isOopForwarded: f) ifTrue:
+ 						[f := manager followForwarded: f.
+ 						 manager storePointer: i ofObject: o withValue: f]]]].
+ 	^lowestForwarder!

Item was added:
+ ----- Method: SpurPigCompactor>>tryToMovePig:at:end: (in category 'compaction') -----
+ tryToMovePig: pigObj at: pigStart end: pigEnd
+ 	"Try to move a pig (a largish object) to a free chunk in low memory.
+ 	 Answer the freeChunk that was used to house the moved pig, or
+ 	 0 if no free chunk could be found."
+ 	| freeChunk prevFree prevPrevFree pigBytes nextNext |
+ 	prevPrevFree := prevFree := 0.
+ 	freeChunk := firstFreeChunk.
+ 	pigBytes := pigEnd - pigStart.
+ 	[freeChunk ~= 0 and: [freeChunk < pigObj]] whileTrue:
+ 		[| next dest chunkBytes newChunk |
+ 		 next			:= manager nextInSortedFreeListLink: freeChunk given: prevFree.
+ 		 dest			:= manager startOfObject: freeChunk.
+ 		 chunkBytes	:= (manager addressAfter: freeChunk) - dest.
+ 		 "N.B. *must* add allocationUnit, not subtract, to avoid unsigned arithmetic issues when chunkBytes = 0"
+ 		 (chunkBytes = pigBytes
+ 		  or: [chunkBytes > (pigBytes + manager allocationUnit)]) ifTrue:
+ 			[manager mem: dest asVoidPointer cp: pigStart asVoidPointer y: pigBytes.
+ 			 manager forwardUnchecked: pigObj to: dest + (pigObj - pigStart).
+ 			 next ~= 0 ifTrue:
+ 				[nextNext  := manager nextInSortedFreeListLink: next given: freeChunk].
+ 			 "now either shorten the chunk, or remove it, adjusting the links to keep the list sorted."
+ 			 pigBytes < chunkBytes "if false, filled entire free chunk"
+ 				ifTrue:
+ 					[newChunk := manager initFreeChunkWithBytes: chunkBytes - pigBytes at: dest + pigBytes.
+ 					 self inSortedFreeListLink: prevFree to: newChunk given: prevPrevFree.
+ 					 self inSortedFreeListLink: newChunk to: next given: prevFree.
+ 					 next ~= 0 ifTrue:
+ 						[self inSortedFreeListLink: next to: nextNext given: newChunk]]
+ 				ifFalse:
+ 					[self inSortedFreeListLink: prevFree to: next given: prevPrevFree.
+ 					 next ~= 0 ifTrue:
+ 						[self inSortedFreeListLink: next to: nextNext given: prevFree]].
+ 			 "self checkTraversableSortedFreeList".
+ 			 ^freeChunk].
+ 		 prevPrevFree := prevFree.
+ 		 prevFree := freeChunk.
+ 		 freeChunk := next].
+ 	^0!

Item was added:
+ ----- Method: SpurPigCompactor>>unmarkSurvivingObjectsForPigCompact (in category 'compaction') -----
+ unmarkSurvivingObjectsForPigCompact
+ 	manager allPastSpaceObjectsDo:
+ 		[:objOop|
+ 		(manager isMarked: objOop) ifTrue:
+ 			[manager setIsMarkedOf: objOop to: false]]!



More information about the Vm-dev mailing list