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

commits at source.squeak.org commits at source.squeak.org
Sat Jan 7 00:14:50 UTC 2023


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

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

Name: VMMaker.oscog.seperateMarking-WoC.3291
Author: WoC
Time: 7 January 2023, 1:14:24.991442 am
UUID: 36af9fd6-1dcf-42b2-a6d6-93110b2f36a9
Ancestors: VMMaker.oscog.seperateMarking-WoC.3290

- adpated barriers to use with 2 phase GC (needs to handle segmentToFill)
- some recategorization
- try to limit 2 phase gc actions to a time frame (5 ms); mixed results until now (sometimes works really good, sometimes gc takes "much longer")
- entered default values for SpurStopTheWorldGarbageCollector functions that were previously empty, because I thought that would translate to a nop (instead a return value was generated (return 0 what translates to false for all my checks) and used in the code)

=============== Diff against VMMaker.oscog.seperateMarking-WoC.3290 ===============

Item was changed:
  ----- Method: CoInterpreter>>mapPrimTraceLog (in category 'debug support') -----
  mapPrimTraceLog
  	"The prim trace log is a circular buffer of objects. If there is
  	 an entry at primTraceLogIndex - 1 \\ PrimTraceBufferSize it has entries.
  	 If there is something at primTraceLogIndex it has wrapped."
+ 	<declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
  	<inline: false>
  	| entryOop |
  	(primTraceLog at: (self safe: primTraceLogIndex - 1 mod: PrimTraceLogSize)) = 0 ifTrue:
  		[^self].
  	(primTraceLog at: primTraceLogIndex) ~= 0 ifTrue:
  		[primTraceLogIndex to: PrimTraceLogSize - 1 do:
  			[:i|
  			 entryOop := primTraceLog at: i.
  			 (entryOop ~= 0
  			  and: [objectMemory shouldRemapOop: entryOop]) ifTrue:
  				[primTraceLog at: i put: (objectMemory remapObj: entryOop)]]].
  	0 to: primTraceLogIndex - 1 do:
  		[:i|
  		 entryOop := primTraceLog at: i.
  		 (entryOop ~= 0
  		  and: [objectMemory shouldRemapOop: entryOop]) ifTrue:
  			[primTraceLog at: i put: (objectMemory remapObj: entryOop)]]!

Item was changed:
  ----- Method: CoInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
