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

commits at source.squeak.org commits at source.squeak.org
Mon Jun 27 14:29:51 UTC 2022


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

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

Name: VMMaker.oscog.seperateMarking-WoC.3202
Author: WoC
Time: 27 June 2022, 4:29:23.658457 pm
UUID: 7be2da0b-3abc-48c5-a28b-b49386d36e60
Ancestors: VMMaker.oscog-eem.3201

Pulled most of the marking logic from the SpurMemoryManager into the new class SpurMarker

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

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

Item was added:
+ CogClass subclass: #SpurMarker
+ 	instanceVariableNames: 'manager marking coInterpreter'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'SpurStackConstants VMBasicConstants'
+ 	category: 'VMMaker-SpurMemoryManager'!

Item was added:
+ ----- Method: SpurMarker class>>simulatorClass (in category 'as yet unclassified') -----
+ simulatorClass
+ 	^SpurMarkerSimulator!

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

Item was added:
+ ----- Method: SpurMarker>>doMarkAndTrace: (in category 'as yet unclassified') -----
+ doMarkAndTrace: objOop
+ 	"Mark the argument, and all objects reachable from it, and any remaining objects
+ 	 on the mark stack. Follow forwarding pointers in the scan."
+ 	
+ 	<inline: true>
+ 	"if markAndTrace: is to follow and eliminate forwarding pointers
+ 	 in its scan it cannot be handed an r-value which is forwarded.
+ 	 The assert for this is in markAndShouldScan:"
+ 	(self markAndShouldScan: objOop) ifFalse:
+ 		[^self].
+ 
+ 	"Now scan the object, and any remaining objects on the mark stack."
+ 	self markLoopFrom: objOop!

Item was added:
+ ----- Method: SpurMarker>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	marking := false!

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

Item was added:
+ ----- Method: SpurMarker>>markAccessibleObjectsAndFireEphemerons (in category 'as yet unclassified') -----
+ markAccessibleObjectsAndFireEphemerons
+ 	self assert: marking.
+ 	self assert: manager validClassTableRootPages.
+ 	self assert: manager segmentManager allBridgesMarked.
+ 	self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
+ 		inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]].
+ 
+ 	"This must come first to enable stack page reclamation.  It clears
+ 	  the trace flags on stack pages and so must precede any marking.
+ 	  Otherwise it will clear the trace flags of reached pages."
+ 	coInterpreter initStackPageGC.
+ 	self markAndTraceHiddenRoots.
+ 	self markAndTraceExtraRoots.
+ 	self assert: manager validClassTableRootPages.
+ 	coInterpreter markAndTraceInterpreterOops: true.
+ 	self assert: manager validObjStacks.
+ 	self markWeaklingsAndMarkAndFireEphemerons.
+ 	self assert: manager validObjStacks!

Item was added:
+ ----- Method: SpurMarker>>markAllUnscannedEphemerons (in category 'weakness and ephemerality') -----
+ markAllUnscannedEphemerons
+ 	"After firing the unscanned ephemerons we must scan-mark them.
+ 	 The wrinkle is that doing so may add more ephemerons to the set.
+ 	 So we remove the first element, by overwriting it with the last element,
+ 	 and decrementing the top, and then markAndTrace its contents."
+ 	self assert: (manager noUnscannedEphemerons) not.
+ 	self assert: manager allUnscannedEphemeronsAreActive.
+ 	[manager unscannedEphemerons top > manager unscannedEphemerons start] whileTrue:
+ 		[| ephemeron key lastptr |
+ 		 ephemeron := manager longAt: manager unscannedEphemerons start.
+ 		 lastptr := manager unscannedEphemerons top - manager bytesPerOop.
+ 		 lastptr > manager unscannedEphemerons start ifTrue:
+ 			[manager longAt: manager unscannedEphemerons start put: (manager longAt: lastptr)].
+ 		 manager unscannedEphemerons top: lastptr.
+ 		 key := manager followedKeyOfMaybeFiredEphemeron: ephemeron.
+ 		 manager setIsMarkedOf: ephemeron to: false. "to get it to be fully scanned in markAndTrace:"
+ 		 self
+ 			doMarkAndTrace: key;
+ 			doMarkAndTrace: ephemeron]!

