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!