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

commits at source.squeak.org commits at source.squeak.org
Sat Jan 7 22:52:25 UTC 2023


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

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

Name: VMMaker.oscog.seperateMarking-WoC.3294
Author: WoC
Time: 7 January 2023, 11:52:00.010246 pm
UUID: aa33ebd9-2615-4d8c-ba09-eda253ad22b7
Ancestors: VMMaker.oscog.seperateMarking-WoC.3293

- small refactoring in CompactingSweeper

- reapaired SpurStopTheWorldGC
	- implemented missing compliance methods
	- avoid writing any mappings for static polymorphism when generating stop the world gc
	- repair handling of ephemeron stack (init it and trace it at the start of marking)
	- corrected comment

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

Item was changed:
  ----- Method: SpurAllAtOnceMarker>>markAndTraceHiddenRoots (in category 'marking') -----
  markAndTraceHiddenRoots
  	"The hidden roots hold both the class table pages and the obj stacks,
  	 and hence need special treatment.  The obj stacks must be marked
  	 specially; their pages must be marked, but only the contents of the
  	 mournQueue should be marked.
  
  	 If a class table page is weak we can mark and trace the hiddenRoots,
  	 which will not trace through class table pages because they are weak.
  	 But if class table pages are strong, we must mark the pages and *not*
  	 trace them so that only classes reachable from the true roots will be
  	 marked, and unreachable classes will be left unmarked."
  
  	self markAndTraceObjStack: manager markStack andContents: false.
  	self markAndTraceObjStack: manager weaklingStack andContents: false.
  	self markAndTraceObjStack: manager mournQueue andContents: true.
+ 	self markAndTraceObjStack: manager ephemeronStack andContents: true.
  
  	self setIsMarkedOf: manager rememberedSetObj.
  	self setIsMarkedOf: manager freeListsObj.
  
  	(manager isWeakNonImm: manager classTableFirstPage) ifTrue:
  		[^self markAndTrace: manager hiddenRootsObj].
  
  	self setIsMarkedOf: manager hiddenRootsObj.
  	self markAndTrace: manager classTableFirstPage.
  	1 to: manager numClassTablePages - 1 do:
  		[:i| self setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)]!

Item was changed:
  ----- Method: SpurAllAtOnceMarker>>markersMarkObjects: (in category 'marking') -----
  markersMarkObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
  	<inline: #never> "for profiling"
  	"Mark all accessible objects.  objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
  	 is true if all objects are unmarked and/or if unmarked classes shoud be removed from the class table."
  	"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'marking...'; flush].
  	manager runLeakCheckerFor: GCModeFull.
  
  	manager shutDownGlobalIncrementalGC: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
  	manager initializeUnscannedEphemerons.
  	manager initializeMarkStack.
  	manager initializeWeaklingStack.
+ 	manager initializeEphemeronStack.
  	marking := true.
  	self markAccessibleObjectsAndFireEphemerons.
  	manager expungeDuplicateAndUnmarkedClasses: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
  	manager nilUnmarkedWeaklingSlotsExcludingYoungObjects: false.
  	marking := false!

Item was changed:
  ----- Method: SpurGarbageCollector class>>declareCVarsIn: (in category 'as yet unclassified') -----
  declareCVarsIn: aCCodeGenerator
  
  	super declareCVarsIn: aCCodeGenerator.
  	aCCodeGenerator
  		var: #allocatorShouldAllocateBlack type: #usqInt.
  		
  	"do not generate polymorphic methods for abstract baseclass SpurGarbageCollector"
  	self = SpurGarbageCollector ifTrue: [^ self].
+ 	SpurMemoryManager wantsIncrementalGC ifFalse: [^ self].
  	
  	aCCodeGenerator
  		staticallyResolvedPolymorphicReceiver: 'marker' to: self markerClass in: self;
  		staticallyResolvedPolymorphicReceiver: 'compactor' to: self compactorClass in: self.
  		
  	self selectorsInIncrementalAndStopTheWorldGC
  		do: [:key |
  			aCCodeGenerator
  				staticallyResolveMethodNamed: key 
  				forClass: self 
  				to: (self staticallyResolvePolymorphicSelector: key)].!

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.
  					 "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 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.
