Chris Muller uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-cmm.831.mcz
==================== Summary ====================
Name: Tools-cmm.831 Author: cmm Time: 17 August 2018, 2:47:24.570535 pm UUID: 4eb798e4-2a62-41b1-b0bb-2910f80e1273 Ancestors: Tools-dtl.830
- The hierarchy is inverted in a PointerExplorer such that the top line represents a (presumed) 'leaf' of the model (to be consistent with the language of 'root'), not to be confused with the opposite direction of the hierarchy presented in regular Explorers. Render the key names in 'instVar' syntax. - Pointer exploring and finding tools must be concerned with the identity of objects. They must find (and, exclude) references to *this* object, not just any other object of equal value.
=============== Diff against Tools-dtl.830 ===============
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: PointerExplorer>>rootObject: (in category 'accessing') ----- rootObject: anObject + self root key: 'leaf'. + super rootObject: anObject! - - self root key: 'root'. - super rootObject: anObject.!
Item was changed: ----- 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), '''' ]]. - (aParent instVarAt: instVarIndex) = aChild - ifTrue: [ ^ '#', (aParent class instVarNameForIndex: instVarIndex)]]. "This also covers arrays" 1 to: aParent basicSize do: [ :index | + (aParent basicAt: index) == aChild - (aParent basicAt: index) = aChild ifTrue: [^ index asString]]. ^ '???'!
Item was changed: ----- Method: PointerFinder class>>on: (in category 'instance creation') ----- + on: anObject + ^ self + on: anObject + except: Array empty! - on: anObject - ^ self new goal: anObject; search; open!
Item was changed: + ----- Method: PointerFinder>>buildList (in category 'initialize-release') ----- - ----- 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 changed: ----- Method: PointerFinder>>excludedObjects (in category 'accessing') ----- excludedObjects + ^ excludedObjects! - - ^ excludedObjects ifNil: [excludedObjects := OrderedCollection new]!
Item was changed: + ----- Method: PointerFinder>>excludedObjects: (in category 'initialize-release') ----- + excludedObjects: aCollection + excludedObjects := aCollection asIdentitySet! - ----- Method: PointerFinder>>excludedObjects: (in category 'accessing') ----- - excludedObjects: aCollection - - excludedObjects := aCollection!
Item was changed: + ----- Method: PointerFinder>>follow:from: (in category 'private') ----- - ----- Method: PointerFinder>>follow:from: (in category 'application') ----- follow: anObject from: parentObject anObject == goal ifTrue: [ parents at: anObject put: parentObject. ^ true ]. anObject shouldFollowOutboundPointers ifFalse: [ ^ false ]. ((parents includesKey: anObject) or: [ anObject class = self class ]) ifTrue: [ ^ false ]. parents at: anObject put: parentObject. toDoNext add: anObject. ^ false!
Item was changed: + ----- Method: PointerFinder>>followObject: (in category 'private') ----- - ----- 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>>goal: (in category 'initialize-release') ----- - ----- Method: PointerFinder>>goal: (in category 'application') ----- goal: anObject goal := anObject!
Item was changed: + ----- Method: PointerFinder>>initialize (in category 'initialize-release') ----- - ----- 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. + + excludedObjects := IdentitySet new! - toDoNext := OrderedCollection new: 5000.!