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