+ 	<declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
  	<inline: #never>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #frameRcvrOffset type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
  	| numLivePages |
  	numLivePages := 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP frameRcvrOffset callerFP theIPPtr theIP oop |
  		thePage := stackPages stackPageAt: i.
  		thePage isFree ifFalse:
  			[self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
  			 numLivePages := numLivePages + 1.
  			 theSP := thePage headSP.
  			 theFP := thePage  headFP.
  			 "Skip the instruction pointer on top of stack of inactive pages."
  			 thePage = stackPage
  				ifTrue: [theIPPtr := ((self isMachineCodeFrame: theFP)
  									or: [(self iframeSavedIP: theFP) = 0])
  										ifTrue: [0]
  										ifFalse: [theFP + FoxIFSavedIP]]
  				ifFalse:
  					[theIPPtr := theSP.
  					 theSP := theSP + objectMemory wordSize].
  			[self assert: (thePage addressIsInPage: theFP).
  			 self assert: (thePage addressIsInPage: theSP).
  			 self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
  			 frameRcvrOffset := self frameReceiverLocation: theFP.
  	 		  [theSP <= frameRcvrOffset] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + objectMemory wordSize].
  			 (self frameHasContext: theFP) ifTrue:
  				[(objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue:
  					[stackPages
  						longAt: theFP + FoxThisContext
  						put: (objectMemory remapObj: (self frameContext: theFP))].
  				 "With SqueakV3 objectMemory or SpurPlanningCompactor can't assert since object body is yet to move."
  				 (objectMemory hasSpurMemoryManagerAPI
  				  and: [(objectMemory slidingCompactionInProgress or: [objectMemory scavengeInProgress]) not]) ifTrue:
  					[self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
  								and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]].
  			(self isMachineCodeFrame: theFP) ifFalse:
  				[(objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue:
  					[theIPPtr ~= 0 ifTrue:
  						[theIP := stackPages longAt: theIPPtr.
  						 theIP = cogit ceReturnToInterpreterPC
  							ifTrue:
  								[self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP).
  								 theIPPtr := theFP + FoxIFSavedIP.
  								 theIP := stackPages longAt: theIPPtr]
  							ifFalse:
  								[self assert: theIP > (self iframeMethod: theFP)].
  						 theIP := theIP - (self iframeMethod: theFP)].
  					 stackPages
  						longAt: theFP + FoxMethod
  						put: (objectMemory remapObj: (self iframeMethod: theFP)).
  					 theIPPtr ~= 0 ifTrue:
  						[stackPages longAt: theIPPtr put: theIP + (self iframeMethod: theFP)]]].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
  			 [theSP <= thePage baseAddress] whileTrue:
  				[oop := stackPages longAt: theSP.
  				 (objectMemory shouldRemapOop: oop) ifTrue:
  					[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
  				 theSP := theSP + objectMemory wordSize]]].
  	stackPages recordLivePagesOnMapping: numLivePages!

Item was changed:
  ----- Method: CoInterpreter>>mapTraceLog (in category 'debug support') -----
  mapTraceLog
  	"The trace log is a circular buffer of pairs of entries. If there is
  	 an entry at traceLogIndex - 3 \\ TraceBufferSize it has entries.
  	 If there is something at traceLogIndex it has wrapped."
+ 	<declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
  	<inline: false>
  	| limit |
  	limit := self safe: traceLogIndex - 3 mod: TraceBufferSize.
  	(traceLog at: limit) = 0 ifTrue: [^self].
  	(traceLog at: traceLogIndex) ~= 0 ifTrue:
  		[limit := TraceBufferSize - 3].
  	0 to: limit by: 3 do:
  		[:i| | intOrClass selectorOrMethod |
  		intOrClass := traceLog at: i.
  		(objectMemory shouldRemapOop: intOrClass) ifTrue:
  			[traceLog at: i put: (objectMemory remapObj: intOrClass)].
  		selectorOrMethod := traceLog at: i + 1.
  		(objectMemory shouldRemapOop: selectorOrMethod) ifTrue:
  			[traceLog at: i + 1 put: (objectMemory remapObj: selectorOrMethod)]]!

Item was changed:
+ ----- Method: SpurAllAtOnceMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurAllAtOnceMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
  setIsMarkedOf: objOop
  
  	manager setIsMarkedOf: objOop to: true!

Item was changed:
  SpurIncrementalMarker subclass: #SpurCountingIncrementalMarker
+ 	instanceVariableNames: 'mStartTime'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SpurGarbageCollector'!

Item was changed:
+ ----- Method: SpurCountingIncrementalMarker>>getUsedMemoryOf: (in category 'segment occupation') -----
- ----- Method: SpurCountingIncrementalMarker>>getUsedMemoryOf: (in category 'as yet unclassified') -----
  getUsedMemoryOf: segInfo
  
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  
  	"hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
  	how much life data is in the segment"
  	^ segInfo lastFreeObject!

Item was added:
+ ----- Method: SpurCountingIncrementalMarker>>incrementalMarkObjects (in category 'marking - incremental') -----
+ incrementalMarkObjects
+ 	"this method is to be run directly after a scavenge -> we can assume there are ony objects in the now past survivor space"
+ 
+ 	<inline: #never> "for profiling"
+ 	
+ 	"manager runLeakCheckerFor: GCModeIncremental."
+ 	
+ 	mStartTime := coInterpreter ioUTCMicrosecondsNow.
+ 	self initForNewMarkingPassIfNecessary.
+ 
+ 	[ | continueMarking |
+ 	(manager isEmptyObjStack: manager markStack)
+ 		ifTrue: [self pushAllRootsOnMarkStack.
+ 			" manager sizeOfObjStack: manager markStack.
+ 			did we finish marking?"
+ 			(manager isEmptyObjStack: manager markStack)
+ 				ifTrue: [self finishMarking.
+ 					^ true]].
+ 	
+ 	
+ 	"due to a slang limitations we have to assign the result into variable => do not remove!!"
+ 	continueMarking := self incrementalMark.
+ 	
+ 	continueMarking
+ 		ifTrue: [true]
+ 		ifFalse: [
+ 			coInterpreter cr; print: 'Time until now: '; printNum: coInterpreter ioUTCMicrosecondsNow - mStartTime ; tab; flush.
+ 			(coInterpreter ioUTCMicrosecondsNow - mStartTime) < (5000 / 2)]] whileTrue.
+ 
+ 	^ false!

Item was changed:
+ ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurCountingIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
  setIsMarkedOf: objOop
  
  	| segmentContainingObject |
  	super setIsMarkedOf: objOop.
  	
  	self flag: #Todo. "we need a more efficient way to get the segment"
  	segmentContainingObject := manager segmentManager segmentContainingObj: objOop.
  	self 
  		setUsedMemory: (self getUsedMemoryOf: segmentContainingObject) + (manager bytesInBody: objOop) 
  		for: segmentContainingObject!

Item was changed:
+ ----- Method: SpurCountingIncrementalMarker>>setUsedMemory:for: (in category 'segment occupation') -----
- ----- Method: SpurCountingIncrementalMarker>>setUsedMemory:for: (in category 'as yet unclassified') -----
  setUsedMemory: usedMemory for: segInfo
  
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  
  	"hack: use lastFreeObject (only used during snapshot, where GC is already done and we can ignore that it gets changed) to keep track of
  	how much life data is in the segment"
  	segInfo lastFreeObject: usedMemory!

Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
+ 
+ 	^ (self selectorsInIncrementalAndStopTheWorldGC includes: aSelectorSymbol)
+ 		ifTrue: [self staticallyResolvePolymorphicSelector: aSelectorSymbol forClass: SpurIncrementalGarbageCollector]
+ 		ifFalse: [aSelectorSymbol]!

Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
+ assertSettingGCFlagsIsOk: objOop
+ 
+ 	checkSetGCFlags ifFalse: [^ self].
+ 
+ 	"do not color young objects. They have an extra state we do not want to change"
+ 	self assert: (manager isOldObject: objOop).
+ 	(manager isOldObject: objOop)
+ 		ifFalse: [self cCode: 'raise(SIGINT)'].
+ 	
+ 	"while sweeping: do not color objects behind the currently point the sweeper is at. This would infer with the next marking pass"
+ 	self assert: (self allocatorShouldAllocateBlack not or: [self inSweepingAheadOfSweepersPosition: objOop]).
+ 	self assert: (self isInSegmentToFill: objOop) not!

Item was changed:
  ----- Method: SpurIncremental2PhaseGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
  doIncrementalCollect
  	
  	| startTime |
  	
  	phase = InMarkingPhase
  		ifTrue: [ | finishedMarking |
  			marker isCurrentlyMarking
  				ifFalse: [self assert: manager allObjectsUnmarked].
  			
  			coInterpreter cr; print: 'start marking '; tab; flush.
  			finishedMarking := marker incrementalMarkObjects.
  			
  			"self assert: manager validObjectColors."
  			
  			finishedMarking
  				ifTrue: [
+ 					"manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)]."
- 					manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
  					
  					"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
  					We only know if they should get swept after the next marking -> keep them alive for this cycle"
  					self allocatorShouldAllocateBlack: true.
  					compactor setInitialSweepingEntity.
  					phase := InSweepingPhase.
  					
  					"marking is done and thus all forwarding from the last compaction references are resolved 
  						-> we can use the now free segments that were compacted during the last cycle"
  					compactor freePastSegmentsAndSetSegmentToFill.
  					compactor assertNoSegmentBeingCompacted.
  					
  					self assert: manager noObjectGrey.
  					
  					coInterpreter cr; print: 'finish marking '; tab; flush.
  					
  					startTime := coInterpreter ioUTCMicrosecondsNow.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
  						checkFreeSpace: GCModeFull.
  						
  					coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  					
  					0 to: manager numSegments - 1
  						do: [:i | | segInfo |
  							segInfo := manager segInfoAt: i.
  							coInterpreter cr; print: 'occupation from marking: '; printNum: (segInfo lastFreeObject asFloat / segInfo segSize) * 100; tab; flush].
  						
+ 					"manager printSegmentOccupationFromMarkedObjects."
- 					manager printSegmentOccupationFromMarkedObjects.
  					
  					^ self]
+ 				ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush. "manager runLeakCheckerFor: GCModeIncremental"]].
- 				ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
  		
  	phase = InSweepingPhase
  		ifTrue: [
  			coInterpreter cr; print: 'start sweeping '; tab; flush.
  			compactor incrementalSweepAndCompact
  				ifTrue: [
  					self allocatorShouldAllocateBlack: false.
+ 					self assert: manager allObjectsWhite.
- 					manager allOldSpaceObjectsDo: [:ea | (manager isWhite: ea) ifFalse: [self cCode: 'raise(SIGINT)']. self assert: (manager isWhite: ea) ].
  					"self assert: manager allObjectsUnmarked."
  					
  					coInterpreter cr; print: 'finish sweeping '; tab; flush.
  					
  					startTime := coInterpreter ioUTCMicrosecondsNow.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull;
  						checkFreeSpace: GCModeFull.
  					coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  					
  					phase := InMarkingPhase.
  					^ self]]!

Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>isInSegmentToFill: (in category 'testing') -----
+ isInSegmentToFill: objOop
+ 
+ 	^ compactor segmentToFill notNil and: [manager segmentManager is: objOop inSegment: compactor segmentToFill]!

Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') -----
+ isOkToScavengeRememberedObject: objOop
+ 	"When sweeping we can alreay have freed an object A that is referenced by B. If B is behind the sweepers
+ 	position and not marked it is garbage and to be collected. Yet B is still in the remembered set and will get
+ 	scanned, during which the freed object will be visited an an error caused. Use this check to prevent this
+ 	
+ 	Objects in the segmentToFll are implicitly marked as they only get copied there if they were marked before"
+ 
+ 	^ (self inSweepingAheadOfSweepersPosition: objOop) not
+ 		or: [(manager isMarked: objOop)
+ 		or: [self isInSegmentToFill: objOop]]!

Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>maybeModifyCopiedObject: (in category 'object creation barriers') -----
+ maybeModifyCopiedObject: objOop
+ 
+ 	"1. when marking always mark as we already could have marked all objects pointing to objOop 
+ 	 2. during sweeping mark objects behind the sweepers current position so it does not collect objOop"
+ 
+ 	(manager isOldObject: objOop)
+ 		ifTrue: [			
+ 			marker isCurrentlyMarking
+ 				ifTrue: [
+ 					"If the object is not white we would skip it. Therefore make sure it is, as all young space objects
+ 					should be"
+ 					self assert: (manager isWhite: objOop).
+ 					
+ 					"do not just color it but handle it correctly, depending on which type of object it is and
+ 					do things like scanning its class"
+ 					marker markAndShouldScan: objOop].
+ 				
+ 			"do not mark objects in segment to fill as it gets ignored during sweeping"
+ 			((self inSweepingAheadOfSweepersPosition: objOop) and: [(self isInSegmentToFill: objOop) not])
+ 				ifTrue: [manager setIsMarkedOf: objOop to: true]]!

