[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-WoC.3303.mcz

[commits at source.squeak.org]

Tom Braun uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-WoC.3303.mcz

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

Name: VMMaker.oscog.seperateMarking-WoC.3303
Author: WoC
Time: 12 January 2023, 11:43:30.923995 pm
UUID: b4c2b3e1-ea83-416b-9846-5eb06f6d112a
Ancestors: VMMaker.oscog.seperateMarking-eem.3302

assert segmentToFill is in the segments array and update segmentToFill when the segments array shifts position

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

Item was added:
+ ----- Method: SpurGarbageCollector>>noteReallocOfSegmentsArray: (in category 'as yet unclassified') -----
+ noteReallocOfSegmentsArray: aBlock
+ 
+ 	self shouldBeImplemented!

Item was added:
+ ----- Method: SpurIncrementalCompactingSweeper>>assertSegmentToFillIsInSegmentsArray (in category 'as yet unclassified') -----
+ assertSegmentToFillIsInSegmentsArray
+ 
+ 	| segInfo |
+ 	segmentToFill ifNil: [^ self].
+ 	
+ 	segInfo := manager segInfoAt: manager numSegments - 1.
+ 
+ 	self assert: (manager segmentManager segments <= segmentToFill and: [segmentToFill <= segInfo]).
+ 	
+ 	(manager segmentManager segments <= segmentToFill and: [segmentToFill <= segInfo])
+ 		ifFalse: [manager debugger]!

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

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>freePastSegmentsAndSetSegmentToFill (in category 'api') -----
  freePastSegmentsAndSetSegmentToFill	
  	
  	"The first segment being claimed met becomes the segmentToFill. The others are just freed."
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	0 to: manager numSegments - 1 do:
  		[:i| | segInfo |
  		 segInfo := manager segInfoAt: i.
  		(self wasSegmentsCompactionAborted: segInfo)
  			ifTrue: [ | freeUntil chunkBytes |
  				freeUntil := manager startOfObject: (self getEndOfCompaction: segInfo).
  				chunkBytes := freeUntil - segInfo segStart.
  				
  				"maybe we could not even move one object out of the segment. Make sure we do not produce an invalid free chunk"
  				chunkBytes > 0
  					ifTrue: [coInterpreter
  								cr; print: 'partially freeing segment from: '; printHex: segInfo segStart;
  								print: ' to: '; printHex: freeUntil ;tab; flush.
  							
  								manager 
  									addFreeChunkWithBytes: chunkBytes 
  									at: segInfo segStart]].
  		 
  		(self isSegmentBeingCompacted: segInfo) ifTrue: 
  			[ | freeChunk chunkBytes |
  			self assert: (manager segmentManager allObjectsAreForwardedInSegment: segInfo includingFreeSpace: false).
  			self assert: (manager noElementOfFreeSpaceIsInSegment: segInfo).
  			
  			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.
  				
  			self unmarkSegmentAsBeingCompacted: segInfo.
  				
  			 segmentToFill ifNil:
  				[manager detachFreeObject: freeChunk.
+ 				 segmentToFill := segInfo.
+ 				self assertSegmentToFillIsInSegmentsArray]]]!
- 				 segmentToFill := segInfo]]]!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'api') -----
  incrementalSweepAndCompact
  
  	scStartTime := coInterpreter ioUTCMicrosecondsNow.
  	self initIfNecessary.
  	
+ 	self assertSegmentToFillIsInSegmentsArray.
+ 	
  	"should in between sweeper calls segments be removed the index would not be correct anymore. Reset it here so we can be sure it is correct"
  	currentSegmentsIndex := manager segmentManager segmentIndexContainingObj: currentObject.
  	"if the bridge between segments was small before and the segment directly after the current one was removed the position of the bridge moved. Update 
  	the current position to avoid this case"
  	currentSegmentsBridge := manager segmentManager bridgeAt: currentSegmentsIndex.
  	
  	" so expensive :(
  	self assert: manager validObjectColors."
  	
  	coInterpreter cr; 
  		print: 'Starting up '; 
  		printNum: coInterpreter ioUTCMicrosecondsNow - scStartTime ; tab.
  	
  	self doincrementalSweepAndCompact
  		ifTrue: [self finishSweepAndCompact.
  			^ true].
  		
  	"do not end on a bridge!! If a segment behind the current one currentObject is removed the size of the bridge can change from 8 bytes to 16 bytes and
  	therefore invalidating currentObject that is now pointing to the overflow header instad of the bridges body. To not hove to implement some finicky update
  	mechanism in the removal of segments just make sure we never reference the bridge before giving back the control to the mutator"
  	self assert: (manager isSegmentBridge: currentObject) not.
  	
  	"skip empty segments. There is no work for us to do + they can be removed. As currentObject is always in the current segment
  	it won't be valid anymore"
  	self assert: (manager segmentManager isEmptySegment: self currentSegment) not.
  		
  	coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush.
  		
  	^ false!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>setSegmentToFillToAddress: (in category 'segment to fill') -----
  setSegmentToFillToAddress: segInfo
  	"part of canReactToShiftSegment:to:. We cannot make any assertions, as the segment still has to be moved in the segments array
  	and right at this moment we do not point to the right address, but we will in a moment (see removeSegment: and canReactToShiftSegment:to: or insertSegmentFor: that brings us to this method to understand better)"
  
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 	segmentToFill := segInfo.
+ 	
+ 	self assertSegmentToFillIsInSegmentsArray!
- 	segmentToFill := segInfo!

