[svn:parrot] r42181 - trunk/tools/dev

[japhb at svn.parrot.org]

Author: japhb
Date: Sat Oct 31 07:39:24 2009
New Revision: 42181
URL: https://trac.parrot.org/parrot/changeset/42181

Log:
[tools] pprof2cg.pl: Fifth tuning: undo singleton for alias trick; causes whitespace outdent

Modified:
   trunk/tools/dev/pprof2cg.pl

Modified: trunk/tools/dev/pprof2cg.pl
==============================================================================
--- trunk/tools/dev/pprof2cg.pl	Sat Oct 31 07:32:00 2009	(r42180)
+++ trunk/tools/dev/pprof2cg.pl	Sat Oct 31 07:39:24 2009	(r42181)
@@ -158,90 +158,88 @@
 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};
-
-            $stats->{global_stats}{total_time} += $time;
-            store_stats      ($stats, $cur_ctx,   $time, $extra);
-            store_stats_stack($stats, $ctx_stack, $time);
-        }
-        #context switch
-        elsif (/^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;
-
-            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;
+        $cur_ctx->{line} = $op_hash{line};
+        my $extra = { op_name => $op_hash{op} };
+        my $time  = $op_hash{time};
 
-            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);
+        $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;
+
+        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;
         }
-        elsif (/^VERSION:(\d+)$/) {
-            my $version = $1;
-            if ($version != 1) {
-                die "profile was generated by an incompatible version of the profiling runcore.";
+        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;
             }
         }
-        elsif (/^CLI:(.*)$/) {
-            $stats->{'global_stats'}{'cli'} = $1;
-        }
-        elsif (/^END_OF_RUNLOOP$/) {
-            #end of loop
-            @$ctx_stack = ();
-        }
-        elsif (/^#/) {
-            #comments are always ignored
-        }
-        else {
-            die "Unrecognized line format: '$line'";
+        #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>