VM Maker: VMMaker.oscog-eem.2090.mcz

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2090.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2090
Author: eem
Time: 13 January 2017, 2:59:27.453633 pm
UUID: 63a161b9-17e1-4911-a89a-1687d9ba9a1a
Ancestors: VMMaker.oscog-eem.2089

SpurPlanningCompactor:
Fix the freeing across segment boundaries at end of run bug (freeFrom:upTo:previousPin: must check for an intervening segment bridge).

Attempt to write a test to catch this.

SpurPlanningCompactor now ready for real-world testing.

=============== Diff against VMMaker.oscog-eem.2089 ===============

Item was changed:
  ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') -----
  freeChunkWithBytes: bytes at: address
        <inline: false>
        | freeChunk |
        self assert: (self isInOldSpace: address).
+       self assert: (segmentManager segmentContainingObj: address) = (segmentManager segmentContainingObj: address + bytes).
        freeChunk := self initFreeChunkWithBytes: bytes at: address.
-       self assert: (segmentManager segmentContainingObj: freeChunk) = (segmentManager segmentContainingObj: (self addressAfter: freeChunk)).
        self addToFreeList: freeChunk bytes: bytes.
        self assert: freeChunk = (self objectStartingAt: address).
        ^freeChunk!

Item was changed:
  ----- Method: SpurPlanningCompactor>>freeFrom:upTo:previousPin: (in category 'private') -----
  freeFrom: toFinger upTo: limit previousPin: previousPinOrNil
        "Free from toFinger up to limit, dealing with a possible intervening run of pinned objects starting at previousPinOrNil."
        <inline: false>
+       | effectiveToFinger pin nextUnpinned start seg |
+       <var: #seg type: #'SpurSegmentInfo *'>
-       | effectiveToFinger pin nextUnpinned start |
        self cCode: [] inSmalltalk:
                [coInterpreter cr; cr; print: 'freeing at '; printHexnp: toFinger; print: ' up to '; printHexnp: limit; print: ' pin '; printHexnp: previousPinOrNil; cr].
        effectiveToFinger := toFinger.
        pin := previousPinOrNil.
+       "If the range toFinger to limit spans segments but there is no pin (as when freeing to the end of memory)
+        segment boundaries must still be observed.  So in this case use the nearest bridge above toFinger as the pin."
+       pin ifNil:
+               [seg := manager segmentManager segmentContainingObj: toFinger.
+                seg segLimit < limit ifTrue:
+                       [pin := manager segmentManager bridgeFor: seg]].
        [pin notNil] whileTrue:
                [(start := manager startOfObject: pin) > toFinger ifTrue:
                        [manager addFreeChunkWithBytes: start - effectiveToFinger at: effectiveToFinger].
                 nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pin.
                 nextUnpinned >= limit ifTrue:
                        [^self].
                 effectiveToFinger := manager startOfObject: nextUnpinned.
                 pin := self findNextMarkedPinnedAfter: nextUnpinned].
        manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger!

