]>
Commit | Line | Data |
---|---|---|
1 | # | |
2 | # profrep -- | |
3 | # | |
4 | # Generate Tcl profiling reports. | |
5 | #------------------------------------------------------------------------------ | |
6 | # Copyright 1992 Karl Lehenbauer and Mark Diekhans. | |
7 | # | |
8 | # Permission to use, copy, modify, and distribute this software and its | |
9 | # documentation for any purpose and without fee is hereby granted, provided | |
10 | # that the above copyright notice appear in all copies. Karl Lehenbauer and | |
11 | # Mark Diekhans make no representations about the suitability of this | |
12 | # software for any purpose. It is provided "as is" without express or | |
13 | # implied warranty. | |
14 | #------------------------------------------------------------------------------ | |
15 | # $Id: profrep.tcl,v 2.0 1992/10/16 04:52:05 markd Rel $ | |
16 | #------------------------------------------------------------------------------ | |
17 | # | |
18 | ||
19 | #@package: TclX-profrep profrep | |
20 | ||
21 | # | |
22 | # Summarize the data from the profile command to the specified significant | |
23 | # stack depth. Returns the maximum number of characters of any significant | |
24 | # stack. (useful in columnizing reports). | |
25 | # | |
26 | proc profrep:summarize {profDataVar stackDepth sumProfDataVar} { | |
27 | upvar $profDataVar profData $sumProfDataVar sumProfData | |
28 | ||
29 | if {(![info exists profData]) || ([catch {array size profData}] != 0)} { | |
30 | error "`profDataVar' must be the name of an array returned by the `profile off' command" | |
31 | } | |
32 | set maxNameLen 0 | |
33 | foreach procStack [array names profData] { | |
34 | if {[llength $procStack] < $stackDepth} { | |
35 | set sigProcStack $procStack | |
36 | } else { | |
37 | set sigProcStack [lrange $procStack 0 [expr {$stackDepth - 1}]] | |
38 | } | |
39 | set maxNameLen [max $maxNameLen [clength $sigProcStack]] | |
40 | if [info exists sumProfData($sigProcStack)] { | |
41 | set cur $sumProfData($sigProcStack) | |
42 | set add $profData($procStack) | |
43 | set new [expr [lindex $cur 0]+[lindex $add 0]] | |
44 | lappend new [expr [lindex $cur 1]+[lindex $add 1]] | |
45 | lappend new [expr [lindex $cur 2]+[lindex $add 2]] | |
46 | set $sumProfData($sigProcStack) $new | |
47 | } else { | |
48 | set sumProfData($sigProcStack) $profData($procStack) | |
49 | } | |
50 | } | |
51 | return $maxNameLen | |
52 | } | |
53 | ||
54 | # | |
55 | # Generate a list, sorted in descending order by the specified key, contain | |
56 | # the indices into the summarized data. | |
57 | # | |
58 | proc profrep:sort {sumProfDataVar sortKey} { | |
59 | upvar $sumProfDataVar sumProfData | |
60 | ||
61 | case $sortKey { | |
62 | {calls} {set keyIndex 0} | |
63 | {real} {set keyIndex 1} | |
64 | {cpu} {set keyIndex 2} | |
65 | default { | |
66 | error "Expected a sort of: `calls', `cpu' or ` real'"} | |
67 | } | |
68 | ||
69 | # Build a list to sort cosisting of a fix-length string containing the | |
70 | # key value and proc stack. Then sort it. | |
71 | ||
72 | foreach procStack [array names sumProfData] { | |
73 | set key [format "%016d" [lindex $sumProfData($procStack) $keyIndex]] | |
74 | lappend keyProcList [list $key $procStack] | |
75 | } | |
76 | set keyProcList [lsort $keyProcList] | |
77 | ||
78 | # Convert the assending sorted list into a descending list of proc stacks. | |
79 | ||
80 | for {set idx [expr [llength $keyProcList]-1]} {$idx >= 0} {incr idx -1} { | |
81 | lappend sortedProcList [lindex [lindex $keyProcList $idx] 1] | |
82 | } | |
83 | return $sortedProcList | |
84 | } | |
85 | ||
86 | # | |
87 | # Print the sorted report | |
88 | # | |
89 | ||
90 | proc profrep:print {sumProfDataVar sortedProcList maxNameLen outFile | |
91 | userTitle} { | |
92 | upvar $sumProfDataVar sumProfData | |
93 | ||
94 | if {$outFile == ""} { | |
95 | set outFH stdout | |
96 | } else { | |
97 | set outFH [open $outFile w] | |
98 | } | |
99 | ||
100 | # Output a header. | |
101 | ||
102 | set stackTitle "Procedure Call Stack" | |
103 | set maxNameLen [max $maxNameLen [clength $stackTitle]] | |
104 | set hdr [format "%-${maxNameLen}s %10s %10s %10s" $stackTitle \ | |
105 | "Calls" "Real Time" "CPU Time"] | |
106 | if {$userTitle != ""} { | |
107 | puts $outFH [replicate - [clength $hdr]] | |
108 | puts $outFH $userTitle | |
109 | } | |
110 | puts $outFH [replicate - [clength $hdr]] | |
111 | puts $outFH $hdr | |
112 | puts $outFH [replicate - [clength $hdr]] | |
113 | ||
114 | # Output the data in sorted order. | |
115 | ||
116 | foreach procStack $sortedProcList { | |
117 | set data $sumProfData($procStack) | |
118 | puts $outFH [format "%-${maxNameLen}s %10d %10d %10d" $procStack \ | |
119 | [lindex $data 0] [lindex $data 1] [lindex $data 2]] | |
120 | } | |
121 | if {$outFile != ""} { | |
122 | close $outFH | |
123 | } | |
124 | } | |
125 | ||
126 | #------------------------------------------------------------------------------ | |
127 | # Generate a report from data collect from the profile command. | |
128 | # o profDataVar (I) - The name of the array containing the data from profile. | |
129 | # o sortKey (I) - Value to sort by. One of "calls", "cpu" or "real". | |
130 | # o stackDepth (I) - The stack depth to consider significant. | |
131 | # o outFile (I) - Name of file to write the report to. If omitted, stdout | |
132 | # is assumed. | |
133 | # o userTitle (I) - Title line to add to output. | |
134 | ||
135 | proc profrep {profDataVar sortKey stackDepth {outFile {}} {userTitle {}}} { | |
136 | upvar $profDataVar profData | |
137 | ||
138 | set maxNameLen [profrep:summarize profData $stackDepth sumProfData] | |
139 | set sortedProcList [profrep:sort sumProfData $sortKey] | |
140 | profrep:print sumProfData $sortedProcList $maxNameLen $outFile $userTitle | |
141 | ||
142 | } |