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

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

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

Name: VMMaker.oscog-eem.2075
Author: eem
Time: 5 January 2017, 2:58:19.533102 pm
UUID: d1a62f7b-baf5-4077-b797-fee2139868a3
Ancestors: VMMaker.oscog-eem.2074

SpurPlanningCompactor:
Enjoy a moment of clarity and eliminate the continue... nonsense.  The enumerators can simply continue with toFinger in lock-step with the current object while pinned objects prevent movement.

To help debug the previous state of SPC change checkInterpreterIntegrity to answer 0 if ok, and a set of problem-identifying flags if not.  Hence remember to send mapExtraRoots in updatePointers.

Select fthe highest suitable free block properly.

The CoInterpreter now appears to work.

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

Item was changed:
  ----- Method: Interpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
  checkInterpreterIntegrity
  "Perform an integrity/leak check using the heapMap.  Assume
  clearLeakMapAndMapAccessibleObjects has set a bit at each
  object's header.  Check that all oops in the interpreter's state
+ points to a header.  Answer 0 if all checks pass."
+ | flags |
+ flags := 0.
- points to a header.  Answer if all checks pass."
- | ok |
- ok := true.
  (self checkOopIntegrity: specialObjectsOop named: 'specialObjectsOop')ifFalse:
+ [flags := 1].
- [ok := false].
  compilerInitialized
  ifTrue:
  [(self checkOopIntegrity: receiver named: 'receiver')ifFalse:
+ [flags := 2].
- [ok := false].
  (self checkOopIntegrity: method named: 'method')ifFalse:
+ [flags := 4]]
- [ok := false]]
  ifFalse:
  [(self checkOopIntegrity: activeContext named: 'activeContext') ifFalse:
+ [flags := 8]].
- [ok := false]].
  (self checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
+ [flags := 16].
- [ok := false].
  (self checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
+ [flags := 32].
- [ok := false].
  (self checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
+ [flags := 64].
- [ok := false].
  (self checkOopIntegrity: receiverClass named: 'receiverClass')ifFalse:
+ [flags := 128].
- [ok := false].
  (self checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
+ [flags := 256].
- [ok := false].
  (self checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
+ [flags := 512].
- [ok := false].
  (self checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
+ [flags := 1024].
- [ok := false].
 
  "Callback support - check suspended callback list"
  1 to: jmpDepth do:
  [:i|
  (self checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
+ [flags := 2048].
- [ok := false].
  (self checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
+ [flags := 4096]].
+ ^flags!
- [ok := false]].
- ^ok!

Item was changed:
  ----- Method: NewObjectMemory>>runLeakCheckerFor: (in category 'debug support') -----
  runLeakCheckerFor: gcModes
  <inline: false>
  (gcModes anyMask: checkForLeaks) ifTrue:
  [(gcModes anyMask: GCModeFull)
  ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
  ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
  self clearLeakMapAndMapAccessibleObjects.
  self assert: self checkHeapIntegrity.
+ self assert: coInterpreter checkInterpreterIntegrity = 0.
- self assert: coInterpreter checkInterpreterIntegrity.
  self assert: coInterpreter checkStackIntegrity.
  self assert: (coInterpreter checkCodeIntegrity: gcModes).
  self validate "simulation only"]!

Item was changed:
  ----- Method: SpurMemoryManager>>allOldSpaceEntitiesForCompactingFrom:do: (in category 'object enumeration') -----
  allOldSpaceEntitiesForCompactingFrom: initialObject do: aBlock
  <inline: true>
  | prevObj prevPrevObj objOop nextObj |
  self assert: (self isOldObject: initialObject).
  prevPrevObj := prevObj := nil.
  objOop := initialObject.
  [self assert: objOop \\ self allocationUnit = 0.
  self oop: objOop isLessThan: endOfMemory] whileTrue:
  [self assert: (self long64At: objOop) ~= 0.
  nextObj := self objectAfter: objOop limit: endOfMemory.
+ aBlock value: objOop value: nextObj.
- aBlock value: objOop.
  prevPrevObj := prevObj.
  prevObj := objOop.
  objOop := nextObj].
  self touch: prevPrevObj.
  self touch: prevObj!

Item was changed:
  ----- Method: SpurMemoryManager>>inLineRunLeakCheckerFor:excludeUnmarkedObjs:classIndicesShouldBeValid: (in category 'debug support') -----
  inLineRunLeakCheckerFor: gcModes excludeUnmarkedObjs: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
  <inline: true>
  (gcModes anyMask: checkForLeaks) ifTrue:
  [(gcModes anyMask: GCModeFull)
  ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
  ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
  self clearLeakMapAndMapAccessibleObjects.
  self asserta: (self checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid).
+ self asserta: coInterpreter checkInterpreterIntegrity = 0.
- self asserta: coInterpreter checkInterpreterIntegrity.
  self asserta: coInterpreter checkStackIntegrity.
  self asserta: (coInterpreter checkCodeIntegrity: gcModes)]!

Item was removed:
- ----- Method: SpurPlanningCompactor>>continueCopyAndUnmarkMobileObjectsFrom:withTop: (in category 'compaction') -----
- continueCopyAndUnmarkMobileObjectsFrom: anUnpinnedEntity withTop: initialTop
- "copyAndUnmarkMobileObjects has encountered a run of pinned objects around which
- it cannot compact, but savedFirstFieldsSpace is still not full.  Continue the pass with a
- new firstFreeObject, resetting it before continuing.
- Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)."
- <var: 'initialTop' type: #usqInt>
- | result top savedFirstFreeObject savedFirstMobileObject nextFreeObject |
- <var: 'top' type: #usqInt>
- self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory).
- self deny: (manager isPinned: anUnpinnedEntity).
- savedFirstMobileObject := firstMobileObject.
- nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity.
- top := initialTop.
- "Copy and unmark the run of immobile objects to match the enumeration in continuePlanCompactSavingForwardersFrom:toFinger:."
- manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do:
- [:o|
- ((self oop: o isLessThan: firstMobileObject)
-  and: [manager isMarked: o]) ifTrue:
- [(manager isPinned: o)
- ifTrue:
- [(manager isSegmentBridge: o) ifFalse:
- [manager setIsMarkedOf: o to: false.
- manager segmentManager notePinned: o]]
- ifFalse:
- [(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
- [^false].
- self assert: o = (manager fetchPointer: 0 ofObject: o).
- manager
- setIsMarkedOf: o to: false;
- storePointerUnchecked: 0 ofObject: o withValue: (manager longAt: top)]]].
- firstMobileObject := savedFirstMobileObject.
- nextFreeObject ifNil:
- [^true].
- savedFirstFreeObject := firstFreeObject.
- firstFreeObject := nextFreeObject.
- result := self copyAndUnmarkMobileObjectsWithTop: top.
- firstFreeObject := savedFirstFreeObject.
- ^result!

Item was removed:
- ----- Method: SpurPlanningCompactor>>continuePlanCompactSavingForwardersFrom:toFinger: (in category 'compaction') -----
- continuePlanCompactSavingForwardersFrom: anUnpinnedEntity toFinger: initialToFinger
- "planCompactSavingForwarders has encountered a run of pinned objects around which
- it cannot compact, but savedFirstFieldsSpace is still not full.  Continue the pass with a
- new firstFreeObject, resetting it before continuing.
- Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)."
- <var: 'initialToFinger' type: #usqInt>
- | result toFinger savedFirstMobileObject savedFirstFreeObject nextFreeObject |
- <var: 'toFinger' type: #usqInt>
- self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory).
- self deny: (manager isPinned: anUnpinnedEntity).
- toFinger := initialToFinger.
- savedFirstMobileObject := firstMobileObject.
- nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity.
- "Forward the run of immobile objects since all unpinned objects between firstMobileObject
- and lastMobileObject must be forwarded.  Return if savedFirstFieldsSpace fills up."
- manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do:
- [:o| | newTop |
- ((self oop: o isLessThan: firstMobileObject)
-  and: [manager isMarked: o]) ifTrue:
- [(manager isPinned: o)
- ifTrue: [self assert: (manager addressAfter: o) <= initialToFinger]
- ifFalse:
- [(newTop := savedFirstFieldsSpace top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
- [firstMobileObject := savedFirstMobileObject.
- ^false]].
- self assert: (manager startOfObject: o) >= toFinger.
- toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: newTop.
- savedFirstFieldsSpace top: newTop]].
- firstMobileObject := savedFirstMobileObject.
- nextFreeObject ifNil:
- [^true].
- self assert: (self oop: nextFreeObject isGreaterThan: lastMobileObject).
- manager allOldSpaceEntitiesFrom: (manager objectAfter: lastMobileObject) to: nextFreeObject do:
- [:o|
- self deny: ((manager isMarked: o) and: [(manager isPinned: o) not])].
- savedFirstFreeObject := firstFreeObject.
- firstFreeObject := nextFreeObject.
- result := self planCompactSavingForwarders.
- firstFreeObject := savedFirstFreeObject.
- ^result!

Item was removed:
- ----- Method: SpurPlanningCompactor>>continueUpdatePointersInMobileObjectsFrom:withTop: (in category 'compaction') -----
- continueUpdatePointersInMobileObjectsFrom: anUnpinnedEntity withTop: initialTop
- "updatePointersInMobileObjects has encountered a run of pinned objects around which
- planCompactSavingForwarders cannot compact, but savedFirstFieldsSpace is still not full.
- Continue the pass with a new firstFreeObject , resetting it before continuing.
- Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed)."
- <var: 'initialTop' type: #usqInt>
- | result top savedFirstFreeObject savedFirstMobileObject nextFreeObject |
- <var: 'top' type: #usqInt>
- self assert: (self oop: anUnpinnedEntity isLessThan: manager endOfMemory).
- self deny: (manager isPinned: anUnpinnedEntity).
- savedFirstMobileObject := firstMobileObject.
- nextFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: anUnpinnedEntity.
- top := initialTop.
- "Update the run of immobile objects to match the enumeration in continuePlanCompactSavingForwardersFrom:toFinger:."
- manager allOldSpaceEntitiesFrom: anUnpinnedEntity to: firstMobileObject do:
- [:o|
- ((self oop: o isLessThan: firstMobileObject)
-  and: [manager isMarked: o]) ifTrue:
- [(manager isPinned: o)
- ifTrue: [self updatePointersIn: o]
- ifFalse:
- [(top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
- [^false].
- self updatePointersIn: o savedFirstFieldPointer: top]]].
- firstMobileObject := savedFirstMobileObject.
- nextFreeObject ifNil:
- [^true].
- savedFirstFreeObject := firstFreeObject.
- firstFreeObject := nextFreeObject.
- result := self updatePointersInMobileObjectsWithTop: top.
- firstFreeObject := savedFirstFreeObject.
- ^result!

Item was changed:
  ----- Method: SpurPlanningCompactor>>copyAndUnmark: (in category 'compaction') -----
  copyAndUnmark: firstPass
  "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions,
  restoring their savedFirstFields."
  | onePass |
  self logPhase: 'copying and unmarking...'.
  firstPass ifTrue:
  [self unmarkInitialImmobileObjects].
  "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass."
  savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
  [self assert: (self oop: firstMobileObject isGreaterThanOrEqualTo: manager endOfMemory).
  ^self].
+ onePass := self copyAndUnmarkMobileObjects.
- onePass := self copyAndUnmarkMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop.
  (onePass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true."
  [self unmarkObjectsAfterLastMobileObject]!

Item was added:
+ ----- 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).
+
+ This enumeration matches those in planCompactSavingForwarders and updatePointersInMobileObjects."
+ | 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: (savedFirstFieldsSpaceWasAllocated
+ or: [savedFirstFieldsSpace limit <= manager firstObject asUnsignedInteger
+ or: [toFinger < top]]).
+ (manager isMarked: o) ifTrue:
+ [(manager isPinned: o)
+ ifTrue:
+ [(manager isSegmentBridge: o) ifFalse:
+ [manager setIsMarkedOf: o to: false.
+ manager segmentManager notePinned: o].
+ previousPin ifNotNil:
+ [| limit |
+ limit := manager startOfObject: previousPin.
+ manager addFreeChunkWithBytes: limit - toFinger at: toFinger.
+ toFinger := manager addressAfter: previousPin.
+ self assert: toFinger <= (manager startOfObject: o)].
+ previousPin := o]
+ ifFalse:
+ [| availableSpace bytes next |
+ [previousPin notNil
+  and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
+ bytes := manager bytesInObject: o.
+ bytes ~= availableSpace
+ and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue:
+ ["The object does not fit in the space between toFinger and previousPin.
+  Move toFinger beyond previousPin and update previousPin appropriately."
+ availableSpace > 0 ifTrue:
+ [manager addFreeChunkWithBytes: availableSpace at: toFinger].
+ toFinger := manager addressAfter: previousPin.
+ next := manager objectStartingAt: toFinger.
+ previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]].
+ toFinger := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top).
+ (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 removed:
- ----- Method: SpurPlanningCompactor>>copyAndUnmarkMobileObjectsWithTop: (in category 'compaction') -----
- copyAndUnmarkMobileObjectsWithTop: initialTop
- "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.
- This enumeration matches those in planCompactSavingForwarders and updatePointersInMobileObjects."
- <var: 'initialTop' type: #usqInt>
- | toFinger top previousPin |
- <var: 'top' type: #usqInt>
- <var: 'toFinger' type: #usqInt>
- toFinger := manager startOfObject: firstFreeObject.
- top := initialTop.
- self deny: (manager isMarked: firstFreeObject).
- manager allOldSpaceEntitiesForCompactingFrom: firstFreeObject do:
- [:o|
- self check: o.
- self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger <= previousPin]]).
- self assert: (savedFirstFieldsSpaceWasAllocated
- or: [savedFirstFieldsSpace limit <= manager firstObject asUnsignedInteger
- or: [toFinger < top]]).
- (manager isMarked: o) ifTrue:
- [(manager isPinned: o)
- ifTrue:
- [(manager isSegmentBridge: o) ifFalse:
- [manager setIsMarkedOf: o to: false.
- manager segmentManager notePinned: o].
- previousPin ifNotNil:
- [| limit |
- limit := manager startOfObject: previousPin.
- manager addFreeChunkWithBytes: limit - toFinger at: toFinger.
- toFinger := manager addressAfter: previousPin.
- self assert: toFinger <= (manager startOfObject: o)].
- previousPin := o]
- ifFalse:
- [| availableSpace bytes next |
- (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
- [self freeFrom: toFinger upTo: (manager startOfObject: o) previousPin: previousPin.
- ^false].
- [previousPin notNil
-  and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
- bytes := manager bytesInObject: o.
- bytes ~= availableSpace
- and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue:
- ["The object does not fit in the space between toFinger and previousPin.
-  Move toFinger beyond previousPin and update previousPin appropriately."
- availableSpace > 0 ifTrue:
- [manager addFreeChunkWithBytes: availableSpace at: toFinger].
- toFinger := manager addressAfter: previousPin.
- next := manager objectStartingAt: toFinger.
- (self oop: next isGreaterThanOrEqualTo: o) ifTrue:
- [^self continueCopyAndUnmarkMobileObjectsFrom: o withTop: top - manager bytesPerOop].
- previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]].
- toFinger := self copyAndUnmarkObject: o to: toFinger firstField: (manager longAt: top)]]].
- self freeFrom: toFinger upTo: manager endOfMemory previousPin: previousPin.
- ^true!

Item was changed:
  ----- Method: SpurPlanningCompactor>>findHighestSuitableFreeBlock: (in category 'space management') -----
  findHighestSuitableFreeBlock: spaceEstimate
+ "If a freeBlock of size at least spaceEstimate exists high enough in the heap, choose it.
+ Ignoring pinned objects for now, the total ammount of shrinkage is expected to be
+ at least totalFreeOldSpace (because of collected objects).  So any free chunk which is
+ at or above endOfMemory - totalFreeOldSpace should not be corrupted during compaction.
+ Let's play with this for a while and see how we get on."
- "If a freeBlock of size at least spaceEstimate exists high enough in the heap, choose it."
  <inline: true>
  manager findLargestFreeChunk ifNotNil:
  [:largestFreeChunk|
+ ((manager bytesInObject: largestFreeChunk) >= spaceEstimate
+ and: [largestFreeChunk asUnsignedInteger > (manager endOfMemory - manager totalFreeOldSpace) asUnsignedInteger]) ifTrue:
- (manager bytesInObject: largestFreeChunk) >= spaceEstimate ifTrue:
  [^largestFreeChunk]].
  ^nil!

Item was added:
+ ----- Method: SpurPlanningCompactor>>freeAllUnpinnedObjectsFromObject:toFinger: (in category 'private') -----
+ freeAllUnpinnedObjectsFromObject: nextObj toFinger: initialToFinger
+ "Free all space from toFinger up, preserving only marked pinned objects."
+ | toFinger nextPinnedObj |
+ <var: 'toFinger' type: #usqInt>
+ <var: 'nextPinnedObj' type: #usqInt>
+ toFinger := initialToFinger.
+ nextPinnedObj := nextObj.
+ [[nextPinnedObj >= manager endOfMemory
+  or: [(manager isMarked: nextPinnedObj)
+  and: [(manager isPinned: nextPinnedObj)]]] whileFalse:
+ [nextPinnedObj := manager objectAfter: nextPinnedObj].
+ nextPinnedObj < manager endOfMemory] whileTrue:
+ [toFinger < (manager startOfObject: nextPinnedObj) ifTrue:
+ [manager addFreeChunkWithBytes: (manager startOfObject: nextPinnedObj) - toFinger at: toFinger].
+ toFinger := manager addressAfter: nextPinnedObj.
+ nextPinnedObj := manager objectAfter: nextPinnedObj].
+ toFinger < manager endOfMemory ifTrue:
+ [manager addFreeChunkWithBytes: manager endOfMemory - toFinger at: toFinger]!

Item was added:
+ ----- Method: SpurPlanningCompactor>>noMobileObjectsAfter: (in category 'private') -----
+ noMobileObjectsAfter: mobileObj
+ self assert: ((manager isMarked: mobileObj) and: [(manager isPinned: mobileObj) not]).
+ manager allOldSpaceEntitiesFrom: mobileObj do:
+ [:o|
+ ((manager isMarked: o) and: [(manager isPinned: o) not]) ifTrue:
+ [^false]].
+ ^true!

Item was changed:
  ----- Method: SpurPlanningCompactor>>planCompactSavingForwarders (in category 'compaction') -----
  planCompactSavingForwarders
  "Sweep the heap from firstFreeObject forwarding marked objects to where they
  can be moved to, saving their forwarding pointer in savedFirstFieldsSpace.
  Continue until either the end of the heap is reached or savedFirstFieldsSpace is full.
  Answer if the end of the heap was reached (savedFirstFieldsSpace has not overflowed).
 
- Note that this method is potentially recursive. If skipping a run of pinned objects
- causes the the algorithm to encounter another run of immobile objects it will
- recurse via continuePlanCompactSavingForwardersFrom:.
-
  This enumeration matches those in updatePointersInMobileObjects and copyAndUnmarkMobileObjects."
 
  | toFinger top previousPin |
  <var: 'top' type: #usqInt>
  <var: 'toFinger' type: #usqInt>
  savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
  [self logPhase: 'planning...'].
- toFinger := manager startOfObject: firstFreeObject.
- top := savedFirstFieldsSpace top.
  self deny: (manager isMarked: firstFreeObject).
+ toFinger := manager startOfObject: firstFreeObject.
+ top := savedFirstFieldsSpace start.
  manager allOldSpaceEntitiesFrom: firstFreeObject do:
  [:o|
  self check: o.
+ self assert: (previousPin
+ ifNil: [toFinger <= (manager startOfObject: o)]
+ ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
- self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger <= previousPin]]).
  self assert: (savedFirstFieldsSpaceWasAllocated
  or: [savedFirstFieldsSpace limit <= manager firstObject asUnsignedInteger
  or: [toFinger < top]]).
  (manager isMarked: o) ifTrue:
  [(manager isPinned: o)
  ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed."
  [previousPin ifNotNil:
  [self assert: (manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2).
  toFinger := manager addressAfter: previousPin.
  self assert: toFinger <= (manager startOfObject: o)].
  previousPin := o]
  ifFalse:
  [| availableSpace bytes next |
- (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
- [savedFirstFieldsSpace top: top - manager bytesPerOop.
- ^false].
  [previousPin notNil
   and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
  bytes := manager bytesInObject: o.
  bytes ~= availableSpace
  and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue:
  ["The object does not fit in the space between toFinger and previousPin.
   Move toFinger beyond previousPin and update previousPin appropriately."
  toFinger := manager addressAfter: previousPin.
  next := manager objectStartingAt: toFinger.
- (self oop: next isGreaterThanOrEqualTo: o) ifTrue:
- [savedFirstFieldsSpace top: top - manager bytesPerOop.
- ^self continuePlanCompactSavingForwardersFrom: o toFinger: toFinger].
  previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]].
+ toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top.
+ (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
+ [savedFirstFieldsSpace top: top - manager bytesPerOop.
+ ^self noMobileObjectsAfter: o]]]].
+ savedFirstFieldsSpace top: top - manager bytesPerOop.
- toFinger := self forwardMobileObject: o to: toFinger savedFirstFieldPtr: top]]].
- savedFirstFieldsSpace top: top.
  ^true!

Item was changed:
  ----- Method: SpurPlanningCompactor>>selectSavedFirstFieldsSpace (in category 'space management') -----
  selectSavedFirstFieldsSpace
  "To compact the heap the algorithm must save the first field (used for the forwarding pointer)
  of all moved objects. This is done in savedFirstFieldsSpace, a contiguous block of memory borrowed
  for the duration of compaction. In a 32-bit system a typical upper bound on the space needed
  is about 1/40 of the heap size.  The default new space size of 4Mb provides an eden of about
  3.6 Mb, which would serve the needs of a 144 Mb heap.  The default segment increment of
  16 Mb would serve the needs of a 640 Mb heap. Make an estimate of the size needed, and
  either use eden, a large free chunk, or a newly-allocated segment, falling back on eden if
  the alternatives can't be had."
  <inline: true>
  | spaceEstimate sizeOfEden |
  spaceEstimate := manager endOfMemory - manager firstObject // 40.
  sizeOfEden := scavenger eden limit - scavenger eden start.
  spaceEstimate > sizeOfEden ifTrue:
  [(self findHighestSuitableFreeBlock: spaceEstimate) ifNotNil:
  [:highestSuitableFreeBlock|
  (spaceEstimate > (manager sizeOfFree: highestSuitableFreeBlock)
   and: [self useSegmentForSavedFirstFieldsSpace: spaceEstimate]) ifTrue:
  [^self].
  (manager sizeOfFree: highestSuitableFreeBlock) > sizeOfEden ifTrue:
  [self useFreeChunkForSavedFirstFieldsSpace: highestSuitableFreeBlock.
+ ^self]].
+ (self useSegmentForSavedFirstFieldsSpace: spaceEstimate) ifTrue:
+ [^self]].
- ^self]]].
  self useEdenForSavedFirstFieldsSpace!