Item was added:
+ ----- Method: SpurIncremental2PhaseGarbageCollector>>maybeModifyGCFlagsOf: (in category 'object creation barriers') -----
+ maybeModifyGCFlagsOf: objOop
+ 
+ 	"when allocating a new object behind the current sweeping hight mark it should be allocated black so it does not get garbage
+ 	collected although we do not know if this is correct (but to know this we would need to mark again and that is expensive +
+       the object was allocated in old space therefore lets assume we want to keep it around (black allocation))
+ 
+ 	As the segmentToFill gets ignored we do not color objects there"
+ 	<inline: true>
+ 	((manager isOldObject: objOop) and: [(self inSweepingAheadOfSweepersPosition: objOop) and: [(self isInSegmentToFill: objOop) not]]) 
+ 		ifTrue: [manager setIsMarkedOf: objOop to: true]!

Item was changed:
  SpurCompactor subclass: #SpurIncrementalCompactingSweeper
+ 	instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer scStartTime'
- 	instanceVariableNames: 'isCurrentlyWorking currentSegmentsIndex currentsCycleSeenObjectCount currentSegmentsBridge currentObject segmentToFill shouldCompact currentCopyToPointer'
  	classVariableNames: 'MaxObjectsToFree MaxOccupationForCompaction'
  	poolDictionaries: ''
  	category: 'VMMaker-SpurGarbageCollector'!
