[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3305.mcz

[commits at source.squeak.org]

Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3305.mcz

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

Name: VMMaker.oscog.seperateMarking-WoC.3305
Author: WoC
Time: 13 January 2023, 12:50:43.423711 am
UUID: 291d0777-24d3-47f4-8046-02acd6de34ad
Ancestors: VMMaker.oscog.seperateMarking-WoC.3304

handle pinned objects during compaction
	- try to keep track of them during marking
	- abort compaction if we find one in the to be compacted segment
	- add assert to forward:to: to forbid forwarding pinned objects
	
- naive approach to scheduling incremental compacts (needs more work, just an experiment)

- added comment why we replace the pointer in the remembered set

=============== Diff against VMMaker.oscog.seperateMarking-WoC.3304 ===============

Item was changed:
  ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'header access') -----
  setIsMarkedOf: objOop
  
  	| segmentContainingObject |
  	super setIsMarkedOf: objOop.
  	
  	self flag: #Todo. "we need a more efficient way to get the segment"
  	segmentContainingObject := manager segmentManager segmentContainingObj: objOop.
  	
  	self 
  		setUsedMemory: (self getUsedMemoryOf: segmentContainingObject) + (manager bytesInBody: objOop) 
  		for: segmentContainingObject.
  		
  	self 
  		setLifeObjectCount: (self getLifeObjectCountOf: segmentContainingObject)  + 1
+ 		for: segmentContainingObject.
+ 		
+ 	(manager isPinned: objOop)
+ 		ifTrue: [segmentContainingObject containsPinned: true]!
- 		for: segmentContainingObject!

