author | Claus Gittinger <cg@exept.de> |
Sat, 11 Nov 1995 16:20:50 +0100 | |
changeset 68 | 5f7ac0b5c903 |
parent 39 | e36b38a77856 |
child 88 | 070ba8eb911e |
permissions | -rw-r--r-- |
0 | 1 |
" |
21 | 2 |
COPYRIGHT (c) 1995 by Claus Gittinger |
3 |
All Rights Reserved |
|
0 | 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 |
||
21 | 13 |
|
14 |
'From Smalltalk/X, Version:2.10.4 on 8-mar-1995 at 22:38:17'! |
|
15 |
||
0 | 16 |
Object subclass:#MessageTally |
21 | 17 |
instanceVariableNames:'process tree ntally theBlock spyInterval' |
18 |
classVariableNames:'' |
|
19 |
poolDictionaries:'' |
|
24 | 20 |
category:'System-Debugging-Support' |
0 | 21 |
! |
22 |
||
9 | 23 |
!MessageTally class methodsFor:'documentation'! |
24 |
||
25 |
version |
|
68
5f7ac0b5c903
uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents:
39
diff
changeset
|
26 |
^ '$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.13 1995-11-11 15:20:37 cg Exp $' |
9 | 27 |
! |
28 |
||
29 |
documentation |
|
30 |
" |
|
31 |
MessageTally allows profiling excution of a block; |
|
32 |
statistic of method evaluation is output on Transcript. |
|
33 |
To get statistic, use 'MessageTally spyOn:aBlock'. |
|
34 |
||
35 |
example: |
|
21 | 36 |
MessageTally spyOn:[ |
37 |
(ByteArray uninitalizedNew:1000) sort |
|
38 |
] |
|
39 |
||
40 |
By default, probing is done every 10ms (i.e. the execution of the block is |
|
41 |
interrupted every 10ms, and the context chain analyzed). |
|
42 |
For better resolution, use smaller clock ticks (if your OperatingSystem |
|
43 |
supports it). Try spyDetailedOn:aBlock, which tries to measure things |
|
44 |
every 1ms. (Notice, that some OS's only provide a resolution of less than |
|
45 |
that time interval) |
|
46 |
" |
|
47 |
! |
|
48 |
||
49 |
examples |
|
9 | 50 |
" |
21 | 51 |
MessageTally spyOn:[ #(6 5 4 3 2 1) sort ] |
52 |
MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
53 |
MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
54 |
MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
55 |
MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
56 |
MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
57 |
MessageTally spyDetailedOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
58 |
Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
59 |
||
60 |
MessageTally spyOn:[SystemBrowser open ] |
|
61 |
MessageTally spyDetailedOn:[SystemBrowser open ] |
|
62 |
" |
|
63 |
! |
|
64 |
||
65 |
copyright |
|
66 |
" |
|
67 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
68 |
All Rights Reserved |
|
69 |
||
70 |
This software is furnished under a license and may be used |
|
71 |
only in accordance with the terms of that license and with the |
|
72 |
inclusion of the above copyright notice. This software may not |
|
73 |
be provided or otherwise made available to, or used by, any |
|
74 |
other person. No title to or ownership of the software is |
|
75 |
hereby transferred. |
|
76 |
" |
|
9 | 77 |
! ! |
0 | 78 |
|
79 |
!MessageTally class methodsFor:'instance creation'! |
|
80 |
||
21 | 81 |
spyOn:aBlock interval:ms |
0 | 82 |
"evaluate aBlock and output time statistic on Transcript" |
83 |
||
21 | 84 |
|runTime aTally nTally| |
0 | 85 |
|
86 |
aTally := self new. |
|
21 | 87 |
runTime := aTally spyOn:aBlock interval:ms. |
88 |
||
89 |
aTally tree isNil ifTrue:[ |
|
24 | 90 |
Transcript cr. |
91 |
Transcript showCr:'TALLY: No probes - execution time too short;'. |
|
92 |
Transcript showCr:'TALLY: retry using: spyOn:[n timesRepeat:[...]]'. |
|
21 | 93 |
] ifFalse:[ |
24 | 94 |
"/ aTally tree inspect. |
95 |
nTally := aTally nTally. |
|
96 |
Transcript cr. |
|
97 |
Transcript showCr:('total execution time: ' |
|
98 |
, runTime printString , ' ms ' |
|
99 |
, '(' , nTally printString , ' probes ;' |
|
100 |
, ' error >= ' |
|
101 |
, (1000 // nTally / 10.0) printString |
|
102 |
, '%)'). |
|
103 |
Transcript cr. |
|
104 |
aTally tree printOn:Transcript. |
|
105 |
Transcript cr. |
|
106 |
Transcript cr. |
|
0 | 107 |
|
24 | 108 |
Transcript showCr:'leafs of calling tree:'. |
109 |
Transcript cr. |
|
110 |
aTally tree printLeafsOn:Transcript. |
|
111 |
Transcript cr. |
|
21 | 112 |
|
24 | 113 |
" |
114 |
aTally statistics. |
|
115 |
" |
|
21 | 116 |
]. |
117 |
||
118 |
" |
|
119 |
MessageTally spyOn:[ #(6 5 4 3 2 1) sort ] |
|
120 |
MessageTally spyOn:[100 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
121 |
MessageTally spyOn:[1000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
122 |
MessageTally spyOn:[10000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
123 |
MessageTally spyOn:[100000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
124 |
MessageTally spyOn:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
125 |
MessageTally spyOn:[SystemBrowser open ] |
|
126 |
MessageTally spyDetailedOn:[SystemBrowser open ] |
|
127 |
Time millisecondsToRun:[500000 timesRepeat:[#(6 5 4 3 2 1) sort] ] |
|
128 |
" |
|
0 | 129 |
! |
130 |
||
21 | 131 |
spyDetailedOn:aBlock |
132 |
"evaluate aBlock and output time statistic on the Transcript. |
|
133 |
Tick is 1ms." |
|
0 | 134 |
|
21 | 135 |
^ self spyOn:aBlock interval:1 |
136 |
! |
|
0 | 137 |
|
21 | 138 |
spyOn:aBlock |
139 |
"evaluate aBlock and output time statistic on the Transcript. |
|
140 |
Tick is 10ms." |
|
141 |
||
142 |
^ self spyOn:aBlock interval:10 |
|
0 | 143 |
! ! |
144 |
||
145 |
!MessageTally methodsFor:'private'! |
|
146 |
||
21 | 147 |
execute |
148 |
theBlock value |
|
149 |
! ! |
|
0 | 150 |
|
21 | 151 |
!MessageTally methodsFor:'accessing'! |
0 | 152 |
|
21 | 153 |
tree |
154 |
^ tree |
|
0 | 155 |
! |
156 |
||
21 | 157 |
nTally |
158 |
^ ntally |
|
159 |
! ! |
|
160 |
||
161 |
!MessageTally methodsFor:'setup'! |
|
162 |
||
163 |
spyOn:aBlock interval:ms |
|
164 |
"spy on execution time" |
|
165 |
||
166 |
|startTime endTime running delay| |
|
167 |
||
168 |
theBlock := aBlock. |
|
0 | 169 |
|
21 | 170 |
Processor activeProcess withPriority:23 do:[ |
24 | 171 |
process := [ |
172 |
[ |
|
173 |
self execute |
|
174 |
] valueNowOrOnUnwindDo:[ |
|
175 |
running := false. |
|
176 |
theBlock := nil. |
|
177 |
] |
|
178 |
] newProcess. |
|
0 | 179 |
|
24 | 180 |
Processor activeProcess withPriority:24 do:[ |
181 |
startTime := OperatingSystem getMillisecondTime. |
|
182 |
delay := (Delay forMilliseconds:ms). |
|
0 | 183 |
|
24 | 184 |
ntally := 0. |
185 |
running := true. |
|
186 |
process resume. |
|
0 | 187 |
|
24 | 188 |
[running] whileTrue:[ |
189 |
delay wait. |
|
190 |
self count:process suspendedContext |
|
191 |
]. |
|
0 | 192 |
|
24 | 193 |
endTime := OperatingSystem getMillisecondTime. |
194 |
]. |
|
21 | 195 |
]. |
0 | 196 |
|
21 | 197 |
tree notNil ifTrue:[tree computePercentage:ntally]. |
198 |
^ endTime - startTime |
|
199 |
! ! |
|
200 |
||
201 |
!MessageTally methodsFor:'probes'! |
|
202 |
||
203 |
count:aContext |
|
204 |
|con chain info atEnd sender home| |
|
0 | 205 |
|
21 | 206 |
con := aContext. |
207 |
con isNil ifTrue:[^ self]. |
|
0 | 208 |
|
21 | 209 |
ntally := ntally + 1. |
210 |
"walk up above the interrupt context" |
|
211 |
||
212 |
[con receiver == Processor] whileTrue:[ |
|
213 |
con := con sender |
|
0 | 214 |
]. |
215 |
||
21 | 216 |
"got it - collect info from contexts" |
217 |
||
218 |
"walk up" |
|
219 |
||
220 |
con isNil ifTrue:[^ self]. |
|
221 |
||
222 |
atEnd := false. |
|
0 | 223 |
|
21 | 224 |
[atEnd] whileFalse:[ |
225 |
con isNil ifTrue:[ |
|
226 |
atEnd := true |
|
227 |
] ifFalse:[ |
|
228 |
sender := con sender. |
|
229 |
sender isNil ifTrue:[ |
|
230 |
atEnd := true |
|
231 |
] ifFalse:[ |
|
232 |
((sender receiver == self) and:[sender selector == #execute]) ifTrue:[ |
|
233 |
atEnd := true |
|
36 | 234 |
"/ ] ifFalse:[ |
235 |
"/ (sender isMemberOf:BlockContext) ifTrue:[ |
|
236 |
"/ sender sender selector == #execute ifTrue:[ |
|
237 |
"/ atEnd := true |
|
238 |
"/ ] |
|
239 |
"/ ] |
|
21 | 240 |
] |
241 |
] |
|
242 |
]. |
|
243 |
atEnd ifFalse:[ |
|
244 |
info := CallChain new. |
|
245 |
(con isMemberOf:BlockContext) ifTrue:[ |
|
246 |
home := con methodHome. |
|
247 |
home isNil ifTrue:[ |
|
248 |
info receiver:UndefinedObject |
|
249 |
selector:'optimized' |
|
250 |
class:UndefinedObject. |
|
251 |
] ifFalse:[ |
|
252 |
info receiver:home receiver class |
|
253 |
selector:home selector |
|
254 |
class:con methodClass. |
|
255 |
]. |
|
36 | 256 |
info isBlock:true. |
21 | 257 |
] ifFalse:[ |
258 |
info receiver:con receiver class |
|
259 |
selector:con selector |
|
260 |
class:con methodClass. |
|
261 |
]. |
|
262 |
info rest:chain. |
|
263 |
chain := info. |
|
264 |
con := sender |
|
265 |
] |
|
266 |
]. |
|
267 |
"add chain to the tree" |
|
268 |
||
269 |
chain isNil ifTrue:[^ self]. |
|
270 |
||
271 |
tree isNil ifTrue:[ |
|
272 |
tree := ProfileTree new. |
|
36 | 273 |
tree receiver:MessageTally |
274 |
selector:#execute |
|
275 |
class:MessageTally . |
|
0 | 276 |
]. |
277 |
||
21 | 278 |
tree addChain:chain |
279 |
! ! |
|
0 | 280 |