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

Sun Jan 1 19:58:07 UTC 2023

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

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

Name: VMMaker.oscog.seperateMarking-WoC.3287
Author: WoC
Time: 1 January 2023, 8:57:40.199509 pm
UUID: 22f43b30-f5ec-4dd7-8b40-18f5d271f3e5
Ancestors: VMMaker.oscog.seperateMarking-eem.3286

A somewhat stable version of the incremental GC. Some intricate changes to code generation (more static polymorphism)

Changes to code generation:
- extended static polymorphism to support multiple versions of the same method in one class and some support structure around it to choose the right version to be generated
- method to:generate: to generate a renamed version of a polymorphic method (neccessary because some handwritten C code expects the method fullGC to exits, that normally does not get generated anymore)
- added some pragmas to existing methods to determine which version is to be generated
- pushed some methods to subclasses in order to get them generated correctly

GC bug fixes:
- don't delete references of weak objects to old space objects during scavenging, as it is difficult to know if is ok to delete the object is ok (see SpurIncrementalGarbageCollector>>isOkToClearReference: for a better explanation)
- handle when segmentToFill is full and we would put more into than there is space to accommodate
- fix off by one error during compaction (don;t skip the last segment when compacting it)
- when having finished marking weakling make sure the marking stack is really empty
- do not apply write barrier during nilling weakling, as this can result in having elements on the marking stack although we just finished and expect (demand!) it to be empty
- enable TempVectReadBarrier (please use generateSqueakSpurIncrementalStack64VM to generate a valid VM with incremental GC)

- primitve for visualizing the heap
- make sure EphemeronStack is set to nil if it does not exist otherwise

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

Item was changed:
  Object subclass: #CCodeGenerator
+ 	instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers recursivelyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining mappingForRecursivePolymophism removedForPolymorphism recursivePolymorphicMethodsMap toGenerate'
- 	instanceVariableNames: 'vmClass structClasses translationDict asArgumentTranslationDict inlineList constants variables variableDeclarations scopeStack methods macros apiMethods apiVariables kernelReturnTypes currentMethod headerFiles globalVariableUsage useSymbolicConstants generateDeadCode requiredSelectors previousCommentMarksInlining previousCommenter logger suppressAsmLabels asmLabelCounts pools selectorTranslations staticallyResolvedPolymorphicReceivers optionsDictionary breakSrcInlineSelectors breakDestInlineSelectors breakOnInline vmMaker accessorDepthCache beganInlining'
  	classVariableNames: 'NoRegParmsInAssertVMs'
  	poolDictionaries: 'VMBasicConstants'
  	category: 'VMMaker-Translation to C'!

  !CCodeGenerator commentStamp: 'tpr 5/2/2003 14:30' prior: 0!
  This class oversees the translation of a subset of Smalltalk to C, allowing the comforts of Smalltalk during development and the efficiency and portability of C for the resulting interpreter.  
  See VMMaker for more useful info!

Item was added:
+ ----- Method: CCodeGenerator>>READMEForExplanationOnStaticPolymorphism (in category 'helpers polymorphic resolving') -----
+ READMEForExplanationOnStaticPolymorphism
+ 
+ 	"static polymophism enables to have multiple classes with the same methods that get resolved at code generation time
+ 	(slang -> C). There are two mechanisms depending on your needs:
+ 	
+ 	(1) static polymorphism for having multiple classes implementing the same methods and selecting which to generate in which case
+ 	(2) static polymorphism to have one class generate multiple variants of the same method
+ 	
+ 	Why to use:
+ 	
+ 	(1) You want to keep an object oriented programming scheme in slang. This limits you to uniquely named methods. Should two classes use the methods with the same names and you want to be able to use both variants this enables you to do so. 
+ 	
+ 	(2) Imagine you use (1) and have classes A and B both using static polymorphism. Imagine you have a class C that uses A and/or B and gets used by A and/or B. Lets say C calls a method on A and A calls a method on C. This method on C calls a method implemented by A and B, but because B is the default the method from B will get called here, possibly resulting in invalid behaviour. (2) helps with propagating this info and causes the correct method from A to be called.
+ 	
+ 	How do you use it:
+ 	
+ 	(1) In all classes implementing the same methods you want to be able to resolve statically you call in declareCVarsIn:  the method CCodeGenerator>>staticallyResolveMethodNamed:forClass:to:. This will remove the method named as the first parameter and rename it to the third parameter. It is important to call this in all classes with this methods so the method names get resolved everywhere. The standard is to generate the third parameter by using (self staticallyResolvePolymorphicSelector: key). For an example see SpurGarbageCollector>>declareCVarsIn:.
+ 	
+ 	In all classes where you want to use your polymorphic methods you now can call CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to:in: in #declareCVarsIn: to resolve every occurence of the receiver in the first parameter to the class given in the second parameter only in the class given in the third parameter. This means you can define how to resolve receivers for other classes, a feature you should use very carefully as this can be confusing to understand. 
+ 	
+ 	If you want to resolve self to your own class you have to implement #hasPolymorphicSelectors on the class side. If it returns true, all sends with self as the receiver will get resolved to the current class. It is recommended to overwrite staticallyResolvePolymorphicSelector: in this case too, as possibly not all methods get statically resolved and therefore renamed. Internally staticallyResolvePolymorphicSelector: is used to get method name to be used when it is determined a receiver want polymorphic resolving. In this case every call to self would cause resolving the method name, even when it should not be resolved. By overwriting staticallyResolvePolymorphicSelector: to only resolve methods that are present in all classes that should be polymorphic you can avoid this. For an example see SpurGarbageCollector>>staticallyResolvePolymorphicSelector:
+ 	
+ 	(2) To use call CCodeGenerator>>recursivelyResolvePolymorpicReceiver:toVariants:in:default:. This will result in all methods and the transitive closure of methods using the receiver given as the first parameter to get resolved to a variant for every class given in the collection that is the second parameter. This is done in the class that is the third parameter (you should probably only call this for self) and if no type info is present the method will get resolved to the class given as the fourth parameter (the fourth parameter has to be a class that is part of the collection that is the second parameter).
+ 	
+ 	Lets call the methods in the transitive closure described above recursive polymorphic methods (rpm). If nothing is known about a rpm it gets resolved to the given default. If the rpm is a part of another rpm that has a defined type it is resolved to the same type. 
+ 	
+ 	You can resolve classes to a specific class part of the recursive polymophism by using CCodeGenerator>>forRecursivePolymorphismResolve:as:. If a method is known to belong to a class that is the first parameter it will get resolved as if it part of the second parameter. This is useful when you know the methods of a class should always be resolved to one specific part (e.g. because it is a helper class for a specific part of an algorithm)
+ 	
+ 	With the pragma #staticallyResolveMethod:to: you can overwrite how a specific method should be resolved. Helpful when a method should be resolved to a type independent given type information, because some invariants rely one variant of the polymorphic method is always called (takes precedence over all other rules described here!!)
+ 	
+ 	With the pragma #staticallyResolveReceiver:to: you can define how a receiver should be resolved on a method base. Helpful if you do not want to define how to resolve a receiver for a complete class (CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to:in:) or the algorithm is not able to determine the type of a receiver (e.g because it is hidden behind a call. 'objectMemory gc' would reference the gc defined by objectMemory, but because it is only checked against objectMemory and not gc (because that would require to resolve that too somehow) the algorithm normally would not know how to to reolve it. With the pragma you can define how to resolve 'objectMemory gc'
+ 	
+ 	Should the algorithm find a call to a method that is polymorphicly defined through (1), but have no type information for it it will cause a halt during resolving. You should then take a look at the comment directly above the halt and hopefully be able to resolve the problem (of you not having defined the type for a call enough (and hopefully not me having made an error))"!

Item was added:
+ ----- Method: CCodeGenerator>>addPolymorphicVariantsFor:referencing:with:default: (in category 'helpers polymorphic resolving') -----
+ addPolymorphicVariantsFor: aTMethod referencing: variableName with: classArray default: defaultClass
+ 
+ 	| tMethod |
+ 	tMethod := methods at: aTMethod selector.
+ 	methods at: aTMethod selector put: (aTMethod asPolymorphicBaseFor: classArray toResolve: variableName default: defaultClass).
+ 	classArray
+ 		do: [:class | | copy polymorphicMethod |
+ 			"make a copy to make sure we get no side effects on the copies"
+ 			copy := tMethod veryDeepCopy.
+ 			polymorphicMethod := copy asPolymorphicFor: variableName resolveTo: class.
+ 			
+ 			(methods at: aTMethod selector ifAbsent: []) ifNotNil:
+ 				[:conflict |
+ 				((aTMethod definingClass inheritsFrom: conflict definingClass)
+ 				 or: [aTMethod definingClass = conflict definingClass]) ifFalse:
+ 					[self error: 'Method name conflict: ', aTMethod selector]].
+ 			methods at: polymorphicMethod selector put: polymorphicMethod]!

Item was added:
+ ----- Method: CCodeGenerator>>forRecursivePolymorphismResolve:as: (in category 'public') -----
+ forRecursivePolymorphismResolve: aClass as: anotherClass
+ 
+ 	(mappingForRecursivePolymophism ifNil: [mappingForRecursivePolymophism := Dictionary new])
+ 		at: aClass
+ 		put: anotherClass!

Item was added:
+ ----- Method: CCodeGenerator>>generate:from: (in category 'nil') -----
+ generate: anUnknownSelector from: aKnownSelector
+ 	
+ 	(toGenerate ifNil: [toGenerate := OrderedCollection new])
+ 		add: aKnownSelector -> anUnknownSelector!

Item was added:
+ ----- Method: CCodeGenerator>>getClassFor:in: (in category 'helpers polymorphic resolving') -----
+ getClassFor: receiverSymbol in: aClass
+ 
+ 	^ (receiverSymbol = 'self' and: [aClass hasPolymorphicSelectors])
+ 		ifTrue: [aClass]
+ 		ifFalse: [staticallyResolvedPolymorphicReceivers 
+ 					at: aClass
+ 					ifPresent: [:dictionary | dictionary at: receiverSymbol ifAbsent: [nil]]
+ 					ifAbsent: [nil]]!