+ 
+ !SpurIncrementalCompactingSweeper commentStamp: 'WoC 1/5/2023 23:21' prior: 0!
+ A SpurIncrementalCompactingSweeper is an incremental sweeper that compacts too. It is a merge of SpurIncrementalSweeper and SpurIncrementalCompactor with slight changes to the algorithm to accomodate 
+ to the fact both parts run at the same time. It traverses the heap one time sweeps normal segments, compacts segments that are planned to be compacted (more on that later) and skips the segment that should get filled. The compaction is adapted from: Lazy Pointer Update for Low Heap Compaction Pause Times (Clément Béra; Eliot Miranda; Elisa Gonzalez Boix -> https://doi.org/10.1145/3359619.3359741)
+ 
+ The SpurIncrementalCompactingSweeper is designed to run after the SpurCountingIncrementalMarker. The SpurCountingIncrementalMarker will write how many bytes of life data are in segments into the segmentInfo lastFreeObject. As a first step we decide if and when yes which segments should get compacted. We try to compact as many segments as possible, that are under a certain threshold (see MaxOccupationForCompaction what the actual value is), into the segmentToFill (an completetly empty segment we reserve or allocate when no empty segment is available)
+ 
+ The interesting entry point for understanding the algorithm is doincrementalSweepAndCompact. We already planned the compaction (read from planCompactionAndReserveSpace) and reserved the segmentToFill (freePastSegmentsAndSetSegmentToFill or findOrAllocateSegmentToFill). We now scan the whole heap. When the current object is in a normal segment we just do a normal sweep. This includes unmarking marked objects and coalescing unmarked objects and free chunks to larger free chunks (the whole succession of free chunks and unmarked objects until the next marked object or end of segment (attention!! only until the end of the segment the first object of this succession is)).
+ 
+  Should the current object we see be in the segmentToFill we skip the whole segment. We can safely skip it as it was empty previously (the mutator cannot allocate into the segmentToFill) and we only copy life objects here -> we do not need to do work here as everything here is life.
+ 
+ If the current object is in a segment that should be compacted (the current object will then be at the beginning of the segment) we start to compact it into segmentToFill. Free chunks get detached and set to a different class (so other safety mechanism ignore them). Marked objects get unmarked and forwarded to the segmentToFill. Unmarked objects get ignored (we just unremember them). 
+ 
+ Instance Variables
+ 	currentCopyToPointer:		<Object>
+ 	currentObject:		<Object>
+ 	currentSegmentsBridge:		<Object>
+ 	currentSegmentsIndex:		<Object>
+ 	currentsCycleSeenObjectCount:		<Object>
+ 	isCurrentlyWorking:		<Object>
+ 	segmentToFill:		<Object>
+ 	shouldCompact:		<Object>
+ 
+ currentCopyToPointer
+ 	- xxxxx
+ 
+ currentObject
+ 	- xxxxx
+ 
+ currentSegmentsBridge
+ 	- xxxxx
+ 
+ currentSegmentsIndex
+ 	- xxxxx
+ 
+ currentsCycleSeenObjectCount
+ 	- xxxxx
+ 
+ isCurrentlyWorking
+ 	- xxxxx
+ 
+ segmentToFill
+ 	- xxxxx
+ 
+ shouldCompact
+ 	- xxxxx
+ !

Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>declareCVarsIn: (in category 'translation') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>declareCVarsIn: (in category 'as yet unclassified') -----
  declareCVarsIn: aCCodeGenerator
  
  	aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'.
  
  	SpurMemoryManager wantsIncrementalGC
  		ifTrue: [
  			(self selectors intersection: SpurPlanningCompactor selectors)
  				do: [:key | 
  					aCCodeGenerator
  						staticallyResolveMethodNamed: key 
  						forClass: self 
  						to: (self staticallyResolvePolymorphicSelector: key)]]!

Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>hasPolymorphicSelectors (in category 'translation') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>hasPolymorphicSelectors (in category 'as yet unclassified') -----
  hasPolymorphicSelectors
  	"when using the incremental gc we have polymorphic selectors and have to resolve them"
  
  	^ SpurMemoryManager wantsIncrementalGC!

Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>initialize (in category 'initialization') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>initialize (in category 'as yet unclassified') -----
  initialize
  	super initialize.
  	"If the segment is occupied by more than MaxOccupationForCompaction, 
  	 it's not worth compacting it, whatever the rest of the system looks like.
  	 MaxOccupationForCompaction is included in [0;16rFFFF]."
  	MaxOccupationForCompaction := 16rD000. "81%"
  	MaxObjectsToFree := 100000!

Item was changed:
+ ----- Method: SpurIncrementalCompactingSweeper class>>staticallyResolvePolymorphicSelector: (in category 'translation') -----
- ----- Method: SpurIncrementalCompactingSweeper class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
  staticallyResolvePolymorphicSelector: aSelectorSymbol
  
  	| intersection |
  	intersection := (self selectors intersection: SpurPlanningCompactor selectors).
  	
  	^ (intersection includes: aSelectorSymbol)
  		ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
  		ifFalse: [aSelectorSymbol]!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>compactSegment:freeStart:segIndex: (in category 'incremental compact') -----
  compactSegment: segInfo freeStart: initialFreeStart segIndex: segIndex
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  
  	| fillStart |
  	fillStart := initialFreeStart.
  	
  	self deny: segIndex = 0. "Cannot compact seg 0"
  	manager segmentManager
  		allEntitiesInSegment: segInfo
  		exceptTheLastBridgeDo:
  			[:entity |
  			(manager isFreeObject: entity)
  				ifTrue: 
  					[manager detachFreeObject: entity.
  					 "To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
  					 manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
  				ifFalse: 
  					[ (manager isMarked: entity)
  						ifTrue: [manager makeWhite: entity.
  							"During the mutator runs new forwarding references can be created. Ignore them as they get resolved with the other 
  							forwarders in this segment in the next marking pass"
  								(manager isForwarded: entity) 
  									ifFalse:[| bytesToCopy |
  										"Copy the object in segmentToFill and replace it by a forwarder."
  										bytesToCopy := manager bytesInBody: entity. 
  										
  										(self oop: fillStart + bytesToCopy isLessThan: (segmentToFill segLimit - manager bridgeSize))
  											ifFalse: ["somebody allocated a new object we did not knew about at the moment of planning :( -> it does not fit anymore and we cannot free the whole segment. Make sure to unmark the segment as beeing compacted as it would be completetly freed otherwise!!"
  												coInterpreter cr; print: 'segments if full. Abort compacting of:  '; printHex: segmentToFill segStart ; tab; flush.
  												self unmarkSegmentAsBeingCompacted: (manager segInfoAt: currentSegmentsIndex).
  												
  												"we need to sweep the rest of the segment. As the segment is not marked to be compacted anymore sweepOrCompactFromCurrentObject will decide to sweep it. We want to start sweeping from the current entity, therefore setting currentObject to it and
  												we have to protect it from beeing freed (with marking it) as it was marked previously and after us unmarking it here would
  												get collected incorrectly"
  												manager setIsMarkedOf: entity to: true.
  												currentObject := entity.
  
  												^ fillStart].
  
  										self migrate: entity sized: bytesToCopy to: fillStart.
  
  										fillStart := fillStart + bytesToCopy.
  										self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]
  						ifFalse: [
  							(manager isRemembered: entity)
  								ifTrue: 
  									[self assert: (manager isFreeObject: entity) not.
  									 scavenger forgetObject: entity].
  						
+ 							"To avoid confusing too much Spur (especially the leak/free checks), we don't make the dead object a free chunk, but make it
+ 							a non pointer object to avoid the leak checker to try to follow the pointers of the dead object. 
+ 							Should we abort compacting this segment the object will get kept alife for one gc cycle" 
+ 							manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]]].
- 							"To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
- 					 		manager set: entity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]]].
  
  	"we want to advance to the next segment from the bridge"
  	currentObject := currentSegmentsBridge.
  	^ fillStart!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>computeSegmentsToCompact (in category 'compaction planning') -----
  computeSegmentsToCompact
  	"Compute segments to compact: least occupied.
  	 Answers true if compaction should be done 
  	 (at least 1 segment is being compacted and
  	 there is a segment to compact into)."
  	| canStillClaim aboutToClaim aboutToClaimSegment atLeastOneSegmentToCompact |
  	<var: 'aboutToClaimSegment' type: #'SpurSegmentInfo *'>
  	atLeastOneSegmentToCompact := false.
  	aboutToClaimSegment := self findNextSegmentToCompact.
  	"Segment to fill is one of the segment compacted last GC. 
  	 If no segment were compacted last GC, and that there is 
  	 at least one segment to compact, allocate a new one."
  	aboutToClaimSegment ifNil: [^false].
  	segmentToFill ifNil:
  		[self findOrAllocateSegmentToFill.
  		 segmentToFill ifNil: ["Abort compaction"^false]].
  	canStillClaim := segmentToFill segSize - manager bridgeSize.
  	[aboutToClaimSegment ifNil: [^atLeastOneSegmentToCompact].
  	 aboutToClaim := self sizeClaimedIn: aboutToClaimSegment.
  	 aboutToClaim < canStillClaim ] whileTrue: 
  		[self markSegmentAsBeingCompacted: aboutToClaimSegment.
  		 
  		coInterpreter cr; 
+ 			print: 'about to compact segment ';
+ 			printNum: (manager segmentManager indexOfSegment: aboutToClaimSegment);
+ 			 print: ' from: '; printHex: aboutToClaimSegment segStart; 
- 			print: 'about to compact segment from: '; printHex: aboutToClaimSegment segStart; 
  			print: ' to: '; printHex: aboutToClaimSegment segStart + aboutToClaimSegment segSize ;tab; flush.
  		
  		 atLeastOneSegmentToCompact := true.
  		 canStillClaim := canStillClaim - aboutToClaim.
  		 aboutToClaimSegment := self findNextSegmentToCompact].
  	^atLeastOneSegmentToCompact!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>doincrementalSweepAndCompact (in category 'sweep and compact') -----
  doincrementalSweepAndCompact
  
  	"Scan the heap for unmarked objects and free them. Coalescence "
  	self assert: currentObject notNil.
  	
  	currentsCycleSeenObjectCount := 0.
  
  	[self oop: currentObject isLessThan: manager endOfMemory] whileTrue:
  		[ currentObject = currentSegmentsBridge
  			ifTrue: [self advanceSegment]
  			ifFalse: [self sweepOrCompactFromCurrentObject].
  					
  		currentsCycleSeenObjectCount >= MaxObjectsToFree
+ 			ifTrue: [" | segInfo segIndex bytesAhead |
+ 				segIndex := (manager segmentIndexContainingObj: currentObject).
+ 				segInfo := manager segInfoAt: segIndex.
+ 				
+ 				bytesAhead := segInfo segSize - (currentObject - segInfo segStart).
+ 				
+ 				segIndex + 1 to: manager numSegments
+ 					do: [:index | | segment|
+ 						segment := manager segInfoAt: index.
+ 						bytesAhead := bytesAhead + segment segSize]."
+ 					
+ 				
+ 				
+ 				(coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000
+ 					ifTrue: [^ false]
+ 					ifFalse: [currentsCycleSeenObjectCount := 0]]].
- 			ifTrue: [^ false]].
  			
  	"set occupation for last segment"
  	manager checkFreeSpace: GCModeIncremental.
  	^ true!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>incrementalSweepAndCompact (in category 'public') -----
  incrementalSweepAndCompact
  
