The Trunk: Tools-dtl.830.mcz

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

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

Name: Tools-dtl.830
Author: dtl
Time: 16 August 2018, 8:32:57.34384 am
UUID: fd5c488d-00a8-4739-9dee-aa35b92aaaeb
Ancestors: Tools-eem.829, Tools-LM.829

Merge PointerFinder and ObjectExplorer changes

=============== Diff against Tools-eem.829 ===============

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 possibleReferencesToSelection!
- self flag: #tooMany. "mt: Note that we might want to ignore references caused by this tool."
- self object chasePointers.!

Item was added:
+ ----- Method: ObjectExplorer>>findDeepSubmorphsIn:that: (in category 'accessing - view') -----
+ findDeepSubmorphsIn: aMorph that: aBlock
+
+ | selectedSubmorphs |
+ selectedSubmorphs := aMorph submorphs select: aBlock.
+ ^ selectedSubmorphs, (aMorph submorphs collect: [:each |
+ self findDeepSubmorphsIn: each that: aBlock]) flatten!

Item was added:
+ ----- Method: ObjectExplorer>>possibleReferencesToSelection (in category 'accessing - view') -----
+ possibleReferencesToSelection
+
+ ^ {self}, self visibleObjectExplorerWrappers!

Item was added:
+ ----- Method: ObjectExplorer>>views (in category 'accessing - view') -----
+ views
+
+ ^ self findDeepSubmorphsIn: ActiveWorld that: [:morph |
+ morph modelOrNil = self]!

Item was added:
+ ----- Method: ObjectExplorer>>visibleListItems (in category 'accessing - view') -----
+ visibleListItems
+
+ | lists |
+ lists := self views select: [:morph |
+ (morph isKindOf: PluggableTreeMorph)].
+ ^ (lists collect: [:each|
+ each items]) flatten!

Item was added:
+ ----- Method: ObjectExplorer>>visibleObjectExplorerWrappers (in category 'accessing - view') -----
+ visibleObjectExplorerWrappers
+
+ | listItems |
+ listItems := self visibleListItems.
+ ^ listItems collect: [:each | each complexContents]!

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: [].
  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!