Item was changed:
  ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentWithNewSegment: (in category 'private') -----
  testRandomAssortmentWithNewSegment: random
        "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks,
         with some allocation in a new segment.  No live pinned objects are created in the new segment
         to obtain the situation that the last segment is entirely empty after compaction.  This tests shrinkage."
        | om pig lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
        random reset. "random is a read stream on 3000 random numbers; for repeatability"
        om := self initializedVM objectMemory.
        om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].

        pinFill := 16r99999900.
        liveFill := 16r55AA0000.
        liveCount := pinCount := expectedFreeSpace := 0.
        pinned := Set new.

        1000 timesRepeat:
                [| nSlots next newObj |
                 nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
                 newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
                 (next := random next) > 0.95
                        ifTrue: "pinned"
                                [om
                                        fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
                                        setIsPinnedOf: newObj to: true]
                        ifFalse: "mobile"
                                [om
                                        fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
                 (next := random next) >= 0.333
                        ifTrue:
                                [om setIsMarkedOf: newObj to: true.
                                 (om isPinned: newObj) ifTrue:
                                        [pinned add: newObj]]
                        ifFalse: "dead or free"
                                [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
                                 (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
                                        ifTrue: [pinCount := pinCount - 1]
                                        ifFalse: [liveCount := liveCount - 1].
                                 next >= 0.2
                                        ifTrue: [om setIsMarkedOf: newObj to: false]
                                        ifFalse: [om setObjectFree: newObj]]].

         pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
         self deny: pig isNil.
         self assert: 0 equals: om bytesLeftInOldSpace.
         om growOldSpaceByAtLeast: om growHeadroom // 2.
         self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize.
         expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig).

        1000 timesRepeat:
                [| nSlots next newObj |
                 nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
                 newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
                 "No pinned objects in second segment."
                 om fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1).
                 (next := random next) >= 0.333
                        ifTrue:
                                [om setIsMarkedOf: newObj to: true.
                                 (om isPinned: newObj) ifTrue:
                                        [pinned add: newObj]]
                        ifFalse: "dead or free"
                                [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
                                 liveCount := liveCount - 1.
                                 next >= 0.2
                                        ifTrue: [om setIsMarkedOf: newObj to: false]
                                        ifFalse: [om setObjectFree: newObj]]].

        totalPinned := pinCount.
        totalLive := liveCount.
        self assert: totalPinned < (totalPinned + totalLive / 20). "should average 2.5%"

        "useful pre-compaction printing:"
        false ifTrue:
                [liveCount := pinCount := 0.
                 om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
                        [:o|
                        om coInterpreter print:
                                ((om isMarked: o)
                                        ifTrue: [(((om isPinned: o)
                                                                        ifTrue: [pinCount := pinCount + 1]
                                                                        ifFalse: [liveCount := liveCount + 1])
                                                                printPaddedWith: Character space to: 3 base: 10), ' ']
                                        ifFalse: ['     ']).
                         om printEntity: o]].

        expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
        om compactor compact.
        self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
        self assert: om allObjectsUnmarked.

        "useful post-compaction printing:"
        false ifTrue:
                [liveCount := pinCount := 0.
                 om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
                        [:o|
                        om coInterpreter print:
                                ((om isFreeObject: o)
                                        ifFalse: [(((om isPinned: o)
                                                                        ifTrue: [pinCount := pinCount + 1]
                                                                        ifFalse: [liveCount := liveCount + 1])
                                                                printPaddedWith: Character space to: 3 base: 10), ' ']
                                        ifTrue: ['     ']).
                         om printEntity: o]].

        "First check and/or count populations..."
        liveCount := pinCount := 0.
        om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
                [:o|
                (om isPinned: o)
                        ifTrue:
                                [pinCount := pinCount + 1.
                                 self assert: (pinned includes: o)]
                        ifFalse: [liveCount := liveCount + 1]].
        self assert: totalPinned equals: pinCount.
        self assert: totalLive equals: liveCount.

        "Now check fills, which also tests update of first field on move..."
        liveCount := pinCount := 0.
        obj := lastObj.
        1 to: totalLive + totalPinned do:
                [:n| | expectedFill actualFill |
                 [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
                 expectedFill := (om isPinned: obj)
                                                        ifTrue: [pinFill + (pinCount := pinCount + 1)]
                                                        ifFalse: [liveFill + (liveCount := liveCount + 1)].
                 1 to: (om numSlotsOf: obj) do:
                        [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
        "the Last segment should be empty"
        self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)).
        "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it."
        self assert: (om isFreeObject: (om objectAfter: obj)).
        self assert: (om isSegmentBridge: (om objectAfter: (om objectAfter: obj))).
        self assert: (om isFreeObject: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
        self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).

        "And the memory should shrink if the shrinkThreshold is low enough"
        om shrinkThreshold: om growHeadroom.
        om attemptToShrink.
+       self assert: om segmentManager numSegments = 1!
-       self assert: om segmentManager numSegments = 1.!

Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testRunOfObjectsWithExtraSegment (in category 'tests') -----
+ testRunOfObjectsWithExtraSegment
+       "Test that the compactor can handle compacting more than one segment and shortening the memory."
+       | om expectedFreeSpace pig gapObj obj |
+       om := self initializedVM objectMemory.
+       om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true].
+       "First create a gap"
+       gapObj := om allocateSlotsInOldSpace: 100 format: om firstLongFormat classIndex: ClassArrayCompactIndex.
+       om fillObj: gapObj numSlots: 100 with: om falseObject.
+       self deny: (om isMarked: gapObj).
+       expectedFreeSpace := om bytesInObject: gapObj.
+       "Now some objects, a gap to a new segment and another run of objects."
+       1 to: 2 do:
+               [:i|
+               10 timesRepeat:
+                       [obj := om allocateSlotsInOldSpace: 50 format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+                        om fillObj: obj numSlots: 50 with: 16r55AA55AA;
+                               setIsMarkedOf: obj to: true.
+                        obj := om allocateSlotsInOldSpace: 260 format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+                       om fillObj: obj numSlots: 260 with: 16rAA55AA55;
+                               setIsMarkedOf: obj to: true].
+               i = 1 ifTrue:
+                       [pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+                        self deny: pig isNil.
+                        self assert: 0 equals: om bytesLeftInOldSpace.
+                        om growOldSpaceByAtLeast: om growHeadroom // 2.
+                        self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize.
+                        expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig)]].
+
+       "useful debugging:""om printOopsFrom: gapObj to: om endOfMemory"
+       expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
+       om compactor compact.
+       self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
+       self assert: om allObjectsUnmarked.
+
+       "The first mobile object past the pinned objects should have moved."
+       self assert: ClassBitmapCompactIndex equals: (om classIndexOf: gapObj).
+       obj := gapObj.
+       "The objects have moved."
+       20 timesRepeat:
+               [self assert: ClassBitmapCompactIndex equals: (om classIndexOf: obj).
+                0 to: (om numSlotsOf: obj) - 1 do: [:i| self assert: 16r55AA55AA equals: (om fetchPointer: i ofObject: obj)].
+                obj := om objectAfter: obj.
+                self assert: ClassBitmapCompactIndex equals: (om classIndexOf: obj).
+                0 to: (om numSlotsOf: obj) - 1 do: [:i| self assert: 16rAA55AA55 equals: (om fetchPointer: i ofObject: obj)].
+                obj := om objectAfter: obj].
+       "the Last segment should be empty"
+       self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)).
+       "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it."
+       self assert: (om isFreeObject: obj).
+       self assert: (om isSegmentBridge: (om objectAfter: obj)).
+       self assert: (om isFreeObject: (om objectAfter: (om objectAfter: obj))).
+       self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: obj))).
+
+       "And the memory should shrink if the shrinkThreshold is low enough"
+       om shrinkThreshold: om growHeadroom.
+       om attemptToShrink.
+       self assert: om segmentManager numSegments = 1!