+ 	scStartTime := coInterpreter ioUTCMicrosecondsNow.
  	self initIfNecessary.
  	
+ 	"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.
+ 	
  	self assert: manager validObjectColors.
  	
  	self doincrementalSweepAndCompact
  		ifTrue: [self finishSweepAndCompact.
  			^ true].
  		
  	coInterpreter cr; print: 'current position: '; printHex: currentObject; tab; flush.
  		
  	^ false!

Item was changed:
  ----- Method: SpurIncrementalCompactingSweeper>>sweepOrCompactFromCurrentObject (in category 'sweep and compact') -----
  sweepOrCompactFromCurrentObject
  
  	self shouldCompactCurrentSegment
  		ifTrue: [self doIncrementalCompact.
  			
  			"either we finished compacting the segment or we had to abort compaction as the segment to fill cannot take more objects from this segment. We have to continue sweeping. This is done by unmarking the current segment as beeing compacted and making sure the last object we nearly copied before (and we know was alive after marking) is kept alive for sweeping"
  			self assert: ((manager isSegmentBridge: currentObject)
+ 							or: [(manager isMarked: currentObject) and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]]).
+ 							
+ 			(coInterpreter ioUTCMicrosecondsNow - scStartTime) > 5000
+ 					ifTrue: ["we just compacted a whole segment. Maybe this took a long time therefore set currentsCycleSeenObjectCount to max to force a check in doincrementalSweepAndCompact"
+ 						currentsCycleSeenObjectCount := MaxObjectsToFree]]
- 							or: [(manager isMarked: currentObject) and: [(self isSegmentAtIndexBeingCompacted: currentSegmentsIndex) not]])]
  		ifFalse: [self doIncrementalSweep.
  			currentObject := self nextCurrentObject]
  		!