Item was changed:
+ ----- Method: SpurIncrementalGarbageCollector>>canReactToShiftSegment:to: (in category 'compactor support') -----
- ----- 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)]!

Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>noteReallocOfSegmentsArray: (in category 'compactor support') -----
+ noteReallocOfSegmentsArray: aBlock
+ 	"when the segments array gets bigger than a certain size it has to be resized, i.e. reallocated which can (probably will) move
+ 	the segments array to another location in memory. As the compactor sometimes holds a pointer to  one of the elements of
+ 	this array we need to update the pointer in this case "
+ 
+ 	<inline: #always>
+ 	compactor segmentToFill 
+ 		ifNil: [aBlock value]
+ 		ifNotNil: [| segmentToFillIndex |
+ 			segmentToFillIndex := manager segmentManager indexOfSegment: compactor segmentToFill.
+ 			aBlock value.
+ 			compactor setSegmentToFillToAddress: (manager segInfoAt: segmentToFillIndex)]!

Item was changed:
  ----- Method: SpurSegmentManager>>allocateOrExtendSegmentInfos (in category 'private') -----
  allocateOrExtendSegmentInfos
  	"Increase the number of allocated segInfos by 16."
+ 	
+ 	manager gc noteReallocOfSegmentsArray: [| newNumSegs |
+ 		numSegInfos = 0 ifTrue:
+ 			[numSegInfos := 16.
+ 			 segments := self
+ 							cCode: [self calloc: numSegInfos _: (self sizeof: SpurSegmentInfo)]
+ 							inSmalltalk: [CArrayAccessor on: ((1 to: numSegInfos) collect: [:i| SpurSegmentInfo new])].
+ 			 ^self].
+ 		newNumSegs := numSegInfos + 16.
+ 		segments := self
+ 							cCode: [self realloc: segments _: newNumSegs * (self sizeof: SpurSegmentInfo)]
+ 							inSmalltalk: [CArrayAccessor on: segments object,
+ 										((numSegInfos to: newNumSegs) collect: [:i| SpurSegmentInfo new])].
+ 		self cCode:
+ 			[segments = 0 ifTrue:
+ 				[self error: 'out of memory; cannot allocate more segments'].
+ 			 self
+ 				memset: segments + numSegInfos
+ 				_: 0
+ 				_: newNumSegs - numSegInfos * (self sizeof: SpurSegmentInfo)].
+ 		numSegInfos := newNumSegs]!
- 	| newNumSegs |
- 	numSegInfos = 0 ifTrue:
- 		[numSegInfos := 16.
- 		 segments := self
- 						cCode: [self calloc: numSegInfos _: (self sizeof: SpurSegmentInfo)]
- 						inSmalltalk: [CArrayAccessor on: ((1 to: numSegInfos) collect: [:i| SpurSegmentInfo new])].
- 		 ^self].
- 	newNumSegs := numSegInfos + 16.
- 	segments := self
- 						cCode: [self realloc: segments _: newNumSegs * (self sizeof: SpurSegmentInfo)]
- 						inSmalltalk: [CArrayAccessor on: segments object,
- 									((numSegInfos to: newNumSegs) collect: [:i| SpurSegmentInfo new])].
- 	self cCode:
- 		[segments = 0 ifTrue:
- 			[self error: 'out of memory; cannot allocate more segments'].
- 		 self
- 			memset: segments + numSegInfos
- 			_: 0
- 			_: newNumSegs - numSegInfos * (self sizeof: SpurSegmentInfo)].
- 	numSegInfos := newNumSegs!

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>noteReallocOfSegmentsArray: (in category 'as yet unclassified') -----
+ noteReallocOfSegmentsArray: aBlock
+ 
+ 	<inline: #always>
+ 	aBlock value!