]> git.zerfleddert.de Git - micropolis/blame - src/tclx/tclsrc/profrep.tcl
Avoid SIGLOST==SIGPWR namespace collision on sparc (LP: #505080).
[micropolis] / src / tclx / tclsrc / profrep.tcl
CommitLineData
6a5fa4e0
MG
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#
26proc 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#
58proc 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
90proc 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
135proc 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}
Impressum, Datenschutz