[Vm-dev] VM Maker: VMMaker.oscog-eem.2084.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 11 20:42:44 UTC 2017 

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

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

Name: VMMaker.oscog-eem.2084
Author: eem
Time: 11 January 2017, 12:41:55.558042 pm
UUID: 0e65b488-e293-46c3-981c-ceebca23fe1e
Ancestors: VMMaker.oscog-rsf.2083

SpurPlanningCompactor:
Extend the incompactible heap test to test that compaction can be invoked directly avoiding fullGC.

Consequetly, add a test that shows the bug with long runs of pinned objects.

Simplify test setup by moving initializeMarkStack et al into initializedVM.

Refactor savedFirstFieldsSpaceWasAllocated into savedFirstFieldsSpaceNotInOldSpace to neaten the toFinger < top assert.

Fix a slip in SpurSegmentManager>>initialize; sweepIndex should be initialized to zero.

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

Item was added:
+ ----- Method: SpurMemoryManager>>compactor (in category 'accessing') -----
+ compactor
+ 	"This is really only for tests..."
+ 	^compactor!

Item was changed:
  CogClass subclass: #SpurPlanningCompactor
+ 	instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceNotInOldSpace firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject'
- 	instanceVariableNames: 'manager scavenger coInterpreter biasForGC firstFreeObject mobileStart firstMobileObject lastMobileObject savedFirstFieldsSpace savedFirstFieldsSpaceWasAllocated firstFieldOfRememberedSet interestingObj anomaly objectAfterLastMobileObject'
  	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>>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."
  	<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]).
- 		 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 notNil and: [previousPin ~= o]] whileTrue:
- 					 previousPin ifNotNil:
  						[| limit |
  						 limit := manager startOfObject: previousPin.
+ 						 self assert: (limit - toFinger >= (manager allocationUnit * 2) or: [limit = toFinger]).
+ 						 limit > toFinger ifTrue:
+ 							[manager addFreeChunkWithBytes: limit - toFinger at: toFinger.].
- 						 manager addFreeChunkWithBytes: limit - toFinger at: toFinger.
  						 toFinger := manager addressAfter: previousPin.
+ 						 previousPin := manager objectStartingAt: toFinger.
+ 						 ((manager isPinned: previousPin) and: [manager isMarked: previousPin]) ifFalse:
+ 							[previousPin := nil].
  						 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 changed:
  ----- Method: SpurPlanningCompactor>>initialize (in category 'instance initialization') -----
  initialize
  	biasForGC := true.
  	savedFirstFieldsSpace := SpurContiguousObjStack new.
+ 	savedFirstFieldsSpaceNotInOldSpace := true!
- 	savedFirstFieldsSpaceWasAllocated := false!

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).
  
  	 This enumeration matches those in updatePointersInMobileObjects and copyAndUnmarkMobileObjects."
  	<inline: #never>
  	| toFinger top previousPin |
  	<var: 'top' type: #usqInt>
  	<var: 'toFinger' type: #usqInt>
  	savedFirstFieldsSpace top < savedFirstFieldsSpace start ifTrue:
  		[self logPhase: 'planning...'].
  	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: (savedFirstFieldsSpaceNotInOldSpace or: [toFinger < top]).
