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!