Item was changed:
  SpurGarbageCollector subclass: #SpurIncrementalGarbageCollector
  	instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags'
  	classVariableNames: 'InCompactingPhase InMarkingPhase InSweepingPhase'
  	poolDictionaries: ''
  	category: 'VMMaker-SpurGarbageCollector'!
+ 
+ !SpurIncrementalGarbageCollector commentStamp: 'WoC 1/5/2023 21:36' prior: 0!
+ A SpurIncrementalGarbageCollector is a garbage collection algorithm. The GC is a mark and sweep with an additional compaction if certain conditions are fulfilled.
+ This class manages SpurIncrementalMarker and SpurIncrementalSweepAndCompact (which in turn manages SpurIncrementalCompactor and SpurIncrementalSweeper). The 3 classes 
+ implementing the GC are therefore SpurIncrementalMarker, SpurIncrementalSweeper and SpurIncrementalCompactor.
+ 
+ Instance Variables
+ 	allAtOnceMarker:		<SpurAllAtOnceMarker>
+ 	checkSetGCFlags:		<Bool>
+ 	phase:		<Number (InMarkingPhase|InSweepingPhase|InCompactingPhase)>
+ 
+ allAtOnceMarker
+ 	- an instance of SpurAllAtOnceMarker. We sometimes need parts of the old (stop-the-world) gc algorithm. This is the marking algorithm we can use through static polymorphism
+ 
+ checkSetGCFlags
+ 	- should we check if it ok to set gc flags or not
+ 
+ phase
+ 	- in which phase is the gc algorithm at the moment. Is either InMarkingPhase, InSweepingPhase or InCompactingPhase
+ !

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>maybeModifyGCFlagsOf: (in category 'object creation barriers') -----
  maybeModifyGCFlagsOf: objOop
  
  	"when allocating a new object behind the current sweeping hight mark it should be allocated black so it does not get garbage
+ 	collected although we do not know if this is correct (but to know this we would need to mark again and that is expensive +
+       the object was allocated in old space therefore lets assume we want to keep it around (black allocation))"
- 	collected although we do not know if this is correct"
  	<inline: true>
  	((manager isOldObject: objOop) and: [self inSweepingAheadOfSweepersPosition: objOop])
  		ifTrue: [manager setIsMarkedOf: objOop to: true]!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>writeBarrierFor:at:with: (in category 'barrier') -----
  writeBarrierFor: anObject at: index with: value
  	"a dijkstra style write barrier with the addition of the generation check
  	objects that are not able to contain pointers are ignored too, as the write barries
  	should ensure we lose no references and this objects do not hold any of them"
  	<inline: true>
  	
  	self flag: #Todo. "we probably want the oldObject check to be the first one as it is only a pointer comparison and no dereferencing is needed"
  	
  	"((manager isImmediate: value) not and: [(manager isPureBitsNonImm: value)])
  		ifTrue: [coInterpreter cr; print: 'saw: '; printHexnp: value; tab; flush]."
  	
+ 	self flag: #Todo. "do I need the immediate check?"
  	(self marking and: [(manager isImmediate: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]])
  		ifTrue: [marker markAndShouldScan: value]!

Item was changed:
  ----- Method: SpurIncrementalMarker class>>initialize (in category 'as yet unclassified') -----
  initialize
  
  	"experimental value. needs some measurements"
+ 	SlotLimitPerPass := 256 * 1024 !
- 	SlotLimitPerPass := 10 * 1024 * 1024!

Item was changed:
+ ----- Method: SpurIncrementalMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurIncrementalMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
  setIsMarkedOf: objOop
  
  	manager setIsMarkedOf: objOop to: true!

Item was changed:
+ ----- Method: SpurMarker>>setIsMarkedOf: (in category 'header access') -----
- ----- Method: SpurMarker>>setIsMarkedOf: (in category 'as yet unclassified') -----
  setIsMarkedOf: objOop
  
  	self subclassResponsibility!

Item was added:
+ ----- Method: SpurMemoryManager>>allOldSpaceEntitiesFrom:excludingTo:do: (in category 'object enumeration') -----
+ allOldSpaceEntitiesFrom: initialObject excludingTo: finalObject do: aBlock
+ 	<inline: true>
+ 	| prevObj prevPrevObj objOop |
+ 	self assert: ((self isNonImmediate: initialObject) and: [segmentManager isInSegments: initialObject]).
+ 	self assert: ((self isNonImmediate: finalObject) and: [segmentManager isInSegments: finalObject]).
+ 	prevPrevObj := prevObj := nil.
+ 	objOop := initialObject.
+ 	[self assert: objOop \\ self allocationUnit = 0.
+ 	 self oop: objOop isLessThan: finalObject] whileTrue:
+ 		[self assert: (self long64At: objOop) ~= 0.
+ 		 aBlock value: objOop.
+ 		 prevPrevObj := prevObj.
+ 		 prevObj := objOop.
+ 		 objOop := self objectAfter: objOop limit: endOfMemory].
+ 	self touch: prevPrevObj.
+ 	self touch: prevObj!