- 		 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 notNil and: [previousPin ~= o]] whileTrue:
+ 						[self assert: ((manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2)
+ 									or: [(manager startOfObject: previousPin) = toFinger]).
- 					[previousPin ifNotNil:
- 						[self assert: (manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2).
  						 toFinger := manager addressAfter: previousPin.
+ 						 previousPin := manager objectStartingAt: toFinger.
+ 						 ((manager isPinned: previousPin) and: [manager isMarked: previousPin])
+ 							ifTrue: [toFinger := manager addressAfter: previousPin]
+ 							ifFalse: [previousPin := nil]].
- 						 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."
  						 toFinger := manager addressAfter: previousPin.
  						 next := manager objectStartingAt: 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.
  	^true!

Item was changed:
  ----- Method: SpurPlanningCompactor>>releaseSavedFirstFieldsSpace (in category 'space management') -----
  releaseSavedFirstFieldsSpace
  	<inline: true>
+ 	self savedFirstFieldsSpaceWasAllocated ifTrue:
- 	savedFirstFieldsSpaceWasAllocated ifTrue:
  		[manager
  			sqDeallocateMemorySegmentAt: savedFirstFieldsSpace start asVoidPointer
+ 			OfSize: savedFirstFieldsSpace limit - savedFirstFieldsSpace start]!
- 			OfSize: savedFirstFieldsSpace limit - savedFirstFieldsSpace start.
- 		 savedFirstFieldsSpaceWasAllocated := false]!

Item was added:
+ ----- Method: SpurPlanningCompactor>>savedFirstFieldsSpaceInFreeChunk (in category 'space management') -----
+ savedFirstFieldsSpaceInFreeChunk
+ 	<inline: true>
+ 	^savedFirstFieldsSpaceNotInOldSpace not and: [savedFirstFieldsSpace start >= manager nilObject]!

Item was added:
+ ----- Method: SpurPlanningCompactor>>savedFirstFieldsSpaceWasAllocated (in category 'space management') -----
+ savedFirstFieldsSpaceWasAllocated
+ 	<inline: true>
+ 	^savedFirstFieldsSpaceNotInOldSpace and: [savedFirstFieldsSpace start >= manager nilObject]!

Item was changed:
  ----- 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 notNil and: [previousPin ~= o]] whileTrue:
