The Trunk: Tools-cmm.831.mcz

> 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.!
>
>