0
|
1 |
"
|
5
|
2 |
COPYRIGHT (c) 1989 by Claus Gittinger
|
0
|
3 |
All Rights Reserved
|
|
4 |
|
|
5 |
This software is furnished under a license and may be used
|
|
6 |
only in accordance with the terms of that license and with the
|
|
7 |
inclusion of the above copyright notice. This software may not
|
|
8 |
be provided or otherwise made available to, or used by, any
|
|
9 |
other person. No title to or ownership of the software is
|
|
10 |
hereby transferred.
|
|
11 |
"
|
|
12 |
|
|
13 |
Object subclass:#MessageTally
|
|
14 |
instanceVariableNames:'classes selectors counts ntally
|
|
15 |
sumClasses sumSelectors sumCounts sumNtally'
|
|
16 |
classVariableNames:''
|
|
17 |
poolDictionaries:''
|
|
18 |
category:'System-Support'
|
|
19 |
!
|
|
20 |
|
|
21 |
MessageTally comment:'
|
9
|
22 |
COPYRIGHT (c) 1989 by Claus Gittinger
|
|
23 |
All Rights Reserved
|
10
|
24 |
|
|
25 |
$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.6 1994-08-05 01:07:01 claus Exp $
|
9
|
26 |
'!
|
0
|
27 |
|
9
|
28 |
!MessageTally class methodsFor:'documentation'!
|
|
29 |
|
|
30 |
copyright
|
|
31 |
"
|
|
32 |
COPYRIGHT (c) 1989 by Claus Gittinger
|
0
|
33 |
All Rights Reserved
|
|
34 |
|
9
|
35 |
This software is furnished under a license and may be used
|
|
36 |
only in accordance with the terms of that license and with the
|
|
37 |
inclusion of the above copyright notice. This software may not
|
|
38 |
be provided or otherwise made available to, or used by, any
|
|
39 |
other person. No title to or ownership of the software is
|
|
40 |
hereby transferred.
|
|
41 |
"
|
|
42 |
!
|
0
|
43 |
|
9
|
44 |
version
|
|
45 |
"
|
10
|
46 |
$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.6 1994-08-05 01:07:01 claus Exp $
|
9
|
47 |
"
|
|
48 |
!
|
|
49 |
|
|
50 |
documentation
|
|
51 |
"
|
|
52 |
MessageTally allows profiling excution of a block;
|
|
53 |
statistic of method evaluation is output on Transcript.
|
|
54 |
To get statistic, use 'MessageTally spyOn:aBlock'.
|
|
55 |
|
|
56 |
example:
|
10
|
57 |
MessageTally spyOn:[
|
|
58 |
(ByteArray uninitalizedNew:1000) sort
|
|
59 |
]
|
9
|
60 |
"
|
|
61 |
! !
|
0
|
62 |
|
|
63 |
!MessageTally class methodsFor:'instance creation'!
|
|
64 |
|
|
65 |
spyOn:aBlock
|
|
66 |
"evaluate aBlock and output time statistic on Transcript"
|
|
67 |
|
|
68 |
|runTime aTally|
|
|
69 |
|
|
70 |
aTally := self new.
|
|
71 |
runTime := aTally spyOn:aBlock.
|
|
72 |
aTally statistics.
|
|
73 |
Transcript cr.
|
|
74 |
Transcript showCr:('total execution time: '
|
|
75 |
, runTime printString , ' ms')
|
|
76 |
|
|
77 |
"MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ]"
|
|
78 |
!
|
|
79 |
|
|
80 |
spyCountOn:aBlock
|
|
81 |
"evaluate aBlock and output call statistic on Transcript"
|
|
82 |
|
|
83 |
(self new spyCountOn:aBlock) statistics
|
|
84 |
|
|
85 |
"MessageTally spyCountOn:[#(6 5 4 3 2 1) sort ]"
|
|
86 |
! !
|
|
87 |
|
|
88 |
!MessageTally methodsFor:'private'!
|
|
89 |
|
|
90 |
setupArrays
|
|
91 |
classes := Array new:200.
|
|
92 |
selectors := Array new:200.
|
|
93 |
counts := Array new:200.
|
|
94 |
sumClasses := Array new:200.
|
|
95 |
sumSelectors := Array new:200.
|
|
96 |
sumCounts := Array new:200.
|
|
97 |
ntally := 0.
|
|
98 |
sumNtally := 0
|
|
99 |
!
|
|
100 |
|
|
101 |
spyOn:aBlock
|
|
102 |
"spy on execution time"
|
|
103 |
|
|
104 |
|startTime endTime|
|
|
105 |
|
|
106 |
self setupArrays.
|
2
|
107 |
ObjectMemory spyInterruptHandler:self.
|
10
|
108 |
startTime := Time millisecondClockValue.
|
0
|
109 |
OperatingSystem startSpyTimer.
|
|
110 |
aBlock value.
|
|
111 |
OperatingSystem stopSpyTimer.
|
10
|
112 |
endTime := Time millisecondClockValue.
|
2
|
113 |
ObjectMemory spyInterruptHandler:nil.
|
0
|
114 |
^ endTime - startTime
|
|
115 |
!
|
|
116 |
|
|
117 |
spyCountOn:aBlock
|
|
118 |
"spy on method sends"
|
|
119 |
|
|
120 |
self setupArrays.
|
2
|
121 |
ObjectMemory stepInterruptHandler:nil.
|
0
|
122 |
StepInterruptPending := true.
|
|
123 |
InterruptPending := true.
|
|
124 |
aBlock value.
|
|
125 |
StepInterruptPending := nil.
|
2
|
126 |
ObjectMemory stepInterruptHandler:nil.
|
0
|
127 |
!
|
|
128 |
|
|
129 |
stepInterrupt
|
|
130 |
"called for every send;
|
|
131 |
increment counts and retrigger stepInterrupt"
|
|
132 |
|
|
133 |
self count.
|
|
134 |
StepInterruptPending := true.
|
|
135 |
InterruptPending := true
|
|
136 |
!
|
|
137 |
|
|
138 |
spyInterrupt
|
|
139 |
"called every 10ms by timer;
|
|
140 |
increment counts and retrigger spyInterrupt"
|
|
141 |
|
|
142 |
self count.
|
|
143 |
OperatingSystem startSpyTimer
|
|
144 |
!
|
|
145 |
|
|
146 |
count
|
|
147 |
"increment class/method counts"
|
|
148 |
|
|
149 |
|where index sel recClass done newColl|
|
|
150 |
|
|
151 |
where := thisContext.
|
|
152 |
"where is now my context"
|
|
153 |
where := where sender.
|
|
154 |
"where is now spy/step interrupt context"
|
|
155 |
where := where sender.
|
|
156 |
"where is now interrupted context"
|
|
157 |
|
|
158 |
"ignore block-contexts"
|
|
159 |
(where isBlockContext) ifTrue:[
|
|
160 |
where := nil. "currently needed"
|
|
161 |
^ self
|
|
162 |
].
|
|
163 |
|
|
164 |
sel := where selector.
|
|
165 |
recClass := where searchClass whichClassImplements:sel "receiver class".
|
|
166 |
|
|
167 |
index := 0.
|
|
168 |
done := false.
|
|
169 |
[done] whileFalse:[
|
|
170 |
index := selectors identityIndexOf:sel startingAt:(index + 1).
|
|
171 |
(index == 0) ifTrue:[
|
|
172 |
ntally := ntally + 1.
|
|
173 |
(ntally > counts size) ifTrue:[
|
2
|
174 |
newColl := Array new:(ntally * 2).
|
|
175 |
newColl replaceFrom:1 with:counts.
|
|
176 |
counts := newColl.
|
|
177 |
newColl := Array new:(ntally * 2).
|
|
178 |
newColl replaceFrom:1 with:selectors.
|
|
179 |
selectors := newColl.
|
|
180 |
newColl := Array new:(ntally * 2).
|
|
181 |
newColl replaceFrom:1 with:classes.
|
|
182 |
classes := newColl.
|
0
|
183 |
].
|
|
184 |
selectors at:ntally put:sel.
|
|
185 |
classes at:ntally put:recClass.
|
|
186 |
counts at:ntally put:1.
|
|
187 |
done := true
|
|
188 |
] ifFalse:[
|
|
189 |
((classes at:index) == recClass) ifTrue:[
|
|
190 |
counts at:index put:((counts at:index) + 1).
|
|
191 |
done := true
|
|
192 |
]
|
|
193 |
]
|
|
194 |
].
|
|
195 |
|
|
196 |
"count in accumulated table"
|
|
197 |
[where notNil] whileTrue:[
|
|
198 |
sel := where selector.
|
|
199 |
(sel == #spyOn:) ifTrue:[
|
|
200 |
where := nil
|
|
201 |
] ifFalse:[
|
|
202 |
recClass := where searchClass whichClassImplements:sel "receiver class".
|
|
203 |
recClass isNil ifTrue:[
|
|
204 |
recClass := where searchClass
|
|
205 |
].
|
|
206 |
index := 0.
|
|
207 |
done := false.
|
|
208 |
[done] whileFalse:[
|
|
209 |
index := sumSelectors identityIndexOf:sel startingAt:(index + 1).
|
|
210 |
(index == 0) ifTrue:[
|
|
211 |
sumNtally := sumNtally + 1.
|
|
212 |
(sumNtally > sumCounts size) ifTrue:[
|
2
|
213 |
newColl := Array new:(sumNtally * 2).
|
|
214 |
newColl replaceFrom:1 with:sumCounts.
|
|
215 |
sumCounts := newColl.
|
0
|
216 |
|
2
|
217 |
newColl := Array new:(sumNtally * 2).
|
|
218 |
newColl replaceFrom:1 with:sumSelectors.
|
|
219 |
sumSelectors := newColl.
|
0
|
220 |
|
2
|
221 |
newColl := Array new:(sumNtally * 2).
|
|
222 |
newColl replaceFrom:1 with:sumClasses.
|
|
223 |
sumClasses := newColl.
|
0
|
224 |
].
|
|
225 |
sumSelectors at:sumNtally put:sel.
|
|
226 |
sumClasses at:sumNtally put:recClass.
|
|
227 |
sumCounts at:sumNtally put:1.
|
|
228 |
done := true
|
|
229 |
] ifFalse:[
|
|
230 |
((sumClasses at:index) == recClass) ifTrue:[
|
|
231 |
sumCounts at:index put:((sumCounts at:index) + 1).
|
|
232 |
done := true
|
|
233 |
]
|
|
234 |
]
|
|
235 |
].
|
|
236 |
where := where sender
|
|
237 |
]
|
|
238 |
]
|
|
239 |
!
|
|
240 |
|
|
241 |
statistics
|
|
242 |
"print statistics with percentages"
|
|
243 |
|
|
244 |
|nprobe sumNprobe nthis percent|
|
|
245 |
|
|
246 |
nprobe := 0.
|
|
247 |
1 to:ntally do:[:index |
|
|
248 |
nprobe := nprobe + (counts at:index)
|
|
249 |
].
|
|
250 |
sumNprobe := 0.
|
|
251 |
1 to:sumNtally do:[:index |
|
|
252 |
sumNprobe := sumNprobe + (sumCounts at:index)
|
|
253 |
].
|
|
254 |
Transcript cr.
|
|
255 |
Transcript show:'total probes: '.
|
|
256 |
Transcript show:nprobe printString.
|
|
257 |
Transcript show:' ('.
|
|
258 |
Transcript show:sumNprobe printString.
|
|
259 |
Transcript show:')'.
|
|
260 |
Transcript cr.
|
|
261 |
Transcript cr.
|
|
262 |
Transcript show:' ntally'.
|
|
263 |
Transcript tab show:'percentage'.
|
|
264 |
Transcript tab show:' class'.
|
|
265 |
Transcript tab showCr:' selector'.
|
|
266 |
Transcript showCr:'------------------ leafs ---------------------------'.
|
|
267 |
1 to:ntally do:[:index |
|
|
268 |
nthis := counts at:index.
|
|
269 |
percent := nthis * 100 // nprobe.
|
2
|
270 |
Transcript show:(nthis printStringLeftPaddedTo:6).
|
0
|
271 |
Transcript tab. Transcript show:' '.
|
2
|
272 |
Transcript show:((percent printStringLeftPaddedTo:3) , '%').
|
0
|
273 |
Transcript tab.
|
2
|
274 |
Transcript show:((classes at:index) name printStringLeftPaddedTo:20).
|
0
|
275 |
Transcript tab. Transcript show:' '.
|
|
276 |
Transcript showCr:((selectors at:index) printString)
|
|
277 |
].
|
|
278 |
|
|
279 |
Transcript showCr:'---------------- accumulated -----------------------'.
|
|
280 |
1 to:sumNtally do:[:index |
|
|
281 |
nthis := sumCounts at:index.
|
|
282 |
percent := nthis * 100 // sumNprobe.
|
2
|
283 |
Transcript show:(nthis printStringLeftPaddedTo:6).
|
0
|
284 |
Transcript tab. Transcript show:' '.
|
2
|
285 |
Transcript show:((percent printStringLeftPaddedTo:3) , '%').
|
0
|
286 |
Transcript tab.
|
|
287 |
(sumClasses at:index) isNil ifTrue:[
|
2
|
288 |
Transcript show:('??' printStringLeftPaddedTo:20)
|
0
|
289 |
] ifFalse:[
|
2
|
290 |
Transcript show:((sumClasses at:index) name printStringLeftPaddedTo:20).
|
0
|
291 |
].
|
|
292 |
Transcript tab. Transcript show:' '.
|
|
293 |
Transcript showCr:((sumSelectors at:index) printString)
|
|
294 |
]
|
|
295 |
! !
|