My favorites | Sign in
Project Home Wiki Issues Source
Checkout   Browse   Changes  
Changes to /trunk/bin/fprofpp
r3 vs. r6 Compare: vs.  Format:
Revision r6
Go to: 
Project members, sign in to write a code review
/trunk/bin/fprofpp   r3 /trunk/bin/fprofpp   r6
1 #!/usr/bin/perl 1 #!/usr/bin/perl
2 2
3 use warnings; 3 use warnings;
4 use strict; 4 use strict;
5 5
6 our $VERSION = '0.08';
7
6 use Devel::FastProf::Reader; 8 use Devel::FastProf::Reader;
7 use Sort::Key qw(rikeysort rnkeysort); 9 use Sort::Key qw(rikeysort rnkeysort);
8 10
9 use Getopt::Std; 11 use Getopt::Std;
12 $Getopt::Std::STANDARD_HELP_VERSION = 1;
10 13
11 our ($opt_f, $opt_r, $opt_t, $opt_g, $opt_e, $opt_p, $opt_H); 14 our ($opt_f, $opt_r, $opt_t, $opt_g, $opt_e, $opt_p, $opt_H);
12 getopts("f:t:rgepH"); 15 getopts("f:t:rgepH");
13 16
14 my $fpfn = defined $opt_f ? $opt_f : "fastprof.out"; 17 my $fpfn = defined $opt_f ? $opt_f : "fastprof.out";
15 18
16 read_fastprof($fpfn); 19 read_fastprof($fpfn);
17 20
18 # we make it look always as if forking info was there: 21 # we make it look always as if forking info was there:
19 %FPIDMAP = map { ("0:$_" => $_) } (1..$#FN) unless %FPIDMAP; 22 %FPIDMAP = map { ("0:$_" => $_) } (1..$#FN) unless %FPIDMAP;
20 23
21 my (@pid, @ofid, @pfn, @rfpidmap, %rpfn); 24 my (@pid, @ofid, @pfn, @rfpidmap, %rpfn);
22 25
23 for (keys %FPIDMAP) { 26 for (keys %FPIDMAP) {
24 my $fid = $FPIDMAP{$_}; 27 my $fid = $FPIDMAP{$_};
25 $rfpidmap[$fid] = $_; 28 $rfpidmap[$fid] = $_;
26 ($pid[$fid], $ofid[$fid]) = split(/:/) 29 ($pid[$fid], $ofid[$fid]) = split(/:/)
27 } 30 }
28 31
29 sub fill_data_for_fid { 32 sub fill_data_for_fid {
30 my $fid = shift; 33 my $fid = shift;
31 # print "filling data for $fid\n"; 34 # print "filling data for $fid\n";
32 my $pid = $pid[$fid]; 35 my $pid = $pid[$fid];
33 my $fn = $FN[$fid]; 36 my $fn = $FN[$fid];
34 if (defined $fn) { 37 if (defined $fn) {
35 my $pfn = "${pid}:$fn"; 38 my $pfn = "${pid}:$fn";
36 $pfn[$fid] = $pfn; 39 $pfn[$fid] = $pfn;
37 $rpfn{$pfn} = $fid; 40 $rpfn{$pfn} = $fid;
38 41
39 if ($fn =~ /^\((?:re_)?eval \d+\)/) { 42 if ($fn =~ /^\((?:re_)?eval \d+\)/) {
40 } 43 }
41 else { 44 else {
42 if ( $fn ne '-e' 45 if ( $fn ne '-e'
43 and open SRC, "<", $fn) { 46 and open SRC, "<", $fn) {
44 # load the source file 47 # load the source file
45 my @lines = ('', <SRC>); 48 my @lines = ('', <SRC>);
46 close SRC; 49 close SRC;
47 $SRC[$fid] = \@lines; 50 $SRC[$fid] = \@lines;
48 } 51 }
49 } 52 }
50 } 53 }
51 else { 54 else {
52 # them look for the file definition on the ancestor processes 55 # them look for the file definition on the ancestor processes
53 my $ppid = $pid; 56 my $ppid = $pid;
54 while (defined ($ppid = $PPID{$ppid})) { 57 while (defined ($ppid = $PPID{$ppid})) {
55 # printf "ppid = $ppid\n"; 58 # printf "ppid = $ppid\n";
56 my $pfid = $FPIDMAP{"${ppid}:$ofid[$fid]"}; 59 my $pfid = $FPIDMAP{"${ppid}:$ofid[$fid]"};
57 $fn = $FN[$pfid]; 60 $fn = $FN[$pfid];
58 if (defined $fn) { 61 if (defined $fn) {
59 $fn = $FN[$fid] = $fn; 62 $fn = $FN[$fid] = $fn;
60 $SRC[$fid] = $SRC[$pfid]; 63 $SRC[$fid] = $SRC[$pfid];
61 $pfn[$fid] = $pfn[$pfid]; 64 $pfn[$fid] = $pfn[$pfid];
62 $rpfn{"${pid}:$fn"} = $fid; 65 $rpfn{"${pid}:$fn"} = $fid;
63 # print "${pid}:$fn => $fid\n"; 66 # print "${pid}:$fn => $fid\n";
64 last; 67 last;
65 } 68 }
66 } 69 }
67 } 70 }
68 } 71 }
69 72
70 fill_data_for_fid $_ for (1..$#FN); 73 fill_data_for_fid $_ for (1..$#FN);
71 74
72 my (@efid, @eline); 75 my (@efid, @eline);
73 my $fid; 76 my $fid;
74 for ($fid = 1; $fid < @FN; ++$fid) { 77 for ($fid = 1; $fid < @FN; ++$fid) {
75 # print "indirecting evals for $fid\n"; 78 # print "indirecting evals for $fid\n";
76 my $fn = $FN[$fid]; 79 my $fn = $FN[$fid];
77 if (my ($efn, $el) = $fn =~ /^\((?:re_)?eval \d+\)\[(.*):(\d+)\]$/) { 80 if (my ($efn, $el) = $fn =~ /^\((?:re_)?eval \d+\)\[(.*):(\d+)\]$/) {
78 my $pid = $pid[$fid]; 81 my $pid = $pid[$fid];
79 my $ppid = $pid; 82 my $ppid = $pid;
80 while (defined $ppid) { 83 while (defined $ppid) {
81 # printf "ppid = $ppid\n"; 84 # printf "ppid = $ppid\n";
82 my $pfn = "${ppid}:$efn"; 85 my $pfn = "${ppid}:$efn";
83 if (defined (my $efid = $rpfn{$pfn})) { 86 if (defined (my $efid = $rpfn{$pfn})) {
84 if ($ppid != $pid) { 87 if ($ppid != $pid) {
85 push @FN, undef; 88 push @FN, undef;
86 $FPIDMAP{"${pid}:$ofid[$efid]"} = $efid; 89 $FPIDMAP{"${pid}:$ofid[$efid]"} = $efid;
87 fill_data_for_fid $#FN; 90 fill_data_for_fid $#FN;
88 } 91 }
89 $efid[$fid] = $efid; 92 $efid[$fid] = $efid;
90 $eline[$fid] = $el; 93 $eline[$fid] = $el;
91 last; 94 last;
92 } 95 }
93 $ppid = $PPID{$ppid}; 96 $ppid = $PPID{$ppid};
94 97
95 } 98 }
96 } 99 }
97 } 100 }
98 101
99 # print "here1\n"; 102 # print "here1\n";
100 103
101 if ($opt_e) { 104 if ($opt_e) {
102 for ((keys %COUNT)) { 105 for ((keys %COUNT)) {
103 my ($fid, $line) = split /:/; 106 my ($fid, $line) = split /:/;
104 if (defined $efid[$fid]) { 107 if (defined $efid[$fid]) {
105 my $efid; 108 my $efid;
106 while (defined($efid = $efid[$fid])) { 109 while (defined($efid = $efid[$fid])) {
107 $line = $eline[$fid]; 110 $line = $eline[$fid];
108 $fid = $efid; 111 $fid = $efid;
109 } 112 }
110 my $key = "${fid}:$line"; 113 my $key = "${fid}:$line";
111 $COUNT{$key} += delete $COUNT{$_}; 114 $COUNT{$key} += delete $COUNT{$_};
112 $TICKS{$key} += delete $TICKS{$_}; 115 $TICKS{$key} += delete $TICKS{$_};
113 } 116 }
114 } 117 }
115 } 118 }
116 119
117 if ($opt_g) { 120 if ($opt_g) {
118 for ((keys %COUNT)) { 121 for ((keys %COUNT)) {
119 my ($fid, $line) = split /:/; 122 my ($fid, $line) = split /:/;
120 my $pid = $pid[$fid]; 123 my $pid = $pid[$fid];
121 my $pfn = $pfn[$fid]; 124 my $pfn = $pfn[$fid];
122 my $ffid = $rpfn{$pfn}; 125 my $ffid = $rpfn{$pfn};
123 if ($ffid != $fid) { 126 if ($ffid != $fid) {
124 my $key = "${ffid}:$line"; 127 my $key = "${ffid}:$line";
125 $COUNT{$key} += delete $COUNT{$_}; 128 $COUNT{$key} += delete $COUNT{$_};
126 $TICKS{$key} += delete $TICKS{$_}; 129 $TICKS{$key} += delete $TICKS{$_};
127 } 130 }
128 } 131 }
129 } 132 }
130 133
131 # print "here2\n"; 134 # print "here2\n";
132 135
133 my @keys = ( $opt_r 136 my @keys = ( $opt_r
134 ? (rikeysort { $COUNT{$_} } keys %COUNT) 137 ? (rikeysort { $COUNT{$_} } keys %COUNT)
135 : (rnkeysort { $TICKS{$_} } keys %COUNT) ); 138 : (rnkeysort { $TICKS{$_} } keys %COUNT) );
136 139
137 if (!$opt_H) { 140 if (!$opt_H) {
138 print "# fprofpp output format is:\n"; 141 print "# fprofpp output format is:\n";
139 print($opt_p 142 print($opt_p
140 ? "# filename:line [pid parent] time count: source\n" 143 ? "# filename:line [pid parent] time count: source\n"
141 : "# filename:line time count: source\n" ); 144 : "# filename:line time count: source\n" );
142 } 145 }
143 146
144 my $n = 0; 147 my $n = 0;
145 for my $key (@keys) { 148 for my $key (@keys) {
146 $n++; 149 $n++;
147 last if (defined $opt_t and $n > $opt_t); 150 last if (defined $opt_t and $n > $opt_t);
148 my ($fid, $line) = split /:/, $key; 151 my ($fid, $line) = split /:/, $key;
149 152
150 my $lines = $SRC[$fid]; 153 my $lines = $SRC[$fid];
151 my $src = $lines ? $lines->[$line] : '???'; 154 my $src = $lines ? $lines->[$line] : '???';
152 $src =~ s/^\s+//; 155 $src =~ s/^\s+//;
153 chomp $src; 156 chomp $src;
154 157
155 my @path; 158 my @path;
156 my $efid; 159 my $efid;
157 while (defined($efid = $efid[$fid])) { 160 while (defined($efid = $efid[$fid])) {
158 # print "$fid, $efid: at line $line inside eval\n"; 161 # print "$fid, $efid: at line $line inside eval\n";
159 push @path, "at line $line inside eval"; 162 push @path, "at line $line inside eval";
160 $line = $eline[$fid]; 163 $line = $eline[$fid];
161 $fid = $efid; 164 $fid = $efid;
162 } 165 }
163 if (@path) { 166 if (@path) {
164 $src = '['.join(' ', @path).'] '. $src; 167 $src = '['.join(' ', @path).'] '. $src;
165 } 168 }
166 my $fn = $FN[$fid]; 169 my $fn = $FN[$fid];
167 170
168 my $spid = ""; 171 my $spid = "";
169 if ($opt_p) { 172 if ($opt_p) {
170 my $pid = $pid[$fid]; 173 my $pid = $pid[$fid];
171 my $ppid = $PPID{$pid}; 174 my $ppid = $PPID{$pid};
172 $spid = defined $ppid ? " [$pid $ppid]" : " [$pid]" 175 $spid = defined $ppid ? " [$pid $ppid]" : " [$pid]"
173 } 176 }
174 177
175 printf("%s:%d%s %.5f %d: %s\n", 178 printf("%s:%d%s %.5f %d: %s\n",
176 # $fid, 179 # $fid,
177 $fn, 180 $fn,
178 $line, 181 $line,
179 $spid, 182 $spid,
180 $TICKS{$key}, 183 $TICKS{$key},
181 $COUNT{$key}, 184 $COUNT{$key},
182 $src); 185 $src);
183 } 186 }
184
185 187
186 __END__ 188 __END__
187 189
188 =head1 NAME 190 =head1 NAME
189 191
190 fprofpp - Devel::FastProf post processor 192 fprofpp - Devel::FastProf post processor
191 193
192 =head1 SYNOPSIS 194 =head1 SYNOPSIS
193 195
194 $ fprofpp [-f filename] [-r] [-e] [-g] [-p] [-t num] 196 $ fprofpp [-f filename] [-r] [-e] [-g] [-p] [-t num]
195 197
196 =head1 DESCRIPTION 198 =head1 DESCRIPTION
197 199
198 C<fprofpp> reads the profile information generated when using 200 C<fprofpp> reads the profile information generated when using
199 L<Devel::FastProf> (usually saved on a file named C<fastprof.out>) and 201 L<Devel::FastProf> (usually saved on a file named C<fastprof.out>) and
200 prints a "human friendly" report. 202 prints a "human friendly" report.
201 203
202 =head2 OPTIONS 204 =head2 OPTIONS
203 205
204 Those are the flags that can be used with C<fprofpp>: 206 Those are the flags that can be used with C<fprofpp>:
205 207
206 =over 4 208 =over 4
207 209
208 =item -f filename 210 =item -f filename
209 211
210 instead of the default C<fastprof.out> reads the file given as an 212 instead of the default C<fastprof.out> reads the file given as an
211 argument. 213 argument.
212 214
213 =item -r 215 =item -r
214 216
215 sorts the lines on the output by the number of times they have been 217 sorts the lines on the output by the number of times they have been
216 called instead of by the time spent on them (that is the default). 218 called instead of by the time spent on them (that is the default).
217 219
218 =item -t num 220 =item -t num
219 221
220 only outputs the first C<num> lines 222 only outputs the first C<num> lines
221 223
222 =item -e 224 =item -e
223 225
224 account the time spent on code inside C<eval "..."> constructions on 226 account the time spent on code inside C<eval "..."> constructions on
225 the line where the eval starts. 227 the line where the eval starts.
226 228
227 Time spent on subroutines defined inside an eval will also be 229 Time spent on subroutines defined inside an eval will also be
228 accounted on that line even when the subs are latter called outside 230 accounted on that line even when the subs are latter called outside
229 the eval. 231 the eval.
230 232
231 By default, every time an eval is executed its code is considered to 233 By default, every time an eval is executed its code is considered to
232 be a different source file and accounted independently of the rest of 234 be a different source file and accounted independently of the rest of
233 the calls to the same eval. 235 the calls to the same eval.
234 236
235 On the report, it points to the place (file and line) where the eval 237 On the report, it points to the place (file and line) where the eval
236 sits, but the line source is the code actually executed. 238 sits, but the line source is the code actually executed.
237 239
238 =item -g 240 =item -g
239 241
240 by default, on forking code, the time spent on every line by every 242 by default, on forking code, the time spent on every line by every
241 process is accounted separately. 243 process is accounted separately.
242 244
243 when this option is set, instead, the time reported is the sum of the 245 when this option is set, instead, the time reported is the sum of the
244 time spent by all the processes on every line. 246 time spent by all the processes on every line.
245 247
246 =item -p 248 =item -p
247 249
248 include process information on the report. 250 include process information on the report.
249 251
250 =item -H 252 =item -H
251 253
252 Do not print the report header. 254 Do not print the report header.
253 255
254 =back 256 =back
255 257
256 =head1 THE EMACS/XEMACS HACK 258 =head1 THE EMACS/XEMACS HACK
257 259
258 The format of the report generated by C<Devel::SmallProf> is similar 260 The format of the report generated by C<Devel::SmallProf> is similar
259 to that generated by C<gcc> or C<grep -n> and so, easily parseable by 261 to that generated by C<gcc> or C<grep -n> and so, easily parseable by
260 C<Emacs> (and I suppose it shouldn't be too difficult to do the same 262 C<Emacs> (and I suppose it shouldn't be too difficult to do the same
261 from C<vi> and other editors). 263 from C<vi> and other editors).
262 264
263 For instance, one way to do it from XEmacs is, starting from a buffer 265 For instance, one way to do it from XEmacs is, starting from a buffer
264 on the same directory where C<fastprof.out> sits: 266 on the same directory where C<fastprof.out> sits:
265 267
266 M-! fprofpp -t 30 268 M-! fprofpp -t 30
267 M-x compilation-mode 269 M-x compilation-mode
268 270
269 then, going to the hot spots of the profiled program would be as easy 271 then, going to the hot spots of the profiled program would be as easy
270 as clicking the mouse over the lines on the C<fprofpp> output buffer. 272 as clicking the mouse over the lines on the C<fprofpp> output buffer.
271 273
272 =head1 SEE ALSO 274 =head1 SEE ALSO
273 275
274 L<Devel::FastProf>, L<perlrun>. 276 L<Devel::FastProf>, L<perlrun>.
275 277
276 =head1 COPYRIGHT AND LICENSE 278 =head1 COPYRIGHT AND LICENSE
277 279
278 Copyright (C) 2005 by Salvador FandiE<ntilde>o 280 Copyright (C) 2005 by Salvador FandiE<ntilde>o
279 E<lt>sfandino@yahoo.comE<gt>. 281 E<lt>sfandino@yahoo.comE<gt>.
280 282
281 This program is free software; you can redistribute it and/or modify 283 This program is free software; you can redistribute it and/or modify
282 it under the same terms as Perl itself, either Perl version 5.8.7 or, 284 it under the same terms as Perl itself, either Perl version 5.8.7 or,
283 at your option, any later version of Perl 5 you may have available. 285 at your option, any later version of Perl 5 you may have available.
284 286
285 =cut 287 =cut
Powered by Google Project Hosting