"

 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.

"

"{ Package: 'stx:libbasic3' }"

Object subclass:#ProfileTree

	instanceVariableNames:'receiver selector class leafTally totalTally called isBlock'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Debugging-Support'

!

!ProfileTree class methodsFor:'documentation'!

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.

"

!

documentation

"

    This is is used as a companion to MessageTally.

    Instances of it are used to represent a calling chain.

    (MessageTally could have used the contexts themself, but these

     may create more overhead)

    [author:]

        Claus Gittinger

    [see also:]

        MessageTally CallChain

        MessageTracer

        AbstractTime

"

! !

!ProfileTree methodsFor:'accessing'!

called

    "return the trees of the called methods/blocks"

    ^ called

    "Modified: 18.5.1996 / 19:00:59 / cg"

!

called:aCollection

    "set the trees of the called methods/blocks"

    called := aCollection

    "Modified: 18.5.1996 / 19:01:08 / cg"

!

isBlock 

    "return true, if this is a tree for a block-context"

    ^ isBlock

    "Modified: 18.5.1996 / 18:59:12 / cg"

!

leafTally

    "return true, if this is a leaf"

    ^ leafTally

    "Modified: 18.5.1996 / 19:01:27 / cg"

!

methodClass 

    "return the contexts methods class"

    ^ class

    "Modified: 18.5.1996 / 19:01:40 / cg"

!

receiver

    "return the contexts receiver"

    ^ receiver

    "Modified: 18.5.1996 / 19:01:45 / cg"

!

receiver:r selector:s class:cls isBlock:blk

    "private tally interface - set receiver, selector, class

     and the block flag."

    receiver := r.

    selector := s.

    class := cls.

    isBlock := blk.

    leafTally := totalTally := 0.

    "Modified: 20.3.1997 / 20:46:19 / cg"

!

selector 

    "return the contexts selector"

    ^ selector

    "Modified: 18.5.1996 / 19:02:04 / cg"

!

totalTally

    "return the total tally counter"

    ^ totalTally

    "Modified: 18.5.1996 / 19:02:15 / cg"

! !

!ProfileTree methodsFor:'adding info'!

addChain:aCallChain

    "{ Pragma: +optSpeed }"

    "merge a chain into the receivers tree"

    |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:(called := OrderedCollection new)

        ].

        found ifFalse:[

            subTree := ProfileTree new.

            subTree receiver:chain receiver

                    selector:chain selector

                       class:chain methodClass

                     isBlock:chain isBlock.

            called add:subTree.

            node := subTree.

            chain := chain rest

        ]

    ].

    node incrementTotalAndLeafTally.

    "Modified: 20.3.1997 / 20:45:50 / cg"

!

computePercentage:total

    "compute percentages"

    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

        ]

    ].

    "Modified: 20.3.1997 / 21:32:01 / cg"

!

incrementLeafTally

    "{ Pragma: +optSpeed }"

    "count as leaf"

    leafTally := leafTally + 1.

    "Modified: 20.3.1997 / 20:46:27 / cg"

!

incrementTotalAndLeafTally

    "{ Pragma: +optSpeed }"

    "count as leaf and total"

    leafTally := leafTally + 1.

    totalTally := totalTally + 1.

    "Modified: 20.3.1997 / 20:46:36 / cg"

!

incrementTotalTally

    "{ Pragma: +optSpeed }"

    "count"

    totalTally := totalTally + 1.

    "Modified: 20.3.1997 / 20:46:41 / cg"

!

leafTally:aCount

    "set the leafTally count"

    leafTally := aCount

    "Modified: 18.5.1996 / 19:03:22 / cg"

!

totalTally:aCount

    "set the totalTally count"

    totalTally := aCount

    "Modified: 18.5.1996 / 19:03:30 / cg"

! !

!ProfileTree methodsFor:'prettyPrinting'!

printLeafsOn:aStream

    "print all leafNodes statistics on aStream"

    |leafNodes|

    leafNodes := OrderedCollection new.

    self addLeafNodesTo:leafNodes.

    leafNodes := leafNodes asSortedCollection:[:a :b |

                                        a leafTally < b leafTally].

    leafNodes do:[:aNode |

        aNode leafTally ~= 0 ifTrue:[

            aNode printSingleLeafOn:aStream.

            aStream cr.

        ]

    ].

    "Modified: 20.3.1997 / 21:08:09 / cg"

!

printMethodLeafsOn:aStream

    "print all method leafNodes statistics on aStream"

    |leafNodes|

    leafNodes := OrderedCollection new.

    self addMethodLeafNodesTo:leafNodes.

    leafNodes := leafNodes asSortedCollection:[:a :b |

                                        a leafTally < b leafTally].

    leafNodes do:[:aNode |

        aNode leafTally ~= 0 ifTrue:[

            aNode printSingleMethodLeafOn:aStream.

            aStream cr.

        ].

    ].

    "Created: 19.3.1997 / 12:19:31 / cg"

    "Modified: 20.3.1997 / 21:07:39 / cg"