- 										(self oop: fillStart + bytesToCopy isLessThan: (segmentToFill segLimit - manager bridgeSize))
- 											ifFalse: ["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.
  
  												^ fillStart].
  
  										self migrate: entity sized: bytesToCopy to: fillStart.
  
  										fillStart := fillStart + bytesToCopy.
  										self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]
+ 						ifFalse: [self handleUnmarkedEntity: entity]]].
- 						ifFalse: [
- 							(manager isRemembered: entity)
- 								ifTrue: 
- 									[self assert: (manager isFreeObject: entity) not.
- 									 scavenger forgetObject: entity].
- 						
- 							"To avoid confusing too much Spur (especially the leak/free checks), we don't make the dead object a free chunk, but make it
- 							a non pointer object to avoid the leak checker to try to follow the pointers of the dead object. 
- 							Should we abort compacting this segment the object will get kept alife for one gc cycle" 
- 							manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]]].
  
  	"we want to advance to the next segment from the bridge"
  	currentObject := currentSegmentsBridge.
  	^ fillStart!

Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>handleUnmarkedEntity: (in category 'compaction planning') -----
+ handleUnmarkedEntity: entity
+ 
+ 	(manager isRemembered: entity)
+ 		ifTrue: 
+ 			[self assert: (manager isFreeObject: entity) not.
+ 			 scavenger forgetObject: entity].
+ 
+ 	"To avoid confusing too much Spur (especially the leak/free checks), we don't make the dead object a free chunk, but make it
+ 	a non pointer object to avoid the leak checker to try to follow the pointers of the dead object. 
+ 	Should we abort compacting this segment the object will get kept alife for one gc cycle" 
+ 	manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat!

Item was added:
+ ----- 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 added:
+ ----- Method: SpurIncrementalCompactingSweeper>>would:overflowSegment: (in category 'compaction planning') -----
+ would: address overflowSegment: segInfo
+ 
+ 	^ (self oop: address isLessThan: (segInfo segLimit - manager bridgeSize))!

Item was changed:
  ----- Method: SpurIncrementalMarker>>incrementalMark (in category 'marking - incremental') -----
  incrementalMark
  	"does one marking cycle. Breaks after a certain amount of slots is marked and the last object, that amount is crossed in, is completely scanned"
  
  	| currentObj slotsLeft |
  	"manager objStack: manager markStack do: [:index :page | Transcript showln: (manager fetchPointer: index ofObject: page)].
  	manager sizeOfObjStack: manager markStack"
  	currentObj := manager popObjStack: manager markStack.
  	"skip young objects. They get already scanned as they are part of the roots"
  	[(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]]
  			whileTrue: [(manager isInClassTable: currentObj) ifTrue: [self setIsMarkedOf: currentObj ].
  				currentObj := manager popObjStack: manager markStack].
  	
  	currentObj
  		ifNil: [^ true]. "there is nothing more on the stack and we are done"
  		
  	slotsLeft := SlotLimitPerPass.
  	
  	[
  		| slotNumber slotsToVisit startIndex |
  		
  		"after passing the limit we push the current index on the stack. Is the currentObj only an index? "
  		(manager isImmediate: currentObj)
  			ifTrue: [startIndex := manager integerValueOf: currentObj.
  				currentObj := manager popObjStack: manager markStack.]
  			ifFalse: [startIndex := 0.
  				
  				self assert: (manager isFreeObject: currentObj) not.
  				(manager isForwarded: currentObj)
  					ifTrue: [currentObj := manager followForwarded: currentObj].
  				
+ 				self flag: #Todo. "young objects can fall out of a forwarder. Do not follow them"
  				self assert: (manager isYoung: currentObj) not.
  				
  				self markAndTraceClassOf: currentObj.
  				
  				"eager color the object black. Either it will get scanned completely and the color is correct
  				or we have at least scanned some of the slots. In the second case the mutator could 
  				modify one of the slots of the object that already were scanned and we would could lose
  				this object. Therefore color the object early to trigger the write barrier on writes. There will
  				be some overhead (trigger the barrier always although only the already scanned slots are
  				technically black) but it seems we need to do this for correctness"
  				self blackenObject: currentObj].
  			
  		slotNumber := manager numStrongSlotsOfInephemeral: currentObj.
  		slotsToVisit := slotNumber - startIndex.
  		
  		slotsLeft - slotsToVisit < 0
  			ifTrue: [ | countThatCanBeVisited |
  				countThatCanBeVisited := slotsToVisit - slotsLeft.
  				self 
  					markFrom: startIndex
  					nSlots: countThatCanBeVisited
  					of: currentObj.
  						
  				"If we need to abort earlier we push the index and the currently scanned object on the marking stack. Otherwise it is not possible
  				for immediates to be on the stack (they have no fields to be scanned) -> we can use the immediated to detect this pattern"
  				(manager topOfObjStack: manager markStack) ~= currentObj ifTrue: 
  						[manager push: currentObj onObjStack: manager markStack].
  				manager 
  					push: (manager integerObjectOf: startIndex + countThatCanBeVisited) 
  					onObjStack: manager markStack.
  				
  				"we need to abort early to not run into some extreme corner cases (giant objects) that would explode our mark time assumptions"
  				^ false]
  			ifFalse: ["we can mark all"
  				slotsLeft := slotsLeft - slotsToVisit.
  				
  				self markFrom: startIndex nSlots: slotsToVisit of: currentObj].		
  
  		currentObj := manager popObjStack: manager markStack.
  		
  		[(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]]
  			whileTrue: [(manager isInClassTable: currentObj) ifTrue: [self setIsMarkedOf: currentObj].
  				currentObj := manager popObjStack: manager markStack].
  	"repeat while there still are objects"
  	currentObj notNil] whileTrue.
  
  	^ true!

