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

commits at source.squeak.org commits at source.squeak.org
Thu Aug 11 13:46:51 UTC 2022


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

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

Name: VMMaker.oscog.seperateMarking-WoC.3253
Author: WoC
Time: 11 August 2022, 3:46:03.942968 pm
UUID: b99e4bbb-6ada-4c8e-a156-ccc460434dd4
Ancestors: VMMaker.oscog.seperateMarking-WoC.3252

shutdown incremental marking and reset the state correctly for enumeration primitives
added missing class tracing for complete marking

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

Item was added:
+ ----- Method: SpurGarbageCollector>>markObjectsForEnumerationPrimitives (in category 'as yet unclassified') -----
+ markObjectsForEnumerationPrimitives
+ 
+ 	^ self shouldBeImplemented!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
  doIncrementalCollect
  
  	phase = InMarkingPhase
  		ifTrue: [
  			marker incrementalMarkObjects
  				ifTrue: [
  					"manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)]."
+ 					manager 
+ 						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
+ 						runLeakCheckerFor: GCModeFull;
+ 						checkFreeSpace: GCModeFull.
- 					manager runLeakCheckerFor: GCModeFull.
  					
  					"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.
  					phase := InSweepingPhase.
  					
  					"marking is done and thus all forwarding references are resolved -> we can use the now free segments that were 
  					compacted during the last cycle"
  					compactor freePastSegmentsAndSetSegmentToFill.
  					
  					^ self]
  				ifFalse: [manager runLeakCheckerFor: GCModeIncremental]].
  		
  	phase = InSweepingPhase
  		ifTrue: [
  			compactor incrementalSweep
  				ifTrue: [
  					self allocatorShouldAllocateBlack: false.
  					manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
  					"self assert: manager allObjectsUnmarked."
  					phase := InCompactingPhase.
  					^ self]].
  		
  	phase = InCompactingPhase
  		ifTrue: [
  			compactor incrementalCompact
  				ifTrue: [phase := InMarkingPhase.
  					^ self]]!

Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>markObjectsForEnumerationPrimitives (in category 'as yet unclassified') -----
+ markObjectsForEnumerationPrimitives
+ 
+ 	"do we need marking complete (and more accurate than incremental marking provides). For now lets do this only during marking although
+ 	probaly not 100% correct"
+ 	self flag: #Todo. "rework later on"
+ 	^ phase = InMarkingPhase!

Item was changed:
  ----- Method: SpurIncrementalMarker>>completeMark (in category 'marking - global') -----
  completeMark
  	"finishes the current mark pass"
  
  	| 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.
  	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 := currentObj.
  				currentObj := manager popObjStack: manager markStack.]
  			ifFalse: [startIndex := 0].
  			
+ 		self markAndTraceClassOf: currentObj.
+ 			
  		slotNumber := manager numStrongSlotsOfInephemeral: currentObj.
  		slotsToVisit := slotNumber - startIndex.
  		
  		"we can mark all"
  		slotsLeft := slotsLeft - slotsToVisit.
  		
  		self markFrom: startIndex nSlots: slotsToVisit of: currentObj.		
  
  		"we finished everything there is to be done with to obj -> make it black"
  		self blackenObject: currentObj.
  		currentObj := manager popObjStack: manager markStack.
  	"repeat while there still are objects"
  	currentObj notNil] whileTrue.
  
  	^ true!

Item was changed:
  ----- Method: SpurIncrementalMarker>>completeMarkObjects (in category 'marking - global') -----
  completeMarkObjects
  	"this method is meant to be run for a complete GC that is used for snapshots. It discards previous marking information, because
  	this will probably include some objects that should be collected
  	It makes me a bit sad but I cannot see how this could be avoided"
  
  	<inline: #never> "for profiling"
  	
- 	manager runLeakCheckerFor: GCModeFull.
- 	
  	"reset and reinitialize all helper structures and do actions to be done at the start of marking"
  	self resetMarkProgress.
  	self initializeForNewMarkingPassIfNecessary.
  	
  	self pushAllRootsOnMarkStack.
  	self completeMark.
  	
+ 	self finishMarking.
+ 	manager runLeakCheckerFor: GCModeFull.
- 	self finishMarking
  
  	!

Item was changed:
  ----- Method: SpurIncrementalMarker>>finishMarking (in category 'as yet unclassified') -----
  finishMarking
  	"marks the structures needed during GC"
  	<inline: #never>
  	
  	1 to: manager numClassTablePages - 1 do:
  		[:i| manager setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)
  				to: true].
  			
  	self flag: #Todo. "handle ephemerons"
  	
  	"lets assume there are not too many for now"
  	self markWeaklingsAndMarkAndFireEphemerons.
  	manager expungeDuplicateAndUnmarkedClasses: true.
  	manager nilUnmarkedWeaklingSlots.
+ 	
+ 	self assert: (manager isEmptyObjStack: manager markStack).
  			
  	isCurrentlyMarking := false.
  	marking := false!

Item was changed:
  ----- Method: SpurIncrementalMarker>>markObjects: (in category 'as yet unclassified') -----
  markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
  
