Skip to content

Commit

Permalink
[tools] pprof2cg.pl: Fifth tuning: undo singleton for alias trick; ca…
Browse files Browse the repository at this point in the history 
…uses whitespace outdent

git-svn-id: https://svn.parrot.org/parrot/trunk@42181 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information
japhb committed Oct 31, 2009
1 parent ba4eccf commit 7ad00b0
Showing 1 changed file with 68 additions and 70 deletions.
138 changes: 68 additions & 70 deletions tools/dev/pprof2cg.pl
View file
Expand Up @@ -158,90 +158,88 @@ sub main {
sub process_line {
my ($line, $stats, $ctx_stack) = @_;

for ($line) {
if (/^OP:(.*)$/) {
# Decode string in the format C<{x{key1:value1}x}{x{key2:value2}x}>
my %op_hash = $1 =~ /{x{([^:]+):(.*?)}x}/g
or die "invalidly formed line '$line'";
if ($line =~ /^OP:(.*)$/) {
# Decode string in the format C<{x{key1:value1}x}{x{key2:value2}x}>
my %op_hash = $1 =~ /{x{([^:]+):(.*?)}x}/g
or die "invalidly formed line '$line'";

my $cur_ctx = $ctx_stack->[0]
or die "input file did not specify an initial context";
my $cur_ctx = $ctx_stack->[0]
or die "input file did not specify an initial context";

if (exists $cur_ctx->{line} && $op_hash{line} == $cur_ctx->{line}) {
$cur_ctx->{op_num}++;
}
else {
$cur_ctx->{op_num} = 0;
}
if (exists $cur_ctx->{line} && $op_hash{line} == $cur_ctx->{line}) {
$cur_ctx->{op_num}++;
}
else {
$cur_ctx->{op_num} = 0;
}

$cur_ctx->{line} = $op_hash{line};
my $extra = { op_name => $op_hash{op} };
my $time = $op_hash{time};
$cur_ctx->{line} = $op_hash{line};
my $extra = { op_name => $op_hash{op} };
my $time = $op_hash{time};

$stats->{global_stats}{total_time} += $time;
store_stats ($stats, $cur_ctx, $time, $extra);
store_stats_stack($stats, $ctx_stack, $time);
}
#context switch
elsif (/^CS:(.*)$/) {
$stats->{global_stats}{total_time} += $time;
store_stats ($stats, $cur_ctx, $time, $extra);
store_stats_stack($stats, $ctx_stack, $time);
}
#context switch
elsif ($line =~ /^CS:(.*)$/) {

# Decode string in the format C<{x{key1:value1}x}{x{key2:value2}x}>
my %cs_hash = $1 =~ /{x{([^:]+):(.*?)}x}/g
or die "invalidly formed line '$line'";
my $cs_hash = \%cs_hash;
# Decode string in the format C<{x{key1:value1}x}{x{key2:value2}x}>
my %cs_hash = $1 =~ /{x{([^:]+):(.*?)}x}/g
or die "invalidly formed line '$line'";
my $cs_hash = \%cs_hash;

my $is_first = scalar(@$ctx_stack) == 0;
my $is_redundant = !$is_first && ($ctx_stack->[0]{'ctx'} eq $cs_hash{ctx});
my $reused_ctx = $is_redundant && ($ctx_stack->[0]{'sub'} ne $cs_hash{sub});
my $is_call = scalar(grep {$_->{'ctx'} eq $cs_hash{ctx}} @$ctx_stack) == 0;
my $is_first = scalar(@$ctx_stack) == 0;
my $is_redundant = !$is_first && ($ctx_stack->[0]{'ctx'} eq $cs_hash{ctx});
my $reused_ctx = $is_redundant && ($ctx_stack->[0]{'sub'} ne $cs_hash{sub});
my $is_call = scalar(grep {$_->{'ctx'} eq $cs_hash{ctx}} @$ctx_stack) == 0;

if ($is_first) {
$ctx_stack->[0] = $cs_hash;
}
elsif ($reused_ctx) {
$ctx_stack->[0]{'sub'} = $cs_hash{sub};
$ctx_stack->[0]{'ns'} = $cs_hash{ns};
}
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 contexts off the stack until one matches the current ctx
while ($ctx_stack->[0]->{'ctx'} ne $cs_hash{ctx}) {
my $ctx = shift @$ctx_stack;
}
}
#print Dumper($ctx_stack);
}
elsif (/^VERSION:(\d+)$/) {
my $version = $1;
if ($version != 1) {
die "profile was generated by an incompatible version of the profiling runcore.";
}
if ($is_first) {
$ctx_stack->[0] = $cs_hash;
}
elsif (/^CLI:(.*)$/) {
$stats->{'global_stats'}{'cli'} = $1;
elsif ($reused_ctx) {
$ctx_stack->[0]{'sub'} = $cs_hash{sub};
$ctx_stack->[0]{'ns'} = $cs_hash{ns};
}
elsif (/^END_OF_RUNLOOP$/) {
#end of loop
@$ctx_stack = ();
elsif ($is_redundant) {
#don't do anything
}
elsif (/^#/) {
#comments are always ignored
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 {
die "Unrecognized line format: '$line'";
#shift contexts off the stack until one matches the current ctx
while ($ctx_stack->[0]->{'ctx'} ne $cs_hash{ctx}) {
my $ctx = shift @$ctx_stack;
}
}
#print Dumper($ctx_stack);
}
elsif ($line =~ /^VERSION:(\d+)$/) {
my $version = $1;
if ($version != 1) {
die "profile was generated by an incompatible version of the profiling runcore.";
}
}
elsif ($line =~ /^CLI:(.*)$/) {
$stats->{'global_stats'}{'cli'} = $1;
}
elsif ($line =~ /^END_OF_RUNLOOP$/) {
#end of loop
@$ctx_stack = ();
}
elsif ($line =~ /^#/) {
#comments are always ignored
}
else {
die "Unrecognized line format: '$line'";
}
}

=item C<print_stats>
Expand Down

0 comments on commit 7ad00b0

Please sign in to comment.