Item was added:
+ ----- Method: SpurMarker>>markAndShouldScan: (in category 'as yet unclassified') -----
+ markAndShouldScan: objOop
+ 	"Helper for markAndTrace:.
+ 	 Mark the argument, and answer if its fields should be scanned now.
+ 	 Immediate objects don't need to be marked.
+ 	 Already marked objects have already been processed.
+ 	 Pure bits objects don't need scanning, although their class does.
+ 	 Weak objects should be pushed on the weakling stack.
+ 	 Anything else need scanning."
+ 	| format |
+ 	<inline: true>
+ 	(manager isImmediate: objOop) ifTrue:
+ 		[^false].
+ 	"if markAndTrace: is to follow and eliminate forwarding pointers
+ 	 in its scan it cannot be handed an r-value which is forwarded."
+ 	self assert: (manager isForwarded: objOop) not.
+ 	(manager isMarked: objOop) ifTrue:
+ 		[^false].
+ 	manager setIsMarkedOf: objOop to: true.
+ 	format := manager formatOf: objOop.
+ 	(manager isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack."
+ 		["Avoid tracing classes of non-objects on the heap, e.g. IRC caches, Sista counters."
+ 		 (manager classIndexOf: objOop) > manager lastClassIndexPun ifTrue:
+ 			[self markAndTraceClassOf: objOop].
+ 		 ^false].
+ 	format = manager weakArrayFormat ifTrue: "push weaklings on the weakling stack to scan later"
+ 		[manager push: objOop onObjStack: manager weaklingStack.
+ 		 ^false].
+ 	(format = manager ephemeronFormat
+ 	 and: [manager activeAndDeferredScan: objOop]) ifTrue:
+ 		[^false].
+ 	^true!

Item was added:
+ ----- Method: SpurMarker>>markAndTraceClassOf: (in category 'as yet unclassified') -----
+ markAndTraceClassOf: objOop
+ 	"Ensure the class of the argument is marked, pushing it on the markStack if not already marked.
+ 	 And for one-way become, which can create duplicate entries in the class table, make sure
+ 	 objOop's classIndex refers to the classObj's actual classIndex.
+ 	 Note that this is recursive, but the metaclass chain should terminate quickly."
+ 	<inline: false>
+ 	| classIndex classObj realClassIndex |
+ 	classIndex := manager classIndexOf: objOop.
+ 	classObj := manager classOrNilAtIndex: classIndex.
+ 	self assert: (coInterpreter objCouldBeClassObj: classObj).
+ 	realClassIndex := manager rawHashBitsOf: classObj.
+ 	(classIndex ~= realClassIndex
+ 	 and: [classIndex > manager lastClassIndexPun]) ifTrue:
+ 		[manager setClassIndexOf: objOop to: realClassIndex].
+ 	(manager isMarked: classObj) ifFalse:
+ 		[manager setIsMarkedOf: classObj to: true.
+ 		 self markAndTraceClassOf: classObj.
+ 		 manager push: classObj onObjStack: manager markStack]!

Item was added:
+ ----- Method: SpurMarker>>markAndTraceExtraRoots (in category 'as yet unclassified') -----
+ markAndTraceExtraRoots
+ 	| oop |
+ 	self assert: manager remapBufferCount = 0.
+ 
+ 	1 to: manager extraRootCount do:
+ 		[:i|
+ 		oop := (manager extraRoots at: i) at: 0.
+ 		((manager isImmediate: oop) or: [manager isFreeObject: oop]) ifFalse:
+ 			[self doMarkAndTrace: oop]]!

Item was added:
+ ----- Method: SpurMarker>>markAndTraceHiddenRoots (in category 'as yet unclassified') -----
+ 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.
+ 
+ 	manager setIsMarkedOf: manager rememberedSetObj to: true.
+ 	manager setIsMarkedOf: manager freeListsObj to: true.
+ 
+ 	(manager isWeakNonImm: manager classTableFirstPage) ifTrue:
+ 		[^self doMarkAndTrace: manager hiddenRootsObj].
+ 
+ 	manager setIsMarkedOf: manager hiddenRootsObj to: true.
+ 	self doMarkAndTrace: manager classTableFirstPage.
+ 	1 to: manager numClassTablePages - 1 do:
+ 		[:i| manager setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)
+ 				to: true]!