Item was changed:
  ----- Method: SpurPlanningCompactor>>updatePointers (in category 'compaction') -----
  updatePointers
  "Sweep the heap, updating all objects to their eventual locations.
  Remember to update the savedFirstFields of pointer objects, as these have been forwarded."
  | onePass |
  self logPhase: 'updating pointers...'.
  "If savedFirstFieldsSpace is empty there is nothing to do."
  savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
  [^self].
  self assert: (manager startOfObject: firstFreeObject) = mobileStart.
  coInterpreter mapInterpreterOops.
+ manager mapExtraRoots.
  self updatePointersInManagerHeapEntities.
  self updatePointersInSurvivingObjects.
  self updatePointersInInitialImmobileObjects.
+ onePass := self updatePointersInMobileObjects.
- onePass := self updatePointersInMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop.
  onePass ifFalse:
  [self updatePointersInObjectsOverflowingSavedFirstFieldsSpace]!

Item was added:
+ ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjects (in category 'compaction') -----
+ updatePointersInMobileObjects
+ "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations.
+ 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).
+
+ This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects."
+ | toFinger top previousPin |
+ <var: 'top' type: #usqInt>
+ <var: 'toFinger' type: #usqInt>
+ self deny: (manager isMarked: firstFreeObject).
+ toFinger := manager startOfObject: firstFreeObject.
+ top := savedFirstFieldsSpace start.
+ manager allOldSpaceEntitiesFrom: firstFreeObject do:
+ [:o|
+ self check: o.
+ self assert: (previousPin
+ ifNil: [toFinger <= (manager startOfObject: o)]
+ ifNotNil: [(manager isMarked: previousPin) and: [toFinger <= (manager startOfObject: previousPin)]]).
+ (manager isMarked: o) ifTrue:
+ [(manager isPinned: o)
+ ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed."
+ [self updatePointersIn: o.
+ previousPin ifNotNil:
+ [toFinger := manager addressAfter: previousPin].
+ previousPin := o]
+ ifFalse:
+ [| availableSpace bytes next |
+ [previousPin notNil
+  and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
+ bytes := manager bytesInObject: o.
+ bytes ~= availableSpace
+ and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue:
+ ["The object does not fit in the space between toFinger and previousPin.
+  Move toFinger beyond previousPin and update previousPin appropriately."
+ toFinger := manager addressAfter: previousPin.
+ next := manager objectStartingAt: toFinger.
+ previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]].
+ self updatePointersIn: o savedFirstFieldPointer: top.
+ toFinger := toFinger + (manager bytesInObject: o).
+ (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
+ [self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
+ ^self noMobileObjectsAfter: o]]]].
+ self assert: savedFirstFieldsSpace top = (top - manager bytesPerOop).
+ ^true!

Item was removed:
- ----- Method: SpurPlanningCompactor>>updatePointersInMobileObjectsWithTop: (in category 'compaction') -----
- updatePointersInMobileObjectsWithTop: initialTop
- "Sweep the mobile portion of the heap, updating all references to objects to their eventual locations.
- Remember to update the savedFirstFields of pointer objects, as these have been forwarded.
- This enumeration matches that in planCompactSavingForwarders and copyAndUnmarkMobileObjects."
- <var: 'initialTop' type: #usqInt>
- | toFinger top previousPin |
- <var: 'top' type: #usqInt>
- <var: 'toFinger' type: #usqInt>
- toFinger := manager startOfObject: firstFreeObject.
- top := initialTop.
- self deny: (manager isMarked: firstFreeObject).
- manager allOldSpaceEntitiesFrom: firstFreeObject do:
- [:o|
- self check: o.
- self assert: (previousPin isNil or: [(manager isMarked: previousPin) and: [toFinger <= previousPin]]).
- (manager isMarked: o) ifTrue:
- [(manager isPinned: o)
- ifTrue: "The empty gaps between two adjacent pinned objects (when not filled below) are freed."
- [self updatePointersIn: o.
- previousPin ifNotNil:
- [toFinger := manager addressAfter: previousPin].
- previousPin := o]
- ifFalse:
- [| availableSpace bytes next |
- (top := top + manager bytesPerOop) >= savedFirstFieldsSpace limit ifTrue:
- [^false].
- [previousPin notNil
-  and: [availableSpace := (manager startOfObject: previousPin) - toFinger.
- bytes := manager bytesInObject: o.
- bytes ~= availableSpace
- and: [bytes + (2 * manager allocationUnit) < availableSpace]]] whileTrue:
- ["The object does not fit in the space between toFinger and previousPin.
-  Move toFinger beyond previousPin and update previousPin appropriately."
- toFinger := manager addressAfter: previousPin.
- next := manager objectStartingAt: toFinger.
- (self oop: next isGreaterThanOrEqualTo: o) ifTrue:
- [^self continueUpdatePointersInMobileObjectsFrom: o withTop: top - manager bytesPerOop].
- previousPin := ((manager isMarked: next) and: [manager isPinned: next]) ifTrue: [next]].
- self updatePointersIn: o savedFirstFieldPointer: top.
- toFinger := toFinger + (manager bytesInObject: o)]]].
- ^true!

Item was changed:
  ----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
  checkInterpreterIntegrity
  "Perform an integrity/leak check using the heapMap.  Assume
  clearLeakMapAndMapAccessibleObjects has set a bit at each
  object's header.  Check that all oops in the interpreter's state
+ points to a header.  Answer 0 if all checks pass."
+ | flags |
+ flags := 0.
- points to a header.  Answer if all checks pass."
- | ok |
- ok := true.
  (objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop')ifFalse:
+ [flags := 1].
- [ok := false].
  "No longer check messageSelector; it is ephemeral, not living beyond message lookup.
  (objectMemory isNonImmediate: messageSelector) ifTrue:
  [(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
  [ok := false]]."
  (objectMemory checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
+ [flags := flags + 2].
- [ok := false].
  "No longer check lkupClass; it is ephemeral, not living beyond message lookup.
  (objectMemory checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
  [ok := false]."
  (objectMemory checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
+ [flags := flags + 4].
- [ok := false].
  (objectMemory checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
+ [flags := flags + 8].
- [ok := false].
  (objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
+ [flags := flags + 16].
- [ok := false].
  tempOop = 0 ifFalse:
  [(objectMemory checkOopIntegrity: tempOop named: 'tempOop')ifFalse:
+ [flags := flags + 32]].
- [ok := false]].
  tempOop2 = 0 ifFalse:
  [(objectMemory checkOopIntegrity: tempOop2 named: 'tempOop2')ifFalse:
+ [flags := flags + 64]].
- [ok := false]].
  tempOop3 = 0 ifFalse:
  [(objectMemory checkOopIntegrity: tempOop3 named: 'tempOop3')ifFalse:
+ [flags := flags + 128]].
- [ok := false]].
 
  "Callback support - check suspended callback list"
  1 to: jmpDepth do:
  [:i|
  (objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
+ [flags := flags + 256].
- [ok := false].
  (objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
+ [flags := flags + 512]].
- [ok := false]].
 
  self checkLogIntegrity ifFalse:
+ [flags := flags + 1024].
- [ok := false].
 
+ ^flags!
- ^ok!