The Trunk: Tools-cmm.831.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

The Trunk: Tools-cmm.831.mcz

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


Reply | Threaded
Open this post in threaded view
|

Re: The Trunk: Tools-cmm.831.mcz

Chris Muller-3
I finally had a moment to review, I definitely like this contribution
to exclude the PointerExplorerWrappers, it will help it work
PointerFinder much more seamlessly, thanks Leon!

This is just a couple of fixes to support arbitrary objects in
#excludedObjects, and also to ensure to get the correct parental
reference by identity instead of only equality.  In the process of
doing that, I changed it to eager iniitialization since everything
else was too.

 - Chris

On Fri, Aug 17, 2018 at 2:47 PM,  <[hidden email]> wrote:

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