Return to profrep.tcl CVS log

Up to [Micropolis - Activity] / micropolis / src / tclx / tclsrc

Annotation of micropolis/src/tclx/tclsrc/profrep.tcl, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.