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

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

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

Name: VMMaker.oscog-eem.2067
Author: eem
Time: 3 January 2017, 11:53:37.445979 am
UUID: 98f859d8-b5a0-4fb8-a8f2-b70bf22be6ac
Ancestors: VMMaker.oscog-rsf.2066

SpurPlanningCompactor:
Nuke unmarkObjectsOverflowingSavedFirstFieldsSpace; it is never appropriate.  Replace it by unmarkObjectsAfterLastMobileObject & objectAfterLastMobileObject.

copyAndUnmark should not unmark initial objects in a second pass, hence copyAndUnmark => copyAndUnmark: firstPass.

Fix reInitializeScan for subsequent passes by setting lastMobileObject appropriately.

Fix several oop comparisons to use the approved method, and add type declarations so that comparisons can work for toFinger and top.

Add an assert to planCompactSavingForwarders & copyAndUnmarkMobileObjectsWithTop: to check that a free chunk used for savedFirstFieldsSpace will not get improoperly overwritten.

Simplify numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer:; the first field ptr is always present.

Fix printEntity: to use the new unprefixed hex printer.

Simulator:
Fix deprecated usage in fetchByte.

=============== Diff against VMMaker.oscog-rsf.2066 ===============

Item was changed:
  ----- Method: SpurMemoryManager>>printEntity: (in category 'debug printing') -----
  printEntity: oop
  <api>
  | isObj |
  isObj := false.
  coInterpreter printHex: oop; space.
  (self addressCouldBeObj: oop) ifFalse:
  [^coInterpreter print: ((self isImmediate: oop) ifTrue: ['immediate'] ifFalse: ['unknown'])].
  coInterpreter
  print: ((self isFreeObject: oop) ifTrue: ['free'] ifFalse:
  [(self isSegmentBridge: oop) ifTrue: ['bridge'] ifFalse:
  [(self isForwarded: oop) ifTrue: ['forwarder'] ifFalse:
  [(self classIndexOf: oop) <= self lastClassIndexPun ifTrue: ['pun/obj stack'] ifFalse:
  [isObj := true. 'object']]]]);
  space; printHex: (self bytesInObject: oop); print: '/'; printNum: (self bytesInObject: oop).
  isObj ifTrue:
  [coInterpreter
  space;
  print: ((self formatOf: oop) <= 16rF ifTrue: ['f:0'] ifFalse: ['f:']);
+ printHexnpnp: (self formatOf: oop);
- printHexnp: (self formatOf: oop);
  print: ((self isGrey: oop) ifTrue: [' g'] ifFalse: [' .']);
  print: ((self isImmutable: oop) ifTrue: ['i'] ifFalse: ['.']);
  print: ((self isMarked: oop) ifTrue: ['m'] ifFalse: ['.']);
  print: ((self isPinned: oop) ifTrue: ['p'] ifFalse: ['.']);
  print: ((self isRemembered: oop) ifTrue: ['r'] ifFalse: ['.'])].
  coInterpreter cr!

Item was changed:
  CogClass subclass: #SpurPlanningCompactor
+ instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject'
- instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet interestingObj anomaly'
  classVariableNames: ''
  poolDictionaries: 'SpurMemoryManagementConstants VMBasicConstants VMBytecodeConstants VMSpurObjectRepresentationConstants'
  category: 'VMMaker-SpurMemoryManager'!
 
  !SpurPlanningCompactor commentStamp: 'eem 12/23/2016 17:50' prior: 0!
  SpurPlanningCompactor implements the classic planning compaction algorithm for Spur.  It makes at least three passes through the heap.  The first pass plans where live movable objects will go, copying their forwarding field to the next slot in savedFirstFieldsSpace, and setting their forwarding pointer to point to their eventual location.  The second pass updates all pointers in live pointer objects to point to objects' final destinations.  The third pass moves objects to their final positions, unmarking objects as it does so.  If the forwarding fields of live objects in the to-be-moved portion of the entire heap won't fit in savedFirstFieldsSpace, then additional passes are made until the entire heap has been compacted.
 
  Instance Variables
  biasForGC <Boolean>
  coInterpreter: <StackInterpreter>
  firstFieldOfRememberedSet <Oop>
  firstFreeObject <Oop>
  firstMobileObject <Oop>
  lastMobileObject <Oop>
  manager: <SpurMemoryManager>
  savedFirstFieldsSpace <SpurContiguousObjStack>
  savedFirstFieldsSpaceWasAllocated <Boolean>
  scavenger: <SpurGenerationScavenger>
 
  biasForGC
  - true if compacting for GC, in which case do only one pass, or false if compacting for snapshot, in which case do as many passes as necessary to compact the entire heap.
 
  firstFieldOfRememberedSet
  - the saved first field of the rememberedSet.  The rememberedSet must be relocated specially because it is not a pointer object.  And hence the first field needs to be extracted for proper relocation.
 
  firstFreeObject
  - the first free object in a compaction pass.
 
  firstMobileObject
  - the first mobile object in a compaction.  Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded.
 
  lastMobileObject
  - the last mobile object in a compaction.  Unpinned objects from the firstMobileObject through to the lastMobileObject are implicitly forwarded.
 
  savedFirstFieldsSpace
  - the space holding the saved first fields, each overwritten by a forwarding pointer, for the objects from firstMobileObject through to lastMobileObject.
 
  savedFirstFieldsSpaceWasAllocated
  - if true, the memory for savedFirstFieldsSpace was obtained via a call of sqAllocateMemorySegmentOfSize:Above:AllocatedSizeInto:!

Item was changed:
  ----- Method: SpurPlanningCompactor>>compact (in category 'compaction - api') -----
  compact
  "Sweep all of old space, sliding unpinned marked objects down over free and unmarked objects.
  Let the segmentManager mark which segments contain pinned objects via notePinned:."
+ | onePass firstPass |
- | onePass |
  <inline: #never> "for profiling"
  self initializeScanCheckingForFullyCompactedHeap ifTrue:
  [^self unmarkObjectsInFullyCompactedHeap].
  self initializeCompaction.
+ firstPass := true.
  [onePass := self planCompactSavingForwarders.
  self assert: (self validRelocationPlanInPass: onePass) = 0.
+ objectAfterLastMobileObject := manager objectAfter: lastMobileObject.
  self updatePointers.
+ self copyAndUnmark: firstPass.
- self copyAndUnmark.
  manager checkFreeSpace: GCModeFull.
  onePass or: [biasForGC]] whileFalse:
+ [firstPass := false.
+ self reinitializeScan;
- [self reinitializeScan;
  updateSavedFirstFieldsSpaceIfNecessary].
  self endCompaction!

Item was changed:
  ----- 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)
- (o < 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 changed:
  ----- 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)
- (o < 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).
- self assert: nextFreeObject > 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 changed:
  ----- 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)
- (o < 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 removed:
- ----- Method: SpurPlanningCompactor>>copyAndUnmark (in category 'compaction') -----
- copyAndUnmark
- "Sweep the heap, unmarking all objects and moving mobile objects to their correct positions,
- restoring their savedFirstFields."
- | onePass |
- self logPhase: 'copying and unmarking...'.
- self unmarkInitialImmobileObjects.
- "If savedFirstFieldsSpace is empty there is nothing to move, and no second pass."
- savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
- [self assert: firstMobileObject >= manager endOfMemory.
- ^self].
- onePass := self copyAndUnmarkMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop.
- onePass ifFalse:
- [self unmarkObjectsOverflowingSavedFirstFieldsSpace]!

Item was added:
+ ----- 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 copyAndUnmarkMobileObjectsWithTop: savedFirstFieldsSpace start - manager bytesPerOop.
+ (onePass not and: [biasForGC]) ifTrue: "only ever one pass if biasForGC is true."
+ [self unmarkObjectsAfterLastMobileObject]!

Item was changed:
  ----- 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:
- next >= 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>>initializeScanCheckingForFullyCompactedHeap (in category 'compaction') -----
  initializeScanCheckingForFullyCompactedHeap
+ "Scan for firstFreeObject and firstMobileObject from the start of memory (actually
+ from lastMobileObject so that reInitializeScan can work on subsequent passes).
+ Answer if the heap is already fully compacted.  Set "
+ firstFreeObject := lastMobileObject := manager hiddenRootsObject.
- "Scan for firstFreeObject and firstMobileObject from the start of memory.
- Answer if the heap is already fully compacted."
- firstFreeObject := manager hiddenRootsObject.
  self reinitializeScan.
  ^firstMobileObject >= manager endOfMemory!

