'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-Profiler'
!

!ProfileTree class methodsFor:'documentation'!

documentation
"
    This is is used as a companion to MessageTally.
    Instances of it are used to represent the calling tree.
"
! !

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