![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to profrep.tcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc|
Return to profrep.tcl CVS log | Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc |
1.1 root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.