Permalink
Browse files

[profiling] parameterize the last global and do some minor code cleanup

git-svn-id: https://svn.parrot.org/parrot/branches/pluggable_runcore@40966 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent fadc618 commit 0357ee2eb32917ce592b23091e61e59267364841 cotto committed Sep 4, 2009
Showing with 30 additions and 25 deletions.
  1. +30 −25 tools/dev/pprof2cg.pl
View
@@ -30,29 +30,33 @@ =head1 USAGE
=cut
-my @ctx_stack = ();
main(\@ARGV);
sub main {
- my $argv = shift;
- my $stats = {};
- my $filename = $argv->[0];
+ my $argv = shift;
+ my $stats = {};
+ my $ctx_stack = [];
+ my $filename = $argv->[0];
+
$stats->{'global_stats'}{'filename'} = $filename;
open FH, "<$filename" or die "couldn't open $filename for reading";
+
while (<FH>) {
my $line = $_;
- process_line($line, $stats);
+ process_line($line, $stats, $ctx_stack);
}
- #print_stats($stats);
+
+ print_stats($stats);
write_cg_profile($stats);
}
sub process_line {
- my $line = shift;
- my $stats = shift;
+ my $line = shift;
+ my $stats = shift;
+ my $ctx_stack = shift;
for ($line) {
if (/^#/) {
@@ -71,51 +75,52 @@ sub process_line {
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 $is_first = scalar(@$ctx_stack) == 0;
+ 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) {
- #KCachegrind starts on the "main" function
- $cs_hash->{'ns'} = 'main';
- $ctx_stack[0] = $cs_hash;
+ $ctx_stack->[0] = $cs_hash;
}
elsif ($is_redundant) {
#don't do anything
}
elsif ($is_call) {
- $ctx_stack[0]{'op_num'}++;
+ $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;
+ 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'});
+ shift @$ctx_stack while ($ctx_stack->[0]->{'ctx'} ne $cs_hash->{'ctx'});
}
- #print Dumper(\@ctx_stack);
+ #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'}++;
+ 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]{'op_num'} = 0;
}
- $ctx_stack[0]{'line'} = $op_hash->{'line'};
+ $ctx_stack->[0]{'line'} = $op_hash->{'line'};
my $extra = { op_name => $op_hash->{'op'} };
- store_stats($stats, $ctx_stack[0], $op_hash->{'time'}, $extra);
+ store_stats($stats, $ctx_stack->[0], $op_hash->{'time'}, $extra);
$extra->{'no_hits'} = 1;
- for my $frame (@ctx_stack[1 .. $#ctx_stack]) {
+ for my $frame (@$ctx_stack[1 .. scalar(@$ctx_stack)-1 ]) {
store_stats($stats, $frame, $op_hash->{'time'}, $extra);
}
}
+ else {
+ die "Unrecognized line format: \"$line\"";
+ }
}
}

0 comments on commit 0357ee2

Please sign in to comment.