[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3277.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Dec 6 14:10:48 UTC 2022
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3277.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3277
Author: WoC
Time: 6 December 2022, 3:10:24.535018 pm
UUID: 2d6b5be0-48c6-471a-864c-36dcbc3d3f97
Ancestors: VMMaker.oscog.seperateMarking-WoC.3276
fix various bugs:
- react to moving segments in segments array (important for segmentToFill)
- do not double scavenge in storeImageSegmentInto:outPointers:roots:
- fix heap parsability during compaction
- reset claim bit of segmentToFill
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3276 ===============
Item was changed:
SpurMarker subclass: #SpurAllAtOnceMarker
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+
+ !SpurAllAtOnceMarker commentStamp: 'WoC 12/2/2022 23:36' prior: 0!
+ Marker implementation for the SpurStopTheWorldGarbageCollector. Marks all reachable objects
+
+ Instance Variables
+ !
Item was added:
+ ----- Method: SpurGarbageCollector>>canReactToShiftSegment:to: (in category 'as yet unclassified') -----
+ canReactToShiftSegment: segmentAddress to: anIndex
+ "always decorate shifting elements in the segments array with this method!!"
+
+ self subclassResponsibility!
Item was added:
+ ----- Method: SpurGarbageCollector>>finishGCPassWithoutPreviousScavenge (in category 'as yet unclassified') -----
+ finishGCPassWithoutPreviousScavenge
+ "finish the startet GC pass"
+
+ ^ self subclassResponsibility!
Item was changed:
----- Method: SpurIncrementalCompactor>>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 changed:
----- Method: SpurIncrementalCompactor>>doIncrementalCompact (in category 'incremental compaction') -----
doIncrementalCompact
<inline: #never>
| segInfo |
currentSegment to: manager numSegments - 1 do:
[:i |
segInfo := self addressOf: (manager segmentManager segments at: i).
(self isSegmentBeingCompacted: segInfo)
ifTrue: [currentSegment := i.
coInterpreter cr;
print: 'Compact from: '; printHex: segInfo segStart;
print: ' to: '; printHex: segInfo segStart + segInfo segSize;
print: ' into: ' ; printHex: segmentToFill segStart; tab; flush.
currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i.
self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
self assert: (self oop: currentHeapPointer 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: currentHeapPointer; tab; flush.
self flag: #Todo. "for now we compact one segment at a time"
^ currentSegment = (manager numSegments - 1)
ifTrue: [true]
ifFalse: [false]]].
^ true!
Item was changed:
----- Method: SpurIncrementalCompactor>>freePastSegmentsAndSetSegmentToFill (in category 'api') -----
freePastSegmentsAndSetSegmentToFill
"The first segment being claimed met becomes the segmentToFill. The others are just freed."
| segInfo |
<var: 'segInfo' type: #'SpurSegmentInfo *'>
0 to: manager numSegments - 1 do:
[:i|
segInfo := self addressOf: (manager segmentManager segments at: i).
(self isSegmentBeingCompacted: segInfo)
ifTrue:
[ | freeChunk chunkBytes |
+ 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.
segmentToFill
ifNil: [manager detachFreeObject: freeChunk.
segmentToFill := segInfo]]]!
Item was added:
+ ----- Method: SpurIncrementalCompactor>>occupyRestOfFreeCompactedIntoSegment (in category 'segment access') -----
+ occupyRestOfFreeCompactedIntoSegment
+
+ manager
+ initFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentHeapPointer
+ at: currentHeapPointer.
+
+ "avoid confusing spur, especially for leak checks"
+ manager
+ set: (manager objectStartingAt: currentHeapPointer)
+ classIndexTo: manager wordSizeClassIndexPun
+ formatTo: manager wordIndexableFormat
+
+
+
+
+ !
Item was changed:
----- Method: SpurIncrementalCompactor>>setFreeChunkOfCompactedIntoSegment (in category 'segment access') -----
setFreeChunkOfCompactedIntoSegment
shouldCompact ifFalse: [^ self].
self assert: segmentToFill notNil.
self assert: (self oop: currentHeapPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)).
manager
addFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - currentHeapPointer
at: currentHeapPointer.
"we have compacted into segmentToFill. It is now not empty anymore and we need to look for a new one"
+ segmentToFill := nil
- shouldCompact
- ifTrue: [segmentToFill := nil]
!
Item was added:
+ ----- Method: SpurIncrementalCompactor>>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: SpurIncrementalGarbageCollector>>canReactToShiftSegment:to: (in category 'as yet unclassified') -----
+ canReactToShiftSegment: segmentAddress to: anIndex
+ "because we have a pointer to segmentToFill changes in the segments array (where segmentToFill is pointing to) can
+ invalidate our pointer (it now points to an incorrect segment). Therefore react to this change and set the segmentToFill to
+ the new address"
+
+ segmentAddress = compactor segmentToFill
+ ifTrue: [
+ compactor setSegmentToFillToAddress: (self addressOf: (manager segmentManager segments at: anIndex))]!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
phase = InMarkingPhase
ifTrue: [ | finishedMarking |
marker isCurrentlyMarking
+ ifFalse: [self assert: manager allObjectsUnmarked].
- 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.
coInterpreter cr; print: 'finish marking '; tab; flush.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
checkFreeSpace: GCModeFull.
^ 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.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
compactor assertNoSegmentBeingCompacted.
phase := InCompactingPhase.
^ self]].
phase = InCompactingPhase
ifTrue: [
"self cCode: 'raise(SIGINT)'."
coInterpreter cr; print: 'start compacting '; tab; flush.
compactor incrementalCompact
ifTrue: [
coInterpreter cr; print: 'finish compacting '; tab; flush.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
phase := InMarkingPhase.
^ self]]!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>finishGCPassWithoutPreviousScavenge (in category 'as yet unclassified') -----
+ finishGCPassWithoutPreviousScavenge
+
+ self assert: manager validObjStacks.
+ coInterpreter cr; print: 'finish gc pass without scavenge '; tab; flush.
+
+ coInterpreter setGCMode: GCModeIncremental.
+ phase = InMarkingPhase
+ ifTrue: [
+ "end marking"
+ [phase = InMarkingPhase]
+ whileTrue: [self doIncrementalCollect]].
+
+ "end this collection cycle"
+ [phase ~= InMarkingPhase]
+ whileTrue: [self doIncrementalCollect]!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>markObjectsForEnumerationPrimitives (in category 'as yet unclassified') -----
markObjectsForEnumerationPrimitives
+ "do we need marking complete (and more accurate than incremental marking provides)"
+ ^ true!
- "do we need marking complete (and more accurate than incremental marking provides). For now lets do this only during marking although
- probaly not 100% correct"
- self flag: #Todo. "rework later on"
- ^ phase = InMarkingPhase!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>maybeModifyCopiedObject: (in category 'object creation barriers') -----
maybeModifyCopiedObject: objOop
"1. when marking always mark as we already could have marked all objects pointing to objOop
2. during sweeping mark objects behind the sweepers current position so it does not collect objOop"
(manager isOldObject: objOop)
ifTrue: [
+ marker isCurrentlyMarking
- phase = InMarkingPhase
ifTrue: [
"If the object is not white we would skip it. Therefore make sure it is, as all young space objects
should be"
self assert: (manager isWhite: objOop).
"do not just color it but handle it correctly, depending on which type of object it is and
do things like scanning its class"
marker markAndShouldScan: objOop].
(self inSweepingAheadOfSweepersPosition: objOop)
ifTrue: [manager setIsMarkedOf: objOop to: true]]!
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])
- ((manager isOldObject: objOop) and: [phase = InMarkingPhase])
ifTrue: [manager setIsMarkedOf: objOop to: true]!
Item was changed:
SpurMarker subclass: #SpurIncrementalMarker
instanceVariableNames: 'isCurrentlyMarking'
classVariableNames: 'SlotLimitPerPass'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+
+ !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>>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: [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.
- self assert: (self isFreeObject: currentObj) not.
(manager isForwarded: currentObj)
ifTrue: [currentObj := manager followForwarded: currentObj].
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.
- ifTrue: [
self
markFrom: startIndex
+ nSlots: countThatCanBeVisited
- 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: startIndex + countThatCanBeVisited)
+ onObjStack: manager markStack.
- manager push: (manager integerObjectOf: slotsLeft) 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: [manager setIsMarkedOf: currentObj to: true].
currentObj := manager popObjStack: manager markStack].
"repeat while there still are objects"
currentObj notNil] whileTrue.
^ true!
Item was changed:
----- Method: SpurIncrementalSweeper>>doIncrementalSweeping (in category 'api - incremental') -----
doIncrementalSweeping
"Scan the heap for unmarked objects and free them. Coalescence "
self assert: currentSweepingEntity notNil.
currentsCycleSeenObjectCount := 0.
[self oop: currentSweepingEntity isLessThan: manager endOfMemory] whileTrue:
[ currentSweepingEntity = currentSegmentsBridge
ifTrue: [self advanceSegment]
+ ifFalse: [self sweepFromCurrentSweepingEntity].
- ifFalse: [self sweepCurrentSweepingEntity].
currentSweepingEntity := self nextSweepingEntity.
currentsCycleSeenObjectCount >= MaxObjectsToFree
ifTrue: [^ false]].
manager checkFreeSpace: GCModeIncremental.
^ true!
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
+ setOccupationAtIndex: segmentIndex
+ used: 0
+ unused: 1.
+
- ifTrue: [
currentSegmentUnused := manager bytesInBody: reservedSegmentsFreeChunk.
nextEntity := manager objectAfter: nextEntity limit: manager endOfMemory].
^ nextEntity!
Item was removed:
- ----- Method: SpurIncrementalSweeper>>sweepCurrentSweepingEntity (in category 'api - incremental') -----
- sweepCurrentSweepingEntity
-
- (self canUseAsFreeSpace: currentSweepingEntity)
- ifTrue: [currentSweepingEntity := self cautiousBulkFreeChunkFrom: currentSweepingEntity]
- ifFalse: [self unmarkAndUpdateStats].
- !
Item was added:
+ ----- Method: SpurIncrementalSweeper>>sweepFromCurrentSweepingEntity (in category 'api - incremental') -----
+ sweepFromCurrentSweepingEntity
+
+ (self canUseAsFreeSpace: currentSweepingEntity)
+ ifTrue: [currentSweepingEntity := self cautiousBulkFreeChunkFrom: currentSweepingEntity]
+ ifFalse: [self unmarkAndUpdateStats].
+ !
Item was changed:
CogClass subclass: #SpurMarker
instanceVariableNames: 'manager coInterpreter marking'
classVariableNames: ''
poolDictionaries: 'SpurObjStackConstants VMBasicConstants'
category: 'VMMaker-SpurGarbageCollector'!
+
+ !SpurMarker commentStamp: 'WoC 12/2/2022 23:35' prior: 0!
+ Abstract baseclass for marking algorithms.
+
+ Instance Variables
+ coInterpreter: <StackInterpreter|CoInterpreter (StackInterpreterSimulator|CogVMSimulator)>
+ manager: <SpurMemoryManage>
+ marking: <aBoolean>
+
+ coInterpreter
+ - xxxxx
+
+ manager
+ - xxxxx
+
+ marking
+ - xxxxx
+ !
Item was changed:
----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
allObjects
"Attempt to answer an array of all objects, excluding those that may
be garbage collected as a side effect of allocating the result array.
If no memory is available answer the number of objects as a SmallInteger.
Since objects are at least 16 bytes big, and the largest SmallInteger covers
1/4 of the address space, the count can never overflow."
| freeChunk ptr start limit count bytes |
gc markObjectsForEnumerationPrimitives ifTrue:
+ [gc finishGCPass.
+ self assert: self allObjectsUnmarked.
+ gc markObjectsCompletely]. "may not want to revive objects unnecessarily; but marking is sloooow."
- [gc markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
ptr := start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
count := 0.
self allHeapEntitiesDo:
[:obj| "continue enumerating even if no room so as to unmark all objects."
(gc markObjectsForEnumerationPrimitives
ifTrue: [self isMarked: obj]
ifFalse: [true]) ifTrue:
[(self isNormalObject: obj)
ifTrue:
[gc markObjectsForEnumerationPrimitives ifTrue:
[self setIsMarkedOf: obj to: false].
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: obj.
ptr := ptr + self bytesPerOop]]
ifFalse:
[gc markObjectsForEnumerationPrimitives ifTrue:
[(self isSegmentBridge: obj) ifFalse:
[self setIsMarkedOf: obj to: false]]]]].
self assert: (self isEmptyObjStack: markStack).
gc 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.
gc maybeModifyGCFlagsOf: freeChunk.
self possibleRootStoreInto: freeChunk.
+ coInterpreter cr; print: 'allObjects in: '; printHex: freeChunk; tab; flush.
+ self assert: self allObjectsUnmarked.
self checkFreeSpace: GCModeFull.
self runLeakCheckerFor: GCModeFull.
^freeChunk!
Item was changed:
----- Method: SpurMemoryManager>>allObjectsUnmarked (in category 'gc - global') -----
allObjectsUnmarked
self allObjectsDo:
+ [:o| (self isMarked: o) ifTrue: [bogon := o. self cCode: 'raise(SIGINT)'. ^false]].
- [:o| (self isMarked: o) ifTrue: [bogon := o. ^false]].
^true!
Item was added:
+ ----- Method: SpurMemoryManager>>allOldObjectsUnmarkedSmallerThan: (in category 'gc - global') -----
+ allOldObjectsUnmarkedSmallerThan: objOop
+
+ self allOldSpaceObjectsDo:
+ [:o| (self isMarked: o) ifTrue: [bogon := o. self cCode: 'raise(SIGINT)'. ^false].
+ o = objOop ifTrue: [^ true]].
+ ^true!
Item was changed:
----- Method: SpurMemoryManager>>markObjectsIn: (in category 'image segment in/out') -----
markObjectsIn: arrayOfRoots
"This is part of storeImageSegmentInto:outPointers:roots:."
+ self assert: (self isForwarded: arrayOfRoots) not.
self uncheckedSetIsMarkedOf: arrayOfRoots to: true.
+
0 to: (self numSlotsOf: arrayOfRoots) - 1 do:
[:i| | oop |
oop := self followField: i ofObject: arrayOfRoots.
(self isNonImmediate: oop) ifTrue:
[self uncheckedSetIsMarkedOf: oop to: true]]!
Item was changed:
----- Method: SpurMemoryManager>>numSlotsOf: (in category 'object access') -----
numSlotsOf: objOop
<returnTypeC: #usqInt>
<api>
| numSlots |
self flag: #endianness.
"numSlotsOf: should not be applied to free or forwarded objects."
self assert: (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun.
+ (self classIndexOf: objOop) > self isForwardedObjectClassIndexPun
+ ifFalse: [self cCode: 'raise(SIGINT)'].
numSlots := self rawNumSlotsOf: objOop.
^numSlots = self numSlotsMask "overflow slots; (2^32)-1 slots are plenty"
ifTrue: [self rawOverflowSlotsOf: objOop]
ifFalse: [numSlots]!
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 roots |
- | 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."
+ gc finishGCPassWithoutPreviousScavenge.
+ roots := self followMaybeForwarded: arrayOfRoots.
self assert: self allObjectsUnmarked.
+ self markObjectsIn: roots.
- self markObjectsIn: arrayOfRoots.
gc markObjectsCompletely.
"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: 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 roots; order is important."
+ self noCheckPush: roots onObjStack: markStack.
- "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.
gc maybeModifyGCFlagsOf: freeChunk.
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 changed:
----- Method: SpurMemoryManager>>validObjStacks (in category 'obj stacks') -----
validObjStacks
^(markStack = nilObj or: [self isValidObjStack: markStack])
and: [(weaklingStack = nilObj or: [self isValidObjStack: weaklingStack])
+ and: [mournQueue = nilObj or: [self isValidObjStack: mournQueue]]]!
- and: [(mournQueue = nilObj or: [self isValidObjStack: mournQueue])
- and: [ephemeronStack = nilObj or: [self isValidObjStack: ephemeronStack]]]]!
Item was changed:
----- Method: SpurSegmentManager class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
isNonArgumentImplicitReceiverVariableName: instVarName
+ ^instVarName = 'manager' or: [instVarName = 'coInterpreter']!
- ^instVarName = 'manager'!
Item was changed:
----- Method: SpurSegmentManager>>insertSegmentFor: (in category 'growing/shrinking memory') -----
insertSegmentFor: segAddress
"Reserve a new segInfo for segAddress. If segAddress
is in the middle of the existing segments, shuffle them
up to make room. Answer the new segment's index."
| segIndex lastSegIndex |
+ manager coInterpreter cr; print: 'insert segment '; tab; flush.
self assert: segAddress >= (segments at: 0) segLimit.
numSegments = numSegInfos ifTrue:
[self allocateOrExtendSegmentInfos].
self assert: numSegments < numSegInfos.
segIndex := lastSegIndex := numSegments - 1.
numSegments := numSegments + 1.
[segAddress >= (segments at: segIndex) segLimit ifTrue:
[segIndex := segIndex + 1.
lastSegIndex to: segIndex by: -1 do:
+ [:idx|
+ manager gc canReactToShiftSegment: (self addressOf: (segments at: idx)) to: idx + 1.
+ segments at: idx + 1 put: (segments at: idx)].
- [:idx| segments at: idx + 1 put: (segments at: idx)].
^segIndex].
segIndex := segIndex - 1]
repeat!
Item was changed:
----- Method: SpurSegmentManager>>removeSegment: (in category 'growing/shrinking memory') -----
removeSegment: emptySeg
<var: #emptySeg type: #'SpurSegmentInfo *'>
| i |
i := self indexOfSegment: emptySeg.
self assert: i > 0.
totalHeapSizeIncludingBridges := totalHeapSizeIncludingBridges - emptySeg segSize.
manager sqDeallocateMemorySegmentAt: emptySeg segStart asVoidPointer OfSize: emptySeg segSize.
+ manager coInterpreter cr; print: 'remove segment '; tab; flush.
-
i to: numSegments - 2 do:
+ [:j|
+ manager gc canReactToShiftSegment: (self addressOf: (segments at: j + 1)) to: j.
+ segments at: j put: (segments at: j + 1)].
- [:j| segments at: j put: (segments at: j + 1)].
self cCode: [] inSmalltalk: [segments at: numSegments - 1 put: SpurSegmentInfo new].
numSegments := numSegments - 1.
self bridgeFrom: (self addressOf: (segments at: i - 1))
to: (i <= (numSegments - 1) ifTrue: [self addressOf: (segments at: i)]).
manager setLastSegment: (self addressOf: (segments at: numSegments - 1))!
Item was changed:
----- Method: SpurSegmentManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') -----
shrinkObjectMemory: delta
"Answer if any shrinkage was achieved."
<inline: false>
<var: #delta type: #usqInt>
| shrinkage emptySeg |
<var: #shrinkage type: #usqInt>
<var: #emptySeg type: #'SpurSegmentInfo *'>
manager checkFreeSpace: GCCheckFreeSpace.
shrinkage := delta.
[emptySeg := self findEmptySegNearestInSizeTo: shrinkage.
(emptySeg isNil
or: [emptySeg segSize > shrinkage]) ifTrue:
[manager checkFreeSpace: GCCheckFreeSpace.
^shrinkage < delta].
shrinkage := shrinkage - emptySeg segSize.
manager detachFreeObject: (manager objectStartingAt: emptySeg segStart).
+ manager coInterpreter cr;
+ print: 'remove segment starting: ';
+ printHex: emptySeg segStart;
+ print: ' to: ';
+ printHex: emptySeg segStart + emptySeg segSize; tab; flush.
+
+ manager segmentToFill
+ ifNil: [manager coInterpreter cr;
+ print: 'segment to fill null '; tab; flush.]
+ ifNotNil: [manager coInterpreter cr;
+ print: 'segment to fill: ';
+ printHex: manager segmentToFill segStart;
+ print: ' to: ';
+ printHex: manager segmentToFill segStart + manager segmentToFill segSize; tab; flush.].
self removeSegment: emptySeg] repeat!
Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>canReactToShiftSegment:to: (in category 'as yet unclassified') -----
+ canReactToShiftSegment: segmentAddress to: anIndex
+
+ <doNotGenerate>!
Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>finishGCPassWithoutPreviousScavenge (in category 'as yet unclassified') -----
+ finishGCPassWithoutPreviousScavenge
+
+ "nop in stop the world as we always finish our gc all at once"!
Item was changed:
----- Method: StackInterpreter>>fireEphemeron: (in category 'finalization') -----
fireEphemeron: ephemeron
<option: #SpurObjectMemory>
- self cCode: 'raise(SIGINT)'.
objectMemory
queueMourner: ephemeron;
setFormatOf: ephemeron to: objectMemory nonIndexablePointerFormat.
self signalFinalization: ephemeron!
More information about the Vm-dev
mailing list