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

Sat Dec 10 04:39:39 UTC 2022

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

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

Name: VMMaker.oscog.seperateMarking-eem.3285
Author: eem
Time: 9 December 2022, 8:39:24.945581 pm
UUID: 5f310817-3af2-4f0c-98e4-720ab7e1305c
Ancestors: VMMaker.oscog.seperateMarking-eem.3284

Add an assert to SpurIncrementalCompactor>>#markSegmentAsBeingCompacted: to check there is more than one segment and that we're not trying to compact/free the first segment.

Add an accessor for getting a pointer to a segment (manager/segmentManager seginfoAt:).

=============== Diff against VMMaker.oscog.seperateMarking-eem.3284 ===============

Item was changed:
  ----- Method: SpurIncrementalCompactor>>assertNoSegmentBeingCompacted (in category 'testing') -----
  assertNoSegmentBeingCompacted
  	"Assertion only - no segment is being claimed at this point. All being compacted bits get cleared during sweeping when setting the occupation of the segments"
  	| segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 self deny: (self isSegmentBeingCompacted: segInfo).
  		(self isSegmentBeingCompacted: segInfo)
  			ifTrue: [self cCode: 'raise(SIGINT)']].!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>completeCompact (in category 'as yet unclassified') -----
  completeCompact

  	| segInfo |
  	self initCompactionIfNecessary.

  	0 to: manager numSegments - 1 do:
  		[:i | 
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		(self isSegmentBeingCompacted: segInfo)
  			ifTrue: [currentSegment := i.
  				currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i.
  				self assert: (self oop: currentHeapPointer isLessThan: (segmentToFill segLimit - manager bridgeSize))]].

  	self postCompactionAction.
  	self finishCompaction.!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>doIncrementalCompact (in category 'incremental compaction') -----
  doIncrementalCompact

  	<inline: #never>
  	| segInfo |
  	currentSegment to: manager numSegments - 1 do:
  		[:i | 
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		(self isSegmentBeingCompacted: segInfo)
  			ifTrue: [currentSegment := i.

  				coInterpreter cr; 
  					print: 'Compact from: '; printHex: segInfo segStart; 
  					print: '  to: '; printHex: segInfo segStart + segInfo segSize; 
  					print: '  into: ' ; printHex: segmentToFill segStart; tab; flush.

  				currentHeapPointer := self compactSegment: segInfo freeStart: currentHeapPointer segIndex: i.
  				self assert: manager totalFreeOldSpace = manager totalFreeListBytes.
  				self assert: (self oop: currentHeapPointer isLessThan: (segmentToFill segLimit - manager bridgeSize)).

  				"guarantee heap parsability for the segmentToFill, for example when invoking checkHeapFreeSpaceIntegrityForIncrementalGC where we walk to whole heap and could enter segmentToFill in an invalid state"
  				self occupyRestOfFreeCompactedIntoSegment.

  				coInterpreter cr; 
  					print: 'Pointer now: '; printHex: currentHeapPointer; tab; flush.

  				self flag: #Todo. "for now we compact one segment at a time"
  				^ currentSegment = (manager numSegments - 1)
  					ifTrue: [true]
  					ifFalse: [false]]].
  	^ true!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>findAndSetSegmentToFill (in category 'segment to fill') -----
  findAndSetSegmentToFill
  	| segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i| 
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		(self segmentIsEmpty: segInfo)
  			ifTrue: [segmentToFill := segInfo. ^i]].
  	^-1!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>findNextSegmentToCompact (in category 'compaction planning') -----
  findNextSegmentToCompact
  	"Answers the next segment to compact or nil if none.
  	  The next segment to compact:
  	 - cannot be segment 0 (Segment 0 has specific objects 
  	  (nil, true, etc.) and special size computed at start-up 
  	  that we don't want to deal with)
  	 - cannot have a high occupation rate (> MaxOccupationForCompaction)"
  	| leastOccupied leastOccupiedSegment tempOccupied segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	leastOccupied := 16rFFFF.
  	1 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 (self cannotBeCompacted: segInfo)
  			ifFalse: 
  				[(tempOccupied := self occupationOf: segInfo) <= leastOccupied
  					ifTrue: [ leastOccupied := tempOccupied.
  							 leastOccupiedSegment := segInfo ]]].
  	leastOccupied > MaxOccupationForCompaction ifTrue:
  		[^self cCoerceSimple: nil to: #'SpurSegmentInfo *'].
  	^leastOccupiedSegment!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>freePastSegmentsAndSetSegmentToFill (in category 'api') -----
  freePastSegmentsAndSetSegmentToFill	
  	"The first segment being claimed met becomes the segmentToFill. The others are just freed."
  	| segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
+ 		 (self isSegmentBeingCompacted: segInfo) ifTrue: 
+ 			[ | freeChunk chunkBytes |
+ 			coInterpreter
+ 				cr; print: 'freeing segment from: '; printHex: segInfo segStart;
+ 				print: ' to: '; printHex: segInfo segStart + segInfo segSize ;tab; flush.
+ 			chunkBytes := segInfo segSize - manager bridgeSize.
+ 			freeChunk := manager 
+ 				addFreeChunkWithBytes: chunkBytes 
+ 				at: segInfo segStart.
+ 			 segmentToFill  ifNil:
+ 				[manager detachFreeObject: freeChunk.
+ 				 segmentToFill := segInfo]]]!
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
- 		 (self isSegmentBeingCompacted: segInfo)
- 			ifTrue: 
- 				[ | freeChunk chunkBytes |
- 				coInterpreter cr; print: 'freeing segment from: '; printHex: segInfo segStart; print: ' to: ';
- 		 printHex: segInfo segStart + segInfo segSize ;tab; flush.
- 				chunkBytes := segInfo segSize - manager bridgeSize.
- 				freeChunk := manager 
- 					addFreeChunkWithBytes: chunkBytes 
- 					at: segInfo segStart.
- 				 segmentToFill 
- 					ifNil: [manager detachFreeObject: freeChunk.
- 						segmentToFill := segInfo]]]!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>markSegmentAsBeingCompacted: (in category 'segment access') -----
  markSegmentAsBeingCompacted: segInfo 
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	"Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation"
+ 	self assert: (manager numSegments > 1 and: [segInfo ~= (manager segInfoAt: 0)]).
  	segInfo swizzle: (segInfo swizzle bitOr: 1 << 16)!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>postSwizzleAction (in category 'api') -----
  postSwizzleAction
  	"Since the compact abuses the swizzle field of segment, it needs to be reset after start-up."

  	| segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 segInfo swizzle: 0 ]!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>canReactToShiftSegment:to: (in category 'as yet unclassified') -----
  canReactToShiftSegment: segmentAddress to: anIndex
  	"because we have a pointer to segmentToFill changes in the segments array (where segmentToFill is pointing to) can
  	invalidate our pointer (it now points to an incorrect segment). Therefore react to this change and set the segmentToFill to 
  	the new address"

  	segmentAddress = compactor segmentToFill
  		ifTrue: [
+ 			compactor setSegmentToFillToAddress: (manager segInfoAt: anIndex)]!
- 			compactor setSegmentToFillToAddress: (self addressOf: (manager segmentManager segments at: anIndex))]!

