1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
#!/bin/sh
# vim:set ft=tcl: \
exec tclsh "$0" "$@"
#=================================================================
# TIME PROFILER
# by [Barney Blankenship] (based on work by [George Peter Staplin])
#
# Insert this snippet above the function definitions you want
# to have profiled.
#
# TO INITIALIZE OR CLEAR/RESET THE PROFILER...
# global TimeProfilerMode
# if { [info exists TimeProfilerMode] } {
# global ProfilerArray
# array unset ProfilerArray
# }
#
# TO PRODUCE THE OUTPUT (currently hard-coded to "TimingDump.txt"
# file output "append" in the current working directory)...
# global TimeProfilerMode
# if { [info exists TimeProfilerMode] } {
# TimeProfilerDump description
# }
# (description: text string shown at the top of the output)
#
# PROFILING DATA COLLECTION
# (This describes what is included in the output)
# Provides total elapsed time in milliseconds between reset and dump.
# Provides function call statistics...
# for each function defined after this snippet, provide...
# Number of times called
# Average milliseconds per call
# Maximum milliseconds call time
# Minimum milliseconds call time
# Total milliseconds used
# Ratio of above to total elapsed time (XX.XXX percent)
# In addition, the function call statistics are sorted
# in descending values of Ratio (above).
#
# Note that nested functions and functions that use
# recursion are provided for and timed properly.
#
# TO DISABLE PROFILING WITHOUT REMOVING THE PROFILER
# Comment out the "set TimeProfilerMode 0" below...
#=================================================================
global TimeProfilerMode
set TimeProfilerMode 0
if { [info exists TimeProfilerMode] } {
proc TimeProfiler {args} {
global ProfilerArray
# Intialize the elapsed time counters if needed...
if { ![info exists ProfilerArray(ElapsedClicks)] } {
set ProfilerArray(ElapsedClicks) [expr double([clock clicks])]
set ProfilerArray(Elapsedms) [expr double([clock clicks -milliseconds])]
}
set fun [lindex [lindex $args 0] 0]
if { [lindex $args end] == "enter" } {
# Initalize the count of functions if needed...
if { ![info exists ProfilerArray(funcount)] } {
set ProfilerArray(funcount) 0
}
# See if this function is here for the first time...
for { set fi 0 } { $fi < $ProfilerArray(funcount) } { incr fi } {
if { [string equal $ProfilerArray($fi) $fun] } {
break
}
}
if { $fi == $ProfilerArray(funcount) } {
# Yes, function first time visit, add...
set ProfilerArray($fi) $fun
set ProfilerArray(funcount) [expr $fi + 1]
}
# Intialize the "EnterStack" if needed...
if { ![info exists ProfilerArray(ES0)] } {
set esi 1
} else {
set esi [expr $ProfilerArray(ES0) + 1]
}
# Append a "enter clicks" and "enter function name index" to the EnterStack...
set ProfilerArray(ES0) $esi
set ProfilerArray(ES$esi) [clock clicks]
# Note: the above is last thing done so timing start is closest to
# function operation start as possible.
} else {
# Right away stop timing...
set deltaclicks [clock clicks]
# Do not bother if TimeProfilerDump wiped the ProfilerArray
# just prior to this "leave"...
if { [info exists ProfilerArray(ES0)] } {
# Pull an "enter clicks" off the EnterStack...
set esi $ProfilerArray(ES0)
set deltaclicks [expr $deltaclicks - $ProfilerArray(ES$esi)]
incr esi -1
set ProfilerArray(ES0) $esi
# Correct for recursion and nesting...
if { $esi } {
# Add our elapsed clicks to the previous stacked values to compensate...
for { set fix $esi } { $fix > 0 } { incr fix -1 } {
set ProfilerArray(ES$fix) [expr $ProfilerArray(ES$fix) + $deltaclicks]
}
}
# Intialize the delta clicks array if needed...
if { ![info exists ProfilerArray($fun,0)] } {
set cai 1
} else {
set cai [expr $ProfilerArray($fun,0) + 1]
}
# Add another "delta clicks" reading...
set ProfilerArray($fun,0) $cai
set ProfilerArray($fun,$cai) $deltaclicks
}
}
}
proc TimeProfilerDump {description} {
global ProfilerArray
# Stop timing elapsed time and calculate conversion factor for clicks to ms...
set EndClicks [expr {double([clock clicks]) - $ProfilerArray(ElapsedClicks)}]
set Endms [expr {double([clock clicks -milliseconds]) - $ProfilerArray(Elapsedms)}]
set msPerClick [expr $Endms / $EndClicks]
# Visit each function and generate the statistics for it...
for { set fi 0 ; set PerfList "" } { $fi < $ProfilerArray(funcount) } { incr fi } {
set fun $ProfilerArray($fi)
if { ![info exists ProfilerArray($fun,0)] } {
continue
}
for { set max -1.0 ; set min -1.0 ; set ctotal 0.0 ; set cai 1 } { $cai <= $ProfilerArray($fun,0) } { incr cai } {
set clicks $ProfilerArray($fun,$cai)
set ctotal [expr {$ctotal + double($clicks)}]
if { $max < 0 || $max < $clicks } {
set max $clicks
}
if { $min < 0 || $clicks < $min } {
set min $clicks
}
}
set cavg [expr {$ctotal / double($ProfilerArray($fun,0))}]
set ProfilerArray($fun,avgms) [expr $cavg * $msPerClick]
set ProfilerArray($fun,totalms) [expr $ctotal * $msPerClick]
set ProfilerArray($fun,ratio) [expr {double($ctotal / $EndClicks) * 100.0}]
set ProfilerArray($fun,max) [expr $max * $msPerClick]
set ProfilerArray($fun,min) [expr $min * $msPerClick]
# Append to the sorting list the pairs of ratio values and function indexes...
lappend PerfList [list $ProfilerArray($fun,ratio) $fi]
}
# Sort the profile data by Ratio...
set PerfList [lsort -real -decreasing -index 0 $PerfList]
# Finally, generate the results...
set fd [open "TimingDump.txt" a]
puts $fd "\n===================================================================="
puts $fd [format " T I M I N G D U M P <%s>" $description]
puts $fd [format "\n Elapsed time: %.0f ms" $Endms]
puts $fd [format "\n %s" [clock format [clock seconds]]]
puts $fd "===================================================================="
for { set li 0 } { $li < [llength $PerfList] } { incr li } {
set fun $ProfilerArray([lindex [lindex $PerfList $li] 1])
puts $fd [format ">>>>> FUNCTION: %s" $fun]
puts $fd [format " CALLS: %d" $ProfilerArray($fun,0)]
puts $fd [format " AVG TIME: %.3f ms" $ProfilerArray($fun,avgms)]
puts $fd [format " MAX TIME: %.3f ms" $ProfilerArray($fun,max)]
puts $fd [format " MIN TIME: %.3f ms" $ProfilerArray($fun,min)]
puts $fd [format " TOTAL TIME: %.3f ms" $ProfilerArray($fun,totalms)]
puts $fd [format " RATIO: %.3f%c\n" $ProfilerArray($fun,ratio) 37]
}
close $fd
# Reset the world...
array unset ProfilerArray
}
#=================================================================
# Overload "proc" so that functions defined after
# this point have added trace handlers for entry and exit.
# [George Peter Staplin]
#=================================================================
rename proc _proc
_proc proc {name arglist body} {
#===================================
# Allow multiple namespace use [JMN]
if { ![string match ::* $name] } {
# Not already an 'absolute' namespace path,
# qualify it so that traces can find it...
set name [uplevel 1 namespace current]::[set name]
}
#===================================
_proc $name $arglist $body
trace add execution $name enter TimeProfiler
trace add execution $name leave TimeProfiler
}
}
|