Item was added:
+ ----- Method: SpurMarker>>markAndTraceObjStack:andContents: (in category 'as yet unclassified') -----
+ markAndTraceObjStack: stackOrNil andContents: markAndTraceContents
+ 	"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."
+ 	<inline: false>
+ 	| index field |
+ 	stackOrNil = manager nilObj ifTrue:
+ 		[^self].
+ 	manager setIsMarkedOf: stackOrNil to: true.
+ 	self assert: (manager numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
+ 	field := manager fetchPointer: ObjStackNextx ofObject: stackOrNil.
+ 	field ~= 0 ifTrue:
+ 		[self markAndTraceObjStack: field andContents: markAndTraceContents].
+ 	field := stackOrNil.
+ 	[field := manager fetchPointer: ObjStackFreex ofObject: field.
+ 	 field ~= 0] whileTrue:
+ 		[manager setIsMarkedOf: field to: true].
+ 	markAndTraceContents ifFalse:
+ 		[^self].
+ 	"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
+ 	  if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5."
+ 	index := (manager fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
+ 	[index >= ObjStackFixedSlots] whileTrue:
+ 		[field := manager followObjField: index ofObject: stackOrNil.
+ 		 (manager isImmediate: field) ifFalse:
+ 			[self doMarkAndTrace: field].
+ 		 index := index - 1]!

Item was added:
+ ----- Method: SpurMarker>>markAndTraceWeaklingsFrom: (in category 'weakness and ephemerality') -----
+ markAndTraceWeaklingsFrom: startIndex
+ 	"Mark weaklings on the weaklingStack, ignoring startIndex
+ 	 number of elements on the bottom of the stack.  Answer
+ 	 the size of the stack *before* the enumeration began."
+ 	^manager objStack: manager weaklingStack from: startIndex do:
+ 		[:weakling|
+ 		 self deny: (manager isForwarded: weakling).
+ 		 self markAndTraceClassOf: weakling.
+ 		"N.B. generateToByDoLimitExpression:negative:on: guards against (unsigned)0 - 1 going +ve"
+ 		 0 to: (manager numStrongSlotsOfWeakling: weakling) - 1 do:
+ 			[:i| | field |
+ 			field := manager followOopField: i ofObject: weakling.
+ 			((manager isImmediate: field) or: [manager isMarked: field]) ifFalse:
+ 				[self doMarkAndTrace: field]]]!

Item was added:
+ ----- Method: SpurMarker>>markInactiveEphemerons (in category 'weakness and ephemerality') -----
+ markInactiveEphemerons
+ 	"Go through the unscanned ephemerons, marking the inactive ones, and
+ 	 removing them from the unscanned ephemerons. Answer if any inactive
+ 	 ones were found. We cannot fire the ephemerons until all are found to
+ 	 be active since scan-marking an inactive ephemeron later in the set may
+ 	 render a previously-observed active ephemeron as inactive."
+ 	| foundInactive ptr |
+ 	foundInactive := false.
+ 	ptr := manager unscannedEphemerons start.
+ 	[ptr < manager unscannedEphemerons top] whileTrue:
+ 		[| ephemeron key |
+ 		 key := manager followedKeyOfEphemeron: (ephemeron := manager longAt: ptr).
+ 		 ((manager isImmediate: key) or: [manager isMarked: key])
+ 			ifTrue:
+ 				[foundInactive := true.
+ 				 "Now remove the inactive ephemeron from the set, and scan-mark it.
+ 				  Scan-marking it may add more ephemerons to the set."
+ 				 manager unscannedEphemerons top: manager unscannedEphemerons top - manager bytesPerOop.
+ 				 manager unscannedEphemerons top > ptr ifTrue:
+ 					[manager longAt: ptr put: (manager longAt: manager unscannedEphemerons top)].
+ 				 self doMarkAndTrace: ephemeron]
+ 			ifFalse:
+ 				[ptr := ptr + manager bytesPerOop]].
+ 	^foundInactive!

Item was added:
+ ----- Method: SpurMarker>>markLoopFrom: (in category 'as yet unclassified') -----
+ markLoopFrom: objOop
+ 	"Scan objOop and all objects on the mark stack, until the mark stack is empty.
+ 	 N.B. When the incremental GC is written this will probably be refactored as
+ 	 markLoopFrom: objOop while: aBlock"
+ 	<inline: true>
+ 	| objToScan field index numStrongSlots scanLargeObject |
+ 
+ 	"Now scan the object, and any remaining objects on the mark stack."
+ 	objToScan := objOop.
+ 	"To avoid overflowing the mark stack when we encounter large objects, we
+ 	 push the obj, then its numStrongSlots, and then index the object from the stack."
+ 	[(manager isImmediate: objToScan)
+ 		ifTrue: [scanLargeObject := true]
+ 		ifFalse:
+ 			[numStrongSlots := manager numStrongSlotsOfInephemeral: objToScan.
+ 			 scanLargeObject := numStrongSlots > self traceImmediatelySlotLimit].
+ 	 scanLargeObject
+ 		ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any."
+ 			[(manager isImmediate: objToScan)
+ 				ifTrue:
+ 					[index := manager integerValueOf: objToScan.
+ 					 objToScan := manager topOfObjStack: manager markStack]
+ 				ifFalse:
+ 					[index := numStrongSlots.
+ 					 self markAndTraceClassOf: objToScan].
+ 			 [index > 0] whileTrue:
+ 				[index := index - 1.
+ 				 field := manager fetchPointer: index ofObject: objToScan.
+ 				 (manager isNonImmediate: field) ifTrue:
+ 					[(manager isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined"
+ 						[field := manager fixFollowedField: index ofObject: objToScan withInitialValue: field].
+ 					 (self markAndShouldScan: field) ifTrue:
+ 						[index > 0 ifTrue:
+ 							[(manager topOfObjStack: manager markStack) ~= objToScan ifTrue: 
+ 								[manager push: objToScan onObjStack: manager markStack].
+ 							 manager push: (manager integerObjectOf: index) onObjStack: manager markStack].
+ 						 objToScan := field.
+ 						 index := -1]]].
+ 			 index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack."
+ 				[objToScan := manager popObjStack: manager markStack.
+ 				 objToScan = objOop ifTrue:
+ 					[objToScan := manager popObjStack: manager markStack]]]
+ 		ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack."
+ 			[index := numStrongSlots.
+ 			 self markAndTraceClassOf: objToScan.
+ 			 [index > 0] whileTrue:
+ 				[index := index - 1.
+ 				 field := manager fetchPointer: index ofObject: objToScan.
+ 				 (manager isNonImmediate: field) ifTrue:
+ 					[(manager isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined"
+ 						[field := manager fixFollowedField: index ofObject: objToScan withInitialValue: field].
+ 					 (self markAndShouldScan: field) ifTrue:
+ 						[manager push: field onObjStack: manager markStack.
+ 						 ((manager rawNumSlotsOf: field) > self traceImmediatelySlotLimit
+ 						  and: [(numStrongSlots := manager numStrongSlotsOfInephemeral: field) > self traceImmediatelySlotLimit]) ifTrue:
+ 							[manager push: (manager integerObjectOf: numStrongSlots) onObjStack: manager markStack]]]].
+ 			 objToScan := manager popObjStack: manager markStack].
+ 	 objToScan notNil] whileTrue!

Item was added:
+ ----- Method: SpurMarker>>markObjects: (in category 'as yet unclassified') -----
+ markObjects: 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.
+ 	marking := true.
+ 	self markAccessibleObjectsAndFireEphemerons.
+ 	manager expungeDuplicateAndUnmarkedClasses: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
+ 	manager nilUnmarkedWeaklingSlots.
+ 	marking := false!

Item was added:
+ ----- Method: SpurMarker>>markWeaklingsAndMarkAndFireEphemerons (in category 'weakness and ephemerality') -----
+ markWeaklingsAndMarkAndFireEphemerons
+ 	"After the initial scan-mark is complete ephemerons can be processed.
+ 	 Weaklings have accumulated on the weaklingStack, but more may be
+ 	 uncovered during ephemeron processing.  So trace the strong slots
+ 	 of the weaklings, and as ephemerons are processed ensure any newly
+ 	 reached weaklings are also traced."
+ 	| numTracedWeaklings |
+ 	<inline: false>
+ 	numTracedWeaklings := 0.
+ 	[coInterpreter markAndTraceUntracedReachableStackPages.
+ 	 coInterpreter markAndTraceMachineCodeOfMarkedMethods.
+ 	 "Make sure all reached weaklings have their strong slots traced before firing ephemerons..."
+ 	 [numTracedWeaklings := self markAndTraceWeaklingsFrom: numTracedWeaklings.
+ 	  (manager sizeOfObjStack: manager weaklingStack) > numTracedWeaklings] whileTrue.
+ 	 manager noUnscannedEphemerons ifTrue:
+ 		[coInterpreter
+ 			markAndTraceUntracedReachableStackPages;
+ 	 		markAndTraceMachineCodeOfMarkedMethods;
+ 			freeUntracedStackPages;
+ 			freeUnmarkedMachineCode.
+ 		 ^self].
+ 	 self markInactiveEphemerons ifFalse:
+ 		[manager fireAllUnscannedEphemerons].
+ 	 self markAllUnscannedEphemerons]
+ 		repeat!

Item was added:
+ ----- Method: SpurMarker>>marking (in category 'as yet unclassified') -----
+ marking 
+ 
+ 	^ marking!

Item was added:
+ ----- Method: SpurMarker>>traceImmediatelySlotLimit (in category 'as yet unclassified') -----
+ traceImmediatelySlotLimit
+ 	"Arbitrary level at which to defer tracing large objects until later.
+ 	 The average slot size of Smalltalk objects is typically near 8.
+ 	 We do require traceImmediatelySlotLimit to be < numSlotsMask."
+ 	^64!

Item was added:
+ SpurMarker subclass: #SpurMarkerSimulator
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SpurMemoryManagerSimulation'!

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

Item was changed:
  ----- Method: SpurMemoryManager class>>ancilliaryClasses (in category 'translation') -----
  ancilliaryClasses
  	"Answer any extra classes to be included in the translation."
+ 	^{	SpurGenerationScavenger. SpurScavengeLogRecord. SpurSegmentManager. SpurSegmentInfo. SpurMarker }, 
- 	^{	SpurGenerationScavenger. SpurScavengeLogRecord. SpurSegmentManager. SpurSegmentInfo }, 
  		self compactorClass classesForTranslation,
  		SpurNewSpaceSpace withAllSubclasses
  		
  	!

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

Item was added:
+ ----- Method: SpurMemoryManager class>>markerClass (in category 'accessing class hierarchy') -----
+ markerClass
+ 	"Answer the marking algorithm to use."
+ 	^Smalltalk classNamed: (InitializationOptions at: #markerClass ifAbsent: [#SpurMarker])!

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].
  	MarkObjectsForEnumerationPrimitives ifTrue:
+ 		[marker markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
- 		[self 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).
  	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 |
  	MarkObjectsForEnumerationPrimitives ifTrue:
+ 		[marker markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
- 		[self 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."
  		 (MarkObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 count := count + 1.
  					 ptr < limit ifTrue:
  						[self longAt: ptr put: obj.
  						 ptr := ptr + self bytesPerOop]]
  				ifFalse:
  					[MarkObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self assert: (self isEmptyObjStack: markStack).
  	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 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 := newSpaceBytes + newSpaceStart.
  	scavengeThreshold := memory size * memory bytesPerElement. "i.e. /don't/ scavenge."
+ 	
+ 	marker := self class markerClass simulatorClass new manager: self; yourself.
+ 	
  	scavenger := SpurGenerationScavenger simulatorClass new.
  	scavenger manager: self.
  	scavenger newSpaceStart: newSpaceStart
  				newSpaceBytes: newSpaceBytes
  				survivorBytes: newSpaceBytes // self scavengerDenominator.
+ 				
+ 	compactor := self class compactorClass simulatorClass new manager: self; yourself
+ 	!
- 	compactor := self class compactorClass simulatorClass new manager: self; yourself!

Item was changed:
  ----- Method: SpurMemoryManager>>ensureRoomOnObjStackAt: (in category 'obj stacks') -----
  ensureRoomOnObjStackAt: objStackRootIndex
  	"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 its good to keep their memory around.  So unused pages
  	 created by popping emptying pages are kept on the ObjStackFreex list."
  	| stackOrNil freeOrNewPage |
  	stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
  	(stackOrNil = nilObj
  	 or: [(self fetchPointer: ObjStackTopx ofObject: stackOrNil) >= ObjStackLimit]) ifTrue:
  		[freeOrNewPage := stackOrNil = nilObj
  								ifTrue: [0]
  								ifFalse: [self fetchPointer: ObjStackFreex ofObject: stackOrNil].
  		 freeOrNewPage ~= 0
  			ifTrue: "the free page list is always on the new page."
  				[self storePointer: ObjStackFreex ofObjStack: stackOrNil withValue: 0.
+ 				 self assert: (marker marking not or: [self isMarked: freeOrNewPage])]
- 				 self assert: (marking not or: [self isMarked: freeOrNewPage])]
  			ifFalse:
  				[freeOrNewPage := self allocateSlotsInOldSpace: ObjStackPageSlots
  										format: self wordIndexableFormat
  										classIndex: self wordSizeClassIndexPun.
  				 freeOrNewPage ifNil: 
  					["Allocate a new segment an retry. This is very uncommon. But it happened to me (Clement)."
  					 self growOldSpaceByAtLeast: ObjStackPageSlots.
  					 freeOrNewPage := self allocateSlotsInOldSpace: ObjStackPageSlots
  										format: self wordIndexableFormat
  										classIndex: self wordSizeClassIndexPun.
  					freeOrNewPage ifNil: [self error: 'no memory to allocate or extend obj stack']].
  				 self storePointer: ObjStackFreex ofObjStack: freeOrNewPage withValue: 0.
+ 				 marker marking ifTrue: [self setIsMarkedOf: freeOrNewPage to: true]].
- 				 marking ifTrue: [self setIsMarkedOf: freeOrNewPage to: true]].
  		 self storePointer: ObjStackMyx ofObjStack: freeOrNewPage withValue: objStackRootIndex;
  			  storePointer: ObjStackNextx ofObjStack: freeOrNewPage withValue: (stackOrNil = nilObj ifTrue: [0] ifFalse: [stackOrNil]);
  			  storePointer: ObjStackTopx ofObjStack: freeOrNewPage withValue: 0;
  			  storePointer: objStackRootIndex ofObject: hiddenRootsObj withValue: freeOrNewPage.
  		 self assert: (self isValidObjStackAt: objStackRootIndex).
  		 "Added a new page; now update and answer the relevant cached first page."
  		 stackOrNil := self updateRootOfObjStackAt: objStackRootIndex with: freeOrNewPage].
  	self assert: (self isValidObjStackAt: objStackRootIndex).
  	^stackOrNil!

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).
  
  	"Mark objects /before/ scavenging, to empty the rememberedTable of unmarked roots."
+ 	marker markObjects: true.
- 	self markObjects: true.
  	gcMarkEndUsecs := coInterpreter ioUTCMicrosecondsNow.
  	
  	scavenger forgetUnmarkedRememberedObjects.
  
  	coInterpreter setGCMode: GCModeNewSpace.
  	self doScavenge: MarkOnTenure.
  	coInterpreter setGCMode: GCModeFull.
  
  	"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
  		excludeUnmarkedObjs: true
  		classIndicesShouldBeValid: true.
  
  	compactionStartUsecs := coInterpreter ioUTCMicrosecondsNow.
  	segmentManager prepareForGlobalSweep. "for notePinned:"
  	compactor compact.
  	self attemptToShrink.
  	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 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."
  	| moreThanEnough |
  	remapBuffer := Array new: RemapBufferSize.
  	remapBufferCount := extraRootCount := 0. "see below"
  	freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  	checkForLeaks := 0.
+ 	needGCFlag := signalLowSpace := false.
- 	needGCFlag := signalLowSpace := marking := false.
  	becomeEffectsFlags := gcPhaseInProgress := validatedIntegerClassFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statMaxAllocSegmentTime := 0.
  	statMarkUsecs := statSweepUsecs := statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statCompactionUsecs := statGCEndUsecs := gcSweepEndUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  	statGrowMemory := statShrinkMemory := statRootTableCount := statAllocatedBytes := 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 := SpurGenerationScavenger simulatorClass new manager: self; yourself.
  	segmentManager := SpurSegmentManager simulatorClass new manager: self; yourself.
  	compactor := self class compactorClass simulatorClass new manager: self; yourself.
+ 	marker := self class markerClass simulatorClass 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."
  
  	"This is needed on 64-bits. We don't want a simulation creating a huge heap by default.
  	 By default use 512Mb on 64-bits, 256Mb on 32-bits."
  	moreThanEnough := 1024 * 1024 * 1024 / (16 / self wordSize). "One million dollars, ha ha ha ha ha,... ha, ha ha ha ha, ..."
  	maxOldSpaceSize := self class initializationOptions
  							ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [moreThanEnough]]
  							ifNil: [moreThanEnough]!

Item was changed:
  ----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex: (in category 'obj stacks') -----
  isValidObjStackPage: objStackPage myIndex: myx
  	"Just check the page itself."
  	<inline: false>
  	(self classIndexOf: objStackPage) = self wordSizeClassIndexPun ifFalse:
  		[objStackInvalidBecause := 'wrong class index'.
  		 invalidObjStackPage := objStackPage.
  		 ^false].
  	(self formatOf: objStackPage) = self wordIndexableFormat ifFalse:
  		[objStackInvalidBecause := 'wrong format'.
  		 invalidObjStackPage := objStackPage.
  		 ^false].
  	(self numSlotsOfAny: objStackPage) = ObjStackPageSlots ifFalse:
  		[objStackInvalidBecause := 'wrong num slots'.
  		 invalidObjStackPage := objStackPage.
  		 ^false].
  	myx = (self fetchPointer: ObjStackMyx ofObject: objStackPage) ifFalse:
  		[objStackInvalidBecause := 'wrong myx'.
  		 invalidObjStackPage := objStackPage.
  		 ^false].
+ 	(marker marking and: [(self isMarked: objStackPage) not]) ifTrue:
- 	(marking and: [(self isMarked: objStackPage) not]) ifTrue:
  		[objStackInvalidBecause := 'marking but page is unmarked'.
  		 invalidObjStackPage := objStackPage.
  		 ^false].
  	^true!

Item was removed:
- ----- Method: SpurMemoryManager>>markAccessibleObjectsAndFireEphemerons (in category 'gc - global') -----
- markAccessibleObjectsAndFireEphemerons
- 	self assert: marking.
- 	self assert: self validClassTableRootPages.
- 	self assert: segmentManager allBridgesMarked.
- 	self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
- 		inSmalltalk: [MarkStackRecord ifNotNil: [MarkStackRecord resetTo: 1]].
- 
- 	"This must come first to enable stack page reclamation.  It clears
- 	  the trace flags on stack pages and so must precede any marking.
- 	  Otherwise it will clear the trace flags of reached pages."
- 	coInterpreter initStackPageGC.
- 	self markAndTraceHiddenRoots.
- 	self markAndTraceExtraRoots.
- 	self assert: self validClassTableRootPages.
- 	coInterpreter markAndTraceInterpreterOops: true.
- 	self assert: self validObjStacks.
- 	self markWeaklingsAndMarkAndFireEphemerons.
- 	self assert: self validObjStacks!

Item was removed:
- ----- Method: SpurMemoryManager>>markAllUnscannedEphemerons (in category 'weakness and ephemerality') -----
- markAllUnscannedEphemerons
- 	"After firing the unscanned ephemerons we must scan-mark them.
- 	 The wrinkle is that doing so may add more ephemerons to the set.
- 	 So we remove the first element, by overwriting it with the last element,
- 	 and decrementing the top, and then markAndTrace its contents."
- 	self assert: (self noUnscannedEphemerons) not.
- 	self assert: self allUnscannedEphemeronsAreActive.
- 	[unscannedEphemerons top > unscannedEphemerons start] whileTrue:
- 		[| ephemeron key lastptr |
- 		 ephemeron := self longAt: unscannedEphemerons start.
- 		 lastptr := unscannedEphemerons top - self bytesPerOop.
- 		 lastptr > unscannedEphemerons start ifTrue:
- 			[self longAt: unscannedEphemerons start put: (self longAt: lastptr)].
- 		 unscannedEphemerons top: lastptr.
- 		 key := self followedKeyOfMaybeFiredEphemeron: ephemeron.
- 		 self setIsMarkedOf: ephemeron to: false. "to get it to be fully scanned in markAndTrace:"
- 		 self
- 			markAndTrace: key;
- 			markAndTrace: ephemeron]!

Item was removed:
- ----- Method: SpurMemoryManager>>markAndShouldScan: (in category 'gc - global') -----
- markAndShouldScan: objOop
- 	"Helper for markAndTrace:.
- 	 Mark the argument, and answer if its fields should be scanned now.
- 	 Immediate objects don't need to be marked.
- 	 Already marked objects have already been processed.
- 	 Pure bits objects don't need scanning, although their class does.
- 	 Weak objects should be pushed on the weakling stack.
- 	 Anything else need scanning."
- 	| format |
- 	<inline: true>
- 	(self isImmediate: objOop) ifTrue:
- 		[^false].
- 	"if markAndTrace: is to follow and eliminate forwarding pointers
- 	 in its scan it cannot be handed an r-value which is forwarded."
- 	self assert: (self isForwarded: objOop) not.
- 	(self isMarked: objOop) ifTrue:
- 		[^false].
- 	self setIsMarkedOf: objOop to: true.
- 	format := self formatOf: objOop.
- 	(self isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack."
- 		["Avoid tracing classes of non-objects on the heap, e.g. IRC caches, Sista counters."
- 		 (self classIndexOf: objOop) > self lastClassIndexPun ifTrue:
- 			[self markAndTraceClassOf: objOop].
- 		 ^false].
- 	format = self weakArrayFormat ifTrue: "push weaklings on the weakling stack to scan later"
- 		[self push: objOop onObjStack: weaklingStack.
- 		 ^false].
- 	(format = self ephemeronFormat
- 	 and: [self activeAndDeferredScan: objOop]) ifTrue:
- 		[^false].
- 	^true!

Item was changed:
  ----- Method: SpurMemoryManager>>markAndTrace: (in category 'gc - global') -----
  markAndTrace: objOop
  	"Mark the argument, and all objects reachable from it, and any remaining objects
  	 on the mark stack. Follow forwarding pointers in the scan."
  	<api>
  	<inline: #never>
- 	"if markAndTrace: is to follow and eliminate forwarding pointers
- 	 in its scan it cannot be handed an r-value which is forwarded.
- 	 The assert for this is in markAndShouldScan:"
- 	(self markAndShouldScan: objOop) ifFalse:
- 		[^self].
  
+ 	marker doMarkAndTrace: objOop!
- 	"Now scan the object, and any remaining objects on the mark stack."
- 	self markLoopFrom: objOop!

Item was removed:
- ----- Method: SpurMemoryManager>>markAndTraceClassOf: (in category 'gc - global') -----
- markAndTraceClassOf: objOop
- 	"Ensure the class of the argument is marked, pushing it on the markStack if not already marked.
- 	 And for one-way become, which can create duplicate entries in the class table, make sure
- 	 objOop's classIndex refers to the classObj's actual classIndex.
- 	 Note that this is recursive, but the metaclass chain should terminate quickly."
- 	<inline: false>
- 	| classIndex classObj realClassIndex |
- 	classIndex := self classIndexOf: objOop.
- 	classObj := self classOrNilAtIndex: classIndex.
- 	self assert: (coInterpreter objCouldBeClassObj: classObj).
- 	realClassIndex := self rawHashBitsOf: classObj.
- 	(classIndex ~= realClassIndex
- 	 and: [classIndex > self lastClassIndexPun]) ifTrue:
- 		[self setClassIndexOf: objOop to: realClassIndex].
- 	(self isMarked: classObj) ifFalse:
- 		[self setIsMarkedOf: classObj to: true.
- 		 self markAndTraceClassOf: classObj.
- 		 self push: classObj onObjStack: markStack]!

Item was removed:
- ----- Method: SpurMemoryManager>>markAndTraceExtraRoots (in category 'gc - global') -----
- markAndTraceExtraRoots
- 	| oop |
- 	self assert: remapBufferCount = 0.
- 	"1 to: remapBufferCount do:
- 		[:i|
- 		 oop := remapBuffer at: i.
- 		 ((self isImmediate: oop) or: [self isFreeObject: oop]) ifFalse:
- 			[self markAndTrace: oop]]."
- 	1 to: extraRootCount do:
- 		[:i|
- 		oop := (extraRoots at: i) at: 0.
- 		((self isImmediate: oop) or: [self isFreeObject: oop]) ifFalse:
- 			[self markAndTrace: oop]]!

Item was removed:
- ----- Method: SpurMemoryManager>>markAndTraceHiddenRoots (in category 'gc - global') -----
- 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: markStack andContents: false.
- 	self markAndTraceObjStack: weaklingStack andContents: false.
- 	self markAndTraceObjStack: mournQueue andContents: true.
- 
- 	self setIsMarkedOf: self rememberedSetObj to: true.
- 	self setIsMarkedOf: self freeListsObj to: true.
- 
- 	(self isWeakNonImm: classTableFirstPage) ifTrue:
- 		[^self markAndTrace: hiddenRootsObj].
- 
- 	self setIsMarkedOf: hiddenRootsObj to: true.
- 	self markAndTrace: classTableFirstPage.
- 	1 to: numClassTablePages - 1 do:
- 		[:i| self setIsMarkedOf: (self fetchPointer: i ofObject: hiddenRootsObj)
- 				to: true]!

Item was removed:
- ----- Method: SpurMemoryManager>>markAndTraceObjStack:andContents: (in category 'obj stacks') -----
- markAndTraceObjStack: stackOrNil andContents: markAndTraceContents
- 	"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."
- 	<inline: false>
- 	| index field |
- 	stackOrNil = nilObj ifTrue:
- 		[^self].
- 	self setIsMarkedOf: stackOrNil to: true.
- 	self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
- 	field := self fetchPointer: ObjStackNextx ofObject: stackOrNil.
- 	field ~= 0 ifTrue:
- 		[self markAndTraceObjStack: field andContents: markAndTraceContents].
- 	field := stackOrNil.
- 	[field := self fetchPointer: ObjStackFreex ofObject: field.
- 	 field ~= 0] whileTrue:
- 		[self setIsMarkedOf: field to: true].
- 	markAndTraceContents ifFalse:
- 		[^self].
- 	"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
- 	  if there were 6 slots in an oop stack, full would be 2, and the last 0-rel index is 5."
- 	index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
- 	[index >= ObjStackFixedSlots] whileTrue:
- 		[field := self followObjField: index ofObject: stackOrNil.
- 		 (self isImmediate: field) ifFalse:
- 			[self markAndTrace: field].
- 		 index := index - 1]!

Item was removed:
- ----- Method: SpurMemoryManager>>markAndTraceWeaklingsFrom: (in category 'weakness and ephemerality') -----
- markAndTraceWeaklingsFrom: startIndex
- 	"Mark weaklings on the weaklingStack, ignoring startIndex
- 	 number of elements on the bottom of the stack.  Answer
- 	 the size of the stack *before* the enumeration began."
- 	^self objStack: weaklingStack from: startIndex do:
- 		[:weakling|
- 		 self deny: (self isForwarded: weakling).
- 		 self markAndTraceClassOf: weakling.
- 		"N.B. generateToByDoLimitExpression:negative:on: guards against (unsigned)0 - 1 going +ve"
- 		 0 to: (self numStrongSlotsOfWeakling: weakling) - 1 do:
- 			[:i| | field |
- 			field := self followOopField: i ofObject: weakling.
- 			((self isImmediate: field) or: [self isMarked: field]) ifFalse:
- 				[self markAndTrace: field]]]!

Item was removed:
- ----- Method: SpurMemoryManager>>markInactiveEphemerons (in category 'weakness and ephemerality') -----
- markInactiveEphemerons
- 	"Go through the unscanned ephemerons, marking the inactive ones, and
- 	 removing them from the unscanned ephemerons. Answer if any inactive
- 	 ones were found. We cannot fire the ephemerons until all are found to
- 	 be active since scan-marking an inactive ephemeron later in the set may
- 	 render a previously-observed active ephemeron as inactive."
- 	| foundInactive ptr |
- 	foundInactive := false.
- 	ptr := unscannedEphemerons start.
- 	[ptr < unscannedEphemerons top] whileTrue:
- 		[| ephemeron key |
- 		 key := self followedKeyOfEphemeron: (ephemeron := self longAt: ptr).
- 		 ((self isImmediate: key) or: [self isMarked: key])
- 			ifTrue:
- 				[foundInactive := true.
- 				 "Now remove the inactive ephemeron from the set, and scan-mark it.
- 				  Scan-marking it may add more ephemerons to the set."
- 				 unscannedEphemerons top: unscannedEphemerons top - self bytesPerOop.
- 				 unscannedEphemerons top > ptr ifTrue:
- 					[self longAt: ptr put: (self longAt: unscannedEphemerons top)].
- 				 self markAndTrace: ephemeron]
- 			ifFalse:
- 				[ptr := ptr + self bytesPerOop]].
- 	^foundInactive!

Item was removed:
- ----- Method: SpurMemoryManager>>markLoopFrom: (in category 'gc - global') -----
- markLoopFrom: objOop
- 	"Scan objOop and all objects on the mark stack, until the mark stack is empty.
- 	 N.B. When the incremental GC is written this will probably be refactored as
- 	 markLoopFrom: objOop while: aBlock"
- 	<inline: true>
- 	| objToScan field index numStrongSlots scanLargeObject |
- 
- 	"Now scan the object, and any remaining objects on the mark stack."
- 	objToScan := objOop.
- 	"To avoid overflowing the mark stack when we encounter large objects, we
- 	 push the obj, then its numStrongSlots, and then index the object from the stack."
- 	[(self isImmediate: objToScan)
- 		ifTrue: [scanLargeObject := true]
- 		ifFalse:
- 			[numStrongSlots := self numStrongSlotsOfInephemeral: objToScan.
- 			 scanLargeObject := numStrongSlots > self traceImmediatelySlotLimit].
- 	 scanLargeObject
- 		ifTrue: "scanning a large object. scan until hitting an unmarked object, then switch to it, if any."
- 			[(self isImmediate: objToScan)
- 				ifTrue:
- 					[index := self integerValueOf: objToScan.
- 					 objToScan := self topOfObjStack: markStack]
- 				ifFalse:
- 					[index := numStrongSlots.
- 					 self markAndTraceClassOf: objToScan].
- 			 [index > 0] whileTrue:
- 				[index := index - 1.
- 				 field := self fetchPointer: index ofObject: objToScan.
- 				 (self isNonImmediate: field) ifTrue:
- 					[(self isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined"
- 						[field := self fixFollowedField: index ofObject: objToScan withInitialValue: field].
- 					 (self markAndShouldScan: field) ifTrue:
- 						[index > 0 ifTrue:
- 							[(self topOfObjStack: markStack) ~= objToScan ifTrue: 
- 								[self push: objToScan onObjStack: markStack].
- 							 self push: (self integerObjectOf: index) onObjStack: markStack].
- 						 objToScan := field.
- 						 index := -1]]].
- 			 index >= 0 ifTrue: "if loop terminated without finding an unmarked referent, switch to top of stack."
- 				[objToScan := self popObjStack: markStack.
- 				 objToScan = objOop ifTrue:
- 					[objToScan := self popObjStack: markStack]]]
- 		ifFalse: "scanning a small object. scan, marking, pushing unmarked referents, then switch to the top of the stack."
- 			[index := numStrongSlots.
- 			 self markAndTraceClassOf: objToScan.
- 			 [index > 0] whileTrue:
- 				[index := index - 1.
- 				 field := self fetchPointer: index ofObject: objToScan.
- 				 (self isNonImmediate: field) ifTrue:
- 					[(self isForwarded: field) ifTrue: "fixFollowedField: is /not/ inlined"
- 						[field := self fixFollowedField: index ofObject: objToScan withInitialValue: field].
- 					 (self markAndShouldScan: field) ifTrue:
- 						[self push: field onObjStack: markStack.
- 						 ((self rawNumSlotsOf: field) > self traceImmediatelySlotLimit
- 						  and: [(numStrongSlots := self numStrongSlotsOfInephemeral: field) > self traceImmediatelySlotLimit]) ifTrue:
- 							[self push: (self integerObjectOf: numStrongSlots) onObjStack: markStack]]]].
- 			 objToScan := self popObjStack: markStack].
- 	 objToScan notNil] whileTrue!

Item was removed:
- ----- Method: SpurMemoryManager>>markObjects: (in category 'gc - global') -----
- markObjects: 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].
- 	self runLeakCheckerFor: GCModeFull.
- 
- 	self shutDownGlobalIncrementalGC: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
- 	self initializeUnscannedEphemerons.
- 	self initializeMarkStack.
- 	self initializeWeaklingStack.
- 	marking := true.
- 	self markAccessibleObjectsAndFireEphemerons.
- 	self expungeDuplicateAndUnmarkedClasses: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged.
- 	self nilUnmarkedWeaklingSlots.
- 	marking := false!

Item was removed:
- ----- Method: SpurMemoryManager>>markWeaklingsAndMarkAndFireEphemerons (in category 'gc - global') -----
- markWeaklingsAndMarkAndFireEphemerons
- 	"After the initial scan-mark is complete ephemerons can be processed.
- 	 Weaklings have accumulated on the weaklingStack, but more may be
- 	 uncovered during ephemeron processing.  So trace the strong slots
- 	 of the weaklings, and as ephemerons are processed ensure any newly
- 	 reached weaklings are also traced."
- 	| numTracedWeaklings |
- 	<inline: false>
- 	numTracedWeaklings := 0.
- 	[coInterpreter markAndTraceUntracedReachableStackPages.
- 	 coInterpreter markAndTraceMachineCodeOfMarkedMethods.
- 	 "Make sure all reached weaklings have their strong slots traced before firing ephemerons..."
- 	 [numTracedWeaklings := self markAndTraceWeaklingsFrom: numTracedWeaklings.
- 	  (self sizeOfObjStack: weaklingStack) > numTracedWeaklings] whileTrue.
- 	 self noUnscannedEphemerons ifTrue:
- 		[coInterpreter
- 			markAndTraceUntracedReachableStackPages;
- 	 		markAndTraceMachineCodeOfMarkedMethods;
- 			freeUntracedStackPages;
- 			freeUnmarkedMachineCode.
- 		 ^self].
- 	 self markInactiveEphemerons ifFalse:
- 		[self fireAllUnscannedEphemerons].
- 	 self markAllUnscannedEphemerons]
- 		repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlots (in category 'weakness and ephemerality') -----
  nilUnmarkedWeaklingSlots
  	"Nil the unmarked slots in the weaklings on the
  	 weakling stack, finalizing those that lost references.
  	 Finally, empty the weaklingStack."
  	<inline: #never> "for profiling"
  	self cCode: '' inSmalltalk: [coInterpreter transcript nextPutAll: 'nilling...'; flush].
  	self eassert: [self allOldMarkedWeakObjectsOnWeaklingStack].
  	weaklingStack = nilObj ifTrue:
  		[^self].
  	self objStack: weaklingStack from: 0 do:
  		[:weakling| | anyUnmarked |
  		anyUnmarked := self nilUnmarkedWeaklingSlotsIn: weakling.
  		anyUnmarked ifTrue:
  			["fireFinalization: could grow the mournQueue and if so,
  			  additional pages must be marked to avoid being GC'ed."
+ 			 self assert: marker marking.
- 			 self assert: marking.
  			 coInterpreter fireFinalization: weakling]].
  	self emptyObjStack: weaklingStack!

Item was changed:
  ----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
  objectsReachableFromRoots: arrayOfRoots
  	"This is part of storeImageSegmentInto:outPointers:roots:.
  	 Answer an Array of all the objects only reachable from the argument, an Array of root objects,
  	 starting with arrayOfRoots.  If there is no space, answer a SmallInteger whose value is the
  	 number of slots required.  This is used to collect the objects to include in an image segment
  	 on Spur, separate from creating the segment, hence simplifying the implementation.
  	 Thanks to Igor Stasenko for this idea."
  
  	| freeChunk ptr start limit count oop objOop |
  	<var: #freeChunk type: #usqInt> "& hence start & ptr are too; limit is also because of addressAfter:"
  	<inline: #never>
  	self assert: (self isArray: arrayOfRoots).
  	"Mark all objects except those only reachable from the arrayOfRoots by marking
  	 each object in arrayOfRoots and then marking all reachable objects (from the
  	 system roots).  This leaves unmarked only objects reachable from the arrayOfRoots.
  	 N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
   	self assert: self allObjectsUnmarked.
  	self markObjectsIn: arrayOfRoots.
+ 	marker markObjects: false.
- 	self markObjects: false.
  
  	"After the mark phase all unreachable weak slots will have been nilled
  	 and all active ephemerons fired."
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self noUnscannedEphemerons.
  
  	"Now unmark the roots before collecting the transitive closure of unmarked objects accessible from the roots."
  	self unmarkObjectsIn: arrayOfRoots.
  
  	"Use the largest free chunk to answer the result."
  	freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
  	totalFreeOldSpace := totalFreeOldSpace - (self bytesInBody: freeChunk). "but must update so that growth in the markStack does not cause assert fails."
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  
  	"First put the arrayOfRoots; order is important."
  	self noCheckPush: arrayOfRoots onObjStack: markStack.
  
  	"Now collect the roots and the transitive closure of unmarked objects from them."
  	[self isEmptyObjStack: markStack] whileFalse:
  		[objOop := self popObjStack: markStack.
  		 self assert: (self isMarked: objOop).
  		 count := count + 1.
  		 ptr < limit ifTrue:
  			[self longAt: ptr put: objOop.
  			 ptr := ptr + self bytesPerOop].
  		 oop := self fetchClassOfNonImm: objOop.
  		 (self isMarked: oop) ifFalse:
  			[self setIsMarkedOf: oop to: true.
  			 self noCheckPush: oop onObjStack: markStack].
  		 ((self isContextNonImm: objOop)
  		  and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the copy loop"
  			ifTrue:
  				[0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
  					[:i|
  					 oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
  					 ((self isImmediate: oop)
  					  or: [self isMarked: oop]) ifFalse:
  						[self setIsMarkedOf: oop to: true.
  						 self noCheckPush: oop onObjStack: markStack]]]
  			ifFalse:
  				[0 to: (self numPointerSlotsOf: objOop) - 1 do:
  					[:i|
  					 oop := self fetchPointer: i ofObject: objOop.
  					 ((self isImmediate: oop)
  					  or: [self isMarked: oop]) ifFalse:
  						[self setIsMarkedOf: oop to: true.
  						 self noCheckPush: oop onObjStack: markStack]]]].
  
  	self unmarkAllObjects.
  
  	"Now try and allocate the result"
  	(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 checkFreeSpace: GCCheckImageSegment.
  		 ^self integerObjectOf: count].
  	"There's room; set the format, & classIndex and shorten."
  	self setFormatOf: freeChunk to: self arrayFormat.
  	self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
  	self shorten: freeChunk toIndexableSize: count.
  	(self isForwarded: freeChunk) ifTrue:
  		[freeChunk := self followForwarded: freeChunk].
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace: GCCheckImageSegment.
  	self runLeakCheckerFor: GCCheckImageSegment.
  	^freeChunk!

Item was removed:
- ----- Method: SpurMemoryManager>>traceImmediatelySlotLimit (in category 'gc - global') -----
- traceImmediatelySlotLimit
- 	"Arbitrary level at which to defer tracing large objects until later.
- 	 The average slot size of Smalltalk objects is typically near 8.
- 	 We do require traceImmediatelySlotLimit to be < numSlotsMask."
- 	^64!

Item was added:
+ SharedPool subclass: #SpurStackConstants
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'ObjStackFixedSlots ObjStackFreex ObjStackNextx ObjStackPageSlots ObjStackTopx'
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SpurMemoryManager'!



More information about the Vm-dev mailing list