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

commits at source.squeak.org commits at source.squeak.org
Fri Oct 4 04:25:12 UTC 2013


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

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

Name: VMMaker.oscog-eem.434
Author: eem
Time: 3 October 2013, 9:20:32.238 pm
UUID: 6b0dc242-e4e1-4d22-be6e-29b360b1e82a
Ancestors: VMMaker.oscog-eem.433

Add a tenuring criterion, allowing tenuring by age (default) or class
(for initialInstanceOf:/nextInstanceOf:).

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

Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>scavengingGC (in category 'generation scavenging') -----
- scavengingGC
- 	"Run the scavenger."
- 	self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
- 													ifTrue: ['th']
- 													ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
- 	^super scavengingGC!

Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
+ scavengingGCTenuringIf: tenuringCriterion
+ 	"Run the scavenger."
+ 	self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
+ 													ifTrue: ['th']
+ 													ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
+ 	^super scavengingGCTenuringIf: tenuringCriterion!

Item was removed:
- ----- Method: Spur32BitMMLESimulator>>scavengingGC (in category 'generation scavenging') -----
- scavengingGC
- 	"Run the scavenger."
- 	self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
- 													ifTrue: ['th']
- 													ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
- 	^super scavengingGC!

Item was added:
+ ----- Method: Spur32BitMMLESimulator>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
+ scavengingGCTenuringIf: tenuringCriterion
+ 	"Run the scavenger."
+ 	self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
+ 													ifTrue: ['th']
+ 													ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
+ 	^super scavengingGCTenuringIf: tenuringCriterion!

Item was changed:
  CogClass subclass: #SpurGenerationScavenger
+ 	instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize previousRememberedSetSize weakList ephemeronList tenuringCriterion tenuringThreshold tenuringClassIndex tenuringProportion numRememberedEphemerons'
- 	instanceVariableNames: 'coInterpreter manager eden futureSpace pastSpace futureSurvivorStart rememberedSet rememberedSetSize previousRememberedSetSize weakList ephemeronList tenuringThreshold tenuringProportion numRememberedEphemerons'
  	classVariableNames: 'RememberedSetLimit RememberedSetRedZone'
+ 	poolDictionaries: 'SpurMemoryManagementConstants'
- 	poolDictionaries: ''
  	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 class>>initialize (in category 'class initialization') -----
  initialize
  	"SpurGenerationScavenger initialize"
  	RememberedSetLimit := 16384.