+ 	"mark objects has to mark all available objects in on go (e.g. used in allInstances where you only want live objects so you do not keep objects that should
+ 	be collected alive, as they get collected into an array that then holds a reference to the object)
+ 	In the incremental case we need to throw away our marking progress until now :( (in incremental collection garbage can stay around until the next round
+ 	of collection when we encountered an object during earlier stages of marking when an object is still alive, but it gets unreferenced during one of the 
+ 	following mutator runs)"
+ 	
+ 	self flag: #Todo. "we made a (forced) complete marking. Lets use the results"
+ 	self completeMarkObjects.
+ 	self assert: (manager isEmptyObjStack: manager markStack).!
- 	self flag: #Todo. "is this sane?"
- 	self incrementalMarkObjects!

Item was changed:
  ----- Method: SpurIncrementalSweeper class>>initialize (in category 'as yet unclassified') -----
  initialize
  
+ 	MaxObjectsToFree := 10000!
- 	MaxObjectsToFree := 100000!

Item was changed:
  ----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
  allInstancesOf: aClass
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer the number of instances as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| classIndex freeChunk ptr start limit count bytes |
  	classIndex := self rawHashBitsOf: aClass.
  	classIndex = 0 ifTrue:
  		[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 ^freeChunk].
+ 	gc markObjectsForEnumerationPrimitives ifTrue:
- 	MarkObjectsForEnumerationPrimitives ifTrue:
  		[marker markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
  	freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
  	start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	(self isClassAtUniqueIndex: aClass)
  		ifTrue:
  			[self uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]]
  		ifFalse:
  			[self ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]].
  	self assert: (self isEmptyObjStack: markStack).
+ 	gc markObjectsForEnumerationPrimitives
- 	MarkObjectsForEnumerationPrimitives
  		ifTrue:
  			[self assert: self allObjectsUnmarked.
  			 self emptyObjStack: weaklingStack]
  		ifFalse:
  			[self assert: (self isEmptyObjStack: weaklingStack)].
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeObject: freeChunk.
  		 ^self integerObjectOf: count].
  	count < self numSlotsMask ifTrue:
  		[| smallObj |
  		 smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
  		 0 to: count - 1 do:
  			[:i|
  			self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofFreeChunk: freeChunk)].
  		 self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
  		 self beRootIfOld: smallObj.
  		 self checkFreeSpace: GCModeFull.
  		 ^smallObj].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self rawOverflowSlotsOf: freeChunk put: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace: GCModeFull.
  	self runLeakCheckerFor: GCModeFull.
  	^freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
  allObjects
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer the number of objects as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
  	| freeChunk ptr start limit count bytes |
