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!
vm-dev@lists.squeakfoundation.org