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

[cotto at svn.parrot.org]

Author: cotto
Date: Sat Sep  5 21:19:47 2009
New Revision: 41017
URL: https://trac.parrot.org/parrot/changeset/41017

Log:
[profiling] detect and handle separate subs that get called with the same context
(it appears to be related to subclasses and :init)

Modified:
   branches/pluggable_runcore/include/parrot/runcore_api.h
   branches/pluggable_runcore/src/runcore/cores.c
   branches/pluggable_runcore/tools/dev/pprof2cg.pl

Modified: branches/pluggable_runcore/include/parrot/runcore_api.h
==============================================================================
--- branches/pluggable_runcore/include/parrot/runcore_api.h	Sat Sep  5 20:36:46 2009	(r41016)
+++ branches/pluggable_runcore/include/parrot/runcore_api.h	Sat Sep  5 21:19:47 2009	(r41017)
@@ -60,6 +60,7 @@
     INTVAL          profiling_flags;
     FILE           *profile_fd;
     STRING         *profile_filename;
+    PMC            *prev_sub;
     Parrot_Context *prev_ctx;
     UINTVAL         level;      /* how many nested runloops */
     UINTVAL         time_size;  /* how big is the following array */

Modified: branches/pluggable_runcore/src/runcore/cores.c
==============================================================================
--- branches/pluggable_runcore/src/runcore/cores.c	Sat Sep  5 20:36:46 2009	(r41016)
+++ branches/pluggable_runcore/src/runcore/cores.c	Sat Sep  5 21:19:47 2009	(r41017)
@@ -1208,7 +1208,9 @@
         if (!postop_file_name) postop_file_name = unknown_file;
 
         /* if current context changed since the last time a CS line was printed... */
-        if ((runcore->prev_ctx != preop_ctx) || preop_sub != preop_ctx->current_sub) {
+        /* Occasionally the ctx stays the same while the sub changes, possible
+         * with a call to a subclass' method. */
+        if ((runcore->prev_ctx != preop_ctx) || runcore->prev_sub != preop_ctx->current_sub) {
 
             if (preop_ctx->current_sub) {
                 STRING *sub_name;
@@ -1231,6 +1233,7 @@
             }
 
             runcore->prev_ctx = preop_ctx;
+            runcore->prev_sub = preop_ctx->current_sub;
         }
 
         /* I'd expect that preop_info.line would be the right thing to use here

Modified: branches/pluggable_runcore/tools/dev/pprof2cg.pl
==============================================================================
--- branches/pluggable_runcore/tools/dev/pprof2cg.pl	Sat Sep  5 20:36:46 2009	(r41016)
+++ branches/pluggable_runcore/tools/dev/pprof2cg.pl	Sat Sep  5 21:19:47 2009	(r41017)
@@ -47,7 +47,7 @@
     }
     close(IN_FH);
 
-    #print_stats($stats);
+    print_stats($stats);
 
     unless ($filename =~ s/\.pprof\./.out./) {
         $filename = "$filename.out";
@@ -82,14 +82,19 @@
         #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 $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 $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);
 
             if ($is_first) {
                 $ctx_stack->[0] = $cs_hash;
             }
+            elsif ($new_sub_old_ctx) {
+                $ctx_stack->[0]{'sub'} = $cs_hash->{'sub'};
+                $ctx_stack->[0]{'ns'}  = $cs_hash->{'ns'};
+            }
             elsif ($is_redundant) {
                 #don't do anything
             }
@@ -138,12 +143,12 @@
     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}}) {
+                for my $op_num (0 .. $#{$stats->{$file}{$ns}{$line_num}}) {
 
-                    print "$file  $ns  line:$line_num  op:$op_numbr ";
+                    print "$file  $ns  line/op:$line_num/$op_num ";
 
-                    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_num] }) {
+                        print "{ $attr => $stats->{$file}{$ns}{$line_num}[$op_num]{$attr} } ";
                     }
                     print "\n";
                 }