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

commits at source.squeak.org commits at source.squeak.org
Sat Oct 26 02:33:55 UTC 2013


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

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

Name: VMMaker.oscog-eem.478
Author: eem
Time: 25 October 2013, 7:31:06.556 pm
UUID: 15a1d83f-0c88-4af2-afce-eed621d27ac6
Ancestors: VMMaker.oscog-eem.477

Fix bad bug in Slang translation of ifNil: which was outputting 0 for
the non-nil side instead of the receiver.

Implement some missing nodesDo:parent:'s.

Make some of the methods in the scavenger <inline: false> for debug.

Count tenures in the scavenger (move statTenures there from SMM).
Move initialization of tenuringProportion to where it'll be executed in C.

Move asserts from addTo[Weak|Ephemeron]List: into
setCorpseOffsetOf:to:.

Fix ancilliaryClass collection for CoInterpreter but introducing
isAcceptableAncilliaryClass: hack.

Move defs of GCModes to StackInterpreter class and add a
GCModeScavenge.  Use this to avoid attempting to shrink memory
after a scavenge.  Rename all postGCAction imps to postGCAction:.

Fix vmProxyMinorVersion to bump to 13 with Spur.

Restore the scavengeInProgress and: [self isInFutureSpace: address]
clause to addressCouldBeObj: so we can print objects during scavenge.
Hard to debug otherwise.  Make the space determiners (isInNewSpace:
et al) use oop:isGreaterThanOrEqualTo:andLessThan:.

Count compaction passes in best/exactFitCompact.  Answer this as
statCompMoveCount.  Eliminate some stats that are never going to be
counted in Spur.  Collect relevant stats in fullGC.

Mark some methods as <api> for the VM proxy when minor ver = 13.

Filter-out primitives with <option:> pragmas that evaluate to false.

Modify primitiveVMParameter to answer scavenge stats for params
9 & 10 (inc GCs & inc GC ms) in Spur.

=============== Diff against VMMaker.oscog-eem.477 ===============

Item was changed:
  ----- Method: CCodeGenerator>>generateIfNil:on:indent: (in category 'C translation') -----
  generateIfNil: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
  	(self isNilConstantReceiverOf: msgNode)
  		ifFalse:
  			[aStream nextPutAll: 'if (!!('.
+ 			 msgNode receiver emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
+ 			 aStream nextPutAll: ')) {'; cr.
+ 			 msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
+ 			 aStream tab: level; nextPut: $}]
- 			msgNode receiver emitCCodeAsExpressionOn: aStream level: level + 1 generator: self.
- 			aStream nextPutAll: ')) {'; cr.
- 			msgNode args last emitCCodeOn: aStream level: level + 1 generator: self.
- 			level timesRepeat: [aStream tab].
- 			aStream nextPut: $}]
  		ifTrue:
  			[msgNode args first emitCCodeOn: aStream level: level generator: self]!

Item was changed:
  ----- Method: CCodeGenerator>>generateIfNilAsArgument:on:indent: (in category 'C translation') -----
  generateIfNilAsArgument: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
  	(self isNilConstantReceiverOf: msgNode)
  		ifFalse:
  			[aStream nextPutAll: '(!!('.
  			 msgNode receiver emitCCodeAsArgumentOn: aStream level: 0 generator: self.
+ 			 aStream nextPut: $); crtab: level + 1; nextPut: $?; space.
+ 			 msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
+ 			 aStream crtab: level + 1; nextPut: $:; space.
+ 			 msgNode receiver emitCCodeAsArgumentOn: aStream level: 0 generator: self.
+ 			 msgNode receiver isLeaf ifFalse:
+ 				[logger cr; nextPutAll: 'sending ifNil: to non-leaf in '; nextPutAll: currentMethod selector].
+ 			 aStream nextPut: $)]
- 			aStream nextPut: $); crtab: level + 1; nextPut: $?; space.
- 			msgNode args last emitCCodeAsArgumentOn: aStream level: level + 2 generator: self.
- 			aStream crtab: level + 1; nextPutAll: ': 0)']
  		ifTrue:
  			[msgNode args first emitCCodeAsArgumentOn: aStream level: level generator: self]!

Item was changed:
  ----- Method: CCodeGenerator>>nonStructClassesForTranslationClasses: (in category 'utilities') -----
  nonStructClassesForTranslationClasses: classes
  	"Answer in superclass order (any superclass precedes any subclass)
  	 the ancilliaryClasses that are not struct classes for all the given classes."
  	| nonStructClasses |
  	nonStructClasses := OrderedCollection new.
  	classes do:
  		[:aTranslationClass|
  		([aTranslationClass ancilliaryClasses: self options]
  				on: MessageNotUnderstood
  				do: [:ex|
  					ex message selector == #ancilliaryClasses:
  						ifTrue: [#()]
  						ifFalse: [ex pass]]) do:
  			[:class|
+ 			(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class]) ifTrue:
+ 				[(class isStructClass
+ 				 or: [(nonStructClasses includes: class)
+ 				 or: [classes includes: class]]) ifFalse:
+ 					[nonStructClasses addLast: class]]]].
- 			(class isStructClass
- 			 or: [(nonStructClasses includes: class)
- 			 or: [classes includes: class]]) ifFalse:
- 				[nonStructClasses addLast: class]]].
  	^ChangeSet superclassOrder: nonStructClasses!

Item was changed:
  ----- Method: CCodeGenerator>>structClassesForTranslationClasses: (in category 'utilities') -----
  structClassesForTranslationClasses: classes
  	"Answer in superclass order (any superclass precedes any subclass)
  	 the ancilliaryClasses that are struct classes for all the given classes."
  	| structClasses |
  	structClasses := OrderedCollection new.
  	classes do:
  		[:aTranslationClass|
  		([aTranslationClass ancilliaryClasses: self options]
  				on: MessageNotUnderstood
  				do: [:ex|
  					ex message selector == #ancilliaryClasses:
  						ifTrue: [#()]
  						ifFalse: [ex pass]]) do:
  			[:class|
  			(class isStructClass
+ 			 and: [(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class])
+ 			 and: [(structClasses includes: class) not]]) ifTrue:
- 			 and: [(structClasses includes: class) not]) ifTrue:
  				[structClasses addLast: class]]].
  	^ChangeSet superclassOrder: structClasses!

Item was changed:
  ----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
  	COGVM := true.
  
  	MinBackwardJumpCountForCompile := 10.
  
  	MaxNumArgs := 15.
  	PrimCallNeedsNewMethod := 1.
  	PrimCallNeedsPrimitiveFunction := 2.
  	PrimCallMayCallBack := 4.
  	PrimCallCollectsProfileSamples := 8.
  
  	ReturnToInterpreter := 1. "setjmp/longjmp code."
  
- 	GCModeFull := 1.
- 	GCModeIncr := 2.
- 	GCModeBecome := 3.
- 
  	PrimTraceLogSize := 256. "Room for 256 selectors.  Must be 256 because we use a byte to hold the index"
  	TraceBufferSize := 256 * 3. "Room for 256 events"
  	TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
  	TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
  	TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
  	TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
  	TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
  	TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
  	TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
  	TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
  	TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
  	TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
  	TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
  	TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
  	TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
  
  	TraceIsFromMachineCode := 1.
  	TraceIsFromInterpreter := 2.
  	CSCallbackEnter := 3.
  	CSCallbackLeave := 4.
  	CSEnterCriticalSection := 5.
  	CSExitCriticalSection := 6.
  	CSResume := 7.
  	CSSignal := 8.
  	CSSuspend := 9.
  	CSWait := 10.
  	CSYield := 11.
  	CSCheckEvents := 12.
  	CSThreadSchedulingLoop := 13.
  	CSOwnVM := 14.
  	CSThreadBind := 15.
  	CSSwitchIfNeccessary := 16.
  
  	TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal'  'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
  
  	"this is simulation only"
  	RumpCStackSize := 4096!

Item was added:
+ ----- Method: CoInterpreter class>>isAcceptableAncilliaryClass: (in category 'translation') -----
+ isAcceptableAncilliaryClass: aClass
+ 	^aClass ~~ InterpreterStackPages!

Item was added:
+ ----- Method: CoInterpreter>>gcMode (in category 'object memory support') -----
+ gcMode
+ 	^gcMode!

Item was removed:
- ----- Method: CoInterpreter>>isReallyYoungObject: (in category 'cog jit support') -----
- isReallyYoungObject: obj
- 	<api>
- 	"For machine code assertion checking.  Answer true if not in a fullGC and obj is young."
- 	^gcMode ~= GCModeFull
- 	  and: [self oop: obj isGreaterThanOrEqualTo: objectMemory youngStart]!