Item was changed:
  ----- Method: SpurPlanningCompactor>>numPointerSlotsWhileCompactingOf:withFormat:savedFirstFieldPointer: (in category 'private') -----
+ numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtr
- numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtrOrNil
  "This is a version of SpurMemoryManager>>numPointerSlotsOf: that deals with the
  possibility of obj being a CompiledMethod whose header is in savedFirstFieldsSpace.
  Answer the number of pointer fields in the given object.
  Works with CompiledMethods, as well as ordinary objects."
  <inline: true>
  | contextSize numLiterals header |
+ self assert: (firstFieldPtr notNil and: [self isMobile: obj]).
  fmt <= manager lastPointerFormat ifTrue:
  [(fmt = manager indexablePointersFormat
   and: [manager isContextNonImm: obj]) ifTrue:
  ["contexts end at the stack pointer"
  contextSize := coInterpreter fetchStackPointerOf: obj.
  ^CtxtTempFrameStart + contextSize].
  ^manager numSlotsOf: obj  "all pointers"].
  self deny: fmt = manager forwardedFormat.
  fmt < manager firstCompiledMethodFormat ifTrue: [^0]. "no pointers"
 
  "CompiledMethod: contains both pointers and bytes"
+ header := manager methodHeaderFromSavedFirstField: (manager longAt: firstFieldPtr).
- self assert: firstFieldPtrOrNil notNil == (self isMobile: obj).
- header := firstFieldPtrOrNil
- ifNil: [manager methodHeaderOf: obj]
- ifNotNil: [manager methodHeaderFromSavedFirstField: (manager longAt: firstFieldPtrOrNil)].
  numLiterals := manager literalCountOfMethodHeader: header.
  ^numLiterals + LiteralStart!

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).
  manager allOldSpaceEntitiesFrom: 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: "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:
- next >= 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]]].
  savedFirstFieldsSpace top: top.
  ^true!

Item was changed:
  ----- Method: SpurPlanningCompactor>>reinitializeScan (in category 'compaction') -----
  reinitializeScan
+ "Search for firstFreeObject and firstMobileObject from lastMobileObject (which is
+ set to the hiddenRootsObject on the first pass)."
  firstMobileObject := manager endOfMemory.
+ firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: lastMobileObject.
- firstFreeObject := self scanForFirstFreeAndFirstMobileObjectFrom: firstFreeObject.
  firstFreeObject ifNil:
  [self error: 'uncompactable heap; no unmarked objects found'].
  mobileStart := manager startOfObject: firstFreeObject!

Item was changed:
  ----- Method: SpurPlanningCompactor>>unmarkInitialImmobileObjects (in category 'compaction') -----
  unmarkInitialImmobileObjects
  "Sweep the initial immobile heap, unmarking all objects up to the first mobile object."
  manager allOldSpaceObjectsFrom: manager firstObject do:
  [:o|
  self check: o.
+ (self oop: o isGreaterThanOrEqualTo: firstMobileObject) ifTrue:
- o >= firstMobileObject ifTrue:
  [^self].
  manager setIsMarkedOf: o to: false]!

Item was added:
+ ----- Method: SpurPlanningCompactor>>unmarkObjectsAfterLastMobileObject (in category 'compaction') -----
+ unmarkObjectsAfterLastMobileObject
+ "Sweep the final immobile heap, unmarking all objects up to the end of memory."
+ manager allOldSpaceObjectsFrom: objectAfterLastMobileObject do:
+ [:o|
+ self check: o.
+ manager setIsMarkedOf: o to: false]!

Item was removed:
- ----- Method: SpurPlanningCompactor>>unmarkObjectsOverflowingSavedFirstFieldsSpace (in category 'compaction') -----
- unmarkObjectsOverflowingSavedFirstFieldsSpace
- self shouldBeImplemented!

