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

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

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

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

Name: VMMaker.oscog-eem.2087
Author: eem
Time: 12 January 2017, 3:44:06.79572 pm
UUID: 76f2e121-53b8-423b-8f0e-07de0597bc77
Ancestors: VMMaker.oscog-eem.2086

SpurPlanningCompactor:
Thar she blows!  Fix the bugs with trailing pinned objects following the last mobile object (they need unmarking and freeing memory beyond the end of the now compacted lastMobileObject must not free them).

testRandomAssortments takes a while and so needs a timeout specifying.

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

Item was changed:
  ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjects (in category 'compaction') -----
  copyAndUnmarkMobileObjects
  "Sweep the mobile portion of the heap, moving objects to their eventual locations, and clearing their marked bits.
  Remember to update the savedFirstFields of pointer objects, as these have been forwarded.
  Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
 
  The enumerations in planCompactSavingForwarders, updatePointersInMobileObjects and copyAndUnmarkMobileObjects
  match.  We could implement them as a single enumeration method taking several block arguments, but arguably that
  would make understanding an already tricky algorithm more difficult.  Instead we tolerate the duplication and encourage
  the reader to diff the three methods to see where they diverge (e.g. via Cmd-shift-C)."
  <inline: #never>
  | toFinger top previousPin |
  <var: 'top' type: #usqInt>
  <var: 'toFinger' type: #usqInt>
  self deny: (manager isMarked: firstFreeObject).
  toFinger := manager startOfObject: firstFreeObject.
  top := savedFirstFieldsSpace start.
  manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do:
  [:o :n|
  self check: o.
  self assert: (previousPin
  ifNil: [toFinger <= (manager startOfObject: o)]
  ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
  self assert: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]).
+ o > lastMobileObject ifTrue:
+ [self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin.
+ ^true].
  (manager isMarked: o) ifTrue:
  [(manager isPinned: o)
  ifTrue:
  [previousPin ifNil:
  [previousPin := o]]
  ifFalse:
  [| availableSpace bytes |
  bytes := manager bytesInObject: o.
  [previousPin notNil
   and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
  bytes ~= availableSpace
  and: [bytes + (2 * manager allocationUnit) > availableSpace]]] whileTrue:
  ["The object does not fit in the space between toFinger and previousPin.
    Move toFinger up to point at the first unmarked or mobile object after
    previousPin, or, if previousPin is contiguous with o, to the start of this
    object.  Update previousPin to be the next pinned object above toFInger
    and below this object, or nil if no such pinned object exists.
    Any unfillable gaps between adjacent pinned objects will be freed."
  availableSpace > 0 ifTrue:
  [manager addFreeChunkWithBytes: availableSpace at: toFinger].
  [self assert: ((manager isMarked: previousPin) and: [manager isPinned: previousPin]).
   self unmarkPinned: previousPin.
   toFinger := manager addressAfter: previousPin.
   previousPin := manager objectStartingAt: toFinger.
   (manager isMarked: previousPin)
    and: [(manager isPinned: previousPin)
    and: [previousPin < o]]]
  whileTrue.
  "Now previousPin is either equal to o or mobile.
   Move it to the next pinned object below o"
  [previousPin >= o
   or: [(manager isMarked: previousPin)
   and: [manager isPinned: previousPin]]] whileFalse:
  [previousPin := manager objectAfter: previousPin].
  previousPin >= o ifTrue:
  [previousPin := nil]].
  self copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: (manager longAt: top).
  toFinger := toFinger + bytes.
  (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
  [| done |
  self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
  done := self noMobileObjectsAfter: n.
  done
  ifTrue: [self freeAllUnpinnedObjectsFromObject: (previousPin ifNil: [n]) toFinger: toFinger]
  ifFalse: [self freeFrom: toFinger upTo: (manager startOfObject: n) previousPin: previousPin].
  ^done]]]].
  self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin.
  ^true!

