[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3255.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Aug 28 15:33:18 UTC 2022
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3255.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3255
Author: WoC
Time: 28 August 2022, 5:32:49.869998 pm
UUID: 9fe52120-7f24-42ff-b618-3e9ffa920a42
Ancestors: VMMaker.oscog.seperateMarking-WoC.3254
can open a stack vm for a short time now
- more asserts
- fixed issues with compacting (forwarders and reserved memory management)
- resetting for incremental collector parts
- provisionally implementation of fullGC (based on incremental components -> should be changed if possible)
- minor refactorings in sweeper
- allocate black array created in allInstancesOf
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3254 ===============
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. Try and
allocate in a segment that already includes pinned objects. The header of the
result will have been filled-in but not the contents."
<var: #totalBytes type: #usqInt>
<inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes
suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned].
chunk ifNil:
[chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
chunk ifNil:
[^nil].
(segmentManager segmentContainingObj: chunk) containsPinned: true].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: chunk put: numSlots.
self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
self long64At: chunk + self baseHeaderSize
put: ((self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)
bitOr: 1 << self pinnedBitShift).
self flag: #Todo. "later on we probably want to do this in the call above"
+ gc maybeModifyGCFlagsOf: chunk + self baseHeaderSize.
- gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace.
^chunk + self baseHeaderSize].
self long64At: chunk
put: ((self headerForSlots: numSlots format: formatField classIndex: classIndex)
bitOr: 1 << self pinnedBitShift).
self flag: #Todo. "later on we probably want to do this in the call above"
gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace.
^chunk!
Item was changed:
----- Method: Spur32BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. The header
will have been filled-in but not the contents. If no memory is available answer nil."
<var: #totalBytes type: #usqInt>
<inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
chunk ifNil:
[^nil].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self flag: #endianness.
self longAt: chunk put: numSlots.
self longAt: chunk + 4 put: self numSlotsMask << self numSlotsHalfShift.
self long64At: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
self flag: #Todo. "later on we probably want to do this in the call above"
+ gc maybeModifyGCFlagsOf: chunk + self baseHeaderSize.
- gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace.
^chunk + self baseHeaderSize].
self long64At: chunk put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
self flag: #Todo. "later on we probably want to do this in the call above"
gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace.
^chunk!
Item was changed:
----- Method: Spur32BitMemoryManager>>setIsGreyOf:to: (in category 'header access') -----
setIsGreyOf: objOop to: aBoolean
+
+ gc assertSettingGCFlagsIsOk: objOop.
+
self flag: #endianness.
self longAt: objOop
put: (aBoolean
ifTrue: [(self longAt: objOop) bitOr: 1 << self greyBitShift]
ifFalse: [(self longAt: objOop) bitAnd: (1 << self greyBitShift) bitInvert32])!
Item was changed:
----- Method: Spur32BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') -----
setIsMarkedOf: objOop to: aBoolean
self assert: (self isFreeObject: objOop) not.
+ gc assertSettingGCFlagsIsOk: objOop.
+
self flag: #endianness.
self longAt: objOop + 4
put: (aBoolean
ifTrue: [(self longAt: objOop + 4) bitOr: 1 << self markedBitHalfShift]
ifFalse: [(self longAt: objOop + 4) bitAnd: (1 << self markedBitHalfShift) bitInvert32])!
Item was changed:
----- Method: Spur64BitMMLESimulator>>longAt:put: (in category 'memory access') -----
longAt: byteAddress put: a64BitValue
"Store the 64-bit value at byteAddress which must be 0 mod 8."
+ "(self statScavenges >= 120 and: [byteAddress = 16rC7F770]) ifTrue: [self halt]."
+ "(self statScavenges >= 320 and: [byteAddress = 16r30DF6D0]) ifTrue: [self halt]."
+ "(self statScavenges >= 320 and: [a64BitValue = 16r30DF6D0]) ifTrue: [self halt]."
+ "byteAddress = 16r4A00408 ifTrue: [self halt].
+ a64BitValue = 16r5A00408 ifTrue: [self halt]."
- "byteAddress = 16r43C790 ifTrue: [self halt]."
^self long64At: byteAddress put: a64BitValue!
Item was changed:
----- Method: Spur64BitMMLESimulator>>scavengingGCTenuringIf: (in category 'gc - global') -----
scavengingGCTenuringIf: tenuringCriterion
"If we're /not/ a clone, clone the VM and push it over the cliff.
If it survives, destroy the clone and continue. We should be OK until next time."
+ self setCheckForLeaks: GCModeFull.
(self leakCheckNewSpaceGC
and: [parent isNil]) ifTrue:
[coInterpreter cr; print: 'scavenge '; print: statScavenges; tab; flush.
CloneOnScavenge ifTrue:
[coInterpreter cloneSimulation objectMemory scavengingGCTenuringIf: tenuringCriterion.
Smalltalk garbageCollect]].
^super scavengingGCTenuringIf: tenuringCriterion!
Item was changed:
----- Method: Spur64BitMemoryManager>>allocateSlotsForPinningInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsForPinningInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. Try and
allocate in a segment that already includes pinned objects. The header of the
result will have been filled-in but not the contents."
<var: #totalBytes type: #usqInt>
<inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes
suchThat: [:f| (segmentManager segmentContainingObj: f) containsPinned].
chunk ifNil:
[chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
chunk ifNil:
[^nil].
(segmentManager segmentContainingObj: chunk) containsPinned: true].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self longAt: chunk
put: numSlots + (self numSlotsMask << self numSlotsFullShift).
self longAt: chunk + self baseHeaderSize
put: ((self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)
bitOr: 1 << self pinnedBitShift).
self flag: #Todo. "later on we probably want to do this in the call above"
+ gc maybeModifyGCFlagsOf: chunk + self baseHeaderSize.
- gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace.
^chunk + self baseHeaderSize].
self longAt: chunk
put: ((self headerForSlots: numSlots format: formatField classIndex: classIndex)
bitOr: 1 << self pinnedBitShift).
self flag: #Todo. "later on we probably want to do this in the call above"
gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace.
^chunk!
Item was changed:
----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. The header
will have been filled-in but not the contents. If no memory is available answer nil."
<var: #totalBytes type: #usqInt>
<inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
chunk ifNil:
[^nil].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self longAt: chunk
put: numSlots + (self numSlotsMask << self numSlotsFullShift).
self longAt: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
self flag: #Todo. "later on we probably want to do this in the call above"
+ gc maybeModifyGCFlagsOf: chunk + self baseHeaderSize.
- gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace ignoring: chunk + self baseHeaderSize.
^chunk + self baseHeaderSize].
self longAt: chunk
put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
self flag: #Todo. "later on we probably want to do this in the call above"
gc maybeModifyGCFlagsOf: chunk.
self checkFreeSpace: GCModeNewSpace ignoring: chunk.
^chunk!
Item was changed:
----- Method: Spur64BitMemoryManager>>setIsGreyOf:to: (in category 'header access') -----
setIsGreyOf: objOop to: aBoolean
+
+ gc assertSettingGCFlagsIsOk: objOop.
+
self longAt: objOop
put: (aBoolean
ifTrue: [(self longAt: objOop) bitOr: 1 << self greyBitShift]
ifFalse: [(self longAt: objOop) bitAnd: (1 << self greyBitShift) bitInvert64])!
Item was changed:
----- Method: Spur64BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') -----
setIsMarkedOf: objOop to: aBoolean
self assert: (self isFreeObject: objOop) not.
+ gc assertSettingGCFlagsIsOk: objOop.
self longAt: objOop
put: (aBoolean
ifTrue: [(self longAt: objOop) bitOr: 1 << self markedBitFullShift]
ifFalse: [(self longAt: objOop) bitAnd: (1 << self markedBitFullShift) bitInvert64])!
Item was added:
+ ----- Method: SpurGarbageCollector>>allocatorMarkBitToSet (in category 'as yet unclassified') -----
+ allocatorMarkBitToSet
+
+ ^ allocatorMarkBitToSet!
Item was changed:
----- Method: SpurGarbageCollector>>allocatorShouldAllocateBlack (in category 'accessing') -----
allocatorShouldAllocateBlack
+ <cmacro: '() GIV(allocatorShouldAllocateBlack)'>
- <inline: true>
^ allocatorShouldAllocateBlack!
Item was added:
+ ----- Method: SpurGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
+ assertSettingGCFlagsIsOk: objOop
+
+ <doNotGenerate>!
Item was added:
+ ----- Method: SpurGarbageCollector>>doScavengeWithoutIncrementalCollect: (in category 'scavenge') -----
+ doScavengeWithoutIncrementalCollect: tenuringCriterion
+ "The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
+ <inline: false>
+ manager doAllocationAccountingForScavenge.
+ manager gcPhaseInProgress: ScavengeInProgress.
+ manager pastSpaceStart: (scavenger scavenge: tenuringCriterion).
+ self assert: (self
+ oop: manager pastSpaceStart
+ isGreaterThanOrEqualTo: scavenger pastSpace start
+ andLessThanOrEqualTo: scavenger pastSpace limit).
+ manager freeStart: scavenger eden start.
+ manager gcPhaseInProgress: 0.
+ manager resetAllocationAccountingAfterGC.!
Item was changed:
+ ----- Method: SpurGarbageCollector>>initialize (in category 'nil') -----
- ----- Method: SpurGarbageCollector>>initialize (in category 'initialize-release') -----
initialize
allocatorShouldAllocateBlack := false!
Item was changed:
----- Method: SpurGenerationScavengerSimulator>>scavenge: (in category 'scavenger') -----
scavenge: tenuringCriterion
manager bootstrapping ifFalse:
+ [coInterpreter transcript nextPutAll: 'scavenging('; print: manager statScavenges; nextPutAll: ')...'; cr; flush.
- [coInterpreter transcript nextPutAll: 'scavenging('; print: manager statScavenges; nextPutAll: ')...'; flush.
cameFrom ifNotNil:
[cameFrom := Dictionary new]].
^super scavenge: tenuringCriterion!
Item was changed:
----- Method: SpurIncrementalCompactor>>assertNoSegmentBeingCompacted (in category 'testing') -----
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"
- "Assertion only - no segment is being claimed at this point"
| segInfo |
<var: 'segInfo' type: #'SpurSegmentInfo *'>
0 to: manager numSegments - 1 do:
[:i|
segInfo := self addressOf: (manager segmentManager segments at: i).
self deny: (self isSegmentBeingCompacted: segInfo)].!
Item was changed:
----- Method: SpurIncrementalCompactor>>compactSegment:freeStart:segIndex: (in category 'incremental compaction') -----
compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
<var: 'segInfo' type: #'SpurSegmentInfo *'>
| currentEntity fillStart bytesToCopy bridge copy |
fillStart := initialFreeStart.
bridge := manager segmentManager bridgeFor: segInfo.
currentEntity := manager objectStartingAt: segInfo segStart.
self deny: segIndex = 0. "Cannot compact seg 0"
[self oop: currentEntity isLessThan: bridge] whileTrue:
[(manager isFreeObject: currentEntity)
ifTrue:
[manager detachFreeObject: currentEntity.
"To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
manager set: currentEntity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
ifFalse:
+ ["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: currentEntity) not
+ ifTrue: ["Copy the object in segmentToFill and replace it by a forwarder."
+ self assert: (manager isPinned: currentEntity) not.
+ bytesToCopy := manager bytesInBody: currentEntity.
+
+ manager memcpy: fillStart asVoidPointer _: (manager startOfObject: currentEntity) asVoidPointer _: bytesToCopy.
+
+ copy := manager objectStartingAt: fillStart.
+ (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: currentEntity to: (manager objectStartingAt: fillStart).
+
+ fillStart := fillStart + bytesToCopy.
+ self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]].
+
- ["Copy the object in segmentToFill and replace it by a forwarder."
- self assert: (manager isPinned: currentEntity) not.
- bytesToCopy := manager bytesInBody: currentEntity.
- manager memcpy: fillStart asVoidPointer _: (manager startOfObject: currentEntity) asVoidPointer _: bytesToCopy.
-
- copy := manager objectStartingAt: fillStart.
- (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: currentEntity to: (manager objectStartingAt: fillStart).
- fillStart := fillStart + bytesToCopy.
- self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))].
currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
self assert: currentEntity = bridge.
+ currentSegment := currentSegment + 1.
- segmentToFill := segmentToFill + 1.
^ fillStart!
Item was added:
+ ----- Method: SpurIncrementalCompactor>>completeCompact (in category 'as yet unclassified') -----
+ completeCompact
+
+ | segInfo |
+ 0 to: manager numSegments - 1 do:
+ [:i |
+ segInfo := self addressOf: (manager segmentManager segments at: i).
+ (self isSegmentBeingCompacted: segInfo)
+ ifTrue: [currentSegment := i.
+ currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i]]!
Item was changed:
----- Method: SpurIncrementalCompactor>>doIncrementalCompact (in category 'incremental compaction') -----
doIncrementalCompact
| segInfo |
currentSegment to: manager numSegments - 1 do:
[:i |
segInfo := self addressOf: (manager segmentManager segments at: i).
(self isSegmentBeingCompacted: segInfo)
ifTrue: [currentSegment := i.
currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i.
+ self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
self flag: #Todo. "for now we compact on segment at a time"
+ ^ currentSegment = (manager numSegments - 1)
- ^ currentSegment = manager numSegments - 1
ifTrue: [true]
ifFalse: [false]]].
^ true!
Item was changed:
----- Method: SpurIncrementalCompactor>>findAndSetSegmentToFill (in category 'segment to fill') -----
findAndSetSegmentToFill
| segInfo |
<var: 'segInfo' type: #'SpurSegmentInfo *'>
0 to: manager numSegments - 1 do:
[:i|
segInfo := self addressOf: (manager segmentManager segments at: i).
(self segmentIsEmpty: segInfo)
ifTrue: [segmentToFill := segInfo. ^i]].
^-1!
Item was changed:
----- Method: SpurIncrementalCompactor>>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. "
- self findAndSetSegmentToFill.
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!
- self assert: segmentToFill ~~ nil.!
Item was changed:
----- Method: SpurIncrementalCompactor>>finishCompaction (in category 'incremental compaction') -----
finishCompaction
self setFreeChunkOfCompactedIntoSegment.
+ self postCompactionAction.
+ self resetCompactor!
- self postCompactionAction!
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 *'>
segmentToFill := nil.
0 to: manager numSegments - 1 do:
[:i|
segInfo := self addressOf: (manager segmentManager segments at: i).
(self isSegmentBeingCompacted: segInfo)
ifTrue:
+ [ | freeChunk chunkBytes |
+ chunkBytes := segInfo segSize - manager bridgeSize.
+ freeChunk := manager
+ addFreeChunkWithBytes: chunkBytes
- [manager
- initFreeChunkWithBytes: segInfo segSize - manager bridgeSize
at: segInfo segStart.
+ segmentToFill
+ ifNil: [manager detachFreeObject: freeChunk.
+ segmentToFill := segInfo]]]!
- segmentToFill ifNil: [segmentToFill := segInfo]]]!
Item was changed:
----- Method: SpurIncrementalCompactor>>incrementalCompact (in category 'api') -----
incrementalCompact
self initializeCompactionIfNecessary.
+ shouldCompact
- self doIncrementalCompact
ifTrue: [
+ self doIncrementalCompact
+ ifTrue: [
+ self finishCompaction.
+ ^ true]]
+ ifFalse: [^ true "nothing to compact => we are finished"].
- self finishCompaction.
- ^ true].
^ false!
Item was changed:
----- Method: SpurIncrementalCompactor>>initializeCompactionIfNecessary (in category 'incremental compaction') -----
initializeCompactionIfNecessary
isCompacting
ifFalse: [self assertNoSegmentBeingCompacted.
self planCompactionAndReserveSpace.
+ self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
+
shouldCompact ifTrue: [currentHeapPointer := segmentToFill segStart]].
+ isCompacting := true.
+
+ self assert: currentSegment notNil
- isCompacting := true
!
Item was changed:
----- Method: SpurIncrementalCompactor>>planCompactionAndReserveSpace (in category 'compaction planning') -----
planCompactionAndReserveSpace
+ shouldCompact := self computeSegmentsToCompact
- shouldCompact := self computeSegmentsToCompact.
- shouldCompact
- ifTrue: [self reserveSegmentToFill]
!
Item was changed:
----- Method: SpurIncrementalCompactor>>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.
- self assert: (self segmentIsEmpty: freeChunk).
-
manager detachFreeObject: freeChunk!
Item was added:
+ ----- Method: SpurIncrementalCompactor>>resetCompactor (in category 'as yet unclassified') -----
+ resetCompactor
+
+ isCompacting := false.
+ shouldCompact := nil.
+ currentHeapPointer := nil.
+ currentSegment := 0!
Item was added:
+ ----- Method: SpurIncrementalCompactor>>segmentToFill (in category 'as yet unclassified') -----
+ segmentToFill
+
+ ^ segmentToFill!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
+ assertSettingGCFlagsIsOk: objOop
+
+ "do not color young objects. They have an extra state we do not want to change"
+ self assert: (manager isOldObject: objOop).
+
+ "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: [objOop >= self compactor currentSweepingEntity])!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
phase = InMarkingPhase
ifTrue: [
marker incrementalMarkObjects
ifTrue: [
+ manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
- "manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)]."
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
We only know if they should get swept after the next marking -> keep them alive for this cycle"
self allocatorShouldAllocateBlack: true.
phase := InSweepingPhase.
"marking is done and thus all forwarding references are resolved -> we can use the now free segments that were
compacted during the last cycle"
compactor freePastSegmentsAndSetSegmentToFill.
^ self]
ifFalse: [manager runLeakCheckerFor: GCModeIncremental]].
phase = InSweepingPhase
ifTrue: [
compactor incrementalSweep
ifTrue: [
self allocatorShouldAllocateBlack: false.
manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
"self assert: manager allObjectsUnmarked."
phase := InCompactingPhase.
^ self]].
phase = InCompactingPhase
ifTrue: [
compactor incrementalCompact
ifTrue: [phase := InMarkingPhase.
^ self]]!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>fullGC (in category 'global') -----
fullGC
"We need to be able to make a full GC, e.g. when we save the image. Use the made progress and finish the collection"
+ self assert: manager validObjStacks.
- self assert: self validObjStacks.
+ "we are not sweeping anymore => reset it"
+ allocatorShouldAllocateBlack := false.
+ compactor resetComponents.
+ manager shutDownGlobalIncrementalGC: true.
+
coInterpreter setGCMode: GCModeNewSpace.
+ self doScavengeWithoutIncrementalCollect: MarkOnTenure.
- self doScavenge: MarkOnTenure.
coInterpreter setGCMode: GCModeIncremental.
marker completeMarkObjects.
+ compactor sweepAndCompact.
- compactor compact.
"we do not need to make a complete mark, we just need to resolve and delete forwarders"
+ "marker resolveAllForwarders"
+ "lets be lazy here as this won't be the final implementation"
+ marker completeMarkObjects.
+
+ manager setHeapSizeAtPreviousGC!
- marker resolveAllForwarders!
Item was changed:
+ ----- Method: SpurIncrementalGarbageCollector>>incrementalCollect (in category 'global') -----
- ----- Method: SpurIncrementalGarbageCollector>>incrementalCollect (in category 'as yet unclassified') -----
incrementalCollect
+ self flag: #Todo. "where to put this?"
+ manager statScavenges = 0 ifTrue: [manager makeAllObjectsWhite.].
self doIncrementalCollect.
self assert: manager validObjStacks.!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>maybeModifyGCFlagsOf: (in category 'as yet unclassified') -----
maybeModifyGCFlagsOf: objOop
<inline: true>
+ ((manager isOldObject: objOop) and: [allocatorShouldAllocateBlack and: [objOop >= compactor currentSweepingEntity]])
- ((manager isOldObject: objOop) and: [allocatorShouldAllocateBlack and: [objOop < compactor currentSweepingEntity]])
ifTrue: [manager setIsMarkedOf: objOop to: true]!
Item was added:
+ ----- Method: SpurIncrementalGarbageCollectorSimulator>>doIncrementalCollect (in category 'as yet unclassified') -----
+ doIncrementalCollect
+
+ | context |
+ manager statScavenges \\ 50 = 0 ifTrue: [GCEventLog reset].
+ "(manager statScavenges > 218 and: [phase = InSweepingPhase]) ifTrue: [self halt]."
+ "manager statScavenges = 320 ifTrue: [self halt]."
+
+ "pop mutator context"
+ context := GCEventLog instance popContext.
+ self assert: context kind = #mutator.
+ super doIncrementalCollect.
+ GCEventLog instance pushMutatorContext!
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: [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 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: [
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) 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: [currentObj := manager popObjStack: manager markStack.].
"repeat while there still are objects"
currentObj notNil] whileTrue.
^ true!
Item was changed:
----- Method: SpurIncrementalMarker>>pushHiddenRootsReferencesOnMarkingStack (in category 'root-scanning') -----
pushHiddenRootsReferencesOnMarkingStack
| classTablePageSize |
self markAndTraceObjStack: manager markStack andContents: false.
self markAndTraceObjStack: manager weaklingStack andContents: false.
self markAndTraceObjStack: manager mournQueue andContents: true.
+ self markAndTraceObjStack: manager ephemeronStack andContents: false.
- self markAndTraceObjStack: manager ephemeronStack andContents: true.
classTablePageSize := manager numStrongSlotsOfInephemeral: manager classTableFirstPage.
self markNSlots: classTablePageSize of: manager classTableFirstPage.
self blackenObject: manager classTableFirstPage!
Item was changed:
----- Method: SpurIncrementalMarker>>pushNewSpaceReferencesOnMarkingStack (in category 'root-scanning') -----
pushNewSpaceReferencesOnMarkingStack
manager allNewSpaceObjectsDo: [:objOop | | format |
- self flag: #Todo. "ephermorons"
format := manager formatOf: objOop.
+ ((manager isNonImmediate: objOop) and: [(manager isPureBitsFormat: format) not])
- ((manager isNonImmediate: objOop) and: [(manager isPureBitsFormat: format) not and: [(manager isWeakFormat: format) not]])
ifTrue: [ | slotNumber |
slotNumber := manager numStrongSlotsOfInephemeral: objOop.
0 to: slotNumber - 1
do: [ :slotIndex | | slot |
slot := manager fetchPointer: slotIndex ofObject: objOop.
+ (self shoudlBeOnMarkingStack: slot)
+ ifTrue: [self markAndShouldScan: slot]]]]
- (self shoudlBeOnMarkingStack: objOop)
- ifTrue: [self markAndShouldScan: objOop]]]]
!
Item was changed:
----- Method: SpurIncrementalMarker>>resetMarkProgress (in category 'marking - global') -----
resetMarkProgress
- manager shutDownGlobalIncrementalGC: true.
-
isCurrentlyMarking := false.
marking := false.
manager emptyObjStack: manager markStack.
manager emptyObjStack: manager weaklingStack.
manager emptyObjStack: manager ephemeronStack!
Item was changed:
----- Method: SpurIncrementalMarker>>shoudlBeOnMarkingStack: (in category 'marking-stack') -----
shoudlBeOnMarkingStack: objOop
<inline: true>
self flag: #Todo. "should be not immediate and no bit array"
+ ^ (manager isNonImmediate: objOop) and: [(manager isOldObject: objOop) and: [manager isWhite: objOop]]!
- ^ (manager isOldObject: objOop) and: [manager isWhite: objOop]!
Item was changed:
----- Method: SpurIncrementalMarker>>writeBarrierFor:at:with: (in category 'barrier') -----
writeBarrierFor: anObject at: index with: value
"a dijkstra style write barrier with the addition of the generation check
objects that are not able to contain pointers are ignored too, as the write barries
should ensure we lose no references and this objects do not hold any of them"
<inline: true>
self flag: #Todo. "we probably want the oldObject check to be the first one as it is only a pointer comparison and no dereferencing is needed"
+ (self marking and: [(self isLeafInObjectGraph: anObject) not and: [(self isLeafInObjectGraph: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]]])
- (self marking and: [(self isLeafInObjectGraph: anObject) not and: [(manager isOldObject: anObject) and: [manager isMarked: anObject]]])
ifTrue: [self pushOnMarkingStackAndMakeGreyIfNecessary: value]!
Item was added:
+ ----- Method: SpurIncrementalMarkerSimulation>>pushOnMarkingStackAndMakeGrey: (in category 'marking-stack') -----
+ pushOnMarkingStackAndMakeGrey: obj
+
+ super pushOnMarkingStackAndMakeGrey: obj
+ !
Item was changed:
+ ----- Method: SpurIncrementalMarkerSimulation>>writeBarrierFor:at:with: (in category 'barrier') -----
- ----- Method: SpurIncrementalMarkerSimulation>>writeBarrierFor:at:with: (in category 'as yet unclassified') -----
writeBarrierFor: anObject at: index with: value
GCEventLog
+ contextToKeepOnEvent: #writeBarrier
- inContext: #writeBarrier
do: [super writeBarrierFor: anObject at: index with: value]
!
Item was changed:
----- Method: SpurIncrementalSweepAndCompact>>compact (in category 'api - global') -----
compact
<doNotGenerate>
+ compactor completeCompact!
- compactor compact!
Item was added:
+ ----- Method: SpurIncrementalSweepAndCompact>>resetComponents (in category 'api - global') -----
+ resetComponents
+
+ sweeper resetSweeper.
+ compactor resetCompactor!
Item was added:
+ ----- Method: SpurIncrementalSweepAndCompact>>sweep (in category 'api - global') -----
+ sweep
+
+ <inline: true>
+ sweeper globalSweep!
Item was added:
+ ----- Method: SpurIncrementalSweepAndCompact>>sweepAndCompact (in category 'api - global') -----
+ sweepAndCompact
+
+ self
+ sweep;
+ compact!
Item was changed:
SpurCompactor subclass: #SpurIncrementalSweeper
+ instanceVariableNames: 'currentSweepingEntity isCurrentlySweeping currentSegmentUsed currentSegmentUnused currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge'
- instanceVariableNames: 'currentSweepingEntity isCurrentlySweeping currentSegmentUsed currentSegmentUnused currentSegmentsIndex currentsCycleSeenObjectCount'
classVariableNames: 'MaxObjectsToFree'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
Item was added:
+ ----- Method: SpurIncrementalSweeper>>advanceSegment (in category 'as yet unclassified') -----
+ advanceSegment
+
+ self setOccupationAtIndex: currentSegmentsIndex used: currentSegmentUsed unused: currentSegmentUnused.
+
+ currentSegmentUsed := currentSegmentUnused := 0.
+ currentSegmentsIndex := currentSegmentsIndex + 1.
+
+ currentSegmentsIndex < manager segmentManager numSegments
+ ifTrue: [currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex]
+ !
Item was changed:
----- Method: SpurIncrementalSweeper>>bulkFreeChunkFrom: (in category 'api - global') -----
bulkFreeChunkFrom: 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).
- self assert: (self canUseAsFreeSpace: true).
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].
next := manager objectStartingAt: start + bytes.
self assert: ((manager oop: next isLessThan: manager endOfMemory)
or: [next = manager endOfMemory and: [(self canUseAsFreeSpace: next) not]]).
self canUseAsFreeSpace: next]
whileTrue: [currentObj := next].
^ manager addFreeChunkWithBytes: bytes at: start!
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 |
- | bytes start next currentObj currentSegmentsBridge |
self assert: (self canUseAsFreeSpace: objOop).
start := manager startOfObject: objOop.
currentObj := objOop.
bytes := 0.
- currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
-
[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 unlinkFreeChunk: currentObj chunkBytes: (manager bytesInBody: currentObj).
manager totalFreeOldSpace: manager totalFreeOldSpace - (manager bytesInBody: currentObj).
+ self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
currentSegmentUnused := currentSegmentUnused + (manager bytesInBody: currentSweepingEntity)].
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 advanceSegment].
- ifTrue: [
- self setOccupationAtIndex: currentSegmentsIndex used: currentSegmentUsed unused: currentSegmentUnused.
- currentSegmentUsed := currentSegmentUnused := 0.
- currentSegmentsIndex := currentSegmentsIndex + 1.
- currentSegmentsIndex < manager segmentManager numSegments
- ifTrue: [currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex]].
(self canUseAsFreeSpace: next) and: [currentsCycleSeenObjectCount < MaxObjectsToFree]]
whileTrue: [currentObj := next].
^ manager addFreeChunkWithBytes: bytes at: start!
Item was added:
+ ----- Method: SpurIncrementalSweeper>>compactorsSegmentToFill (in category 'as yet unclassified') -----
+ compactorsSegmentToFill
+
+ "this is incredible^10 ugly but I see no much better way to access the info"
+
+ ^ manager gc compactor compactor segmentToFill!
Item was changed:
----- Method: SpurIncrementalSweeper>>currentSweepingEntity (in category 'accessing') -----
currentSweepingEntity
+ <cmacro: '() GIV(currentSweepingEntity)'>
^ currentSweepingEntity!
Item was changed:
----- Method: SpurIncrementalSweeper>>doIncrementalSweeping (in category 'api - incremental') -----
doIncrementalSweeping
+ "Scan the heap for unmarked objects and free them. Coalescence "
- "Iterate over all entities, in order, making large free chunks from free chunks and unmarked objects,
- unmarking live objects and rebuilding the free lists."
self assert: currentSweepingEntity notNil.
currentsCycleSeenObjectCount := 0.
[self oop: currentSweepingEntity isLessThan: manager endOfMemory] whileTrue:
+ [ currentSweepingEntity = currentSegmentsBridge
+ ifTrue: [self advanceSegment]
+ ifFalse: [self sweepCurrentSweepingEntity].
+
+ currentSweepingEntity :=self nextSweepingEntity .
+
- [ | oldEntity |
- (self canUseAsFreeSpace: currentSweepingEntity)
- ifTrue: [currentSweepingEntity := self cautiousBulkFreeChunkFrom: currentSweepingEntity]
- ifFalse: [self unmark: currentSweepingEntity.
- currentSegmentUsed := currentSegmentUsed + (manager bytesInBody: currentSweepingEntity).
- currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1].
-
- oldEntity := currentSweepingEntity.
- currentSweepingEntity := manager objectAfter: currentSweepingEntity limit: manager endOfMemory.
- self assert: oldEntity <= currentSweepingEntity.
- self assert: currentSweepingEntity notNil.
-
currentsCycleSeenObjectCount >= MaxObjectsToFree
ifTrue: [^ false]].
manager checkFreeSpace: GCModeIncremental.
^ true!
Item was changed:
----- Method: SpurIncrementalSweeper>>finishSweeping (in category 'as yet unclassified') -----
finishSweeping
+ self resetSweeper.
- isCurrentlySweeping := false.
manager updateSweepEndUsecs!
Item was changed:
----- Method: SpurIncrementalSweeper>>initializeIfNecessary (in category 'api - incremental') -----
initializeIfNecessary
isCurrentlySweeping
ifFalse: [currentSegmentUsed := currentSegmentUnused := 0.
currentSegmentsIndex := 0.
+ currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
currentSweepingEntity := manager firstObject.
isCurrentlySweeping := true]
!
Item was added:
+ ----- 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: [
+ currentSegmentUnused := manager bytesInBody: reservedSegmentsFreeChunk.
+ nextEntity := manager objectAfter: nextEntity limit: manager endOfMemory].
+
+ ^ nextEntity!
Item was added:
+ ----- Method: SpurIncrementalSweeper>>resetSweeper (in category 'as yet unclassified') -----
+ resetSweeper
+
+ "reset all incremental progress. To be used before doing a global sweep to leave the sweeper in the correct state for the next time"
+ isCurrentlySweeping := false.
+ currentSweepingEntity := nil.
+ currentSegmentUsed := nil.
+ currentSegmentUnused := nil.
+ currentSegmentsIndex := nil.
+ currentsCycleSeenObjectCount := nil
+
+ !
Item was added:
+ ----- Method: SpurIncrementalSweeper>>sweepCurrentSweepingEntity (in category 'api - incremental') -----
+ sweepCurrentSweepingEntity
+
+ (self canUseAsFreeSpace: currentSweepingEntity)
+ ifTrue: [currentSweepingEntity := self cautiousBulkFreeChunkFrom: currentSweepingEntity]
+ ifFalse: [self unmarkAndUpdateStats].
+ !
Item was added:
+ ----- Method: SpurIncrementalSweeper>>unmarkAndUpdateStats (in category 'api - incremental') -----
+ unmarkAndUpdateStats
+
+ self unmark: currentSweepingEntity.
+
+ currentSegmentUsed := currentSegmentUsed + (manager bytesInBody: currentSweepingEntity).
+ currentsCycleSeenObjectCount := currentsCycleSeenObjectCount + 1
+ !
Item was changed:
----- Method: SpurMemoryManager class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
isNonArgumentImplicitReceiverVariableName: aString
+ ^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'compactor' 'planningCompactor' 'selectiveCompactor' 'heapMap' 'marker' 'sweeper' 'gc') includes: aString!
- ^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager' 'compactor' 'planningCompactor' 'selectiveCompactor' 'heapMap' 'marker' 'sweeper') includes: aString!
Item was changed:
----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
addToFreeTree: freeChunk bytes: chunkBytes
"Add freeChunk to the large free chunk tree.
For the benefit of sortedFreeObject:, answer the treeNode it is added
to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
| childBytes parent child |
+ self initFreeTreeChunk: freeChunk bytes: chunkBytes.
- self assert: (self isFreeObject: freeChunk).
- self assert: chunkBytes = (self bytesInBody: freeChunk).
- self assert: chunkBytes >= (self numFreeLists * self allocationUnit).
- self
- storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
- storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0;
- storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
- storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
- storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
Beneath the node are smaller and larger blocks."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[childBytes := self bytesInBody: child.
"check for overlap; could write this as self oop: (self objectAfter: freeChunk) isLessThanOrEqualTo: child...
but that relies on headers being correct, etc. So keep it clumsy..."
self assert: ((self oop: freeChunk + chunkBytes - self baseHeaderSize isLessThanOrEqualTo: child)
or: [self oop: freeChunk isGreaterThanOrEqualTo: child + childBytes - self baseHeaderSize]).
childBytes = chunkBytes ifTrue: "size match; add to list at node."
[self setNextFreeChunkOf: freeChunk withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: child) isLilliputianSize: false.
self setNextFreeChunkOf: child withValue: freeChunk isLilliputianSize: false.
^child].
"walk down the tree"
parent := child.
child := self fetchPointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: child].
parent = 0 ifTrue:
[self assert: (freeLists at: 0) = 0.
freeLists at: 0 put: freeChunk.
freeListsMask := freeListsMask bitOr: 1.
^0].
self assert: (freeListsMask anyMask: 1).
"insert in tree"
self storePointer: self freeChunkParentIndex
ofFreeChunk: freeChunk
withValue: parent.
self storePointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: freeChunk.
^0!
Item was changed:
----- Method: SpurMemoryManager>>allInstancesOf: (in category 'primitive support') -----
allInstancesOf: aClass
"Attempt to answer an array of all objects, excluding those that may
be garbage collected as a side effect of allocating the result array.
If no memory is available answer the number of instances as a SmallInteger.
Since objects are at least 16 bytes big, and the largest SmallInteger covers
1/4 of the address space, the count can never overflow."
| classIndex freeChunk ptr start limit count bytes |
classIndex := self rawHashBitsOf: aClass.
classIndex = 0 ifTrue:
[freeChunk := self allocateSlots: 0 format: self arrayFormat classIndex: ClassArrayCompactIndex.
^freeChunk].
gc markObjectsForEnumerationPrimitives ifTrue:
[marker markObjects: true]. "may not want to revive objects unnecessarily; but marking is sloooow."
freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
(self isClassAtUniqueIndex: aClass)
ifTrue:
[self uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]]
ifFalse:
[self ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p]].
self assert: (self isEmptyObjStack: markStack).
gc markObjectsForEnumerationPrimitives
ifTrue:
[self assert: self allObjectsUnmarked.
self emptyObjStack: weaklingStack]
ifFalse:
[self assert: (self isEmptyObjStack: weaklingStack)].
(count > (ptr - start / self bytesPerOop) "not enough room"
or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
[self freeObject: freeChunk.
^self integerObjectOf: count].
count < self numSlotsMask ifTrue:
[| smallObj |
smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
0 to: count - 1 do:
[:i|
self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofFreeChunk: freeChunk)].
self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
self beRootIfOld: smallObj.
self checkFreeSpace: GCModeFull.
^smallObj].
bytes := self largeObjectBytesForSlots: count.
start := self startOfObject: freeChunk.
self freeChunkWithBytes: limit - start - bytes at: start + bytes.
totalFreeOldSpace := totalFreeOldSpace - bytes.
self rawOverflowSlotsOf: freeChunk put: count.
self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
+ gc maybeModifyGCFlagsOf: freeChunk.
self possibleRootStoreInto: freeChunk.
self checkFreeSpace: GCModeFull.
self runLeakCheckerFor: GCModeFull.
^freeChunk!
Item was added:
+ ----- Method: SpurMemoryManager>>initFreeTreeChunk:bytes: (in category 'free space') -----
+ initFreeTreeChunk: freeChunk bytes: chunkBytes
+
+ self assert: (self isFreeObject: freeChunk).
+ self assert: chunkBytes = (self bytesInBody: freeChunk).
+ self assert: chunkBytes >= (self numFreeLists * self allocationUnit).
+ self
+ storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
+ storePointer: self freeChunkPrevIndex ofFreeChunk: freeChunk withValue: 0;
+ storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
+ storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
+ storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
+ !
Item was changed:
----- Method: SpurMemoryManager>>markStack (in category 'spur bootstrap') -----
markStack
+
+ <cmacro: '() GIV(markStack)'>
^markStack!
Item was changed:
----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
objectsReachableFromRoots: arrayOfRoots
"This is part of storeImageSegmentInto:outPointers:roots:.
Answer an Array of all the objects only reachable from the argument, an Array of root objects,
starting with arrayOfRoots. If there is no space, answer a SmallInteger whose value is the
number of slots required. This is used to collect the objects to include in an image segment
on Spur, separate from creating the segment, hence simplifying the implementation.
Thanks to Igor Stasenko for this idea."
| freeChunk ptr start limit count oop objOop |
<var: #freeChunk type: #usqInt> "& hence start & ptr are too; limit is also because of addressAfter:"
<inline: #never>
self assert: (self isArray: arrayOfRoots).
"Mark all objects except those only reachable from the arrayOfRoots by marking
each object in arrayOfRoots and then marking all reachable objects (from the
system roots). This leaves unmarked only objects reachable from the arrayOfRoots.
N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
self assert: self allObjectsUnmarked.
self markObjectsIn: arrayOfRoots.
marker markObjects: false.
"After the mark phase all unreachable weak slots will have been nilled
and all active ephemerons fired."
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self noUnscannedEphemerons.
"Now unmark the roots before collecting the transitive closure of unmarked objects accessible from the roots."
self unmarkObjectsIn: arrayOfRoots.
"Use the largest free chunk to answer the result."
freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
totalFreeOldSpace := totalFreeOldSpace - (self bytesInBody: freeChunk). "but must update so that growth in the markStack does not cause assert fails."
ptr := start := freeChunk + self baseHeaderSize.
limit := self addressAfter: freeChunk.
count := 0.
"First put the arrayOfRoots; order is important."
self noCheckPush: arrayOfRoots onObjStack: markStack.
"Now collect the roots and the transitive closure of unmarked objects from them."
[self isEmptyObjStack: markStack] whileFalse:
[objOop := self popObjStack: markStack.
self assert: (self isMarked: objOop).
count := count + 1.
ptr < limit ifTrue:
[self longAt: ptr put: objOop.
ptr := ptr + self bytesPerOop].
oop := self fetchClassOfNonImm: objOop.
(self isMarked: oop) ifFalse:
[self setIsMarkedOf: oop to: true.
self noCheckPush: oop onObjStack: markStack].
((self isContextNonImm: objOop)
and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the copy loop"
ifTrue:
[0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
[:i|
oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
((self isImmediate: oop)
or: [self isMarked: oop]) ifFalse:
[self setIsMarkedOf: oop to: true.
self noCheckPush: oop onObjStack: markStack]]]
ifFalse:
[0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
oop := self fetchPointer: i ofObject: objOop.
((self isImmediate: oop)
or: [self isMarked: oop]) ifFalse:
[self setIsMarkedOf: oop to: true.
self noCheckPush: oop onObjStack: markStack]]]].
self unmarkAllObjects.
"Now try and allocate the result"
(count > (ptr - start / self bytesPerOop) "not enough room"
or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
[self freeObject: freeChunk.
self checkFreeSpace: GCCheckImageSegment.
^self integerObjectOf: count].
"There's room; set the format, & classIndex and shorten."
self setFormatOf: freeChunk to: self arrayFormat.
self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
+ gc allocatorShouldAllocateBlack ifTrue: [self setIsMarkedOf: freeChunk to: true].
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>>storePointerImmutabilityCheck:ofObject:withValue: (in category 'object access') -----
storePointerImmutabilityCheck: fieldIndex ofObject: objOop withValue: valuePointer
"Note must check here for stores of young objects into old ones."
<inline: true> "Must be inlined for the normal send in cannotAssign:to:withIndex:"
self cppIf: IMMUTABILITY ifTrue:
[self deny: (self isImmediate: objOop).
(self isImmutable: objOop) ifTrue:
[^coInterpreter cannotAssign: valuePointer to: objOop withIndex: fieldIndex]].
+ self storePointer: fieldIndex ofObject: objOop withValue: valuePointer!
- self storePointer: fieldIndex ofObject: objOop withValue: valuePointer.
-
- self marker writeBarrierFor: objOop at: fieldIndex with: valuePointer!
Item was changed:
----- Method: StackInterpreter>>eekcr (in category 'debug printing') -----
eekcr
"For marking the end of a leak check print message"
<api>
<inline: #never>
+ self print: '\n'; flush.
- self printf: '\n'.
self cCode: '' inSmalltalk: [self halt]!
More information about the Vm-dev
mailing list