home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / profrep.tcl < prev    next >
Text File  |  1996-05-29  |  6KB  |  173 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1992 by Westmount Technology B.V., Delft, The Netherlands.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Westmount Technology B.V.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)profrep.tcl    1.3 (1.1)
  17. #    Author        : Karl Lehenbauer and Mark Diekhans
  18. #    Original date    : Tue Sep  1 16:24:28 MET DST 1992
  19. #    Description    : Tcl part of profile package
  20. #              extended with 'cpc': CPU time per call
  21. #
  22. #---------------------------------------------------------------------------
  23. #
  24. # @(#)profrep.tcl    1.3 (1.1)    15 May 1995 Copyright 1992 Westmount Technology
  25. #
  26. #---------------------------------------------------------------------------
  27. #@package: profrep profrep
  28.  
  29. # If this isn't Extended Tcl, define some support procs.
  30.  
  31. if {[info commands clength] == ""} {
  32.     proc clength {str} {return [string length $str]}
  33. }
  34. if {[info commands max] == ""} {
  35.     proc max {a b} {if {$a > $b} {return $a} else {return $b}}
  36. }
  37.  
  38. if {[info commands replicate] == ""} {
  39.     proc replicate {str cnt} {
  40.         set result {}
  41.         for {set i 0} {$i < $cnt} {incr i} {
  42.             append result $str
  43.         }
  44.     }
  45. }
  46.  
  47. #
  48. # Summarize the data from the profile command to the specified significant
  49. # stack depth.  Returns the maximum number of characters of any significant
  50. # stack.  (useful in columnizing reports).
  51. #
  52. proc profrep:summarize {profDataVar stackDepth sumProfDataVar} {
  53.     upvar $profDataVar profData $sumProfDataVar sumProfData
  54.  
  55.     if {(![info exists profData]) || ([catch {array size profData}] != 0)} {
  56.         error "`profDataVar' must be the name of an array returned by the `profile off' command"
  57.     }
  58.     set maxNameLen 0
  59.     foreach procStack [array names profData] {
  60.         if {[llength $procStack] < $stackDepth} {
  61.             set sigProcStack $procStack
  62.         } else {
  63.             set sigProcStack [lrange $procStack 0 [expr {$stackDepth - 1}]]
  64.         }
  65.         set maxNameLen [max $maxNameLen [clength $sigProcStack]]
  66.         if [info exists sumProfData($sigProcStack)] {
  67.             set cur $sumProfData($sigProcStack)
  68.             set add $profData($procStack)
  69.             set     new [expr [lindex $cur 0]+[lindex $add 0]]
  70.             lappend new [expr [lindex $cur 1]+[lindex $add 1]]
  71.             lappend new [expr [lindex $cur 2]+[lindex $add 2]]
  72.             set sumProfData($sigProcStack) $new
  73.         } else {
  74.             set sumProfData($sigProcStack) $profData($procStack)
  75.         }
  76.     }
  77.     return $maxNameLen
  78. }
  79.  
  80. #
  81. # Generate a list, sorted in descending order by the specified key, contain
  82. # the indices into the summarized data.
  83. #
  84. proc profrep:sort {sumProfDataVar sortKey} {
  85.     upvar $sumProfDataVar sumProfData
  86.  
  87.     case $sortKey {
  88.         {calls} {set keyIndex 0}
  89.         {real}  {set keyIndex 1}
  90.         {cpu}   {set keyIndex 2}
  91.         {cpc}   {set keyIndex 3}
  92.         default {
  93.             error "Expected a sort of: `calls', `cpu', `cpc'  or ` real'"}
  94.     }
  95.  
  96.     # Build a list to sort cosisting of a fix-length string containing the
  97.     # key value and proc stack. Then sort it.
  98.  
  99.     foreach procStack [array names sumProfData] {
  100.     set calls [lindex $sumProfData($procStack) 0]
  101.     set cpu [lindex $sumProfData($procStack) 2]
  102.     lappend sumProfData($procStack) [expr $cpu/$calls]
  103.         set key [format "%016d" [lindex $sumProfData($procStack) $keyIndex]]
  104.         lappend keyProcList [list $key $procStack]
  105.     }
  106.     set keyProcList [lsort $keyProcList]
  107.  
  108.     # Convert the assending sorted list into a descending list of proc stacks.
  109.  
  110.     for {set idx [expr [llength $keyProcList]-1]} {$idx >= 0} {incr idx -1} {
  111.         lappend sortedProcList [lindex [lindex $keyProcList $idx] 1]
  112.     }
  113.     return $sortedProcList
  114. }
  115.  
  116. #
  117. # Print the sorted report
  118. #
  119.  
  120. proc profrep:print {sumProfDataVar sortedProcList maxNameLen outFile
  121.                     userTitle} {
  122.     upvar $sumProfDataVar sumProfData
  123.     
  124.     if {$outFile == ""} {
  125.         set outFH stdout
  126.     } else {
  127.         set outFH [open $outFile w]
  128.     }
  129.  
  130.     # Output a header.
  131.  
  132.     set stackTitle "Procedure Call Stack"
  133.     set maxNameLen [max $maxNameLen [clength $stackTitle]]
  134.     set hdr [format "%-${maxNameLen}s %10s %10s %10s %10s" $stackTitle \
  135.                     "Calls" "Real Time" "CPU Time" "CPU/Call"]
  136.     if {$userTitle != ""} {
  137.         puts $outFH [replicate - [clength $hdr]]
  138.         puts $outFH $userTitle
  139.     }
  140.     puts $outFH [replicate - [clength $hdr]]
  141.     puts $outFH $hdr
  142.     puts $outFH [replicate - [clength $hdr]]
  143.  
  144.     # Output the data in sorted order.
  145.  
  146.     foreach procStack $sortedProcList {
  147.         set data $sumProfData($procStack)
  148.         puts $outFH [format "%-${maxNameLen}s %10d %10d %10d %10d" $procStack \
  149.         [lindex $data 0] [lindex $data 1] [lindex $data 2] [lindex $data 3]]
  150.     }
  151.     if {$outFile != ""} {
  152.         close $outFH
  153.     }
  154. }
  155.  
  156. #------------------------------------------------------------------------------
  157. # Generate a report from data collect from the profile command.
  158. #   o profDataVar (I) - The name of the array containing the data from profile.
  159. #   o sortKey (I) - Value to sort by. One of "calls", "cpu" or "real".
  160. #   o stackDepth (I) - The stack depth to consider significant.
  161. #   o outFile (I) - Name of file to write the report to.  If omitted, stdout
  162. #     is assumed.
  163. #   o userTitle (I) - Title line to add to output.
  164.  
  165. proc profrep {profDataVar sortKey stackDepth {outFile {}} {userTitle {}}} {
  166.     upvar $profDataVar profData
  167.  
  168.     set maxNameLen [profrep:summarize profData $stackDepth sumProfData]
  169.     set sortedProcList [profrep:sort sumProfData $sortKey]
  170.     profrep:print sumProfData $sortedProcList $maxNameLen $outFile $userTitle
  171.  
  172. }
  173.