Add multipass compaction tests when the mourn queue is scanned

smalltalksrc/VMMaker/SpurPlanningCompactor.class.st

@@ -163,6 +163,23 @@ SpurPlanningCompactor >> compact [
 	self endCompaction
 ]
 
+{ #category : #'space management' }
+SpurPlanningCompactor >> configureSavedFirstFieldsSpaceStart: theStart limit: theLimit isOldSpace: isOldSpace [
+	"Use teden to hold the savedFirstFieldsSpace."
+
+	<inline: true>
+	| limit |
+	limit := theLimit.
+	savedFirstFieldSpaceMaxSlots ifNotNil: [
+		limit := limit min:
+			(theStart + (savedFirstFieldSpaceMaxSlots * manager bytesPerOop)) ].
+
+	savedFirstFieldsSpace
+		start: theStart;
+		limit: limit.
+	savedFirstFieldsSpaceNotInOldSpace := isOldSpace not
+]
+
 { #category : #compaction }
 SpurPlanningCompactor >> copyAndUnmark: firstPass [
 	"Sweep the heap, unmarking all objects and moving mobile objects to their correct positions,
@@ -598,6 +615,12 @@ SpurPlanningCompactor >> repinRememberedSet [
 	scavenger relocateRememberedSet
 ]
 
+{ #category : #'space management' }
+SpurPlanningCompactor >> savedFirstFieldSpaceMaxSlots: aNumber [
+
+	savedFirstFieldSpaceMaxSlots := aNumber
+]
+
 { #category : #'space management' }
 SpurPlanningCompactor >> savedFirstFieldsSpaceInFreeChunk [
 	<inline: true>
@@ -950,11 +973,12 @@ SpurPlanningCompactor >> updateSavedFirstFieldsSpaceIfNecessary [
 { #category : #'space management' }
 SpurPlanningCompactor >> useEdenForSavedFirstFieldsSpace [
 	"Use teden to hold the savedFirstFieldsSpace."
+
 	<inline: true>
-	savedFirstFieldsSpace
-		start: scavenger eden start;
-		limit: scavenger eden limit.
-	savedFirstFieldsSpaceNotInOldSpace := true.
+	self
+		configureSavedFirstFieldsSpaceStart: scavenger eden start
+		limit: scavenger eden limit
+		isOldSpace: false.
 	self deny: self savedFirstFieldsSpaceWasAllocated
 ]
 
@@ -963,35 +987,39 @@ SpurPlanningCompactor >> useFreeChunkForSavedFirstFieldsSpace: highestSuitableFr
 	"Use the supplied free chunk to hold the savedFirstFieldsSpace. Invoked when
 	 eden is found not to be big enough for the job. Avoid the first few fields so as
 	 not to destroy the free chunk and there by confuse object enumeration."
+
 	<inline: true>
 	self assert: (manager validFreeTreeChunk: highestSuitableFreeBlock).
-	savedFirstFieldsSpace
-		start: highestSuitableFreeBlock + (manager freeChunkLargerIndex * manager bytesPerOop);
-		limit: (manager addressAfter: highestSuitableFreeBlock).
-	savedFirstFieldsSpaceNotInOldSpace := false.
+	self
+		configureSavedFirstFieldsSpaceStart: highestSuitableFreeBlock
+			+ (manager freeChunkLargerIndex * manager bytesPerOop)
+		limit: (manager addressAfter: highestSuitableFreeBlock)
+		isOldSpace: false.
 	self deny: self savedFirstFieldsSpaceWasAllocated
 ]
 
 { #category : #'space management' }
 SpurPlanningCompactor >> useSegmentForSavedFirstFieldsSpace: spaceEstimate [
 	"Attempt to allocate a memory segment large enough to hold the savedFirstFieldsSpace.
 	 Invoked when neither eden nor a large free chunk are found to be big enough for the job."
-	| roundedSize allocatedSize |
+
 	<var: #segAddress type: #'void *'>
+	| roundedSize allocatedSize |
 	roundedSize := spaceEstimate + 1023 // 1024 * 1024.
-	(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
-		sqAllocateMemorySegmentOfSize: roundedSize
-		Above: (manager segmentManager firstGapOfSizeAtLeast: roundedSize)
-		AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
-								inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
-		[:segAddress|
-		 savedFirstFieldsSpace
-			start: segAddress asUnsignedIntegerPtr;
-			limit: segAddress asUnsignedIntegerPtr + allocatedSize.
-		 savedFirstFieldsSpaceNotInOldSpace := true.
-		 self assert: self savedFirstFieldsSpaceWasAllocated.
-		 ^true].
-	^false
+	(manager
+		 sqAllocateMemorySegmentOfSize: roundedSize
+		 Above: (manager segmentManager firstGapOfSizeAtLeast: roundedSize)
+		 AllocatedSizeInto: (self
+				  cCode: [ self addressOf: allocatedSize ]
+				  inSmalltalk: [ [ :sz | allocatedSize := sz ] ])) ifNotNil: [ :segAddress |
+		self
+			configureSavedFirstFieldsSpaceStart:
+			segAddress asUnsignedIntegerPtr
+			limit: segAddress asUnsignedIntegerPtr + allocatedSize
+			isOldSpace: true.
+		self assert: self savedFirstFieldsSpaceWasAllocated.
+		^ true ]. "sent to the manager so that the simulator can increase memory to simulate a new segment"
+	^ false
 ]
 
 { #category : #private }

smalltalksrc/VMMakerTests/VMSpurOldSpaceGarbageCollectorTest.class.st

@@ -220,6 +220,61 @@ VMSpurOldSpaceGarbageCollectorTest >> testAnOldObjectReferencedFromVMVariableSho
 	self assertHashOf: self keptObjectInVMVariable1 equals: hash
 ]
 
+{ #category : #ephemerons }
+VMSpurOldSpaceGarbageCollectorTest >> testCompactEphemeronQueuePass1 [
+
+	| ephemeron |
+
+	"For first compaction pass"
+	"Hole, then mourn queue"
+	self newOldSpaceObjectWithSlots: 0.
+	memory initializeMournQueue.
+
+	"For second compaction pass"
+	"Hole, then ephemeron. Does not really need to be an ephemeron for this tests, any object does it"
+	self newOldSpaceObjectWithSlots: 0.	
+	ephemeron := self newOldSpaceObjectWithSlots: 0.
+	self keepObjectInVMVariable1: ephemeron.
+	memory push: ephemeron onObjStack: memory mournQueue.
+
+	"Compact"
+	memory garbageCollectForSnapshot.
+
+	"Assert?"
+	self assert: (memory sizeOfObjStack: memory mournQueue) equals: 1.
+	self assert: memory dequeueMourner equals: self keptObjectInVMVariable1.
+]
+
+{ #category : #ephemerons }
+VMSpurOldSpaceGarbageCollectorTest >> testCompactEphemeronQueuePass2 [
+
+	| ephemeron |
+
+	"For first compaction pass"
+	"Hole, then mourn queue"
+	self newOldSpaceObjectWithSlots: 0.
+	memory initializeMournQueue.
+
+	"For second compaction pass"
+	"Hole, then ephemeron. Does not really need to be an ephemeron for this tests, any object does it"
+	self newOldSpaceObjectWithSlots: 0.	
+	ephemeron := self newOldSpaceObjectWithSlots: 0.
+	self keepObjectInVMVariable1: ephemeron.
+	memory push: ephemeron onObjStack: memory mournQueue.
+
+	"Set the number of objects to compact per compact Phase.
+	We set N=1 to make two compaction phases.
+	The first phase will compact the mourn queue.
+	The second phase will compact the ephemeron."
+	memory compactor savedFirstFieldSpaceMaxSlots: 1.
+
+	"Compact"
+	memory garbageCollectForSnapshot.
+
+	self assert: (memory sizeOfObjStack: memory mournQueue) equals: 1.
+	self assert: memory dequeueMourner equals: self keptObjectInVMVariable1.
+]
+
 { #category : #'tests-OldSpaceSize' }
 VMSpurOldSpaceGarbageCollectorTest >> testDoNotCollectRoots [