[svn:parrot] r41018 - in branches/pluggable_runcore: src/runcore tools/dev

cotto at svn.parrot.org cotto at svn.parrot.org
Sat Sep 5 21:45:33 UTC 2009


Author: cotto
Date: Sat Sep  5 21:45:31 2009
New Revision: 41018
URL: https://trac.parrot.org/parrot/changeset/41018

Log:
[profiling] add explicit detection of runloop termination

Modified:
   branches/pluggable_runcore/src/runcore/cores.c
   branches/pluggable_runcore/tools/dev/pprof2cg.pl

Modified: branches/pluggable_runcore/src/runcore/cores.c
==============================================================================
--- branches/pluggable_runcore/src/runcore/cores.c	Sat Sep  5 21:19:47 2009	(r41017)
+++ branches/pluggable_runcore/src/runcore/cores.c	Sat Sep  5 21:45:31 2009	(r41018)
@@ -1246,6 +1246,11 @@
 
     } /* while (pc) */
 
+    /* make it easy to tell separate runloops apart */
+    if (runcore->level == 0) {
+        fprintf(runcore->profile_fd, "END_OF_RUNLOOP\n");
+    }
+
     Profiling_exit_check_SET(runcore);
     runcore->runcore_finish = Parrot_hires_get_time();;
     return pc;

Modified: branches/pluggable_runcore/tools/dev/pprof2cg.pl
==============================================================================
--- branches/pluggable_runcore/tools/dev/pprof2cg.pl	Sat Sep  5 21:19:47 2009	(r41017)
+++ branches/pluggable_runcore/tools/dev/pprof2cg.pl	Sat Sep  5 21:45:31 2009	(r41018)
@@ -47,7 +47,7 @@
     }
     close(IN_FH);
 
-    print_stats($stats);
+    #print_stats($stats);
 
     unless ($filename =~ s/\.pprof\./.out./) {
         $filename = "$filename.out";
@@ -82,16 +82,17 @@
         #context switch
         elsif (/^CS:(.*)$/) {
 
-            my $cs_hash         = split_vars($1);
-            my $is_first        = scalar(@$ctx_stack) == 0;
-            my $is_redundant    = !$is_first && ($ctx_stack->[0]{'ctx'} eq $cs_hash->{'ctx'});
-            my $new_sub_old_ctx = $is_redundant && ($ctx_stack->[0]{'sub'} ne $cs_hash->{'sub'});
-            my $is_call         = !scalar(grep {$_->{'ctx'} eq $cs_hash->{'ctx'}} @$ctx_stack);
+            my $cs_hash      = split_vars($1);
+            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;
+                print "added $cs_hash->{'ns'} with ctx $cs_hash->{'ctx'}\n";
             }
-            elsif ($new_sub_old_ctx) {
+            elsif ($reused_ctx) {
                 $ctx_stack->[0]{'sub'} = $cs_hash->{'sub'};
                 $ctx_stack->[0]{'ns'}  = $cs_hash->{'ns'};
             }
@@ -105,13 +106,23 @@
                     target  => $cs_hash->{'ns'}
                 };
                 store_stats($stats, $ctx_stack->[0], 0, $extra );
-            unshift @$ctx_stack, $cs_hash;
+                unshift @$ctx_stack, $cs_hash;
+                print "added $cs_hash->{'ns'} with ctx $cs_hash->{'ctx'}\n";
             }
             else {
-                shift @$ctx_stack while ($ctx_stack->[0]->{'ctx'} ne $cs_hash->{'ctx'});
+                #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 "shifted away $ctx->{'ns'}@ $ctx->{'ctx'} looking for $cs_hash->{'ctx'}\n";
+                }
+                print "done\n";
             }
             #print Dumper($ctx_stack);
         }
+        elsif (/^END_OF_RUNLOOP$/) {
+            #end of loop
+            $ctx_stack = [];
+        }
         elsif (/^OP:(.*)$/) {
             my $op_hash = split_vars($1);
 


More information about the parrot-commits mailing list