"
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
$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.7 1995-02-08 03:16:43 claus Exp $
'!
!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.7 1995-02-08 03:16:43 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 := Time millisecondClockValue.
OperatingSystem startSpyTimer.
aBlock value.
OperatingSystem stopSpyTimer.
endTime := Time millisecondClockValue.
ObjectMemory spyInterruptHandler:nil.
^ endTime - startTime
!
spyCountOn:aBlock
"spy on method sends"
self setupArrays.
ObjectMemory stepInterruptHandler:nil.
ObjectMemory flushInlineCaches.
StepInterruptPending := 1.
InterruptPending := 1.
aBlock value.
StepInterruptPending := nil.
ObjectMemory stepInterruptHandler:nil.
!
stepInterrupt
"called for every send;
increment counts and retrigger stepInterrupt"
self count.
ObjectMemory flushInlineCaches.
StepInterruptPending := 1.
InterruptPending := 1
!
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)
]
! !