"
 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 the calling tree.
"
! !

!ProfileTree methodsFor:'accessing'!

called
    ^ called
!

called:aCollection
    called := aCollection
!

isBlock 
    ^ isBlock 
!

isBlock:aBoolean
    isBlock  := aBoolean
!

leafTally
    ^ leafTally
!

methodClass 
    ^ class 
!

receiver
    ^ receiver
!

receiver:r selector:s class:cls 
    receiver := r.
    selector := s.
    class := cls
!

selector 
    ^ selector
!

totalTally
    ^ totalTally
! !

!ProfileTree methodsFor:'adding info'!

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.
!

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
	]
    ].
!

incrementLeafTally
    leafTally isNil ifTrue:[
	leafTally := 1
    ] ifFalse:[
	leafTally := leafTally + 1.
    ].
!

incrementTotalTally
    totalTally isNil ifTrue:[
	totalTally := 1
    ] ifFalse:[
	totalTally := totalTally + 1.
    ].
!

leafTally:aCount
    leafTally := aCount
!

totalTally:aCount
    totalTally := aCount
! !

!ProfileTree methodsFor:'prettyPrinting'!

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.
    ].
!

printOn:aStream
    |s|

"/    self printOn:aStream indent:0
    s := WriteStream on:String new.
    self printOn:s indent:0.

    aStream nextPutAll:s contents
!

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)
	].
    ].
!

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

!ProfileTree methodsFor:'private'!

= aProfileTreeNode
    receiver ~= aProfileTreeNode receiver ifTrue:[^ false].
    selector ~~ aProfileTreeNode selector ifTrue:[^ false].
    class ~~ aProfileTreeNode methodClass ifTrue:[^ false].
    ^ true
!

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
	]
    ]
! !

!ProfileTree class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic3/ProfileTree.st,v 1.8 1995-11-27 22:33:04 cg Exp $'
! !