[svn:parrot] r40930 - branches/pluggable_runcore/tools/dev
cotto at svn.parrot.org
cotto at svn.parrot.org
Wed Sep 2 22:02:52 UTC 2009
Author: cotto
Date: Wed Sep 2 22:02:49 2009
New Revision: 40930
URL: https://trac.parrot.org/parrot/changeset/40930
Log:
[profiling] split pprof2cg into functions for greater sanity, testing and refactoring
Modified:
branches/pluggable_runcore/tools/dev/pprof2cg.pl
Modified: branches/pluggable_runcore/tools/dev/pprof2cg.pl
==============================================================================
--- branches/pluggable_runcore/tools/dev/pprof2cg.pl Wed Sep 2 19:51:31 2009 (r40929)
+++ branches/pluggable_runcore/tools/dev/pprof2cg.pl Wed Sep 2 22:02:49 2009 (r40930)
@@ -27,123 +27,109 @@
message specifying the location of profile. The profile will usually be named
parrot.XXXX.pprof, where XXXX is the PID of the parrot process.
+To generate a Callgrind-compatible profile, run this script with the pprof
+filename as the first argument.
+
=cut
my @ctx_stack = ();
-my %stats;
-
-my $total_time = 0;
-my $prev_line = 0;
+main(\@ARGV);
-sub split_vars{
- my $href;
- my $str = shift;
- while ($str =~ /\G { ([^:]+) : (.*?) } /cxg) {
- $href->{$1} = $2;
+sub main {
+ my $argv = shift;
+ my $stats = {};
+ my $filename = $argv->[0];
+ open FH, "<$filename" or die "couldn't open $filename for reading";
+ while (<FH>) {
+ my $line = $_;
+ process_line($line, $stats);
}
- return $href;
+ print_stats($stats);
}
-sub store_stats {
- my $stats_ref = shift;
- my $locator = shift;
- my $time = shift;
- my $extra = shift;
-
- my $file = $locator->{'file'};
- my $ns = $locator->{'ns'};
- my $line = $locator->{'line'};
- my $op_num = $locator->{'op_num'};
-
- if (exists $stats_ref->{$file}{$ns}{$line}[$op_num]) {
- $stats_ref->{$file}{$ns}{$line}[$op_num]{'hits'}++
- unless exists $extra->{no_hits};
- $stats_ref->{$file}{$ns}{$line}[$op_num]{'time'} += $time;
- }
- else {
- $stats_ref->{$file}{$ns}{$line}[$op_num]{'hits'} = 1;
- $stats_ref->{$file}{$ns}{$line}[$op_num]{'time'} = $time;
- for my $key (keys %{$extra}) {
- $stats_ref->{$file}{$ns}{$line}[$op_num]{$key} = $extra->{$key};
- }
- }
-}
+sub process_line {
-while (<>) {
+ my $line = shift;
+ my $stats = shift;
- if (/^#/) {
- #comments are always ignored
- }
- elsif (/^VERSION:(\d+)$/) {
- my $version = $1;
- if ($version != 1) {
- die "profile was generated by an incompatible version of the profiling runcore.";
+ for ($line) {
+ if (/^#/) {
+ #comments are always ignored
+ }
+ elsif (/^VERSION:(\d+)$/) {
+ my $version = $1;
+ if ($version != 1) {
+ die "profile was generated by an incompatible version of the profiling runcore.";
+ }
}
- }
- #context switch
- elsif (/^CS:(.*)$/) {
+ elsif (/^CLI:(.*)$/) {
+ $stats->{'global_stats'}{'cli'} = $1;
+ }
+ #context switch
+ elsif (/^CS:(.*)$/) {
- my $cs_hash = split_vars($1);
- my $is_first = $#ctx_stack == -1;
- my $is_redundant = !$is_first && ($ctx_stack[0]{'ctx'} eq $cs_hash->{'ctx'});
- my $is_call = !scalar(grep {$_->{'ctx'} eq $cs_hash->{'ctx'}} @ctx_stack);
+ my $cs_hash = split_vars($1);
+ my $is_first = $#ctx_stack == -1;
+ my $is_redundant = !$is_first && ($ctx_stack[0]{'ctx'} eq $cs_hash->{'ctx'});
+ my $is_call = !scalar(grep {$_->{'ctx'} eq $cs_hash->{'ctx'}} @ctx_stack);
- if ($is_first) {
- $ctx_stack[0] = $cs_hash;
- }
- elsif ($is_redundant) {
- #don't do anything
- }
- elsif ($is_call) {
-
- $ctx_stack[0]{'op_num'}++;
- my $extra = {
- op_name => "CALL",
- target => $cs_hash->{'ns'}
- };
- store_stats(\%stats, $ctx_stack[0], 0, $extra );
+ if ($is_first) {
+ $ctx_stack[0] = $cs_hash;
+ }
+ elsif ($is_redundant) {
+ #don't do anything
+ }
+ elsif ($is_call) {
+ $ctx_stack[0]{'op_num'}++;
+ my $extra = {
+ op_name => "CALL",
+ target => $cs_hash->{'ns'}
+ };
+ store_stats($stats, $ctx_stack[0], 0, $extra );
unshift @ctx_stack, $cs_hash;
}
else {
shift @ctx_stack while ($ctx_stack[0]->{'ctx'} ne $cs_hash->{'ctx'});
}
print Dumper(\@ctx_stack);
- }
- elsif (/^OP:(.*)$/) {
- my $op_hash = split_vars($1);
-
- if (exists $ctx_stack[0]{'line'} && $op_hash->{'line'} == $ctx_stack[0]{'line'}) {
- $ctx_stack[0]{'op_num'}++;
- }
- else {
- $ctx_stack[0]{'op_num'} = 0;
}
+ elsif (/^OP:(.*)$/) {
+ my $op_hash = split_vars($1);
- $ctx_stack[0]{'line'} = $op_hash->{'line'};
- my $extra = { op_name => $op_hash->{'op'} };
- store_stats(\%stats, $ctx_stack[0], $op_hash->{'time'}, $extra);
+ if (exists $ctx_stack[0]{'line'} && $op_hash->{'line'} == $ctx_stack[0]{'line'}) {
+ $ctx_stack[0]{'op_num'}++;
+ }
+ else {
+ $ctx_stack[0]{'op_num'} = 0;
+ }
+
+ $ctx_stack[0]{'line'} = $op_hash->{'line'};
+ my $extra = { op_name => $op_hash->{'op'} };
+ store_stats($stats, $ctx_stack[0], $op_hash->{'time'}, $extra);
$extra->{'no_hits'} = 1;
for my $frame (@ctx_stack[1 .. $#ctx_stack]) {
- store_stats(\%stats, $frame, $op_hash->{'time'}, $extra);
+ store_stats($stats, $frame, $op_hash->{'time'}, $extra);
+ }
}
}
}
+sub print_stats {
+ my $stats = shift;
-if (1) {
- for my $file (sort keys %stats) {
- for my $ns (sort keys %{ $stats{$file} }) {
- for my $line_num (sort {$a<=>$b} keys %{ $stats{$file}{$ns} }) {
- for my $op_numbr (0 .. $#{$stats{$file}{$ns}{$line_num}}) {
+ for my $file (grep {$_ ne 'global_stats'} sort keys %$stats) {
+ for my $ns (sort keys %{ $stats->{$file} }) {
+ for my $line_num (sort {$a<=>$b} keys %{ $stats->{$file}{$ns} }) {
+ for my $op_numbr (0 .. $#{$stats->{$file}{$ns}{$line_num}}) {
print "$file $ns line:$line_num op:$op_numbr ";
- for my $attr (sort keys %{ $stats{$file}{$ns}{$line_num}[$op_numbr] }) {
- print "{ $attr => $stats{$file}{$ns}{$line_num}[$op_numbr]{$attr} } ";
+ for my $attr (sort keys %{ $stats->{$file}{$ns}{$line_num}[$op_numbr] }) {
+ print "{ $attr => $stats->{$file}{$ns}{$line_num}[$op_numbr]{$attr} } ";
}
say "";
}
@@ -153,75 +139,119 @@
}
}
+sub split_vars{
+ my $href;
+ my $str = shift;
+ while ($str =~ /\G { ([^:]+) : (.*?) } /cxg) {
+ $href->{$1} = $2;
+ }
+ return $href;
+}
+
+sub store_stats {
+ my $stats = shift;
+ my $locator = shift;
+ my $time = shift;
+ my $extra = shift;
+
+ my $file = $locator->{'file'};
+ my $ns = $locator->{'ns'};
+ my $line = $locator->{'line'};
+ my $op_num = $locator->{'op_num'};
+
+ if (exists $stats->{'global_stats'}{'total_time'}) {
+ $stats->{'global_stats'}{'total_time'} += $time;
+ }
+ else {
+ $stats->{'global_stats'}{'total_time'} = $time;
+ }
+
+ if (exists $stats->{$file}{$ns}{$line}[$op_num]) {
+ $stats->{$file}{$ns}{$line}[$op_num]{'hits'}++
+ unless exists $extra->{no_hits};
+ $stats->{$file}{$ns}{$line}[$op_num]{'time'} += $time;
+ }
+ else {
+ $stats->{$file}{$ns}{$line}[$op_num]{'hits'} = 1;
+ $stats->{$file}{$ns}{$line}[$op_num]{'time'} = $time;
+ for my $key (keys %{$extra}) {
+ $stats->{$file}{$ns}{$line}[$op_num]{$key} = $extra->{$key};
+ }
+ }
+}
-=head1
-open(OUT_FH, ">parrot.out") or die "couldn't open parrot.out for writing";
+sub write_cg_profile {
-say OUT_FH <<"HEADER";
+ my $stats = shift;
+
+ open(OUT_FH, ">parrot.out") or die "couldn't open parrot.out for writing";
+
+ say OUT_FH <<"HEADER";
version: 1
creator: 3.4.1-Debian
pid: 5751
-cmd: ./callgrind_test
+cmd: $stats->{'global_stats'}{'cli'}
part: 1
desc: I1 cache:
desc: D1 cache:
desc: L2 cache:
-desc: Timerange: Basic block 0 - $total_time
+desc: Timerange: Basic block 0 - $stats->{'global_stats'}{'total_time'}
desc: Trigger: Program termination
positions: line
events: Ir
-summary: $total_time
+summary: $stats->{'global_stats'}{'total_time'}
HEADER
-for $file (keys %stats) {
+ for my $file (grep {$_ ne 'global_stats'} keys %$stats) {
- say OUT_FH "fl=$file";
+ say OUT_FH "fl=$file";
- for $func (keys %{ $stats{$file} }) {
- say OUT_FH "\nfn=$func";
+ for my $func (keys %{ $stats->{$file} }) {
+ say OUT_FH "\nfn=$func";
- for $line (sort keys %{ $stats{$file}{$func} }) {
+ for my $line (sort keys %{ $stats->{$file}{$func} }) {
- if ($stats{$file}{$func}{$line}{line_calls_func}) {
+ if ($stats->{$file}{$func}{$line}{line_calls_func}) {
- my $line_time = 0;
- my $func_op_num = 0;
+ my $line_time = 0;
+ my $func_op_num = 0;
- for $op_num (sort grep {$_ ne 'line_calls_func'} keys %{ $stats{$file}{$func}{$line} }) {
+ for my $op_num (sort grep {$_ ne 'line_calls_func'} keys %{ $stats->{$file}{$func}{$line} }) {
- if ($stats{$file}{$func}{$line}{$op_num}{op} eq "FUNCTION_CALL") {
- $func_op_num = $op_num;
- }
- else {
- $line_time += $stats{$file}{$func}{$line}{$op_num}{time}
- unless $stats{$file}{$func}{$line}{$op_num}{op} ~~ @call_ops;
+ if ($stats->{$file}{$func}{$line}{$op_num}{op} eq "FUNCTION_CALL") {
+ $func_op_num = $op_num;
+ }
+ else {
+ $line_time += $stats->{$file}{$func}{$line}{$op_num}{time};
+ }
}
- }
- say OUT_FH "$line $line_time";
+ say OUT_FH "$line $line_time";
- my $func_name = $stats{$file}{$func}{$line}{$func_op_num}{func_name};
- my $hits = $stats{$file}{$func}{$line}{$func_op_num}{hits};
- $line_time = $stats{$file}{$func}{$line}{$func_op_num-1}{time};
- say OUT_FH "cfn=$func_name";
- say OUT_FH "calls=$hits $line_time";
+ my $func_name = $stats->{$file}{$func}{$line}{$func_op_num}{func_name};
+ my $hits = $stats->{$file}{$func}{$line}{$func_op_num}{hits};
+ $line_time = $stats->{$file}{$func}{$line}{$func_op_num-1}{time};
+ say OUT_FH "cfn=$func_name";
+ say OUT_FH "calls=$hits $line_time";
- my $func_time = $stats{$file}{$func}{$line}{$func_op_num}{time};
+ my $func_time = $stats->{$file}{$func}{$line}{$func_op_num}{time};
- say OUT_FH "$line $func_time";
- }
- else {
- #aggregate all lines
- my $line_time = 0;
- for $op_num (sort grep {$_ ne 'line_calls_func'} keys %{ $stats{$file}{$func}{$line} }) {
- $line_time += $stats{$file}{$func}{$line}{$op_num}{time};
+ say OUT_FH "$line $func_time";
+ }
+ else {
+ #aggregate all lines
+ my $line_time = 0;
+ for my $op_num (sort grep {$_ ne 'line_calls_func'} keys %{ $stats->{$file}{$func}{$line} }) {
+ $line_time += $stats->{$file}{$func}{$line}{$op_num}{time};
+ }
+ say OUT_FH "$line $line_time";
}
- say OUT_FH "$line $line_time";
}
}
}
-}
-say OUT_FH "totals: $total_time";
+ say OUT_FH "totals: $stats->{'global_stats'}{'total_time'}";
+ close OUT_FH;
+}
More information about the parrot-commits
mailing list