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

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

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

Name: VMMaker.oscog-eem.2089
Author: eem
Time: 13 January 2017, 11:11:59.299154 am
UUID: dba93c68-3848-4229-9da0-2329131ac979
Ancestors: VMMaker.oscog-cb.2088

SpurPlanningCompactor:
Add a variant of the testRandomAssortments test that tests for shrinkage
Beef up the validFreeTreeChunk:parent: and freeChunkWithBytes:at: asserts to insist that a free chunk lie within a single segment.
Both of these are chasing the real VM's freeing of memory across segment boundaries.

Change attemptToShrink to request the segmentManager to shrink by at least growHeadroom, since it won't otherwise.  Have shrinkObjectMemory: anser if shrinkage occurred, and only increment statShrinkMemory if so.

=============== Diff against VMMaker.oscog-cb.2088 ===============

Item was changed:
  ----- Method: SpurMemoryManager>>attemptToShrink (in category 'growing/shrinking memory') -----
  attemptToShrink
+ "Attempt to shrink memory after successfully reclaiming lots of memory.
+ If there's enough memory to shrink then be sure to attept to shrink by
+ at least growHeaqdroom because segments are typically of that size."
- "Attempt to shrink memory after successfully reclaiming lots of memory."
  (totalFreeOldSpace > shrinkThreshold
+ and: [totalFreeOldSpace > growHeadroom
+ and: [segmentManager shrinkObjectMemory: (totalFreeOldSpace - growHeadroom max: growHeadroom)]]) ifTrue:
+ [statShrinkMemory := statShrinkMemory + 1]!
- and: [totalFreeOldSpace > growHeadroom]) ifTrue:
- [statShrinkMemory := statShrinkMemory + 1.
- segmentManager shrinkObjectMemory: totalFreeOldSpace - growHeadroom]!

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

Item was changed:
  ----- Method: SpurMemoryManager>>validFreeTreeChunk:parent: (in category 'free space') -----
  validFreeTreeChunk: chunk parent: parent
  <var: 'reason' type: #'const char *'>
  <returnTypeC: #'const char *'>
  chunk = 0 ifTrue:
  [^nil].
  (self addressCouldBeOldObj: chunk) ifFalse:
  [^'not in old space'].
  (self bytesInObject: chunk) / self allocationUnit < self numFreeLists ifTrue:
  [^'too small'].
  parent ~= (self fetchPointer: self freeChunkParentIndex ofFreeChunk: chunk) ifTrue:
  [^'bad parent'].
+
+ (segmentManager segmentContainingObj: chunk) ~~ (segmentManager segmentContainingObj: (self addressAfter: chunk)) ifTrue:
+ [^'not in one segment'].
  (self validFreeTreeChunk: (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: chunk) parent: chunk) ifNotNil:
  [:reason| ^reason].
  (self validFreeTreeChunk: (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: chunk) parent: chunk) ifNotNil:
  [:reason| ^reason].
  ^nil!

Item was changed:
  ----- Method: SpurPlanningCompactor>>findNextMarkedPinnedAfter: (in category 'private') -----
  findNextMarkedPinnedAfter: unpinnedObj
  <inline: true>
  | nextObj |
+ self deny: ((manager isPinned: unpinnedObj) and: [manager isMarked: unpinnedObj]).
- self deny: (manager isPinned: unpinnedObj).
  nextObj := unpinnedObj.
  [nextObj := manager objectAfter: nextObj limit: manager endOfMemory.
  nextObj >= manager endOfMemory ifTrue:
  [^nil].
  (manager isPinned: nextObj) and: [manager isMarked: nextObj]] whileFalse.
  ^nextObj!

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 |
  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.
  [pin notNil] whileTrue:
  [(start := manager startOfObject: pin) > toFinger ifTrue:
  [manager addFreeChunkWithBytes: start - effectiveToFinger at: effectiveToFinger].
+ nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pin.
- nextUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedObjectFollowing: pin.
  nextUnpinned >= limit ifTrue:
  [^self].
  effectiveToFinger := manager startOfObject: nextUnpinned.
  pin := self findNextMarkedPinnedAfter: nextUnpinned].
  manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger!

Item was removed:
- ----- Method: SpurPlanningCompactor>>unmarkPinnedObjectsAndFindFirstUnpinnedObjectFollowing: (in category 'private') -----
- unmarkPinnedObjectsAndFindFirstUnpinnedObjectFollowing: pinnedObj
- <inline: true>
- | nextObj |
- self assert: (manager isPinned: pinnedObj).
- nextObj := pinnedObj.
- [self unmarkPinned: nextObj.
- nextObj := manager objectAfter: nextObj limit: manager endOfMemory.
- nextObj >= manager endOfMemory ifTrue:
- [^manager endOfMemory].
- manager isPinned: nextObj] whileTrue.
- ^nextObj!

Item was added:
+ ----- Method: SpurPlanningCompactor>>unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: (in category 'private') -----
+ unmarkPinnedObjectsAndFindFirstUnpinnedOrFreeEntityFollowing: pinnedObj
+ <inline: true>
+ | nextObj |
+ self assert: ((manager isPinned: pinnedObj) and: [manager isMarked: pinnedObj]).
+ nextObj := pinnedObj.
+ [self unmarkPinned: nextObj.
+ nextObj := manager objectAfter: nextObj limit: manager endOfMemory.
+ nextObj >= manager endOfMemory ifTrue:
+ [^manager endOfMemory].
+ (manager isPinned: nextObj) and: [manager isMarked: nextObj]] whileTrue.
+ ^nextObj!

Item was changed:
  ----- Method: SpurPlanningCompactorTests>>testRandomAssortment: (in category 'private') -----
  testRandomAssortment: random
  "Test that the compactor can handle a random assortment of live, pinned, dead, and free chunks."
  | om 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]]].
  totalPinned := pinCount.
  totalLive := liveCount.
+ self assert: totalPinned < (totalPinned + totalLive / 10). "should average 5%"
- self assert: totalPinned < (totalPinned + totalLive / 10). "should be about 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)]].
  "They should be the last objects..."
  self assert: (om isFreeObject: (om objectAfter: obj)).
  self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj))!

Item was added:
+ ----- 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.!

Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testRandomAssortmentsWithNewSegment (in category 'tests') -----
+ testRandomAssortmentsWithNewSegment
+ "Test that the compactor can handle some number of random assortments of live, pinned, dead, and free chunks
+ allocated in a new segment."
+ <timeout: 60>
+ | random |
+ random := Random new.
+ 10 timesRepeat: [self testRandomAssortmentWithNewSegment: (random next: 6000) readStream]!

Item was changed:
  ----- Method: SpurSegmentManager>>shrinkObjectMemory: (in category 'growing/shrinking memory') -----
  shrinkObjectMemory: delta
+ "Answer if any shrinkage was achieved."
  <inline: false>
  <var: #delta type: #usqInt>
  | shrinkage emptySeg |
  <var: #shrinkage type: #usqInt>
  <var: #emptySeg type: #'SpurSegmentInfo *'>
  shrinkage := delta.
  [emptySeg := self findEmptySegNearestInSizeTo: shrinkage.
  emptySeg notNil] whileTrue:
  [emptySeg segSize > shrinkage ifTrue:
+ [^shrinkage < delta].
- [^self].
  shrinkage := shrinkage - emptySeg segSize.
  manager detachFreeObject: (manager objectStartingAt: emptySeg segStart).
+ self removeSegment: emptySeg].
+ ^shrinkage < delta!
- self removeSegment: emptySeg]!