Item was changed:
  ----- Method: SpurPlanningCompactor>>updatePointersIn:savedFirstFieldPointer: (in category 'compaction') -----
+ updatePointersIn: obj savedFirstFieldPointer: firstFieldPtr
- updatePointersIn: obj savedFirstFieldPointer: firstFieldPtrOrNil
  "Sweep the pointer fields in obj, updating all references to mobile objects to their eventual locations.
+ firstFieldPtr is supplied for mobile objects so that the saved first field can be updated, and so that
- firstFieldPtrOrNil is supplied for mobile objects so that the saved first field can be updated, and so that
  the first field of a compiled method (which is its header, or reference to a CogMethod holding its header)
  can be retrieved."
  <inline: false>
+ | fmt numPointerSlots oop fwd |
- | fmt numPointerSlots |
  fmt := manager formatOf: obj.
+ numPointerSlots := self numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtr.
- numPointerSlots := self numPointerSlotsWhileCompactingOf: obj withFormat: fmt savedFirstFieldPointer: firstFieldPtrOrNil.
  (fmt <= manager lastPointerFormat "excludes CompiledMethod"
  and: [numPointerSlots > 0]) ifTrue:
+ ["Relocate the saved first field; Note that CompiledMethods can be excluded since their
- [| oop fwd |
- "Relocate the saved first field; Note that CompiledMethods can be excluded since their
   first field is either a SmallInteger or a reference to a CogMethod outside of oldSpace."
+ oop := manager longAt: firstFieldPtr.
- oop := manager longAt: firstFieldPtrOrNil.
  ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue:
  [self assert: (manager isMarked: oop).
  fwd := manager fetchPointer: 0 ofObject: oop.
  self assert: (self isPostMobile: fwd).
+ manager longAt: firstFieldPtr put: fwd]].
- manager longAt: firstFieldPtrOrNil put: fwd]].
  1 to: numPointerSlots - 1 do:
+ [:i|
- [:i| | oop fwd |
  oop := manager fetchPointer: i ofObject: obj.
  ((manager isNonImmediate: oop) and: [self isMobile: oop]) ifTrue:
  [self assert: ((manager isMarked: oop) or: [obj = manager hiddenRootsObject]).
  fwd := manager fetchPointer: 0 ofObject: oop.
  self assert: (self isPostMobile: fwd).
  manager storePointerUnchecked: i ofObject: obj withValue: fwd]]!

Item was changed:
  ----- 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:
- next >= 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: SpurPlanningCompactor>>validRelocationPlanInPass: (in category 'private') -----
  validRelocationPlanInPass: onePass
  "Answer 0 if all the mobile objects from firstMobileObject to lastMobileObject
  have sane forwarding addresses, and that savedFirstFieldsSpace is of
  matching capacity.  Otherwise answer an error code identifying the anomaly."
  | nMobiles toFinger |
+ <var: 'toFinger' type: #usqInt>
+ <var: 'destination' type: #usqInt>
  nMobiles := 0.
  toFinger := mobileStart.
  anomaly := nil.
  manager allOldSpaceEntitiesFrom: firstMobileObject do:
  [:o| | destination |
  self check: o.
  (manager isMarked: o) ifTrue:
  [(manager isPinned: o) ifFalse:
  [nMobiles := nMobiles + 1.
  destination := manager fetchPointer: 0 ofObject: o.
  destination >= toFinger ifFalse:
  [anomaly := o. ^1].
  toFinger := toFinger + (manager bytesInObject: o).
+ (self oop: o isGreaterThan: lastMobileObject) ifTrue:
- o > lastMobileObject ifTrue:
  [anomaly := o. ^2].
  o = lastMobileObject ifTrue:
  [^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1
    = nMobiles
  ifTrue: [0]
  ifFalse: [3]]]]].
  ^savedFirstFieldsSpace top - savedFirstFieldsSpace start / manager bytesPerOop + 1
   = nMobiles
  ifTrue: [0]
+ ifFalse: [4]!
- ifFalse: [3]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>fetchByte (in category 'interpreter shell') -----
  fetchByte
+ ^objectMemory byteAt: (localIP := localIP + 1).!
-
- ^ self byteAt: (localIP := localIP + 1).!