home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / tclsrc / profrep.tcl < prev    next >
Encoding:
Text File  |  1994-07-16  |  3.8 KB  |  125 lines
  1. #
  2. # profrep  --
  3. #
  4. # Generate Tcl profiling reports.
  5. #------------------------------------------------------------------------------
  6. # Copyright 1992-1994 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 4.0 1994/07/16 05:29:55 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. #@package: TclX-profrep profrep
  20.  
  21. #
  22. # Do sort comparison.  May only be called by profrep:sort, as it address its
  23. # local variables.
  24. #
  25. proc profrep:sortcmp {key1 key2} {
  26.     upvar profData profData keyIndex keyIndex
  27.     
  28.     set val1 [lindex $profData($key1) $keyIndex]
  29.     set val2 [lindex $profData($key2) $keyIndex]
  30.  
  31.     if {$val1 < $val2} {
  32.         return -1
  33.     }
  34.     if {$val1 > $val2} {
  35.         return 1
  36.     }
  37.     return 0
  38. }
  39.  
  40. #
  41. # Generate a list, sorted in descending order by the specified key, contain
  42. # the indices into the summarized data.
  43. #
  44. proc profrep:sort {profDataVar sortKey} {
  45.     upvar $profDataVar profData
  46.  
  47.     case $sortKey {
  48.         {calls} {set keyIndex 0}
  49.         {real}  {set keyIndex 1}
  50.         {cpu}   {set keyIndex 2}
  51.         default {
  52.             error "Expected a sort type of: `calls', `cpu' or ` real'"
  53.         }
  54.     }
  55.  
  56.     return [lsort -integer -decreasing -command profrep:sortcmp \
  57.             [array names profData]]
  58. }
  59.  
  60. #
  61. # Print the sorted report
  62. #
  63. proc profrep:print {profDataVar sortedProcList outFile userTitle} {
  64.     upvar $profDataVar profData
  65.     
  66.     set maxNameLen 0
  67.     foreach procStack [array names profData] {
  68.         foreach procName $procStack {
  69.             set maxNameLen [max $maxNameLen [clength $procName]]
  70.         }
  71.     }
  72.  
  73.     if {$outFile == ""} {
  74.         set outFH stdout
  75.     } else {
  76.         set outFH [open $outFile w]
  77.     }
  78.  
  79.     # Output a header.
  80.  
  81.     set stackTitle "Procedure Call Stack"
  82.     set maxNameLen [max [expr $maxNameLen+6] [expr [clength $stackTitle]+4]]
  83.     set hdr [format "%-${maxNameLen}s %10s %10s %10s" $stackTitle \
  84.                     "Calls" "Real Time" "CPU Time"]
  85.     if {$userTitle != ""} {
  86.         puts $outFH [replicate - [clength $hdr]]
  87.         puts $outFH $userTitle
  88.     }
  89.     puts $outFH [replicate - [clength $hdr]]
  90.     puts $outFH $hdr
  91.     puts $outFH [replicate - [clength $hdr]]
  92.  
  93.     # Output the data in sorted order.
  94.  
  95.     foreach procStack $sortedProcList {
  96.         set data $profData($procStack)
  97.         puts $outFH [format "%-${maxNameLen}s %10d %10d %10d" \
  98.                             [lvarpop procStack] \
  99.                             [lindex $data 0] [lindex $data 1] [lindex $data 2]]
  100.         foreach procName $procStack {
  101.             if {$procName == "<global>"} break
  102.             puts $outFH "    $procName"
  103.         }
  104.     }
  105.     if {$outFile != ""} {
  106.         close $outFH
  107.     }
  108. }
  109.  
  110. #------------------------------------------------------------------------------
  111. # Generate a report from data collect from the profile command.
  112. #   o profDataVar (I) - The name of the array containing the data from profile.
  113. #   o sortKey (I) - Value to sort by. One of "calls", "cpu" or "real".
  114. #   o outFile (I) - Name of file to write the report to.  If omitted, stdout
  115. #     is assumed.
  116. #   o userTitle (I) - Title line to add to output.
  117.  
  118. proc profrep {profDataVar sortKey {outFile {}} {userTitle {}}} {
  119.     upvar $profDataVar profData
  120.  
  121.     set sortedProcList [profrep:sort profData $sortKey]
  122.     profrep:print profData $sortedProcList $outFile $userTitle
  123.  
  124. }
  125.