[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