[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-eem.3286.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Dec 10 20:39:53 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-eem.3286.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-eem.3286
Author: eem
Time: 10 December 2022, 12:39:31.947015 pm
UUID: 11df3955-6e89-421a-a7e1-d02beb4d1cfb
Ancestors: VMMaker.oscog.seperateMarking-eem.3285
Add some assert checking and supporting emumeration code to SpurSegmentManager. Assert that when freeing an incrementally compacted segment all objects there-in are forwarded and no free space there-in is on the global free list.
=============== Diff against VMMaker.oscog.seperateMarking-eem.3285 ===============
Item was changed:
----- Method: SpurIncrementalCompactor>>compactSegment:freeStart:segIndex: (in category 'incremental compaction') -----
compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
<var: 'segInfo' type: #'SpurSegmentInfo *'>
+
+ | fillStart |
-
- | currentEntity fillStart bytesToCopy bridge |
fillStart := initialFreeStart.
- bridge := manager segmentManager bridgeFor: segInfo.
- currentEntity := manager objectStartingAt: segInfo segStart.
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:
+ ["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 migrate: entity sized: bytesToCopy to: fillStart.
+
- [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."
- bytesToCopy := manager bytesInBody: currentEntity.
-
- self migrate: currentEntity sized: bytesToCopy to: fillStart.
-
fillStart := fillStart + bytesToCopy.
+ self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]].
+
- self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]].
-
- currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
-
- self assert: currentEntity = bridge.
currentSegment := currentSegment + 1.
^ fillStart!
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 |
- [:i|
segInfo := manager segInfoAt: i.
(self isSegmentBeingCompacted: segInfo) ifTrue:
[ | freeChunk chunkBytes |
+ self assert: (manager segmentManager allObjectsAreForwardedInSegment: segInfo includingFreeSpace: false).
+ self assert: (manager noElementOfFreeSpaceIsInSegment: segInfo).
coInterpreter
cr; print: 'freeing segment from: '; printHex: segInfo segStart;
print: ' to: '; printHex: segInfo segStart + segInfo segSize ;tab; flush.
chunkBytes := segInfo segSize - manager bridgeSize.
freeChunk := manager
addFreeChunkWithBytes: chunkBytes
at: segInfo segStart.
segmentToFill ifNil:
[manager detachFreeObject: freeChunk.
segmentToFill := segInfo]]]!
Item was added:
+ ----- Method: SpurMemoryManager>>noElementOfFreeSpaceIsInSegment: (in category 'debug support') -----
+ noElementOfFreeSpaceIsInSegment: segInfo
+ "Check that no free space on teh system's free lists is in the segment.
+ N.B. This is slightly different to there is no free space in the segment."
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ self allFreeObjectsDo:
+ [:freeBird| (segmentManager is: freeBird inSegment: segInfo) ifTrue: [^false]].
+ ^true!
Item was changed:
+ ----- Method: SpurSegmentManager>>allBridgesMarked (in category 'testing') -----
- ----- Method: SpurSegmentManager>>allBridgesMarked (in category 'debug support') -----
allBridgesMarked
0 to: numSegments - 1 do:
[:i| | bridgeObj |
bridgeObj := self bridgeAt: i.
self assert: (self isValidSegmentBridge: bridgeObj).
(manager isMarked: bridgeObj) ifFalse:
[^false]].
^true
"for debugging:"
"(0 to: numSegments - 1) select:
[:i| | bridgeObj |
bridgeObj := self bridgeAt: i.
self assert: (self isValidSegmentBridge: bridgeObj).
manager isMarked: bridgeObj]"!
Item was added:
+ ----- Method: SpurSegmentManager>>allEntitiesInSegment:exceptTheLastBridgeDo: (in category 'enumerating') -----
+ allEntitiesInSegment: segInfo exceptTheLastBridgeDo: aUnaryBlock
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ <include: #always>
+ | bridge currentEntity |
+ bridge := self bridgeFor: segInfo.
+ currentEntity := manager objectStartingAt: segInfo segStart.
+ [self oop: currentEntity isLessThan: bridge] whileTrue:
+ [aUnaryBlock value: currentEntity.
+ currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
+ self assert: currentEntity = bridge!
Item was added:
+ ----- Method: SpurSegmentManager>>allObjectsAreForwardedInSegment:includingFreeSpace: (in category 'testing') -----
+ allObjectsAreForwardedInSegment: segInfo includingFreeSpace: includeFreeSpace
+ "Answer if all objects in the segment are forwarded to somewhere outside the segment.
+ If includeFreeSpace is true, answer false if there is any unforwarded free space in the segment."
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ self allEntitiesInSegment: segInfo exceptTheLastBridgeDo:
+ [:thing|
+ (manager isFreeObject: thing)
+ ifTrue: [includeFreeSpace ifTrue: [^false]]
+ ifFalse:
+ [(manager isForwarded: thing) ifFalse:
+ [^false].
+ (self is: (manager fetchPointer: 0 ofMaybeForwardedObject: thing) inSegment: segInfo) ifTrue:
+ [^false]]].
+ ^true!
Item was added:
+ ----- Method: SpurSegmentManager>>allObjectsAreWhiteInSegment: (in category 'testing') -----
+ allObjectsAreWhiteInSegment: segInfo
+ "Answer if all objects in the segment are white."
+
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ self allEntitiesInSegment: segInfo exceptTheLastBridgeDo:
+ [:thing|
+ ((manager isFreeObject: thing)
+ or: [manager isWhite: thing]) ifFalse:
+ [^false]].
+ ^true!
Item was added:
+ ----- Method: SpurSegmentManager>>is:inSegment: (in category 'testing') -----
+ is: address inSegment: segInfo
+ <var: 'address' type: #usqInt>
+ <var: 'segInfo' type: #'SpurSegmentInfo *'>
+ ^(self oop: address isLessThan: segInfo segLimit)
+ and: [self oop: address isGreaterThanOrEqualTo: segInfo segStart]!
Item was changed:
----- Method: SpurSelectiveCompactor>>compactSegment:freeStart:segIndex: (in category 'compaction') -----
compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ | fillStart |
- | 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"
lastLilliputianChunk := self lastLilliputianChunkAtIndex: segIndex - 1.
+ manager segmentManager
+ allEntitiesInSegment: segInfo
+ exceptTheLastBridgeDo:
+ [:entity|
+ (manager isFreeObject: entity)
+ ifTrue:
+ ["To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
+ (manager isLilliputianSize: (manager bytesInBody: entity))
+ ifTrue: [self incrementalUnlinkLilliputianChunk: entity] "Performance hack for single linked list"
+ ifFalse: [manager detachFreeObject: entity].
+ manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
+ ifFalse:
+ [| bytesToCopy copy |
+ "Copy the object in segmentToFill and replace it by a forwarder."
+ self assert: (manager isPinned: entity) not.
+ bytesToCopy := manager bytesInBody: entity.
+ manager memcpy: fillStart asVoidPointer _: (manager startOfObject: entity) 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: entity to: (manager objectStartingAt: fillStart).
+ fillStart := fillStart + bytesToCopy.
+ self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]].
- [self oop: currentEntity isLessThan: bridge] whileTrue:
- [(manager isFreeObject: currentEntity)
- ifTrue:
- ["To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
- (manager isLilliputianSize: (manager bytesInBody: currentEntity))
- ifTrue: [self incrementalUnlinkLilliputianChunk: currentEntity] "Performance hack for single linked list"
- ifFalse: [manager detachFreeObject: currentEntity].
- manager set: currentEntity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
- ifFalse:
- ["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.
^ fillStart!
More information about the Vm-dev
mailing list