Item was changed:
  ----- Method: SpurIncrementalSweeper>>incrementalSweep (in category 'api - incremental') -----
  incrementalSweep
  	<inline: #never> "for profiling"
  	
  	self initIfNecessary.
  	
+ 	"should in between sweeper calls segments be removed the index would not be correct anymore. Reset it here so we can be sure it is correct"
+ 	currentSegmentsIndex := manager segmentManager segmentIndexContainingObj: currentSweepingEntity.
+ 	"if the bridge between segments was small before and the segment directly after the current one was removed the position of the bridge moved. Update 
+ 	the current position to avoid this case"
+ 	currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
+ 	
  	self assert: manager validObjectColors.
  	
  	self doIncrementalSweeping
  		ifTrue: [self finishSweeping.
  			^ true].
  		
  	^ false
  	!

Item was changed:
  ----- Method: SpurMemoryManager class>>gcClass (in category 'accessing class hierarchy') -----
  gcClass
  	"Answer the garbage collection algorithm to use."
+ 	^Smalltalk classNamed: (InitializationOptions at: #gcClass ifAbsent: [#SpurStopTheWorldGarbageCollector])!
- 	^Smalltalk classNamed: (InitializationOptions at: #gcClass ifAbsent: [#SpurIncrementalGarbageCollector])!

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.
  
  	"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, 32k bytes per page in 64 bits"
  	ObjStackTopx := 0.
  	ObjStackMyx := 1.
  	ObjStackFreex := 2.
  	ObjStackNextx := 3.
  	ObjStackFixedSlots := 4.
  	ObjStackLimit := ObjStackPageSlots - ObjStackFixedSlots.
  	"The hiddenRootsObject contains the classTable pages and up to 8 additional objects.
+ 	 Currently we use five; the four objStacks (the mark stack, the weaklings and the
- 	 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.
  	EphemeronStackRootIndex := MarkStackRootIndex + 4.
  
  	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 := 64. "max. # of external roots; used e.g. by the PyBridge plugin which uses three entries"
  
  	"gcPhaseInProgress takes these values to identify phases as required."
  	ScavengeInProgress := 1.
  	SlidingCompactionInProgress := 2!

Item was added:
+ ----- Method: SpurPlanningCompactor>>segmentToFill (in category 'as yet unclassified') -----
+ segmentToFill
+ 
+ 	^ nil!

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>inSweepingAheadOfSweepersPosition: (in category 'as yet unclassified') -----
+ inSweepingAheadOfSweepersPosition: objOop
+ 
+ 	^ false!

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>maybeModifyCopiedObject: (in category 'object creation barriers') -----
+ maybeModifyCopiedObject: objOop
+ 
+ !

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>maybeModifyForwarder: (in category 'object creation barriers') -----
+ maybeModifyForwarder: objOop!

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>maybeModifyGCFlagsOf: (in category 'object creation barriers') -----
+ maybeModifyGCFlagsOf: objOop!



More information about the Vm-dev mailing list