"

 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.

"

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 

    "private tally interface - set receiver, selector and class.

     the block flag is cleared."

    receiver := r.

    selector := s.

    class := cls

    "Modified: 18.5.1996 / 19:01:52 / 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

    "Modified: 18.5.1996 / 19:01:57 / 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 receviers 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:(OrderedCollection new)

        ].

        found ifFalse:[

            subTree := ProfileTree new.

            subTree receiver:chain receiver

                    selector:chain selector

                       class:chain methodClass

                     isBlock:chain isBlock.

            node called add:subTree.

            node := subTree.

            chain := chain rest

        ]

    ].

    node incrementTotalTally.

    node incrementLeafTally.

    "Modified: 18.5.1996 / 19:02:28 / 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: 18.5.1996 / 19:02:45 / cg"

!

incrementLeafTally

    "{ Pragma: +optSpeed }"

    "count as leaf"

    leafTally isNil ifTrue:[

        leafTally := 1

    ] ifFalse:[

        leafTally := leafTally + 1.

    ].

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

!

incrementTotalTally

    "{ Pragma: +optSpeed }"

    "count"

    totalTally isNil ifTrue:[

        totalTally := 1

    ] ifFalse:[

        totalTally := totalTally + 1.

    ].

    "Modified: 18.5.1996 / 19:03:06 / 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 printSingleOn:aStream.

        aStream cr.

    ].

    "Modified: 18.5.1996 / 19:04:03 / 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"

!

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 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:'%)'.

        ].

    ].

    "Modified: 18.5.1996 / 19:04:28 / 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].

    ^ true

!

addLeafNodesTo:aCollection

    "add all leaf nodes to aCollection"

    |idx|

    leafTally notNil ifTrue:[

        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

        ]

    ]

! !

!ProfileTree class methodsFor:'documentation'!

version

! !