Hi All,

    here are some stats to go with the new compactor in use in my work VMMaker image running on a 2.3 GHz Intel Core i7 late 2012 MacMini running Yosemite 10.10.5

uptime 0h6m2s

memory 231,735,296 bytes

old 226,734,992 bytes (97.8%)

young 3,801,936 bytes (1.6%)

used 192,741,392 bytes (83.2%)

free 35,365,936 bytes (15.3%)

GCs 6,992 (51.9 ms between GCs)

full 6 totalling 1,573 ms (0.4% uptime), avg 262.2 ms

incr 6,986 totalling 5,306 ms (1.5% uptime), avg 0.8 ms

On Fri, Jan 13, 2017 at 3:00 PM, <[hidden email]> wrote:

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2090.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.2090
Author: eem
Time: 13 January 2017, 2:59:27.453633 pm
UUID: 63a161b9-17e1-4911-a89a-1687d9ba9a1a
Ancestors: VMMaker.oscog-eem.2089

SpurPlanningCompactor:
Fix the freeing across segment boundaries at end of run bug (freeFrom:upTo:previousPin: must check for an intervening segment bridge).

Attempt to write a test to catch this.

SpurPlanningCompactor now ready for real-world testing.

=============== Diff against VMMaker.oscog-eem.2089 ===============

