[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3290.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Jan 5 20:21:47 UTC 2023
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3290.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3290
Author: WoC
Time: 5 January 2023, 9:21:20.809577 pm
UUID: 768f93a1-b2fc-4512-874e-4bea6c9c78a6
Ancestors: VMMaker.oscog.seperateMarking-WoC.3289
Implemented a second version of incremental GC still based on the first attempt but in two phases and not three (counting of life objects in marking and sweeping + compacting in one step)
- CCodeGenerator now keeps track of which classes get generated (I wanted the use this, but do not need it anymore. As it was a nice info to have one time during debugging I decided to keep it)
- prepared SpurAllAtOnceMarker and SpurIncrementalMarker for introduction of SpurCountingIncrementalMarker
-added SpurCountingIncrementalMarker SpurIncremental2PhaseGarbageCollector and SpurIncrementalCompactingSweeper which implement the modified algorithm
- added some helper functions on SpurMemoryMarker that print useful information
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3289 ===============
Item was changed:
Object subclass: #CCodeGenerator
+ instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers recursivelyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining mappingForRecursivePolymophism removedForPolymorphism recursivePolymorphicMethodsMap toGenerate classesToBeGenerated'
- instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers recursivelyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining mappingForRecursivePolymophism removedForPolymorphism recursivePolymorphicMethodsMap toGenerate'
classVariableNames: 'NoRegParmsInAssertVMs'
poolDictionaries: 'VMBasicConstants'
category: 'VMMaker-Translation to C'!
!CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.
See VMMaker for more useful info!
Item was changed:
----- Method: CCodeGenerator>>addClass: (in category 'public') -----
addClass: aClass
"Add the variables and methods of the given class to the code base."
+ classesToBeGenerated add: aClass.
aClass prepareToBeAddedToCodeGenerator: self.
self checkClassForNameConflicts: aClass.
self addClassVarsFor: aClass.
"ikp..."
self addPoolVarsFor: aClass.
(aClass inheritsFrom: VMStructType) ifFalse:
[variables addAll: (self instVarNamesForClass: aClass)].
self retainMethods: (aClass requiredMethodNames: self options).
'Adding Class ' , aClass name , '...'
displayProgressAt: Sensor cursorPoint
from: 0
to: aClass selectors size
during:
[:bar |
aClass selectors withIndexDo:
[:sel :i | | source |
bar value: i.
self addMethodFor: aClass selector: sel]].
aClass declareCVarsIn: self!
Item was added:
+ ----- Method: CCodeGenerator>>classesToBeGenerated (in category 'accessing') -----
+ classesToBeGenerated
+
+ ^ classesToBeGenerated!
Item was changed:
----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:fromMethod:in: (in category 'public') -----
ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode fromMethod: aTMethod in: aClass
"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
prefixed with a given string to disambiguate. This hack allows us to use two different
compaction algorithms with the same API at the same time; the selection being done
by a class which holds the flag stating which algorithm is in effect at the current time."
| class receiverSymbol |
staticallyResolvedPolymorphicReceivers ifNil: [^self].
"for debugging. Please do not remove!!"
+ "(aTMethod selector = #slidingCompactionRemapObj: and: [aSendNode selector = #isMobile:]) ifTrue: [self halt]."
- "aTMethod selector = #mapStackPages and: [aSendNode selector = #shouldRemapOop:]) ifTrue: [self halt]."
(aSendNode receiver isVariable
or: [(self hasPolymorphicMethod: aSendNode selector in: aClass )
or: [removedForPolymorphism includesKey: aSendNode selector]])
ifFalse: [^self].
receiverSymbol := aSendNode receiver name.
class := (aTMethod pragmasAt: #staticallyResolveMethod:to:)
ifNotNil: [:pragmas |
pragmas
detect: [:pragma | aSendNode selector = (pragma argumentAt: 1)]
ifFound: [:pragma | "self halt."
self
resolve: aSendNode
to: (Smalltalk at: (pragma argumentAt: 2))
ifFound: [^self]]
ifNone: []].
class := (aTMethod pragmaAt: #declareTypeForStaticPolymorphism:)
ifNotNil: [:pragma | | typeHint classFromHint |
typeHint := pragma argumentAt: 1.
classFromHint := Smalltalk at: (pragma argumentAt: 1).
"if we look at a polymorphic base method do not resolve it to its default but the type hint if it knows it"
methods at: aSendNode selector
ifPresent: [:method |
method isPolymorphicBase
ifTrue: [(method classes includes: classFromHint)
ifTrue: [ | newSelector |
newSelector := method polymorphicSelectorForClass: classFromHint.
aSendNode setSelectorForPolymorphism: newSelector.
^ self]].
method isPolymorphic
ifTrue: [self error: 'Should not happen']].
removedForPolymorphism at: aSendNode selector
ifPresent: [:dictionary |
dictionary at: classFromHint
ifPresent: [:selector |
aSendNode
setSelectorForPolymorphism: selector.
^ self].
(mappingForRecursivePolymophism associationsSelect: [:assoc | assoc value = classFromHint]) keys
detect: [:key | dictionary includesKey: key]
ifFound: [:clazz |
aSendNode
setSelectorForPolymorphism: (dictionary at: clazz).
^ self]
]].
class ifNil: [self resolveRecursivePolymorphism: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: [^ self]].
class := class ifNil: [self getClassFromPragmasIn: aTMethod ifMatching: receiverSymbol].
class := class ifNil: [self getClassFor: receiverSymbol in: aClass].
class := class ifNil: [
removedForPolymorphism at: aSendNode selector
ifPresent: [: dict |
+ "you probably ask yourself: why am I here? This halt is triggered if we were unable to resolve your method, although
+ it is polymorphic with a very high probability. You either have to declare to which type the method has to be resolved, you
+ did not implement to method in the class you would it expect to be in (inspect dict and see if the class you would expect is
+ listed there as a key. If not you did not call staticallyResolveMethodNamed:forClass:to: on the selector in the missing class, please
+ investigate) or I forgot to include one case if the type should already be known
- "you probably ask yourself: why am I here? This halt is triggered if we wre unable to resolve your method, although
- it is polymorphic with a very high probability. You either have to declare to which type the method has to be resolved
- or I forgot to include one case if the type should already be known
Please have a look what aTMethod to know in which method the problem occured and aSendNode to know the call in aTMethod that is not enough defined. Probably you want to include a pragma #staticallyResolveReceiver:to: to define of which type the receiver is. Should the current method be a Polymorphic(Base)TMethod it is probably interesting why resolveRecursivePolymorphism:in:fromMethod:in:ifMatch: above does not resolve it."
self halt]].
"we have to find a class to resolve the selector"
class
ifNotNil: [
aSendNode
setSelectorForPolymorphism: (class staticallyResolvePolymorphicSelector: aSendNode selector)]
!
Item was changed:
----- Method: CCodeGenerator>>initialize (in category 'initialize-release') -----
initialize
translationDict := Dictionary new.
inlineList := Array new.
constants := Dictionary new: 100.
variables := Set new: 100.
variableDeclarations := Dictionary new: 100.
methods := Dictionary new: 500.
kernelReturnTypes := self computeKernelReturnTypes.
macros := Dictionary new.
self initializeCTranslationDictionary.
headerFiles := OrderedCollection new.
globalVariableUsage := Dictionary new.
useSymbolicConstants := true.
generateDeadCode := true.
scopeStack := OrderedCollection new.
self getLogger.
pools := IdentitySet new.
selectorTranslations := IdentityDictionary new.
accessorDepthCache := IdentityDictionary new.
beganInlining := false.
suppressAsmLabels := false.
previousCommentMarksInlining := false.
previousCommenter := nil.
breakSrcInlineSelectors := IdentitySet new.
+ breakDestInlineSelectors := IdentitySet new.
+ classesToBeGenerated := IdentitySet new!
- breakDestInlineSelectors := IdentitySet new!
Item was changed:
----- Method: SpurAllAtOnceMarker>>markAndShouldScan: (in category 'marking') -----
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].
+ self setIsMarkedOf: objOop.
- 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].
(manager isWeakFormat: format) ifTrue: "push weaklings on the weakling stack to scan later"
[manager push: objOop onObjStack: manager weaklingStack.
^false].
((manager isEphemeronFormat: format)
and: [manager activeAndDeferredScan: objOop]) ifTrue:
[^false].
^true!
Item was changed:
----- Method: SpurAllAtOnceMarker>>markAndTraceClassOf: (in category 'marking') -----
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:
+ [self setIsMarkedOf: classObj.
- [manager setIsMarkedOf: classObj to: true.
self markAndTraceClassOf: classObj.
manager push: classObj onObjStack: manager markStack]!
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 setIsMarkedOf: manager rememberedSetObj.
+ self setIsMarkedOf: manager freeListsObj.
- manager setIsMarkedOf: manager rememberedSetObj to: true.
- manager setIsMarkedOf: manager freeListsObj to: true.
(manager isWeakNonImm: manager classTableFirstPage) ifTrue:
[^self markAndTrace: manager hiddenRootsObj].
+ self setIsMarkedOf: manager hiddenRootsObj.
- manager setIsMarkedOf: manager hiddenRootsObj to: true.
self markAndTrace: manager classTableFirstPage.
1 to: manager numClassTablePages - 1 do:
+ [:i| self setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)]!
- [:i| manager setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)
- to: true]!
Item was changed:
----- Method: SpurAllAtOnceMarker>>markAndTraceObjStack:andContents: (in category 'marking') -----
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].
+ self setIsMarkedOf: stackOrNil.
- 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:
+ [self setIsMarkedOf: field].
- [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 markAndTrace: field].
index := index - 1]!
Item was added:
+ ----- Method: SpurAllAtOnceMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ manager setIsMarkedOf: objOop to: true!
Item was added:
+ SpurIncrementalMarker subclass: #SpurCountingIncrementalMarker
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurGarbageCollector'!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker class>>selectorsInOverlappingClasses (in category 'as yet unclassified') -----
+ selectorsInOverlappingClasses
+
+ ^ SpurAllAtOnceMarker selectors intersection: (SpurIncrementalMarker selectors union: self selectors)!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>getUsedMemoryOf: (in category 'as yet unclassified') -----
+ getUsedMemoryOf: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+
+ "hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
+ how much life data is in the segment"
+ ^ segInfo lastFreeObject!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>initForNewMarkingPass (in category 'marking-initialization') -----
+ initForNewMarkingPass
+
+ super initForNewMarkingPass.
+
+ 0 to: manager numSegments - 1
+ do: [:index |
+ self setUsedMemory: 0 for: (manager segInfoAt: index)]!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ | segmentContainingObject |
+ super setIsMarkedOf: objOop.
+
+ self flag: #Todo. "we need a more efficient way to get the segment"
+ segmentContainingObject := manager segmentManager segmentContainingObj: objOop.
+ self
+ setUsedMemory: (self getUsedMemoryOf: segmentContainingObject) + (manager bytesInBody: objOop)
+ for: segmentContainingObject!
Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>setUsedMemory:for: (in category 'as yet unclassified') -----
+ setUsedMemory: usedMemory for: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+
+ "hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
+ how much life data is in the segment"
+ segInfo lastFreeObject: usedMemory!
Item was added:
+ SpurIncrementalGarbageCollector subclass: #SpurIncremental2PhaseGarbageCollector
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'VMMaker-SpurGarbageCollector'!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>compactorClass (in category 'accessing class hierarchy') -----
+ compactorClass
+
+ ^ SpurIncrementalCompactingSweeper!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>declareRecursivePolymorphismMappingForIncrementalClasses: (in category 'translation') -----
+ declareRecursivePolymorphismMappingForIncrementalClasses: aCCodeGenerator
+
+ aCCodeGenerator
+ forRecursivePolymorphismResolve: SpurCountingIncrementalMarker as: SpurIncrementalGarbageCollector;
+ forRecursivePolymorphismResolve: SpurIncrementalCompactingSweeper as: SpurIncrementalGarbageCollector!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>markerClass (in category 'accessing class hierarchy') -----
+ markerClass
+
+ ^ SpurCountingIncrementalMarker!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>markerClassesForTranslation (in category 'translation') -----
+ markerClassesForTranslation
+
+ ^ super markerClassesForTranslation , {SpurCountingIncrementalMarker}!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>sweeperAndCompactorClassesForTranslation (in category 'translation') -----
+ sweeperAndCompactorClassesForTranslation
+
+ ^ {SpurPlanningCompactor . SpurIncrementalCompactingSweeper}!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
+ doIncrementalCollect
+
+ | startTime |
+
+ phase = InMarkingPhase
+ ifTrue: [ | finishedMarking |
+ marker isCurrentlyMarking
+ ifFalse: [self assert: manager allObjectsUnmarked].
+
+ coInterpreter cr; print: 'start marking '; tab; flush.
+ finishedMarking := marker incrementalMarkObjects.
+
+ "self assert: manager validObjectColors."
+
+ finishedMarking
+ ifTrue: [
+ manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
+
+ "when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
+ We only know if they should get swept after the next marking -> keep them alive for this cycle"
+ self allocatorShouldAllocateBlack: true.
+ compactor setInitialSweepingEntity.
+ phase := InSweepingPhase.
+
+ "marking is done and thus all forwarding from the last compaction references are resolved
+ -> we can use the now free segments that were compacted during the last cycle"
+ compactor freePastSegmentsAndSetSegmentToFill.
+ compactor assertNoSegmentBeingCompacted.
+
+ self assert: manager noObjectGrey.
+
+ coInterpreter cr; print: 'finish marking '; tab; flush.
+
+ startTime := coInterpreter ioUTCMicrosecondsNow.
+ manager
+ setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
+ runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
+ checkFreeSpace: GCModeFull.
+
+ coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
+
+ 0 to: manager numSegments - 1
+ do: [:i | | segInfo |
+ segInfo := manager segInfoAt: i.
+ coInterpreter cr; print: 'occupation from marking: '; printNum: (segInfo lastFreeObject asFloat / segInfo segSize) * 100; tab; flush].
+
+ manager printSegmentOccupationFromMarkedObjects.
+
+ ^ self]
+ ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
+
+ phase = InSweepingPhase
+ ifTrue: [
+ coInterpreter cr; print: 'start sweeping '; tab; flush.
+ compactor incrementalSweepAndCompact
+ ifTrue: [
+ self allocatorShouldAllocateBlack: false.
+ manager allOldSpaceObjectsDo: [:ea | (manager isWhite: ea) ifFalse: [self cCode: 'raise(SIGINT)']. self assert: (manager isWhite: ea) ].
+ "self assert: manager allObjectsUnmarked."
+
+ coInterpreter cr; print: 'finish sweeping '; tab; flush.
+
+ startTime := coInterpreter ioUTCMicrosecondsNow.
+ manager
+ setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
+ runLeakCheckerFor: GCModeFull;
+ checkFreeSpace: GCModeFull.
+ coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
+
+ phase := InMarkingPhase.
+ ^ self]]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>inSweepingAheadOfSweepersPosition: (in category 'testing') -----
+ inSweepingAheadOfSweepersPosition: objOop
+
+ ^ self isSweeping and: [objOop >= compactor currentObject]!
Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>sweepersCurrentSweepingEntity (in category 'as yet unclassified') -----
+ sweepersCurrentSweepingEntity
+
+ ^ compactor currentObject!
Item was added:
+ SpurCompactor subclass: #SpurIncrementalCompactingSweeper
+ instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer'
+ classVariableNames: 'MaxObjectsToFree MaxOccupationForCompaction'
+ poolDictionaries: ''
+ category: 'VMMaker-SpurGarbageCollector'!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>declareCVarsIn: (in category 'as yet unclassified') -----
+ declareCVarsIn: aCCodeGenerator
+
+ aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'.
+
+ SpurMemoryManager wantsIncrementalGC
+ ifTrue: [
+ (self selectors intersection: SpurPlanningCompactor selectors)
+ do: [:key |
+ aCCodeGenerator
+ staticallyResolveMethodNamed: key
+ forClass: self
+ to: (self staticallyResolvePolymorphicSelector: key)]]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>hasPolymorphicSelectors (in category 'as yet unclassified') -----
+ hasPolymorphicSelectors
+ "when using the incremental gc we have polymorphic selectors and have to resolve them"
+
+ ^ SpurMemoryManager wantsIncrementalGC!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ super initialize.
+ "If the segment is occupied by more than MaxOccupationForCompaction,
+ it's not worth compacting it, whatever the rest of the system looks like.
+ MaxOccupationForCompaction is included in [0;16rFFFF]."
+ MaxOccupationForCompaction := 16rD000. "81%"
+ MaxObjectsToFree := 100000!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
+
+ | intersection |
+ intersection := (self selectors intersection: SpurPlanningCompactor selectors).
+
+ ^ (intersection includes: aSelectorSymbol)
+ ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
+ ifFalse: [aSelectorSymbol]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>advanceSegment (in category 'sweep and compact') -----
+ advanceSegment
+
+ self assert: (manager isSegmentBridge: currentObject).
+ currentSegmentsIndex := currentSegmentsIndex + 1.
+
+ self flag: #Todo. "is this ever false? Mhh, investigate"
+ currentSegmentsIndex < manager segmentManager numSegments
+ ifTrue: [currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex].
+
+ currentObject := self nextCurrentObject
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>assertNoSegmentBeingCompacted (in category 'as yet unclassified') -----
+ assertNoSegmentBeingCompacted
+ "Assertion only - no segment is being claimed at this point. All being compacted bits get cleared during sweeping when setting the occupation of the segments"
+ | segInfo |
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 0 to: manager numSegments - 1 do:
+ [:i|
+ segInfo := manager segInfoAt: i.
+ self deny: (self isSegmentBeingCompacted: segInfo).
+ (self isSegmentBeingCompacted: segInfo)
+ ifTrue: [self cCode: 'raise(SIGINT)']].!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>biasForGC (in category 'api') -----
+ biasForGC!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>biasForSnapshot (in category 'api') -----
+ biasForSnapshot!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>canUseAsFreeSpace: (in category 'testing') -----
+ canUseAsFreeSpace: objOop
+
+ <inline: true>
+ ^ (manager isFreeObject: objOop) or: [(manager isMarked: objOop) not]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>cannotBeCompacted: (in category 'testing') -----
+ cannotBeCompacted: segInfo
+
+ ^ (self isSegmentBeingCompacted: segInfo)
+ or: [segInfo containsPinned
+ or: [manager segmentManager isEmptySegment: segInfo]]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>cautiousBulkFreeChunkFrom: (in category 'incremental sweeping') -----
+ cautiousBulkFreeChunkFrom: objOop
+ "The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
+ from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
+ | bytes start next currentObj |
+ self assert: (self canUseAsFreeSpace: objOop).
+
+ start := manager startOfObject: objOop.
+ currentObj := objOop.
+ bytes := 0.
+
+ [bytes := bytes + (manager bytesInBody: currentObj).
+ (manager isRemembered: currentObj)
+ ifTrue:
+ [self assert: (manager isFreeObject: currentObj) not.
+ scavenger forgetObject: currentObj].
+
+ (manager isFreeObject: currentObj)
+ ifTrue: [ "we need to unlink chunks for concurrent sweeping. In the stop the world sweeper we can just reset the freeLists but here we need to keep them
+ around so the mutator can still work between sweeping passes"
+
+ self flag: #Todo. "we want to optimize for lilliputian chunks!! For now it is ok(ish) but we have to do something about it.
+ At the moment I see 3 possibilities:
+ - have the lilliputian list always sorted (O(n) insert in the worst case!!)
+ - sort the lilliputian part before sweeping (O(n log n) at the start. but everytime before sweeping)
+ - be cheeky and discard the lilliputian list (problem: the mutator has no access to the list + it can insert unsorted chunks (for the duration of sweeping we could let it use a second list and just append it after sweeping)"
+ manager detachFreeObject: currentObj.
+ "self assert: manager totalFreeOldSpace = manager totalFreeListBytes."].
+
+
+ next := manager objectStartingAt: start + bytes.
+ currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.
+ self assert: ((manager oop: next isLessThan: manager endOfMemory)
+ or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
+
+ "should the next object not be usable as free space (because it is marked) abort the loop. Attention:
+ briges at the end of segments are marked and therefore we leave the loop here. This is important as the
+ newly created free space segment should not be bigger than there still is space left in the current segment"
+ (self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]]
+ whileTrue: [currentObj := next].
+
+ ^ manager addFreeChunkWithBytes: bytes at: start!
Item was added:
+ ----- 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 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: segmentToFill segStart ; tab; flush.
+ self unmarkSegmentAsBeingCompacted: (manager segInfoAt: currentSegmentsIndex).
+
+ "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: [
+ (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 mark the free chunk as a word object."
+ 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>>computeSegmentsToCompact (in category 'compaction planning') -----
+ computeSegmentsToCompact
+ "Compute segments to compact: least occupied.
+ Answers true if compaction should be done
+ (at least 1 segment is being compacted and
+ there is a segment to compact into)."
+ | canStillClaim aboutToClaim aboutToClaimSegment atLeastOneSegmentToCompact |
+ <var: 'aboutToClaimSegment' type: #'SpurSegmentInfo *'>
+ atLeastOneSegmentToCompact := false.
+ aboutToClaimSegment := self findNextSegmentToCompact.
+ "Segment to fill is one of the segment compacted last GC.
+ If no segment were compacted last GC, and that there is
+ at least one segment to compact, allocate a new one."
+ aboutToClaimSegment ifNil: [^false].
+ segmentToFill ifNil:
+ [self findOrAllocateSegmentToFill.
+ segmentToFill ifNil: ["Abort compaction"^false]].
+ canStillClaim := segmentToFill segSize - manager bridgeSize.
+ [aboutToClaimSegment ifNil: [^atLeastOneSegmentToCompact].
+ aboutToClaim := self sizeClaimedIn: aboutToClaimSegment.
+ aboutToClaim < canStillClaim ] whileTrue:
+ [self markSegmentAsBeingCompacted: aboutToClaimSegment.
+
+ coInterpreter cr;
+ print: 'about to compact segment from: '; printHex: aboutToClaimSegment segStart;
+ print: ' to: '; printHex: aboutToClaimSegment segStart + aboutToClaimSegment segSize ;tab; flush.
+
+ atLeastOneSegmentToCompact := true.
+ canStillClaim := canStillClaim - aboutToClaim.
+ aboutToClaimSegment := self findNextSegmentToCompact].
+ ^atLeastOneSegmentToCompact!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>currentObject (in category 'accessing') -----
+ currentObject
+
+ <cmacro: '() GIV(currentObject)'>
+ ^ currentObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>doIncrementalCompact (in category 'incremental compact') -----
+ doIncrementalCompact
+
+ | segInfo |
+ segInfo := manager segInfoAt: currentSegmentsIndex.
+
+ self assert: segInfo ~= segmentToFill.
+ self assert: (self isSegmentBeingCompacted: segInfo).
+
+ coInterpreter cr;
+ print: 'Compact from: '; printHex: segInfo segStart;
+ print: ' to: '; printHex: segInfo segStart + segInfo segSize;
+ print: ' into: ' ; printHex: segmentToFill segStart; tab; flush.
+
+ currentCopyToPointer := self compactSegment: segInfo freeStart: currentCopyToPointer segIndex: currentSegmentsIndex.
+ self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
+ self assert: (self oop: currentCopyToPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)).
+
+ "guarantee heap parsability for the segmentToFill, for example when invoking checkHeapFreeSpaceIntegrityForIncrementalGC where we walk to whole heap and could enter segmentToFill in an invalid state"
+ self occupyRestOfFreeCompactedIntoSegment.
+
+ coInterpreter cr;
+ print: 'Pointer now: '; printHex: currentCopyToPointer; tab; flush.
+
+ self postCompactionAction!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>doIncrementalSweep (in category 'incremental sweeping') -----
+ doIncrementalSweep
+
+ self assert: (self addressOf: (manager segmentManager segments at: currentSegmentsIndex)) ~= segmentToFill.
+
+ (self canUseAsFreeSpace: currentObject)
+ ifTrue: [currentObject := self cautiousBulkFreeChunkFrom: currentObject]
+ ifFalse: [self unmarkCurrentObject]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>doincrementalSweepAndCompact (in category 'sweep and compact') -----
+ doincrementalSweepAndCompact
+
+ "Scan the heap for unmarked objects and free them. Coalescence "
+ self assert: currentObject notNil.
+
+ currentsCycleSeenObjectCount := 0.
+
+ [self oop: currentObject isLessThan: manager endOfMemory] whileTrue:
+ [ currentObject = currentSegmentsBridge
+ ifTrue: [self advanceSegment]
+ ifFalse: [self sweepOrCompactFromCurrentObject].
+
+ currentsCycleSeenObjectCount >= MaxObjectsToFree
+ ifTrue: [^ false]].
+
+ "set occupation for last segment"
+ manager checkFreeSpace: GCModeIncremental.
+ ^ true!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>findAndSetSegmentToFill (in category 'segment to fill') -----
+ findAndSetSegmentToFill
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ | segInfo |
+ 0 to: manager numSegments - 1
+ do: [:i |
+ segInfo := manager segInfoAt: i.
+ (self segmentIsEmpty: segInfo)
+ ifTrue: [segmentToFill := segInfo.
+ ^ i]].
+
+ ^ -1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>findNextSegmentToCompact (in category 'compaction planning') -----
+ findNextSegmentToCompact
+ "Answers the next segment to compact or nil if none.
+ The next segment to compact:
+ - cannot be segment 0 (Segment 0 has specific objects
+ (nil, true, etc.) and special size computed at start-up
+ that we don't want to deal with)
+ - cannot have a high occupation rate (> MaxOccupationForCompaction)"
+ | leastOccupied leastOccupiedSegment tempOccupied segInfo |
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ leastOccupied := 1.
+ 1 to: manager numSegments - 1 do:
+ [:i|
+ segInfo := manager segInfoAt: i.
+ (self cannotBeCompacted: segInfo)
+ ifFalse:
+ [(tempOccupied := self occupationOf: segInfo) <= leastOccupied
+ ifTrue: [ leastOccupied := tempOccupied.
+ leastOccupiedSegment := segInfo ]]].
+ leastOccupied > MaxOccupationForCompaction ifTrue:
+ [^self cCoerceSimple: nil to: #'SpurSegmentInfo *'].
+ ^leastOccupiedSegment!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>findOrAllocateSegmentToFill (in category 'segment to fill') -----
+ findOrAllocateSegmentToFill
+ "There was no compacted segments from past GC that we can directly re-use.
+ We need either to find an empty segment or allocate a new one."
+ | segIndex |
+ "segment was already set from freePastSegmentsAndSetSegmentToFill at the end of the last markingpass. No need to do something. "
+ segmentToFill ifNotNil: [^0].
+
+ self findAndSetSegmentToFill.
+ segmentToFill ifNotNil: [self reserveSegmentToFill. ^0].
+
+ "No empty segment. We need to allocate a new one"
+ (manager growOldSpaceByAtLeast: manager growHeadroom) ifNil: ["failed to allocate"^0].
+
+ "We don't know which segment it is that we've just allocated... So we look for it... This is a bit dumb."
+ segIndex := self findAndSetSegmentToFill.
+ self assert: segmentToFill ~~ nil.
+ self reserveSegmentToFill!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>finishSweepAndCompact (in category 'sweep and compact') -----
+ finishSweepAndCompact
+
+ self assert: manager allObjectsWhite.
+ self reset.
+ self flag: #Todo. "update time needed for gc"!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>freePastSegmentsAndSetSegmentToFill (in category 'public') -----
+ freePastSegmentsAndSetSegmentToFill
+
+ "The first segment being claimed met becomes the segmentToFill. The others are just freed."
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 0 to: manager numSegments - 1 do:
+ [:i| | segInfo |
+ segInfo := manager segInfoAt: i.
+ (self isSegmentBeingCompacted: segInfo) ifTrue:
+ [ | freeChunk chunkBytes |
+ self assert: (manager segmentManager allObjectsAreForwardedInSegment: segInfo includingFreeSpace: false).
+ self assert: (manager noElementOfFreeSpaceIsInSegment: segInfo).
+
+ coInterpreter
+ cr; print: 'freeing segment from: '; printHex: segInfo segStart;
+ print: ' to: '; printHex: segInfo segStart + segInfo segSize ;tab; flush.
+
+ chunkBytes := segInfo segSize - manager bridgeSize.
+ freeChunk := manager
+ addFreeChunkWithBytes: chunkBytes
+ at: segInfo segStart.
+
+ self unmarkSegmentAsBeingCompacted: segInfo.
+
+ segmentToFill ifNil:
+ [manager detachFreeObject: freeChunk.
+ segmentToFill := segInfo]]]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'public') -----
+ incrementalSweepAndCompact
+
+ self initIfNecessary.
+
+ self assert: manager validObjectColors.
+
+ self doincrementalSweepAndCompact
+ ifTrue: [self finishSweepAndCompact.
+ ^ true].
+
+ coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush.
+
+ ^ false!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initForCompaction (in category 'state initialization') -----
+ initForCompaction
+
+ self assertNoSegmentBeingCompacted.
+ self planCompactionAndReserveSpace.
+
+ self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
+
+ shouldCompact
+ ifTrue: [currentCopyToPointer := segmentToFill segStart].!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initForSweeping (in category 'state initialization') -----
+ initForSweeping
+
+ currentSegmentsIndex := 0.
+ currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
+
+ currentObject := manager firstObject.!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initIfNecessary (in category 'state initialization') -----
+ initIfNecessary
+
+ isCurrentlyWorking
+ ifFalse: [
+ self initForSweeping.
+ self initForCompaction.
+
+ isCurrentlyWorking := true]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>initialize (in category 'initialize-release') -----
+ initialize
+
+ isCurrentlyWorking := false.
+ currentSegmentsIndex := 0.
+ currentsCycleSeenObjectCount := 0.
+ currentSegmentsBridge := nil.
+ currentObject := nil.
+ segmentToFill := nil.
+ shouldCompact := false.
+ currentCopyToPointer := nil!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>isMobile: (in category 'as yet unclassified') -----
+ isMobile: obj
+
+ <inline: true>
+ self flag: #Todo. "investigate this one here"
+ ^ (manager isPinned: obj) not!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>isSegmentAtIndexBeingCompacted: (in category 'testing') -----
+ isSegmentAtIndexBeingCompacted: segIndex
+
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ ^ (manager segInfoAt: segIndex) swizzle = 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>isSegmentBeingCompacted: (in category 'testing') -----
+ isSegmentBeingCompacted: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ ^ segInfo swizzle = 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>markSegmentAsBeingCompacted: (in category 'segment access') -----
+ markSegmentAsBeingCompacted: segInfo
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ self assert: (manager numSegments > 1 and: [segInfo ~= (self addressOf: (manager segmentManager segments at: 0))]).
+ segInfo swizzle: 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>migrate:sized:to: (in category 'incremental compact') -----
+ migrate: obj sized: bytesToCopy to: address
+
+ | copy |
+ self assert: (manager isPinned: obj) not.
+
+ manager memcpy: address asVoidPointer _: (manager startOfObject: obj) asVoidPointer _: bytesToCopy.
+
+ copy := manager objectStartingAt: address.
+ (manager isRemembered: copy) ifTrue:
+ ["copy has the remembered bit set, but is not in the remembered table."
+ manager setIsRememberedOf: copy to: false.
+ scavenger remember: copy].
+
+ manager forward: obj to: (manager objectStartingAt: address).
+
+ ^ copy!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>nextCurrentObject (in category 'sweep and compact') -----
+ nextCurrentObject
+
+ | nextObject |
+ nextObject := manager objectAfter: currentObject limit: manager endOfMemory.
+
+ (segmentToFill notNil and: [manager segmentManager is: nextObject inSegment: segmentToFill])
+ ifTrue: [
+ "skip the reserved segment. Return the bridge so we go into advanceSegment"
+ nextObject := manager segmentManager bridgeFor: segmentToFill].
+
+ ^ nextObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>occupationOf: (in category 'segment access') -----
+ occupationOf: segInfo
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "lastFreeObject is abused to save the claimed memory for the given segment"
+
+ ^ segInfo lastFreeObject asFloat / segInfo segSize!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>occupyRestOfFreeCompactedIntoSegment (in category 'incremental compact') -----
+ occupyRestOfFreeCompactedIntoSegment
+
+ manager
+ initFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentCopyToPointer
+ at: currentCopyToPointer.
+
+ "avoid confusing spur, especially for leak checks"
+ manager
+ set: (manager objectStartingAt: currentCopyToPointer)
+ classIndexTo: manager wordSizeClassIndexPun
+ formatTo: manager wordIndexableFormat!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>planCompactionAndReserveSpace (in category 'compaction planning') -----
+ planCompactionAndReserveSpace
+
+ shouldCompact := self computeSegmentsToCompact
+
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>postCompactionAction (in category 'incremental compact') -----
+ postCompactionAction
+
+ | allFlags |
+ "For now we don't optimize and just follow everything everywhere on stack and in caches, let's see in the profiler if we need to optimize with those cases. My guess is that this is < 100 microSecond"
+ manager followSpecialObjectsOop.
+ allFlags := BecamePointerObjectFlag + BecameActiveClassFlag bitOr: BecameCompiledMethodFlag.
+ "Note: there is not the OldBecameNewFlag"
+ "gcMode flag is cleared after postBecomeAction, reset it."
+ manager coInterpreter postBecomeAction: allFlags.
+ manager coInterpreter setGCMode: GCModeFull.
+
+ "Special to selective, crazy objects can be forwarded..."
+ "manager postBecomeScanClassTable: allFlags. => Done in followClassTable"
+ manager followClassTable.
+ manager followProcessList.
+ manager followForwardedObjStacks.
+
+ "Not sure the following are needed...
+ coInterpreter mapInterpreterOops.
+ manager mapExtraRoots."
+ self assert: manager validClassTableHashes.!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>postSwizzleAction (in category 'public') -----
+ postSwizzleAction
+ "Since the compact abuses the swizzle field of segment, it needs to be reset after start-up."
+
+ | segInfo |
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 0 to: manager numSegments - 1 do:
+ [:i|
+ segInfo := manager segInfoAt: i.
+ segInfo swizzle: 0 ]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>remapObj: (in category 'api') -----
+ remapObj: objOop
+ "Scavenge or simply follow objOop. Answer the new location of objOop.
+ The send should have been guarded by a send of shouldRemapOop:.
+ The method is called remapObj: for compatibility with ObjectMemory."
+ <api>
+ <inline: false>
+ ^manager slidingCompactionRemapObj: objOop!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>reserveSegmentToFill (in category 'segment access') -----
+ reserveSegmentToFill
+ "remove the free space from the freeLists so the mutator cannot allocate in this segment"
+
+ | freeChunk |
+ self assert: segmentToFill notNil.
+ self assert: (self segmentIsEmpty: segmentToFill).
+
+ freeChunk := manager objectStartingAt: segmentToFill segStart.
+ manager detachFreeObject: freeChunk!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>reset (in category 'sweep and compact') -----
+ reset
+
+ self setFreeChunkOfCompactedIntoSegment.
+
+ isCurrentlyWorking := false.
+ shouldCompact := false.
+ currentCopyToPointer := 0.
+ currentSegmentsIndex := 0.
+ currentObject := 0.
+ currentSegmentsIndex := nil.
+ currentsCycleSeenObjectCount := 0!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>segmentIsEmpty: (in category 'testing') -----
+ segmentIsEmpty: segInfo
+ "a free segment contains only a free chunk and a bridge (every segment ends in one of these)"
+
+ ^ manager segmentManager isEmptySegment: segInfo!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>segmentToFill (in category 'accessing') -----
+ segmentToFill
+
+ <cmacro: '() GIV(segmentToFill)'>
+ ^ segmentToFill!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>setFreeChunkOfCompactedIntoSegment (in category 'incremental compact') -----
+ setFreeChunkOfCompactedIntoSegment
+
+ shouldCompact ifFalse: [^ self].
+
+ self assert: segmentToFill notNil.
+ self assert: (self oop: currentCopyToPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)).
+
+ manager
+ addFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentCopyToPointer
+ at: currentCopyToPointer.
+
+ "we have compacted into segmentToFill. It is now not empty anymore and we need to look for a new one"
+ segmentToFill := nil
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>setInitialSweepingEntity (in category 'as yet unclassified') -----
+ setInitialSweepingEntity
+
+ currentObject := manager firstObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>setSegmentToFillToAddress: (in category 'segment to fill') -----
+ setSegmentToFillToAddress: segInfo
+ "part of canReactToShiftSegment:to:. We cannot make any assertions, as the segment still has to be moved in the segments array
+ and right at this moment we do not point to the right address, but we will in a moment (see removeSegment: and canReactToShiftSegment:to: or insertSegmentFor: that brings us to this method to understand better)"
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ segmentToFill := segInfo!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>shouldCompactCurrentSegment (in category 'sweep and compact') -----
+ shouldCompactCurrentSegment
+
+ | currentSegment |
+ shouldCompact ifFalse: [^ false].
+
+ currentSegment := (manager segInfoAt: currentSegmentsIndex).
+ ^ self isSegmentBeingCompacted: currentSegment!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>shouldRemapObj: (in category 'api') -----
+ shouldRemapObj: objOop
+ "Answer if the obj should be scavenged, or simply followed. Sent via the compactor
+ from shouldRemapObj:. We test for being already scavenged because mapStackPages
+ via mapInterpreterOops may be applied twice in the context of a global GC where a
+ scavenge, followed by a scan-mark-free, and final compaction passes may result in
+ scavenged fields being visited twice."
+ <api>
+ <inline: false>
+ ^manager slidingCompactionShouldRemapObj: objOop!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>sizeClaimedIn: (in category 'as yet unclassified') -----
+ sizeClaimedIn: segment
+ <var: 'segment' type: #'SpurSegmentInfo *'>
+
+ ^ segment lastFreeObject!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>sweepOrCompactFromCurrentObject (in category 'sweep and compact') -----
+ sweepOrCompactFromCurrentObject
+
+ self shouldCompactCurrentSegment
+ ifTrue: [self doIncrementalCompact.
+
+ "either we finished compacting the segment or we had to abort compaction as the segment to fill cannot take more objects from this segment. We have to continue sweeping. This is done by unmarking the current segment as beeing compacted and making sure the last object we nearly copied before (and we know was alive after marking) is kept alive for sweeping"
+ self assert: ((manager isSegmentBridge: currentObject)
+ or: [(manager isMarked: currentObject) and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]])]
+ ifFalse: [self doIncrementalSweep.
+ currentObject := self nextCurrentObject]
+ !
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>unmark: (in category 'incremental sweeping') -----
+ unmark: objOop
+
+ self assert: ((manager isMarked: objOop) and: [(manager isFreeObject: objOop) not]).
+
+ (manager isSegmentBridge: objOop)
+ ifFalse: [manager
+ setIsMarkedOf: objOop to: false;
+ setIsGreyOf: objOop to: false].
+
+ (manager isPinned: objOop)
+ ifTrue: [manager segmentManager notePinned: objOop]!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>unmarkCurrentObject (in category 'incremental sweeping') -----
+ unmarkCurrentObject
+
+ self unmark: currentObject.
+ currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>unmarkSegmentAsBeingCompacted: (in category 'segment access') -----
+ unmarkSegmentAsBeingCompacted: segInfo
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ "Swizzle is abused to note a segment as being compacted. 1 means yes, 0 no"
+ segInfo swizzle: 0!
Item was changed:
----- Method: SpurIncrementalGarbageCollector class>>classesForTranslation (in category 'translation') -----
classesForTranslation
+ ^ super classesForTranslation , self markerClassesForTranslation , {SpurStopTheWorldGarbageCollector} , self sweeperAndCompactorClassesForTranslation!
- ^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurStopTheWorldGarbageCollector . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }!
Item was changed:
----- Method: SpurIncrementalGarbageCollector class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
super declareCVarsIn: aCCodeGenerator.
aCCodeGenerator
var: 'phase' declareC: 'sqInt phase = 0';
var: 'checkSetGCFlags' declareC: 'sqInt checkSetGCFlags = 1'.
aCCodeGenerator
staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker in: self.
+
+ SpurMemoryManager gcClass = self
+ ifTrue: [
+ self declareRecursivePolymorphismMappingForIncrementalClasses: aCCodeGenerator.
+
+ "just important when doiing incremental compaction, therefore doin it here"
+ aCCodeGenerator
+ forRecursivePolymorphismResolve: SpurAllAtOnceMarker as: SpurStopTheWorldGarbageCollector;
+ forRecursivePolymorphismResolve: SpurPlanningCompactor as: SpurStopTheWorldGarbageCollector].
+ !
- aCCodeGenerator
- forRecursivePolymorphismResolve: SpurIncrementalMarker as: self;
- forRecursivePolymorphismResolve: SpurIncrementalCompactor as: self;
- forRecursivePolymorphismResolve: SpurIncrementalSweepAndCompact as: self;
- forRecursivePolymorphismResolve: SpurIncrementalSweeper as: self.
-
- "just important when doiing incremental compaction, therefore doin it here"
- aCCodeGenerator
- forRecursivePolymorphismResolve: SpurAllAtOnceMarker as: SpurStopTheWorldGarbageCollector;
- forRecursivePolymorphismResolve: SpurPlanningCompactor as: SpurStopTheWorldGarbageCollector!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector class>>declareRecursivePolymorphismMappingForIncrementalClasses: (in category 'nil') -----
+ declareRecursivePolymorphismMappingForIncrementalClasses: aCCodeGenerator
+
+ aCCodeGenerator
+ forRecursivePolymorphismResolve: SpurIncrementalMarker as: self;
+ forRecursivePolymorphismResolve: SpurIncrementalCompactor as: self;
+ forRecursivePolymorphismResolve: SpurIncrementalSweepAndCompact as: self;
+ forRecursivePolymorphismResolve: SpurIncrementalSweeper as: self.!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector class>>markerClassesForTranslation (in category 'translation') -----
+ markerClassesForTranslation
+
+ ^ {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker}!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector class>>sweeperAndCompactorClassesForTranslation (in category 'translation') -----
+ sweeperAndCompactorClassesForTranslation
+
+ ^ {SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact}!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
assertSettingGCFlagsIsOk: objOop
checkSetGCFlags ifFalse: [^ self].
"do not color young objects. They have an extra state we do not want to change"
self assert: (manager isOldObject: objOop).
(manager isOldObject: objOop)
ifFalse: [self cCode: 'raise(SIGINT)'].
"while sweeping: do not color objects behind the currently point the sweeper is at. This would infer with the next marking pass"
+ self assert: (self allocatorShouldAllocateBlack not or: [self inSweepingAheadOfSweepersPosition: objOop]).
- self assert: (self allocatorShouldAllocateBlack not or: [objOop >= self compactor currentSweepingEntity]).
+ (self allocatorShouldAllocateBlack not or: [self inSweepingAheadOfSweepersPosition: objOop])
- (self allocatorShouldAllocateBlack not or: [objOop >= self compactor currentSweepingEntity])
ifFalse: [self cCode: 'raise(SIGINT)']!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
| startTime |
phase = InMarkingPhase
ifTrue: [ | finishedMarking |
marker isCurrentlyMarking
ifFalse: [self assert: manager allObjectsUnmarked].
coInterpreter cr; print: 'start marking '; tab; flush.
finishedMarking := marker incrementalMarkObjects.
"self assert: manager validObjectColors."
finishedMarking
ifTrue: [
manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
We only know if they should get swept after the next marking -> keep them alive for this cycle"
self allocatorShouldAllocateBlack: true.
compactor setInitialSweepingEntity.
phase := InSweepingPhase.
"marking is done and thus all forwarding from the last compaction references are resolved
-> we can use the now free segments that were compacted during the last cycle"
compactor freePastSegmentsAndSetSegmentToFill.
self assert: manager noObjectGrey.
coInterpreter cr; print: 'finish marking '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
-
+ 0 to: manager numSegments - 1
+ do: [:i | | segInfo |
+ segInfo := manager segInfoAt: i.
+ coInterpreter cr; print: 'occupation from marking: '; printNum: (segInfo lastFreeObject asFloat / segInfo segSize) * 100; tab; flush].
+
^ self]
ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
phase = InSweepingPhase
ifTrue: [
coInterpreter cr; print: 'start sweeping '; tab; flush.
compactor incrementalSweep
ifTrue: [
self allocatorShouldAllocateBlack: false.
manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
"self assert: manager allObjectsUnmarked."
coInterpreter cr; print: 'finish sweeping '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
compactor assertNoSegmentBeingCompacted.
phase := InCompactingPhase.
^ self]].
phase = InCompactingPhase
ifTrue: [
"self cCode: 'raise(SIGINT)'."
coInterpreter cr; print: 'start compacting '; tab; flush.
+ "compactor isCurrentlyCompacting
+ ifFalse: [manager printFreeSpaceStatistics]."
- compactor isCurrentlyCompacting
- ifFalse: [manager printFreeSpaceStatistics].
compactor incrementalCompact
ifTrue: [
coInterpreter cr; print: 'finish compacting '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
phase := InMarkingPhase.
^ self]]!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') -----
isOkToScavengeRememberedObject: objOop
"When sweeping we can alreay have freed an object A that is referenced by B. If B is behind the sweepers
position and not marked it is garbage and to be collected. Yet B is still in the remembered set and will get
scanned, during which the freed object will be visited an an error caused. Use this check to prevent this"
+ ^ ((self inSweepingAheadOfSweepersPosition: objOop)
+ and: [(manager isMarked: objOop) not]) not!
- ^ (phase = InSweepingPhase
- and: [objOop >= compactor currentSweepingEntity
- and: [(manager isMarked: objOop) not]]) not!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>maybeModifyForwarder: (in category 'object creation barriers') -----
maybeModifyForwarder: objOop
"mark forwarders so they do not get garbage collected before they can get resolved.
1. Does only apply to marking because only in this phase we can overlook forwarding references to be resolved (e.g. when
the mutator runs after the first marking pass and an object that is referenced by at least one already black object gets a forwarded -> the pointer of the black object won't get updated in this marking pass and during sweeping the forwarding pointer will get removed).
2. Does not apply to sweeping or compacting because the forwarder is set on the header of the original object, which already includes
the correcty set mark bit"
self assert: (manager isForwarded: objOop).
((manager isOldObject: objOop) and: [marker isCurrentlyMarking])
+ ifTrue: [marker setIsMarkedOf: objOop]!
- ifTrue: [manager setIsMarkedOf: objOop to: true]!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>sweepersCurrentSweepingEntity (in category 'as yet unclassified') -----
+ sweepersCurrentSweepingEntity
+
+ ^ compactor sweeper currentSweepingEntity!
Item was changed:
SpurMarker subclass: #SpurIncrementalMarker
instanceVariableNames: 'isCurrentlyMarking'
classVariableNames: 'SlotLimitPerPass'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+ !SpurIncrementalMarker commentStamp: 'WoC 1/4/2023 00:21' prior: 0!
+ Marker for the SpurIncrementalGarbageCollector. It is concipated to mark objects in old space (and only in old space!!) while beeing able to be interrupted
- !SpurIncrementalMarker commentStamp: 'WoC 12/2/2022 23:39' prior: 0!
- Marker for the SpurIncrementalGarbageCollector.
Roots are:
- Stack references
- hidden objects
- extra objects
- young space objects
Instance Variables
isCurrentlyMarking: <Object>
isCurrentlyMarking
- xxxxx
!
Item was changed:
----- Method: SpurIncrementalMarker>>blackenObject: (in category 'as yet unclassified') -----
blackenObject: obj
self flag: #Todo. "do we need to ungrey the object or can we save the call? Idea:
-> if grey set -> grey
-> if mark set -> ignore grey, interpret it as black"
manager setIsGreyOf: obj to: false.
+ self setIsMarkedOf: obj!
- manager setIsMarkedOf: obj to: true!
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 ].
- whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true].
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 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].
- whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true].
currentObj := manager popObjStack: manager markStack].
"repeat while there still are objects"
currentObj notNil] whileTrue.
^ true!
Item was changed:
----- Method: SpurIncrementalMarker>>incrementalMarkFrom: (in category 'marking - incremental') -----
incrementalMarkFrom: objOop
"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 := objOop.
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].
((manager isYoung: currentObj) and: [manager isInClassTable: currentObj])
+ ifTrue: [self setIsMarkedOf: currentObj].
- ifTrue: [manager setIsMarkedOf: currentObj to: true].
slotNumber := manager numStrongSlotsOfInephemeral: currentObj.
slotsToVisit := slotNumber - startIndex.
slotsLeft - slotsToVisit < 0
ifTrue: [
self
markFrom: startIndex
nSlots: slotsLeft
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: slotsLeft + 1) 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].
"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 added:
+ ----- Method: SpurIncrementalMarker>>initForNewMarkingPass (in category 'marking-initialization') -----
+ initForNewMarkingPass
+
+ manager initializeMarkStack.
+ manager initializeWeaklingStack.
+ manager initializeEphemeronStack.
+
+ "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 markHelperStructures.
+
+ isCurrentlyMarking := true.
+ marking := true.
+ self pushInternalStructuresOnMarkStack
+
+ !
Item was changed:
----- Method: SpurIncrementalMarker>>initForNewMarkingPassIfNecessary (in category 'marking-initialization') -----
initForNewMarkingPassIfNecessary
isCurrentlyMarking
+ ifFalse: [self initForNewMarkingPass]
- ifFalse: [
- manager initializeMarkStack.
- manager initializeWeaklingStack.
- manager initializeEphemeronStack.
-
- "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 markHelperStructures.
-
- isCurrentlyMarking := true.
- marking := true.
- self pushInternalStructuresOnMarkStack].
!
Item was changed:
----- Method: SpurIncrementalMarker>>markAndTraceObjStack:andContents: (in category 'marking-initialization') -----
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].
+ self setIsMarkedOf: stackOrNil.
- 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:
+ [self setIsMarkedOf: field].
- [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 pushOnMarkingStackAndMakeGrey: field].
index := index - 1]!
Item was changed:
----- Method: SpurIncrementalMarker>>markHelperStructures (in category 'marking-initialization') -----
markHelperStructures
"marks the structures needed during GC"
+ self setIsMarkedOf: manager rememberedSetObj.
+ self setIsMarkedOf: manager freeListsObj.
- manager setIsMarkedOf: manager rememberedSetObj to: true.
- manager setIsMarkedOf: manager freeListsObj to: true.
(manager isWeakNonImm: manager classTableFirstPage) ifTrue:
[self pushOnMarkingStackAndMakeGrey: manager hiddenRootsObj].
+ self setIsMarkedOf: manager hiddenRootsObj!
- manager setIsMarkedOf: manager hiddenRootsObj to: true!
Item was changed:
----- Method: SpurIncrementalMarker>>pushHiddenRootsReferencesOnMarkingStack (in category 'root-scanning') -----
pushHiddenRootsReferencesOnMarkingStack
| classTablePageSizeLocal |
self markAndTraceObjStack: manager markStack andContents: false.
self markAndTraceObjStack: manager weaklingStack andContents: false.
self markAndTraceObjStack: manager mournQueue andContents: true.
self markAndTraceObjStack: manager ephemeronStack andContents: false.
classTablePageSizeLocal := manager numStrongSlotsOfInephemeral: manager classTableFirstPage.
self markNSlots: classTablePageSizeLocal of: manager classTableFirstPage.
self blackenObject: manager classTableFirstPage.
1 to: manager numClassTablePages - 1 do:
+ [:i| self setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)]!
- [:i| manager setIsMarkedOf: (manager fetchPointer: i ofObject: manager hiddenRootsObj)
- to: true].!
Item was added:
+ ----- Method: SpurIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ manager setIsMarkedOf: objOop to: true!
Item was changed:
----- Method: SpurIncrementalSweeper>>cautiousBulkFreeChunkFrom: (in category 'api - incremental') -----
cautiousBulkFreeChunkFrom: objOop
"The old space entity before objOop is necessarily a marked object. Attempts to free as many bytes
from objOop start as possible, looking ahead to free contiguous freechunks / unmarked objects"
| bytes start next currentObj |
self assert: (self canUseAsFreeSpace: objOop).
start := manager startOfObject: objOop.
currentObj := objOop.
bytes := 0.
[bytes := bytes + (manager bytesInBody: currentObj).
(manager isRemembered: currentObj)
ifTrue:
[self assert: (manager isFreeObject: currentObj) not.
scavenger forgetObject: currentObj].
(manager isFreeObject: currentObj)
ifTrue: [ "we need to unlink chunks for concurrent sweeping. In the stop the world sweeper we can just reset the freeLists but here we need to keep them
around so the mutator can still work between sweeping passes"
self flag: #Todo. "we want to optimize for lilliputian chunks!! For now it is ok(ish) but we have to do something about it.
At the moment I see 3 possibilities:
- have the lilliputian list always sorted (O(n) insert in the worst case!!)
- sort the lilliputian part before sweeping (O(n log n) at the start. but everytime before sweeping)
- be cheeky and discard the lilliputian list (problem: the mutator has no access to the list + it can insert unsorted chunks (for the duration of sweeping we could let it use a second list and just append it after sweeping)"
manager detachFreeObject: currentObj.
"self assert: manager totalFreeOldSpace = manager totalFreeListBytes."].
next := manager objectStartingAt: start + bytes.
currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1.
self assert: ((manager oop: next isLessThan: manager endOfMemory)
or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
-
- "we found the end of a segment (old space segments always end in a bridge). Advance to the next"
- "next = currentSegmentsBridge
- ifTrue: [self cCode: 'raise(SIGINT)'.
- self advanceSegment]."
"should the next object not be usable as free space (because it is marked) abort the loop. Attention:
briges at the end of segments are marked and therefore we leave the loop here. This is important as the
newly created free space segment should not be bigger than there still is space left in the current segment"
(self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]]
whileTrue: [currentObj := next].
currentSegmentUnused := currentSegmentUnused + bytes.
^ manager addFreeChunkWithBytes: bytes at: start!
Item was changed:
----- Method: SpurIncrementalSweeper>>nextSweepingEntity (in category 'as yet unclassified') -----
nextSweepingEntity
| nextEntity reservedSegmentsFreeChunk |
nextEntity := manager objectAfter: currentSweepingEntity limit: manager endOfMemory.
reservedSegmentsFreeChunk := self compactorsSegmentToFill ifNotNil: [manager objectStartingAt: self compactorsSegmentToFill segStart].
nextEntity = reservedSegmentsFreeChunk
ifTrue: [ | segmentIndex |
"reset the claim bit!! (would otherwise stay untouched which would trigger errors)
unused does not match here as long used stays 0 which will drop down the complete
calculation to 0"
segmentIndex := manager segmentManager segmentIndexContainingObj: nextEntity.
+ self flag: #Todo. "the occupation gets set two times (here and in advance segment). We should be able
+ to remove this here. Investigate!!"
self
setOccupationAtIndex: segmentIndex
used: 0
unused: 1.
currentSegmentUsed := 0.
currentSegmentUnused := manager bytesInBody: reservedSegmentsFreeChunk.
nextEntity := manager objectAfter: nextEntity limit: manager endOfMemory].
^ nextEntity!
Item was changed:
----- Method: SpurMarker class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
"resolve keys present in both the incremental marker and the all at once mark when incremental GC is selected for generation"
self = SpurMarker ifTrue: [^ self].
SpurMemoryManager wantsIncrementalGC ifFalse: [^ self].
+ self selectorsInOverlappingClasses
+ do: [:selector |
- self selectorsInAllAtOnceMarkerAndIncrementalMarker
- do: [:key |
aCCodeGenerator
+ staticallyResolveMethodNamed: selector
- staticallyResolveMethodNamed: key
forClass: self
+ to: (self staticallyResolvePolymorphicSelector: selector)].
+
- to: (self staticallyResolvePolymorphicSelector: key)]
!
Item was removed:
- ----- Method: SpurMarker class>>selectorsInAllAtOnceMarkerAndIncrementalMarker (in category 'as yet unclassified') -----
- selectorsInAllAtOnceMarkerAndIncrementalMarker
-
- ^ (SpurAllAtOnceMarker selectors intersection: SpurIncrementalMarker selectors)!
Item was added:
+ ----- Method: SpurMarker class>>selectorsInOverlappingClasses (in category 'as yet unclassified') -----
+ selectorsInOverlappingClasses
+
+ ^ SpurAllAtOnceMarker selectors intersection: ((SpurMemoryManager markerClass withAllSuperclasses copyUpTo: SpurMarker) gather: #selectors)!
Item was changed:
----- Method: SpurMarker class>>staticallyResolvePolymorphicSelector: (in category 'nil') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
- staticallyResolvePolymorphicSelector: aSelectorSymbol
+ ^ (self selectorsInOverlappingClasses includes: aSelectorSymbol)
+ ifTrue: [ | classes classesUpToMarker |
+ classesUpToMarker := SpurMemoryManager markerClass withAllSuperclasses copyUpTo: SpurMarker.
+ (classesUpToMarker includes: self)
+ ifTrue: [classes := classesUpToMarker]
+ ifFalse: [classes := (self withAllSuperclasses copyUpTo: SpurMarker)].
+
+ classes
+ detect: [:class | class selectors includes: aSelectorSymbol]
+ ifFound: [:class | self staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: class]
+ ifNone: [self halt]]
- ^ (self selectorsInAllAtOnceMarkerAndIncrementalMarker includes: aSelectorSymbol)
- ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
ifFalse: [aSelectorSymbol]!
Item was added:
+ ----- Method: SpurMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
+ setIsMarkedOf: objOop
+
+ self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
self wantsIncrementalGC
ifTrue: [aCCodeGenerator
recursivelyResolvePolymorpicReceiver: 'gc' toVariants: {SpurIncrementalGarbageCollector. SpurStopTheWorldGarbageCollector} in: self default: SpurIncrementalGarbageCollector;
+ staticallyResolvedPolymorphicReceiver: 'gc' to: self markerClass in: SpurIncrementalGarbageCollector;
+ staticallyResolvedPolymorphicReceiver: 'compactor' to: self compactorClass in: self;
+ staticallyResolvedPolymorphicReceiver: 'marker' to: self markerClass in: self].
- staticallyResolvedPolymorphicReceiver: 'gc' to: SpurIncrementalMarker in: SpurIncrementalGarbageCollector;
- staticallyResolvedPolymorphicReceiver: 'compactor' to: SpurIncrementalSweepAndCompact in: self;
- staticallyResolvedPolymorphicReceiver: 'marker' to: SpurIncrementalMarker in: self].
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
aCCodeGenerator removeVariable: 'memory'. "memory is a simulation time thing only"
self declareCAsOop: #( freeStart scavengeThreshold newSpaceStart pastSpaceStart
oldSpaceStart lowSpaceThreshold freeOldSpaceStart endOfMemory)
in: aCCodeGenerator.
self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']), #(statAllocatedBytes)
in: aCCodeGenerator.
aCCodeGenerator
var: #lastHash type: #usqInt;
var: #freeListsMask type: #usqInt;
var: #freeLists type: #'sqInt *';
var: #objStackInvalidBecause type: #'char *';
var: #unscannedEphemerons type: #SpurContiguousObjStack;
var: #heapGrowthToSizeGCRatio type: #float;
var: #heapSizeAtPreviousGC type: #usqInt;
var: #totalFreeOldSpace type: #usqInt;
var: #maxOldSpaceSize type: #usqInt.
aCCodeGenerator
var: #oldSpaceUsePriorToScavenge type: #sqLong.
aCCodeGenerator
var: #remapBuffer
declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
aCCodeGenerator
var: #extraRoots
declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.
self wantsIncrementalGC
ifTrue: [aCCodeGenerator
staticallyResolvedPolymorphicReceiver: 'manager gc' to: SpurIncrementalGarbageCollector in: SpurSegmentManager;
"the vm needs (from handwritten C code) the method fullGC. Generate it later on"
generate: #fullGC from: #SIGC_fullGC]!
Item was changed:
----- Method: SpurMemoryManager class>>wantsIncrementalGC (in category 'as yet unclassified') -----
wantsIncrementalGC
+ ^ self gcClass includesBehavior: SpurIncrementalGarbageCollector!
- ^ self gcClass = SpurIncrementalGarbageCollector!
Item was changed:
----- Method: SpurMemoryManager>>printFreeSpaceStatistics (in category 'debug printing') -----
printFreeSpaceStatistics
"used for debugging"
<export: true>
<var: 'sizeCount' declareC:'static unsigned long long sizeCount[64] = {0}'>
| sizeCount |
self cCode:'' inSmalltalk:[
sizeCount := CArrayAccessor on: (DoubleWordArray new: 64).
].
coInterpreter cr;
print: '----------------------------------------- '; cr;
print: '----------------------------------------- ';
cr.
0 to: self numSegments -1
+ do: [:index | | segInfo bigFreeChunkMemory freeSpace occupiedSpace objectCount |
- do: [:index | | segInfo bigFreeChunkMemory freeSpace occupiedSpace |
segInfo := self segInfoAt: index.
bigFreeChunkMemory := 0.
freeSpace := 0.
occupiedSpace := 0.
+ objectCount := 0.
segmentManager
allEntitiesInSegment: segInfo
+ exceptTheLastBridgeDo: [:oop | | oopSize slotCount |
+ oopSize := self bytesInBody: oop.
+ slotCount := oopSize >> 3.
- exceptTheLastBridgeDo: [:oop | | oopSize |
- oopSize := self numSlotsOfAny: oop.
(self isFreeOop: oop)
ifTrue: [
"index > 0
ifTrue: [self cCode: 'raise(SIGINT)']."
freeSpace := freeSpace + oopSize.
+ slotCount < 64
- oopSize < 64
ifTrue: [
+ sizeCount at: slotCount put: ((sizeCount at: slotCount) + 1)]
- sizeCount at: oopSize put: ((sizeCount at: oopSize) + 1)]
ifFalse: [sizeCount at: 0 put: ((sizeCount at: 0) + 1).
bigFreeChunkMemory := bigFreeChunkMemory + oopSize]]
+ ifFalse: [objectCount := objectCount + 1.
+ occupiedSpace := occupiedSpace + oopSize]].
- ifFalse: [occupiedSpace := occupiedSpace + oopSize]].
coInterpreter cr;
print: 'Segment ';
printNum: index;
print: ' (starting at: ';
printHex: segInfo segStart; tab;
print: 'max slots: '; tab;
printNum: segInfo segSize >> 3;
print: ')';
cr; cr; flush.
coInterpreter cr;
print: 'Currently occupied space: '; tab;
+ printNum: occupiedSpace; tab;
+ print: 'From '; printNum: objectCount; print: ' objects'; cr;
- printNum: occupiedSpace; cr;
print: 'Currently free space: '; tab;
printNum: freeSpace; cr;
print: 'Resulting in an occupation percentage of: '; tab;
printNum: (occupiedSpace asFloat / (occupiedSpace + freeSpace)) * 100;
cr; cr; flush.
coInterpreter tab;
print: 'big free chunks ';
printNum: (sizeCount at: 0);
print: ' reserving number of slots: ';
printNum: bigFreeChunkMemory;
cr; flush.
sizeCount at: 0 put: 0.
1 to: 63
do: [:i |
(sizeCount at: i) > 0
ifTrue: [coInterpreter tab;
print: 'free chunk of size '; printNum: i; print: ': ';
printNum: (sizeCount at: i);
cr; flush.
sizeCount at: i put: 0.]].
coInterpreter cr;
print: '----------------------------------------- '; cr.].
coInterpreter cr;
print: '----------------------------------------- '; cr;
print: '----------------------------------------- ';
cr.
!
Item was added:
+ ----- Method: SpurMemoryManager>>printSegmentOccupationFromMarkedObjects (in category 'debug printing') -----
+ printSegmentOccupationFromMarkedObjects
+
+ "used for debugging"
+ <export: true>
+
+ coInterpreter cr;
+ print: '----------------------------------------- '; cr;
+ print: '----------------------------------------- ';
+ cr.
+
+ 0 to: self numSegments -1
+ do: [:index | | segInfo occupiedSpace |
+ segInfo := self segInfoAt: index.
+ occupiedSpace := 0.
+
+ segmentManager
+ allEntitiesInSegment: segInfo
+ exceptTheLastBridgeDo: [:oop | | oopSize |
+ oopSize := self bytesInBody: oop.
+
+ (self isFreeOop: oop)
+ ifFalse: [
+ (self isMarked: oop)
+ ifTrue: [occupiedSpace := occupiedSpace + oopSize]]].
+
+ coInterpreter cr;
+ print: 'Segment ';
+ printNum: index;
+ print: ' (starting at: ';
+ printHex: segInfo segStart;
+ print: ')';
+ cr; cr; flush.
+
+ coInterpreter cr;
+ print: 'Currently occupied space: '; tab;
+ printNum: occupiedSpace; tab;
+ print: 'Resulting in an occupation percentage of: '; tab;
+ printNum: (occupiedSpace asFloat / (segInfo segSize)) * 100;
+ cr; cr; flush.
+
+
+ ].
+
+ coInterpreter cr;
+ print: '----------------------------------------- '; cr;
+ print: '----------------------------------------- ';
+ cr.
+ !
Item was changed:
----- Method: SpurMemoryManager>>validObjectColors (in category 'debug support') -----
validObjectColors
| currentSweepingEntityT |
+ currentSweepingEntityT := gc sweepersCurrentSweepingEntity ifNil: [self firstObject].
- currentSweepingEntityT := gc compactor sweeper currentSweepingEntity ifNil: [self firstObject].
self allOldSpaceEntitiesFrom: currentSweepingEntityT do: [:obj |
((self isMarked: obj) and: [(self isPointers: obj) and: [(self isContext: obj) not]])
ifTrue: [| slotCount |
slotCount := self numSlotsOf: obj.
0 to: slotCount - 1
do: [:index | | slot |
slot := self fetchPointer: index ofObject: obj.
((self isNonImmediate: slot) and: [(self isOldObject: slot) and: [(self isForwarded: slot) not]])
ifTrue: [(slot >= currentSweepingEntityT and: [(self isMarked: slot) not])
ifTrue: [self halt.
coInterpreter longPrintOop: (self firstReferenceTo:(self firstReferenceTo: obj)).
self printReferencesTo: (self firstReferenceTo: obj).
self printReferencesTo: obj.
self printRelativePositionOf: obj.
self printRelativePositionOf: slot.
coInterpreter longPrintOop: obj.
coInterpreter longPrintOop: slot.
self cCode: 'raise(SIGINT)'.
^ false]]]]].
^ true!
Item was changed:
----- Method: VMClass class>>staticallyResolvePolymorphicSelector: (in category 'translation') -----
staticallyResolvePolymorphicSelector: aSelectorSymbol
+
+ ^ self staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: self!
- ^((self name select: [:ea| ea isUppercase]), '_', aSelectorSymbol) asSymbol!
Item was added:
+ ----- Method: VMClass class>>staticallyResolvePolymorphicSelector:forClass: (in category 'translation') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: aClass
+
+ ^ ((aClass name select: [:ea| ea isUppercase]), '_', aSelectorSymbol) asSymbol!
Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpur2PhaseIncrementalStack64VM (in category 'configurations') -----
+ generateSqueakSpur2PhaseIncrementalStack64VM
+ "No primitives since we can use those from the Cog VM"
+ ^VMMaker
+ generate: StackInterpreter
+ with: #(ObjectMemory Spur64BitMemoryManager
+ gcClass SpurIncremental2PhaseGarbageCollector
+ FailImbalancedPrimitives false
+ MULTIPLEBYTECODESETS true
+ TempVectReadBarrier true
+ bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
+ to: self sourceTree, '/src/spur64.stack'
+ platformDir: self sourceTree, '/platforms'
+ including: #()!
Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurIncrementalCog64VM (in category 'configurations') -----
+ generateSqueakSpurIncrementalCog64VM
+ "No primitives since we can use those for the Cog VM"
+ ^VMMaker
+ generate: CoInterpreter
+ and: StackToRegisterMappingCogit
+ with: #(ObjectMemory Spur64BitCoMemoryManager
+ MULTIPLEBYTECODESETS true
+ TempVectReadBarrier true
+ bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
+ to: self sourceTree, '/src/spur64.cog'
+ platformDir: self sourceTree, '/platforms'
+ including:#()!
More information about the Vm-dev
mailing list