[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3293.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Jan 7 14:41:43 UTC 2023
Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3293.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-WoC.3293
Author: WoC
Time: 7 January 2023, 3:41:19.657769 pm
UUID: a3aab76a-4795-4f7d-8696-1b02378b80c7
Ancestors: VMMaker.oscog.seperateMarking-WoC.3292
- some small layout changes to debug printing
in CompactingSweeper: never end on a bridge and skip empty segments
- bridges can move by 8 byte and then our previously saved pointer to it is invalid
- empty segments can be removed. If the currentObject is in an empty segment the address will be invalid
- reorganization of control flow for skipping segments (to advanceSegment)
- some method category reorganization
=============== Diff against VMMaker.oscog.seperateMarking-WoC.3292 ===============
Item was changed:
----- 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: (compactor occupationOf: segInfo) * 100; tab;
+ print: '('; printNum: (compactor sizeClaimedIn: segInfo) ; print: ' bytes)' ;flush].
- coInterpreter cr; print: 'occupation from marking: '; printNum: (segInfo lastFreeObject asFloat / segInfo segSize) * 100; tab; flush].
+ manager printSegmentOccupationFromMarkedObjects.
- "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.
self assert: manager allObjectsWhite.
"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 changed:
----- Method: SpurIncrementalCompactingSweeper>>advanceSegment (in category 'sweep and compact') -----
advanceSegment
+ [ | shouldContinue |
+ self assert: ((manager isSegmentBridge: currentObject) or: [self shouldSkipCurrentSegment]).
- 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 := manager objectStartingAt: self currentSegment segStart.
+ shouldContinue := self shouldSkipCurrentSegment]
+ ifFalse: [currentObject := manager objectStartingAt: (manager segmentManager lastBridge).
+ shouldContinue := false].
- ifTrue: [currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex].
+ shouldContinue] whileTrue
- currentObject := self nextCurrentObject
!
Item was changed:
----- 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: segInfo segStart ; tab; flush.
- self unmarkSegmentAsBeingCompacted: (manager segInfoAt: currentSegmentsIndex).
self
+ unmarkSegment: self currentSegment
- unmarkSegment: (manager segInfoAt: currentSegmentsIndex)
asBeingCompactedAndSaveEndOfCompactionAddress: entity.
"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 don't make the dead object a free chunk, but make it
a non pointer object to avoid the leak checker to try to follow the pointers of the dead object.
Should we abort compacting this segment the object will get kept alife for one gc cycle"
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>>currentSegment (in category 'accessing') -----
+ currentSegment
+
+ ^ manager segInfoAt: currentSegmentsIndex!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>doIncrementalCompact (in category 'incremental compact') -----
doIncrementalCompact
| segInfo |
+ segInfo := self currentSegment.
- 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 changed:
----- 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].
+ (currentObject ~= currentSegmentsBridge and: [currentsCycleSeenObjectCount >= MaxObjectsToFree])
- currentsCycleSeenObjectCount >= MaxObjectsToFree
ifTrue: [" | segInfo segIndex bytesAhead |
segIndex := (manager segmentIndexContainingObj: currentObject).
segInfo := manager segInfoAt: segIndex.
bytesAhead := segInfo segSize - (currentObject - segInfo segStart).
segIndex + 1 to: manager numSegments
do: [:index | | segment|
segment := manager segInfoAt: index.
bytesAhead := bytesAhead + segment segSize]."
(coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000
ifTrue: [^ false]
ifFalse: [currentsCycleSeenObjectCount := 0]]].
"set occupation for last segment"
manager checkFreeSpace: GCModeIncremental.
^ true!
Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper>>freePastSegmentsAndSetSegmentToFill (in category 'api') -----
- ----- 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 wasSegmentsCompactionAborted: segInfo)
ifTrue: [ | freeUntil chunkBytes |
freeUntil := manager startOfObject: (self getEndOfCompaction: segInfo).
chunkBytes := freeUntil - segInfo segStart.
"maybe we could not even move one object out of the segment. Make sure we do not produce an invalid free chunk"
chunkBytes > 0
ifTrue: [coInterpreter
cr; print: 'partially freeing segment from: '; printHex: segInfo segStart;
print: ' to: '; printHex: freeUntil ;tab; flush.
manager
addFreeChunkWithBytes: chunkBytes
at: segInfo segStart]].
(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 changed:
+ ----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'api') -----
- ----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'public') -----
incrementalSweepAndCompact
scStartTime := coInterpreter ioUTCMicrosecondsNow.
self initIfNecessary.
"should in between sweeper calls segments be removed the index would not be correct anymore. Reset it here so we can be sure it is correct"
currentSegmentsIndex := manager segmentManager segmentIndexContainingObj: currentObject.
"if the bridge between segments was small before and the segment directly after the current one was removed the position of the bridge moved. Update
the current position to avoid this case"
currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
self assert: manager validObjectColors.
self doincrementalSweepAndCompact
ifTrue: [self finishSweepAndCompact.
^ true].
+ "do not end on a bridge!! If a segment behind the current one currentObject is removed the size of the bridge can change from 8 bytes to 16 bytes and
+ therefore invalidating currentObject that is now pointing to the overflow header instad of the bridges body. To not hove to implement some finicky update
+ mechanism in the removal of segments just make sure we never reference the bridge before giving back the control to the mutator"
+ self assert: (manager isSegmentBridge: currentObject) not.
+
+ "skip empty segments. There is no work for us to do + they can be removed. As currentObject is always in the current segment
+ it won't be valid anymore"
+ self assert: (manager segmentManager isEmptySegment: self currentSegment) not.
+
coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush.
^ false!
Item was changed:
----- Method: SpurIncrementalCompactingSweeper>>nextCurrentObject (in category 'sweep and compact') -----
nextCurrentObject
+ ^ manager objectAfter: currentObject limit: manager endOfMemory.
+ !
- | 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 changed:
+ ----- Method: SpurIncrementalCompactingSweeper>>postSwizzleAction (in category 'api') -----
- ----- 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 changed:
----- Method: SpurIncrementalCompactingSweeper>>shouldCompactCurrentSegment (in category 'sweep and compact') -----
shouldCompactCurrentSegment
| currentSegment |
shouldCompact ifFalse: [^ false].
+ currentSegment := self currentSegment.
- currentSegment := (manager segInfoAt: currentSegmentsIndex).
^ self isSegmentBeingCompacted: currentSegment!
Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>shouldSkipCurrentSegment (in category 'testing') -----
+ shouldSkipCurrentSegment
+
+ ^ (segmentToFill notNil and: [manager segmentManager is: currentObject inSegment: segmentToFill])
+ or: [manager segmentManager isEmptySegment: self currentSegment]!
Item was changed:
----- 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]]).
(coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000
ifTrue: ["we just compacted a whole segment. Maybe this took a long time therefore set currentsCycleSeenObjectCount to max to force a check in doincrementalSweepAndCompact"
currentsCycleSeenObjectCount := MaxObjectsToFree]]
ifFalse: [self doIncrementalSweep.
currentObject := self nextCurrentObject]
!
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: 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 |
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.
(self isFreeOop: oop)
ifTrue: [
"index > 0
ifTrue: [self cCode: 'raise(SIGINT)']."
freeSpace := freeSpace + oopSize.
slotCount < 64
ifTrue: [
sizeCount at: slotCount put: ((sizeCount at: slotCount) + 1)]
ifFalse: [sizeCount at: 0 put: ((sizeCount at: 0) + 1).
bigFreeChunkMemory := bigFreeChunkMemory + oopSize]]
ifFalse: [objectCount := objectCount + 1.
occupiedSpace := occupiedSpace + oopSize]].
coInterpreter cr;
print: 'Segment ';
printNum: index;
print: ' (starting at: ';
printHex: segInfo segStart; tab;
+ print: 'max bytes: '; tab;
+ printNum: segInfo segSize;
- 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;
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 bytes: ';
- 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 changed:
----- 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; flush.
- cr; cr; flush.
+ coInterpreter
- coInterpreter cr;
print: 'Currently occupied space: '; tab;
printNum: occupiedSpace; tab;
print: 'Resulting in an occupation percentage of: '; tab;
printNum: (occupiedSpace asFloat / (segInfo segSize)) * 100;
+ flush.
- cr; cr; flush.
].
+ coInterpreter cr; cr;
- coInterpreter cr;
print: '----------------------------------------- '; cr;
print: '----------------------------------------- ';
cr.
!
More information about the Vm-dev
mailing list