[Pkg] The Trunk: Kernel-mtf.495.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Sep 20 00:02:29 UTC 2010


Matthew Fulmer uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-mtf.495.mcz

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

Name: Kernel-mtf.495
Author: mtf
Time: 19 September 2010, 8:01:13.128 pm
UUID: 06402399-42b9-465b-b695-a86471b12533
Ancestors: Kernel-mtf.422, Kernel-cmm.494

added useful pointer tracing tools to the base classes. The core of the fix for http://bugs.squeak.org/view.php?id=7158

=============== Diff against Kernel-cmm.494 ===============

Item was added:
+ ----- Method: CompiledMethod>>outboundPointersDo: (in category 'tracing') -----
+ outboundPointersDo: aBlock
+ 
+ 	| numLiterals |
+ 	aBlock value: self class.
+ 	numLiterals := self numLiterals.
+ 	1 to: numLiterals do: [:i | aBlock value: (self literalAt: i)]!

Item was changed:
  ----- Method: MethodDictionary>>includesKey: (in category 'accessing') -----
  includesKey: aSymbol
  	"This override assumes that pointsTo is a fast primitive"
  
  	aSymbol ifNil: [^ false].
+ 	^ super instVarsInclude: aSymbol!
- 	^ self pointsTo: aSymbol!

Item was added:
+ ----- Method: Object>>chasePointers (in category 'tracing') -----
+ chasePointers
+ 	PointerFinder on: self!

Item was added:
+ ----- Method: Object>>explorePointers (in category 'tracing') -----
+ explorePointers
+ 	PointerExplorer new openExplorerFor: self!

Item was added:
+ ----- Method: Object>>inboundPointers (in category 'tracing') -----
+ inboundPointers
+ "Answers a collection of all objects in the system that point to myself"
+ 
+ 	^ self inboundPointersExcluding: #()!

Item was added:
+ ----- Method: Object>>inboundPointersExcluding: (in category 'tracing') -----
+ inboundPointersExcluding: objectsToExclude
+ "Answer a list of all objects in the system that point to me, excluding those in the collection of objectsToExclude. I do my best to avoid creating any temporary objects that point to myself, especially method and block contexts. Adapted from PointerFinder class >> #pointersTo:except:"
+ 
+ 	| anObj pointers objectsToAlwaysExclude |
+ 	Smalltalk garbageCollect.
+ 	"big collection shouldn't grow, so it's contents array is always the same"
+ 	pointers := OrderedCollection new: 1000.
+ 
+ 	"#allObjectsDo: and #pointsTo: are expanded inline to keep spurious
+ 	 method and block contexts out of the results"
+ 	anObj := self someObject.
+ 	[0 == anObj] whileFalse: [
+ 		anObj isInMemory
+ 			ifTrue: [((anObj instVarsInclude: self)
+ 				or: [anObj class == self])
+ 					ifTrue: [pointers add: anObj]].
+ 		anObj := anObj nextObject].
+ 
+ 	objectsToAlwaysExclude := {
+ 		pointers collector.
+ 		thisContext.
+ 		thisContext sender.
+ 		thisContext sender sender.
+ 		objectsToExclude.
+ 	}.
+ 
+ 	^ pointers removeAllSuchThat: [:ea |
+ 		(objectsToAlwaysExclude identityIncludes: ea)
+ 			or: [objectsToExclude identityIncludes: ea]]!

Item was added:
+ ----- Method: Object>>outboundPointers (in category 'tracing') -----
+ outboundPointers
+ "Answers a list of all objects I am causing not to be garbage-collected"
+ 
+ 	| collection |
+ 	collection := OrderedCollection new.
+ 	self outboundPointersDo: [:ea | collection add: ea].
+ 	^ collection!

Item was added:
+ ----- Method: Object>>outboundPointersDo: (in category 'tracing') -----
+ outboundPointersDo: aBlock
+ "do aBlock for every object I point to, exactly how the garbage collector would. Adapted from PointerFinder >> #followObject:"
+ 
+ 	aBlock value: self class.
+ 	1 to: self class instSize do: [:i | aBlock value: (self instVarAt: i)].
+ 	1 to: self basicSize do: [:i | aBlock value: (self basicAt: i)].!

Item was changed:
+ ----- Method: ProtoObject>>pointsTo: (in category 'tracing') -----
- ----- Method: ProtoObject>>pointsTo: (in category 'testing') -----
  pointsTo: anObject
+ "Answers true if I hold a reference to anObject, or false otherwise. Or stated another way:
+ 
+ Answers true if the garbage collector would fail to collect anObject because I hold a reference to it, or false otherwise"
+ 
+ 	^ (self instVarsInclude: anObject)
+ 		or: [self class == anObject]!
- 	"This method returns true if self contains a pointer to anObject,
- 		and returns false otherwise"
- 	<primitive: 132>
- 	1 to: self class instSize do:
- 		[:i | (self instVarAt: i) == anObject ifTrue: [^ true]].
- 	1 to: self basicSize do:
- 		[:i | (self basicAt: i) == anObject ifTrue: [^ true]].
- 	^ false!



More information about the Packages mailing list