+ 						[self assert: ((manager startOfObject: previousPin) - toFinger >= (manager allocationUnit * 2)
+ 									or: [(manager startOfObject: previousPin) = toFinger]).
+ 						 toFinger := manager addressAfter: previousPin.
+ 						 previousPin := manager objectStartingAt: toFinger.
+ 						 ((manager isPinned: previousPin) and: [manager isMarked: previousPin]) ifFalse:
+ 							[previousPin := nil].
+ 						 self assert: toFinger <= (manager startOfObject: 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 changed:
  ----- Method: SpurPlanningCompactor>>updateSavedFirstFieldsSpaceIfNecessary (in category 'space management') -----
  updateSavedFirstFieldsSpaceIfNecessary
  	"If savedFirstFieldsSpace is a free chunk then it may need to be repositioned if there is more than one pass."
+ 	<inline: true>
+ 	self savedFirstFieldsSpaceInFreeChunk ifTrue:
- 
- 	((manager isInOldSpace: savedFirstFieldsSpace start)
- 	 and: [savedFirstFieldsSpaceWasAllocated not]) ifTrue:
  		[self useFreeChunkForSavedFirstFieldsSpace: manager findLargestFreeChunk].
  
  	savedFirstFieldsSpace top: savedFirstFieldsSpace start - manager bytesPerOop.
  	manager resetFreeListHeads!

Item was changed:
  ----- Method: SpurPlanningCompactor>>useEdenForSavedFirstFieldsSpace (in category 'space management') -----
  useEdenForSavedFirstFieldsSpace
  	"Use teden to hold the savedFirstFieldsSpace."
  	<inline: true>
  	savedFirstFieldsSpace
  		start: scavenger eden start;
+ 		limit: scavenger eden limit.
+ 	savedFirstFieldsSpaceNotInOldSpace := true.
+ 	self deny: self savedFirstFieldsSpaceWasAllocated!
- 		limit: scavenger eden limit!

Item was changed:
  ----- Method: SpurPlanningCompactor>>useFreeChunkForSavedFirstFieldsSpace: (in category 'space management') -----
  useFreeChunkForSavedFirstFieldsSpace: highestSuitableFreeBlock
  	"Use the supplied free chunk to hold the savedFirstFieldsSpace. Invoked when
  	 eden is found not to be big enough for the job. Avoid the first few fields so as
  	 not to destroy the free chunk and there by confuse object enumeration."
  	<inline: true>
  	savedFirstFieldsSpace
  		start: highestSuitableFreeBlock + (manager freeChunkLargerIndex * manager bytesPerOop);
+ 		limit: (manager addressAfter: highestSuitableFreeBlock).
+ 	savedFirstFieldsSpaceNotInOldSpace := false.
+ 	self deny: self savedFirstFieldsSpaceWasAllocated!
- 		limit: (manager addressAfter: highestSuitableFreeBlock)!

Item was changed:
  ----- Method: SpurPlanningCompactor>>useSegmentForSavedFirstFieldsSpace: (in category 'space management') -----
  useSegmentForSavedFirstFieldsSpace: spaceEstimate
  	"Attempt to allocate a memory segment large enough to hold the savedFirstFieldsSpace.
+ 	 Invoked when neither eden nor a large free chunk are found to be big enough for the job."
- 	 Invoked when neither eden nor a large free chunk are found to be big enough for the
- 	 job."
  	| allocatedSize |
  	(manager "sent to the manager so that the simulator can increase memory to simulate a new segment"
  		sqAllocateMemorySegmentOfSize: spaceEstimate
  		Above: (self firstGapOfSizeAtLeast: spaceEstimate)
  		AllocatedSizeInto: (self cCode: [self addressOf: allocatedSize]
  								inSmalltalk: [[:sz| allocatedSize := sz]])) ifNotNil:
  		[:segAddress|
- 		 savedFirstFieldsSpaceWasAllocated := true.
  		 savedFirstFieldsSpace
  			start: segAddress;
  			limit: segAddress + allocatedSize.
+ 		 savedFirstFieldsSpaceNotInOldSpace := true.
+ 		 self assert: self savedFirstFieldsSpaceWasAllocated.
  		 ^true].
  	^false!

Item was changed:
  TestCase subclass: #SpurPlanningCompactorTests
  	instanceVariableNames: 'emptyVM'
  	classVariableNames: ''
+ 	poolDictionaries: 'VMSqueakClassIndices'
- 	poolDictionaries: ''
  	category: 'VMMaker-Tests'!

Item was added:
+ ----- Method: SpurPlanningCompactorTests class>>defaultIntegerBaseInDebugger (in category 'debugger') -----
+ defaultIntegerBaseInDebugger
+ 	^VMClass defaultIntegerBaseInDebugger!

Item was changed:
  ----- Method: SpurPlanningCompactorTests>>initializedVM (in category 'private') -----
  initializedVM
+ 	| newVM |
+ 	newVM := emptyVM cloneSimulation.
+ 	newVM
- 	^emptyVM cloneSimulation
  		openOn: self class imageNameForTests extraMemory: 0;
+ 		initStackPages.
+ 	newVM objectMemory
+ 		initializeMarkStack; "The Pharo bootstrap has no mark or weakling stacks :-)"
+ 		initializeWeaklingStack.
+ 	^newVM!
- 		initStackPages;
- 		yourself!

Item was changed:
  ----- Method: SpurPlanningCompactorTests>>testIncompactibleHeap (in category 'tests') -----
  testIncompactibleHeap
  	| errored |
  	errored := false.
+ 	"First test for incompactibility via fullGC"
  	[self initializedVM objectMemory
- 		initializeMarkStack; "The Pharo bootstrap has no mark or weakling stacks :-)"
- 		initializeWeaklingStack;
  		abandonEmptySegmentForTests;
  		fullGC]
  		on: Error
  		do: [:ex|
  			errored := true.
  			self assert: ex messageText = 'uncompactable heap; no unmarked objects found'].
+ 	self assert: errored.
+ 
+ 	"Now check for incompactibility by directly calling compact"
+ 	errored := false.
+ 	"First test for incompactibility via fullGC"
+ 	[| om |
+ 	 om := self initializedVM objectMemory.
+ 	 om abandonEmptySegmentForTests.
+ 	 om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true].
+ 	 om compactor compact]
+ 		on: Error
+ 		do: [:ex|
+ 			errored := true.
+ 			self assert: ex messageText = 'uncompactable heap; no unmarked objects found'].
  	self assert: errored!

Item was added:
+ ----- Method: SpurPlanningCompactorTests>>testRunOfContiguousPinnedObjects (in category 'tests') -----
+ testRunOfContiguousPinnedObjects
+ 	"Test that the compactor can handle a long run of adjacent pinned objects across which it can and must move some unpinned objects."
+ 	| om expectedFreeSpace firstPinnedObj gapObj obj |
+ 	om := self initializedVM objectMemory.
+ 	om allOldSpaceObjectsDo: [:o| om setIsMarkedOf: o to: true].
+ 	"First create a gap"
+ 	gapObj := om allocateSlotsInOldSpace: 100 format: om firstLongFormat classIndex: ClassArrayCompactIndex.
+ 	om fillObj: gapObj numSlots: 100 with: om falseObject.
+ 	"Now a long run of pinned objects."
+ 	50 timesRepeat:
+ 		[obj := om allocateSlotsInOldSpace: 4 format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+ 		 om
+ 			fillObj: obj numSlots: 4 with: 16r99999999;
+ 			setIsPinnedOf: obj to: true;
+ 			setIsMarkedOf: obj to: true.
+ 		 firstPinnedObj ifNil:
+ 			[firstPinnedObj := obj]].
+ 	"Now something to move around it."
+ 	obj := om allocateSlotsInOldSpace: 100 format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+ 	om fillObj: obj numSlots: 100 with: 16r55AA55AA;
+ 		setIsMarkedOf: obj to: true.
+ 	"And something to move to the end of it."
+ 	obj := om allocateSlotsInOldSpace: 100 format: om firstLongFormat classIndex: ClassBitmapCompactIndex.
+ 	om fillObj: obj numSlots: 100 with: 16rAA55AA55;
+ 		setIsMarkedOf: obj to: true.
+ 
+ 
+ 	expectedFreeSpace := om bytesLeftInOldSpace + (om bytesInObject: gapObj).
+ 	om compactor compact.
+ 	self assert: expectedFreeSpace equals: om bytesLeftInOldSpace.
+ 	om allOldSpaceObjectsDo: [:o| self deny: (om isMarked: o)].
+ 
+ 	"The first mobile object past the pinned objects should have moved."
+ 	self assert: ClassBitmapCompactIndex equals: (om classIndexOf: gapObj).
+ 	self deny: (om isPinned: gapObj). 
+ 	0 to: 99 do: [:i| self assert: 16r55AA55AA equals: (om fetchPointer: i ofObject: gapObj)].
+ 	"The pinned objects should not have moved."
+ 	obj := firstPinnedObj.
+ 	50 timesRepeat:
+ 		[self assert: ClassBitmapCompactIndex equals: (om classIndexOf: obj).
+ 		 0 to: 3 do: [:i| self assert: 16r99999999 equals: (om fetchPointer: i ofObject: obj)].
+ 		 obj := om objectAfter: obj].
+ 	"The last object should have moved down."
+ 	self assert: ClassBitmapCompactIndex equals: (om classIndexOf: obj).
+ 	self deny: (om isPinned: obj). 
+ 	0 to: 99 do: [:i| self assert: 16rAA55AA55 equals: (om fetchPointer: i ofObject: obj)].
+ 	"It should be the last object..."
+ 	self assert: (om isFreeObject: (om objectAfter: obj)).
+ 	self assert: om endOfMemory equals: (om addressAfter: (om objectAfter: obj))
+ 		!

Item was changed:
  ----- Method: SpurSegmentManager>>initialize (in category 'initialization') -----
  initialize
+ 	numSegments := numSegInfos := sweepIndex := 0.
- 	numSegments := numSegInfos := 0.
  	canSwizzle := false!

More information about the Vm-dev mailing list