The Trunk: Tools-LM.828.mcz

David T. Lewis uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-LM.828.mcz

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

Name: Tools-LM.828
Author: LM
Time: 13 August 2018, 1:25:54.504807 pm
UUID: 061511ca-729a-ce43-a08c-8057c24f7406
Ancestors: Tools-tcj.827

Added the ability to exclude specific objects from the  PointerFinder.
Improved the Explorer's "chase pointers" context menu to exclude the Explorer itself from the search (includes some meta-programming, not ideal, but certainly better than previously, ideas for improvement appreciated).
Changed the way the PointerExplorer displays references, it now states the associations name on the left, and the Objects hash is moved to the right, together with the objects displayString.
These changes make it much easier to understand how the objects are associated with each other and should make it easier to track down memory leaks.

=============== Diff against Tools-cmm.826 ===============

Item was changed:
  ----- Method: FileContentsBrowser>>browseVersions (in category 'other') -----
  browseVersions
+ "Create and schedule a message set browser on all versions of the
+ currently selected message selector."
+ | class selector |
+ (selector := self selectedMessageName) ifNotNil:
+ [class := self selectedClassOrMetaClass.
+ (class exists and: [class realClass includesSelector: selector]) ifTrue:
+ [VersionsBrowser
+ browseVersionsOf: (class realClass compiledMethodAt: selector)
+ class: class realClass theNonMetaClass
+ meta: class realClass isMeta
+ category: self selectedMessageCategoryName
+ selector: selector]]!
- "Create and schedule a message set browser on all versions of the currently selected message selector."
- (ToolSet
- browseVersionsOf: self selectedClassOrMetaClass
- selector: self selectedMessageName) ifNil: [self changed: #flash]!

Item was changed:
  ----- Method: Inspector>>chasePointers (in category 'menu commands') -----
  chasePointers
  | selected  saved |
  self selectionIndex = 0 ifTrue: [^ self changed: #flash].
  selected := self selection.
  saved := self object.
  [self object: nil.
  (Smalltalk includesKey: #PointerFinder)
  ifTrue: [PointerFinder on: selected]
  ifFalse: [self inspectPointers]]
  ensure: [self object: saved]!

Item was changed:
  ----- Method: ObjectExplorer>>chasePointersForSelection (in category 'menus - actions') -----
  chasePointersForSelection
 
+ PointerFinder on: self object except: {self}, ObjectExplorerWrapper allInstances!
- self flag: #tooMany. "mt: Note that we might want to ignore references caused by this tool."
- self object chasePointers.!

Item was changed:
  ----- Method: PointerExplorer>>rootObject: (in category 'accessing') -----
  rootObject: anObject
 
+ self root key: 'root'.
- self root key: anObject identityHash asString.
  super rootObject: anObject.!

Item was changed:
  ----- Method: PointerExplorerWrapper>>contents (in category 'accessing') -----
  contents
  "Return the wrappers with the objects holding references to item. Eldest objects come first, weak only referencers are at the end and have parentheses around their identity hash."
 
  | objects weakOnlyReferences |
  objects := self object inboundPointersExcluding: { self. self item. model }.
  weakOnlyReferences := OrderedCollection new.
  objects removeAllSuchThat: [ :each |
  each class == self class
  or: [ each class == PointerExplorer
  or: [ (each isContext
  and: [ (each objectClass: each receiver) == PointerExplorer ] )
  or: [ (each pointsOnlyWeaklyTo: self object)
  ifTrue: [ weakOnlyReferences add: each. true ]
  ifFalse: [ false ] ] ] ] ].
  ^(objects replace: [ :each |
+ self class with: each name: (self nameForParent: each) model: self object ])
- self class with: each name: each identityHash asString model: self object ])
  addAll: (weakOnlyReferences replace: [ :each |
+ (self class with: each name: '(', (self nameForParent: each), ')' model: self object)
- (self class with: each name: '(', each identityHash asString, ')' model: self object)
  weakOnly: true;
  yourself ]);
  yourself!

Item was added:
+ ----- Method: PointerExplorerWrapper>>explorerStringFor: (in category 'converting') -----
+ explorerStringFor: anObject
+
+ ^ anObject identityHash asString, ': ', (super explorerStringFor: anObject).!

Item was added:
+ ----- Method: PointerExplorerWrapper>>memberNameFrom:to: (in category 'accessing') -----
+ memberNameFrom: aParent to: aChild
+
+ 1 to: aParent class instSize do: [ :instVarIndex |
+ (aParent instVarAt: instVarIndex) = aChild
+ ifTrue: [ ^ '#', (aParent class instVarNameForIndex: instVarIndex)]].
+ "This also covers arrays"
+ 1 to: aParent basicSize do: [ :index |
+ (aParent basicAt: index) = aChild
+ ifTrue: [^ index asString]].
+ ^ '???'!

Item was added:
+ ----- Method: PointerExplorerWrapper>>nameForParent: (in category 'accessing') -----
+ nameForParent: anObject
+
+ ^  self memberNameFrom: anObject to: self object!

Item was changed:
  Model subclass: #PointerFinder
+ instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex excludedObjects'
- instanceVariableNames: 'goal parents toDo toDoNext hasGemStone pointerList objectList parentsSize todoSize depth pointerListIndex'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Tools-Debugger'!
 
  !PointerFinder commentStamp: '<historical>' prior: 0!
  I can search for reasons why a certain object isn't garbage collected.  I'm a quick port of a VisualWorks program written by Hans-Martin Mosner.  Call me as shown below.  I'll search for a path from a global variable to the given object, presenting it in a small morphic UI.
 
  Examples:
  PointerFinder on: self currentHand
  PointerFinder on: StandardSystemView someInstance
 
  Now, let's see why this image contains more HandMorphs as expected...
 
  HandMorph allInstancesDo: [:e | PointerFinder on: e]!

Item was added:
+ ----- Method: PointerFinder class>>on:except: (in category 'instance creation') -----
+ on: anObject except: aCollection
+ ^ self new
+ goal: anObject;
+ excludedObjects: aCollection;
+ search;
+ open!

Item was changed:
  ----- Method: PointerFinder>>buildList (in category 'application') -----
  buildList
  | list obj parent object key |
  list := OrderedCollection new.
  obj := goal.
 
  [list addFirst: obj.
+ obj := parents at: obj ifAbsent: [nil].
- obj := parents at: obj ifAbsent: [].
  obj == nil] whileFalse.
  list removeFirst.
  parent := Smalltalk.
  objectList := OrderedCollection new.
  pointerList := OrderedCollection new.
  [list isEmpty]
  whileFalse:
  [object := list removeFirst.
  key := nil.
  (parent isKindOf: Dictionary)
  ifTrue: [list size >= 2
  ifTrue:
  [key := parent keyAtValue: list second ifAbsent: [].
  key == nil
  ifFalse:
  [object := list removeFirst; removeFirst.
  pointerList add: key printString , ' -> ' , object class name]]].
  key == nil
  ifTrue:
  [parent class == object ifTrue: [key := 'CLASS'].
  key == nil ifTrue: [1 to: parent class instSize do: [:i | key == nil ifTrue: [(parent instVarAt: i)
  == object ifTrue: [key := parent class instVarNameForIndex: i]]]].
  key == nil ifTrue: [parent isCompiledCode ifTrue: [key := 'literals?']].
  key == nil ifTrue: [1 to: parent basicSize do: [:i | key == nil ifTrue: [(parent basicAt: i)
  == object ifTrue: [key := i printString]]]].
  key == nil ifTrue: [(parent isMorph and: [object isKindOf: Array]) ifTrue: [key := 'submorphs?']].
  key == nil ifTrue: [key := '???'].
  pointerList add: key , ': ' , object class name, (object isMorph ifTrue: [' (', object identityHash asString, ')'] ifFalse: [ String empty ]) ].
  objectList add: object.
  parent := object]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects (in category 'accessing') -----
+ excludedObjects
+
+ ^ excludedObjects ifNil: [excludedObjects := OrderedCollection new]!

Item was added:
+ ----- Method: PointerFinder>>excludedObjects: (in category 'accessing') -----
+ excludedObjects: aCollection
+
+ excludedObjects := aCollection!

Item was changed:
  ----- Method: PointerFinder>>followObject: (in category 'application') -----
  followObject: anObject
+
+ (self excludedObjects includes: anObject)
+ ifTrue: [^ false].
  anObject outboundPointersDo: [:ea |
  (self follow: ea from: anObject)
  ifTrue: [^ true]].
  ^ false!

Item was changed:
  ----- Method: PointerFinder>>initialize (in category 'application') -----
  initialize
  parents := IdentityDictionary new: 20000.
  parents at: Smalltalk put: nil.
  parents at: Processor put: nil.
  parents at: self put: nil.
 
  toDo := OrderedCollection new: 5000.
  toDo add: Smalltalk.
+ toDoNext := OrderedCollection new: 5000.!
- toDoNext := OrderedCollection new: 5000!