git.zerfleddert.de Git - micropolis/blob - src/tclx/tclsrc/profrep.tcl

   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 }