+ 	gc markObjectsForEnumerationPrimitives ifTrue:
- 	MarkObjectsForEnumerationPrimitives ifTrue:
  		[marker markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
  	freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
+ 		 (gc markObjectsForEnumerationPrimitives
- 		 (MarkObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
+ 					[gc markObjectsForEnumerationPrimitives ifTrue:
- 					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 count := count + 1.
  					 ptr < limit ifTrue:
  						[self longAt: ptr put: obj.
  						 ptr := ptr + self bytesPerOop]]
  				ifFalse:
+ 					[gc markObjectsForEnumerationPrimitives ifTrue:
- 					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self assert: (self isEmptyObjStack: markStack).
+ 	gc markObjectsForEnumerationPrimitives
- 	MarkObjectsForEnumerationPrimitives
  		ifTrue:
  			[self assert: self allObjectsUnmarked.
  			 self emptyObjStack: weaklingStack]
  		ifFalse:
  			[self assert: (self isEmptyObjStack: weaklingStack)].
  	self assert: count >= self numSlotsMask.
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
  		 self checkFreeSpace: GCModeFull.
  		 ^self integerObjectOf: count].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self rawOverflowSlotsOf: freeChunk put: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace: GCModeFull.
  	self runLeakCheckerFor: GCModeFull.
  	^freeChunk!

Item was added:
+ ----- Method: SpurMemoryManager>>allObjectsWhite (in category 'gc - global') -----
+ allObjectsWhite
+ 	self allObjectsDo:
+ 		[:o| ((self isMarked: o) or: [self isGrey: o]) ifTrue: [bogon := o. ^false]].
+ 	^true!

Item was changed:
  ----- Method: SpurMemoryManager>>ambiguousClass:allInstancesInto:limit:resultsInto: (in category 'primitive support') -----
  ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: binaryBlock
  	"Dea with ambiguity and normalize indices."
  	<inline: true>
  	| expectedIndex count ptr |
  	count := 0.
  	ptr := start.
  	expectedIndex := self rawHashBitsOf: aClass.
  	self allHeapEntitiesDo:
  		[:obj| | actualIndex | "continue enumerating even if no room so as to unmark all objects and/or normalize class indices."
+ 		 (gc markObjectsForEnumerationPrimitives
- 		 (MarkObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
+ 					[gc markObjectsForEnumerationPrimitives ifTrue:
- 					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 actualIndex := self classIndexOf: obj.
  					 (self classOrNilAtIndex: actualIndex) = aClass ifTrue:
  					 	[actualIndex ~= expectedIndex ifTrue:
  							[self setClassIndexOf: obj to: expectedIndex].
  						 count := count + 1.
  						 ptr < limit ifTrue:
  							[self longAt: ptr put: obj.
  							 ptr := ptr + self bytesPerOop]]]
  				ifFalse:
+ 					[gc markObjectsForEnumerationPrimitives ifTrue:
- 					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self purgeDuplicateClassTableEntriesFor: aClass.
  	binaryBlock value: count value: ptr
  !

Item was added:
+ ----- Method: SpurMemoryManager>>makeAllObjectsWhite (in category 'primitive support') -----
+ makeAllObjectsWhite
+ 	self allHeapEntitiesDo:
+ 		[:obj|
+ 		 (self isWhite: obj) not ifTrue:
+ 			[(self isNormalObject: obj)
+ 				ifTrue:
+ 					[self setIsMarkedOf: obj to: false.
+ 					 self setIsGreyOf: obj to: false]
+ 				ifFalse:
+ 					[(self isSegmentBridge: obj) ifFalse:
+ 						[self setIsMarkedOf: obj to: false.
+ 						  self setIsGreyOf: obj to: false]]]].
+ !

Item was added:
+ ----- Method: SpurMemoryManager>>markObjectsForEnumerationPrimitives (in category 'gc - incremental') -----
+ markObjectsForEnumerationPrimitives
+ 
+  	<doNotGenerate>
+ 	^ MarkObjectsForEnumerationPrimitives!

Item was changed:
  ----- Method: SpurMemoryManager>>shutDownGlobalIncrementalGC: (in category 'gc - incremental') -----
  shutDownGlobalIncrementalGC: objectsShouldBeUnmarked
  	"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
  	self flag: 'need to implement the global inc GC first...'.
  	objectsShouldBeUnmarked ifTrue:
+ 		[self makeAllObjectsWhite.
+ 		self assert: self allObjectsUnmarked]!
- 		[self assert: self allObjectsUnmarked]!

Item was changed:
  ----- Method: SpurMemoryManager>>uniqueIndex:allInstancesInto:limit:resultsInto: (in category 'primitive support') -----
  uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: binaryBlock
  	<inline: true>
  	| count ptr |
  	count := 0.
  	ptr := start.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
+ 		 (gc markObjectsForEnumerationPrimitives
- 		 (MarkObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
+ 					[gc markObjectsForEnumerationPrimitives ifTrue:
- 					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 (self classIndexOf: obj) = classIndex ifTrue:
  					 	[count := count + 1.
  						 ptr < limit ifTrue:
  							[self longAt: ptr put: obj.
  							 ptr := ptr + self bytesPerOop]]]
  				ifFalse:
+ 					[gc markObjectsForEnumerationPrimitives ifTrue:
- 					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	binaryBlock value: count value: ptr
  !

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>markObjectsForEnumerationPrimitives (in category 'as yet unclassified') -----
+ markObjectsForEnumerationPrimitives
+ 
+ 	^ manager markObjectsForEnumerationPrimitives!

Item was changed:
  ----- Method: StackInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
  incrementalMarkAndTraceStackPage: thePage
  	| theSP theFP frameRcvrOffset callerFP oop |
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #frameRcvrOffset type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<inline: false>
  
  	self assert: (stackPages isFree: thePage) not.
  	self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
  	thePage trace: StackPageTraced.
  
  	theSP := thePage headSP.
  	theFP := thePage headFP.
  	"Skip the instruction pointer on top of stack of inactive pages."
  	thePage = stackPage ifFalse:
  		[theSP := theSP + objectMemory wordSize].
  	[frameRcvrOffset := self frameReceiverLocation: theFP.
  	 [theSP <= frameRcvrOffset] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isOopForwarded: oop) ifTrue:
  			[oop := objectMemory followForwarded: oop.
  			 stackPages longAt: theSP put: oop].
  		 (objectMemory isImmediate: oop) ifFalse:
+ 			[objectMemory marker markAndShouldScan: oop].
- 			[objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: oop].
  		 theSP := theSP + objectMemory wordSize].
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (objectMemory isContext: (self frameContext: theFP)).
+ 		 objectMemory marker markAndShouldScan: (self frameContext: theFP)].
+ 	objectMemory marker markAndShouldScan: (self iframeMethod: theFP).
- 		 objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: (self frameContext: theFP)].
- 	objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: (self iframeMethod: theFP).
  	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  		[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
  		 theFP := callerFP].
  	theSP := theFP + FoxCallerSavedIP. "caller ip is frameCallerContext in a base frame"
  	[theSP <= thePage baseAddress] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isOopForwarded: oop) ifTrue:
  			[oop := objectMemory followForwarded: oop.
  			 stackPages longAt: theSP put: oop].
  		 (objectMemory isImmediate: oop) ifFalse:
+ 			[objectMemory marker markAndShouldScan: oop].
- 			[objectMemory marker pushOnMarkingStackAndMakeGreyIfNecessary: oop].
  		 theSP := theSP + objectMemory wordSize]!



More information about the Vm-dev mailing list