"
 COPYRIGHT (c) 1989 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:#MessageTally
       instanceVariableNames:'classes selectors counts ntally
                              sumClasses sumSelectors sumCounts sumNtally'
       classVariableNames:''
       poolDictionaries:''
       category:'System-Support'
!

MessageTally comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
              All Rights Reserved
'!

!MessageTally class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 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.
"
!

version
"
$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.5 1994-06-02 17:19:54 claus Exp $
"
!

documentation
"
    MessageTally allows profiling excution of a block; 
    statistic of method evaluation is output on Transcript.
    To get statistic, use 'MessageTally spyOn:aBlock'.

    example:
	MessageTally spyOn:[
	    (ByteArray uninitalizedNew:1000) sort
	]
"
! !

!MessageTally class methodsFor:'instance creation'!

spyOn:aBlock
    "evaluate aBlock and output time statistic on Transcript"

    |runTime aTally|

    aTally := self new.
    runTime := aTally spyOn:aBlock.
    aTally statistics.
    Transcript cr.
    Transcript showCr:('total execution time: '
                       , runTime printString , ' ms')

    "MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]"
!

spyCountOn:aBlock
    "evaluate aBlock and output call statistic on Transcript"

    (self new spyCountOn:aBlock) statistics

    "MessageTally spyCountOn:[#(6 5 4 3 2 1) sort ]"
! !

!MessageTally methodsFor:'private'!

setupArrays
    classes := Array new:200.
    selectors := Array new:200.
    counts := Array new:200.
    sumClasses := Array new:200.
    sumSelectors := Array new:200.
    sumCounts := Array new:200.
    ntally := 0.
    sumNtally := 0
!

spyOn:aBlock
    "spy on execution time"

    |startTime endTime|

    self setupArrays.
    ObjectMemory spyInterruptHandler:self.
    startTime := OperatingSystem getMillisecondTime.
    OperatingSystem startSpyTimer.
    aBlock value.
    OperatingSystem stopSpyTimer.
    endTime := OperatingSystem getMillisecondTime.
    ObjectMemory spyInterruptHandler:nil.
    ^ endTime - startTime
!

spyCountOn:aBlock
    "spy on method sends"

    self setupArrays.
    ObjectMemory stepInterruptHandler:nil.
    StepInterruptPending := true.
    InterruptPending := true.
    aBlock value.
    StepInterruptPending := nil.
    ObjectMemory stepInterruptHandler:nil.
!

stepInterrupt
    "called for every send;
     increment counts and retrigger stepInterrupt"

    self count.
    StepInterruptPending := true.
    InterruptPending := true
!

spyInterrupt
    "called every 10ms by timer;
     increment counts and retrigger spyInterrupt"

    self count.
    OperatingSystem startSpyTimer
!

count
    "increment class/method counts"

    |where index sel recClass done newColl|

    where := thisContext.
    "where is now my context"
    where := where sender.
    "where is now spy/step interrupt context"
    where := where sender.
    "where is now interrupted context"

    "ignore block-contexts"
    (where isBlockContext) ifTrue:[
        where := nil.   "currently needed"
        ^ self
    ].

    sel := where selector.
    recClass := where searchClass whichClassImplements:sel "receiver class".

    index := 0.
    done := false.
    [done] whileFalse:[
        index := selectors identityIndexOf:sel startingAt:(index + 1).
        (index == 0) ifTrue:[
            ntally := ntally + 1.
            (ntally > counts size) ifTrue:[
                newColl := Array new:(ntally * 2).
                newColl replaceFrom:1 with:counts.
                counts := newColl.
                newColl := Array new:(ntally * 2).
                newColl replaceFrom:1 with:selectors.
                selectors := newColl.
                newColl := Array new:(ntally * 2).
                newColl replaceFrom:1 with:classes.
                classes := newColl.
            ].
            selectors at:ntally put:sel.
            classes at:ntally put:recClass.
            counts at:ntally put:1.
            done := true
        ] ifFalse:[
            ((classes at:index) == recClass) ifTrue:[
                counts at:index put:((counts at:index) + 1).
                done := true
            ]
        ]
    ].

    "count in accumulated table"
    [where notNil] whileTrue:[
        sel := where selector.
        (sel == #spyOn:) ifTrue:[
            where := nil
        ] ifFalse:[
            recClass := where searchClass whichClassImplements:sel "receiver class".
            recClass isNil ifTrue:[
                recClass := where searchClass
            ].
            index := 0.
            done := false.
            [done] whileFalse:[
                index := sumSelectors identityIndexOf:sel startingAt:(index + 1).
                (index == 0) ifTrue:[
                    sumNtally := sumNtally + 1.
                    (sumNtally > sumCounts size) ifTrue:[
                        newColl := Array new:(sumNtally * 2).
                        newColl replaceFrom:1 with:sumCounts.
                        sumCounts := newColl.

                        newColl := Array new:(sumNtally * 2).
                        newColl replaceFrom:1 with:sumSelectors.
                        sumSelectors := newColl.

                        newColl := Array new:(sumNtally * 2).
                        newColl replaceFrom:1 with:sumClasses.
                        sumClasses := newColl.
                    ].
                    sumSelectors at:sumNtally put:sel.
                    sumClasses at:sumNtally put:recClass.
                    sumCounts at:sumNtally put:1.
                    done := true
                ] ifFalse:[
                    ((sumClasses at:index) == recClass) ifTrue:[
                        sumCounts at:index put:((sumCounts at:index) + 1).
                        done := true
                    ]
                ]
            ].
            where := where sender
        ]
    ]
!

statistics
    "print statistics with percentages"

    |nprobe sumNprobe nthis percent|

    nprobe := 0.
    1 to:ntally do:[:index |
        nprobe := nprobe + (counts at:index)
    ].
    sumNprobe := 0.
    1 to:sumNtally do:[:index |
        sumNprobe := sumNprobe + (sumCounts at:index)
    ].
    Transcript cr.
    Transcript show:'total probes: '.
    Transcript show:nprobe printString.
    Transcript show:' ('.
    Transcript show:sumNprobe printString.
    Transcript show:')'.
    Transcript cr.
    Transcript cr.
    Transcript show:'  ntally'.
    Transcript tab show:'percentage'.
    Transcript tab show:'        class'.     
    Transcript tab showCr:'       selector'.
    Transcript showCr:'------------------ leafs ---------------------------'.
    1 to:ntally do:[:index |
        nthis := counts at:index.
        percent := nthis * 100 // nprobe.
        Transcript show:(nthis printStringLeftPaddedTo:6).
        Transcript tab. Transcript show:'    '.
        Transcript show:((percent printStringLeftPaddedTo:3) , '%').
        Transcript tab. 
        Transcript show:((classes at:index) name printStringLeftPaddedTo:20).
        Transcript tab. Transcript show:'    '.
        Transcript showCr:((selectors at:index) printString)
    ].

    Transcript showCr:'---------------- accumulated -----------------------'.
    1 to:sumNtally do:[:index |
        nthis := sumCounts at:index.
        percent := nthis * 100 // sumNprobe.
        Transcript show:(nthis printStringLeftPaddedTo:6).
        Transcript tab. Transcript show:'    '.
        Transcript show:((percent printStringLeftPaddedTo:3) , '%').
        Transcript tab. 
        (sumClasses at:index) isNil ifTrue:[
            Transcript show:('??' printStringLeftPaddedTo:20)
        ] ifFalse:[
            Transcript show:((sumClasses at:index) name printStringLeftPaddedTo:20).
        ].
        Transcript tab. Transcript show:'    '.
        Transcript showCr:((sumSelectors at:index) printString)
    ]
! !