Item was removed:
- ----- Method: CoInterpreter>>postGCAction (in category 'object memory support') -----
- postGCAction
- 	"Shrink free memory, signal the gc semaphore and let the Cogit do its post GC thang"
- 	| freeSizeNow |
- 
- 	freeSizeNow := objectMemory freeSize.
- 	(freeSizeNow > objectMemory shrinkThreshold
- 	 and: [freeSizeNow > objectMemory growHeadroom]) ifTrue:
- 		["Attempt to shrink memory after successfully reclaiming lots of memory"
- 		 objectMemory shrinkObjectMemory: freeSizeNow - objectMemory growHeadroom].
- 
- 	cogit cogitPostGCAction: gcMode.
- 
- 	self signalSemaphoreWithIndex: gcSemaphoreIndex.
- 
- 	lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
- 
- 	gcMode := 0!

Item was added:
+ ----- Method: CoInterpreter>>postGCAction: (in category 'object memory support') -----
+ postGCAction: gcModeArg
+ 	"Attempt to shrink free memory, signal the gc semaphore and let the Cogit do its post GC thang"
+ 	self assert: gcModeArg = gcMode.
+ 	super postGCAction: gcModeArg.
+ 	cogit cogitPostGCAction: gcModeArg.
+ 	lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
+ 	gcMode := 0!

Item was added:
+ ----- Method: CogObjectRepresentation>>isImmediate: (in category 'testing') -----
+ isImmediate: oop
+ 	<doNotGenerate>
+ 	^objectMemory isImmediate: oop!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>isImmediate: (in category 'object representation') -----
- isImmediate: oop
- 	^objectMemory isImmediate: oop!

Item was removed:
- ----- Method: CogObjectRepresentationForSqueakV3>>isImmediate: (in category 'object representation') -----
- isImmediate: anOop
- 	^objectMemory isIntegerObject: anOop!