!

printOn:aStream

    "print statistics on aStream"

    |s|

"/    self printOn:aStream indent:0

    s := WriteStream on:String new.

    self printOn:s indent:0.

    aStream nextPutAll:s contents

    "Modified: 18.5.1996 / 19:03:55 / cg"

!

printOn:aStream indent:i

    "print statistics indented on aStream"

    selector notNil ifTrue:[

        aStream spaces:i.

        self printSingleOn:aStream.

        aStream cr.

    ].

    called notNil ifTrue:[

        called do:[:sub|

            sub printOn:aStream indent:(i + 1)

        ].

    ].

    "Modified: 18.5.1996 / 19:04:12 / cg"

!

printSingleLeafOn:aStream

    "print a single nodes statistic on aStream"

    selector notNil ifTrue:[

        isBlock == true ifTrue:[

            '[] in ' printOn:aStream

        ].

        receiver name printOn:aStream.

        (class notNil and:[class ~~ receiver]) ifTrue:[

            '>>' printOn:aStream.

            class name printOn:aStream

        ].

        aStream space.

        selector printOn:aStream.

        aStream space.

        leafTally notNil ifTrue:[

            aStream nextPutAll:'('.

            leafTally printOn:aStream.

            aStream nextPutAll:'%)'.

        ] ifFalse:[

            aStream nextPutAll:'(total '.

            totalTally printOn:aStream.

            aStream nextPutAll:'%)'.

        ].

    ].

    "Created: 19.3.1997 / 19:10:13 / cg"

    "Modified: 19.3.1997 / 19:17:05 / cg"

!

printSingleMethodLeafOn:aStream

    "print a single nodes statistic on aStream"

    |cls|

    selector notNil ifTrue:[

        isBlock == true ifTrue:[

            '[] in ' printOn:aStream

        ].

        (class notNil and:[class ~~ receiver]) ifTrue:[

            cls := class

        ] ifFalse:[

            cls := receiver.

        ].

        cls name printOn:aStream.

        aStream space.

        selector printOn:aStream.

        aStream space.

        leafTally notNil ifTrue:[

            aStream nextPutAll:'('.

            leafTally printOn:aStream.

            aStream nextPutAll:'%)'.

        ] ifFalse:[

            aStream nextPutAll:'(total '.

            totalTally printOn:aStream.

            aStream nextPutAll:'%)'.

        ]

    ].

    "Created: 19.3.1997 / 19:10:32 / cg"

    "Modified: 19.3.1997 / 19:17:13 / cg"

!

printSingleOn:aStream

    "print a single nodes statistic on aStream"

    selector notNil ifTrue:[

        isBlock == true ifTrue:[

            '[] in ' printOn:aStream

        ].

        receiver name printOn:aStream.

        (class notNil and:[class ~~ receiver]) ifTrue:[

            '>>' printOn:aStream.

            class name printOn:aStream

        ].

        aStream space.

        selector printOn:aStream.

        aStream space.

        (leafTally isNil or:[leafTally ~= totalTally]) ifTrue:[

            aStream nextPutAll:'(total '.

            totalTally printOn:aStream.

            aStream nextPutAll:'%)'.

        ].

        leafTally notNil ifTrue:[

            aStream nextPutAll:'(here '.

            leafTally printOn:aStream.

            aStream nextPutAll:'%)'.

        ].

    ].

    "Modified: 19.3.1997 / 19:14:32 / cg"

! !

!ProfileTree methodsFor:'private'!

= aProfileTreeNode

    "return true, if the argument tree is for the same method invocation"

    selector ~~ aProfileTreeNode selector ifTrue:[^ false].

    class ~~ aProfileTreeNode methodClass ifTrue:[^ false].

    receiver ~= aProfileTreeNode receiver ifTrue:[^ false].

    ^ true

    "Modified: 19.3.1997 / 12:23:41 / cg"

!

addLeafNodesTo:aCollection

    "add all leaf nodes to 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

        ]

    ]

    "Modified: 19.3.1997 / 12:23:49 / cg"

!

addMethodLeafNodesTo:aCollection

    "add all method leaf nodes to aCollection"

    |idx|

    leafTally notNil ifTrue:[

        idx := aCollection findFirst:[:el | el sameMethodAsIn: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 addMethodLeafNodesTo:aCollection

        ]

    ]

    "Modified: 19.3.1997 / 12:26:05 / cg"

!

hash

    "return true, if the argument tree is for the same method invocation"

    class notNil ifTrue:[

        ^ selector identityHash bitXor: class identityHash

    ].

    ^ selector identityHash bitXor: receiver identityHash

    "Created: 20.3.1997 / 20:27:15 / cg"

    "Modified: 21.3.1997 / 14:02:27 / cg"