| 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 | } |