Item was changed:
  ----- Method: Cogit>>checkIfValidObjectRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidObjectRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
  	<var: #mcpc type: #'char *'>
  	| literal cacheTag entryPoint offset targetMethod |
  	<var: #targetMethod type: #'CogMethod *'>
  	annotation = IsObjectReference ifTrue:
  		[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
  		 (self asserta: (objectRepresentation checkValidObjectReference: literal)) ifFalse:
  			[^1].
  		((objectRepresentation couldBeObject: literal)
+ 		 and: [objectMemory isReallyYoungObject: literal]) ifTrue:
- 		 and: [coInterpreter isReallyYoungObject: literal]) ifTrue:
  			[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  				[^2]]].
  	(self isSendAnnotation: annotation) ifTrue:
  		[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
  			[^3].
  		 cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
  		 (self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
  			[^4].
  		((objectRepresentation couldBeObject: cacheTag)
  		 and: [coInterpreter isReallyYoungObject: cacheTag]) ifTrue:
  			[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  				[^5]].
  		entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  		entryPoint > methodZoneBase ifTrue:
  			["It's a linked send; find which kind."
  			 self
  				offsetAndSendTableFor: entryPoint
  				annotation: annotation
  				into: [:off :table| offset := off].
  			 targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
  			 (self asserta: (targetMethod cmType = CMMethod
  						   or: [targetMethod cmType = CMClosedPIC
  						   or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
  				[^6]]].
  	^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCode: (in category 'jit - api') -----
  mapObjectReferencesInMachineCode: gcMode
  	<api>
  	"Update all references to objects in machine code."
  	gcMode caseOf: {
+ 		[GCModeScavenge]	-> [self mapObjectReferencesInMachineCodeForIncrementalGC].
+ 		[GCModeIncr]			-> [self mapObjectReferencesInMachineCodeForScavenge].
+ 		[GCModeFull]			-> [self mapObjectReferencesInMachineCodeForFullGC].
+ 		[GCModeBecome]		-> [self mapObjectReferencesInMachineCodeForBecome] }.
- 		[GCModeIncr]		-> [self mapObjectReferencesInMachineCodeForIncrementalGC].
- 		[GCModeFull]		-> [self mapObjectReferencesInMachineCodeForFullGC].
- 		[GCModeBecome]	-> [self mapObjectReferencesInMachineCodeForBecome] }.
  
  	(self asserta: methodZone freeStart <= methodZone youngReferrers) ifFalse:
  		[self error: 'youngReferrers list overflowed']!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileSetPosition (in category 'file primitives') -----
  primitiveFileSetPosition
+ 	| newPosition file |
- 	| newPosition file sz |
  	<var: 'file' type: 'SQFile *'>
  	<var: 'newPosition' type: 'squeakFileOffsetType'>
  	<export: true>
+ 	(interpreterProxy isIntegerObject: (interpreterProxy stackValue: 0)) ifFalse:
+ 		[(interpreterProxy byteSizeOf: (interpreterProxy stackValue: 0)) ~= (self sizeof: #squeakFileOffsetType) ifTrue:
+ 			[^interpreterProxy primitiveFail]].
- 	(interpreterProxy isImmediate: (interpreterProxy stackValue: 0)) ifFalse:
- 		[sz := self cCode: 'sizeof(squeakFileOffsetType)'.
- 		(interpreterProxy byteSizeOf: (interpreterProxy stackValue: 0)) > sz 
- 			ifTrue: [^interpreterProxy primitiveFail]].
  	newPosition := interpreterProxy positive64BitValueOf: (interpreterProxy stackValue: 0).
  	file := self fileValueOf: (interpreterProxy stackValue: 1).
+ 	interpreterProxy failed ifFalse:
+ 		[self sqFile: file SetPosition: newPosition ].
+ 	interpreterProxy failed ifFalse:
+ 		[interpreterProxy pop: 2] "pop position, file; leave rcvr on stack"!
- 	interpreterProxy failed ifFalse:[
- 		self sqFile: file SetPosition: newPosition ].
- 	interpreterProxy failed ifFalse:[
- 		interpreterProxy pop: 2 "pop position, file; leave rcvr on stack" ].!

Item was removed:
- ----- Method: Interpreter>>postGCAction (in category 'object memory support') -----
- postGCAction
- 	"Mark the active and home contexts as roots if old. This 
- 	allows the interpreter to use storePointerUnchecked to 
- 	store into them."
- 
- 	compilerInitialized
- 		ifTrue: [self compilerPostGC]
- 		ifFalse: [(self oop: activeContext isLessThan: youngStart)
- 				ifTrue: [self beRootIfOld: activeContext].
- 			(self oop: theHomeContext isLessThan: youngStart)
- 				ifTrue: [self beRootIfOld: theHomeContext]].
- 	(self sizeOfFree: freeBlock) > shrinkThreshold
- 		ifTrue: ["Attempt to shrink memory after successfully 
- 			reclaiming lots of memory"
- 			self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
- 	
- 	self signalSemaphoreWithIndex: gcSemaphoreIndex.
- !

Item was added:
+ ----- Method: Interpreter>>postGCAction: (in category 'object memory support') -----
+ postGCAction: gcModeArg
+ 	"Mark the active and home contexts as roots if old. This 
+ 	allows the interpreter to use storePointerUnchecked to 
+ 	store into them."
+ 
+ 	compilerInitialized
+ 		ifTrue: [self compilerPostGC]
+ 		ifFalse: [(self oop: activeContext isLessThan: youngStart)
+ 				ifTrue: [self beRootIfOld: activeContext].
+ 			(self oop: theHomeContext isLessThan: youngStart)
+ 				ifTrue: [self beRootIfOld: theHomeContext]].
+ 	(self sizeOfFree: freeBlock) > shrinkThreshold
+ 		ifTrue: ["Attempt to shrink memory after successfully 
+ 			reclaiming lots of memory"
+ 			self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
+ 	
+ 	self signalSemaphoreWithIndex: gcSemaphoreIndex.
+ !

Item was added:
+ ----- Method: NewCoObjectMemory>>isReallyYoungObject: (in category 'cog jit support') -----
+ isReallyYoungObject: obj
+ 	<api>
+ 	"For machine code assertion checking.  Answer true if not in a fullGC and obj is young."
+ 	^coInterpreter gcMode ~= GCModeFull
+ 	  and: [self oop: obj isGreaterThanOrEqualTo: self youngStart]!

Item was removed:
- ----- Method: NewCoObjectMemorySimulator>>postGCAction (in category 'simulation only') -----
- postGCAction
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter postGCAction!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>postGCAction: (in category 'simulation only') -----
+ postGCAction: gcMode
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter postGCAction: gcMode!

Item was changed:
  ----- Method: NewObjectMemory>>fullGC (in category 'garbage collection') -----
  fullGC
  	"Do a mark/sweep garbage collection of the entire object memory.
  	 Free inaccessible objects but do not move them."
  
  	<inline: false>
  	fullGCLock > 0 ifTrue:
  		[self warning: 'aborting fullGC because fullGCLock > 0'.
  		 ^self].
  	self runLeakCheckerForFullGC: true.
  	self preGCAction: GCModeFull.
  	needGCFlag := false.
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self clearRootsTable.
  	self initWeakTableForIncrementalGC: false.
  	youngStart := self startOfMemory.  "process all of memory"
  	self markPhase: true.
  	"Sweep phase returns the number of survivors.
  	Use the up-to-date version instead the one from startup."
  	totalObjectCount := self sweepPhaseForFullGC.
  	self runLeakCheckerForFullGC: true.
  	self fullCompaction.
  	statFullGCs := statFullGCs + 1.
  	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
  	self capturePendingFinalizationSignals.
  
  	youngStart := freeStart.  "reset the young object boundary"
+ 	self postGCAction: GCModeFull.
- 	self postGCAction.
  	self runLeakCheckerForFullGC: true!

Item was changed:
  ----- Method: NewObjectMemory>>incrementalGC (in category 'garbage collection') -----
  incrementalGC
  	"Do a mark/sweep garbage collection of just the young object
  	area of object memory (i.e., objects above youngStart), using
  	the root table to identify objects containing pointers to
  	young objects from the old object area."
  	| survivorCount weDidGrow |
  	<inline: false>
  
  	rootTableOverflowed ifTrue:
  		["root table overflow; cannot do an incremental GC because some roots are missing.
  		 (this should be very rare)"
  		 statRootTableOverflows := statRootTableOverflows + 1.
  		 ^self fullGC].
  	self runLeakCheckerForFullGC: false.
  	coInterpreter preGCAction: GCModeIncr.
  	needGCFlag := false.
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self initWeakTableForIncrementalGC: true.
  	"implicitly process memory from youngStart to freeStart"
  	self markPhase: false.
  	self assert: weakRootCount <= WeakRootTableSize.
  	1 to: weakRootCount do:
  		[:i| self finalizeReference: (weakRoots at: i)].
  	survivorCount := self sweepPhase.
  	self runLeakCheckerForFullGC: false.
  	self incrementalCompaction.
  	statIncrGCs := statIncrGCs + 1.
  	statGCEndUsecs := self ioUTCMicrosecondsNow.
  	statIGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
  	statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
  	self capturePendingFinalizationSignals.
  	
  	statRootTableCount  := rootTableCount.
  	statSurvivorCount := survivorCount.
  	weDidGrow := false.
  	(((survivorCount > tenuringThreshold)
  	 or: [rootTableCount >= RootTableRedZone])
  	 or: [forceTenureFlag == true]) ifTrue:
  		["move up the young space boundary if
  		  * there are too many survivors:
  			this limits the number of objects that must be
  			processed on future incremental GC's
  		  * we're about to overflow the roots table:
  			this limits the number of full GCs that may be caused
  			by root table overflows in the near future"
  		forceTenureFlag := false.
  		statTenures := statTenures + 1.
  		self clearRootsTable.
  		((self freeSize < growHeadroom)
  		 and: [gcBiasToGrow > 0]) ifTrue:
  			[self biasToGrow.
  			 weDidGrow := true].
  		youngStart := freeStart].
+ 	coInterpreter postGCAction: GCModeIncr.
- 	coInterpreter postGCAction.
  	
  	self runLeakCheckerForFullGC: false.
  	weDidGrow ifTrue:
  		[self biasToGrowCheckGCLimit]!

Item was removed:
- ----- Method: NewObjectMemorySimulator>>postGCAction (in category 'simulation only') -----
- postGCAction
- 	"hack around the CoInterpreter/ObjectMemory split refactoring"
- 	^coInterpreter postGCAction!

Item was added:
+ ----- Method: NewObjectMemorySimulator>>postGCAction: (in category 'simulation only') -----
+ postGCAction: gcMode
+ 	"hack around the CoInterpreter/ObjectMemory split refactoring"
+ 	^coInterpreter postGCAction: gcMode!

Item was removed:
- ----- Method: NewspeakInterpreter>>postGCAction (in category 'object memory support') -----
- postGCAction
- 	"Mark the active and home contexts as roots if old. This 
- 	allows the interpreter to use storePointerUnchecked to 
- 	store into them."
- 
- 	activeContext < youngStart ifTrue:
- 		[self beRootIfOld: activeContext].
- 	theHomeContext < youngStart ifTrue:
- 		[self beRootIfOld: theHomeContext].
- 	(self sizeOfFree: freeBlock) > shrinkThreshold ifTrue:
- 		["Attempt to shrink memory after successfully reclaiming lots of memory"
- 		 self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
- 	
- 	self signalSemaphoreWithIndex: gcSemaphoreIndex!

Item was added:
+ ----- Method: NewspeakInterpreter>>postGCAction: (in category 'object memory support') -----
+ postGCAction: gcModeArg
+ 	"Mark the active and home contexts as roots if old. This 
+ 	allows the interpreter to use storePointerUnchecked to 
+ 	store into them."
+ 
+ 	activeContext < youngStart ifTrue:
+ 		[self beRootIfOld: activeContext].
+ 	theHomeContext < youngStart ifTrue:
+ 		[self beRootIfOld: theHomeContext].
+ 	(self sizeOfFree: freeBlock) > shrinkThreshold ifTrue:
+ 		["Attempt to shrink memory after successfully reclaiming lots of memory"
+ 		 self shrinkObjectMemory: (self sizeOfFree: freeBlock) - growHeadroom].
+ 	
+ 	self signalSemaphoreWithIndex: gcSemaphoreIndex!

Item was changed:
  ----- Method: ObjectMemory>>fullGC (in category 'garbage collection') -----
  fullGC
  	"Do a mark/sweep garbage collection of the entire object memory. Free inaccessible objects but do not move them."
  
  	<inline: false>
  	DoAssertionChecks ifTrue:
  		[self reverseDisplayFrom: 0 to: 7.
  		 self clearLeakMapAndMapAccessibleObjects.
  		 self checkHeapIntegrity].
  	self preGCAction: GCModeFull.
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self clearRootsTable.
  	self initWeakTableForIncrementalGC: false.
  	youngStart := self startOfMemory.  "process all of memory"
  	self markPhase.
  	"Sweep phase returns the number of survivors.
  	Use the up-to-date version instead the one from startup."
  	totalObjectCount := self sweepPhase.
  	self fullCompaction.
  	allocationCount := 0.
  	statFullGCs := statFullGCs + 1.
  	statGCEndTime := self ioMicroMSecs.
  	statFullGCUsecs := statFullGCUsecs + (self ioUTCMicrosecondsNow - gcStartUsecs).
  	self capturePendingFinalizationSignals.
  
  	youngStart := freeBlock.  "reset the young object boundary"
+ 	self postGCAction: GCModeFull.
- 	self postGCAction.
  	DoAssertionChecks ifTrue:
  		[self clearLeakMapAndMapAccessibleObjects.
  		 self checkHeapIntegrity.
  		 self reverseDisplayFrom: 0 to: 7]!

Item was changed:
  ----- Method: ObjectMemory>>incrementalGC (in category 'garbage collection') -----
  incrementalGC
  	"Do a mark/sweep garbage collection of just the young object 
  	area of object memory (i.e., objects above youngStart), using 
  	the root table to identify objects containing pointers to 
  	young objects from the old object area."
  	| survivorCount weDidGrow |
  	<inline: false>
  	rootTableOverflowed ifTrue:
  		["root table overflow; cannot do an incremental GC because some roots are missing.
  		 (this should be very rare)"
  		 statRootTableOverflows := statRootTableOverflows + 1.
  		 ^self fullGC].
  
  	DoAssertionChecks ifTrue:
  		[self reverseDisplayFrom: 8 to: 15.
  		 self checkHeapIntegrity.
  		 self checkInterpreterIntegrity.
  		 self validate].
  
  	self preGCAction: GCModeIncr.
  	"incremental GC and compaction"
  
  	gcStartUsecs := self ioUTCMicrosecondsNow.
  	statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  	self initWeakTableForIncrementalGC: true.
  	self markPhase.
  	self assert: weakRootCount <= WeakRootTableSize.
  	1 to: weakRootCount do:[:i| self finalizeReference: (weakRoots at: i)].
  	survivorCount := self sweepPhase.
  	self incrementalCompaction.
  	statAllocationCount := allocationCount.
  	allocationCount := 0.
  	statIncrGCs := statIncrGCs + 1.
  	statGCEndTime := self ioMicroMSecs.
  	statIGCDeltaUsecs := self ioUTCMicrosecondsNow - gcStartUsecs.
  	statIncrGCUsecs := statIncrGCUsecs + statIGCDeltaUsecs.
  	self capturePendingFinalizationSignals.
  
  	self forceInterruptCheck. "Force an an interrupt check ASAP.We could choose to be clever here and only do this under certain time conditions. Keep it simple for now"
  	
  	statRootTableCount  := rootTableCount.
  	statSurvivorCount := survivorCount.
  	weDidGrow := false.
  	(((survivorCount > tenuringThreshold)
  			or: [rootTableCount >= RootTableRedZone])
  			or: [forceTenureFlag == true])
  		ifTrue: ["move up the young space boundary if 
  			* there are too many survivors: 
  			this limits the number of objects that must be 
  			processed on future incremental GC's 
  			* we're about to overflow the roots table 
  			this limits the number of full GCs that may be caused 
  			by root table overflows in the near future"
  			forceTenureFlag := false.
  			statTenures := statTenures + 1.
  			self clearRootsTable.
  			(((self sizeOfFree: freeBlock) < growHeadroom) and: 
  				[gcBiasToGrow > 0]) 
  				ifTrue: [self biasToGrow.
  						weDidGrow := true].
  			youngStart := freeBlock].
+ 	self postGCAction: GCModeIncr.
- 	self postGCAction.
  	DoAssertionChecks ifTrue:
  		[self validate.
  		 self checkHeapIntegrity.
  		 self checkInterpreterIntegrity.
  		 self reverseDisplayFrom: 8 to: 15].
  	weDidGrow ifTrue: [self biasToGrowCheckGCLimit]!

Item was changed:
  ----- Method: ObjectMemory>>isImmediate: (in category 'interpreter access') -----
  isImmediate: anOop
+ 	<api>
  	^self isIntegerObject: anOop!

Item was changed:
  CogClass subclass: #SpurGenerationScavenger
+ 	instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize previousRememberedSetSize weakList ephemeronList tenureCriterion tenureThreshold tenuringClassIndex tenuringProportion numRememberedEphemerons statTenures'
- 	instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize previousRememberedSetSize weakList ephemeronList tenureCriterion tenureThreshold tenuringClassIndex tenuringProportion numRememberedEphemerons'
  	classVariableNames: 'RememberedSetLimit RememberedSetRedZone'
  	poolDictionaries: 'SpurMemoryManagementConstants'
  	category: 'VMMaker-SpurMemoryManager'!
  
  !SpurGenerationScavenger commentStamp: 'eem 9/30/2013 11:05' prior: 0!
  SpurGenerationScavenger is an implementation of David Ungar's Generation Scavenging garbage collection algorithm.  See
  	Generation Scavenging, A Non-disruptive, High-Performance Storage Reclamation Algorithm
  	David Ungar
  	Proceeding
  	SDE 1 Proceedings of the first ACM SIGSOFT/SIGPLAN software engineering symposium on Practical software development environments
  	Pages 157 - 167 
  	ACM New York, NY, USA ©1984 
  
  Also relevant are
  	An adaptive tenuring policy for generation scavengers
  	David Ungar & Frank Jackson
  	ACM Transactions on Programming Languages and Systems (TOPLAS) TOPLAS Homepage archive
  	Volume 14 Issue 1, Jan. 1992 
  	Pages 1 - 27 
  	ACM New York, NY, USA ©1992
  and
  	Ephemerons: a new finalization mechanism
  	Barry Hayes
  	Proceedings of the 12th ACM SIGPLAN conference on Object-oriented programming, systems, languages, and applications
  	Pages 176-183 
  	ACM New York, NY, USA ©1997
  
  See text below the variable definitions and explanation below for a full explanation of weak and ephemeron processing.
  
  Instance Variables
  	coInterpreter:					<StackInterpreterSimulator|CogVMSimulator>
  	eden:							<SpurNewSpaceSpace>
  	ephemeronList:					<Integer|nil>
  	futureSpace:					<SpurNewSpaceSpace>
  	futureSurvivorStart:				<Integer address>
  	manager:						<SpurMemoryManager|Spur32BitMMLESimulator et al>
  	numRememberedEphemerons:	<Integer>
  	pastSpace:						<SpurNewSpaceSpace>
  	previousRememberedSetSize:	<Integer>
  	rememberedSet:				<CArrayAccessor on: Array>
  	rememberedSetSize:			<Integer>
  	tenuringProportion:				<Float>
  	tenuringThreshold:				<Integer address>
  	weakList:						<Integer|nil>
  
  coInterpreter
  	- the interpreter/vm, in this context, the mutator
  
  manager
  	- the Spur memory manager
  
  eden
  	- the space containing newly created objects
  
  futureSpace
  	- the space to which surviving objects are copied during a scavenge
  
  futureSurvivorStart
  	- the allocation pointer into futureSpace
  
  pastSpace
  	- the space surviving objects live in until the next scavenge
  
  rememberedSet
  	- the root old space objects that refer to objects in new space; a scavenge starts form these roots and the interpreter's stack
  
  rememberedSetSize
  	- the size of the remembered set, also the first unused index in the rememberedSet
  
  previousRememberedSetSize:
  	- the size of the remembered set before scavenging objects in future space.
  
  numRememberedEphemerons
  	- the number of unscavenged ephemerons at the front of the rememberedSet.
  
  ephemeronList
  	- the head of the list of corpses of unscavenged ephemerons reached in the current phase
  
  weakList
  	- the head of the list of corpses of weak arrays reached during the scavenge.
  
  tenuringProportion
  	- the amount of pastSpace below which the system will not tenure unless futureSpace fills up, and above which it will eagerly tenure
  
  tenuringThreshold
  	- the pointer into pastSpace below which objects will be tenured
  
  Weakness and Ephemerality in the Scavenger.
  Weak arrays should not hold onto their referents (except from their strong fileds, their named inst vars).  Ephemerons are objects that implement instance-based finalization; attaching an ephemeron to an object keeps that object alive and causes the ephemeron to "fire" when the object is only reachable from the ephemeron (or other ephemerons & weak arrays).  They are a special kind of Associations that detect when their keys are about to die, i.e. when an ephemeron's key is not reachable from the roots except from weak arrays and other ephemerons with about-to-die keys.  Note that if an ephemeron's key is not about to die then references from the rest of the ephemeron can indeed prevent ephemeron keys from dying.
  
  The scavenger is concerned with collecting objects in new space, therefore it ony deals with weak arrays and ephemerons that are either in the remembered set or in new space.  By deferring scanning these objects until other reachable objects have been scavenged, the scavenger can detect dead or dying references.
  
  Weak Array Processing
  In the case of weak arrays this is simple.  The scavenger refuses to scavenge the referents of weak arrays in scavengeReferentsOf: until the entire scavenge is over.  It then scans the weak arrays in the remembered set and in future space and nils all fields in them that are referring to unforwarded objects in eden and past space, because these objects have not survived the scavenge.  The root weak arrays remaining to be scavenged are in the remembered table.  Surviving weak arrays in future space are collected on a list.  The list is threaded through the corpses of weak arrays in eden and/or past space.  weakList holds the slot offset of the first weak array found in eden and/or past space.  The next offset is stored in the weak array corpse's identityHash and format fields (22 bits & 5 bits of allocationUnits, for a max new space size of 2^28 bytes, 256Mb).  The list is threaded throguh corpses, but the surviving arrays are pointed to by the corpses' forwarding pointers.
  
  Ephemeron Processing
  The case of ephemerons is a little more complicated because an ephemeron's key should survive.  The scavenger is cyclical.  It scavenges the remembered set, which may copy and forward surviving objects in past and/or eden spaces to future space.  It then scavenges those promoted objects in future space until no more are promoted, which may in turn remember more objects.  The cycles continue until no more objects get promoted to future space and no more objects get remembered.  At this point all surviving objecta are in futureSpace.
  
  So if the scavenger does not scan ephemerons in the remembered set or in future space until the scavenger finishes cycling, it can detect ephemerons whose keys are about to die because these will be unforwarded objects in eden and/or past space.  Ephemerons encountered in the remembered set are either processed like ordinary objects if their keys have been promoted to futureSpace, or are moved to the front of the rememberedSet (because, dear reader, it is a sequence) if their keys have not been promoted.  Ephemerons encountered in scavengeReferentsOf: are either scanned like normal objects if their keys have been promoted, or added to the ephemeronList, organized identically to the weakList, if their keys are yet to be promoted.  Since references from other ephemerons with surviving keys to ephemeron keys can and should prevent the ephemerons whose keys they are from firing the scavenger does not fire ephemerons unless all unscavenged ephemerons have unscavenged keys.  So the unscavenged ephemerons (the will be at the beginning of the remembered set and on the ephemeronList) are scanned and any that have promoted keys are scavenged.  But if no unscavenged ephemerons have surviving keys then all the unscavenged ephemerons are fired and then scavenged.  This in turn may remember more objects and promote more objects to future space, and encounter more unscavenged ephemerons.  So the scavenger continues until no more objects are remembered, no more objects are promoted to future space and no more unscavenged ephemerons exist.!

Item was changed:
  ----- Method: SpurGenerationScavenger>>addToEphemeronList: (in category 'weakness and ephemerality') -----
  addToEphemeronList: ephemeronCorpse
  	"ephemeronCorpse is the corpse of an ephemeron that was copied and forwarded.
  	 Later on its surviving copy must be scanned to nil weak references.
  	 Thread the corpse onto the weakList.  Later, the weakList can be followed, and
  	 the forwarding pointer followed to locate the survivor."
  	<inline: false>
  	| ephemeronListOffset |
- 	self assert: (manager isYoung: ephemeronCorpse).
- 	self assert: (manager isForwarded: ephemeronCorpse).
  	self assert: (self isScavengeSurvivor: (manager keyOfEphemeron: (manager followForwarded: ephemeronCorpse))) not.
  
  	ephemeronListOffset := ephemeronList ifNil: 0.
  	self setCorpseOffsetOf: ephemeronCorpse to: ephemeronListOffset.
  	ephemeronList := self corpseOffsetOf: ephemeronCorpse.
  	self assert: (self firstCorpse: ephemeronList) = ephemeronCorpse!

Item was changed:
  ----- Method: SpurGenerationScavenger>>addToWeakList: (in category 'weakness and ephemerality') -----
  addToWeakList: weakCorpse
  	"weakCorpse is the corpse of a weak array that was copied and forwarded.
  	 Later on its surviving copy must be scanned to nil weak references.
  	 Thread the corpse onto the weakList.  Later, the weakList can be followed, and
  	 the forwarding pointer followed to locate the survivor."
  	<inline: false>
  	| weakListOffset |
- 	self assert: (manager isYoung: weakCorpse).
- 	self assert: (manager isForwarded: weakCorpse).
  
  	weakListOffset := weakList ifNil: 0.
  	self setCorpseOffsetOf: weakCorpse to: weakListOffset.
  	weakList := self corpseOffsetOf: weakCorpse.
  	self assert: (self firstCorpse: weakList) = weakCorpse!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyToOldSpace: (in category 'scavenger') -----
  copyToOldSpace: survivor
  	"Copy survivor to oldSpace.  Answer the new oop of the object."
  	<inline: true>
  	| numSlots newOop |
+ 	statTenures := statTenures + 1.
  	self flag: 'why not just pass header??'.
  	numSlots := manager numSlotsOf: survivor.
  	newOop := manager
  					allocateSlotsInOldSpace: numSlots
  					format: (manager formatOf: survivor)
  					classIndex: (manager classIndexOf: survivor).
  	newOop ifNil:
  		[self error: 'out of memory'].
  	manager
  		mem: newOop + manager baseHeaderSize
  		cp: survivor + manager baseHeaderSize
  		y: numSlots * manager wordSize.
  	self remember: newOop.
  	manager setIsRememberedOf: newOop to: true.
  	^newOop!

Item was changed:
  ----- Method: SpurGenerationScavenger>>initialize (in category 'initialization') -----
  initialize
  	pastSpace := SpurNewSpaceSpace new.
  	futureSpace := SpurNewSpaceSpace new.
  	eden := SpurNewSpaceSpace new.
  	rememberedSet := CArrayAccessor on: (Array new: RememberedSetLimit).
  	rememberedSetSize := 0.
  	tenureThreshold := 0.
+ 	statTenures := 0!
- 	tenuringProportion := 0.9!

Item was changed:
  ----- Method: SpurGenerationScavenger>>newSpaceStart:newSpaceBytes:edenBytes: (in category 'initialization') -----
  newSpaceStart: startAddress newSpaceBytes: totalBytes edenBytes: requestedEdenBytes 
  	| actualEdenBytes survivorBytes |
  
  	actualEdenBytes := requestedEdenBytes.
  	survivorBytes := totalBytes - actualEdenBytes // 2 truncateTo: manager allocationUnit.
  	actualEdenBytes := totalBytes - survivorBytes - survivorBytes truncateTo: manager allocationUnit.
  	self assert: totalBytes - actualEdenBytes - survivorBytes - survivorBytes < manager allocationUnit.
  
  	"for tenuring we require older objects below younger objects.  since allocation
  	 grows up this means that the survivor spaces must preceed eden."
  
  	pastSpace start: startAddress; limit: startAddress + survivorBytes.
  	futureSpace start: pastSpace limit; limit: pastSpace limit + survivorBytes.
  	eden start: futureSpace limit; limit: futureSpace limit + actualEdenBytes.
  
  	self assert: futureSpace limit <= (startAddress + totalBytes).
  	self assert: eden start \\ manager allocationUnit
  				+ (eden limit \\ manager allocationUnit) = 0.
  	self assert: pastSpace start \\ manager allocationUnit
  				+ (pastSpace limit \\ manager allocationUnit) = 0.
  	self assert: futureSpace start \\ manager allocationUnit
  				+ (futureSpace limit \\ manager allocationUnit) = 0.
  
  	self initFutureSpaceStart.
+ 	manager initSpaceForAllocationCheck: (self addressOf: eden).
+ 
+ 	tenuringProportion := 0.9!
- 	manager initSpaceForAllocationCheck: (self addressOf: eden)!

Item was changed:
  ----- Method: SpurGenerationScavenger>>processEphemerons (in category 'weakness and ephemerality') -----
  processEphemerons
  	"There are ephemerons to be scavenged.  Scavenge them and fire any whose keys are
  	 still in pastSpace and/or eden.  The unscavenged ephemerons in this cycle can only be
  	 fired if all the unscavenged ephemerons in this cycle are firable, because references
  	 to ephemeron keys from unfired ephemerons should prevent the ephemerons with
  	 those keys from firing.  So scavenge ephemerons with surviving keys, and only if none
  	 are found, fire ephemerons with unreferenced keys, and scavenge them.   Read the
  	 class comment for a more in-depth description of the algorithm."
+ 	<inline: false>
  	| unfiredEphemeronsScavenged |
  	unfiredEphemeronsScavenged := self scavengeUnfiredEphemeronsInRememberedSet.
  	self scavengeUnfiredEphemeronsOnEphemeronList ifTrue:
  		[unfiredEphemeronsScavenged := true].
  	unfiredEphemeronsScavenged ifFalse:
  		[self fireEphemeronsInRememberedSet.
  		 self fireEphemeronsOnEphemeronList]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>processWeaklings (in category 'weakness and ephemerality') -----
  processWeaklings
  	"Go through the remembered set and the weak list, nilling references to
  	 any objects that didn't survive the scavenge. Read the class comment
  	 for a more in-depth description of the algorithm."
+ 	<inline: false>
  	| i rootObj weakCorpse weakObj |
  	i := 0.
  	[i < rememberedSetSize] whileTrue:
  		[rootObj := rememberedSet at: i.
  		(manager isWeakNonImm: rootObj)
  			ifTrue:
  				[self processWeakSurvivor: rootObj.
  				 "If no more referents, remove by overwriting with the last element in the set."
  				 (manager hasYoungReferents: rootObj)
  					ifFalse:
  						[manager setIsRememberedOf: rootObj to: false.
  						 i + 1 < rememberedSetSize ifTrue:
  							[rememberedSet at: i put: (rememberedSet at: rememberedSetSize - 1)].
  						 rememberedSetSize := rememberedSetSize - 1]
  					ifTrue: [i := i + 1]]
  			ifFalse: [i := i + 1]].
  	weakList ifNotNil:
  		[weakCorpse := self firstCorpse: weakList.
  		 [weakCorpse notNil] whileTrue:
  			[self assert: (manager isForwarded: weakCorpse).
  			 weakObj := manager followForwarded: weakCorpse.
  			 self processWeakSurvivor: weakObj.
  			 weakCorpse := self nextCorpseOrNil: weakCorpse].
  		weakList := nil]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeFutureSurvivorSpaceStartingAt: (in category 'scavenger') -----
  scavengeFutureSurvivorSpaceStartingAt: initialAddress
  	"scavengeFutureSurvivorSpaceStartingAt: does a depth-first traversal of the
  	 new objects starting at the one at initialAddress in futureSurvivorSpace."
+ 	<inline: false>
  	| ptr obj |
  	ptr := initialAddress.
  	[ptr < futureSurvivorStart] whileTrue:
  		[obj := manager objectStartingAt: ptr.
  		 ptr := manager addressAfter: obj.
  		 self cCoerceSimple: (self scavengeReferentsOf: obj) to: #void]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>scavengeLoop (in category 'scavenger') -----
  scavengeLoop
  	"This is the inner loop of the main routine, scavenge.  It first scavenges the new objects immediately
  	 reachable from old ones. Then it scavenges those that are transitively reachable.  If this results in a
  	 promotion, the promotee gets remembered, and it first scavenges objects adjacent to the promotee,
  	 then scavenges the ones reachable from the promoted.  This loop continues until no more reachable
  	 objects are left.  At that point, pastSurvivorSpace is exchanged with futureSurvivorSpace.
  
  	 Notice that each pointer in a live object is inspected once and only once.  The previousRememberedSetSize
  	 and previousFutureSurvivorSpaceLimit variables ensure that no object is scanned twice, as well as
  	 detecting closure.  If this were not true, some pointers might get forwarded twice.
  
  	 An extension of the algorithm presented in David's original paper is to handle weak arrays and ephemerons.
  	 Weak arrays should not have their weak referents scavenged unless there are strong references to them.
  	 Ephemerons should fire if their key is not reachable other than from ephemerons and weak arrays.
  	 Handle this by maintaining a list for weak arrays and a list for ephemerons, which allow scavenging these
  	 objects once all other objects in new space have been scavenged, hence allowing the scavenger to
  	 detect which referents in new space of weak arrays are dead and of ephemeron keys are only live due to
  	 ephemerons.  Read the class comment for a more in-depth description of the algorithm."
+ 	<inline: false>
+ 	<returnTypeC: #void>
- 
  	| previousFutureSurvivorStart firstTime |
  	self assert: futureSurvivorStart = futureSpace start. "future space should be empty at the start"
  
  	weakList := ephemeronList := nil.
  	numRememberedEphemerons := 0.
  	firstTime := true.
  	previousRememberedSetSize := 0.
  	previousFutureSurvivorStart := futureSurvivorStart.
  
  	[self scavengeRememberedSetStartingAt: previousRememberedSetSize.
  	 previousRememberedSetSize := rememberedSetSize.
  	 firstTime ifTrue:
  		[coInterpreter mapInterpreterOops.
  		 manager mapExtraRoots.
  		 firstTime := false].
  	 "if nothing more copied and forwarded (or remembered by mapInterpreterOops)
  	  to scavenge, and no ephemerons to process, scavenge is done."
  	 (previousRememberedSetSize = rememberedSetSize
  	  and: [previousFutureSurvivorStart = futureSurvivorStart
  	  and: [numRememberedEphemerons = 0
  	  and: [ephemeronList isNil]]]) ifTrue:
  		[^self].
  
  	 self scavengeFutureSurvivorSpaceStartingAt: previousFutureSurvivorStart.
  	 previousFutureSurvivorStart := futureSurvivorStart.
  
  	 "no more roots created to scavenge..."
  	 previousRememberedSetSize = rememberedSetSize ifTrue:
  		[(numRememberedEphemerons = 0
  		  and: [ephemeronList isNil]) ifTrue:
  			[^self]. "no ephemerons to process, scavenge is done."
  
  		 "all reachable objects in this cycle have been promoted to futureSpace.
  		  ephemerons can now be processed."
  		 self processEphemerons]] repeat!

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."
  		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:
  				[(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: SpurGenerationScavenger>>setCorpseOffsetOf:to: (in category 'weakness and ephemerality') -----
  setCorpseOffsetOf: corpse to: offset
  	"Set the offset of the corpse's next corpse to offset.  Use the identityHash
  	 and format fields to construct a 27 bit offset through non-future newSpace
  	 and use this to implement the list.  27 bits of 8 byte allocationUnits units is
  	 2 ^ 30 bytes or 1Gb, big enough for newSpace for a good few years yet."
+ 
+ 	self assert: (manager isYoung: corpse).
+ 	self assert: (manager isForwarded: corpse).
  	manager
  		setHashBitsOf: corpse
  			to: offset >> manager formatFieldWidthShift;
  		setFormatOf: corpse
  			to: (offset bitAnd: manager formatMask)!

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

Item was changed:
  CogClass subclass: #SpurMemoryManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: SpurMemoryManager>>addressCouldBeObj: (in category 'debug support') -----
  addressCouldBeObj: address
  	<api>
+ 	<inline: false>
  	^(address bitAnd: self baseHeaderSize - 1) = 0
  	  and: [(self isInOldSpace: address)
  		or: [(self isInEden: address)
  		or: [(self isInSurvivorSpace: address)
+ 		or: [scavengeInProgress and: [self isInFutureSpace: address]]]]]!
- 		"or: [scavengeInProgress and: [self isInFutureSpace: address]"]]]!

Item was changed:
  ----- Method: SpurMemoryManager>>bestFitCompact (in category 'compaction') -----
  bestFitCompact
  	"Compact all of memory using best-fit, assuming free space is sorted
  	 and that the highest objects are recorded in highestObjects."
  
  	<returnTypeC: #void>
  	<inline: false>
  	| freePriorToExactFit |
  	freePriorToExactFit := totalFreeOldSpace.
  	self exactFitCompact.
  	highestObjects isEmpty ifTrue:
  		[^self]. "either no high objects, or no misfits."
+ 	statCompactPassCount := statCompactPassCount + 1.
  	highestObjects reverseDo:
  		[:o| | b |
  		 self assert: ((self isForwarded: o) or: [self isPinned: o]) not.
  		 b := self bytesInObject: o.
  				(self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
  					[:f|
  					self mem: f
  						cp: o
  						y: ((self hasOverflowHeader: o)
  								ifTrue: [b - self baseHeaderSize]
  								ifFalse: [b]).
  					(self isRemembered: o) ifTrue:
  						[scavenger remember: f].
  					self forward: o to: f]].
  	self allOldSpaceObjectsFrom: firstFreeChunk
  		do: [:o| | b |
  			((self isForwarded: o)
  			 or: [self isPinned: o]) ifFalse:
  				[b := self bytesInObject: o.
  				(self allocateOldSpaceChunkOfBytes: b suchThat: [:f| f < o]) ifNotNil:
  					[:f|
  					self mem: f
  						cp: o
  						y: ((self hasOverflowHeader: o)
  								ifTrue: [b - self baseHeaderSize]
  								ifFalse: [b]).
  					(self isRemembered: o) ifTrue:
  						[scavenger remember: f].
  					self forward: o to: f]]].
  	self checkFreeSpace
  	self touch: freePriorToExactFit!

Item was changed:
  ----- Method: SpurMemoryManager>>characterObjectOf: (in category 'object access') -----
+ characterObjectOf: characterCode
+ 	<api>
- characterObjectOf: characterCode 
  	^characterCode << self numTagBits + self characterTag!

Item was changed:
  ----- Method: SpurMemoryManager>>exactFitCompact (in category 'compaction') -----
  exactFitCompact
  	"Compact all of memory above firstFreeChunk using exact-fit, assuming free
  	 space is sorted and that the highest objects are recorded in highestObjects.
  	 Note that we don't actually move; we merely copy and forward.  Eliminating
  	 forwarders will be done in a final pass.
  	 Leave the objects that don't fit exactly, and hence aren't moved, in highestObjects."
  
  	<returnTypeC: #void>
  	<inline: false>
  	| failures first |
  	<var: #failures type: #usqInt>
  	totalFreeOldSpace = 0 ifTrue: [^0].
  	failures := highestObjects last + self wordSize.
+ 	[statCompactPassCount := statCompactPassCount + 1.
+ 	 highestObjects from: failures - self wordSize reverseDo:
- 	[highestObjects from: failures - self wordSize reverseDo:
  		[:o| | b |
  		o < firstFreeChunk ifTrue:
  			[failures = (highestObjects last + self wordSize)
  				ifTrue: [highestObjects resetAsEmpty]
  				ifFalse: [highestObjects first: failures].
  			 ^self].
  		 ((self isForwarded: o) or: [self isPinned: o]) ifFalse:
  			[b := self bytesInObject: o.
  			 (self allocateOldSpaceChunkOfExactlyBytes: b suchThat: [:f| f < o])
  				ifNil:
  					[failures := failures - self wordSize.
  					 failures < highestObjects start ifTrue:
  						[failures := highestObjects limit].
  					 self longAt: failures put: o]
  				ifNotNil:
  					[:f|
  					self mem: f
  						cp: o
  						y: ((self hasOverflowHeader: o)
  								ifTrue: [b - self baseHeaderSize]
  								ifFalse: [b]).
  					"wait until the next scavenge to unremember o"
  					(self isRemembered: o) ifTrue:
  						[scavenger remember: f].
  					self forward: o to: f]]].
  	 "now highestObjects contains only failures, if any, from failures to last.
  	  set first to first failure and refill buffer. next cycle will add more failures.
  	  give up on exact-fit when half of the highest objects fail to fit."
  	 first := self longAt: highestObjects first.
  	 first > firstFreeChunk ifTrue:
  		[| highestObjBytes failureBytes savedLimit |
  		 highestObjBytes := highestObjects limit - highestObjects start.
  		 failureBytes := highestObjects last >= failures
  							ifTrue: [highestObjects last - failures]
  							ifFalse: [highestObjBytes - (failures - highestObjects last)].
  		 failureBytes >= (highestObjBytes // 2) ifTrue:
  			[highestObjects first: failures.
  			 ^self].
  		 savedLimit := self moveFailuresToTopOfHighestObjects: failures.
  		 self fillHighestObjectsWithMovableObjectsFrom: firstFreeChunk upTo: first.
  		 failures := self moveFailuresInHighestObjectsBack: savedLimit]] repeat!

Item was changed:
  ----- Method: SpurMemoryManager>>forwardSurvivor:to: (in category 'become implementation') -----
  forwardSurvivor: obj1 to: obj2
  	self assert: (self isInNewSpace: obj1).
+ 	self assert: (self isInFutureSpace: obj2).
  	self storePointerUnchecked: 0 ofObject: obj1 withValue: obj2.
  	self setFormatOf: obj1 to: self forwardedFormat.
  	self setClassIndexOf: obj1 to: self isForwardedObjectClassIndexPun!

Item was changed:
  ----- Method: SpurMemoryManager>>fullGC (in category 'gc - global') -----
  fullGC
+ 	needGCFlag := false.
+ 	gcStartUsecs := self ioUTCMicrosecondsNow.
+ 	statMarkCount := 0.
+ 	self preGCAction: GCModeFull.
+ 	self globalGarbageCollect.
+ 	self postGCAction: GCModeFull.
+ 	statFullGCs := statFullGCs + 1.
+ 	statGCEndUsecs := self ioUTCMicrosecondsNow.
+ 	statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).!
- 	^self globalGarbageCollect!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  	"We can put all initializations that set something to 0 or to false here.
  	 In C all global variables are initialized to 0, and 0 is false."
  	remapBuffer := Array new: RemapBufferSize.
  	remapBufferCount := extraRootCount := 0. "see below"
  	freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  	checkForLeaks := 0.
  	needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
  	becomeEffectsFlags := 0.
  	statScavenges := statIncrGCs := statFullGCs := 0.
  	statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
  	statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
+ 	statGrowMemory := statShrinkMemory := statRootTableCount := statSurvivorCount := 0.
+ 	statRootTableOverflows := statMarkCount := statSpecialMarkCount := statCompactPassCount := statCoalesces := 0.
- 	statGrowMemory := statShrinkMemory := statRootTableCount := statTenures := statSurvivorCount := 0.
- 	statRootTableOverflows := statSweepCount := statMarkCount := statSpecialMarkCount := statMkFwdCount := 0.
- 	statCoalesces := 0.
  
  	"We can initialize things that are allocated but are lazily initialized."
  	unscannedEphemerons := SpurContiguousObjStack new.
  	highestObjects := SpurCircularBuffer new manager: self; yourself.
  
  	"we can initialize things that are virtual in C."
  	scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
  	segmentManager := SpurSegmentManager new manager: self; yourself.
  
  	"We can also initialize here anything that is only for simulation."
  	heapMap := self wordSize = 4 ifTrue: [CogCheck32BitHeapMap new].
  
  	"N.B. We *don't* initialize extraRoots because we don't simulate it."!

Item was changed:
  ----- Method: SpurMemoryManager>>isImmediate: (in category 'object testing') -----
+ isImmediate: oop
+ 	<api>
- isImmediate: oop 
  	^(oop bitAnd: self tagMask) ~= 0!

Item was changed:
  ----- Method: SpurMemoryManager>>isInEden: (in category 'object testing') -----
  isInEden: objOop
+ 	^self
+ 		oop: objOop
+ 		isGreaterThanOrEqualTo: scavenger eden start
+ 		andLessThan: freeStart!
- 	^objOop >= scavenger eden start
- 	  and: [objOop < freeStart]!

Item was changed:
  ----- Method: SpurMemoryManager>>isInFutureSpace: (in category 'object testing') -----
+ isInFutureSpace: address
+ 	^self
+ 		oop: address
+ 		isGreaterThanOrEqualTo: scavenger futureSpace start
+ 		andLessThan: scavenger futureSurvivorStart!
- isInFutureSpace: objOop
- 	^objOop >= scavenger futureSpace start
- 	  and: [objOop < scavenger futureSurvivorStart]!

Item was changed:
  ----- Method: SpurMemoryManager>>isInOldSpace: (in category 'object testing') -----
+ isInOldSpace: address
+ 	^self
+ 		oop: address
+ 		isGreaterThanOrEqualTo: newSpaceLimit
+ 		andLessThan: freeOldSpaceStart!
- isInOldSpace: address 
- 	^address between: newSpaceLimit and: freeOldSpaceStart!

Item was changed:
  ----- Method: SpurMemoryManager>>isInSurvivorSpace: (in category 'object testing') -----
+ isInSurvivorSpace: address
+ 	^self
+ 		oop: address
+ 		isGreaterThanOrEqualTo: scavenger pastSpace start
+ 		andLessThan: pastSpaceStart!
- isInSurvivorSpace: objOop
- 	^objOop >= scavenger pastSpace start
- 	  and: [objOop < pastSpaceStart]!

Item was changed:
  ----- Method: SpurMemoryManager>>isPinned: (in category 'header access') -----
  isPinned: objOop
+ 	<api>
  	^((self longAt: objOop) >> self pinnedBitShift bitAnd: 1) ~= 0!

Item was added:
+ ----- Method: SpurMemoryManager>>pinObject: (in category 'primitive support') -----
+ pinObject: objOop
+ 	<api>
+ 	self shouldBeImplemented!

Item was changed:
  ----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'gc - scavenging') -----
  scavengingGCTenuringIf: tenuringCriterion
  	"Run the scavenger."
  
  	self assert: remapBufferCount = 0.
  	self assert: (segmentManager numSegments = 0 "true in the spur image bootstrap"
  				or: [scavenger eden limit - freeStart > coInterpreter interpreterAllocationReserveBytes]).
  	self checkFreeSpace.
  	"coInterpreter printCallStackFP: coInterpreter framePointer"
  
  	self runLeakCheckerForFullGC: false.
  	coInterpreter
+ 		preGCAction: GCModeScavenge;
- 		preGCAction: GCModeIncr;
  		"would prefer this to be in mapInterpreterOops, but
  		 compatibility with ObjectMemory dictates it goes here."
  		flushMethodCacheFrom: startOfMemory to: newSpaceLimit.
  	needGCFlag := false.
  
  	gcStartUsecs := coInterpreter ioUTCMicrosecondsNow.
  
  	scavengeInProgress := true.
  	pastSpaceStart := scavenger scavenge: tenuringCriterion.
  	self assert: (self
  					oop: pastSpaceStart
  					isGreaterThanOrEqualTo: scavenger pastSpace start
  					andLessThanOrEqualTo: scavenger pastSpace limit).
  	freeStart := scavenger eden start.
  	self initSpaceForAllocationCheck: (self addressOf: scavenger eden).
  	scavengeInProgress := false.
  
  	statScavenges := statScavenges + 1.
  	statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
  	statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
  	statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
  	statRootTableCount := scavenger rememberedSetSize.
  
+ 	coInterpreter postGCAction: GCModeScavenge.
- 	coInterpreter postGCAction.
  	self runLeakCheckerForFullGC: false.
  
  	self checkFreeSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>statCompMoveCount (in category 'accessing') -----
  statCompMoveCount
+ 	"Spur never compacts by moving; but it does make compaction passes."
+ 	^statCompactPassCount!
- 	"Spur never compacts by moving"
- 	^0!

Item was changed:
  ----- Method: SpurMemoryManager>>statMkFwdCount (in category 'accessing') -----
  statMkFwdCount
+ 	^0!
- 	^statMkFwdCount!

Item was changed:
  ----- Method: SpurMemoryManager>>statSweepCount (in category 'accessing') -----
  statSweepCount
+ 	^0!
- 	^statSweepCount!

Item was changed:
  ----- Method: SpurMemoryManager>>statTenures (in category 'accessing') -----
  statTenures
+ 	<doNotGenerate>
+ 	^scavenger statTenures!
- 	^statTenures!

Item was changed:
  ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
  	STACKVM := true.
  
+ 	GCModeFull := 1.
+ 	GCModeIncr := 2.
+ 	GCModeScavenge := 3.
+ 	GCModeBecome := 4.
+ 
  	DumpStackOnLowSpace := 0.
  	PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall"
  	MillisecondClockMask := 16r1FFFFFFF.
  	"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
  	MaxExternalPrimitiveTableSize := 4096. "entries"
  
  	MaxJumpBuf := 32. "max. callback depth"
  	FailImbalancedPrimitives := true!

Item was changed:
  ----- Method: StackInterpreter class>>table:from: (in category 'initialization') -----
  table: anArray from: specArray 
  	"SpecArray is an array of one of (index selector) or (index1 
  	 index2 selector) or (index nil) or (index1 index2 nil).  If selector
  	 then the entry is the selector, but if nil the entry is the index."
  	| contiguous |
  	contiguous := 0.
  	specArray do:
  		[:spec | 
  		(spec at: 1) = contiguous ifFalse:
  			[self error: 'Non-contiguous table entry'].
  		spec size = 2
  			ifTrue:
  				[anArray
  					at: (spec at: 1) + 1
  					put: ((spec at: 2) ifNil: [spec at: 1] ifNotNil: [:sym| sym]).
  				 contiguous := contiguous + 1]
  			ifFalse:
  				[(spec at: 1) to: (spec at: 2) do:
  					[:i | anArray at: i + 1 put: ((spec at: 3) ifNil: [i] ifNotNil: [:sym| sym])].
  				 contiguous := contiguous + ((spec at: 2) - (spec at: 1)) + 1]].
  	anArray doWithIndex:
  		[:entry :index|
+ 		entry isSymbol ifTrue:
+ 			[(self whichClassIncludesSelector: entry) ifNotNil:
+ 				[:c| | m |
+ 				m := c >> entry.
+ 				(m pragmaAt: #option:) ifNotNil:
+ 					[:pragma|
+ 					(initializationOptions at: (pragma arguments first) ifAbsent: [true]) ifFalse:
+ 						[anArray at: index put: 0]]]]]!
- 		(self whichClassIncludesSelector: entry) ifNotNil:
- 			[:c| | m |
- 			m := c >> entry.
- 			(m pragmaAt: #option:) ifNotNil:
- 				[:pragma|
- 				(initializationOptions at: (pragma arguments first) ifAbsent: [true]) ifFalse:
- 					[anArray at: index put: 0]]]]!

Item was changed:
  ----- Method: StackInterpreter class>>vmProxyMinorVersion (in category 'api version') -----
  vmProxyMinorVersion
  	"Define the  VM_PROXY_MINOR version for this VM as used to
  	 define the api in platforms/Cross/vm/sqVirtualMachine.[ch]"
+ 	^(initializationOptions at: #SpurObjectMemory ifAbsent: [false])
+ 		ifTrue: [13]
+ 		ifFalse: [12]!
- 	^12!

Item was changed:
  ----- Method: StackInterpreter>>lookupMethodInClass: (in category 'message sending') -----
  lookupMethodInClass: class
  	| currentClass dictionary found |
  	<inline: false>
+ 	self assert: (self addressCouldBeClassObj: class).
- 	self assert: class ~= objectMemory nilObject.
  	currentClass := class.
  	[currentClass ~= objectMemory nilObject]
  		whileTrue:
  		[dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currentClass.
  		dictionary = objectMemory nilObject ifTrue:
  			["MethodDict pointer is nil (hopefully due a swapped out stub)
  				-- raise exception #cannotInterpret:."
  			self createActualMessageTo: class.
  			messageSelector := objectMemory splObj: SelectorCannotInterpret.
  			self sendBreakpoint: messageSelector receiver: nil.
  			^self lookupMethodInClass: (self superclassOf: currentClass)].
  		found := self lookupMethodInDictionary: dictionary.
  		found ifTrue: [^currentClass].
  		currentClass := self superclassOf: currentClass].
  
  	"Could not find #doesNotUnderstand: -- unrecoverable error."
  	messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
  		[self error: 'Recursive not understood error encountered'].
  
  	"Cound not find a normal message -- raise exception #doesNotUnderstand:"
  	self createActualMessageTo: class.
  	messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
  	self sendBreak: messageSelector + BaseHeaderSize
  		point: (objectMemory lengthOf: messageSelector)
  		receiver: nil.
  	^self lookupMethodInClass: class!

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."
+ 	<inline: false>
  	self mapStackPages.
  	self mapMachineCode.
  	self mapTraceLogs.
  	self mapVMRegisters.
  	self mapProfileState.
  	self remapCallbackState.
  	(tempOop ~= 0
  	 and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
  		[tempOop := objectMemory remapObj: tempOop]!

Item was removed:
- ----- Method: StackInterpreter>>postGCAction (in category 'object memory support') -----
- postGCAction
- 	"Shrink free memory and signal the gc semaphore"
- 	| freeSizeNow |
- 
- 	freeSizeNow := objectMemory freeSize.
- 	(freeSizeNow > objectMemory shrinkThreshold
- 	 and: [freeSizeNow > objectMemory growHeadroom]) ifTrue:
- 		["Attempt to shrink memory after successfully reclaiming lots of memory"
- 		 objectMemory shrinkObjectMemory: freeSizeNow - objectMemory growHeadroom].
- 
- 	self signalSemaphoreWithIndex: gcSemaphoreIndex!

Item was added:
+ ----- Method: StackInterpreter>>postGCAction: (in category 'object memory support') -----
+ postGCAction: gcModeArg
+ 	"Shrink free memory and signal the gc semaphore"
+ 
+ 	(gcModeArg = GCModeFull or: [gcModeArg = GCModeIncr]) ifTrue:"but *not* become and *not* scavenge"
+ 		[| freeSizeNow |
+ 		 freeSizeNow := objectMemory freeSize.
+ 		 (freeSizeNow > objectMemory shrinkThreshold
+ 		  and: [freeSizeNow > objectMemory growHeadroom]) ifTrue:
+ 			["Attempt to shrink memory after successfully reclaiming lots of memory"
+ 			 objectMemory shrinkObjectMemory: freeSizeNow - objectMemory growHeadroom]].
+ 
+ 	self signalSemaphoreWithIndex: gcSemaphoreIndex!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
(excessive size, no diff calculated)

Item was added:
+ ----- Method: TGoToNode>>nodesDo:parent: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent
+ 	aBlock value: self value: parent!

Item was added:
+ ----- Method: TLabeledCommentNode>>nodesDo:parent: (in category 'enumerating') -----
+ nodesDo: aBlock parent: parent
+ 	aBlock value: self value: parent!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr GCModeScavenge IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimNoErr STACKVM ShiftForWord VMBIGENDIAN'
- 	classVariableNames: 'BaseHeaderSize Byte0Mask Byte0Shift Byte1Mask Byte1Shift Byte1ShiftNegated Byte2Mask Byte2Shift Byte3Mask Byte3Shift Byte3ShiftNegated Byte4Mask Byte4Shift Byte4ShiftNegated Byte5Mask Byte5Shift Byte5ShiftNegated Byte6Mask Byte6Shift Byte7Mask Byte7Shift Byte7ShiftNegated Bytes3to0Mask Bytes7to4Mask BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFull GCModeIncr IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimNoErr STACKVM ShiftForWord VMBIGENDIAN'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMBasicConstants commentStamp: '<historical>' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.
  
  self ensureClassPool.
  self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
  self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
  (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
  	[:k| self classPool declare: k from: ObjectMemory classPool]!

Item was added:
+ ----- Method: VMClass class>>isAcceptableAncilliaryClass: (in category 'translation') -----
+ isAcceptableAncilliaryClass: aClass
+ 	^true!



More information about the Vm-dev mailing list