Item was changed:
  ----- Method: SpurMemoryManager>>freeChunkWithBytes:at: (in category 'free space') -----
  freeChunkWithBytes: bytes at: address
        <inline: false>
        | freeChunk |
        self assert: (self isInOldSpace: address).
+       self assert: (segmentManager segmentContainingObj: address) = (segmentManager segmentContainingObj: address + bytes).
        freeChunk := self initFreeChunkWithBytes: bytes at: address.
-       self assert: (segmentManager segmentContainingObj: freeChunk) = (segmentManager segmentContainingObj: (self addressAfter: freeChunk)).
        self addToFreeList: freeChunk bytes: bytes.
        self assert: freeChunk = (self objectStartingAt: address).
        ^freeChunk!

Item was changed:
  ----- Method: SpurPlanningCompactor>>freeFrom:upTo:previousPin: (in category 'private') -----
  freeFrom: toFinger upTo: limit previousPin: previousPinOrNil
        "Free from toFinger up to limit, dealing with a possible intervening run of pinned objects starting at previousPinOrNil."
        <inline: false>
+       | effectiveToFinger pin nextUnpinned start seg |
+       <var: #seg type: #'SpurSegmentInfo *'>
-       | effectiveToFinger pin nextUnpinned start |
        self cCode: [] inSmalltalk:
                [coInterpreter cr; cr; print: 'freeing at '; printHexnp: toFinger; print: ' up to '; printHexnp: limit; print: ' pin '; printHexnp: previousPinOrNil; cr].
        effectiveToFinger := toFinger.
        pin := previousPinOrNil.
+       "If the range toFinger to limit spans segments but there is no pin (as when freeing to the end of memory)
+        segment boundaries must still be observed.  So in this case use the nearest bridge above toFinger as the pin."
+       pin ifNil:
+               [seg := manager segmentManager segmentContainingObj: toFinger.
+                seg segLimit < limit ifTrue:
+                       [pin := manager segmentManager bridgeFor: seg]].
        [pin notNil] whileTrue:
                [(start := manager startOfObject: pin) > toFinger ifTrue:
                        [manager addFreeChunkWithBytes: start - effectiveToFinger at: effectiveToFinger].
                 nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pin.
                 nextUnpinned >= limit ifTrue:
                        [^self].
                 effectiveToFinger := manager startOfObject: nextUnpinned.
                 pin := self findNextMarkedPinnedAfter: nextUnpinned].
        manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger!

