Revision: 840
Author: tim.bunce
Date: Mon Jul 20 21:31:58 2009
Log: Fix goto'd subs to not be treated as xsubs in perl 5.10
Moved list of slowops out to a .h file and added a few more for now.
Sync'd test16 results for perl 5.10

http://code.google.com/p/perl-devel-nytprof/source/detail?r=840

Added:
  /trunk/slowops.h
Modified:
  /trunk/MANIFEST
  /trunk/NYTProf.xs
  /trunk/t/test16.rdt

=======================================
--- /dev/null
+++ /trunk/slowops.h    Mon Jul 20 21:31:58 2009
@@ -0,0 +1,19 @@
+PL_ppaddr[OP_CLOSEDIR] = pp_slowop_profiler;
+PL_ppaddr[OP_CLOSE] = pp_slowop_profiler;
+PL_ppaddr[OP_MATCH] = pp_slowop_profiler;
+PL_ppaddr[OP_OPEN] = pp_slowop_profiler;
+PL_ppaddr[OP_OPEN_DIR] = pp_slowop_profiler;
+PL_ppaddr[OP_RAND] = pp_slowop_profiler;
+PL_ppaddr[OP_READDIR] = pp_slowop_profiler;
+PL_ppaddr[OP_READLINE] = pp_slowop_profiler;
+PL_ppaddr[OP_READ] = pp_slowop_profiler;
+PL_ppaddr[OP_SELECT] = pp_slowop_profiler;
+PL_ppaddr[OP_SLEEP] = pp_slowop_profiler;
+PL_ppaddr[OP_SRAND] = pp_slowop_profiler;
+PL_ppaddr[OP_STAT] = pp_slowop_profiler;
+PL_ppaddr[OP_SUBST] = pp_slowop_profiler;
+PL_ppaddr[OP_WAIT] = pp_slowop_profiler;
+PL_ppaddr[OP_SYSOPEN] = pp_slowop_profiler;
+/*PL_ppaddr[OP_PRINT] = pp_slowop_profiler;*/
+PL_ppaddr[OP_PRTF] = pp_slowop_profiler;
+PL_ppaddr[OP_RENAME] = pp_slowop_profiler;
=======================================
--- /trunk/MANIFEST     Wed Jul 15 14:22:57 2009
+++ /trunk/MANIFEST     Mon Jul 20 21:31:58 2009
@@ -34,6 +34,7 @@
  lib/Devel/NYTProf/js/style-tablesorter.css
  perftest.pl
  ppport.h
+slowops.h
  t/00-load.t
  t/22-readstream.t
  t/30-util.t
=======================================
--- /trunk/NYTProf.xs   Mon Jul 20 11:56:41 2009
+++ /trunk/NYTProf.xs   Mon Jul 20 21:31:58 2009
@@ -43,6 +43,9 @@
  #ifndef PERLDBf_SAVESRC_NOSUBS
  #define PERLDBf_SAVESRC_NOSUBS 0
  #endif
+#ifndef CvISXSUB
+#define CvISXSUB CvXSUB
+#endif

  #if (PERL_VERSION < 8) || ((PERL_VERSION == 8) && (PERL_SUBVERSION < 8))
  /* If we're using DB::DB() instead of opcode redirection with an old perl
@@ -2194,7 +2197,7 @@
      /* { called_subname => { "caller_subname[fid:line]" => [ count,  
incl_time, ... ] } } */
      sv_tmp = *hv_fetch(sub_callers_hv, called_subname_pv,  
strlen(called_subname_pv), 1);