Item was changed:
  ----- Method: SpurMemoryManager>>validObjectColors (in category 'debug support') -----
  validObjectColors
  
  	| currentSweepingEntityT |
  	
  	currentSweepingEntityT := gc sweepersCurrentSweepingEntity ifNil: [self firstObject].
  	
  
  	self allOldSpaceEntitiesFrom: currentSweepingEntityT do: [:obj |
  		((self isMarked: obj) and: [(self isPointers: obj) and: [(self isContext: obj) not]])
  			ifTrue: [| slotCount |
  				slotCount := self numSlotsOf: obj.
  				
  				0 to: slotCount - 1
  					do: [:index | | slot |
  						slot := self fetchPointer: index ofObject: obj.
  						
  						((self isNonImmediate: slot) and: [(self isOldObject: slot) and: [(self isForwarded: slot) not]])
  							ifTrue: [(slot >= currentSweepingEntityT and: [(self isMarked: slot) not])
+ 										ifTrue: [
+ 											"for the 2 phase incremental gc. When we call this method while already having compacted some objects they are not marked anymore as we unmark them and do not sweep the segmentToFill"
+ 											(compactor segmentToFill notNil and: [(self segmentManager is: slot inSegment: compactor segmentToFill) not])
+ 												ifTrue: [self halt.
+ 													coInterpreter longPrintOop: (self firstReferenceTo:(self firstReferenceTo: obj)).
+ 													self printReferencesTo: (self firstReferenceTo: obj).
+ 													self printReferencesTo: obj.
+ 													
+ 													self printRelativePositionOf: obj.		
+ 													self printRelativePositionOf: slot.											
+ 													
+ 													coInterpreter longPrintOop: obj.
+ 													coInterpreter longPrintOop: slot.
+ 													
+ 													self cCode: 'raise(SIGINT)'.
+ 													
+ 													^ false]]]]]].
- 										ifTrue: [self halt.
- 											coInterpreter longPrintOop: (self firstReferenceTo:(self firstReferenceTo: obj)).
- 											self printReferencesTo: (self firstReferenceTo: obj).
- 											self printReferencesTo: obj.
- 											
- 											self printRelativePositionOf: obj.		
- 											self printRelativePositionOf: slot.											
- 											
- 											coInterpreter longPrintOop: obj.
- 											coInterpreter longPrintOop: slot.
- 											
- 											self cCode: 'raise(SIGINT)'.
- 											
- 											^ false]]]]].
  						
  					
  	^ true!

Item was changed:
  ----- Method: SpurStopTheWorldGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
  assertSettingGCFlagsIsOk: objOop
+ 	"please keep this method. Needed to generate polymorpic version for this method"
+ 	
+ 	^ true!
- 	"please keep this method. Needed to generate polymorpic version for this method"!

Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>doScavenge: (in category 'scavenge') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>doScavenge: (in category 'as yet unclassified') -----
  doScavenge: tenuringCriterion
  
  	"needed to generate polymorphic version of this method"
  	"The inner shell for scavenge, abstrascted out so globalGarbageCollect can use it."
  	<inline: false>
  	manager doAllocationAccountingForScavenge.
  	manager gcPhaseInProgress: ScavengeInProgress.
  	manager pastSpaceStart: (scavenger scavenge: tenuringCriterion).
  	self assert: (self
  					oop: manager pastSpaceStart
  					isGreaterThanOrEqualTo: scavenger pastSpace start
  					andLessThanOrEqualTo: scavenger pastSpace limit).
  	manager freeStart: scavenger eden start.
  	manager gcPhaseInProgress: 0.
  	manager resetAllocationAccountingAfterGC.!

Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>isIncremental (in category 'testing') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>isIncremental (in category 'as yet unclassified') -----
  isIncremental
  
  	^ false!

Item was changed:
  ----- Method: SpurStopTheWorldGarbageCollector>>isOkToClearReference: (in category 'testing') -----
  isOkToClearReference: objOop
  
+ 	^ true!
- 	"nop here"!

Item was changed:
  ----- Method: SpurStopTheWorldGarbageCollector>>isOkToDeleteSegment: (in category 'testing') -----
+ isOkToDeleteSegment: segment
+ 
+ 	^ true!
- isOkToDeleteSegment: segment!

Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') -----
+ isOkToScavengeRememberedObject: objOop
+ 
+ 	^ true!
- ----- Method: SpurStopTheWorldGarbageCollector>>isOkToScavengeRememberedObject: (in category 'as yet unclassified') -----
- isOkToScavengeRememberedObject: objOop!

Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>scavengingGCTenuringIf: (in category 'scavenge') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>scavengingGCTenuringIf: (in category 'as yet unclassified') -----
  scavengingGCTenuringIf: tenuringCriterion
  	"Run the scavenger."
  	<inline: false>
  	self assert: manager remapBufferCount = 0.
  	(self asserta: scavenger eden limit - manager freeStart > coInterpreter interpreterAllocationReserveBytes) ifFalse:
  		[coInterpreter tab;
  			printNum: scavenger eden limit - manager freeStart; space;
  			printNum: coInterpreter interpreterAllocationReserveBytes; space;
  			printNum: coInterpreter interpreterAllocationReserveBytes - (scavenger eden limit - manager freeStart); cr].
  	manager checkMemoryMap.
  	manager checkFreeSpace: GCModeNewSpace.
  	manager runLeakCheckerFor: GCModeNewSpace.
  
  	coInterpreter
  		preGCAction: GCModeNewSpace;
  		"would prefer this to be in mapInterpreterOops, but
  		 compatibility with ObjectMemory dictates it goes here."
  		flushMethodCacheFrom: manager newSpaceStart to: manager oldSpaceStart.
  	manager needGCFlag: false.
  
  	manager gcStartUsecs: coInterpreter ioUTCMicrosecondsNow.
  
  	self doScavenge: tenuringCriterion.
  
  	manager statScavenges: manager statScavenges + 1.
  	manager statGCEndUsecs: coInterpreter ioUTCMicrosecondsNow.
  	manager statSGCDeltaUsecs: manager statGCEndUsecs - manager gcStartUsecs.
  	manager statScavengeGCUsecs: manager statScavengeGCUsecs + manager statSGCDeltaUsecs.
  	manager statRootTableCount: scavenger rememberedSetSize.
  
  	scavenger logScavenge.
  
  	coInterpreter postGCAction: GCModeNewSpace.
  
  	manager runLeakCheckerFor: GCModeNewSpace.
  	manager checkFreeSpace: GCModeNewSpace!