Item was changed:
  ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentWithNewSegment: (in category 'private') -----
  testRandomAssortmentWithNewSegment: random
        "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks,
         with some allocation in a new segment.  No live pinned objects are created in the new segment
         to obtain the situation that the last segment is entirely empty after compaction.  This tests shrinkage."
        | om pig lastObj obj expectedFreeSpace liveFill pinFill liveCount pinCount totalLive totalPinned pinned |
        random reset. "random is a read stream on 3000 random numbers; for repeatability"
        om := self initializedVM objectMemory.
        om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true. lastObj := o].

        pinFill := 16r99999900.
        liveFill := 16r55AA0000.
        liveCount := pinCount := expectedFreeSpace := 0.
        pinned := Set new.

        1000 timesRepeat:
                [| nSlots next newObj |
                 nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
                 newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
                 (next := random next) > 0.95
                        ifTrue: "pinned"
                                [om
                                        fillObj: newObj numSlots: nSlots with: pinFill + (pinCount := pinCount + 1);
                                        setIsPinnedOf: newObj to: true]
                        ifFalse: "mobile"
                                [om
                                        fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
                 (next := random next) >= 0.333
                        ifTrue:
                                [om setIsMarkedOf: newObj to: true.
                                 (om isPinned: newObj) ifTrue:
                                        [pinned add: newObj]]
                        ifFalse: "dead or free"
                                [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
                                 (om isPinned: newObj) "Must check /before/ setObjectFree: which clears all bits"
                                        ifTrue: [pinCount := pinCount - 1]
                                        ifFalse: [liveCount := liveCount - 1].
                                 next >= 0.2
                                        ifTrue: [om setIsMarkedOf: newObj to: false]
                                        ifFalse: [om setObjectFree: newObj]]].

         pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
         self deny: pig isNil.
         self assert: 0 equals: om bytesLeftInOldSpace.
         om growOldSpaceByAtLeast: om growHeadroom // 2.
         self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize.
         expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig).

        1000 timesRepeat:
                [| nSlots next newObj |
                 nSlots := (random next * 300) rounded. "Make sure we stray into overflow size field territory."
                 newObj := om allocateSlotsInOldSpace: nSlots format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
                 "No pinned objects in second segment."
                 om fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1).
                 (next := random next) >= 0.333
                        ifTrue:
                                [om setIsMarkedOf: newObj to: true.
                                 (om isPinned: newObj) ifTrue:
                                        [pinned add: newObj]]
                        ifFalse: "dead or free"
                                [expectedFreeSpace := expectedFreeSpace + (om bytesInObject: newObj).
                                 liveCount := liveCount - 1.
                                 next >= 0.2
                                        ifTrue: [om setIsMarkedOf: newObj to: false]
                                        ifFalse: [om setObjectFree: newObj]]].

        totalPinned := pinCount.
        totalLive := liveCount.
        self assert: totalPinned < (totalPinned + totalLive / 20). "should average 2.5%"

        "useful pre-compaction printing:"
        false ifTrue:
                [liveCount := pinCount := 0.
                 om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
                        [:o|
                        om coInterpreter print:
                                ((om isMarked: o)
                                        ifTrue: [(((om isPinned: o)
                                                                        ifTrue: [pinCount := pinCount + 1]
                                                                        ifFalse: [liveCount := liveCount + 1])
                                                                printPaddedWith: Character space to: 3 base: 10), ' ']
                                        ifFalse: ['     ']).
                         om printEntity: o]].

        expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
        om compactor compact.
        self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
        self assert: om allObjectsUnmarked.

        "useful post-compaction printing:"
        false ifTrue:
                [liveCount := pinCount := 0.
                 om allOldSpaceEntitiesFrom: (om objectAfter: lastObj) to: (om objectBefore: om endOfMemory) do:
                        [:o|
                        om coInterpreter print:
                                ((om isFreeObject: o)
                                        ifFalse: [(((om isPinned: o)
                                                                        ifTrue: [pinCount := pinCount + 1]
                                                                        ifFalse: [liveCount := liveCount + 1])
                                                                printPaddedWith: Character space to: 3 base: 10), ' ']
                                        ifTrue: ['     ']).
                         om printEntity: o]].

        "First check and/or count populations..."
        liveCount := pinCount := 0.
        om allOldSpaceObjectsFrom: (om objectAfter: lastObj) do:
                [:o|
                (om isPinned: o)
                        ifTrue:
                                [pinCount := pinCount + 1.
                                 self assert: (pinned includes: o)]
                        ifFalse: [liveCount := liveCount + 1]].
        self assert: totalPinned equals: pinCount.
        self assert: totalLive equals: liveCount.

        "Now check fills, which also tests update of first field on move..."
        liveCount := pinCount := 0.
        obj := lastObj.
        1 to: totalLive + totalPinned do:
                [:n| | expectedFill actualFill |
                 [obj := om objectAfter: obj. (om isEnumerableObject: obj) or: [obj >= om endOfMemory]] whileFalse.
                 expectedFill := (om isPinned: obj)
                                                        ifTrue: [pinFill + (pinCount := pinCount + 1)]
                                                        ifFalse: [liveFill + (liveCount := liveCount + 1)].
                 1 to: (om numSlotsOf: obj) do:
                        [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
        "the Last segment should be empty"
        self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)).
        "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it."
        self assert: (om isFreeObject: (om objectAfter: obj)).
        self assert: (om isSegmentBridge: (om objectAfter: (om objectAfter: obj))).
        self assert: (om isFreeObject: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).
        self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: (om objectAfter: obj)))).

        "And the memory should shrink if the shrinkThreshold is low enough"
        om shrinkThreshold: om growHeadroom.
        om attemptToShrink.