+ 	RememberedSetRedZone := RememberedSetLimit - (RememberedSetLimit // 2).
+ 
+ 	TenureByAge := 1.
+ 	TenureByClass := 2!
- 	RememberedSetRedZone := RememberedSetLimit - (RememberedSetLimit // 2)!

Item was changed:
  ----- Method: SpurGenerationScavenger>>shouldBeTenured: (in category 'scavenger') -----
  shouldBeTenured: survivor
  	"Answer if an object should be tenured.  Use the tenuringThreshold to decide.
  	 If the survivors (measured in bytes) are above some fraction of the survivor
  	 space then objects below the threshold (older objects, since allocation grows
  	 upwards and hence new objects are later than old) are scavenged.  Otherwise,
  	 the threshold is set to 0 and no objects are tenured.  See e.g.
  	 An adaptive tenuring policy for generation scavengers, David Ungar & Frank Jackson.
  	 ACM TOPLAS, Volume 14 Issue 1, Jan. 1992, pp 1 - 27."
  
+ 	^tenuringCriterion caseOf: {
+ 		[TenureByAge]	->
+ 			[survivor < tenuringThreshold
+ 			 and: [survivor >= manager startOfMemory]]. "exclude methods in the method zone"
+ 		[TenureByClass] ->
+ 			[(manager classIndexOf: survivor) = tenuringClassIndex
+ 			 and: [survivor >= manager startOfMemory]] "exclude methods in the method zone"}!
- 	^survivor < tenuringThreshold
- 	  and: [survivor >= manager startOfMemory] "exclude methods in the method zone"!

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

Item was added:
+ ----- Method: SpurGenerationScavenger>>tenuringClassIndex: (in category 'accessing') -----
+ tenuringClassIndex: anInteger
+ 	tenuringClassIndex := anInteger!

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

Item was added:
+ ----- Method: SpurGenerationScavenger>>tenuringCriterion: (in category 'accessing') -----
+ tenuringCriterion: anInteger
+ 	tenuringCriterion := anInteger!

Item was added:
+ SharedPool subclass: #SpurMemoryManagementConstants
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'TenureByAge TenureByClass'
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-SpurMemoryManager'!

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

Item was added:
+ ----- Method: SpurMemoryManager>>existInstancesInNewSpaceOf: (in category 'debug support') -----
+ existInstancesInNewSpaceOf: classObj
+ 	| classIndex |
+ 	classIndex := self rawHashBitsOf: classObj.
+ 	self allNewSpaceObjectsDo:
+ 		[:obj|
+ 		(self classIndexOf: obj) = classIndex ifTrue:
+ 			[^true]].
+ 	^false!

Item was changed:
  ----- Method: SpurMemoryManager>>flushNewSpace (in category 'generation scavenging') -----
  flushNewSpace
  	| savedTenuringThreshold |
  	savedTenuringThreshold := scavenger getRawTenuringThreshold.
  	scavenger setRawTenuringThreshold: newSpaceLimit.
+ 	self scavengingGCTenuringIf: TenureByAge.
- 	self scavengingGC.
  	scavenger setRawTenuringThreshold: savedTenuringThreshold.
  	self assert: scavenger rememberedSetSize = 0.
  	self assert: pastSpaceStart = scavenger pastSpace start.
  	self assert: freeStart = scavenger eden start!

Item was added:
+ ----- Method: SpurMemoryManager>>flushNewSpaceInstancesOf: (in category 'generation scavenging') -----
+ flushNewSpaceInstancesOf: aClass
+ 	| classIndex |
+ 	classIndex := self rawHashBitsOf: aClass.
+ 	classIndex = 0 ifTrue: "no instances; nothing to do"
+ 		[^self].
+ 	scavenger tenuringClassIndex: classIndex.
+ 	self scavengingGCTenuringIf: TenureByClass.
+ 	self assert: (self existInstancesInNewSpaceOf: aClass) not!

Item was changed:
  ----- Method: SpurMemoryManager>>initialInstanceOf: (in category 'object enumeration') -----
  initialInstanceOf: classObj
  	<inline: false>
  	| classIndex |
  	classIndex := self rawHashBitsOf: classObj.
  	classIndex = 0 ifTrue:
  		[^nil].
+ 	"flush instances in newSpace to settle the enumeration."
+ 	self flushNewSpaceInstancesOf: classObj..
- 	"flush newSpace to settle the enumeration."
- 	self flushNewSpace.
  	self allObjectsDo:
  		[:objOop|
  		classIndex = (self classIndexOf: objOop) ifTrue:
  			[^objOop]].
  	^nil!

Item was changed:
  ----- Method: SpurMemoryManager>>scavengingGC (in category 'generation scavenging') -----
  scavengingGC
  	"Run the scavenger."
  
+ 	self scavengingGCTenuringIf: TenureByAge!
- 	self assert: remapBufferCount = 0.
- 	self checkFreeSpace.
- 	"coInterpreter printCallStackFP: coInterpreter framePointer"
- 
- 	self runLeakCheckerForFullGC: false.
- 	coInterpreter
- 		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.
- 	self assert: (self
- 					oop: pastSpaceStart
- 					isGreaterThanOrEqualTo: scavenger pastSpace start
- 					andLessThanOrEqualTo: scavenger pastSpace limit).
- 	freeStart := scavenger eden start.
- 	self initSpaceForAllocationCheck: scavenger eden.
- 	scavengeInProgress := false.
- 
- 	statScavenges := statScavenges + 1.
- 	statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
- 	statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
- 	statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
- 
- 	coInterpreter postGCAction.
- 	self runLeakCheckerForFullGC: false.
- 
- 	self checkFreeSpace!

Item was added:
+ ----- Method: SpurMemoryManager>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
+ scavengingGCTenuringIf: tenuringCriterion
+ 	"Run the scavenger."
+ 
+ 	self assert: remapBufferCount = 0.
+ 	self checkFreeSpace.
+ 	"coInterpreter printCallStackFP: coInterpreter framePointer"
+ 
+ 	self runLeakCheckerForFullGC: false.
+ 	coInterpreter
+ 		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.
+ 	scavenger tenuringCriterion: tenuringCriterion.
+ 	pastSpaceStart := scavenger scavenge.
+ 	self assert: (self
+ 					oop: pastSpaceStart
+ 					isGreaterThanOrEqualTo: scavenger pastSpace start
+ 					andLessThanOrEqualTo: scavenger pastSpace limit).
+ 	freeStart := scavenger eden start.
+ 	self initSpaceForAllocationCheck: scavenger eden.
+ 	scavengeInProgress := false.
+ 
+ 	statScavenges := statScavenges + 1.
+ 	statGCEndUsecs := coInterpreter ioUTCMicrosecondsNow.
+ 	statSGCDeltaUsecs := statGCEndUsecs - gcStartUsecs.
+ 	statScavengeGCUsecs := statScavengeGCUsecs + statSGCDeltaUsecs.
+ 
+ 	coInterpreter postGCAction.
+ 	self runLeakCheckerForFullGC: false.
+ 
+ 	self checkFreeSpace!

Item was changed:
  ----- Method: SpurMemoryManager>>sufficientSpaceAfterGC: (in category 'generation scavenging') -----
  sufficientSpaceAfterGC: numBytes
  	"This is ObjectMemory's funky entry-point into its incremental GC,
  	 which is a stop-the-world a young generation reclaimer.  In Spur
  	 we run the scavenger.  Answer if space is not low."
  
  	self assert: numBytes = 0.
+ 	self scavengingGCTenuringIf: TenureByAge.
- 	self scavengingGC.
  	lowSpaceThreshold > totalFreeOldSpace ifTrue: "space is low"
  		[lowSpaceThreshold := 0. "avoid signalling low space twice"
  		 ^false].
  	^true!



More information about the Vm-dev mailing list