Item was changed:
+ ----- Method: SpurStopTheWorldGarbageCollector>>writeBarrierFor:at:with: (in category 'barrier') -----
- ----- Method: SpurStopTheWorldGarbageCollector>>writeBarrierFor:at:with: (in category 'as yet unclassified') -----
  writeBarrierFor: anObject at: index with: value!

Item was changed:
  ----- Method: StackInterpreter>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
  checkForEventsMayContextSwitch: mayContextSwitch
  	"Check for possible interrupts and handle one if necessary.
  	 Answer if a context switch has occurred."
  	| switched sema now |
  	<inline: false>
  	<var: #now type: #usqLong>
  	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector>
  	statCheckForEvents := statCheckForEvents + 1.
  
  	"restore the stackLimit if it has been smashed."
  	self restoreStackLimit.
  	self externalWriteBackHeadFramePointers.
  	self assert: stackPage = stackPages mostRecentlyUsedPage.
  
  	"Allow the platform to do anything it needs to do synchronously."
  	self ioSynchronousCheckForEvents.
  
  	self checkCogCompiledCodeCompactionCalledFor.
  
  	objectMemory needGCFlag ifTrue:
  		["sufficientSpaceAfterGC: runs the incremental GC and
  		 then, if not enough space is available, the fullGC."
- 		self cr; print: 'context switch '; tab; flush.
  		 (objectMemory sufficientSpaceAfterGC: 0) ifFalse:
  			[self setSignalLowSpaceFlagAndSaveProcess]].
  
  	mayContextSwitch ifFalse: [^false].
  
  	switched := false.
  
  	(profileProcess ~= objectMemory nilObject
  	 or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
  		[self zeroNextProfileTick.
  		 "Take a sample (if not already done so) for the profiler if it is active.  This
  		  must be done before any of the synchronousSignals below or else we will
  		  attribute a pause in ioRelinquishProcessor to the newly activated process."
  		 profileProcess = objectMemory nilObject ifTrue:
  			[profileProcess := self activeProcess.
  			 profileMethod := objectMemory nilObject].
  		 "and signal the profiler semaphore if it is present"
  		 (profileSemaphore ~= objectMemory nilObject
  		  and: [self synchronousSignal: profileSemaphore]) ifTrue:
  			[switched := true]].
  
  	self cppIf: #LRPCheck
  		ifTrue:
  			[self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
  				[switched := true]].
  
  	objectMemory signalLowSpace ifTrue:
  		[objectMemory signalLowSpace: false. "reset flag"
  		 sema := objectMemory splObj: TheLowSpaceSemaphore.
  		 (sema ~= objectMemory nilObject
  		  and: [self synchronousSignal: sema]) ifTrue:
  			[switched := true]].
  
  	"inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
  	 ioProcessEvents e.g. for native GUIs.  We would like to manage that here but can't
  	 since the platform code may choose to call ioProcessEvents itself in various places."
  	false
  		ifTrue:
  			[((now := self ioUTCMicroseconds) >= nextPollUsecs
  			 and: [inIOProcessEvents = 0]) ifTrue:
  				[statIOProcessEvents := statIOProcessEvents + 1.
  				 inIOProcessEvents := inIOProcessEvents + 1.
  				 self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
  				 inIOProcessEvents > 0 ifTrue:
  					[inIOProcessEvents := inIOProcessEvents - 1].
  				 nextPollUsecs := now + 20000
  				 "msecs to wait before next call to ioProcessEvents.  Note that strictly
  				  speaking we might need to update 'now' at this point since
  				  ioProcessEvents could take a very long time on some platforms"]]
  		ifFalse:
  			[(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
  				[statIOProcessEvents := statIOProcessEvents + 1.
  				 self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
  				 nextPollUsecs := now + 20000
  				 "msecs to wait before next call to ioProcessEvents.  Note that strictly
  				  speaking we might need to update 'now' at this point since
  				  ioProcessEvents could take a very long time on some platforms"]].
  
  	interruptPending ifTrue:
  		[interruptPending := false.
  		 "reset interrupt flag"
  		 sema := objectMemory splObj: TheInterruptSemaphore.
  		 (sema ~= objectMemory nilObject
  		  and: [self synchronousSignal: sema]) ifTrue:
  			[switched := true]].
  
  	nextWakeupUsecs ~= 0 ifTrue:
  		[now >= nextWakeupUsecs ifTrue:
  			[nextWakeupUsecs := 0.
  			 "set timer interrupt to 0 for 'no timer'"
  			 sema := objectMemory splObj: TheTimerSemaphore.
  			 (sema ~= objectMemory nilObject
  			  and: [self synchronousSignal: sema]) ifTrue:
  				[switched := true]]].
  
  	"signal any pending finalizations"
  	pendingFinalizationSignals > 0 ifTrue:
  		[pendingFinalizationSignals := 0.
  		 sema := objectMemory splObj: TheFinalizationSemaphore.
  		 (sema ~= objectMemory nilObject
  		  and: [self synchronousSignal: sema]) ifTrue:
  			[switched := true]].
  
  	"signal all semaphores in semaphoresToSignal"
  	self signalExternalSemaphores ifTrue:
  		[switched := true].
  
  	^switched!




More information about the Vm-dev mailing list