Item was changed:
  ----- Method: SpurIncrementalSweeper>>setOccupationAtIndex:used:unused: (in category 'compactor support') -----
  setOccupationAtIndex: segmentIndex used: used unused: unused
  	"WARNING: Resets the isCompacted bit"
  	"Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation
  	 Setting occupation resets the claim bit"
  	| occupation segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 	segInfo := manager segInfoAt: segmentIndex.
- 	segInfo := self addressOf: (manager segmentManager segments at: segmentIndex).
  	"careful with overflow here..."
  	occupation := ((used asFloat / (used + unused)) * 16rFFFF) asInteger.
  	self assert: (occupation between: 0 and: 16rFFFF).
  	segInfo swizzle: occupation!

Item was added:
+ ----- Method: SpurMemoryManager>>segInfoAt: (in category 'segments') -----
+ segInfoAt: zeroRelativeIndex
+ 	<doNotGenerate>
+ 	^segmentManager segInfoAt: zeroRelativeIndex!

Item was added:
+ ----- Method: SpurSegmentManager>>segInfoAt: (in category 'accessing') -----
+ segInfoAt: zeroRelativeIndex
+ 	<inline: #always>
+ 	^self addressOf: (segments at: zeroRelativeIndex)!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>assertNoSegmentBeingCompacted (in category 'compaction') -----
  assertNoSegmentBeingCompacted
  	"Assertion only - no segment is being claimed at this point"
  	| segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 self deny: (self isSegmentBeingCompacted: segInfo)].
  	!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>compactSegmentsToCompact (in category 'compaction') -----
  compactSegmentsToCompact
  	"Forwards all objects in segments to compact and removes their freechunks"
  	| segInfo fillStart |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	fillStart := segmentToFill segStart.

  	 "Removes initial free chunk in segment to fill... (Segment is entirely free)"
  	manager detachFreeObject: (manager objectStartingAt: fillStart).

  	 "Compact each segment to compact..."
  	0 to: manager numSegments - 1 do:
  		[:i| 
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		(self isSegmentBeingCompacted: segInfo)
  			ifTrue: [fillStart := self compactSegment: segInfo freeStart: fillStart segIndex: i]].

  	 "Final free chunk in segment to fill..."
  	 manager 
  		addFreeChunkWithBytes: segmentToFill segSize - manager bridgeSize + segmentToFill segStart - fillStart 
  		at: fillStart.

  	self postCompactionAction
  	!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>findAndSetSegmentToFill (in category 'segment to fill') -----
  findAndSetSegmentToFill
  	| segInfo firstEntity |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i| 
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 firstEntity := manager objectStartingAt: segInfo segStart.
  		 ((manager isFreeObject: firstEntity) and: [(manager objectAfter: firstEntity limit: manager endOfMemory) = (manager segmentManager bridgeFor: segInfo)])
  			ifTrue: [segmentToFill := segInfo. ^i]].
  	^-1
  	!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>findNextSegmentToCompact (in category 'compaction') -----
  findNextSegmentToCompact
  	"Answers the next segment to compact or nil if none.
  	  The next segment to compact:
  	 - cannot be segment 0 (Segment 0 has specific objects 
  	  (nil, true, etc.) and special size computed at start-up 
  	  that we don't want to deal with)
  	 - cannot have a high occupation rate (> MaxOccupationForCompaction)"
  	| leastOccupied leastOccupiedSegment tempOccupied segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	leastOccupied := 16rFFFF.
  	1 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 ((self isSegmentBeingCompacted: segInfo) or: [segInfo containsPinned or: [manager segmentManager isEmptySegment: segInfo] ])
  			ifFalse: 
  				[(tempOccupied := self occupationOf: segInfo) <= leastOccupied
  					ifTrue: [ leastOccupied := tempOccupied.
  							 leastOccupiedSegment := segInfo ]]].
  	leastOccupied > MaxOccupationForCompaction ifTrue:
  		[^self cCoerceSimple: nil to: #'SpurSegmentInfo *'].
  	^leastOccupiedSegment!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>freePastSegmentsAndSetSegmentToFill (in category 'segment access') -----
  freePastSegmentsAndSetSegmentToFill	
  	"The first segment being claimed met becomes the segmentToFill. The others are just freed."
  	| segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	segmentToFill := nil.
  	0 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 (self isSegmentBeingCompacted: segInfo)
  			ifTrue: 
  				[manager 
  					initFreeChunkWithBytes: segInfo segSize - manager bridgeSize 
  					at: segInfo segStart.
  				 segmentToFill ifNil: [segmentToFill := segInfo]]]!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>lastLilliputianChunkAtIndex: (in category 'segment access') -----
  lastLilliputianChunkAtIndex: segIndex
  	<inline: true>
  	"Abuse lastFreeObject field, can be used during compaction only, used for different purpose during snapshot"