+       self assert: om segmentManager numSegments = 1!
-       self assert: om segmentManager numSegments = 1.!

Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testRunOfObjectsWithExtraSegment (in category 'tests') -----
+ testRunOfObjectsWithExtraSegment
+       "Test that the compactor can handle compacting more than one segment and shortening the memory."
+       | om expectedFreeSpace pig gapObj obj |
+       om := self initializedVM objectMemory.
+       om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true].
+       "First create a gap"
+       gapObj := om allocateSlotsInOldSpace: 100 format: om firstLongFormat classIndex: ClassArrayCompactIndex.
+       om fillObj: gapObj numSlots: 100 with: om falseObject.
+       self deny: (om isMarked: gapObj).
+       expectedFreeSpace := om bytesInObject: gapObj.
+       "Now some objects, a gap to a new segment and another run of objects."
+       1 to: 2 do:
+               [:i|
+               10 timesRepeat:
+                       [obj := om allocateSlotsInOldSpace: 50 format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+                        om fillObj: obj numSlots: 50 with: 16r55AA55AA;
+                               setIsMarkedOf: obj to: true.
+                        obj := om allocateSlotsInOldSpace: 260 format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+                       om fillObj: obj numSlots: 260 with: 16rAA55AA55;
+                               setIsMarkedOf: obj to: true].
+               i = 1 ifTrue:
+                       [pig := om allocateSlotsInOldSpace: (om numSlotsOfAny: om findLargestFreeChunk) format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+                        self deny: pig isNil.
+                        self assert: 0 equals: om bytesLeftInOldSpace.
+                        om growOldSpaceByAtLeast: om growHeadroom // 2.
+                        self assert: om growHeadroom equals: om bytesLeftInOldSpace + om bridgeSize.
+                        expectedFreeSpace := expectedFreeSpace + (om bytesInObject: pig)]].
+
+       "useful debugging:""om printOopsFrom: gapObj to: om endOfMemory"
+       expectedFreeSpace := expectedFreeSpace + om bytesLeftInOldSpace.
+       om compactor compact.
+       self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
+       self assert: om allObjectsUnmarked.
+
+       "The first mobile object past the pinned objects should have moved."
+       self assert: ClassBitmapCompactIndex equals: (om classIndexOf: gapObj).
+       obj := gapObj.
+       "The objects have moved."
+       20 timesRepeat:
+               [self assert: ClassBitmapCompactIndex equals: (om classIndexOf: obj).
+                0 to: (om numSlotsOf: obj) - 1 do: [:i| self assert: 16r55AA55AA equals: (om fetchPointer: i ofObject: obj)].
+                obj := om objectAfter: obj.
+                self assert: ClassBitmapCompactIndex equals: (om classIndexOf: obj).
+                0 to: (om numSlotsOf: obj) - 1 do: [:i| self assert: 16rAA55AA55 equals: (om fetchPointer: i ofObject: obj)].
+                obj := om objectAfter: obj].
+       "the Last segment should be empty"
+       self assert: (om segmentManager isEmptySegment: (om segmentManager segments at: 1)).
+       "They should be the last objects, followed by a free object to the end fo the first segment, a bridge, then an empty segment with a single free object in it."
+       self assert: (om isFreeObject: obj).
+       self assert: (om isSegmentBridge: (om objectAfter: obj)).
+       self assert: (om isFreeObject: (om objectAfter: (om objectAfter: obj))).
+       self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: (om objectAfter: obj))).
+
+       "And the memory should shrink if the shrinkThreshold is low enough"
+       om shrinkThreshold: om growHeadroom.
+       om attemptToShrink.
+       self assert: om segmentManager numSegments = 1!

--

_,,,^..^,,,_

best, Eliot