Item was changed:
  ----- Method: SpurIncremental2PhaseGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
  doIncrementalCollect
  	
  	| startTime |
  	
  	phase = InMarkingPhase
  		ifTrue: [ | finishedMarking |
  			marker isCurrentlyMarking
+ 				ifFalse: [self assert: manager allObjectsUnmarked.
+ 					manager segmentManager prepareForGlobalSweep].
- 				ifFalse: [self assert: manager allObjectsUnmarked].
  			
  			coInterpreter cr; print: 'start marking '; tab; flush.
  			finishedMarking := marker incrementalMarkObjects.
  			
  			"self assert: manager validObjectColors."
  			
  			finishedMarking
  				ifTrue: [
  					"manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)]."
  					
  					"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
  					We only know if they should get swept after the next marking -> keep them alive for this cycle"
  					self allocatorShouldAllocateBlack: true.
  					compactor setInitialSweepingEntity.
  					phase := InSweepingPhase.
  					
  					"marking is done and thus all forwarding from the last compaction references are resolved 
  						-> we can use the now free segments that were compacted during the last cycle"
  					compactor freePastSegmentsAndSetSegmentToFill.
  					compactor assertNoSegmentBeingCompacted.
  					
  					self assert: manager noObjectGrey.
  					
  					coInterpreter cr; print: 'finish marking '; tab; flush.
  					
  					startTime := coInterpreter ioUTCMicrosecondsNow.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
  						checkFreeSpace: GCModeFull.
  						
  					manager clearLeakMapAndMapMarkedOrYoungObjects.
  					coInterpreter checkStackIntegrity.
  						
  					coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  					
  					0 to: manager numSegments - 1
  						do: [:i | | segInfo |
  							segInfo := manager segInfoAt: i.
  							coInterpreter cr; print: 'occupation from marking: '; printNum: (compactor occupationOf: segInfo) * 100; tab; 
  							print: '('; printNum: (marker getLifeObjectCountOf: segInfo); print: ' objects -> ' ;printNum: (compactor sizeClaimedIn: segInfo) ; print: ' bytes)'  ;flush].
  						
  					manager printSegmentOccupationFromMarkedObjects.
  					
  					^ self]
  				ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush. "manager runLeakCheckerFor: GCModeIncremental"]].
  		
  	phase = InSweepingPhase
  		ifTrue: [
  			coInterpreter cr; print: 'start sweeping '; tab; flush.
  			compactor incrementalSweepAndCompact
  				ifTrue: [
  					self allocatorShouldAllocateBlack: false.
  					self assert: manager allObjectsWhite.
  					"self assert: manager allObjectsUnmarked."
  					
  					coInterpreter cr; print: 'finish sweeping '; tab; flush.
  					
  					startTime := coInterpreter ioUTCMicrosecondsNow.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull;
  						checkFreeSpace: GCModeFull.
  					coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  					
  					phase := InMarkingPhase.
+ 					
+ 					fullGCWanted := false.
  					^ self]]!

Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>abortCompactionAt:in: (in category 'incremental compact') -----
+ abortCompactionAt: entity in: segInfo
+ 
+ 	<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 	"somebody allocated a new object we did not knew about at the moment of planning :( 
+ 		-> it does not fit anymore and we cannot free the whole segment or the object is pinned. Make sure to 
+ 		unmark the segment as beeing compacted as it would be completetly freed otherwise!!"
+ 	(manager isPinned: entity)
+ 		ifTrue: [coInterpreter cr; print: 'segments contains pinned object. ']
+ 		ifFalse: [coInterpreter cr; print: 'segments if full. '].
+ 	coInterpreter cr; print: 'Abort compacting of:  '; printHex: segInfo segStart ; tab; flush.
+ 	self 
+ 		unmarkSegment: self currentSegment
+ 		asBeingCompactedAndSaveEndOfCompactionAddress: entity.
+ 		
+ 	"we need to sweep the rest of the segment. As the segment is not marked to be compacted 
+ 	anymore sweepOrCompactFromCurrentObject will decide to sweep it. We want to start 
+ 	sweeping from the current entity, therefore setting currentObject to it and we have to protect 
+ 	it from beeing freed (with marking it) as it was marked previously and after us unmarking it here would
+ 	get collected incorrectly"
+ 	manager setIsMarkedOf: entity to: true.
+ 	currentObject := entity.!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>compactSegment:freeStart:segIndex: (in category 'incremental compact') -----
  compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  
  	| fillStart |
  	fillStart := initialFreeStart.
  	
  	self deny: segIndex = 0. "Cannot compact seg 0"
  	manager segmentManager
  		allEntitiesInSegment: segInfo
  		exceptTheLastBridgeDo:
  			[:entity |
  			(manager isFreeObject: entity)
  				ifTrue: 
  					[manager detachFreeObject: entity.
  					currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.
  					 "To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
  					 manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
  				ifFalse: 
+ 					[ 
+ 					(manager isPinned: entity)
+ 						ifTrue: [manager debugger].
+ 					
+ 					(manager isMarked: entity)
+ 						ifTrue: [| bytesToCopy |
+ 							"note: we copy even forwarders if they are marked so they cannot get lost"
+ 							manager makeWhite: entity.
+ 							
+ 							"I really hat that this can happen :( . The marker will keep track of which segments contain pinned objects.
+ 							If the pinned object is created during sweeping and compacting, we cannot know about it while working at
+ 							our plan we did at the start of sweeping and compacting"
+ 							(manager isPinned: entity)
+ 								ifTrue: [self abortCompactionAt: entity in: segInfo].
- 					[ (manager isMarked: entity)
- 						ifTrue: [manager makeWhite: entity.
- 							"During the mutator runs new forwarding references can be created. Ignore them as they get resolved with the other 
- 							forwarders in this segment in the next marking pass"
- 								(manager isForwarded: entity) 
- 									ifFalse:[| bytesToCopy |
- 										"Copy the object in segmentToFill and replace it by a forwarder."
- 										bytesToCopy := manager bytesInBody: entity. 
- 										
- 										(self would: fillStart + bytesToCopy overflowSegment: segmentToFill)
- 											ifFalse: [
- 												self handleWouldBeCompactionOverflow: entity in: segInfo.
  
+ 							bytesToCopy := manager bytesInBody: entity. 
+ 							
+ 							(self would: fillStart + bytesToCopy overflowSegment: segmentToFill)
+ 								ifFalse: [
+ 									self abortCompactionAt: entity in: segInfo.
- 												^ fillStart].
- 											
- 										"let's make copying more expensive. Number is just a guess"
- 										currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 100.
- 										self migrate: entity sized: bytesToCopy to: fillStart.
  
+ 									^ fillStart].
+ 								
+ 							"let's make copying more expensive. Number is just a guess"
+ 							currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 100.
+ 							self migrate: entity sized: bytesToCopy to: fillStart.
+ 
+ 							fillStart := fillStart + bytesToCopy.
+ 							self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]
- 										fillStart := fillStart + bytesToCopy.
- 										self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]
  						ifFalse: [self handleUnmarkedEntity: entity]]].
  
  	"we want to advance to the next segment from the bridge"
  	currentObject := currentSegmentsBridge.
  	^ fillStart!

Item was removed:
- ----- Method: SpurIncrementalCompactingSweeper>>handleWouldBeCompactionOverflow:in: (in category 'compaction planning') -----
- handleWouldBeCompactionOverflow: entity in: segInfo
- 
- 	"somebody allocated a new object we did not knew about at the moment of planning :( 
- 		-> it does not fit anymore and we cannot free the whole segment. Make sure to 
- 		unmark the segment as beeing compacted as it would be completetly freed otherwise!!"
- 	coInterpreter cr; print: 'segments if full. Abort compacting of:  '; printHex: segInfo segStart ; tab; flush.
- 	self 
- 		unmarkSegment: self currentSegment
- 		asBeingCompactedAndSaveEndOfCompactionAddress: entity.
- 		
- 	"we need to sweep the rest of the segment. As the segment is not marked to be compacted 
- 	anymore sweepOrCompactFromCurrentObject will decide to sweep it. We want to start 
- 	sweeping from the current entity, therefore setting currentObject to it and we have to protect 
- 	it from beeing freed (with marking it) as it was marked previously and after us unmarking it here would
- 	get collected incorrectly"
- 	manager setIsMarkedOf: entity to: true.
- 	currentObject := entity.!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>initialize (in category 'initialize-release') -----
  initialize
  
  	isCurrentlyWorking := false.
  	currentSegmentsIndex := 0.
  	currentsCycleSeenObjectCount := 0.
  	currentSegmentsBridge := nil.
  	currentObject := nil.
  	segmentToFill := nil.
  	shouldCompact := false.
  	currentCopyToPointer := nil.
+ 	maxObjectsToFree := InitialMaxObjectsToFree!
- 	maxObjectsToFree := MaxObjectsToFree!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>migrate:sized:to: (in category 'incremental compact') -----
  migrate: obj sized: bytesToCopy to: address
  
  	| copy |
  	self assert: (manager isPinned: obj) not. 
  	
  	manager memcpy: address asVoidPointer _: (manager startOfObject: obj) asVoidPointer _: bytesToCopy.
  	
  	copy := manager objectStartingAt: address.
  	 (manager isRemembered: copy) ifTrue: 
+ 		["replace the pointer in the remembered set instead of leaving it there. It could get hidden inside the free chunk that will get
+ 		created after the next marking phase and the sweeper won't be able to find it and make the scavenger forget it."
+ 		scavenger remember: copy insteadOf: obj].
- 		[scavenger remember: copy insteadOf: obj].
  	
  	 manager forward: obj to: (manager objectStartingAt: address). 
  	
  	^ copy!

Item was changed:
  SpurGarbageCollector subclass: #SpurIncrementalGarbageCollector
+ 	instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags stopTheWorldGC fullGCWanted'
- 	instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags stopTheWorldGC'
  	classVariableNames: 'InCompactingPhase InMarkingPhase InSweepingPhase'
  	poolDictionaries: ''
  	category: 'VMMaker-SpurGarbageCollector'!
  
  !SpurIncrementalGarbageCollector commentStamp: 'WoC 1/5/2023 21:36' prior: 0!
  A SpurIncrementalGarbageCollector is a garbage collection algorithm. The GC is a mark and sweep with an additional compaction if certain conditions are fulfilled.
  This class manages SpurIncrementalMarker and SpurIncrementalSweepAndCompact (which in turn manages SpurIncrementalCompactor and SpurIncrementalSweeper). The 3 classes 
  implementing the GC are therefore SpurIncrementalMarker, SpurIncrementalSweeper and SpurIncrementalCompactor.
  
  Instance Variables
  	allAtOnceMarker:		<SpurAllAtOnceMarker>
  	checkSetGCFlags:		<Bool>
  	phase:		<Number (InMarkingPhase|InSweepingPhase|InCompactingPhase)>
  
  allAtOnceMarker
  	- an instance of SpurAllAtOnceMarker. We sometimes need parts of the old (stop-the-world) gc algorithm. This is the marking algorithm we can use through static polymorphism
  
  checkSetGCFlags
  	- should we check if it ok to set gc flags or not
  
  phase
  	- in which phase is the gc algorithm at the moment. Is either InMarkingPhase, InSweepingPhase or InCompactingPhase
  !

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
  doIncrementalCollect
  	
  	| startTime |
  	
  	phase = InMarkingPhase
  		ifTrue: [ | finishedMarking |
  			marker isCurrentlyMarking
  				ifFalse: [self assert: manager allObjectsUnmarked].
  			
  			coInterpreter cr; print: 'start marking '; tab; flush.
  			finishedMarking := marker incrementalMarkObjects.
  			
  			"self assert: manager validObjectColors."
  			
  			finishedMarking
  				ifTrue: [
  					manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
  					
  					"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
  					We only know if they should get swept after the next marking -> keep them alive for this cycle"
  					self allocatorShouldAllocateBlack: true.
  					compactor setInitialSweepingEntity.
  					phase := InSweepingPhase.
  					
  					"marking is done and thus all forwarding from the last compaction references are resolved 
  						-> we can use the now free segments that were compacted during the last cycle"
  					compactor freePastSegmentsAndSetSegmentToFill.
  					
+ 					manager segmentManager prepareForGlobalSweep.
+ 					
  					self assert: manager noObjectGrey.
  					
  					coInterpreter cr; print: 'finish marking '; tab; flush.
  					
  					startTime := coInterpreter ioUTCMicrosecondsNow.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
  						checkFreeSpace: GCModeFull.
  						
  					coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  						
  					
  					^ self]
  				ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
  		
  	phase = InSweepingPhase
  		ifTrue: [
  			coInterpreter cr; print: 'start sweeping '; tab; flush.
  			compactor incrementalSweep
  				ifTrue: [
  					self allocatorShouldAllocateBlack: false.
  					manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
  					"self assert: manager allObjectsUnmarked."
  					
  					coInterpreter cr; print: 'finish sweeping '; tab; flush.
  					
  					startTime := coInterpreter ioUTCMicrosecondsNow.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull;
  						checkFreeSpace: GCModeFull.
  					coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  						
  					compactor assertNoSegmentBeingCompacted.
  					
  					phase := InCompactingPhase.
  					^ self]].
  		
  	phase = InCompactingPhase
  		ifTrue: [
  			"self cCode: 'raise(SIGINT)'."
  			coInterpreter cr; print: 'start compacting '; tab; flush.
  			compactor isCurrentlyCompacting
  				ifFalse: [manager printFreeSpaceStatistics].
  			compactor incrementalCompact
  				ifTrue: [
  					coInterpreter cr; print: 'finish compacting '; tab; flush.
  					
  					startTime := coInterpreter ioUTCMicrosecondsNow.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull;
  						checkFreeSpace: GCModeFull.
  					coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  					
  					phase := InMarkingPhase.
  					
+ 					fullGCWanted := false.
+ 					
  					^ self]]!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>doScavenge: (in category 'scavenge') -----
  doScavenge: tenuringCriterion
  
  	"The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
  	<inline: false>
  	manager doAllocationAccountingForScavenge.
  	manager gcPhaseInProgress: ScavengeInProgress.
  	manager pastSpaceStart: (scavenger scavenge: tenuringCriterion).
  	self assert: (self
  					oop: manager pastSpaceStart
  					isGreaterThanOrEqualTo: scavenger pastSpace start
  					andLessThanOrEqualTo: scavenger pastSpace limit).
  	manager freeStart: scavenger eden start.
  	manager gcPhaseInProgress: 0.
  	manager resetAllocationAccountingAfterGC.
  	
+ 	(fullGCWanted or: [self numSegmentsAboutToBeFreed > 0])
+ 		ifTrue: [self incrementalCollect]
+ 	!
- 	self incrementalCollect!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>initialize (in category 'initialize-release') -----
  initialize
  
  	super initialize.
  	
  	checkSetGCFlags := true.
  	phase := InMarkingPhase.
+ 	fullGCWanted := false.
+ 	
  	allAtOnceMarker := SpurAllAtOnceMarker new.
  	stopTheWorldGC := SpurStopTheWorldGarbageCollector new.
  	
  	stopTheWorldGC marker: allAtOnceMarker.
  	stopTheWorldGC compactor: SpurPlanningCompactor new!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>sufficientSpaceAfterGC: (in category 'as yet unclassified') -----
  sufficientSpaceAfterGC: numBytes
  
  	| heapSizePostGC |
  	self assert: numBytes = 0.
  	self scavengingGCTenuringIf: TenureByAge.
  	heapSizePostGC := manager segmentManager totalOldSpaceCapacity - manager totalFreeOldSpace.
  	(heapSizePostGC - manager heapSizeAtPreviousGC) asFloat / manager heapSizeAtPreviousGC >= manager heapGrowthToSizeGCRatio
+ 		ifTrue: [fullGCWanted := true] "fullGC will attempt to shrink"
- 		ifTrue: ["self fullGC"] "fullGC will attempt to shrink"
  		ifFalse: "Also attempt to shrink if there is plenty of free space and no need to GC"
  			[manager totalFreeOldSpace > (manager shrinkThreshold * 2) ifTrue:
  				[manager attemptToShrink.
  				 ^true]].
  		
  	self flag: #Todo. "we probably want here something more sophisticated, like tak into account how many
  	objects survived tenuring in the near past and how much work is still to be done until marking is finished
  	and the segments get freed. Until then just assume the compacted segments get freed soon enough"
  	[self numSegmentsAboutToBeFreed = 0 "lets wait until we get more space"
  	 and: [manager totalFreeOldSpace < manager growHeadroom
  	 and: [(manager growOldSpaceByAtLeast: 0) notNil]]] whileTrue:
  		[manager totalFreeOldSpace >= manager growHeadroom ifTrue:
  			[^true]].
  	manager lowSpaceThreshold > manager totalFreeOldSpace ifTrue: "space is low"
  		[manager lowSpaceThreshold: 0. "avoid signalling low space twice"
  		 ^false].
  	^true!

Item was changed:
  ----- Method: SpurMemoryManager>>forward:to: (in category 'become implementation') -----
  forward: obj1 to: obj2
+ 
+ 	self assert: (self isPinned: obj1) not.
+ 
  	self set: obj1 classIndexTo: self isForwardedObjectClassIndexPun formatTo: self forwardedFormat.
  	self cppIf: IMMUTABILITY ifTrue: [ self setIsImmutableOf: obj1 to: false ].
  	self storePointer: 0 ofForwarder: obj1 withValue: obj2.
  	gc maybeModifyForwarder: obj1. 
  	"For safety make sure the forwarder has a slot count that includes its contents."
  	(self rawNumSlotsOf: obj1) = 0 ifTrue:
  		[self rawNumSlotsOf: obj1 put: 1]!