[Pkg] The Trunk: Tools-cmm.831.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Aug 17 19:47:45 UTC 2018
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.!
More information about the Packages
mailing list