Item was added:
+ ----- Method: SpurPlanningCompactor>>findNextMarkedPinnedAfter: (in category 'private') -----
+ findNextMarkedPinnedAfter: unpinnedObj
+ <inline: true>
+ | nextObj |
+ 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 |
- | effectiveToFinger firstUnpinned |
  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 unmarkPinnedObjectsAndFindFirstUnpinnedObjectFollowing: pin.
+ nextUnpinned >= limit ifTrue:
- previousPinOrNil ifNotNil:
- [manager addFreeChunkWithBytes: (manager startOfObject: previousPinOrNil) - toFinger at: toFinger.
- firstUnpinned := self unmarkPinnedObjectsAndFindFirstUnpinnedObjectFollowing: previousPinOrNil.
- firstUnpinned >= limit ifTrue:
  [^self].
+ effectiveToFinger := manager startOfObject: nextUnpinned.
+ pin := self findNextMarkedPinnedAfter: nextUnpinned].
- effectiveToFinger := manager startOfObject: firstUnpinned].
  manager addFreeChunkWithBytes: limit - effectiveToFinger at: effectiveToFinger!

Item was changed:
  ----- 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 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 |
- | om lastObj obj expectedFreeSpace liveFill pinFill liveCounter pinCounter totalLive totalPinned |
  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.
- liveCounter := pinCounter := expectedFreeSpace := 0.
  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);
- fillObj: newObj numSlots: nSlots with: pinFill + (pinCounter := pinCounter + 1);
  setIsPinnedOf: newObj to: true]
  ifFalse: "mobile"
  [om
+ fillObj: newObj numSlots: nSlots with: liveFill + (liveCount := liveCount + 1)].
- fillObj: newObj numSlots: nSlots with: liveFill + (liveCounter := liveCounter + 1)].
  (next := random next) >= 0.333
  ifTrue:
+ [om setIsMarkedOf: newObj to: true.
+ (om isPinned: newObj) ifTrue:
+ [pinned add: newObj]]
- [om setIsMarkedOf: newObj to: true]
  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].
- ifTrue: [pinCounter := pinCounter - 1]
- ifFalse: [liveCounter := liveCounter - 1].
  next >= 0.2
  ifTrue: [om setIsMarkedOf: newObj to: false]
  ifFalse: [om setObjectFree: newObj]]].
+ totalPinned := pinCount.
+ totalLive := liveCount.
- totalPinned := pinCounter.
- totalLive := liveCounter.
  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]].
- "Check our checking code before the compaction, just in case..."
- liveCounter := pinCounter := 0.
- obj := lastObj.
- 1 to: totalLive + totalPinned do:
- [:n| | expectedFill actualFill |
- [obj := om objectAfter: obj. (om isEnumerableObject: obj) and: [om isMarked: obj]] whileFalse.
- expectedFill := (om isPinned: obj)
- ifTrue: [pinFill + (pinCounter := pinCounter + 1)]
- ifFalse: [liveFill + (liveCounter := liveCounter + 1)].
- 1 to: (om numSlotsOf: obj) do:
- [:i| self assert: expectedFill equals: (actualFill := om fetchPointer: i - 1 ofObject: obj)]].
 
- "useful debugging:""om printOopsFrom: (om objectAfter: lastObj) to: om endOfMemory"
  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.
- liveCounter := pinCounter := 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)].
- ifTrue: [pinFill + (pinCounter := pinCounter + 1)]
- ifFalse: [liveFill + (liveCounter := liveCounter + 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 changed:
  ----- Method: SpurPlanningCompactorTests>>testRandomAssortments (in category 'tests') -----
  testRandomAssortments
  "Test that the compactor can handle some number of random assortments of live, pinned, dead, and free chunks."
+ <timeout: 60>
  | random |
  random := Random new.
  10 timesRepeat: [self testRandomAssortment: (random next: 3000) readStream]!