Item was added:
+ ----- Method: CCodeGenerator>>getClassFromPragmasIn:ifMatching: (in category 'helpers polymorphic resolving') -----
+ getClassFromPragmasIn: aTMethod ifMatching: receiverSymbol
+ 
+ 	^ (aTMethod pragmasAt: #staticallyResolveReceiver:to:)
+ 		ifNotNil: [:pragmas | 
+ 			pragmas 
+ 				detect: [:pragma | receiverSymbol = (pragma argumentAt: 1)]
+ 				ifFound: [:pragma | Smalltalk at: (pragma argumentAt: 2)]
+ 				ifNone: []]!

Item was added:
+ ----- Method: CCodeGenerator>>hasPolymorphicMethod:in: (in category 'helpers polymorphic resolving') -----
+ hasPolymorphicMethod: aSelector in: aClass
+ 
+ 	^ aClass withAllSuperclasses
+ 		anySatisfy: [:class | (recursivePolymorphicMethodsMap at: class ifAbsent: [{}]) includes: aSelector]!

Item was removed:
- ----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: (in category 'public') -----
- ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode
- 	"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
- 	 prefixed with a given string to disambiguate. This hack allows us to use two different
- 	 compaction algorithms with the same API at the same time; the selection being done
- 	 by a class which holds the flag stating which algorithm is in effect at the current time."
- 	| class |
- 	staticallyResolvedPolymorphicReceivers ifNil: [^self].
- 	aSendNode receiver isVariable ifFalse:
- 		[^self].
- 	class := staticallyResolvedPolymorphicReceivers
- 				at: aSendNode receiver name
- 				ifAbsent: [^self].
- 	aSendNode selector: (class staticallyResolvePolymorphicSelector: aSendNode selector)!

Item was added:
+ ----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:fromMethod:in: (in category 'public') -----
+ ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode fromMethod: aTMethod in: aClass
+ 	"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
+ 	 prefixed with a given string to disambiguate. This hack allows us to use two different
+ 	 compaction algorithms with the same API at the same time; the selection being done
+ 	 by a class which holds the flag stating which algorithm is in effect at the current time."
+ 	| class receiverSymbol |
+ 	staticallyResolvedPolymorphicReceivers ifNil: [^self].
+ 	"(aTMethod selector = #SSTWGC_unmarkObjectsIn: and: [aSendNode selector = #setIsMarkedOf:to:]) ifTrue: [self halt]."
+ 	
+ 	(aSendNode receiver isVariable 
+ 		or: [(self hasPolymorphicMethod: aSendNode selector in: aClass )
+ 		or: [removedForPolymorphism includesKey: aSendNode selector]]) 
+ 			ifFalse: [^self].
+ 			
+ 	receiverSymbol := aSendNode receiver name.		
+ 	
+ 	class := (aTMethod pragmasAt: #staticallyResolveMethod:to:)
+ 		ifNotNil: [:pragmas | 
+ 			pragmas 
+ 				detect: [:pragma | aSendNode selector = (pragma argumentAt: 1)]
+ 				ifFound: [:pragma | "self halt."
+ 					self 
+ 						resolve: aSendNode 
+ 						to: (Smalltalk at: (pragma argumentAt: 2)) 
+ 						ifFound: [^self]]
+ 				ifNone: []].
+ 	
+ 	class ifNil: [self resolveRecursivePolymorphism: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: [^ self]].
+ 	
+ 	
+ 	
+ 	class := class ifNil: [self getClassFromPragmasIn: aTMethod ifMatching: receiverSymbol].
+ 	class := class ifNil: [self getClassFor: receiverSymbol in: aClass].
+ 	
+ 	class := class ifNil: [
+ 		removedForPolymorphism at: aSendNode selector
+ 			ifPresent: [: dict | 
+ 				"you probably ask yourself: why am I here? This halt is triggered if we wre unable to resolve your method, although 
+ 				it is polymorphic with a very high probability. You either have to declare to which type the method has to be resolved
+ 				or I forgot to include one case if the type should already be known
+ 				
+ 				Please have a look what aTMethod to know in which method the problem occured and aSendNode to know the call in aTMethod that is not enough defined. Probably you want to include a pragma #staticallyResolveReceiver:to: to define of which type the receiver is. Should the current method be a Polymorphic(Base)TMethod it is probably interesting why resolveRecursivePolymorphism:in:fromMethod:in:ifMatch: above does not resolve it."
+ 				self halt]].
+ 	
+ 	"we have to find a class to resolve the selector"
+ 	class
+ 		ifNotNil: [
+ 			aSendNode 
+ 						setSelectorForPolymorphism: (class staticallyResolvePolymorphicSelector: aSendNode selector)]
+ 	
+ 	!

Item was removed:
- ----- Method: CCodeGenerator>>ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:fromMethodIn: (in category 'public') -----
- ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode fromMethodIn: aClass
- 	"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
- 	 prefixed with a given string to disambiguate. This hack allows us to use two different
- 	 compaction algorithms with the same API at the same time; the selection being done
- 	 by a class which holds the flag stating which algorithm is in effect at the current time."
- 	| class |
- 	staticallyResolvedPolymorphicReceivers ifNil: [^self].
- 	aSendNode receiver isVariable ifFalse:
- 		[^self].
- 	
- 	class := (aSendNode receiver name = 'self' and: [aClass hasPolymorphicSelectors])
- 		ifTrue: [aClass]
- 		ifFalse: [staticallyResolvedPolymorphicReceivers
- 					at: aSendNode receiver name
- 					ifAbsent: [^self]].
- 	
- 	aSendNode selector: (class staticallyResolvePolymorphicSelector: aSendNode selector)!

Item was changed:
  ----- Method: CCodeGenerator>>isConstantNode:valueInto: (in category 'utilities') -----
  isConstantNode: aNode valueInto: aBlock
  	"Answer if aNode evaluates to a constant, and if so, evaluate aBlock with the value of that constant."

  	aNode isConstant ifTrue:
  		[(aNode isDefine
  		  and: [self defineAtCompileTime: aNode name]) ifTrue:
  			[^false].
  		 aBlock value: aNode value.
  		 ^true].
  	(aNode isVariable
  	 and: [aNode name = #nil]) ifTrue:
  		[aBlock value: nil.
  		 ^true].
  	aNode isSend ifTrue:
+ 		[(self anyMethodNamed: aNode unmodifiedSelector)
- 		[(self anyMethodNamed: aNode selector)
  			ifNil:
  				[(VMBasicConstants valueOfBasicSelector: aNode selector) ifNotNil:
  					[:value|
  					 aBlock value: value.
  					 ^true].
  				 aNode constantNumbericValueOrNil ifNotNil:
  					[:value|
  					 aBlock value: value.
  					 ^true]]
  			ifNotNil:
  				[:m|
  				(m isMacroWithDefinition not
  				 and: [m statements size = 1
  				 and: [m statements last isReturn]]) ifTrue:
  					[^self isConstantNode: m statements last expression valueInto: aBlock]]].
  	^false!

Item was added:
+ ----- Method: CCodeGenerator>>isReceiverProbablyPolymorpicSendReturningConstant: (in category 'helpers polymorphic resolving') -----
+ isReceiverProbablyPolymorpicSendReturningConstant: aSendNode
+ 
+ 	^ aSendNode receiver isSend 
+ 		and: [aSendNode receiver oldSelector notNil 
+ 		and: [methods 
+ 				at: aSendNode receiver selector 
+ 				ifPresent: [:method | method isReturnConstant] 
+ 				ifAbsent: [false]]]!

Item was changed:
  ----- Method: CCodeGenerator>>prepareMethods (in category 'utilities') -----
  prepareMethods
  	| globals |
  	globals := Set new: 200.
  	globals addAll: variables.
  	methods do:
  		[:m |
  		m locals, m args do:
  			[:var |
  			(globals includes: var) ifTrue:
  				[self error: 'Local variable ''', var, ''' may mask global when inlining ', m selector].
  			((methods at: var ifAbsent: [nil]) ifNil: [false] ifNotNil: [:m1| m1 isStructAccessor not]) ifTrue:
  				[logger
  					ensureCr;
  					nextPutAll: 'Local variable name ''', var, ''' in ';
  					nextPutAll: m selector;
  					nextPutAll: ' may mask method when inlining';
  					cr]].
  		m bindClassVariablesIn: constants.
+ 		m prepareMethodIn: self].
+ 	
+ 	toGenerate do:
+ 		[:each | | copy |
+ 			self assert: (methods includesKey: each key).
+ 			copy := (methods at: each key) veryDeepCopy.
+ 			copy selector: each value.
+ 			copy static: false.
+ 			self addMethod: copy]!
- 		m prepareMethodIn: self]!

Item was added:
+ ----- Method: CCodeGenerator>>recursivelyResolvePolymorpicReceiver:toVariants:in:default: (in category 'public') -----
+ recursivelyResolvePolymorpicReceiver: variableName toVariants: classArray in: aClass default: defaultClass
+ 	"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
+ 	 prefixed with a given string to disambiguate. This hack allows us to use two different
+ 	 compaction algorithms with the same API at the same time; the selection being done
+ 	 by a class which holds the flag stating which algorithm is in effect at the current time."
+ 	| methodsInClass methodsReferencingReceiver missingSelectors notGeneratedMethods oldMissingSelectorsSize |
+ 	((recursivelyResolvedPolymorphicReceivers ifNil: [recursivelyResolvedPolymorphicReceivers := Dictionary new])
+ 		at: aClass
+ 		ifAbsentPut: [Dictionary new])
+ 			at: variableName
+ 			put: classArray.
+ 		
+ 	"not generated methods can forward to the polymophic target. Scan them for use, so we can methods that use them include into the transitice closure of referencing methods"	
+ 	notGeneratedMethods := Dictionary newFrom: (((Pragma allNamed: #doNotGenerate in: aClass) 
+ 		collect: [:ea | | selector |
+ 			selector := ea method selector.
+ 			"some methods cannot be converted. Ignore them and print them for the developer to do something about it"
+ 			[selector -> (ea method asTranslationMethodOfClass: TMethod)] 
+ 				on: Error 
+ 				do: [Transcript showln: selector , ' of notGenerated methods could not be translated to a TMethod. Should it be relevant for polymorphism please fix it'.
+ 					selector]])
+ 		select: [:ea | ea isSymbol not]).
+ 		
+ 		
+ 		
+ 	methodsInClass := methods select: [:each | each definingClass = aClass].
+ 	methodsReferencingReceiver := methodsInClass select: [:method | (method allReferencedVariablesUsing: self) includes: variableName].
+ 
+ 	missingSelectors := self transitiveClosureOfMethods: methodsReferencingReceiver , notGeneratedMethods in: aClass.
+ 	oldMissingSelectorsSize := missingSelectors size.
+ 	
+ 	"do not start to generate not generated methods now. We just wanted to get their transistive closure"
+ 	missingSelectors := missingSelectors copyWithoutAll: notGeneratedMethods keys.
+ 	self assert: missingSelectors size = (oldMissingSelectorsSize - notGeneratedMethods size).
+ 	
+ 	missingSelectors do: [:selector | methods 
+ 											at: selector 
+ 											ifPresent: [:method |
+ 												(recursivePolymorphicMethodsMap ifNil: [recursivePolymorphicMethodsMap := Dictionary new])
+ 													at: aClass
+ 													ifPresent: [:set | set add: method selector]
+ 													ifAbsentPut: [Set with: method selector].
+ 												self 
+ 													addPolymorphicVariantsFor: method 
+ 													referencing: variableName 
+ 													with: classArray
+ 													default: defaultClass] 
+ 											ifAbsent: []].!

Item was added:
+ ----- Method: CCodeGenerator>>resolve:inSelfSend:in:to:ifFound: (in category 'helpers polymorphic resolving') -----
+ resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: receiverClass ifFound: aReturnBlock
+ 
+ 	(receiverSymbol = 'self' and: [self hasPolymorphicMethod: aSendNode selector in: aClass])
+ 						ifTrue: [
+ 							aSendNode
+ 									setSelectorForPolymorphism: ((methods at: aSendNode selector) polymorphicSelectorForClass: receiverClass).
+ 								aReturnBlock value]!

Item was added:
+ ----- Method: CCodeGenerator>>resolve:to:ifFound: (in category 'helpers polymorphic resolving') -----
+ resolve: aSendNode to: receiverClass ifFound: aReturnBlock
+ 
+ 	| newSelector |
+ 	newSelector := methods 
+ 						at: aSendNode selector 
+ 						ifPresent: [:method | (method isPolymorphic or: [method isPolymorphicBase])
+ 													ifTrue: [method polymorphicSelectorForClass: receiverClass]
+ 													ifFalse: [nil]]
+ 						ifAbsent: ["when a class uses normal static polymorphism it removes selectors in favour of the prefixed ones.
+ 							Lookup if this is the case here, if so resolve to the one specific to receiverClass"
+ 							removedForPolymorphism 
+ 								at: aSendNode selector
+ 								ifPresent: [:mapping | mapping at: receiverClass ifAbsent: [nil]]
+ 								ifAbsent: [nil]].
+ 	newSelector
+ 		ifNotNil: [aSendNode
+ 					setSelectorForPolymorphism: newSelector.
+ 				aReturnBlock value] !

Item was added:
+ ----- Method: CCodeGenerator>>resolvePolymorphicMethod:in:fromMethod:in:ifMatch: (in category 'helpers polymorphic resolving') -----
+ resolvePolymorphicMethod: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: aReturnBlock
+ 
+ 	self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: aTMethod receiverClass ifFound: aReturnBlock.
+ 			
+ 	receiverSymbol = aTMethod receiverToResolve
+ 			ifTrue: [self resolve: aSendNode to: aTMethod receiverClass ifFound: aReturnBlock].
+ 			
+ 	"now get desperate. look if there is a method with the selectors name that is mentioned in a polymorphic context"
+ 	removedForPolymorphism at: aSendNode selector 
+ 		ifPresent: [:dictionary | dictionary at: aTMethod receiverClass
+ 									ifPresent: [:selector |
+ 										aSendNode
+ 											setSelectorForPolymorphism: selector.
+ 										aReturnBlock value].
+ 									
+ 									"is the TMethods receiverClass associated with one of the polymorphic classes implementing  aSendNode selector?"
+ 									(mappingForRecursivePolymophism associationsSelect: [:assoc | assoc value = aTMethod receiverClass]) keys
+ 										detect: [:key | dictionary includesKey: key]
+ 										ifFound: [:class | 
+ 											aSendNode
+ 												setSelectorForPolymorphism: (dictionary at: class).
+ 											aReturnBlock value]].
+ 	
+ 	(self hasPolymorphicMethod: aSendNode selector in: aTMethod receiverClass)
+ 		ifTrue: [self halt]!

Item was added:
+ ----- Method: CCodeGenerator>>resolvePolymorphicMethod:in:to:on:in:ifMatch: (in category 'helpers polymorphic resolving') -----
+ resolvePolymorphicMethod: receiverSymbol in: aSendNode to: receiverClass on: receiverToResolve in: aClass ifMatch: aReturnBlock
+ 
+ 	self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: receiverClass ifFound: aReturnBlock.
+ 			
+ 	receiverSymbol = receiverToResolve
+ 			ifTrue: [self resolve: aSendNode to: receiverClass ifFound: aReturnBlock].
+ 			
+ 	"now get desperate. look if there is a method with the selectors name that is mentioned in a polymorphic context"
+ 	removedForPolymorphism at: aSendNode selector 
+ 		ifPresent: [:dictionary | dictionary at: receiverClass
+ 									ifPresent: [:selector |
+ 										aSendNode
+ 											setSelectorForPolymorphism: selector.
+ 										aReturnBlock value].
+ 									
+ 									"is the TMethods receiverClass associated with one of the polymorphic classes implementing  aSendNode selector?"
+ 									(mappingForRecursivePolymophism associationsSelect: [:assoc | assoc value = receiverClass]) keys
+ 										detect: [:key | dictionary includesKey: key]
+ 										ifFound: [:class | 
+ 											aSendNode
+ 												setSelectorForPolymorphism: (dictionary at: class).
+ 											aReturnBlock value]].
+ 	
+ 	(self hasPolymorphicMethod: aSendNode selector in: receiverClass)
+ 		ifTrue: [self halt]!

Item was added:
+ ----- Method: CCodeGenerator>>resolveRecursivePolymorphism:in:fromMethod:in:ifMatch: (in category 'helpers polymorphic resolving') -----
+ resolveRecursivePolymorphism: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: aReturnBlock
+ 
+ 	"- if the current TMethod is a base method we want to resolve it to the default
+ 	- if the current TMethod is a polymorphic method, meaning it got a type to resolve for, apply this type to submethods
+ 	- if the called method (from SendNode) is a polymorphic base method we resolve it to the default if we are not in a class associated with only one type. Should this be the case we resolve the method to this type"
+ 
+ 	"((aTMethod selector = #globalGarbageCollect) and: [aSendNode selector = #preGlobalGCActions]) ifTrue: [0 halt]."
+ 	
+ 	aTMethod isPolymorphicBase
+ 		ifTrue: [self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: aTMethod default ifFound: aReturnBlock.
+ 							
+ 				"if the polymorphic receiver is mentioned we resolve the method to the default"
+ 				self resolve: aSendNode to: aTMethod default ifFound: aReturnBlock.
+ 				
+ 				
+ 				"now get desperate. look if there is a method with the selectors name that is mentioned in a polymorphic context"
+ 				removedForPolymorphism at: aSendNode selector 
+ 					ifPresent: [:dictionary | dictionary at: aTMethod default 
+ 												ifPresent: [:selector |
+ 													aSendNode
+ 														setSelectorForPolymorphism: selector.
+ 													aReturnBlock value].
+ 												
+ 												"is the TMethods receiverClass associated with one of the polymorphic classes implementing  aSendNode selector?"
+ 											(mappingForRecursivePolymophism associationsSelect: [:assoc | assoc value = aTMethod default]) keys
+ 												detect: [:key | dictionary includesKey: key]
+ 												ifFound: [:class | 
+ 													aSendNode
+ 														setSelectorForPolymorphism: (dictionary at: class).
+ 													aReturnBlock value]].
+ 				
+ 				(self hasPolymorphicMethod: aSendNode selector in: aTMethod default)
+ 					ifTrue: [self halt]].
+ 						
+ 	aTMethod isPolymorphic
+ 		ifTrue: [self resolvePolymorphicMethod: receiverSymbol in: aSendNode fromMethod: aTMethod in: aClass ifMatch: aReturnBlock].
+ 	
+ 	methods at: aSendNode selector
+ 		ifPresent: [:calledMethod | 
+ 			calledMethod isPolymorphicBase
+ 				ifTrue: [ | alternativeClass matchingClass |
+ 					"we have type info and the calledMethod does not care which type it is -> use type info"
+ 					aTMethod isPolymorphic
+ 						ifTrue: [
+ 							aSendNode
+ 								setSelectorForPolymorphism: (calledMethod polymorphicSelectorForClass: aTMethod receiverClass).
+ 							aReturnBlock value ].
+ 						
+ 					self resolve: receiverSymbol inSelfSend: aSendNode in: aClass to: calledMethod default ifFound: aReturnBlock.
+ 
+ 					alternativeClass := mappingForRecursivePolymophism at: aClass ifAbsent: [nil].
+ 					(calledMethod classes includes: aClass)
+ 						ifTrue: [matchingClass := aClass]
+ 						ifFalse: [(calledMethod classes includes: alternativeClass)
+ 									ifTrue: [matchingClass := alternativeClass]].
+ 						matchingClass ifNotNil: [
+ 							aSendNode
+ 								setSelectorForPolymorphism: (calledMethod polymorphicSelectorForClass: matchingClass).
+ 							aReturnBlock value]]]
+ 		ifAbsent: []	.
+ 	
+ 	!

Item was changed:
  ----- Method: CCodeGenerator>>staticallyResolveMethodNamed:forClass:to: (in category 'public') -----
  staticallyResolveMethodNamed: selector forClass: aClass to: staticallyResolvedSelector
  	"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
  	 prefixed with a given string to disambiguate. This hack allows us to use two different
  	 compaction algorithms with the same API at the same time; the selection being done
  	 by a class which holds the flag stating which algorithm is in effect at the current time."
  	| method |
  	method := methods
  					removeKey: selector
  					ifAbsent:
+ 						["self halt. "self logger cr; nextPutAll: 'warning: did not find ', selector, ' to be able to map to ', staticallyResolvedSelector.
- 						[self logger cr; nextPutAll: 'warning: did not find ', selector, ' to be able to map to ', staticallyResolvedSelector.
  						^self].
  	method selector: staticallyResolvedSelector.
+ 	methods at: staticallyResolvedSelector put: method.
+ 	
+ 	(removedForPolymorphism ifNil: [removedForPolymorphism := Dictionary new]) 
+ 		at: selector
+ 		ifPresent: [:set | set at: aClass put: staticallyResolvedSelector ]
+ 		ifAbsentPut: [Dictionary with: aClass -> staticallyResolvedSelector]
+ 		!
- 	methods at: staticallyResolvedSelector put: method!

Item was removed:
- ----- Method: CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to: (in category 'public') -----
- staticallyResolvedPolymorphicReceiver: variableName to: aClass
- 	"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
- 	 prefixed with a given string to disambiguate. This hack allows us to use two different
- 	 compaction algorithms with the same API at the same time; the selection being done
- 	 by a class which holds the flag stating which algorithm is in effect at the current time."
- 	(staticallyResolvedPolymorphicReceivers ifNil: [staticallyResolvedPolymorphicReceivers := Dictionary new])
- 		at: variableName
- 		put: aClass!

Item was added:
+ ----- Method: CCodeGenerator>>staticallyResolvedPolymorphicReceiver:to:in: (in category 'public') -----
+ staticallyResolvedPolymorphicReceiver: variableName to: aClass in: theClassWithTheVariable
+ 	"We allow a limited amount of polymorphism; if a class chooses, its selectors can be
+ 	 prefixed with a given string to disambiguate. This hack allows us to use two different
+ 	 compaction algorithms with the same API at the same time; the selection being done
+ 	 by a class which holds the flag stating which algorithm is in effect at the current time."
+ 	((staticallyResolvedPolymorphicReceivers ifNil: [staticallyResolvedPolymorphicReceivers := Dictionary new])
+ 		at: theClassWithTheVariable
+ 		ifAbsentPut: [Dictionary new])
+ 			at: variableName
+ 			put: aClass!

Item was added:
+ ----- Method: CCodeGenerator>>transitiveClosureOfMethods:in: (in category 'helpers polymorphic resolving') -----
+ transitiveClosureOfMethods: aTMethodDictionary in: aClass
+ 
+ 	| alreadySeenSelectors toVisit toVisitNext |
+ 	alreadySeenSelectors := Set newFrom: aTMethodDictionary keys.
+ 	toVisit := OrderedCollection newFrom: aTMethodDictionary keys.
+ 	toVisitNext := OrderedCollection new.
+ 	
+ 	[toVisit
+ 		do: [:each | (SystemNavigation default allCallsOn: each fromBehaviors: (aClass withAllSuperclasses copyUpTo: VMClass )sorted: false)
+ 								do: [:method | |selector | 
+ 									selector := method selector.
+ 									(alreadySeenSelectors includes: selector)
+ 										ifFalse: [alreadySeenSelectors add: selector.
+ 											toVisitNext add: selector] ]].
+ 	toVisit := toVisitNext.
+ 	toVisitNext := OrderedCollection new.
+ 	
+ 	toVisit notEmpty] whileTrue.
+ 
+ 	^ alreadySeenSelectors!

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."
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
  	| mapInstructionPointer |
  	(objectMemory shouldRemapObj: method) ifTrue:
  		["i.e. interpreter instructionPointer in method as opposed to machine code?"
  		(mapInstructionPointer := instructionPointer > method) ifTrue:
  			[instructionPointer := instructionPointer - method]. "*rel to method"
  		method := objectMemory remapObj: method.
  		mapInstructionPointer ifTrue:
  			[instructionPointer := instructionPointer + method]]. "*rel to method"
  	(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
  		[newMethod := objectMemory remapObj: newMethod]!

Item was changed:
  ----- Method: CoInterpreterMT>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
  	 during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
  	<var: #vmThread type: #'CogVMThread *'>
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
  	super mapInterpreterOops.

  	"Per-thread state; trace each thread's own newMethod and stack of awol processes."
  	1 to: cogThreadManager getNumThreads do:
  		[:i| | vmThread |
  		vmThread := cogThreadManager vmThreadAt: i.
  		vmThread state ifNotNil:
  			[(vmThread newMethodOrNull notNil
  			 and: [objectMemory shouldRemapOop: vmThread newMethodOrNull]) ifTrue:
  				[vmThread newMethodOrNull: (objectMemory remapObj: vmThread newMethodOrNull)].
  			 0 to: vmThread awolProcIndex - 1 do:
  				[:j|
  				(objectMemory shouldRemapOop: (vmThread awolProcesses at: j)) ifTrue:
  					[vmThread awolProcesses at: j put: (objectMemory remapObj: (vmThread awolProcesses at: j))]]]]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
  primitiveFullGC
  	"Do a full garbage collection.  In SqueakV3ObjectMemory, answer the number
  	 of bytes available (including swap space if dynamic memory management is
  	 supported).  In Spur, answer the size of the largest free chunk."
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector>

  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[self methodReturnInteger: objectMemory fullGC.
  		 ^self].
  	objectMemory incrementalGC.  "maximimize space for forwarding table"
  	objectMemory fullGC.
  	self methodReturnInteger: (objectMemory bytesLeft: true)!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveObjectsAccessibleFromRoots (in category 'image segment in/out') -----
  primitiveObjectsAccessibleFromRoots
  	"This primitive is called from Squeak as...
  		arrayOfRoots uniquelyAccessibleObjects"

  	"This primitive answers an array of the receiver and every object in its proper tree of subParts (ie, that is not refered to from anywhere else outside the tree)."
  	"This primitive could be used to implement the primitiveStoreImageSegment segment, thanks to a suggestion from Igor Stassenko. Currently it is
  	 used only to debug that primitive."
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector>
- 
  	| arrayOfRoots result |
  	arrayOfRoots := self stackTop.

  	"Essential type checks"
  	(objectMemory isArray: arrayOfRoots)				"Must be indexable pointers"
  		ifFalse: [^self primitiveFail].

  	result := objectMemory objectsAccessibleFromRoots: arrayOfRoots.
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [(objectMemory isIntegerObject: result)
  	 and: [(objectMemory integerValueOf: result) = PrimErrNoMemory]]) ifTrue:
  		[objectMemory fullGC.
  		 arrayOfRoots := self stackTop.
  		 result := objectMemory objectsAccessibleFromRoots: arrayOfRoots].
  	(objectMemory isIntegerObject: result)
  		ifTrue: [self primitiveFailFor: (objectMemory integerValueOf: result)]
  		ifFalse: [self methodReturnValue: result]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveStoreImageSegment (in category 'image segment in/out') -----
  primitiveStoreImageSegment
  	"This primitive is called from Squeak as...
  		<imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray."

  "This primitive will store a binary image segment (in the same format as the Squeak image file) of the receiver and every object in its proper tree of subParts (ie, that is not refered to from anywhere else outside the tree).  All pointers from within the tree to objects outside the tree will be copied into the array of outpointers.  In their place in the image segment will be an oop equal to the offset in the outPointer array (the first would be 4). but with the high bit set."

  "The primitive expects the array and wordArray to be more than adequately long.  In this case it returns normally, and truncates the two arrays to exactly the right size.  To simplify truncation, both incoming arrays are required to be 256 bytes or more long (ie with 3-word headers).  If either array is too small, the primitive will fail, but in no other case.

  During operation of the primitive, it is necessary to convert from both internal and external oops to their mapped values.  To make this fast, the headers of the original objects in question are replaced by the mapped values (and this is noted by adding the forbidden XX header type).  Tables are kept of both kinds of oops, as well as of the original headers for restoration.

  To be specific, there are two similar two-part tables, the outpointer array, and one in the upper fifth of the segmentWordArray.  Each grows oops from the bottom up, and preserved headers from halfway up.

  In case of either success or failure, the headers must be restored.  In the event of primitive failure, the table of outpointers must also be nilled out (since the garbage in the high half will not have been discarded."
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurStopTheWorldGarbageCollector>
- 
  	| outPointerArray segmentWordArray arrayOfRoots ecode |

  	outPointerArray := self stackTop.
  	segmentWordArray := self stackValue: 1.
  	arrayOfRoots := self stackValue: 2.

  	"Essential type checks"
  	((objectMemory isArray: arrayOfRoots)				"Must be indexable pointers"
  	and: [(objectMemory isArray: outPointerArray)		"Must be indexable pointers"
  	and: [objectMemory isWords: segmentWordArray]])	"Must be indexable words"
  		ifFalse: [^self primitiveFail].

  	ecode := objectMemory storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots.
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [ecode = PrimErrNeedCompaction]) ifTrue:
  		[objectMemory fullGC.
  		 outPointerArray := self stackTop.
  		 segmentWordArray := self stackValue: 1.
  		 arrayOfRoots := self stackValue: 2.
  		 ecode := objectMemory storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots].
  	ecode = PrimNoErr
  		ifTrue: [self pop: 3]  "...leaving the receiver on the stack as return value"
  		ifFalse: [self primitiveFailFor: ecode]!

Item was added:
+ TMethod subclass: #PolymorphicBaseTMethod
+ 	instanceVariableNames: 'classes default receiverToResolve'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Translation to C'!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>classes (in category 'accessing') -----
+ classes
+ 
+ 	^ classes!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>classes: (in category 'accessing') -----
+ classes: anObject
+ 
+ 	classes := anObject.!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>default (in category 'accessing') -----
+ default
+ 
+ 	^ default!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>default: (in category 'accessing') -----
+ default: anObject
+ 
+ 	default := anObject.!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>isPolymorphicBase (in category 'testing') -----
+ isPolymorphicBase
+ 
+ 	^ true!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>printOn: (in category 'as yet unclassified') -----
+ printOn: aStream
+ 
+ 	super printOn: aStream.
+ 	aStream
+ 		nextPut: $<;
+ 		nextPutAll: self default name;
+ 		nextPut: $>!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>receiverToResolve (in category 'accessing') -----
+ receiverToResolve
+ 
+ 	^ receiverToResolve!

Item was added:
+ ----- Method: PolymorphicBaseTMethod>>receiverToResolve: (in category 'accessing') -----
+ receiverToResolve: anObject
+ 
+ 	receiverToResolve := anObject.!

Item was added:
+ TMethod subclass: #PolymorphicTMethod
+ 	instanceVariableNames: 'receiverToResolve receiverClass'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Translation to C'!

Item was added:
+ ----- Method: PolymorphicTMethod>>isPolymorphic (in category 'testing') -----
+ isPolymorphic
+ 
+ 	^ true!

Item was added:
+ ----- Method: PolymorphicTMethod>>printOn: (in category 'as yet unclassified') -----
+ printOn: aStream
+ 
+ 	super printOn: aStream.
+ 	aStream
+ 		nextPut: $<;
+ 		nextPutAll: self receiverClass name;
+ 		nextPut: $>!

Item was added:
+ ----- Method: PolymorphicTMethod>>receiverClass (in category 'accessing') -----
+ receiverClass
+ 
+ 	^ receiverClass!

Item was added:
+ ----- Method: PolymorphicTMethod>>receiverClass: (in category 'accessing') -----
+ receiverClass: anObject
+ 
+ 	receiverClass := anObject.!

Item was added:
+ ----- Method: PolymorphicTMethod>>receiverToResolve (in category 'accessing') -----
+ receiverToResolve
+ 
+ 	^ receiverToResolve!

Item was added:
+ ----- Method: PolymorphicTMethod>>receiverToResolve: (in category 'accessing') -----
+ receiverToResolve: anObject
+ 
+ 	receiverToResolve := anObject.!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>setIsMarkedOf:to: (in category 'header access') -----
  setIsMarkedOf: objOop to: aBoolean
  	self assert: (self isFreeObject: objOop) not.
+ 	gc assertSettingGCFlagsIsOk: objOop.
+ 	
- 	"gc assertSettingGCFlagsIsOk: objOop."
  	self longAt: objOop
  		put: (aBoolean
  				ifTrue: [(self longAt: objOop) bitOr: 1 << self markedBitFullShift]
  				ifFalse: [(self longAt: objOop) bitAnd: (1 << self markedBitFullShift) bitInvert64])!

Item was changed:
  ----- Method: SpurGarbageCollector class>>declareCVarsIn: (in category 'as yet unclassified') -----
  declareCVarsIn: aCCodeGenerator

  	super declareCVarsIn: aCCodeGenerator.
  	aCCodeGenerator
+ 		var: #allocatorShouldAllocateBlack type: #usqInt.
+ 		
+ 	"do not generate polymorphic methods for abstract baseclass SpurGarbageCollector"
+ 	self = SpurGarbageCollector ifTrue: [^ self].
+ 	
+ 	aCCodeGenerator
+ 		staticallyResolvedPolymorphicReceiver: 'marker' to: self markerClass in: self;
+ 		staticallyResolvedPolymorphicReceiver: 'compactor' to: self compactorClass in: self.
+ 		
+ 	self selectorsInIncrementalAndStopTheWorldGC
+ 		do: [:key |
+ 			aCCodeGenerator
+ 				staticallyResolveMethodNamed: key 
+ 				forClass: self 
+ 				to: (self staticallyResolvePolymorphicSelector: key)].!
- 		var: #allocatorShouldAllocateBlack type: #usqInt.!

Item was added:
+ ----- Method: SpurGarbageCollector class>>hasPolymorphicSelectors (in category 'as yet unclassified') -----
+ hasPolymorphicSelectors
+ 	"when using the incremental gc we have polymorphic selectors and have to resolve them"
+ 
+ 	^ self ~= SpurGarbageCollector and: [SpurMemoryManager wantsIncrementalGC]!

Item was added:
+ ----- Method: SpurGarbageCollector class>>selectorsInIncrementalAndStopTheWorldGC (in category 'as yet unclassified') -----
+ selectorsInIncrementalAndStopTheWorldGC
+ 
+ 	^ SpurIncrementalGarbageCollector selectors intersection: SpurStopTheWorldGarbageCollector selectors!

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

Item was changed:
  ----- Method: SpurGarbageCollector>>assertSettingGCFlagsIsOk: (in category 'as yet unclassified') -----
  assertSettingGCFlagsIsOk: objOop

+ 	^ self subclassResponsibility!
- 	<doNotGenerate>!

Item was changed:
  ----- Method: SpurGarbageCollector>>doScavenge: (in category 'scavenge') -----
  doScavenge: tenuringCriterion
- 	"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.

+ 	self subclassResponsibility!
- 	self incrementalCollect!

Item was changed:
  ----- Method: SpurGarbageCollector>>isIncremental (in category 'testing') -----
  isIncremental

+ 	self subclassResponsibility!
- 	^ false!

Item was added:
+ ----- Method: SpurGarbageCollector>>isOkToClearReference: (in category 'testing') -----
+ isOkToClearReference: objOop
+ 
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: SpurGarbageCollector>>isOkToScavengeRememberedObject: (in category 'testing') -----
  isOkToScavengeRememberedObject: objOop

+ 	self subclassResponsibility!
- 	^ true!

Item was changed:
  ----- Method: SpurGarbageCollector>>markObjects: (in category 'as yet unclassified') -----
  markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged

+ 	self subclassResponsibility!
- 	marker markersMarkObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged!

Item was changed:
  ----- Method: SpurGarbageCollector>>scavengingGCTenuringIf: (in category 'scavenge') -----
  scavengingGCTenuringIf: tenuringCriterion
+ 	
+ 	"implementation, although the same, implemented in subclasses to generate static polymorphic methods from them"
+ 	self subclassResponsibility!
- 	"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 added:
+ ----- Method: SpurGarbageCollector>>writeBarrierFor:at:with: (in category 'barrier') -----
+ writeBarrierFor: anObject at: index with: value
+ 
+ 	self subclassResponsibility!

Item was changed:
  ----- Method: SpurGenerationScavenger class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(eden futureSpace pastSpace) do:
  		[:var| aCCodeGenerator var: var type: #SpurNewSpaceSpace].
  	aCCodeGenerator
  		var: #rememberedSet type: #'sqInt *';
  		var: #tenuringProportion type: #double;
  		var: #scavengeLogRecord type: #SpurScavengeLogRecord;
+ 		var: #scavengeLog type: #'FILE *'.
+ 		
+ 	SpurMemoryManager wantsIncrementalGC
+ 		ifTrue: [aCCodeGenerator
+ 					recursivelyResolvePolymorpicReceiver: 'manager' toVariants: {SpurIncrementalGarbageCollector. SpurStopTheWorldGarbageCollector} in: self default: SpurIncrementalGarbageCollector]!
- 		var: #scavengeLog type: #'FILE *'!

Item was changed:
  ----- Method: SpurGenerationScavenger>>processWeakSurvivor: (in category 'weakness and ephemerality') -----
  processWeakSurvivor: weakObj
  	"Process a weak survivor on the weakList.  Those of its fields
  	 which have not survived the scavenge should be nilled, and if any
  	 are, the coInterpreter should be informed via fireFinalization:.
  	 Answer if the weakObj has any young referents."
  	| weakObjShouldMourn hasYoungReferents numStrongSlots  |
  	weakObjShouldMourn := hasYoungReferents := false.
  	"N.B. generateToByDoLimitExpression:negative:on: guards against (unsigned)0 - 1 going +ve"
  	numStrongSlots := manager numFixedSlotsOf: weakObj.
  	0 to: numStrongSlots - 1 do:
  		[:i| | referent |
  		 referent := manager fetchPointer: i ofObject: weakObj.
  		 ((manager isNonImmediate: referent)
  		  and: [manager isYoungObject: referent]) ifTrue:
  			[hasYoungReferents := true]].
  	numStrongSlots
  		to: (manager numSlotsOf: weakObj) - 1
  		do: [:i| | referent |
  			referent := manager fetchPointer: i ofObject: weakObj.
  			"Referent could be forwarded due to scavenging or a become:, don't assume."
  			(manager isNonImmediate: referent) ifTrue:
  				[(manager isForwarded: referent) ifTrue:
  					[referent := manager followForwarded: referent.
  					 "weakObj is either young or already in remembered table; no need to check"
  					 self assert: ((manager isReallyYoungObject: weakObj)
  								or: [manager isRemembered: weakObj]).
  					 manager storePointerUnchecked: i ofObject: weakObj withValue: referent].
  				(self isMaybeOldScavengeSurvivor: referent)
  					ifTrue:
  						[(manager isYoungObject: referent) ifTrue:
  							[hasYoungReferents := true]]
  					ifFalse:
+ 						[(manager gc isOkToClearReference: referent)
- 						[(self isOkToClearReference: referent)
  							ifTrue: [
  								weakObjShouldMourn := true.
  								 manager
  									storePointerUnchecked: i
  									ofObject: weakObj
  									withValue: manager nilObject]]]].
  	weakObjShouldMourn ifTrue:
  		[coInterpreter fireFinalization: weakObj].
  	^hasYoungReferents!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeRememberedSetStartingAt: (in category 'scavenger') -----
  scavengeRememberedSetStartingAt: n
  	"scavengeRememberedSetStartingAt: n traverses objects in the remembered
  	 set starting at the nth one.  If the object does not refer to any new objects, it
  	 is removed from the set.  Otherwise, its new referents are scavenged.  Defer
  	 scavenging ephemerons until after a complete scavenge has been performed,
  	 so that triggered ephemerons can be fired.  Move them to the front of the set
  	 and count them in numRememberedEphemerons for later scanning."
  	<inline: false>
  	| destIndex sourceIndex referrer |
  	sourceIndex := destIndex := n.
  	[sourceIndex < rememberedSetSize] whileTrue:
  		["*Don't* follow forwarding pointers here. oldSpace objects may refer
+ 		  to these roots, and so they can't be removed in the scavenge (old objects 
+ 		could point to forwarding pointers that are in the young space and need
+ 		to be updated. As it would be costly to add such old objects to the remembered
+ 		set just update the forwarding pointers and keep them here in the remembered set)."
- 		  to these roots, and so they can't be removed in the scavenge."
  		referrer := rememberedSet at: sourceIndex.
  		"Any potential firing ephemerons should not be scanned yet.
  		 Move any to the front of the set to save time in later scanning."
  		((manager isEphemeron: referrer)
  		 and: [(self isScavengeSurvivor: ((manager keyOfEphemeron: referrer))) not])
  			ifTrue:
  				[self assert: destIndex >= numRememberedEphemerons.
  				 rememberedSet
  					at: destIndex put: (rememberedSet at: numRememberedEphemerons);
  					at: numRememberedEphemerons put: referrer.
  				 numRememberedEphemerons := numRememberedEphemerons + 1.
  				 destIndex := destIndex + 1]
  			ifFalse:
  				[((manager gc isOkToScavengeRememberedObject: referrer) and: [self scavengeReferentsOf: referrer])
  					ifTrue:
  						[rememberedSet at: destIndex put: referrer.
  						 destIndex := destIndex + 1]
  					ifFalse:
  						[manager setIsRememberedOf: referrer to: false]].
  		 sourceIndex := sourceIndex + 1].
  	rememberedSetSize := destIndex.
  	self assert: self noUnfiredEphemeronsAtEndOfRememberedSet!

Item was changed:
  ----- Method: SpurHybridCompactor class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	aCCodeGenerator
+ 		staticallyResolvedPolymorphicReceiver: 'planningCompactor' to: SpurPlanningCompactor in: self;
+ 		staticallyResolvedPolymorphicReceiver: 'selectiveCompactor' to: SpurSweeper in: self"SpurSelectiveCompactor" "The selector mangling is easier this way"!
- 		staticallyResolvedPolymorphicReceiver: 'planningCompactor' to: SpurPlanningCompactor;
- 		staticallyResolvedPolymorphicReceiver: 'selectiveCompactor' to: SpurSweeper"SpurSelectiveCompactor" "The selector mangling is easier this way"!

Item was added:
+ SpurGarbageCollector subclass: #SpurHybridGarbageCollector
+ 	instanceVariableNames: 'isInIncrementalMode incrementalGC stopTheWorldGC'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SpurGarbageCollector'!

Item was added:
+ ----- Method: SpurHybridGarbageCollector class>>classesForTranslation (in category 'translation') -----
+ classesForTranslation
+ 
+ 	^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }!

Item was added:
+ ----- Method: SpurHybridGarbageCollector class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ 	
+ 	aCCodeGenerator
+ 		staticallyResolvedPolymorphicReceiver: 'incrementalGC' to: SpurIncrementalGarbageCollector in: self;
+ 		staticallyResolvedPolymorphicReceiver: 'stopTheWorldGC' to: SpurStopTheWorldGarbageCollector in: self!

Item was added:
+ ----- Method: SpurHybridGarbageCollector>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	isInIncrementalMode := true.
+ 	incrementalGC := SpurIncrementalGarbageCollector new.
+ 	stopTheWorldGC := SpurStopTheWorldGarbageCollector new.!

Item was added:
+ ----- Method: SpurHybridGarbageCollector>>writeBarrierFor:at:with: (in category 'as yet unclassified') -----
+ writeBarrierFor: anObject at: index with: value
+ 
+ 	self isInIncrementalMode
+ 		ifTrue: [incrementalGC writeBarrierFor: anObject at: index with: value]
+ 		ifFalse: ["does nothing"]!

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

+ 	aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'.
+ 	
+ 	SpurMemoryManager wantsIncrementalGC
+ 		ifTrue: [| incrementalSelectors |
+ 			incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors.
+ 
+ 			(incrementalSelectors intersection: SpurPlanningCompactor selectors)
+ 				do: [:key | 
+ 					aCCodeGenerator
+ 						staticallyResolveMethodNamed: key 
+ 						forClass: self 
+ 						to: (self staticallyResolvePolymorphicSelector: key)]]!
- 	aCCodeGenerator var: #segmentToFill type: #'SpurSegmentInfo *'.!

Item was changed:
  ----- Method: SpurIncrementalCompactor>>compactSegment:freeStart:segIndex: (in category 'incremental compaction') -----
  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: 
  					["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: currentSegment).
+ 								currentSegment := currentSegment + 1.
+ 								^ fillStart].

  						self migrate: entity sized: bytesToCopy to: fillStart.

  						fillStart := fillStart + bytesToCopy.
  						self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))]]].

  	currentSegment := currentSegment + 1.
  	^ fillStart!

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

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

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

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

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

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

  				self flag: #Todo. "for now we compact one segment at a time"
+ 				^ currentSegment = manager numSegments "compact will increment currentSegment and therefore we cannot compare against numSegments to not skip the last segment"
- 				^ currentSegment = (manager numSegments - 1)
  					ifTrue: [true]
  					ifFalse: [false]]].
  	^ true!

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

Item was added:
+ ----- Method: SpurIncrementalCompactor>>unmarkSegmentAsBeingCompacted: (in category 'segment access') -----
+ unmarkSegmentAsBeingCompacted: segInfo 
+ 	<var: 'segInfo' type: #'SpurSegmentInfo *'>
+ 	"Swizzle is abused bit 16 isBeingCompacted bits 0-15 occupation"
+ 	segInfo swizzle: (segInfo swizzle bitAnd: 16rFFFF)!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector class>>classesForTranslation (in category 'translation') -----
  classesForTranslation

+ 	^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurStopTheWorldGarbageCollector . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }!
- 	^ super classesForTranslation , {SpurMarker . SpurIncrementalMarker . SpurAllAtOnceMarker . SpurPlanningCompactor . SpurIncrementalSweeper . SpurIncrementalCompactor . SpurIncrementalSweepAndCompact }!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator

  	super declareCVarsIn: aCCodeGenerator.
+ 	aCCodeGenerator 
+ 		var: 'phase' declareC: 'sqInt phase = 0';
+ 	 	var: 'checkSetGCFlags' declareC: 'sqInt checkSetGCFlags = 1'.
- 	aCCodeGenerator var: 'phase' declareC: 'sqInt phase = 0'.

  	aCCodeGenerator
+ 		staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker in: self.
+ 		
+ 	aCCodeGenerator
+ 		forRecursivePolymorphismResolve: SpurIncrementalMarker as: self;
+ 		forRecursivePolymorphismResolve: SpurIncrementalCompactor as: self;
+ 		forRecursivePolymorphismResolve: SpurIncrementalSweepAndCompact as: self;
+ 		forRecursivePolymorphismResolve: SpurIncrementalSweeper as: self.
+ 		
+ 	"just important when doiing incremental compaction, therefore doin it here"
+ 	aCCodeGenerator
+ 		forRecursivePolymorphismResolve: SpurAllAtOnceMarker as: SpurStopTheWorldGarbageCollector;
+ 		forRecursivePolymorphismResolve: SpurPlanningCompactor as: SpurStopTheWorldGarbageCollector!
- 		staticallyResolvedPolymorphicReceiver: 'marker' to: self markerClass;
- 		staticallyResolvedPolymorphicReceiver: 'allAtOnceMarker' to: SpurAllAtOnceMarker!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>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: [objOop >= self compactor currentSweepingEntity]).

  	(self allocatorShouldAllocateBlack not or: [objOop >= self compactor currentSweepingEntity])
+ 		ifFalse: [self cCode: 'raise(SIGINT)']!
- 		ifFalse: [self cCode: 'error("foo")'.]!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
  doIncrementalCollect

  	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)].

  					"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.

+ 					self assert: manager noObjectGrey.
+ 					
  					coInterpreter cr; print: 'finish marking '; tab; flush.

  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
  						checkFreeSpace: GCModeFull.

  					^ self]
  				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.

  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull;
  						checkFreeSpace: GCModeFull.

  					compactor assertNoSegmentBeingCompacted.

  					phase := InCompactingPhase.
  					^ self]].

  	phase = InCompactingPhase
  		ifTrue: [
  			"self cCode: 'raise(SIGINT)'."
  			coInterpreter cr; print: 'start compacting '; tab; flush.
  			compactor incrementalCompact
  				ifTrue: [
  					coInterpreter cr; print: 'finish compacting '; tab; flush.
  					manager 
  						setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
  						runLeakCheckerFor: GCModeFull;
  						checkFreeSpace: GCModeFull.

  					phase := InMarkingPhase.

  					^ self]]!

Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>doScavenge: (in category 'scavenge') -----
+ doScavenge: tenuringCriterion
+ 
+ 	"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.
+ 	
+ 	self incrementalCollect!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>fullGC (in category 'global') -----
  fullGC
  	"We need to be able to make a full GC, e.g. when we save the image. Use the made progress and finish the collection"
+ 	<returnTypeC: #usqLong>
+ 	<inline: #never> "for profiling"

  	"incredible hacky solution. Will later on be replaced with the old collection, but for now use this to keep the state transitions consistent"

  	self assert: manager validObjStacks.

  	coInterpreter cr; print: 'start fullGC '; tab; flush.

  	coInterpreter setGCMode: GCModeNewSpace.
  	self doScavengeWithoutIncrementalCollect: MarkOnTenure.

  	coInterpreter setGCMode: GCModeIncremental.
  	phase = InMarkingPhase
  		ifTrue: [
  			"end marking"
  			[phase = InMarkingPhase]
  				whileTrue: [self doIncrementalCollect]].

  		"end this collection cycle"
  		[phase ~= InMarkingPhase]
  			whileTrue: [self doIncrementalCollect].

  		"resolve forwarders in young space"
  		coInterpreter setGCMode: GCModeNewSpace.
  		self doScavengeWithoutIncrementalCollect: MarkOnTenure.

  		coInterpreter setGCMode: GCModeIncremental.

  		"mark completely"
  		[phase = InMarkingPhase]
  			whileTrue: [self doIncrementalCollect].
  		"do rest of collection"
  		[phase ~= InMarkingPhase]
  			whileTrue: [self doIncrementalCollect].

  	manager setHeapSizeAtPreviousGC.

  	coInterpreter cr; print: 'end fullGC '; tab; flush.

  	^(manager freeLists at: 0) ~= 0
  		ifTrue: [manager bytesInBody: manager findLargestFreeChunk]
  		ifFalse: [0]!

Item was changed:
  ----- Method: SpurIncrementalGarbageCollector>>incrementalCollect (in category 'global') -----
  incrementalCollect

+ 	| startTime |
  	self flag: #Todo. "where to put this?"
  	manager statScavenges = 0 ifTrue: [manager makeAllObjectsWhite.].
+ 	startTime := coInterpreter ioUTCMicrosecondsNow.
+ 	
  	self doIncrementalCollect.

+ 	coInterpreter cr; print: 'time: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
  	self assert: manager validObjStacks.!

Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>isOkToGrey (in category 'as yet unclassified') -----
+ isOkToGrey
+ 
+ 	^ checkSetGCFlags!

Item was added:
+ ----- Method: SpurIncrementalGarbageCollector>>scavengingGCTenuringIf: (in category 'scavenge') -----
+ 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 added:
+ ----- 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 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>>finishMarking (in category 'as yet unclassified') -----
  finishMarking
  	"marks the structures needed during GC"
  	<inline: #never>

  	"lets assume there are not too many for now"
  	self markWeaklingsAndMarkAndFireEphemerons.
+ 	[(manager isEmptyObjStack: manager markStack) not]
+ 		whileTrue: [self incrementalMark].
+ 	
+ 	self assert: (manager isEmptyObjStack: manager markStack).
+ 	
  	"self assert: self allReferencedClassesAreMarked."
  	self allReferencedClassesAreMarked not
  		ifTrue: [self cCode: 'raise(SIGINT)'].
  	manager expungeDuplicateAndUnmarkedClasses: true ignoringClassesInYoungSpace: true.

+ 	
+ 	
  	"Young space weaklings are not included in the weak set here. If weaklings from young space contain references to
  	old space and the object behind it gets freed during sweeping a scavenge can try to access such an object. Therefore
  	collect all young space weaklings here and nil their references (do it in the end to not include not existing weak objects 
  	from previous marking passes"
  	self collectWeaklingsFromYoungSpaceInWeakSet.
  	manager nilUnmarkedWeaklingSlotsExcludingYoungObjects: true.

  	self assert: (manager isEmptyObjStack: manager markStack).

  	isCurrentlyMarking := false.
  	marking := false!

Item was changed:
  ----- Method: SpurIncrementalMarker>>incrementalMark (in category 'marking - incremental') -----
  incrementalMark
  	"does one marking cycle. Breaks after a certain amount of slots is marked and the last object, that amount is crossed in, is completely scanned"

  	| currentObj slotsLeft |
  	"manager objStack: manager markStack do: [:index :page | Transcript showln: (manager fetchPointer: index ofObject: page)].
  	manager sizeOfObjStack: manager markStack"
  	currentObj := manager popObjStack: manager markStack.
  	"skip young objects. They get already scanned as they are part of the roots"
  	[(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]]
  			whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true].
  				currentObj := manager popObjStack: manager markStack].

  	currentObj
  		ifNil: [^ true]. "there is nothing more on the stack and we are done"

  	slotsLeft := SlotLimitPerPass.

  	[
  		| slotNumber slotsToVisit startIndex |

  		"after passing the limit we push the current index on the stack. Is the currentObj only an index? "
  		(manager isImmediate: currentObj)
  			ifTrue: [startIndex := manager integerValueOf: currentObj.
  				currentObj := manager popObjStack: manager markStack.]
  			ifFalse: [startIndex := 0.

  				self assert: (manager isFreeObject: currentObj) not.
  				(manager isForwarded: currentObj)
  					ifTrue: [currentObj := manager followForwarded: currentObj].

+ 				self assert: (manager isYoung: currentObj) not.

  				self markAndTraceClassOf: currentObj.

  				"eager color the object black. Either it will get scanned completely and the color is correct
  				or we have at least scanned some of the slots. In the second case the mutator could 
  				modify one of the slots of the object that already were scanned and we would could lose
  				this object. Therefore color the object early to trigger the write barrier on writes. There will
  				be some overhead (trigger the barrier always although only the already scanned slots are
  				technically black) but it seems we need to do this for correctness"
  				self blackenObject: currentObj].

  		slotNumber := manager numStrongSlotsOfInephemeral: currentObj.
  		slotsToVisit := slotNumber - startIndex.

  		slotsLeft - slotsToVisit < 0
  			ifTrue: [ | countThatCanBeVisited |
  				countThatCanBeVisited := slotsToVisit - slotsLeft.
  				self 
  					markFrom: startIndex
  					nSlots: countThatCanBeVisited
  					of: currentObj.

  				"If we need to abort earlier we push the index and the currently scanned object on the marking stack. Otherwise it is not possible
  				for immediates to be on the stack (they have no fields to be scanned) -> we can use the immediated to detect this pattern"
  				(manager topOfObjStack: manager markStack) ~= currentObj ifTrue: 
  						[manager push: currentObj onObjStack: manager markStack].
  				manager 
  					push: (manager integerObjectOf: startIndex + countThatCanBeVisited) 
  					onObjStack: manager markStack.

  				"we need to abort early to not run into some extreme corner cases (giant objects) that would explode our mark time assumptions"
  				^ false]
  			ifFalse: ["we can mark all"
  				slotsLeft := slotsLeft - slotsToVisit.

  				self markFrom: startIndex nSlots: slotsToVisit of: currentObj].		

  		currentObj := manager popObjStack: manager markStack.

  		[(currentObj notNil) and: [(manager isNonImmediate: currentObj) and: [manager isYoung: currentObj]]]
  			whileTrue: [(manager isInClassTable: currentObj) ifTrue: [manager setIsMarkedOf: currentObj to: true].
  				currentObj := manager popObjStack: manager markStack].
  	"repeat while there still are objects"
  	currentObj notNil] whileTrue.

  	^ true!

Item was changed:
  ----- Method: SpurIncrementalMarker>>markFrom:nSlots:of: (in category 'as yet unclassified') -----
  markFrom: startIndex nSlots: anAmount of: objOop

  	startIndex to: startIndex + anAmount - 1
  		do: [:index | | slot |
  			slot := manager fetchPointer: index ofObject: objOop.

  			(manager isNonImmediate: slot)
  				ifTrue: [
+ 					self flag: #Todo. "can we use unchecked fix?"
  					(manager isForwarded: slot)
  						ifTrue: [slot := manager fixFollowedField: index ofObject: objOop withInitialValue: slot].
  					self markAndShouldScan: slot]]!

Item was removed:
- ----- Method: SpurIncrementalMarker>>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 marking and: [(manager isImmediate: value) not and: [(manager isOldObject: anObject) and: [(manager isOldObject: value) and: [manager isMarked: anObject]]]])
- 		ifTrue: [self markAndShouldScan: value]!

Item was removed:
- ----- Method: SpurIncrementalMarkerSimulator>>writeBarrierFor:at:with: (in category 'barrier') -----
- writeBarrierFor: anObject at: index with: value
- 
- 	GCEventLog
- 		contextToKeepOnEvent: #writeBarrier 
- 		do: [super writeBarrierFor: anObject at: index with: value]
- 	!

Item was changed:
  ----- Method: SpurIncrementalSweepAndCompact class>>declareCVarsIn: (in category 'nil') -----
+ declareCVarsIn: aCCodeGenerator
+ 
+ 	SpurMemoryManager wantsIncrementalGC
+ 		ifTrue: [| incrementalSelectors |
+ 			incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors.
+ 
+ 			(incrementalSelectors intersection: SpurPlanningCompactor selectors)
+ 				do: [:key | 
+ 					aCCodeGenerator
+ 						staticallyResolveMethodNamed: key 
+ 						forClass: self 
+ 						to: (self staticallyResolvePolymorphicSelector: key)]]!
- declareCVarsIn: aCCodeGenerator!

Item was added:
+ ----- Method: SpurIncrementalSweepAndCompact class>>hasPolymorphicSelectors (in category 'nil') -----
+ hasPolymorphicSelectors
+ 	"when using the incremental gc we have polymorphic selectors and have to resolve them"
+ 
+ 	^ SpurMemoryManager wantsIncrementalGC!

Item was added:
+ ----- Method: SpurIncrementalSweepAndCompact class>>staticallyResolvePolymorphicSelector: (in category 'as yet unclassified') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
+ 
+ 	| incrementalSelectors |
+ 	incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors.
+ 	incrementalSelectors := (incrementalSelectors intersection: SpurPlanningCompactor selectors).
+ 	
+ 	^ (incrementalSelectors includes: aSelectorSymbol)
+ 		ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
+ 		ifFalse: [aSelectorSymbol]!

Item was changed:
  ----- Method: SpurIncrementalSweeper class>>declareCVarsIn: (in category 'as yet unclassified') -----
+ declareCVarsIn: aCCodeGenerator
+ 
+ 	SpurMemoryManager wantsIncrementalGC
+ 		ifTrue: [| incrementalSelectors |
+ 			incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors.
+ 
+ 			(incrementalSelectors intersection: SpurPlanningCompactor selectors)
+ 				do: [:key | 
+ 					aCCodeGenerator
+ 						staticallyResolveMethodNamed: key 
+ 						forClass: self 
+ 						to: (self staticallyResolvePolymorphicSelector: key)]]!
- declareCVarsIn: aCCodeGenerator!

Item was changed:
  ----- Method: SpurMarker class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	"resolve keys present in both the incremental marker and the all at once mark when incremental GC is selected for generation"

+ 	self = SpurMarker ifTrue: [^ self].
  	SpurMemoryManager wantsIncrementalGC ifFalse: [^ self].

  	self selectorsInAllAtOnceMarkerAndIncrementalMarker
  		do: [:key | 
  			aCCodeGenerator
  				staticallyResolveMethodNamed: key 
  				forClass: self 
  				to: (self staticallyResolvePolymorphicSelector: key)]
  	!

Item was changed:
  ----- Method: SpurMarker class>>selectorsInAllAtOnceMarkerAndIncrementalMarker (in category 'as yet unclassified') -----
  selectorsInAllAtOnceMarkerAndIncrementalMarker

+ 	^ (SpurAllAtOnceMarker selectors intersection: SpurIncrementalMarker selectors)!
- 	| subclasses otherMarker |
- 	subclasses := SpurMarker allSubclasses 
- 						select: [:ea | (ea name endsWith: 'Simulator') not].  "ignore simulators as they never get generated"
- 	self assert: subclasses size = 2.  "code written with SpurAllAtOnceMarker and SpurIncrementalMarker in mind. If you extend the class hierarchy you potentially have to change this method too"
- 	
- 	otherMarker := subclasses detect:  [:class | class ~= self].
- 
- 	^ (self selectors intersection: otherMarker selectors)!

Item was added:
+ ----- Method: SpurMarker>>markAndShouldScan: (in category 'as yet unclassified') -----
+ markAndShouldScan: objOop
+ 
+ 	self subclassResponsibility!

Item was removed:
- ----- Method: SpurMarker>>writeBarrierFor:at:with: (in category 'barrier') -----
- writeBarrierFor: anObject at: index with: value!

Item was changed:
  ----- Method: SpurMemoryManager class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
+ 
+ 	self wantsIncrementalGC
+ 		ifTrue: [aCCodeGenerator
+ 					recursivelyResolvePolymorpicReceiver: 'gc' toVariants: {SpurIncrementalGarbageCollector. SpurStopTheWorldGarbageCollector} in: self default: SpurIncrementalGarbageCollector;
+ 					staticallyResolvedPolymorphicReceiver: 'gc' to: SpurIncrementalMarker in: SpurIncrementalGarbageCollector; 
+ 					staticallyResolvedPolymorphicReceiver: 'compactor' to: SpurIncrementalSweepAndCompact in: self; 
+ 					staticallyResolvedPolymorphicReceiver: 'marker' to: SpurIncrementalMarker in: self].
+ 
  	self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
  	aCCodeGenerator removeVariable: 'memory'. "memory is a simulation time thing only"
  	self declareCAsOop: #(	freeStart scavengeThreshold newSpaceStart pastSpaceStart
  							oldSpaceStart lowSpaceThreshold freeOldSpaceStart endOfMemory)
  		in: aCCodeGenerator.
  	self declareCAsUSqLong: (self allInstVarNames select: [:ivn| ivn endsWith: 'Usecs']), #(statAllocatedBytes)
  		in: aCCodeGenerator.
  	aCCodeGenerator
  		var: #lastHash type: #usqInt;
  		var: #freeListsMask type: #usqInt;
  		var: #freeLists type: #'sqInt *';
  		var: #objStackInvalidBecause type: #'char *';
  		var: #unscannedEphemerons type: #SpurContiguousObjStack;
  		var: #heapGrowthToSizeGCRatio type: #float;
  		var: #heapSizeAtPreviousGC type: #usqInt;
  		var: #totalFreeOldSpace type: #usqInt;
  		var: #maxOldSpaceSize type: #usqInt.
  	aCCodeGenerator
  		var: #oldSpaceUsePriorToScavenge type: #sqLong.
  	aCCodeGenerator
  		var: #remapBuffer
  		declareC: 'sqInt remapBuffer[RemapBufferSize + 1 /* ', (RemapBufferSize + 1) printString, ' */]'.
  	aCCodeGenerator
  		var: #extraRoots
  		declareC: 'sqInt *extraRoots[ExtraRootsSize + 1 /* ', (ExtraRootsSize + 1) printString, ' */]'.

  	self wantsIncrementalGC
  		ifTrue: [aCCodeGenerator
+ 					"hack!! see SpurMemoryManager>>staticallyResolvePolymorphicSelector: why we use this" 
+ 					staticallyResolvedPolymorphicReceiver: 'manager gc' to: SpurIncrementalGarbageCollector in: SpurSegmentManager;
+ 					staticallyResolvedPolymorphicReceiver: 'objectMemory' to: self in: StackInterpreter;
+ 					staticallyResolvedPolymorphicReceiver: 'objectMemory' to: self in: CoInterpreter;
+ 					staticallyResolvedPolymorphicReceiver: 'objectMemory' to: self in: CoInterpreterMT;
+ 					"the vm needs (from handwritten C code) the method fullGC. Generate it later on"
+ 					generate: #fullGC from: #SIGC_fullGC]!
- 					staticallyResolvedPolymorphicReceiver: 'marker' to: SpurIncrementalMarker;
- 					"hack!! see SpurMemoryManager>>staticallyResolvePolymorphicSelector: why we use this"
- 					staticallyResolvedPolymorphicReceiver: 'objectMemory' to: SpurMemoryManager]!

Item was changed:
  ----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
  allObjects
  	"Attempt to answer an array of all objects, excluding those that may
  	 be garbage collected as a side effect of allocating the result array.
  	 If no memory is available answer the number of objects as a SmallInteger.
  	 Since objects are at least 16 bytes big, and the largest SmallInteger covers
  	 1/4 of the address space, the count can never overflow."
+ 	<staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector>
  	| freeChunk ptr start limit count bytes |
  	gc markObjectsForEnumerationPrimitives ifTrue:
  		[gc finishGCPass.
+ 		self assert: self allObjectsWhite.
+ 		gc markObjectsCompletely.
+ 		self assert: self noObjectGrey]. "may not want to revive objects unnecessarily; but marking is sloooow."
- 		self assert: self allObjectsUnmarked.
- 		gc markObjectsCompletely]. "may not want to revive objects unnecessarily; but marking is sloooow."
  	freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
  		 (gc markObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[gc markObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 count := count + 1.
  					 ptr < limit ifTrue:
  						[self longAt: ptr put: obj.
  						 ptr := ptr + self bytesPerOop]]
  				ifFalse:
  					[gc markObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self assert: (self isEmptyObjStack: markStack).
  	gc markObjectsForEnumerationPrimitives
  		ifTrue:
  			[self assert: self allObjectsUnmarked.
  			 self emptyObjStack: weaklingStack]
  		ifFalse:
  			[self assert: (self isEmptyObjStack: weaklingStack)].
  	self assert: count >= self numSlotsMask.
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
  		 self checkFreeSpace: GCModeFull.
  		 ^self integerObjectOf: count].
  	bytes := self largeObjectBytesForSlots: count.
  	start := self startOfObject: freeChunk.
  	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
  	totalFreeOldSpace := totalFreeOldSpace - bytes.
  	self rawOverflowSlotsOf: freeChunk put: count.
  	self set: freeChunk classIndexTo: ClassArrayCompactIndex formatTo: self arrayFormat.
  	gc maybeModifyGCFlagsOf: freeChunk.
  	self possibleRootStoreInto: freeChunk.
  	coInterpreter cr; print: 'allObjects in:  '; printHex: freeChunk; tab; flush.
+ 	self assert: self allObjectsWhite.
- 	self assert: self allObjectsUnmarked.
  	self checkFreeSpace: GCModeFull.
  	self runLeakCheckerFor: GCModeFull.
  	^freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>allObjectsWhite (in category 'gc - global') -----
  allObjectsWhite
  	self allObjectsDo:
+ 		[:o| ((self isMarked: o) or: [self isGrey: o]) ifTrue: [self cCode: 'raise(SIGINT)'. bogon := o. ^false]].
- 		[:o| ((self isMarked: o) or: [self isGrey: o]) ifTrue: [bogon := o. ^false]].
  	^true!

Item was changed:
  ----- Method: SpurMemoryManager>>ambiguousClass:allInstancesInto:limit:resultsInto: (in category 'primitive support') -----
  ambiguousClass: aClass allInstancesInto: start limit: limit resultsInto: binaryBlock
  	"Dea with ambiguity and normalize indices."
  	<inline: true>
+ 	<staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector>
  	| expectedIndex count ptr |
  	count := 0.
  	ptr := start.
  	expectedIndex := self rawHashBitsOf: aClass.
  	self allHeapEntitiesDo:
  		[:obj| | actualIndex | "continue enumerating even if no room so as to unmark all objects and/or normalize class indices."
  		 (gc markObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[gc markObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 actualIndex := self classIndexOf: obj.
  					 (self classOrNilAtIndex: actualIndex) = aClass ifTrue:
  					 	[actualIndex ~= expectedIndex ifTrue:
  							[self setClassIndexOf: obj to: expectedIndex].
  						 count := count + 1.
  						 ptr < limit ifTrue:
  							[self longAt: ptr put: obj.
  							 ptr := ptr + self bytesPerOop]]]
  				ifFalse:
  					[gc markObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	self purgeDuplicateClassTableEntriesFor: aClass.
  	binaryBlock value: count value: ptr
  !

Item was added:
+ ----- Method: SpurMemoryManager>>collectAsNumberInto:limit:resultsInto: (in category 'primitive support') -----
+ collectAsNumberInto: start limit: limit resultsInto: binaryBlock
+ 
+ 	<inline: true>
+ 	| count ptr |
+ 	count := 0.
+ 	ptr := start.
+ 	self allHeapEntitiesDo:
+ 		[:obj| | entry |
+ 		entry := (self bytesInBody: obj) >> self shiftForWord.
+ 		self assert: entry < (2 << 57).
+ 		
+ 		entry := entry + (((self isFreeObject: obj)
+ 			ifTrue: [0]
+ 			ifFalse: [1]) << 56).
+ 		
+ 		count := count + 1.
+ 		 ptr < limit ifTrue:
+ 			[self longAt: ptr put: entry.
+ 			 ptr := ptr + self bytesPerOop]].
+ 		
+ 	binaryBlock value: count value: ptr
+ !

Item was changed:
  ----- Method: SpurMemoryManager>>gc (in category 'accessing') -----
  gc

+ 	<doNotGenerate>
  	^ gc!

Item was added:
+ ----- Method: SpurMemoryManager>>getMarkObjectsForEnumerationPrimitives (in category 'gc - incremental') -----
+ getMarkObjectsForEnumerationPrimitives
+ 
+ 	^ MarkObjectsForEnumerationPrimitives!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
  initializeObjectMemory: bytesToShift
  	"Initialize object memory variables at startup time. Assume endOfMemory at al are
  	 initialised by the image-reading code via setHeapBase:memoryLimit:endOfMemory:.
  	 endOfMemory is assumed to point to the end of the last object in the image.
  	 Assume: image reader also initializes the following variables:
  		specialObjectsOop
  		lastHash"
  	<inline: false>
  	| freeListObj |
  	"Catch mis-initializations leading to bad translations to C"
  	self assert: self baseHeaderSize = self baseHeaderSize.
  	self assert: (self maxSlotsForAlloc * self wordSize) asInteger > 0.
  	self bootstrapping ifFalse:
  		[self
  			initSegmentBridgeWithBytes: self bridgeSize
  			at: endOfMemory - self bridgeSize].
  	segmentManager adjustSegmentSwizzlesBy: bytesToShift.
  	"image may be at a different address; adjust oops for new location"
  	self adjustAllOopsBy: bytesToShift.
  	specialObjectsOop := segmentManager swizzleObj: specialObjectsOop.

  	"heavily used special objects"
  	nilObj		:= self splObj: NilObject.
  	falseObj	:= self splObj: FalseObject.
  	trueObj		:= self splObj: TrueObject.

  	"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
  	 conditional branch code as a result).  In addition, Spur places the free lists and
  	 class table root page immediately following them."
  	self assert: nilObj = oldSpaceStart.
  	self assert: falseObj = (self oldSpaceObjectAfter: nilObj).
  	self assert: trueObj = (self oldSpaceObjectAfter: falseObj).
  	freeListObj := self oldSpaceObjectAfter: trueObj.
  	self setHiddenRootsObj: (self oldSpaceObjectAfter: freeListObj).
  	markStack := self swizzleObjStackAt: MarkStackRootIndex.
  	weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex.
  	mournQueue := self swizzleObjStackAt: MournQueueRootIndex.
+ 	(self addressCouldBeObj: (self fetchPointer: EphemeronStackRootIndex ofObject: hiddenRootsObj))
+ 		ifFalse: [self storePointerUnchecked: EphemeronStackRootIndex ofObject: hiddenRootsObj withValue: nilObj].
  	ephemeronStack := self swizzleObjStackAt: EphemeronStackRootIndex.
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: (self isEmptyObjStack: ephemeronStack).

  	self initializeFreeSpacePostLoad: freeListObj.
  	segmentManager collapseSegmentsPostSwizzle.
  	self updateFreeLists.
  	self computeFreeSpacePostSwizzle.
  	compactor postSwizzleAction.
  	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart, free space"
  	self initializeNewSpaceVariables.
  	scavenger initializeRememberedSet.
  	segmentManager checkSegments.
  	compactor biasForGC.

  	"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
  	growHeadroom := 16*1024*1024.		"headroom when growing"
  	shrinkThreshold := 32*1024*1024.		"free space before shrinking"
  	self setHeapSizeAtPreviousGC.
  	heapGrowthToSizeGCRatio := 0.333333. "By default GC after scavenge if heap has grown by a third since the last GC"!

Item was added:
+ ----- Method: SpurMemoryManager>>memoryMap (in category 'primitive support') -----
+ memoryMap
+ 
+ 	| freeChunk ptr start limit count bytes |
+ 	freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
+ 	start := freeChunk + self baseHeaderSize.
+ 	limit := self addressAfter: freeChunk.
+ 	self collectAsNumberInto: start limit: limit resultsInto: [:c :p| count := c. ptr := p].
+ 
+ 	(count > (ptr - start / self bytesPerOop) "not enough room"
+ 	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
+ 		[self freeObject: freeChunk.
+ 		 ^self integerObjectOf: count].
+ 	count < self numSlotsMask ifTrue:
+ 		[| smallObj |
+ 		 smallObj := self allocateSlots: count format: self arrayFormat classIndex: ClassArrayCompactIndex.
+ 		 0 to: count - 1 do:
+ 			[:i|
+ 			self storePointerUnchecked: i ofObject: smallObj withValue: (self fetchPointer: i ofFreeChunk: freeChunk)].
+ 		 self freeChunkWithBytes: (self bytesInBody: freeChunk) at: (self startOfObject: freeChunk).
+ 		 self beRootIfOld: smallObj.
+ 		 self checkFreeSpace: GCModeFull.
+ 		 ^smallObj].
+ 	bytes := self largeObjectBytesForSlots: count.
+ 	start := self startOfObject: freeChunk.
+ 	self freeChunkWithBytes: limit - start - bytes at: start + bytes.
+ 	totalFreeOldSpace := totalFreeOldSpace - bytes.
+ 	self rawOverflowSlotsOf: freeChunk put: count.
+ 	self set: freeChunk classIndexTo: (self rawHashBitsOf: (self splObj: ClassDoubleWordArray)) formatTo: self sixtyFourBitIndexableFormat.
+ 	gc maybeModifyGCFlagsOf: freeChunk.
+ 	self possibleRootStoreInto: freeChunk.
+ 	self checkFreeSpace: GCModeFull.
+ 	self runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true.
+ 	self cCode: 'raise(SIGINT)'.
+ 	^freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>nilUnmarkedWeaklingSlotsIn:excludingYoungObjects: (in category 'weakness and ephemerality') -----
  nilUnmarkedWeaklingSlotsIn: aWeakling excludingYoungObjects: aBoolean
  	"Nil the unmarked slots in aWeakling and
  	 answer if any unmarked slots were found."
  	<inline: true>
  	| anyUnmarked |
  	anyUnmarked := false.
  	self assert: (self allStrongSlotsOfWeaklingAreMarked: aWeakling excludingYoungObjects: aBoolean).
  	"N.B. generateToByDoLimitExpression:negative:on: guards against (unsigned)0 - 1 going +ve"
  	(self numStrongSlotsOfWeakling: aWeakling) to: (self numSlotsOf: aWeakling) - 1 do:
  		[:i| | referent |
  		referent := self fetchPointer: i ofObject: aWeakling.
  		(self isNonImmediate: referent) ifTrue:
  			[(self isUnambiguouslyForwarder: referent) ifTrue:
+ 				[
+ 				referent := self uncheckedFixFollowedField: i ofObject: aWeakling withInitialValue: referent.
+ 				((self isOldObject: aWeakling) and: [(self isYoungObject: referent) and: [(self isRemembered: aWeakling) not]])
+ 					ifTrue: [scavenger remember: aWeakling]].
- 				[referent := self fixFollowedField: i ofObject: aWeakling withInitialValue: referent].
  			 ((self isImmediate: referent) or: [self isMarked: referent]) ifFalse:
  				[((self isYoung: referent) and: [aBoolean])
  					ifFalse: [self storePointerUnchecked: i ofObject: aWeakling withValue: nilObj.
  				 			 anyUnmarked := true]]]].
  	^anyUnmarked!

Item was changed:
  ----- Method: SpurMemoryManager>>noElementOfFreeSpaceIsInSegment: (in category 'debug support') -----
  noElementOfFreeSpaceIsInSegment: segInfo
  	"Check that no free space on teh system's free lists is in the segment.
  	 N.B. This is slightly different to there is no free space in the segment."
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	self allFreeObjectsDo:
+ 		[:freeBird| (segmentManager is: freeBird inSegment: segInfo) ifTrue: [ self cCode: 'raise(SIGINT)'.^false]].
- 		[:freeBird| (segmentManager is: freeBird inSegment: segInfo) ifTrue: [^false]].
  	^true!

Item was added:
+ ----- Method: SpurMemoryManager>>noObjectGrey (in category 'gc - global') -----
+ noObjectGrey
+ 	self allObjectsDo:
+ 		[:o| (self isGrey: o) ifTrue: [self cCode: 'raise(SIGINT)'. bogon := o. ^false]].
+ 	^true!

Item was changed:
  ----- Method: SpurMemoryManager>>objectsReachableFromRoots: (in category 'image segment in/out') -----
  objectsReachableFromRoots: arrayOfRoots
  	"This is part of storeImageSegmentInto:outPointers:roots:.
  	 Answer an Array of all the objects only reachable from the argument, an Array of root objects,
  	 starting with arrayOfRoots.  If there is no space, answer a SmallInteger whose value is the
  	 number of slots required.  This is used to collect the objects to include in an image segment
  	 on Spur, separate from creating the segment, hence simplifying the implementation.
  	 Thanks to Igor Stasenko for this idea."

  	| freeChunk ptr start limit count oop objOop roots |
  	<var: #freeChunk type: #usqInt> "& hence start & ptr are too; limit is also because of addressAfter:"
+ 	
+ 	"do not check if it is ok to set gc flags"
+ 	<staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector>
+ 	<staticallyResolveMethod: 'unmarkObjectsIn:' to: #SpurStopTheWorldGarbageCollector> 
+ 	<staticallyResolveMethod: 'unmarkAllObjects' to: #SpurStopTheWorldGarbageCollector> 
+ 	
  	<inline: #never>
  	self assert: (self isArray: arrayOfRoots).
  	"Mark all objects except those only reachable from the arrayOfRoots by marking
  	 each object in arrayOfRoots and then marking all reachable objects (from the
  	 system roots).  This leaves unmarked only objects reachable from the arrayOfRoots.
  	 N.B. A side-effect of the marking is that all forwarders in arrayOfRoots will be followed."
  	gc finishGCPassWithoutPreviousScavenge.
  	roots := self followMaybeForwarded: arrayOfRoots.
   	self assert: self allObjectsUnmarked.
  	self markObjectsIn: roots.
  	gc markObjectsCompletely.

  	"After the mark phase all unreachable weak slots will have been nilled
  	 and all active ephemerons fired."
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  	self assert: self noUnscannedEphemerons.

  	"Now unmark the roots before collecting the transitive closure of unmarked objects accessible from the roots."
  	self unmarkObjectsIn: roots.

  	"Use the largest free chunk to answer the result."
  	freeChunk := self allocateLargestFreeChunk. "N.B. Does /not/ update totalFreeOldSpace"
  	totalFreeOldSpace := totalFreeOldSpace - (self bytesInBody: freeChunk). "but must update so that growth in the markStack does not cause assert fails."
  	ptr := start := freeChunk + self baseHeaderSize.
  	limit := self addressAfter: freeChunk.
  	count := 0.

  	"First put the roots; order is important."
  	self noCheckPush: roots onObjStack: markStack.

  	"Now collect the roots and the transitive closure of unmarked objects from them."
  	[self isEmptyObjStack: markStack] whileFalse:
  		[objOop := self popObjStack: markStack.
  		 self assert: (self isMarked: objOop).
  		 count := count + 1.
  		 ptr < limit ifTrue:
  			[self longAt: ptr put: objOop.
  			 ptr := ptr + self bytesPerOop].
  		 oop := self fetchClassOfNonImm: objOop.
  		 (self isMarked: oop) ifFalse:
  			[self setIsMarkedOf: oop to: true.
  			 self noCheckPush: oop onObjStack: markStack].
  		 ((self isContextNonImm: objOop)
  		  and: [coInterpreter isStillMarriedContext: objOop]) "widow now, before the copy loop"
  			ifTrue:
  				[0 to: (coInterpreter numSlotsOfMarriedContext: objOop) - 1 do:
  					[:i|
  					 oop := coInterpreter fetchPointer: i ofMarriedContext: objOop.
  					 ((self isImmediate: oop)
  					  or: [self isMarked: oop]) ifFalse:
  						[self setIsMarkedOf: oop to: true.
  						 self noCheckPush: oop onObjStack: markStack]]]
  			ifFalse:
  				[0 to: (self numPointerSlotsOf: objOop) - 1 do:
  					[:i|
  					 oop := self fetchPointer: i ofObject: objOop.
  					 ((self isImmediate: oop)
  					  or: [self isMarked: oop]) ifFalse:
  						[self setIsMarkedOf: oop to: true.
  						 self noCheckPush: oop onObjStack: markStack]]]].

  	self unmarkAllObjects.

  	"Now try and allocate the result"
  	(count > (ptr - start / self bytesPerOop) "not enough room"
  	 or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
  		[self freeObject: freeChunk.
  		 self checkFreeSpace: GCCheckImageSegment.
  		 ^self integerObjectOf: count].
  	"There's room; set the format, & classIndex and shorten."
  	self setFormatOf: freeChunk to: self arrayFormat.
  	self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
  	gc maybeModifyGCFlagsOf: freeChunk.
  	self shorten: freeChunk toIndexableSize: count.
  	(self isForwarded: freeChunk) ifTrue:
  		[freeChunk := self followForwarded: freeChunk].
  	self possibleRootStoreInto: freeChunk.
  	self checkFreeSpace: GCCheckImageSegment.
  	self runLeakCheckerFor: GCCheckImageSegment.
  	^freeChunk!

Item was changed:
  ----- Method: SpurMemoryManager>>push:onObjStack: (in category 'obj stacks') -----
  push: objOop onObjStack: objStack
  	<inline: true>
  	self assert: (self addressCouldBeOop: objOop).
+ 	(gc isIncremental and: [objStack = self markStack and: [self isYoung: objOop]] )
+ 		ifTrue: [self cCode: 'raise(SIGINT)'].
  	(self isImmediate: objOop)
  		ifTrue:
  			[self assert: objStack = markStack.
  			 self assert: (self addressCouldBeObj: (self topOfObjStack:
  							(0 = (self fetchPointer: ObjStackTopx ofObject: objStack)
  								ifTrue: [self fetchPointer: ObjStackNextx ofObject: objStack]
  								ifFalse: [objStack])))]
  		ifFalse: "There should be no weaklings on the mark stack."
  			[self assert: (objStack = markStack and: [self isWeakNonImm: objOop]) not.
  			"There should only be weaklings on the weaklingStack"
  			 self assert: (objStack ~= weaklingStack or: [self isWeakNonImm: objOop])].
  	^self noCheckPush: objOop onObjStack: objStack!

Item was changed:
  ----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
  storeImageSegmentInto: segmentWordArrayArg outPointers: outPointerArrayArg roots: arrayOfRootsArg
  	"This primitive is called from Squeak as...
  		<imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray.

  	 This primitive will store a binary image segment (in the same format as objects in the heap) of the
  	 set of objects in arrayOfObjects.  All pointers from within the set to objects outside the set will be
  	 copied into the array of outPointers.  In their place in the image segment will be an oop equal to the
  	 offset in the outPointer array (the first would be 8), but with the high bit set.

  	 Since Spur has a class table the load primitive must insert classes that have instances into the
  	 class table.  This primitive marks such classes using the isRemembered bit, which isn't meaningful
  	 as a remembered bit in the segment.

  	 The primitive expects the segmentWordArray and outPointerArray to be more than adequately long.
  	 In this case it returns normally, and truncates the two arrays to exactly the right size.

  	 The primitive can fail for the following reasons with the specified failure codes:
  		PrimErrGenericError:		the segmentWordArray is too small for the version stamp
  		PrimErrWritePastObject:	the segmentWordArray is too small to contain the reachable objects
  		PrimErrBadIndex:			the outPointerArray is too small
  		PrimErrNoMemory:			additional allocations failed
  		PrimErrLimitExceeded:		there is no room in the hash field to store out pointer indices or class references."
+ 				
+ 	"ignore incremental gc safety mechanisms as this is a special case"
+ 	<staticallyResolveMethod: 'copyObj:toAddr:stopAt:savedFirstFields:index:' to: #SpurStopTheWorldGarbageCollector>
+ 	<staticallyResolveMethod: 'return:restoringObjectsIn:upTo:savedFirstFields:' to: #SpurStopTheWorldGarbageCollector>
+ 	<staticallyResolveMethod: 'return:restoringObjectsIn:savedFirstFields:and:savedHashes:' to: #SpurStopTheWorldGarbageCollector>
+ 	<staticallyResolveMethod: 'mapOopsFrom:to:outPointers:outHashes:' to: #SpurStopTheWorldGarbageCollector>
+ 				
  	<inline: false>
  	| segmentWordArray outPointerArray arrayOfRoots
  	  arrayOfObjects savedFirstFields savedOutHashes segStart segAddr endSeg outIndex numClassesInSegment |
  	<var: 'segAddr' type: #usqInt>
  	((self isObjImmutable: segmentWordArrayArg)
  	 or: [self isObjImmutable: outPointerArrayArg]) ifTrue:
  		[^PrimErrNoModification].
  	"Since segmentWordArrayArg & outPointerArrayArg may get shortened, they can't be pinned."
  	((self isPinned: segmentWordArrayArg)
  	 or: [self isPinned: outPointerArrayArg]) ifTrue:
  		[^PrimErrObjectIsPinned].
  	(self numSlotsOf: outPointerArrayArg) > self maxIdentityHash ifTrue:
  		[^PrimErrLimitExceeded].

  	self runLeakCheckerFor: GCCheckImageSegment.

  	"First scavenge to collect any new space garbage that refers to the graph."
  	self scavengingGC.
  	segmentWordArray := self updatePostScavenge: segmentWordArrayArg.
  	outPointerArray := self updatePostScavenge: outPointerArrayArg.
  	arrayOfRoots := self updatePostScavenge: arrayOfRootsArg.
  	self deny: (self forwardersIn: outPointerArray).
  	self deny: (self forwardersIn: arrayOfRoots).

  	"Now compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array.
  	 Included in arrayOfObjects are the arrayOfRoots and all its contents.  All objects have been unmarked."
  	arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots.
  	arrayOfObjects ifNil:
  		[^PrimErrNoMemory].
  	"If objectsReachableFromRoots: answers an integer there is not enough continuous free space in which to allocate the
  	 reachable objects.  If there is sufficient free space then answer an error code to prompt a compacting GC and a retry."
  	(self isIntegerObject: arrayOfObjects) ifTrue:
  		[totalFreeOldSpace - self allocationUnit >= (self integerValueOf: arrayOfObjects) ifTrue:
  			[^PrimErrNeedCompaction].
  		 ^PrimErrNoMemory].

  	self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written"
  	self deny: (self forwardersIn: arrayOfObjects).

  	"Both to expand the max size of segment and to reduce the length of the
  	 load-time pass that adds classes to the class table, move classes to the
  	 front of arrayOfObjects, leaving the root array as the first element."
  	numClassesInSegment := self moveClassesForwardsIn: arrayOfObjects.

  	"The scheme is to copy the objects into segmentWordArray, and then map the oops in segmentWordArray.
  	 Therefore the primitive needs to both map efficiently originals to copies in segmentWordArray and
  	 be able to undo any side-effects if the primitive fails because either segmentWordArray or outPointerArray
  	 is too small.  The mapping is done by having the objects to be stored in arrayOfObjects refer to their mapped
  	 locations through their first field, just like a forwarding pointer, but without becoming a forwarder, saving their
  	 first field in savedFirstFields, and the objects in outPointerArray pointing to their locations in the outPointerArray
  	 through their identityHashes, saved in savedOutHashes.
  	 Since arrayOfObjects and its savedFirstFields, and outPointerArray and its saved hashes, can be enumerated
  	 side-by-side, the hashes can be restored to the originals.  So the first field of the heap object corresponding to
  	 an object in arrayOfObjects is set to its location in segmentWordArray, and the hash of an object in outPointerArray
  	 is set to its index in outPointerArray plus the top hash bit.  Classes in arrayOfObjects have their marked bit set.
  	 Oops in objects in segmentWordArray are therefore mapped by accessing the original oop, and following its first
  	 field. Class indices in segmentWordArray are mapped by fetching the original class, and testing its marked bit.
  	 If marked, the first field is followed to access the class copy in the segment.  Out pointers (objects and classes,
  	 which are unmarked), the object's identityHash is set (eek!!!!) to its index in the outPointerArray. So savedOutHashes
  	 parallels the outPointerArray. The saved hash array is initialized with an out-of-range hash value so that the first
  	 unused entry can be identified."

  	savedFirstFields := self noInlineAllocateSlots: (self numSlotsOf: arrayOfObjects)
  							format: self wordIndexableFormat
  							classIndex: self wordSizeClassIndexPun.
  	savedOutHashes := self noInlineAllocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4)
  							format: self firstLongFormat
  							classIndex: self thirtyTwoBitLongsClassIndexPun.
  	(savedFirstFields isNil or: [savedOutHashes isNil]) ifTrue:
  		[self freeObject: arrayOfObjects.
  		 (savedFirstFields notNil and: [self isInOldSpace: savedFirstFields]) ifTrue:
  			[self freeObject: savedFirstFields].
  		 (savedOutHashes notNil and: [self isInOldSpace: savedOutHashes]) ifTrue:
  			[self freeObject: savedOutHashes].
  		 ^PrimErrNoMemory].

  	self fillObj: savedFirstFields numSlots: (self numSlotsOf: savedFirstFields) with: 0.
  	self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: self savedOutHashFillValue.

  	segAddr := segmentWordArray + self baseHeaderSize.
  	endSeg := self addressAfter: segmentWordArray.

  	"Write a version number for byte order and version check."
  	segAddr >= endSeg ifTrue: [^PrimErrGenericFailure].
  	self long32At: segAddr put: self imageSegmentVersion.
  	self long32At: segAddr + 4 put: self imageSegmentVersion.
  	segStart := segAddr := segAddr + self allocationUnit.

  	self assert: arrayOfRoots = (self fetchPointer: 0 ofObject: arrayOfObjects).

  	"Copy all reachable objects to the segment, setting the marked bit for all objects (clones) in the segment,
  	 and the remembered bit for all classes (clones) in the segment."
  	0 to: (self numSlotsOf: arrayOfObjects) - 1 do:
  		[:i| | newSegAddrOrError objOop |
  		"Check that classes in the segment are addressable.  Since the top bit of the hash field is used to tag
  		 classes external to the segment, the segment offset must not inadvertently set this bit.  This limit still
  		 allows for a million or more classes."
  		(i = numClassesInSegment
  		 and: [segAddr - segStart / self allocationUnit + self lastClassIndexPun >= TopHashBit]) ifTrue:
  			[^self return: PrimErrLimitExceeded
  					restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields].
  		objOop := self fetchPointer: i ofObject: arrayOfObjects.
  		self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]).
  		newSegAddrOrError := self copyObj: objOop
  									toAddr: segAddr
  									stopAt: endSeg
  									savedFirstFields: savedFirstFields
  									index: i.
  		(self oop: newSegAddrOrError isLessThan: segStart) ifTrue:
  			[^self return: newSegAddrOrError
  					restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields].
  		 segAddr := newSegAddrOrError].

  	"Check that it can be safely shortened."
  	(endSeg ~= segAddr
  	 and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue:
  		[^self return: PrimErrWritePastObject
  				restoringObjectsIn: arrayOfObjects upTo: -1 savedFirstFields: savedFirstFields].

  	"Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
  	 have their first field pointing to the corresponding copy in segmentWordArray."
  	(outIndex := self mapOopsFrom: segStart
  					to: segAddr
  					outPointers: outPointerArray
  					outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail"
  		[^self return: PrimErrBadIndex
  				restoringObjectsIn: arrayOfObjects savedFirstFields: savedFirstFields
  				and: outPointerArray savedHashes: savedOutHashes].

  	"We're done.  Shorten the results, restore hashes and return."
  	self shorten: segmentWordArray toIndexableSize: segAddr - (segmentWordArray + self baseHeaderSize) / 4.
  	self shorten: outPointerArray toIndexableSize: outIndex.
  	^self return: PrimNoErr
  		restoringObjectsIn: arrayOfObjects savedFirstFields: savedFirstFields
  		and: outPointerArray savedHashes: savedOutHashes!

Item was changed:
  ----- Method: SpurMemoryManager>>storePointer:ofObject:withValue: (in category 'object access') -----
  storePointer: fieldIndex ofObject: objOop withValue: valuePointer
  	"Note must check here for stores of young objects into old ones."
  	<inline: true>

  	self assert: (self isForwarded: objOop) not.
+ 	(self isForwarded: objOop)
+ 		ifTrue: [self cCode: 'raise(SIGINT)'].

  	(self isOldObject: objOop) ifTrue: "most stores into young objects"
  		[(self isYoung: valuePointer) ifTrue:
  			[self possibleRootStoreInto: objOop]].

  	self
  		longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord)
  		put: valuePointer.

+ 	gc writeBarrierFor: objOop at: fieldIndex with: valuePointer.
- 	self marker writeBarrierFor: objOop at: fieldIndex with: valuePointer.

  	^ valuePointer!

Item was added:
+ ----- Method: SpurMemoryManager>>uncheckedFixFollowedField:ofObject:withInitialValue: (in category 'forwarding') -----
+ uncheckedFixFollowedField: fieldIndex ofObject: anObject withInitialValue: initialValue
+ 	"Private helper for nilUnmarkedWeaklingSlotsIn:excludingYoungObjects:. It is important to use an unchecked pointer store to not trigger the write barrier and possibly add elements to the mark stack although we are currently finishing marking and do not visit the mark stack anymore (the consequence would be we have a grey object and possibly cause errors later on)"
+ 	<inline: #never>
+ 	| objOop |
+ 	self assert: (self isOopForwarded: initialValue).
+ 	"inlined followForwarded: for speed (one less test)"
+ 	objOop := initialValue.
+ 	[objOop := self fetchPointer: 0 ofMaybeForwardedObject: objOop.
+ 	 self isOopForwarded: objOop] whileTrue.
+ 	self storePointerUnchecked: fieldIndex ofObject: anObject withValue: objOop.
+ 	^objOop!

Item was changed:
  ----- Method: SpurMemoryManager>>uniqueIndex:allInstancesInto:limit:resultsInto: (in category 'primitive support') -----
  uniqueIndex: classIndex allInstancesInto: start limit: limit resultsInto: binaryBlock
  	<inline: true>
+ 	<staticallyResolveMethod: 'setIsMarkedOf:to:' to: #SpurStopTheWorldGarbageCollector>
  	| count ptr |
  	count := 0.
  	ptr := start.
  	self allHeapEntitiesDo:
  		[:obj| "continue enumerating even if no room so as to unmark all objects."
  		 (gc markObjectsForEnumerationPrimitives
  				ifTrue: [self isMarked: obj]
  				ifFalse: [true]) ifTrue:
  			[(self isNormalObject: obj)
  				ifTrue:
  					[gc markObjectsForEnumerationPrimitives ifTrue:
  						[self setIsMarkedOf: obj to: false].
  					 (self classIndexOf: obj) = classIndex ifTrue:
  					 	[count := count + 1.
  						 ptr < limit ifTrue:
  							[self longAt: ptr put: obj.
  							 ptr := ptr + self bytesPerOop]]]
  				ifFalse:
  					[gc markObjectsForEnumerationPrimitives ifTrue:
  						[(self isSegmentBridge: obj) ifFalse:
  							[self setIsMarkedOf: obj to: false]]]]].
  	binaryBlock value: count value: ptr
  !

Item was changed:
  ----- Method: SpurMemoryManager>>validObjectColors (in category 'debug support') -----
  validObjectColors

  	| currentSweepingEntityT |

  	currentSweepingEntityT := gc compactor sweeper currentSweepingEntity 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: [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: SpurMemoryManager>>weaklingStack (in category 'spur bootstrap') -----
  weaklingStack
+ 	
+ 	<cmacro: '() GIV(weaklingStack)'>
  	^weaklingStack!

Item was added:
+ ----- Method: SpurPlanningCompactor class>>hasPolymorphicSelectors (in category 'nil') -----
+ hasPolymorphicSelectors
+ 	"when using the incremental gc we have polymorphic selectors and have to resolve them"
+ 
+ 	^ SpurMemoryManager wantsIncrementalGC!

Item was added:
+ ----- Method: SpurPlanningCompactor class>>staticallyResolvePolymorphicSelector: (in category 'nil') -----
+ staticallyResolvePolymorphicSelector: aSelectorSymbol
+ 
+ 	| incrementalSelectors |
+ 	incrementalSelectors := SpurIncrementalCompactor selectors , SpurIncrementalSweeper selectors , SpurIncrementalSweepAndCompact selectors.
+ 	incrementalSelectors := (incrementalSelectors intersection: SpurPlanningCompactor selectors).
+ 	
+ 	^ (incrementalSelectors includes: aSelectorSymbol)
+ 		ifTrue: [super staticallyResolvePolymorphicSelector: aSelectorSymbol]
+ 		ifFalse: [aSelectorSymbol]!

Item was changed:
  ----- Method: SpurSegmentManager>>allObjectsAreForwardedInSegment:includingFreeSpace: (in category 'testing') -----
  allObjectsAreForwardedInSegment: segInfo includingFreeSpace: includeFreeSpace
  	"Answer if all objects in the segment are forwarded to somewhere outside the segment.
  	 If includeFreeSpace is true, answer false if there is any unforwarded free space in the segment."

  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	self allEntitiesInSegment: segInfo exceptTheLastBridgeDo:
  		[:thing|
  		(manager isFreeObject: thing)
  			ifTrue: [includeFreeSpace ifTrue: [^false]]
  			ifFalse:
+ 				[self flag: #Todo. "does not work because free objects seem to be collections"
+ 				(manager isForwarded: thing) ifFalse:
- 				[(manager isForwarded: thing) ifFalse:
  					[^false].
  				(self is: (manager fetchPointer: 0 ofMaybeForwardedObject: thing) inSegment: segInfo) ifTrue:
  					[^false]]].
  	^true!

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

Item was changed:
  ----- Method: SpurStopTheWorldGarbageCollector>>canReactToShiftSegment:to: (in category 'as yet unclassified') -----
+ canReactToShiftSegment: segmentAddress to: anIndex!
- canReactToShiftSegment: segmentAddress to: anIndex
- 
- 	<doNotGenerate>!

Item was added:
+ ----- 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>>globalGarbageCollect (in category 'as yet unclassified') -----
  globalGarbageCollect
  	<inline: true> "inline into fullGC"

+ 	self cCode: [] inSmalltalk: [manager preGlobalGCActions].
- 	manager preGlobalGCActions.

  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: manager markStack).
  	self assert: (self isEmptyObjStack: manager weaklingStack).

  	"Mark objects /before/ scavenging, to empty the rememberedTable of unmarked roots."
  	self markObjects: true.
  	manager gcMarkEndUsecs: coInterpreter ioUTCMicrosecondsNow.

  	scavenger forgetUnmarkedRememberedObjects.

  	coInterpreter setGCMode: GCModeNewSpace.
  	self doScavenge: MarkOnTenure.
  	coInterpreter setGCMode: GCModeFull.

  	"Mid-way the leak check must be more lenient.  Unmarked classes will have been
  	 expunged from the table, but unmarked instances will not yet have been reclaimed."
  	manager runLeakCheckerFor: GCModeFull
  		excludeUnmarkedObjs: true
  		classIndicesShouldBeValid: true.

  	manager compactionStartUsecs: coInterpreter ioUTCMicrosecondsNow.
  	manager segmentManager prepareForGlobalSweep. "for notePinned:"
  	compactor compact.
  	manager attemptToShrink.
  	manager setHeapSizeAtPreviousGC.

  	self assert: manager validObjStacks.
  	self assert: (manager isEmptyObjStack: manager markStack).
  	self assert: (manager isEmptyObjStack: manager weaklingStack).
  	self assert: manager allObjectsUnmarked.
  	manager runLeakCheckerFor: GCModeFull!

Item was changed:
  ----- Method: SpurStopTheWorldGarbageCollector>>incrementalCollect (in category 'global') -----
  incrementalCollect
+ 	"not supported in a stop the world GC -> no op"!
- 	"not supported in a stop the world GC -> no op"
- 	
- 	<doNotGenerate>!

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

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

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

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>isOkToScavengeRememberedObject: (in category 'as yet unclassified') -----
+ isOkToScavengeRememberedObject: objOop!

Item was added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>markObjects: (in category 'as yet unclassified') -----
+ markObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged
+ 
+ 	marker markersMarkObjects: objectsShouldBeUnmarkedAndUnmarkedClassesShouldBeExpunged!

Item was changed:
  ----- Method: SpurStopTheWorldGarbageCollector>>markObjectsForEnumerationPrimitives (in category 'as yet unclassified') -----
  markObjectsForEnumerationPrimitives

+ 	^ manager getMarkObjectsForEnumerationPrimitives!
- 	^ manager markObjectsForEnumerationPrimitives!

Item was added:
+ ----- 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 added:
+ ----- Method: SpurStopTheWorldGarbageCollector>>writeBarrierFor:at:with: (in category 'as yet unclassified') -----
+ writeBarrierFor: anObject at: index with: value!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

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!

Item was changed:
  ----- Method: StackInterpreter>>incrementalMarkAndTraceInterpreterOops (in category 'object memory support') -----
  incrementalMarkAndTraceInterpreterOops
  	"Mark and trace all oops in the interpreter's state."
  	"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."
+ 	<staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
  	| oop marker |
- 	
- 	"do not remove. Necessary for resolving polymorphic receiver"
  	marker := objectMemory marker.

  	"Must mark stack pages first to initialize the per-page trace
  	 flags for full garbage collect before any subsequent tracing."
  	self incrementalMarkAndTraceStackPages.
  	self incrementalMarkAndTraceTraceLog.
  	self incrementalMarkAndTracePrimTraceLog.
  	marker markAndShouldScan: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
  	(objectMemory isImmediate: newMethod) ifFalse:
  		[marker markAndShouldScan: newMethod].
  	self incrementalTraceProfileState.
  	tempOop = 0 ifFalse: [marker markAndShouldScan: tempOop].
  	tempOop2 = 0 ifFalse: [marker markAndShouldScan: tempOop2].

  	"V3 memory manager support"
  	1 to: objectMemory remapBufferCount do:
  		[:i | 
  		oop := objectMemory remapBuffer at: i.
  		(objectMemory isImmediate: oop) ifFalse: [marker markAndShouldScan: oop]]!

Item was changed:
  ----- Method: StackInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
  incrementalMarkAndTraceStackPage: thePage
  	| theSP theFP frameRcvrOffset callerFP oop marker |
  	<var: #thePage type: #'StackPage *'>
  	<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].
  		 (objectMemory isImmediate: oop) ifFalse:
  			[marker markAndShouldScan: oop].
  		 theSP := theSP + objectMemory wordSize].
  	(self frameHasContext: theFP) ifTrue:
  		[self assert: (objectMemory isContext: (self frameContext: 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].
  		 (objectMemory isImmediate: oop) ifFalse:
  			[marker markAndShouldScan: oop].
  		 theSP := theSP + objectMemory wordSize]!

Item was changed:
  ----- Method: StackInterpreter>>incrementalTraceProfileState (in category 'object memory support') -----
  incrementalTraceProfileState

+ 	<staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
- 	"do not remove. Necessary for resolving polymorphic receiver"
  	| marker |
  	marker := objectMemory marker.

  	objectMemory hasSpurMemoryManagerAPI ifTrue:
  		[self followForwardingPointersInProfileState].
  	marker pushOnMarkingStackAndMakeGreyIfNecessary: profileProcess.
  	marker pushOnMarkingStackAndMakeGreyIfNecessary: profileMethod.
  	marker pushOnMarkingStackAndMakeGreyIfNecessary: profileSemaphore.

  	self cppIf: #LRPCheck
  		ifTrue:
  			["The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt.  Be very careful with it.
  			  If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
  			  been recenty sampled, but it must be newMethod and we don't need to trace it twice.  If LRPCSN
  			  ~= statCheckForEvents then LRPCM must be some extant object and needs to be traced."
  			self sqLowLevelMFence.
  			(longRunningPrimitiveCheckMethod ~= nil
  			 and: [longRunningPrimitiveCheckSequenceNumber ~= statCheckForEvents]) ifTrue:
  				[(objectMemory isForwarded: longRunningPrimitiveCheckMethod) ifTrue:
  					[longRunningPrimitiveCheckMethod := objectMemory followForwarded: longRunningPrimitiveCheckMethod].
  			marker pushOnMarkingStackAndMakeGreyIfNecessary: longRunningPrimitiveCheckMethod].
  			longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
  				[(objectMemory isForwarded: longRunningPrimitiveCheckSemaphore) ifTrue:
  					[longRunningPrimitiveCheckSemaphore := objectMemory followForwarded: longRunningPrimitiveCheckSemaphore].
  				 marker pushOnMarkingStackAndMakeGreyIfNecessary: longRunningPrimitiveCheckSemaphore]]!

Item was changed:
  ----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
  	 during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
  	<inline: false>
  	self mapStackPages.
  	self mapMachineCode: self getGCMode.
  	self mapTraceLogs.
  	self mapVMRegisters.
  	self mapProfileState.
  	(tempOop ~= 0
  	 and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
  		[tempOop := objectMemory remapObj: tempOop].
  	(tempOop2 ~= 0
  	 and: [objectMemory shouldRemapOop: tempOop2]) ifTrue:
  		[tempOop2 := objectMemory remapObj: tempOop2].
  	objectMemory hasSpurMemoryManagerAPI ifFalse:
  		[self getClassTagOfLinkedList]!

Item was changed:
  ----- Method: StackInterpreter>>mapProfileState (in category 'object memory support') -----
  mapProfileState
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
  	(objectMemory shouldRemapObj: profileProcess) ifTrue:
  		[profileProcess := objectMemory remapObj: profileProcess].
  	(objectMemory shouldRemapObj: profileMethod) ifTrue:
  		[profileMethod := objectMemory remapObj: profileMethod].
  	(objectMemory shouldRemapObj: profileSemaphore) ifTrue:
  		[profileSemaphore := objectMemory remapObj: profileSemaphore].
  	self cppIf: #LRPCheck
  		ifTrue:
  			["The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt.  Be very careful with it.
  			  If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
  			  been recenty sampled and could be mapped or not, but it must be newMethod and we can simply
  			  copy newMethod.  If LRPCSN ~= statCheckForEvents then LRPCM must be some extant object and
  			  needs to be remapped."
  			self sqLowLevelMFence.
  			longRunningPrimitiveCheckMethod ifNotNil:
  				[longRunningPrimitiveCheckSequenceNumber = statCheckForEvents
  					ifTrue: [longRunningPrimitiveCheckMethod := newMethod]
  					ifFalse:
  						[(objectMemory shouldRemapObj: longRunningPrimitiveCheckMethod) ifTrue:
+ 							[longRunningPrimitiveCheckMethod := objectMemory remapObj: longRunningPrimitiveCheckMethod]].
- 							[longRunningPrimitiveCheckMethod := self remapObj: longRunningPrimitiveCheckMethod]].
  				 self sqLowLevelMFence].
  			longRunningPrimitiveCheckSemaphore ifNotNil:
  				[(objectMemory shouldRemapObj: longRunningPrimitiveCheckSemaphore) ifTrue:
  					[longRunningPrimitiveCheckSemaphore := objectMemory remapObj: longRunningPrimitiveCheckSemaphore]]]!

Item was changed:
  ----- Method: StackInterpreter>>mapStackPages (in category 'object memory support') -----
  mapStackPages
  	<inline: #never>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #theFP type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #theIPPtr type: #'char *'>
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
  	| numLivePages |
  	numLivePages := 0.
  	0 to: numStackPages - 1 do:
  		[:i| | thePage theSP theFP 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 := 0]
  				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]).
  			 [theSP <= (theFP + FoxReceiver)] 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 not]) ifTrue:
  					[self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
  								  and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]].
  			 (objectMemory shouldRemapObj: (self frameMethod: theFP)) ifTrue:
  				[theIPPtr ~= 0 ifTrue:
  					[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
  					 theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
  				 stackPages
  					longAt: theFP + FoxMethod
  					put: (objectMemory remapObj: (self frameMethod: theFP)).
  				 theIPPtr ~= 0 ifTrue:
  					[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
  			 (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  				[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize.
  				 theFP := callerFP].
  			 theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
  			 [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: 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."
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalSweepAndCompact>
  	(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 changed:
  ----- Method: StackInterpreter>>retryPrimitiveOnFailure (in category 'primitive support') -----
  retryPrimitiveOnFailure
  	"In Spur two cases of primitive failure are handled specially.  A primitive may fail due to validation
  	 encountering a forwarder. On failure, check the accessorDepth for the primitive and if non-negative
  	 scan the args to the depth, following any forwarders.  Retry the primitive if any are found.  Hence
  	 lazily and transparently following forwarders on primitive failure.  Additionally a primitive might fail
  	 due to an allocation failing.  Retry if external primitives have failed with PrimErrNoMemory after running
  	 first the scavenger and then on a subsequent failure, the global mark-sweep collector.  Hence lazily
  	 and transparently GC on memory exhaustion."
  	<option: #SpurObjectMemory>
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector>
  	<inline: false>
  	| primitiveIndex gcDone followDone canRetry retry retried |
  	primitiveIndex := self primitiveIndexOf: newMethod.
  	self assert: (self saneFunctionPointerForFailureOfPrimIndex: primitiveIndex).
  	gcDone := 0.
  	followDone := canRetry := retried := false.
  	[retry := false.
  	 primFailCode = PrimErrNoMemory
  		ifTrue:
  			[(gcDone := gcDone + 1) = 1 ifTrue:
  				[canRetry := primitiveIndex = PrimNumberExternalCall].
  			 canRetry ifTrue:
  				 [gcDone = 1 ifTrue:
  					[objectMemory scavengingGC].
  				 gcDone = 2 ifTrue:
  					[objectMemory fullGC].
  				 retry := gcDone <= 2]]
  		 ifFalse:
  			[followDone ifFalse:
  				[followDone := true.
  				 retry := self checkForAndFollowForwardedPrimitiveState]].
  	 retry] whileTrue:
  		[self assert: primFailCode ~= 0.
  		 retried := true.
  		 self initPrimCall.
  		 self cCode: [] inSmalltalk:
  			[self maybeMapPrimitiveFunctionPointerBackToSomethingEvaluable].
  		 self dispatchFunctionPointer: primitiveFunctionPointer].
  	^retried!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
  primitiveFullGC
  	"Do a full garbage collection.  In SqueakV3ObjectMemory, answer the number
  	 of bytes available (including swap space if dynamic memory management is
  	 supported).  In Spur, answer the size of the largest free chunk."
+ 	
+ 	"because pragma does not get resolved correctly from super we need to inlude it here"
+ 	<staticallyResolveReceiver: 'objectMemory' to: #SpurIncrementalGarbageCollector>

  	self externalWriteBackHeadFramePointers.
  	super primitiveFullGC!

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

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

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

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

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

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

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

  	objectMemory beRootIfOld: result.
  	self methodReturnValue: result!

Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveMemoryMap (in category 'system control primitives') -----
+ primitiveMemoryMap
+ 	"creates a 64 bit array containing an entry for every entity in the heap. The first 8 say which type of object it is and the other 56 which size it has"
+ 
+ 	| result |
+ 	result := objectMemory memoryMap.
+ 	(objectMemory isIntegerObject: result) ifTrue:
+ 		[objectMemory growToAccomodateContainerWithNumSlots: (objectMemory integerValueOf: result).
+ 		 result := objectMemory memoryMap.
+ 		 (objectMemory isIntegerObject: result) ifTrue:
+ 			[^self primitiveFailFor: PrimErrNoMemory]].
+ 	self methodReturnValue: result!

Item was added:
+ ----- Method: TMethod>>asPolymorphicBaseFor:toResolve:default: (in category 'as yet unclassified') -----
+ asPolymorphicBaseFor: aClassCollection toResolve: aSymbol default: defaultClass 
+ 
+ 	| method |
+ 	self assert: (aClassCollection includes: defaultClass).
+ 	
+ 	method := PolymorphicBaseTMethod new.
+ 	
+ 	method 
+ 		copyFrom: self;
+ 		classes: aClassCollection;
+ 		default: defaultClass;
+ 		receiverToResolve: aSymbol.
+ 	
+ 	^ method!

Item was added:
+ ----- Method: TMethod>>asPolymorphicFor:resolveTo: (in category 'as yet unclassified') -----
+ asPolymorphicFor: aSymbol resolveTo: aClass
+ 
+ 	| method |
+ 	method := PolymorphicTMethod new.
+ 	
+ 	method 
+ 		copyFrom: self;
+ 		receiverToResolve: aSymbol;
+ 		receiverClass: aClass;
+ 		selector: (self polymorphicSelectorForClass: aClass).
+ 	
+ 	^ method!

Item was added:
+ ----- Method: TMethod>>isPolymorphic (in category 'testing') -----
+ isPolymorphic
+ 
+ 	^ false!

Item was added:
+ ----- Method: TMethod>>isPolymorphicBase (in category 'testing') -----
+ isPolymorphicBase
+ 
+ 	^ false!

Item was added:
+ ----- Method: TMethod>>polymorphicSelectorForClass: (in category 'as yet unclassified') -----
+ polymorphicSelectorForClass: aClass
+ 
+ 	^ ((aClass name select: [:ea| ea isUppercase]), '_', self selector) asSymbol!

Item was added:
+ ----- Method: TMethod>>pragmasAt: (in category 'accessing') -----
+ pragmasAt: aSelector
+ 	^self compiledMethod pragmasAt: aSelector!

Item was changed:
  ----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
  prepareMethodIn: aCodeGen
  	"Record sends of builtin operators, map sends of the special selector dispatchOn:in:
  	 with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
  	 Declare limit variables for to:[by:]do: loops with limits that potentially have side-effects.
  	 As a hack also update the types of variables introduced to implement cascades correctly.
  	 This has to be done at the same time as this is done, so why not piggy back here?"
  	aCodeGen maybeBreakForTestToInline: selector in: self.
  	extraVariableNumber ifNotNil:
  		[declarations keysAndValuesDo:
  			[:varName :decl|
  			decl isBlock ifTrue:
  				[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
  				 locals add: varName.
  				 self declarationAt: varName
  					put: (decl value: self value: aCodeGen), ' ', varName]]].
+ 
  	aCodeGen
  		pushScope: declarations
  		while:"N.B.  nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved."
  			[parseTree nodesWithParentsDo:
  				[:node :parent|
  				 node isSend ifTrue:
+ 					[aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node fromMethod: self in: self definingClass.
- 					[aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node fromMethodIn: self definingClass.
  					 (aCodeGen isBuiltinSelector: node selector)
  						ifTrue:
  							[node isBuiltinOperator: true.
  							"If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
  							 node selector = #to:by:do: ifTrue:
  								[self ensureToByDoLoopLimitIsSafeAndEfficient: node in: aCodeGen]]
  						ifFalse:
  							[(aCodeGen isStackAccessor: node selector)
  								ifTrue: "compute and cache the accessor depth early, before inlining destroys the accessor chains"
  									[self export ifTrue:
  										[aCodeGen accessorDepthForMethod: self]]
  								ifFalse:
  									[(CaseStatements includes: node selector) ifTrue:
  										[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node in: aCodeGen})].
  									 (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
  										[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })].
  									 (#(printf: fprintf: f:printf: f:wprintf:) includes: node selector) ifTrue:
  										[self transformPrintf: node in: aCodeGen].
  									(node receiver isVariable
  									 and: [node receiver name = #Character
  									 and: [node selector isUnary]]) ifTrue:
  										[parent replaceNodesIn: (Dictionary newFromPairs: { node. TConstantNode new setValue: (Character perform: node selector) })]]]]]]!

Item was changed:
  TParseNode subclass: #TSendNode
+ 	instanceVariableNames: 'selector receiver arguments isBuiltinOperator oldSelector'
- 	instanceVariableNames: 'selector receiver arguments isBuiltinOperator'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'VMMaker-Translation to C'!

Item was added:
+ ----- Method: TSendNode>>oldSelector (in category 'accessing') -----
+ oldSelector
+ 
+ 	^ oldSelector!

Item was added:
+ ----- Method: TSendNode>>oldSelector: (in category 'accessing') -----
+ oldSelector: aClass
+ 
+ 	oldSelector := aClass!

Item was added:
+ ----- Method: TSendNode>>setSelectorForPolymorphism: (in category 'nil') -----
+ setSelectorForPolymorphism: newSelector
+ 
+ 	self
+ 		oldSelector: self selector;
+ 		selector: newSelector!

Item was changed:
  ----- Method: TSendNode>>shouldExcludeReceiverAsFirstArgument: (in category 'C code generation') -----
  shouldExcludeReceiverAsFirstArgument: aCodeGen
  	"Only include the receiver as the first argument in certain cases.
  	 The receiver is always included if it is an expression.
  	 If it is a variable:
  		 If the vmClass says it is an implicit variable, don't include it.
  		 If the method's definingClass says it is an implicit variable, don't include it.
  		 If the variable is 'self' and the method being called is not in
  		 the method set (i.e. it is some external code), don't include it.
  		 If it is a struct send of something the vm says is an implicit variable, don't include it."
  	| m |
  	(aCodeGen isAssertSelector: selector) ifTrue:
  		[^true].

  	(receiver isSend
  	 and: [(receiver shouldExcludeReceiverAsFirstArgument: aCodeGen)
  		or: [receiver receiver isVariable
  			 and: [(self isSelfReference: receiver receiver in: aCodeGen)
  				or: [self isStructReference: receiver receiver in: aCodeGen]]]]) ifTrue:
+ 		[^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver unmodifiedSelector].
- 		[^aCodeGen isNonArgumentImplicitReceiverVariableName: receiver selector].

  	^receiver isVariable
  	    and: [(aCodeGen isNonArgumentImplicitReceiverVariableName: receiver name)
  		    or: [(self isSelfReference: receiver in: aCodeGen)
  			    and: [(m := aCodeGen methodNamed: selector) isNil
  					or: [#(implicit nil) includes: m typeForSelf]]]]!

Item was added:
+ ----- Method: TSendNode>>unmodifiedSelector (in category 'accessing') -----
+ unmodifiedSelector
+ 
+ 	^ self oldSelector ifNil: [selector]!

Item was changed:
  ----- Method: VMClass class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  	"Falsify the `what type of VM is this?' flags that are defined in the various interp.h files.
  	 Subclass implementations need to include a super initializeMiscConstants"

  	| omc |
  	VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
  	SPURVM := STACKVM := COGVM := COGMTVM := false.

  	InitializationOptions ifNil: [InitializationOptions := Dictionary new].
  	omc := InitializationOptions at: #ObjectMemory ifAbsent: nil.
  	(omc isNil and: [self defaultObjectMemoryClass notNil]) ifTrue:
  		[omc := InitializationOptions at: #ObjectMemory put: self defaultObjectMemoryClass name].
  	omc := omc ifNotNil: [Smalltalk at: omc].
  	InitializationOptions
  		at: #SqueakV3ObjectMemory	"the good ole default"
  			ifAbsentPut: (omc
  					ifNil: [true]
  					ifNotNil: [omc includesBehavior: ObjectMemory]);
  		at: #SpurObjectMemory		"the new contender"
  			ifAbsentPut: (omc
  					ifNil: [false]
  					ifNotNil: [omc includesBehavior: SpurMemoryManager]).
  	omc validateInitializationOptions. "hack around edge cases"

  	"Use ifAbsentPut: so that they will get copied back to the
  	 VMMaker's options and dead code will likely be eliminated."
  	PharoVM := InitializationOptions at: #PharoVM ifAbsentPut: [false].
  	NewspeakVM := InitializationOptions at: #NewspeakVM ifAbsentPut: [false].
  	SistaVM := InitializationOptions at: #SistaVM ifAbsentPut: [false].
  	TempVectReadBarrier := InitializationOptions at: #TempVectReadBarrier ifAbsentPut: [false].
  	LowcodeVM := InitializationOptions at: #LowcodeVM ifAbsentPut: [false].
  	MULTIPLEBYTECODESETS := InitializationOptions at: #MULTIPLEBYTECODESETS ifAbsentPut: [false].
  	"Simulation only; on by default..."
  	CloneOnGC := InitializationOptions at: #CloneOnGC ifAbsentPut: [true].
  	CloneOnScavenge := InitializationOptions at: #CloneOnScavenge ifAbsentPut: [true].

  	"These must be set only if specified, not defaulted, because they are set on the command line or in include files."
  	InitializationOptions
  		at: #VMBIGENDIAN	ifPresent: [:value| VMBIGENDIAN := value];
  		at: #ObjectMemory	ifPresent: [:value| SPURVM := value beginsWith: 'Spur'];
  		at: #STACKVM		ifPresent: [:value| STACKVM := value];
  		at: #COGVM		ifPresent: [:value| COGVM := InitializationOptions at: #COGVM];
  		at: #COGMTVM		ifPresent: [:value| COGMTVM := InitializationOptions at: #COGMTVM].

  	"consistency checks"
  	SPURVM
  		ifTrue:
  			[(TempVectReadBarrier not
  			  and: [{SpurMemoryManager compactorClass}, (SpurMemoryManager compactorClass ancilliaryClasses) anySatisfy:
+ 						[:c| c == SpurSelectiveCompactor or: [c == SpurIncrementalSweepAndCompact]]]) ifTrue:
- 						[:c| c == SpurSelectiveCompactor]]) ifTrue:
  				[self error: 'Selective compactor requires read barrier']]
  		ifFalse:
  			[TempVectReadBarrier ifTrue: [self error: 'read barrier works with spur VM only...'].
  			 SistaVM ifTrue: [self error: 'Sista VM works with spur VM only...']].

  	"And not these; they're compile-time"
  	IMMUTABILITY := InitializationOptions at: #IMMUTABILITY ifAbsent: [SPURVM] "Default as enabled for Spur VMs"!

Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurIncrementalStack64VM (in category 'configurations') -----
+ generateSqueakSpurIncrementalStack64VM
+ 	"No primitives since we can use those from the Cog VM"
+ 	^VMMaker
+ 		generate: StackInterpreter
+ 		with: #(ObjectMemory Spur64BitMemoryManager
+ 				FailImbalancedPrimitives false
+ 				MULTIPLEBYTECODESETS true
+ 				TempVectReadBarrier true
+ 				bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
+ 		to: self sourceTree, '/src/spur64.stack'
+ 		platformDir: self sourceTree, '/platforms'
+ 		including: #()!