.
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
'From Smalltalk/X, Version:2.10.4 on 8-mar-1995 at 22:37:26'!
Object subclass:#ProfileTree
instanceVariableNames:'receiver selector class leafTally totalTally called isBlock'
classVariableNames:''
poolDictionaries:''
category:'System-Debugging-Support'
!
!ProfileTree class methodsFor:'documentation'!
version
"
$Header: /cvs/stx/stx/libbasic3/ProfileTree.st,v 1.5 1995-08-11 16:01:31 claus Exp $
"
!
documentation
"
This is is used as a companion to MessageTally.
Instances of it are used to represent the calling tree.
"
!
copyright
"
COPYRIGHT (c) 1995 by Claus Gittinger
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
! !
!ProfileTree methodsFor:'prettyPrinting'!
printOn:aStream indent:i
selector notNil ifTrue:[
aStream spaces:i.
self printSingleOn:aStream.
aStream cr.
].
called notNil ifTrue:[
called do:[:sub|
sub printOn:aStream indent:(i + 1)
].
].
!
printOn:aStream
|s|
"/ self printOn:aStream indent:0
s := WriteStream on:String new.
self printOn:s indent:0.
aStream nextPutAll:s contents
!
printSingleOn:aStream
selector notNil ifTrue:[
isBlock == true ifTrue:[
'[] in ' printOn:aStream
].
receiver name printOn:aStream.
(class notNil and:[class ~~ receiver class]) ifTrue:[
'>>' printOn:aStream.
class name printOn:aStream
].
aStream space.
selector printOn:aStream.
aStream space.
aStream nextPutAll:'(total '.
totalTally printOn:aStream.
aStream nextPutAll:'%)'.
leafTally notNil ifTrue:[
aStream nextPutAll:'(leaf '.
leafTally printOn:aStream.
aStream nextPutAll:'%)'.
].
].
!
printLeafsOn:aStream
|leafNodes|
leafNodes := OrderedCollection new.
self addLeafNodesTo:leafNodes.
leafNodes := leafNodes asSortedCollection:[:a :b |
a leafTally < b leafTally].
leafNodes do:[:aNode |
aNode printSingleOn:aStream.
aStream cr.
].
! !
!ProfileTree methodsFor:'accessing'!
selector
^ selector
!
called:aCollection
called := aCollection
!
methodClass
^ class
!
isBlock:aBoolean
isBlock := aBoolean
!
receiver
^ receiver
!
called
^ called
!
leafTally
^ leafTally
!
receiver:r selector:s class:cls
receiver := r.
selector := s.
class := cls
!
totalTally
^ totalTally
!
isBlock
^ isBlock
! !
!ProfileTree methodsFor:'adding info'!
computePercentage:total
totalTally := (totalTally / total * 1000) rounded / 10.0.
leafTally notNil ifTrue:[
leafTally := (leafTally / total * 1000) rounded / 10.0
].
called notNil ifTrue:[
called do:[:subTree |
subTree computePercentage:total
]
].
!
addChain:aCallChain
|node found subTree chain called|
node := self.
chain := aCallChain.
[chain notNil] whileTrue:[
node incrementTotalTally.
found := false.
(called := node called) notNil ifTrue:[
called do:[:subTree |
found ifFalse:[
(chain = subTree) ifTrue:[
node := subTree.
chain := chain rest.
found := true
].
].
].
] ifFalse:[
node called:(OrderedCollection new)
].
found ifFalse:[
subTree := ProfileTree new.
subTree receiver:chain receiver
selector:chain selector
class:chain methodClass.
subTree isBlock:(chain isBlock).
node called add:subTree.
node := subTree.
chain := chain rest
]
].
node incrementTotalTally.
node incrementLeafTally.
!
incrementTotalTally
totalTally isNil ifTrue:[
totalTally := 1
] ifFalse:[
totalTally := totalTally + 1.
].
!
leafTally:aCount
leafTally := aCount
!
incrementLeafTally
leafTally isNil ifTrue:[
leafTally := 1
] ifFalse:[
leafTally := leafTally + 1.
].
!
totalTally:aCount
totalTally := aCount
! !
!ProfileTree methodsFor:'private'!
addLeafNodesTo:aCollection
|idx|
leafTally notNil ifTrue:[
idx := aCollection indexOf:self.
idx == 0 ifTrue:[
aCollection add:self copy
] ifFalse:[
|nd|
nd := aCollection at:idx.
nd leafTally:(nd leafTally + leafTally).
nd totalTally:(nd totalTally max: totalTally)
]
].
called notNil ifTrue:[
called do:[:aNode |
aNode addLeafNodesTo:aCollection
]
]
!
= aProfileTreeNode
receiver ~= aProfileTreeNode receiver ifTrue:[^ false].
selector ~~ aProfileTreeNode selector ifTrue:[^ false].
class ~~ aProfileTreeNode methodClass ifTrue:[^ false].
^ true
! !