3 # Copyright (C) 2009, Parrot Foundation.
17 Convert the output of Parrot's profiling runcore to a Callgrind-compatible
22 perl tools/dev/pprof2cg.pl parrot.pprof.1234
26 Generate a profile by passing C<-Rprofiling> to parrot, for example C<./parrot
27 -Rprofiling perl6.pbc hello.p6>. Once execution completes, C<parrot> will
28 print a message specifying the location of the parrot profile (pprof). The
29 profile will be named parrot.pprof.XXXX, where XXXX is the PID of the parrot
30 process unless another name is specified by the B<PARROT_PROFILING_OUTPUT>
33 To generate a Callgrind-compatible profile, run this script with the pprof
34 filename as the first argument. The output file usable by kcachegrind will be
35 in parrot.out.XXXX, where XXXX again is the PID of the original parrot process.
37 =head1 Environment Variables
39 =head2 PARROT_PROFILING_OUTPUT
41 If the environment variable PARROT_PROFILING_OUTPUT is set, the profiling
42 runcore will attempt to use its value as the profile filename. Note that it
43 does not check whether the file already exists and will happily overwrite
50 =head1 Internal Data Structures
56 Parrot's execution model is built on continuation-passing style and does not
57 precisely fit the straightforward function-based format that
58 Callgrind-compatible tools expect. For this reason, the profiling runcore
59 captures information about context switches (CS lines in the pprof file) and
60 pprof2cg.pl maintains a context stack that functions similarly to a typical
61 call stack. pprof2cg.pl then maps these context switches as if they were
62 function calls and returns. See C<$ctx_stack> for more information.
66 Variables which are named C<$ctx_stack> hold a reference to an array of hashes
67 which contain information about the currently active contexts. When collecting
68 timing information about an op, it is necessary to add that information to all
69 function calls on the stack because Callgrind-compatible tools expect the cost
70 of a function call to include the cost of all calls made by that function, etc.
72 When a context switch is detected, C<process_line> looks at the context stack
73 to determine if the context switch looks like a function call (if the context
74 hasn't been seen before) or a return (if the context is somewhere on the
75 stack). There are some other cases that the code handles, but these can be
76 ignored for now in the interest of simplicity. If the context has been seen,
77 C<process_line> shifts contexts off the stack until it finds the context that
78 has been switched to. When C<process_line> detects a new context, it adds a
79 fake op representing a function call to C<$stats> and unshifts a new context
82 Each element of C<@$ctx_stack> contains the information needed to uniquely
83 identify the site of the original context switch.
87 Variables which are named C<$stats> contain a reference to a deeply nested
88 HoHoH.. which contains all information gathered about a profiled PIR program.
89 The nested hashes and arrays refer to the file, namespace, line of source code
90 and op number, respectively. The op number is used to allow multiple
91 instructions per line because PIR instructions often represent multiple
92 low-level instructions. This also makes it easy to inject pseudo-ops to
93 represent function calls.
95 Each op always has a time value representing the total amount of time spent in
96 that op. Ops may also have an op_name value that gives the name of the op.
97 When control flow similar to a function call is detected, a pseudo-op
98 representing a function call is injected. These pseudo-ops have zero cost when
99 initialized and are used to determine the total time spent between when the
100 context becomes active and when control flow returns to or past the context.
101 Although they're not exactly like functions calls, they're close enough that it
102 may help to think of them as such.
104 Uncomment the print_stats line in main to see a representation of the data
105 contained in C<$stats>.
115 This function is minimal driver for the other functions in this file, taking
116 the name of a Parrot profile and writing a Callgrind-compatible profile to a
117 similarly-named file.
125 my $filename = $argv->[0];
127 open(my $in_fh, '<', $filename) or die "couldn't open $filename for reading: $!";
129 while (my $line = <$in_fh>) {
130 process_line
($line, $stats, $ctx_stack);
132 close($in_fh) or die "couldn't close $filename: $!";
134 #print_stats($stats);
136 unless ($filename =~ s/pprof/out/) {
137 $filename = "$filename.out";
140 open(my $out_fh, '>', $filename) or die "couldn't open $filename for writing: $!";
141 my $cg_profile = get_cg_profile
($stats);
142 print $out_fh $cg_profile;
143 close($out_fh) or die "couldn't close $filename: $!";
144 print "$filename can now be used with kcachegrind or other callgrind-compatible tools.\n";
147 =item C<process_line>
149 This function takes a string containing a single line from a Parrot profile, a
150 reference to a hash of fine-grained statistics about the current PIR program
151 and a reference to the current context stack. It modifies the statistics and
152 context stack according to the information from the Parrot profile.
160 my $ctx_stack = shift;
164 #comments are always ignored
166 elsif (/^VERSION:(\d+)$/) {
169 die "profile was generated by an incompatible version of the profiling runcore.";
172 elsif (/^CLI:(.*)$/) {
173 $stats->{'global_stats'}{'cli'} = $1;
176 elsif (/^CS:(.*)$/) {
178 my $cs_hash = split_vars
($1);
179 my $is_first = scalar(@
$ctx_stack) == 0;
180 my $is_redundant = !$is_first && ($ctx_stack->[0]{'ctx'} eq $cs_hash->{'ctx'});
181 my $reused_ctx = $is_redundant && ($ctx_stack->[0]{'sub'} ne $cs_hash->{'sub'});
182 my $is_call = scalar(grep {$_->{'ctx'} eq $cs_hash->{'ctx'}} @
$ctx_stack) == 0;
185 $ctx_stack->[0] = $cs_hash;
187 elsif ($reused_ctx) {
188 $ctx_stack->[0]{'sub'} = $cs_hash->{'sub'};
189 $ctx_stack->[0]{'ns'} = $cs_hash->{'ns'};
191 elsif ($is_redundant) {
195 $ctx_stack->[0]{'op_num'}++;
198 target
=> $cs_hash->{'ns'}
200 store_stats
($stats, $ctx_stack->[0], 0, $extra );
201 unshift @
$ctx_stack, $cs_hash;
204 #shift contexts off the stack until one matches the current ctx
205 while ($ctx_stack->[0]->{'ctx'} ne $cs_hash->{'ctx'}) {
206 my $ctx = shift @
$ctx_stack;
209 #print Dumper($ctx_stack);
211 elsif (/^END_OF_RUNLOOP$/) {
215 elsif (/^OP:(.*)$/) {
216 my $op_hash = split_vars
($1);
218 die "input file did not specify an initial context" if (@
$ctx_stack == 0);
220 if (exists $ctx_stack->[0]{'line'} && $op_hash->{'line'} == $ctx_stack->[0]{'line'}) {
221 $ctx_stack->[0]{'op_num'}++;
224 $ctx_stack->[0]{'op_num'} = 0;
227 $ctx_stack->[0]{'line'} = $op_hash->{'line'};
228 my $extra = { op_name
=> $op_hash->{'op'} };
229 store_stats
($stats, $ctx_stack->[0], $op_hash->{'time'}, $extra);
231 $extra->{'no_hits'} = 1;
232 for my $frame (@
$ctx_stack[1 .. scalar(@
$ctx_stack)-1 ]) {
233 store_stats
($stats, $frame, $op_hash->{'time'}, $extra);
237 die "Unrecognized line format: \"$line\"";
244 This function prints a complete, human-readable representation of the
245 statistical data that have been collected into the C<$stats> argument to
246 stdout. It is primarily intended to ease debugging and is not necessary to
247 create a Callgrind-compatible profile.
254 for my $file (grep {$_ ne 'global_stats'} sort keys %$stats) {
255 for my $ns (sort keys %{ $stats->{$file} }) {
256 for my $line_num (sort {$a<=>$b} keys %{ $stats->{$file}{$ns} }) {
257 for my $op_num (0 .. $#{$stats->{$file}{$ns}{$line_num}}) {
259 print "$file $ns line/op:$line_num/$op_num ";
261 for my $attr (sort keys %{ $stats->{$file}{$ns}{$line_num}[$op_num] }) {
262 print "{ $attr => $stats->{$file}{$ns}{$line_num}[$op_num]{$attr} } ";
274 This function takes a string specifying 1 or more key/value mappings and
275 returns a reference to a hash containing those keys and values. The string
276 must be in the format C<{x{key1:value1}x}{x{key2:value2}x}>.
283 die "invalidly formed line '$str'"
284 unless $str =~ /({x{ [^:]+ : (.*?) }x})+/x;
285 while ($str =~ /\G {x{ ([^:]+) : (.*?) }x} /cxg) {
293 This function adds statistical data to the C<$stats> hash reference. The
294 C<$locator> argument specifies information such as the namespace, file, line
295 and op number where the data should go. C<$time> is an integer representing
296 the amount of time spent at the specified location. C<$extra> contains any
297 ancillary data that should be stored in the hash. This includes data on
298 (faked) subroutine calls and op names.
308 my $file = $locator->{'file'};
309 my $ns = $locator->{'ns'};
310 my $line = $locator->{'line'};
311 my $op_num = $locator->{'op_num'};
313 if (exists $stats->{'global_stats'}{'total_time'}) {
314 $stats->{'global_stats'}{'total_time'} += $time;
317 $stats->{'global_stats'}{'total_time'} = $time;
320 if (exists $stats->{$file}{$ns}{$line}[$op_num]) {
321 $stats->{$file}{$ns}{$line}[$op_num]{'hits'}++
322 unless exists $extra->{no_hits
};
323 $stats->{$file}{$ns}{$line}[$op_num]{'time'} += $time;
326 $stats->{$file}{$ns}{$line}[$op_num]{'hits'} = 1;
327 $stats->{$file}{$ns}{$line}[$op_num]{'time'} = $time;
328 for my $key (keys %{$extra}) {
329 $stats->{$file}{$ns}{$line}[$op_num]{$key} = $extra->{$key};
334 =item C<get_cg_profile>
336 This function takes a reference to a hash of statistical information about a
337 PIR program and returns a string containing a Callgrind-compatible profile.
338 Although some information in the profile may not be accurate (namely PID and
339 creator), tools such as kcachegrind are able to consume files generated by this
349 push @output, <<"HEADER";
351 creator: 3.4.1-Debian
353 cmd: $stats->{'global_stats'}{'cli'}
359 desc: Timerange: Basic block 0 - $stats->{'global_stats'}{'total_time'}
360 desc: Trigger: Program termination
363 summary: $stats->{'global_stats'}{'total_time'}
367 for my $file (grep {$_ ne 'global_stats'} keys %$stats) {
369 push @output, "fl=$file";
371 for my $ns (keys %{ $stats->{$file} }) {
372 push @output, "\nfn=$ns";
374 for my $line (sort keys %{ $stats->{$file}{$ns} }) {
377 my $line_stats = $stats->{$file}{$ns}{$line};
378 my $op_count = scalar(@
$line_stats);
381 while ($curr_op < $op_count && $line_stats->[$curr_op]{'op_name'} ne 'CALL') {
382 $op_time += $line_stats->[$curr_op]{'time'};
385 push @output, "$line $op_time";
387 if ($curr_op < $op_count && $line_stats->[$curr_op]{'op_name'} eq 'CALL') {
388 my $call_target = $line_stats->[$curr_op]{'target'};
389 my $call_count = $line_stats->[$curr_op]{'hits'};
390 my $call_cost = $line_stats->[$curr_op]{'time'};
392 push @output, "cfn=$call_target";
393 push @output, "calls=$call_count $call_cost";
396 if ($curr_op < $op_count) {
398 while ($curr_op < $op_count) {
399 $op_time += $line_stats->[$curr_op]{'time'};
402 push @output, "$line $op_time";
408 push @output, "totals: $stats->{'global_stats'}{'total_time'}";
409 return join("\n", @output);
418 # cperl-indent-level: 4
421 # vim: expandtab shiftwidth=4: