The Trunk: Kernel-mtf.495.mcz

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!