+ 	^(manager segInfoAt: 0) lastFreeObject!
- 	^(self addressOf: (manager segmentManager segments at: 0)) lastFreeObject!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>postSwizzleAction (in category 'api') -----
  postSwizzleAction
  	"Since the compact abuses the swizzle field of segment, it needs to be reset after start-up."
  	| segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i|
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 segInfo swizzle: 0 ]!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>setLastLilliputianChunkAtindex:to: (in category 'segment access') -----
  setLastLilliputianChunkAtindex: segIndex to: chunk 
  	<inline: true>
  	"Abuse lastFreeObject field, can be used during compaction only, used for different purpose during snapshot"
+ 	(manager segInfoAt: 0) lastFreeObject: chunk!
- 	(self addressOf: (manager segmentManager segments at: 0)) lastFreeObject: chunk!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>setOccupationAtIndex:used:unused: (in category 'segment access') -----
  setOccupationAtIndex: segmentIndex used: used unused: unused
  	"WARNING: Resets the isCompacted bit"
  	"Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation
  	 Setting occupation resets the claim bit"
  	| occupation segInfo |
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 	segInfo := manager segInfoAt: segmentIndex.
- 	segInfo := self addressOf: (manager segmentManager segments at: segmentIndex).
  	"careful with overflow here..."
  	occupation := ((used asFloat / (used + unused)) * 16rFFFF) asInteger.
  	self assert: (occupation between: 0 and: 16rFFFF).
  	segInfo swizzle: occupation!

