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

commits at source.squeak.org commits at source.squeak.org
Thu Mar 16 19:59:07 UTC 2023


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

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

Name: VMMaker.oscog.seperateMarking-eem.3318
Author: eem
Time: 16 March 2023, 12:58:42.178303 pm
UUID: 784966ef-ca2e-4538-b5a9-dc5504f30fed
Ancestors: VMMaker.oscog.seperateMarking-eem.3317

A few tweaks to the IGC code as part of getting to know it properly.  Add a phase counter to SpurIncrementalGarbageCollector and use this in the printing of starting a phase. Add an assert to check that a traced stack page's contents are valid.  This isn't quite finished yet; I plan to make (not marked,grey) an invalid state so that "black or grey" and "white" is just a marked bit test. SO for the moment BogusGrey is a misnomer.

Merge VMMaker.oscog-eem.3311.
Fix checkOkayStackPage: for Spur.

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

Item was changed:
  ----- Method: CoInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
  incrementalMarkAndTraceStackPage: thePage
- 	| theSP theFP frameRcvrOffset callerFP oop marker |
  	<var: #thePage type: #'StackPage *'>
+ 	| theSP theFP frameRcvrOffset callerFP oop marker |
- 	<var: #theSP type: #'char *'>
- 	<var: #theFP type: #'char *'>
- 	<var: #frameRcvrOffset type: #'char *'>
- 	<var: #callerFP type: #'char *'>
  	<staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
  	<inline: false>
  	
  	"do not remove. Necessary for resolving polymorphic receiver"
  	marker := objectMemory marker.
  
  	self assert: (stackPages isFree: thePage) not.
  	self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
  	self assert: thePage trace ~= StackPageTraced.
  	thePage trace: StackPageTraced.
  
  	theSP := thePage headSP.
+ 	theFP := thePage headFP.
- 	theFP := thePage  headFP.
  	"Skip the instruction pointer on top of stack of inactive pages."
  	thePage = stackPage ifFalse:
  		[theSP := theSP + objectMemory wordSize].
  	[frameRcvrOffset := self frameReceiverLocation: theFP.
  	 [theSP <= frameRcvrOffset] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isOopForwarded: oop) ifTrue:
  			[oop := objectMemory followForwarded: oop.
  			 stackPages longAt: theSP put: oop].
+ 		 marker markAndScan: oop.
- 		 (objectMemory isImmediate: oop) ifFalse:
- 			[marker markAndShouldScan: oop].
  		 theSP := theSP + objectMemory wordSize].
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (objectMemory isContext: (self frameContext: theFP)).
+ 		 marker markAndScan: (self frameContext: theFP)].
- 		 marker markAndShouldScan: (self frameContext: theFP)].
  	(self isMachineCodeFrame: theFP)
  		ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)]
+ 		ifFalse: [marker markAndScan: (self iframeMethod: theFP)].
- 		ifFalse: [marker markAndShouldScan: (self iframeMethod: theFP)].
  	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  		[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
  		 theFP := callerFP].
  	theSP := theFP + FoxCallerSavedIP + objectMemory wordSize. "caller ip is ceBaseReturnPC"
  	[theSP <= thePage baseAddress] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isOopForwarded: oop) ifTrue:
  			[oop := objectMemory followForwarded: oop.
  			 stackPages longAt: theSP put: oop].
+ 		 marker markAndScan: oop.
+ 		 theSP := theSP + objectMemory wordSize].
+ 	self deny: (self whiteOrBogusGreyObjectsOnStackPage: thePage)!
- 		 (objectMemory isImmediate: oop) ifFalse:
- 			[marker markAndShouldScan: oop].
- 		 theSP := theSP + objectMemory wordSize]!

Item was changed:
  ----- Method: CoInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops.
  	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
  	 only during message lookup and because createActualMessageTo will not
  	 cause a GC these cannot change during message lookup.
  	 c.f. followMethodNewMethodAndInstructionPointer.
  	 Override to relocate the instructionPointer relative to newMethod, if required.
  	 In the Cogit the VM may be in a machine code primitive when the GC is invoked.
  	 However, because compaction moves several objects, it is possible for the
  	 compacted method to overlap the pre-compacted newMethod and hence
  	 there's a danger of updating instructionPointer twice."
