1# 2# profrep -- 3# 4# Generate Tcl profiling reports. 5#------------------------------------------------------------------------------ 6# Copyright 1992-1999 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 1.1 2001/10/24 23:31:48 hobbs Exp $ 16#------------------------------------------------------------------------------ 17# 18 19#@package: TclX-profrep profrep 20 21namespace eval TclXProfRep { 22 23 # 24 # Convert the profile array from entries that have only the time spent in 25 # the proc to the time spend in the proc and all it calls. 26 # 27 proc sum {inDataVar outDataVar} { 28 upvar 1 $inDataVar inData $outDataVar outData 29 30 foreach inStack [array names inData] { 31 for {set idx 0} {![lempty [set part [lrange $inStack $idx end]]]} \ 32 {incr idx} { 33 if ![info exists outData($part)] { 34 set outData($part) {0 0 0} 35 } 36 lassign $outData($part) count real cpu 37 if {$idx == 0} { 38 incr count [lindex $inData($inStack) 0] 39 } 40 incr real [lindex $inData($inStack) 1] 41 incr cpu [lindex $inData($inStack) 2] 42 set outData($part) [list $count $real $cpu] 43 } 44 } 45 } 46 47 # 48 # Do sort comparison. May only be called by sort, as it address its 49 # local variables. 50 # 51 proc sortcmp {key1 key2} { 52 upvar profData profData keyIndex keyIndex 53 54 set val1 [lindex $profData($key1) $keyIndex] 55 set val2 [lindex $profData($key2) $keyIndex] 56 57 if {$val1 < $val2} { 58 return -1 59 } 60 if {$val1 > $val2} { 61 return 1 62 } 63 return 0 64 } 65 66 # 67 # Generate a list, sorted in descending order by the specified key, contain 68 # the indices into the summarized data. 69 # 70 proc sort {profDataVar sortKey} { 71 upvar $profDataVar profData 72 73 case $sortKey { 74 {calls} {set keyIndex 0} 75 {real} {set keyIndex 1} 76 {cpu} {set keyIndex 2} 77 default { 78 error "Expected a sort type of: `calls', `cpu' or ` real'" 79 } 80 } 81 82 return [lsort -integer -decreasing -command sortcmp \ 83 [array names profData]] 84 } 85 86 # 87 # Print the sorted report 88 # 89 proc print {profDataVar sortedProcList outFile userTitle} { 90 upvar $profDataVar profData 91 92 set maxNameLen 0 93 foreach procStack [array names profData] { 94 foreach procName $procStack { 95 set maxNameLen [max $maxNameLen [clength $procName]] 96 } 97 } 98 99 if {$outFile == ""} { 100 set outFH stdout 101 } else { 102 set outFH [open $outFile w] 103 } 104 105 # Output a header. 106 107 set stackTitle "Procedure Call Stack" 108 set maxNameLen [max [expr $maxNameLen+6] [expr [clength $stackTitle]+4]] 109 set hdr [format "%-${maxNameLen}s %10s %10s %10s" $stackTitle \ 110 "Calls" "Real Time" "CPU Time"] 111 if {$userTitle != ""} { 112 puts $outFH [replicate - [clength $hdr]] 113 puts $outFH $userTitle 114 } 115 puts $outFH [replicate - [clength $hdr]] 116 puts $outFH $hdr 117 puts $outFH [replicate - [clength $hdr]] 118 119 # Output the data in sorted order. Trim leading ::. 120 121 foreach procStack $sortedProcList { 122 set data $profData($procStack) 123 set cmd [lvarpop procStack] 124 regsub {^::} $cmd {} cmd 125 puts $outFH [format "%-${maxNameLen}s %10d %10d %10d" \ 126 $cmd [lindex $data 0] [lindex $data 1] \ 127 [lindex $data 2]] 128 foreach procName $procStack { 129 if {$procName == "<global>"} break 130 regsub {^::} $procName {} procName 131 puts $outFH " $procName" 132 } 133 } 134 if {$outFile != ""} { 135 close $outFH 136 } 137 } 138 139} ;# TclXProfRep 140 141#------------------------------------------------------------------------------ 142# Generate a report from data collect from the profile command. 143# o profDataVar (I) - The name of the array containing the data from profile. 144# o sortKey (I) - Value to sort by. One of "calls", "cpu" or "real". 145# o outFile (I) - Name of file to write the report to. If omitted, stdout 146# is assumed. 147# o userTitle (I) - Title line to add to output. 148 149proc profrep {profDataVar sortKey {outFile {}} {userTitle {}}} { 150 upvar $profDataVar profData 151 152 TclXProfRep::sum profData sumProfData 153 set sortedProcList [TclXProfRep::sort sumProfData $sortKey] 154 TclXProfRep::print sumProfData $sortedProcList $outFile $userTitle 155} 156 157 158