"

 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:#MessageTally

	instanceVariableNames:'process tree ntally theBlock spyInterval'

	classVariableNames:''

	poolDictionaries:''

	category:'System-Debugging-Support'

!

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

"

    MessageTally allows profiling excution of a block; 

    statistic of method evaluation is output on Transcript.

    To get statistic, use 'MessageTally spyOn:aBlock'.

    By default, probing is done every 10ms (i.e. the execution of the block is 

    interrupted every 10ms, and the context chain analyzed).

    For better resolution, use smaller clock ticks (if your OperatingSystem

    supports it). Try 'spyDetailedOn:aBlock', which tries to measure things

    every 1ms. 

    (Notice, that some OS's do not provide this timer resolution,

     so measuring may be less accurate.)

    For good results, make certain that the measured block runs for some

    time (say 5 seconds) - add a timesRepeat-loop around it if required.

    [author:]

        Claus Gittinger

    [see also:]

        CallChain ProfileTree

        MessageTracer

"

!

examples

"

                                                                        [exBegin]

     MessageTally spyOn:[ #(6 5 4 3 2 1) cop sort ]

                                                                        [exEnd]

                                                                        [exBegin]

     MessageTally spyOn:[

        10000 timesRepeat:[ #(6 5 4 3 2 1) copy sort] 

     ]

                                                                        [exEnd]

                                                                        [exBegin]

     MessageTally spyOn:[

        100000 timesRepeat:[ #(6 5 4 3 2 1) copy sort] 

     ]

                                                                        [exEnd]

                                                                        [exBegin]

     MessageTally spyOn:[

        500000 timesRepeat:[#(6 5 4 3 2 1) copy sort] 

     ]

                                                                        [exEnd]

                                                                        [exBegin]

     MessageTally spyDetailedOn:[

        500000 timesRepeat:[#(6 5 4 3 2 1) copy sort] 

     ]

                                                                        [exEnd]

                                                                        [exBegin]

     Time millisecondsToRun:[

        500000 timesRepeat:[#(6 5 4 3 2 1) copy sort] 

     ]

                                                                        [exEnd]

                                                                        [exBegin]

     MessageTally spyOn:[SystemBrowser open ]

                                                                        [exEnd]

                                                                        [exBegin]

     MessageTally spyDetailedOn:[SystemBrowser open ]

                                                                        [exEnd]

"

! !

!MessageTally class methodsFor:'instance creation'!

spyDetailedOn:aBlock

    "evaluate aBlock and output time statistic on the Transcript.

     Tick is 1ms."

    ^ self spyOn:aBlock interval:1

!

spyOn:aBlock

    "evaluate aBlock and output time statistic on the Transcript.

     Tick is 10ms."

    ^ self spyOn:aBlock interval:10

!

spyOn:aBlock interval:ms

    "evaluate aBlock and output time statistic on Transcript"

    |runTime aTally nTally|

    aTally := self new.

    runTime := aTally spyOn:aBlock interval:ms.

    aTally tree isNil ifTrue:[

        Transcript cr.

        Transcript showCR:'TALLY: No probes - execution time too short;'.

        Transcript showCR:'TALLY: retry using: spyOn:[n timesRepeat:[...]]'.

    ] ifFalse:[

        "/ aTally tree inspect.

        nTally := aTally nTally.

        Transcript cr.

        Transcript showCR:('total execution time: '

                           , runTime printString , ' ms '

                           , '(' , nTally printString , ' probes ;'

                           , ' error >= ' 

                           , (1000 // nTally / 10.0) printString

                           , '%)').

        Transcript cr.

        aTally tree printOn:Transcript.

        Transcript cr.

        Transcript cr.

        Transcript showCR:'leafs of calling tree:'.

        Transcript cr.

        aTally tree printLeafsOn:Transcript.

        Transcript cr.

        "

        aTally statistics.

        "

    ].

    "

     MessageTally spyOn:[ #(6 5 4 3 2 1) sort ]

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

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

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

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

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

     MessageTally spyOn:[SystemBrowser open ]

     MessageTally spyDetailedOn:[SystemBrowser open ]

     Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ]

    "

    "Modified: 18.5.1996 / 15:42:44 / cg"

! !

!MessageTally methodsFor:'accessing'!

nTally 

    "return the number of accumulated probes"

    ^ ntally

    "Modified: 18.5.1996 / 18:47:47 / cg"

!

tree

    "return the accumulated calling tree"

    ^ tree

    "Modified: 18.5.1996 / 18:47:57 / cg"

! !

!MessageTally methodsFor:'private'!

execute

    "evaluate the target block"

    theBlock value

    "Modified: 18.5.1996 / 18:48:10 / cg"

! !

!MessageTally methodsFor:'probes'!

count:aContext

    "entered whenever the probed block gets interrupted;

     look where it is, and remember in the calling tree"

    |con chain info atEnd sender home|

    con := aContext.

    con isNil ifTrue:[^ self].

    ntally := ntally + 1.

    "walk up above the interrupt context"

    [con receiver == Processor] whileTrue:[

        con := con sender

    ].

    "got it - collect info from contexts"

    "walk up"

    con isNil ifTrue:[^ self].

    atEnd := false.

    [atEnd] whileFalse:[

        con isNil ifTrue:[

            atEnd := true

        ] ifFalse:[

            sender := con sender.

            sender isNil ifTrue:[

                atEnd := true

            ] ifFalse:[

                ((sender receiver == self) and:[sender selector == #execute]) ifTrue:[

                    atEnd := true

"/                ] ifFalse:[

"/                    (sender isMemberOf:BlockContext) ifTrue:[

"/                        sender sender selector == #execute ifTrue:[

"/                            atEnd := true

"/                        ]

"/                    ]

                ]

            ]

        ].

        atEnd ifFalse:[

            info := CallChain new.

            (con isMemberOf:BlockContext) ifTrue:[

                home := con methodHome.

                home isNil ifTrue:[

                    info receiver:UndefinedObject

                         selector:'optimized'

                            class:UndefinedObject

                          isBlock:true.

                ] ifFalse:[

                    info receiver:home receiver class

                         selector:home selector

                            class:con methodClass

                          isBlock:true.

                ].

            ] ifFalse:[

                info receiver:con receiver class

                     selector:con selector

                        class:con methodClass.

            ].

            info rest:chain.

            chain := info.

            con := sender

        ]

    ].

    "add chain to the tree"

    chain isNil ifTrue:[^ self].

    tree isNil ifTrue:[

        tree := ProfileTree new.

        tree receiver:MessageTally 

             selector:#execute 

                class:MessageTally .

    ].

    tree addChain:chain

    "Modified: 18.5.1996 / 18:53:31 / cg"

! !

!MessageTally methodsFor:'setup'!

"spy on execution time"

    |startTime endTime running delay|

    theBlock := aBlock.

    Processor activeProcess withPriority:23 do:[

	process := [

			[

			    self execute

			] valueNowOrOnUnwindDo:[

			    running := false.

			    theBlock := nil.

			]

		   ] newProcess.

	Processor activeProcess withPriority:24 do:[

	    startTime := OperatingSystem getMillisecondTime.

	    delay := (Delay forMilliseconds:ms).

	    ntally := 0.

	    running := true.

	    process resume.

	    [running] whileTrue:[

		delay wait.

		self count:process suspendedContext

	    ].

	    endTime := OperatingSystem getMillisecondTime.

	].    

    ].    

    tree notNil ifTrue:[tree computePercentage:ntally].

    ^ endTime - startTime

! !

!MessageTally class methodsFor:'documentation'!

version

! !