+ 	<declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
  	| ipdelta |
  	(objectMemory shouldRemapObj: method) ifTrue:
  		[ipdelta := (self method: method includesAddress: instructionPointer) ifTrue:
  						[instructionPointer - method].
  		 method := objectMemory remapObj: method.
  		 ipdelta ifNotNil:
  			[instructionPointer := method + ipdelta]].
  	(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
  		[ipdelta := (ipdelta isNil "don't relocate twice!!!!"
  					  and: [self method: newMethod includesAddress: instructionPointer]) ifTrue:
  						[instructionPointer - newMethod].
  		 newMethod := objectMemory remapObj: newMethod.
  		 ipdelta ifNotNil:
  			[instructionPointer := newMethod + ipdelta]]!

Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveBenchmarkScavenge (in category 'benchmark primitives') -----
+ primitiveBenchmarkScavenge
+ 	<option: #VMBenchmarks>
+ 	<export: true>
+ 	self primitiveReturnTimeTakenFor:
+ 		[objectMemory hasSpurMemoryManagerAPI
+ 			ifTrue: [objectMemory scavengingGC]
+ 			ifFalse: [objectMemory incrementalGC].
+ 		 self integerObjectOf: (objectMemory bytesLeft: false)]!

Item was changed:
  ----- Method: CogStackPageSurrogate>>printOn: (in category 'printing') -----
  printOn: aStream
  	super printOn: aStream.
+ 	aStream space.
+ 	self baseAddress printOn: aStream base: 16.
+ 	aStream nextPut: $@.
+ 	aStream space; print: address; nextPut: $/.
- 	aStream nextPut: $@; print: address; nextPut: $/.
  	address printOn: aStream base: 16!

Item was removed:
- ----- Method: CogVMSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- 	^0!

Item was removed:
- ----- Method: InterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- 	^0!

Item was changed:
  SpurMarker subclass: #SpurAllAtOnceMarker
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-SpurGarbageCollector'!
  
+ !SpurAllAtOnceMarker commentStamp: 'eem 3/16/2023 10:17' prior: 0!
+ Marker implementation for the SpurStopTheWorldGarbageCollector. Marks all reachable objects in a single pass.
- !SpurAllAtOnceMarker commentStamp: 'WoC 12/2/2022 23:36' prior: 0!
- Marker implementation for the SpurStopTheWorldGarbageCollector. Marks all reachable objects 
  
+ Instance Variables: inherited!
- Instance Variables
- !

Item was changed:
  ----- Method: SpurIncremental2PhaseGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
  doIncrementalCollect
  	
  	| startTime |
  	
  	phase = InMarkingPhase
  		ifTrue: [ | finishedMarking |
  			marker isCurrentlyMarking
  				ifFalse: [self assert: manager allObjectsUnmarked.
  					manager segmentManager prepareForGlobalSweep].
  			
  			coInterpreter cr; print: 'start marking '; tab; flush.
  			finishedMarking := marker incrementalMarkObjects.
  			
  			"self assert: manager validObjectColors."
  			
  			finishedMarking
  				ifTrue: [
  					"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.
+ 					self phase: InSweepingPhase.
- 					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.
  						
  					manager clearLeakMapAndMapMarkedOrYoungObjects.
  					coInterpreter checkStackIntegrity.
  						
  					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: (compactor occupationOf: segInfo) * 100; tab; 
  							print: '('; printNum: (marker getLifeObjectCountOf: segInfo); print: ' objects -> ' ;printNum: (compactor sizeClaimedIn: segInfo) ; print: ' bytes)'  ;flush].
  						
  					manager printSegmentOccupationFromMarkedObjects.
  					
  					^ self]
  				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.
  					"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.
  					
+ 					self phase: InMarkingPhase.
- 					phase := InMarkingPhase.
  					
  					fullGCWanted := false.
  					^ self]]!

Item was changed:
  SpurGarbageCollector subclass: #SpurIncrementalGarbageCollector
