[squeak-dev] The Trunk: Tools-dtl.830.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Aug 16 12:32:58 UTC 2018
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!
More information about the Squeak-dev
mailing list
|