-    if (!SvROK(sv_tmp)) { /* autoviv hash ref - is first call of this  
subname from anywhere */
+    if (!SvROK(sv_tmp)) { /* autoviv hash ref - is first call of this  
called subname from anywhere */
          HV *hv = newHV();
          sv_setsv(sv_tmp, newRV_noinc((SV *)hv));

@@ -2214,7 +2217,8 @@
                      * corresonding .pm file using the package part of the  
subname.
                      */
                  SV *sv = *hv_fetch(GvHV(PL_DBsub), called_subname_pv,  
strlen(called_subname_pv), 1);
-                sv_setpv(sv, ":0-0"); /* empty file name */
+                if (!SvOK(sv))
+                    sv_setpv(sv, ":0-0"); /* empty file name */
                  if (trace_level >= 2)
                      logwarn("Adding fake DBsub entry for '%s' xsub\n",  
called_subname_pv);
              }
@@ -2403,7 +2407,7 @@
      subr_entry->initial_subr_secs      = cumulative_subr_secs;
      subr_entry->subr_call_seqn         = ++cumulative_subr_seqn;
      subr_entry->called_subnam_sv       = &PL_sv_undef; /* see  
incr_sub_inclusive_time */
-    subr_entry->called_is_xs           = "?"; /* we don't know yet */
+    subr_entry->called_is_xs           = NULL; /* we don't know yet */

      file = OutCopFILE(prev_cop);
      subr_entry->caller_fid = (file == last_executed_fileptr)
@@ -2627,7 +2631,7 @@
      else {
          if (op_type == OP_GOTO) {
              /* use the called_cv that was the arg to the goto op */
-            is_xs = (CvXSUB(called_cv)) ? "xsub" : NULL;
+            is_xs = (CvISXSUB(called_cv)) ? "xsub" : NULL;
          }
          else
          if (op != next_op) {   /* have entered a sub */
@@ -2967,21 +2971,7 @@
          /* XXX this will turn into a loop over an array that maps
           * opcodes to the subname we'll use: OP_PRTF => "printf"
           */
-        PL_ppaddr[OP_SLEEP] = pp_slowop_profiler;
-        PL_ppaddr[OP_OPEN] = pp_slowop_profiler;
-        PL_ppaddr[OP_CLOSE] = pp_slowop_profiler;
-        PL_ppaddr[OP_READ] = pp_slowop_profiler;
-        PL_ppaddr[OP_READLINE] = pp_slowop_profiler;
-        PL_ppaddr[OP_STAT] = pp_slowop_profiler;
-        PL_ppaddr[OP_OPEN_DIR] = pp_slowop_profiler;
-        PL_ppaddr[OP_CLOSEDIR] = pp_slowop_profiler;
-        PL_ppaddr[OP_READDIR] = pp_slowop_profiler;
-        PL_ppaddr[OP_RAND] = pp_slowop_profiler;
-        PL_ppaddr[OP_SRAND] = pp_slowop_profiler;
-        PL_ppaddr[OP_WAIT] = pp_slowop_profiler;
-        PL_ppaddr[OP_SELECT] = pp_slowop_profiler;
-        PL_ppaddr[OP_MATCH] = pp_slowop_profiler;
-        PL_ppaddr[OP_SUBST] = pp_slowop_profiler;
+#include "slowops.h"
      }

      /* redirect opcodes for caller tracking */
=======================================
--- /trunk/t/test16.rdt Thu Jul 16 02:29:49 2009
+++ /trunk/t/test16.rdt Mon Jul 20 21:31:58 2009
@@ -27,10 +27,10 @@
  fid_fileinfo  1       call    11      main::CORE:match        [ 2 0 0 0 0 0 0 
main::foo ]
  fid_fileinfo  1       call    14      main::CORE:match        [ 1 0 0 0 0 0 0 
main::foo ]
  fid_fileinfo  1       call    22      main::CORE:match        [ 3 0 0 0 0 0 0 
main::bar ]
-fid_fileinfo   1       call    30      main::foo       [ 1 0 0 0 0 0 0 
main::BEGIN ]
-fid_fileinfo   1       call    31      main::foo       [ 1 0 0 0 0 0 0 
main::BEGIN ]
-fid_fileinfo   1       call    32      main::bar       [ 1 0 0 0 0 0 0 
main::BEGIN ]
-fid_fileinfo   1       call    33      main::bar       [ 1 0 0 0 0 0 0 
main::BEGIN ]
+fid_fileinfo   1       call    30      main::foo       [ 1 0 0 0 0 0 0 
main::RUNTIME ]
+fid_fileinfo   1       call    31      main::foo       [ 1 0 0 0 0 0 0 
main::RUNTIME ]
+fid_fileinfo   1       call    32      main::bar       [ 1 0 0 0 0 0 0 
main::RUNTIME ]
+fid_fileinfo   1       call    33      main::bar       [ 1 0 0 0 0 0 0 
main::RUNTIME ]
  fid_line_time 1       9       [ 0 2 ]
  fid_line_time 1       10      [ 0 2 ]
  fid_line_time 1       11      [ 0 2 ]
@@ -56,8 +56,8 @@
  sub_subinfo   main::CORE:match        called_by       1       14      [ 1 0 0 
0 0 0 0 main::foo ]
  sub_subinfo   main::CORE:match        called_by       1       22      [ 3 0 0 
0 0 0 0 main::bar ]
  sub_subinfo   main::bar       [ 1 20 27 2 0 0 0 0 ]
-sub_subinfo    main::bar       called_by       1       32      [ 1 0 0 0 0 0 0 
main::BEGIN ]
-sub_subinfo    main::bar       called_by       1       33      [ 1 0 0 0 0 0 0 
main::BEGIN ]
+sub_subinfo    main::bar       called_by       1       32      [ 1 0 0 0 0 0 0 
main::RUNTIME ]
+sub_subinfo    main::bar       called_by       1       33      [ 1 0 0 0 0 0 0 
main::RUNTIME ]
  sub_subinfo   main::foo       [ 1 8 18 2 0 0 0 0 ]
-sub_subinfo    main::foo       called_by       1       30      [ 1 0 0 0 0 0 0 
main::BEGIN ]
-sub_subinfo    main::foo       called_by       1       31      [ 1 0 0 0 0 0 0 
main::BEGIN ]
+sub_subinfo    main::foo       called_by       1       30      [ 1 0 0 0 0 0 0 
main::RUNTIME ]
+sub_subinfo    main::foo       called_by       1       31      [ 1 0 0 0 0 0 0 
main::RUNTIME ]

--~--~---------~--~----~------------~-------~--~----~
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.

Group hosted at:  http://groups.google.com/group/develnytprof-dev
Project hosted at:  http://perl-devel-nytprof.googlecode.com
CPAN distribution:  http://search.cpan.org/dist/Devel-NYTProf

To post, email:  [email protected]
To unsubscribe, email:  [email protected]
-~----------~----~----~----~------~----~------~--~---

Reply via email to