+ 	instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags stopTheWorldGC fullGCWanted phaseCounter'
- 	instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags stopTheWorldGC fullGCWanted'
  	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>>doIncrementalCollect (in category 'as yet unclassified') -----
  doIncrementalCollect
  	
  	| startTime |
  	
  	phase = InMarkingPhase
  		ifTrue: [ | finishedMarking |
  			marker isCurrentlyMarking
  				ifFalse: [self assert: manager allObjectsUnmarked].
  			
+ 			coInterpreter cr; print: 'start marking '; printNum: (phaseCounter := phaseCounter + 1); tab; flush.
- 			coInterpreter cr; print: 'start marking '; tab; flush.
  			finishedMarking := marker incrementalMarkObjects.
  			
  			"self assert: manager validObjectColors."
  			
  			finishedMarking
  				ifTrue: [
  					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.
+ 					self phase: InSweepingPhase.
- 					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.
  					
  					manager segmentManager prepareForGlobalSweep.
  					
  					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.
  						
  					
  					^ 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 incrementalSweep
  				ifTrue: [
  					self allocatorShouldAllocateBlack: false.
  					manager allOldSpaceObjectsDo: [:ea | 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.
  						
  					compactor assertNoSegmentBeingCompacted.
  					
+ 					self phase: InCompactingPhase.
- 					phase := InCompactingPhase.
  					^ self]].
  		
  	phase = InCompactingPhase
  		ifTrue: [
  			"self cCode: 'raise(SIGINT)'."
  			coInterpreter cr; print: 'start compacting '; tab; flush.
  			compactor isCurrentlyCompacting
  				ifFalse: [manager printFreeSpaceStatistics].
  			compactor incrementalCompact
  				ifTrue: [
  					coInterpreter cr; print: 'finish compacting '; 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.
  					
+ 					self phase: InMarkingPhase.
- 					phase := InMarkingPhase.
  					
  					fullGCWanted := false.
  					
  					^ self]]!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>initialize (in category 'initialize-release') -----
  initialize
  
  	super initialize.
  	
  	checkSetGCFlags := true.
+ 	phase := InMarkingPhase. phaseCounter := 0.
- 	phase := InMarkingPhase.
  	fullGCWanted := false.
  	
  	allAtOnceMarker := SpurAllAtOnceMarker new.
  	stopTheWorldGC := SpurStopTheWorldGarbageCollector new.
  	
  	stopTheWorldGC marker: allAtOnceMarker.
  	stopTheWorldGC compactor: SpurPlanningCompactor new!

Item was changed:
  SpurMarker subclass: #SpurIncrementalMarker
  	instanceVariableNames: 'isCurrentlyMarking'
  	classVariableNames: 'SlotLimitPerPass'
  	poolDictionaries: ''
  	category: 'VMMaker-SpurGarbageCollector'!
  
+ !SpurIncrementalMarker commentStamp: 'eem 3/16/2023 10:19' prior: 0!
+ Marker for the SpurIncrementalGarbageCollector. It mark objects in old space (and only in old space!!) incrementally, in batches.
- !SpurIncrementalMarker commentStamp: 'WoC 1/4/2023 00:21' prior: 0!
- Marker for the SpurIncrementalGarbageCollector. It is concipated to mark objects in old space (and only in old space!!) while beeing able to be interrupted
  
  Roots are:
  	- Stack references
  	- hidden objects
  	- extra objects
+ 	- (surviving) young space objects
- 	- young space objects
  
  Instance Variables
+ 	isCurrentlyMarking:		<Boolean>
- 	isCurrentlyMarking:		<Object>
  
  isCurrentlyMarking
+ 	- true if in the mark phase!
- 	- xxxxx
- !

Item was added:
+ ----- Method: SpurIncrementalMarker>>markAndScan: (in category 'marking - incremental') -----
+ markAndScan: objOop
+ 	"marks the object (grey or black as neccessary) and returns if the object should be scanned
+ 	This is simply the non-inlined version of markAndShouldScan:"
+ 
+ 	<inline: #never>
+ 	^self markAndShouldScan: objOop!

Item was changed:
  ----- Method: SpurIncrementalMarker>>markAndShouldScan: (in category 'marking - incremental') -----
  markAndShouldScan: objOop
  	"marks the object (grey or black as neccessary) and returns if the object should be scanned
  	Objects that get handled later on get marked as black, as they are practically a leaf in the object tree (we scan them later on, so we cannot lose objects and do not
  	need to adhere to the tricolor invariant)"
  
  	| format |
  	<inline: true>
+ 	((manager isImmediate: objOop)
+ 	or: [manager isYoung: objOop])
- 	(manager isYoung: objOop)
  		ifTrue: [^ false].
  	
- 	(manager isImmediate: objOop) ifTrue:
- 		[^false].
- 	
  	self assert: (manager isForwarded: objOop) not.
  
  	"if it is marked we already did everything we needed to do and if is grey we already saw it and do not have to do anything here"
+ 	(manager isWhite: objOop) ifFalse:
- 	(manager isWhite: objOop) not ifTrue:
  		[^false].
  	
  	format := manager formatOf: objOop.
  	
  	(manager isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack."
  		["Avoid tracing classes of non-objects on the heap, e.g. IRC caches, Sista counters."
  		 (manager classIndexOf: objOop) > manager lastClassIndexPun ifTrue:
  			[self markAndTraceClassOf: objOop].
  		
  		"the object does not need to enter the marking stack as there are no pointer to visit -> it is already finished and we can make it black"
  		self blackenObject: objOop.
  		 ^false].
  	
  	(manager isWeakFormat: format) ifTrue: "push weaklings on the weakling stack to scan later"
  		[manager push: objOop onObjStack: manager weaklingStack.
  		"do not follow weak references. They get scanned at the end of marking -> it should be ok to not follow the tricolor invariant"
  		self blackenObject: objOop.
  		 ^false].
  	
  	((manager isEphemeronFormat: format)
  	 and: [manager activeAndDeferredScan: objOop]) ifTrue:
  		[self blackenObject: objOop.
  		^false].
  	
  	"we know it is an object that can contain we have to follow"
  	self pushOnMarkingStackAndMakeGrey: objOop.
  	
  	^ true!

Item was added:
+ ----- Method: SpurMemoryManager>>isWhiteOrBogusGrey: (in category 'header access') -----
+ isWhiteOrBogusGrey: objOop
+ 	"Answer if the object is either white, or grey but unmarked"
+ 	
+ 	^(self isMarked: objOop) not!

Item was changed:
  ----- Method: SpurMemoryManager>>printHeaderOf: (in category 'debug printing') -----
  printHeaderOf: objOop
  	<export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h"
  	"N.B. No safety bounds checks!!!!  We need to look e.g. at corpses."
  	coInterpreter printHexnp: objOop.
  	(self hasOverflowHeader: objOop)
  		ifTrue: [coInterpreter
  					print: ' hdr16 slotf '; printHexnp: (self numSlotsOfAny: objOop - self allocationUnit);
  					print: ' slotc '; printHexnp: (self rawOverflowSlotsOf: objOop); space]
  		ifFalse: [coInterpreter print: ' hdr8 slots '; printHexnp: (self numSlotsOfAny: objOop)].
  	coInterpreter
  		space;
+ 		printChar: ((self isImmutable: objOop) ifTrue: [$I] ifFalse: [$i]);
- 		printChar: ((self isMarked: objOop) ifTrue: [$M] ifFalse: [$m]);
- 		printChar: ((self isGrey: objOop) ifTrue: [$G] ifFalse: [$g]);
  		printChar: ((self isPinned: objOop) ifTrue: [$P] ifFalse: [$p]);
  		printChar: ((self isRemembered: objOop) ifTrue: [$R] ifFalse: [$r]);
+ 		printChar: ((self isMarked: objOop) ifTrue: [$M] ifFalse: [$m]);
+ 		printChar: ((self isGrey: objOop) ifTrue: [$G] ifFalse: [$g]);
- 		printChar: ((self isImmutable: objOop) ifTrue: [$I] ifFalse: [$i]);
  		print: ' hash '; printHexnp: (self rawHashBitsOf: objOop);
  		print: ' fmt '; printHexnp: (self formatOf: objOop);
  		print: ' cidx '; printHexnp: (self classIndexOf: objOop);
  		cr!

Item was changed:
  ----- Method: SpurMemoryManager>>printHeaderTypeOf:on: (in category 'debug printing interpreter support') -----
  printHeaderTypeOf: obj on: aStream
  	<var: 'aStream' type: #'FILE *'>
  	<inline: true>
+ 	' hdr%d %c%c%c%c%c%c' f: aStream printf: {
- 	' hdr%d %c%c%c%c%c' f: aStream printf: {
  		(self hasOverflowHeader: obj) ifTrue: [16] ifFalse: [8].
  		(self isImmutable: obj) ifTrue: [$i] ifFalse: [$.].
- 		(self isRemembered: obj) ifTrue: [$r] ifFalse: [$.].
  		(self isPinned: obj) ifTrue: [$p] ifFalse: [$.].
+ 		(self isRemembered: obj) ifTrue: [$r] ifFalse: [$.].
+ 		(self isMarked: obj)
+ 			ifTrue: [(self isGrey: obj) ifTrue: [$G] ifFalse: [$M]]
+ 			 ifFalse: [(self isGrey: obj) ifTrue: [$!!] ifFalse: [$W]].
  		(self isMarked: obj) ifTrue: [$m] ifFalse: [$.].
  		(self isGrey: obj) ifTrue: [$g] ifFalse: [$.] }!

Item was changed:
  ----- Method: SpurSegmentManager>>segmentContainingObj: (in category 'accessing') -----
  segmentContainingObj: objOop
+ 	"Answer the segment containing an object.  This is mostly for assert checking, but
+ 	 variations on the incremental GC may use it in anger. Binary search is (of course)
+ 	 marginally slower than linear search for a single segment (e.g. in a 720k object heap,
+ 	 67.1ms vs 61.3ms, or 9.5% slower to derive the segment containing every old space
+ 	 entity), but usefully faster for many segments (e.g. 92.7ms vs 116ms, or 20% faster
+ 	 in the same heap extended with enough large arrays to require 11 segments; and this
+ 	 is pessimal; there are fewer objects at high addresses since the large arrays are there)."
  	<export: true>
  	<returnTypeC: #'SpurSegmentInfo *'>
+ 	| high low mid seg |
+ 	low := 0. mid := numSegments // 2. high := numSegments - 1.
+ 	[seg := segments at: mid.
+ 	(self oop: objOop isGreaterThanOrEqualTo: seg segStart)
+ 		ifTrue:
+ 			[mid = high
+ 				ifTrue:
+ 					[^(self oop: objOop isLessThan: seg segLimit) ifTrue:
+ 						[seg]]
+ 				ifFalse:
+ 					[low := mid.
+ 					 mid := mid + high + 1 // 2]]
+ 		ifFalse:
+ 			[high := mid - 1.
+ 			mid := low + mid // 2].
+ 	low <= high] whileTrue.
- 	numSegments - 1 to: 0 by: -1 do:
- 		[:i|
- 		objOop >= (segments at: i) segStart ifTrue:
- 			[^self addressOf: (segments at: i)]].
  	^nil!

Item was changed:
  ----- Method: StackInterpreter>>checkOkayStackPage: (in category 'debug support') -----
  checkOkayStackPage: thePage
- 	| theSP theFP ok frameRcvrOffset callerFP oop |
  	<var: #thePage type: #'StackPage *'>
+ 	| theSP theFP ok frameRcvrOffset callerFP oop |
- 	<var: #theSP type: #'char *'>
- 	<var: #theFP type: #'char *'>
- 	<var: #frameRcvrOffset type: #'char *'>
- 	<var: #callerFP type: #'char *'>
  	<inline: false>
  	theSP := thePage headSP.
  	theFP := thePage  headFP.
  	ok := true.
  	"Skip the instruction pointer on top of stack of inactive pages."
  	thePage = stackPage ifFalse:
  		[theSP := theSP + objectMemory wordSize].
  	[frameRcvrOffset := self frameReceiverLocation: theFP.
  	 [theSP <= frameRcvrOffset] whileTrue:
  		[oop := stackPages longAt: theSP.
+ 		 (objectMemory isImmediate: oop) ifFalse:
- 		 (objectMemory isIntegerObject: oop) ifFalse:
  			[ok := ok & (self checkOkayFields: oop)].
  		 theSP := theSP + objectMemory wordSize].
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (objectMemory isContext: (self frameContext: theFP)).
  		 ok := ok & (self checkOkayFields: (self frameContext: theFP))].
  	ok := ok & (self checkOkayFields: (self frameMethodObject: theFP)).
  	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  		[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
  		 theFP := callerFP].
  	theSP := self isCog
  				ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
  				ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
  	[theSP <= thePage baseAddress] whileTrue:
  		[oop := stackPages longAt: theSP.
+ 		 (objectMemory isImmediate: oop) ifFalse:
- 		 (objectMemory isIntegerObject: oop) ifFalse:
  			[ok := ok & (self checkOkayFields: oop)].
  		 theSP := theSP + objectMemory wordSize].
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
  incrementalMarkAndTraceStackPage: thePage
- 	| theSP theFP frameRcvrOffset callerFP oop marker |
  	<var: #thePage type: #'StackPage *'>
+ 	| theSP theFP frameRcvrOffset callerFP oop marker |
- 	<var: #theSP type: #'char *'>
- 	<var: #theFP type: #'char *'>
- 	<var: #frameRcvrOffset type: #'char *'>
- 	<var: #callerFP type: #'char *'>
  	<staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
  	<inline: false>
  	
  	"do not remove. Necessary for resolving polymorphic receiver"
  	marker := objectMemory marker.
  
  	self assert: (stackPages isFree: thePage) not.
  	self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
  	thePage trace: StackPageTraced.
  
  	theSP := thePage headSP.
  	theFP := thePage headFP.
  	"Skip the instruction pointer on top of stack of inactive pages."
  	thePage = stackPage ifFalse:
  		[theSP := theSP + objectMemory wordSize].
  	[frameRcvrOffset := self frameReceiverLocation: theFP.
  	 [theSP <= frameRcvrOffset] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isOopForwarded: oop) ifTrue:
  			[oop := objectMemory followForwarded: oop.
  			 stackPages longAt: theSP put: oop].
+ 		 marker markAndScan: oop.
- 		 (objectMemory isImmediate: oop) ifFalse:
- 			[marker markAndShouldScan: oop].
  		 theSP := theSP + objectMemory wordSize].
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (objectMemory isContext: (self frameContext: theFP)).
+ 		 marker markAndScan: (self frameContext: theFP)].
+ 	marker markAndScan: (self iframeMethod: theFP).
- 		 marker markAndShouldScan: (self frameContext: theFP)].
- 	marker markAndShouldScan: (self iframeMethod: theFP).
  	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  		[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
  		 theFP := callerFP].
  	theSP := theFP + FoxCallerSavedIP. "caller ip is frameCallerContext in a base frame"
  	[theSP <= thePage baseAddress] whileTrue:
  		[oop := stackPages longAt: theSP.
  		 (objectMemory isOopForwarded: oop) ifTrue:
  			[oop := objectMemory followForwarded: oop.
  			 stackPages longAt: theSP put: oop].
+ 		 marker markAndScan: oop.
+ 		 theSP := theSP + objectMemory wordSize].
+ 	self deny: (self whiteOrBogusGreyObjectsOnStackPage: thePage)!
- 		 (objectMemory isImmediate: oop) ifFalse:
- 			[marker markAndShouldScan: oop].
- 		 theSP := theSP + objectMemory wordSize]!

Item was changed:
  ----- Method: StackInterpreter>>incrementalMarkAndTraceStackPages (in category 'object memory support') -----
  incrementalMarkAndTraceStackPages
  	"GC of pages.  Throwing away all stack pages on full GC is simple but dangerous
  	 because it causes us to allocate lots of contexts immediately before a GC.
  	 Reclaiming pages whose top context is not referenced is poor because it would
  	 take N incrementalGCs to reclaim N unused pages.  Only the page whose top
  	 context is not referred to by the bottom context of any other page would be
+ 	 reclaimed.  Not until the next GC would the page whose top context is the
- 	 reclaimed.  Not until the next GC would the page whose top contect is the
  	 previously reclaimed page's base frame's bottom context be reclaimed.
  
  	 Better is to not mark stack pages until their contexts are encountered.  We can
  	 eagerly trace the active page and the page reachable from its bottom context
  	 if any, and so on.  Other pages can be marked when we encounter a married
  	 context."
  	| thePage |
  	<inline: false>
  	0 to: numStackPages - 1 do:
+ 		[:i|
+ 		thePage := stackPages stackPageAt: i.
+ 		(stackPages isFree: thePage) ifFalse:
+ 			[thePage trace ~= StackPageTraced
+ 				ifTrue: [self incrementalMarkAndTraceStackPage: thePage]
+ 				ifFalse: [self deny: (self whiteOrBogusGreyObjectsOnStackPage: thePage)]]].
+ 	^nil!
- 			[:i|
- 			thePage := stackPages stackPageAt: i.
- 			(stackPages isFree: thePage) ifFalse:
- 				[self incrementalMarkAndTraceStackPage: thePage]].
- 		^nil!

Item was changed:
  ----- Method: StackInterpreter>>mapVMRegisters (in category 'object memory support') -----
  mapVMRegisters
  	"Map the oops in the interpreter's vm ``registers'' to their new values 
  	during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops.
  	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
  	 only during message lookup and because createActualMessageTo will not
  	 cause a GC these cannot change during message lookup.
  	 c.f. followMethodNewMethodAndInstructionPointer."
+ 	<declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
  	(objectMemory shouldRemapObj: method) ifTrue:
  		[instructionPointer := instructionPointer - method. "*rel to method"
  		 method := objectMemory remapObj: method.
  		 instructionPointer := instructionPointer + method]. "*rel to method"
  	(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
  		[newMethod := objectMemory remapObj: newMethod]!

Item was added:
+ ----- Method: StackInterpreter>>objectsInStackZoneDo: (in category 'object memory support') -----
+ objectsInStackZoneDo: aQuinaryBlock
+ 	"Evaluate aTrinaryBlock with the stackPage, frame pointer, stack pointer (location) and oop of all objects in all stack pages."
+ 	<doNotGenerate>
+ 	0 to: numStackPages - 1 do:
+ 		[:i| | thePage |
+ 		thePage := stackPages stackPageAt: i.
+ 		(stackPages isFree: thePage) ifFalse:
+ 			[self objectsOnStackPage: thePage do: [:theFP :theSP :oop| aQuinaryBlock value: thePage value: theFP value: theSP value: oop]]]!

Item was added:
+ ----- Method: StackInterpreter>>objectsOnStackPage:do: (in category 'object memory support') -----
+ objectsOnStackPage: thePage do: aTrinaryBlock
+ 	"Evaluate aTrinaryBlock with the frame pointer, stack pointer (location) and oop of all objects in the stackPage."
+ 	<doNotGenerate>
+ 	| theSP theFP frameRcvrOffset callerFP |
+ 	self deny: (stackPages isFree: thePage).
+ 	self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
+ 
+ 	theSP := thePage headSP.
+ 	theFP := thePage  headFP.
+ 	"Skip the instruction pointer on top of stack of inactive pages."
+ 	thePage = stackPage ifFalse:
+ 		[theSP := theSP + objectMemory wordSize].
+ 	[frameRcvrOffset := self frameReceiverLocation: theFP.
+ 	 [theSP <= frameRcvrOffset] whileTrue:
+ 		[aTrinaryBlock value: theFP value: theSP value: (stackPages longAt: theSP).
+ 		 theSP := theSP + objectMemory wordSize].
+ 	(self frameHasContext: theFP) ifTrue:
+ 		[self assert: (objectMemory isContext: (self frameContext: theFP)).
+ 		 aTrinaryBlock value: theFP value: theFP + FoxThisContext value: (self frameContext: theFP)].
+ 	aTrinaryBlock value: theFP value: theFP + FoxMethod value: (self frameMethodObject: theFP).
+ 	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 		[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
+ 		 theFP := callerFP].
+ 	theSP := self isCog
+ 				ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
+ 				ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
+ 	[theSP <= thePage baseAddress] whileTrue:
+ 		[aTrinaryBlock value: theFP value: theSP value: (stackPages longAt: theSP).
+ 		 theSP := theSP + objectMemory wordSize]!

Item was added:
+ ----- Method: StackInterpreter>>whiteObjectsOnStackPage: (in category 'debug support') -----
+ whiteObjectsOnStackPage: thePage
+ 	"Answer if the page refers directly to any white objects."
+ 	<var: #thePage type: #'StackPage *'>
+ 	| theSP theFP frameRcvrOffset callerFP oop |
+ 	theSP := thePage headSP.
+ 	theFP := thePage  headFP.
+ 	"Skip the instruction pointer on top of stack of inactive pages."
+ 	thePage = stackPage ifFalse:
+ 		[theSP := theSP + objectMemory wordSize].
+ 	[frameRcvrOffset := self frameReceiverLocation: theFP.
+ 	 [theSP <= frameRcvrOffset] whileTrue:
+ 		[oop := stackPages longAt: theSP.
+ 		 ((objectMemory isNonImmediate: oop)
+ 		 and: [objectMemory isWhite: oop]) ifTrue:
+ 			[^true].
+ 		 theSP := theSP + objectMemory wordSize].
+ 	(self frameHasContext: theFP) ifTrue:
+ 		[self assert: (objectMemory isContext: (self frameContext: theFP)).
+ 		 (objectMemory isWhite: (self frameContext: theFP)) ifTrue:
+ 			[^true]].
+ 	(objectMemory isWhite: (self frameMethodObject: theFP)) ifTrue:
+ 		[^true].
+ 	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 		[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
+ 		 theFP := callerFP].
+ 	theSP := self isCog
+ 				ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
+ 				ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
+ 	[theSP <= thePage baseAddress] whileTrue:
+ 		[oop := stackPages longAt: theSP.
+ 		 ((objectMemory isNonImmediate: oop)
+ 		 and: [objectMemory isWhite: oop]) ifTrue:
+ 			[^true].
+ 		 theSP := theSP + objectMemory wordSize].
+ 	^false!

Item was added:
+ ----- Method: StackInterpreter>>whiteOrBogusGreyObjectsOnStackPage: (in category 'debug support') -----
+ whiteOrBogusGreyObjectsOnStackPage: thePage
+ 	"Answer if the page refers directly to any white objects."
+ 	<var: #thePage type: #'StackPage *'>
+ 	| theSP theFP frameRcvrOffset callerFP oop |
+ 	theSP := thePage headSP.
+ 	theFP := thePage  headFP.
+ 	"Skip the instruction pointer on top of stack of inactive pages."
+ 	thePage = stackPage ifFalse:
+ 		[theSP := theSP + objectMemory wordSize].
+ 	[frameRcvrOffset := self frameReceiverLocation: theFP.
+ 	 [theSP <= frameRcvrOffset] whileTrue:
+ 		[oop := stackPages longAt: theSP.
+ 		 ((objectMemory isNonImmediate: oop)
+ 		 and: [(objectMemory isOldObject: oop)
+ 		 and: [objectMemory isWhiteOrBogusGrey: oop]]) ifTrue:
+ 			[^true].
+ 		 theSP := theSP + objectMemory wordSize].
+ 	(self frameHasContext: theFP) ifTrue:
+ 		[self assert: (objectMemory isContext: (oop := self frameContext: theFP)).
+ 		 ((objectMemory isOldObject: oop)
+ 		 and: [objectMemory isWhiteOrBogusGrey: oop]) ifTrue:
+ 			[^true]].
+ 	((objectMemory isOldObject: (oop := self frameMethodObject: theFP))
+ 	 and: [objectMemory isWhiteOrBogusGrey: oop]) ifTrue:
+ 		[^true].
+ 	(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ 		[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
+ 		 theFP := callerFP].
+ 	theSP := self isCog
+ 				ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
+ 				ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
+ 	[theSP <= thePage baseAddress] whileTrue:
+ 		[oop := stackPages longAt: theSP.
+ 		 ((objectMemory isNonImmediate: oop)
+ 		 and: [(objectMemory isOldObject: oop)
+ 		 and: [objectMemory isWhiteOrBogusGrey: oop]]) ifTrue:
+ 			[^true].
+ 		 theSP := theSP + objectMemory wordSize].
+ 	^false!

Item was removed:
- ----- Method: StackInterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- 	^0!



More information about the Vm-dev mailing list