Item was changed:
  ----- Method: SpurSelectiveCompactorSimulator>>checkSegmentsIterable (in category 'debugging') -----
  checkSegmentsIterable
  	"Check only 1 free object at the end or none.
  	 Check segment is iterable until bridge"
  	| currentEntity bridge |
  	self talk: 'Checking segments iterable'.
  	0 to: manager numSegments - 1 do:
  		[:i| | segInfo |
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 bridge := manager segmentManager bridgeFor: segInfo.
  		 currentEntity := manager objectStartingAt: segInfo segStart.
  		 [self oop: currentEntity isLessThan: bridge] whileTrue: 
  			[currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
  		 "End of iteration should end on bridge"
  		 self assert: currentEntity = bridge.].
  	self talkNoCr: ' OK'.!

Item was changed:
  ----- Method: SpurSelectiveCompactorSimulator>>globalSweepAndSegmentOccupationAnalysis (in category 'sweep phase') -----
  globalSweepAndSegmentOccupationAnalysis
  	super globalSweepAndSegmentOccupationAnalysis.
  	self talk: 'Occupation map: '.
  	0 to: manager numSegments - 1 do:
  		[:i| | segInfo |
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		 self talkNoCr: i.
  		 self talkNoCr: '->'.
  		 self talkNoCr: (self occupationOf: segInfo) printString.
  		 self talkNoCr: '('.
  		 self talkNoCr: ((self occupationOf: segInfo) * 100 * 100 // 16rFFFF / 100) asFloat printString.
  		 self talkNoCr: '%);'].
  	self checkSegmentsIterable.
  	!

Item was changed:
  ----- Method: SpurSelectiveCompactorSimulator>>tellMeWhichSegmentsAreBeingCompacted (in category 'debugging') -----
  tellMeWhichSegmentsAreBeingCompacted
  	<doNotGenerate> 
  	| beingCompacted |
  	beingCompacted := OrderedCollection new.
  	0 to: manager numSegments - 1 do:
  		[:i| | segInfo |
+ 		 segInfo := manager segInfoAt: i.
- 		 segInfo := self addressOf: (manager segmentManager segments at: i).
  		(self isSegmentBeingCompacted: segInfo) ifTrue: [beingCompacted add: segInfo]].
  	self 
  		talk: 'Segment being compacted: ' , 
  			(beingCompacted collect: [:seg | 
  				manager segmentManager indexOfSegment: seg ]) asArray printString
  	!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveGCInfo (in category 'system control primitives') -----
  primitiveGCInfo
  	"VM parameters are numbered as follows:
  	0    stopTheWorld (0) or incremental gc (1)
  	1    if incremental gc: current gc phase -> 0 marking; 1 sweeping; 2 compacting
  		if stopTheWorld -> -1
  	2	eden start
  	3    eden limit
  	4	freeStart
  	5	scavengeThreshold
  	6    amount of old space segments
  	"

  	| result staticCount oldSpaceSegmentCount segmentInfoCount |
  	staticCount := 8.
  	segmentInfoCount := 5.
  	oldSpaceSegmentCount := objectMemory numSegments.
  	result := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: staticCount + (oldSpaceSegmentCount * segmentInfoCount).

  	objectMemory storePointerUnchecked: 0	ofObject: result withValue: (objectMemory integerObjectOf: (objectMemory gc isIncremental ifTrue: [1] ifFalse: [0])).
  	objectMemory storePointerUnchecked: 1	ofObject: result withValue: (objectMemory 
  		integerObjectOf: (objectMemory gc isIncremental 
  								ifTrue: [objectMemory gc phase]
  								ifFalse: [-1])).

  	objectMemory storePointerUnchecked: 2	ofObject: result withValue: (objectMemory integerObjectOf: objectMemory scavenger eden start).
  	objectMemory storePointerUnchecked: 3	ofObject: result withValue: (objectMemory integerObjectOf: objectMemory scavenger eden limit).
  	objectMemory storePointerUnchecked: 4	ofObject: result withValue: (objectMemory integerObjectOf: objectMemory freeStart).
  	objectMemory storePointerUnchecked: 5	ofObject: result withValue: (objectMemory integerObjectOf: objectMemory scavengeThreshold).
  	objectMemory storePointerUnchecked: 6	ofObject: result withValue: (objectMemory integerObjectOf: objectMemory statSurvivorCount).

  	objectMemory storePointerUnchecked: 7	ofObject: result withValue: (self positiveMachineIntegerFor: oldSpaceSegmentCount).

  	0 to: oldSpaceSegmentCount - 1
  		do: [:index | | baseIndex segInfo |
+ 			segInfo := objectMemory segInfoAt: index.
- 			segInfo := self addressOf: (objectMemory segmentManager segments at: index).
  			baseIndex := staticCount + (index * segmentInfoCount).

  			objectMemory storePointerUnchecked: baseIndex ofObject: result withValue: (objectMemory integerObjectOf: segInfo segStart).
  			objectMemory storePointerUnchecked: baseIndex + 1 ofObject: result withValue: (objectMemory integerObjectOf: segInfo segSize).
  			objectMemory storePointerUnchecked: baseIndex + 2 ofObject: result withValue: (objectMemory integerObjectOf: (segInfo swizzle bitAnd: 16rFFFF)).
  			objectMemory storePointerUnchecked: baseIndex + 3 ofObject: result withValue: (objectMemory integerObjectOf: segInfo containsPinned).
  			objectMemory storePointerUnchecked: baseIndex + 4 ofObject: result withValue: (objectMemory integerObjectOf: (segInfo swizzle bitOr: 1 << 16))].

  	objectMemory beRootIfOld: result.
  	self methodReturnValue: result!