[perl-devel-nytprof] r895 committed - Fixed problems with profiling forks....

[codesite...@google.com]

Revision: 895
Author: tim.bunce
Date: Thu Oct 29 10:45:04 2009
Log: Fixed problems with profiling forks.
Should fix
http://www.nntp.perl.org/group/perl.cpan.testers/2009/10/msg5789927.html
Added reporting of ZLIB_VERSION in the test output.
Adopted the convention that non-error trace messages start with "~ "
(only applied to trace level 1 and some level 2 so far)

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

Modified:
/trunk/NYTProf.xs
/trunk/slowops.h
/trunk/t/00-load.t
/trunk/t/60-forkdepth.t
/trunk/t/test30-fork-0.rdt

=======================================
--- /trunk/NYTProf.xs Wed Oct 28 14:45:45 2009
+++ /trunk/NYTProf.xs Thu Oct 29 10:45:04 2009
@@ -83,6 +83,9 @@
#else
#define default_compression_level 0
#endif
+#ifndef ZLIB_VERSION
+#define ZLIB_VERSION "0"
+#endif

#define NYTP_START_NO 0
#define NYTP_START_BEGIN 1
@@ -459,8 +462,9 @@
file->zs.zfree = (free_func) 0;
file->zs.opaque = 0;

- status = deflateInit2(&(file->zs), compression_level, Z_DEFLATED, 15,
- 9 /* memLevel */, Z_DEFAULT_STRATEGY);
+ status = deflateInit2(&(file->zs), compression_level, Z_DEFLATED,
+ 15 /* windowBits */,
+ 9 /* memLevel */, Z_DEFAULT_STRATEGY);
if (status != Z_OK) {
croak("deflateInit2 failed, error %d (%s)", status, file->zs.msg);
}
@@ -1833,8 +1837,8 @@
file = OutCopFILE(cop);
if (!last_executed_fid) { /* first time */
if (trace_level >= 1) {
- logwarn("NYTProf pid %ld: first statement line %d of %s\n",
- (long)getpid(), (int)CopLINE(cop), OutCopFILE(cop));
+ logwarn("~ first statement profiled at line %d of %s,
pid %ld\n",
+ (int)CopLINE(cop), OutCopFILE(cop), (long)getpid());
}
}
if (file != last_executed_fileptr) { /* cache (hit ratio ~50% e.g. for
perlcritic) */
@@ -2035,7 +2039,7 @@
croak("Failed to open output '%s': %s%s", filename,
strerror(fopen_errno), hint);
}
if (trace_level >= 1)
- logwarn("Opened %s\n", filename);
+ logwarn("~ opened %s\n", filename);

output_header(aTHX);
}
@@ -2064,12 +2068,14 @@
static int
reinit_if_forked(pTHX)
{
+ int open_new_file;
+
if (getpid() == last_pid)
- return 0; /* not forked */
+ return 0; /* not forked */

/* we're now the child process */
if (trace_level >= 1)
- logwarn("New pid %d (was %d) forkdepth %d\n", getpid(), last_pid,
profile_forkdepth);
+ logwarn("~ new pid %d (was %d) forkdepth %d\n", getpid(),
last_pid, profile_forkdepth);

/* reset state */
last_pid = getpid();
@@ -2078,25 +2084,28 @@
if (sub_callers_hv)
hv_clear(sub_callers_hv);

- if (out) {
+ open_new_file = (out) ? 1 : 0;
+ if (open_new_file) {
/* data that was unflushed in the parent when it forked
* is now duplicated unflushed in this child,
* so discard it when we close the inherited filehandle.
*/
NYTP_close(out, 1);
-
- if (profile_forkdepth == 0) {
- /* user doesn't want this child profiled */
- disable_profile(aTHX);
- }
- else {
- open_output_file(aTHX_ PROF_output_file);
- }
+ out = NULL;
+ /* if we fork while profiling then ensure we'll get a distinct
filename */
+ profile_opts |= NYTP_OPTf_ADDPID;
}

- if (profile_forkdepth > 0)
+ if (profile_forkdepth == 0) { /* parent doesn't want children profiled
*/
+ disable_profile(aTHX);
+ open_new_file = 0;
+ }
+ else /* count down another generation */
--profile_forkdepth;

+ if (open_new_file)
+ open_output_file(aTHX_ PROF_output_file);
+
return 1; /* have forked */
}

@@ -2246,7 +2255,7 @@

if ( (sprintf(called_subname_pv, "%s::%s",
subr_entry->called_subpkg_pv,
SvPV_nolen(subr_entry->called_subnam_sv)) >=
sizeof(called_subname_pv)) )
- croak("NYTProf called_subname_pv buffer overflow on '%s'\n",
called_subname_pv);
+ croak("~ called_subname_pv buffer overflow on '%s'\n",
called_subname_pv);

/* { called_subname => { "caller_subname[fid:line]" => [ count,
incl_time, ... ] } } */
sv_tmp = *hv_fetch(sub_callers_hv, called_subname_pv,
strlen(called_subname_pv), 1);
@@ -2301,7 +2310,7 @@
sv_inc(AvARRAY(subr_call_av)[NYTP_SCi_CALL_COUNT]);
}

- if (trace_level >= 3)
+ if (trace_level >= 4)
logwarn("%02d <- %s %"NVff"s excl = %"NVff"s incl - %"NVff"s
(%g-%g), oh %g-%g=%gt, d%d @%d:%d #%lu %p\n",
subr_entry->subr_prof_depth,
called_subname_pv,
@@ -2473,7 +2482,7 @@
subr_entry_ix = SSNEWa(sizeof(*subr_entry), MEM_ALIGNBYTES);
subr_entry = subr_entry_ix_ptr(subr_entry_ix);
if (subr_entry_ix <= prev_subr_entry_ix) {
- logwarn("NYTProf: stack is confused!\n");
+ logwarn("NYTProf panic: stack is confused!\n");
}
Zero(subr_entry, 1, subr_entry_t);

@@ -2833,7 +2842,7 @@
logwarn("unknown entersub %s assumed to be anon
called_cv '%s'\n",
what, SvPV_nolen(sub_sv));
}
- if (trace_level)
+ if (trace_level >= 9)
sv_dump(sub_sv);
}
subr_entry->called_subpkg_pv = stash_name;
@@ -2857,7 +2866,7 @@
if (!profile_subs)
subr_entry->already_counted++;

- if (trace_level >= 2) {
+ if (trace_level >= 3) {
logwarn("%02d ->%4s %s::%s from %s::%s (d%d, oh %"NVff"t,
sub %"NVff"s) #%lu\n",
subr_entry->subr_prof_depth,
(subr_entry->called_is_xs) ? subr_entry->called_is_xs : "sub",
@@ -2891,7 +2900,6 @@
DB_stmt(aTHX_ NULL, op);
return op;
}
-

static OP *
pp_leave_profiler(pTHX) /* handles OP_LEAVESUB,
OP_LEAVEEVAL, etc */
@@ -2901,6 +2909,13 @@
return op;
}

+static OP *
+pp_fork_profiler(pTHX) /* handles OP_FORK */
+{
+ OP *op = run_original_op(PL_op->op_type);
+ reinit_if_forked(aTHX);
+ return op;
+}

static OP *
pp_exit_profiler(pTHX) /* handles OP_EXIT,
OP_EXEC, etc */
@@ -2919,7 +2934,7 @@
int prev_is_profiling = is_profiling;

if (trace_level)
- logwarn("NYTProf enable_profile (previously %s) to %s\n",
+ logwarn("~ enable_profile (previously %s) to %s\n",
prev_is_profiling ? "enabled" : "disabled",
(file && *file) ? file : PROF_output_file);

@@ -2959,8 +2974,8 @@
is_profiling = 0;
}
if (trace_level)
- logwarn("NYTProf disable_profile (previously %s)\n",
- prev_is_profiling ? "enabled" : "disabled");
+ logwarn("~ disable_profile (previously %s, pid %d)\n",
+ prev_is_profiling ? "enabled" : "disabled", getpid());
return prev_is_profiling;
}

@@ -2971,8 +2986,8 @@
int saved_errno = errno;

if (trace_level >= 1)
- logwarn("finish_profile (last_pid %d, getpid %d,
overhead %"NVff"s, is_profiling %d)\n",
- last_pid, getpid(), cumulative_overhead_ticks/ticks_per_sec,
is_profiling);
+ logwarn("~ finish_profile (overhead %"NVff"s, is_profiling %d)\n",
+ cumulative_overhead_ticks/ticks_per_sec, is_profiling);

/* write data for final statement, unless DB_leave has already */
if (!profile_leave || opt_use_db_sub)
@@ -3010,7 +3025,17 @@
PL_perldb |= PERLDBf_LINE; /* line-by-line profiling via DB::DB
(if $DB::single true) */
PL_perldb |= PERLDBf_SINGLE; /* start (after BEGINs) with
single-step on XXX still needed? */
}
- if (opt_perldb) /* not documented - for testing only */
+
+ if (profile_opts & NYTP_OPTf_OPTIMIZE)
+ PL_perldb &= ~PERLDBf_NOOPT;
+ else PL_perldb |= PERLDBf_NOOPT;
+
+ if (profile_opts & NYTP_OPTf_SAVESRC) {
+ /* ask perl to keep the source lines so we can copy them */
+ PL_perldb |= PERLDBf_SAVESRC | PERLDBf_SAVESRC_NOSUBS;
+ }
+
+ if (opt_perldb) /* force a PL_perldb value - for testing only, not
documented */
PL_perldb = opt_perldb;

#ifdef HAS_CLOCK_GETTIME
@@ -3024,7 +3049,7 @@
/* downgrade to CLOCK_REALTIME if desired clock not available */
if (clock_gettime(profile_clock, &start_time) != 0) {
if (trace_level)
- logwarn("clock_gettime clock %d not available (%s) using
CLOCK_REALTIME instead\n",
+ logwarn("~ clock_gettime clock %d not available (%s) using
CLOCK_REALTIME instead\n",
profile_clock, strerror(errno));
profile_clock = CLOCK_REALTIME;
/* check CLOCK_REALTIME as well, just in case */
@@ -3038,19 +3063,10 @@
profile_clock = -1;
}
#endif
-
- if (profile_opts & NYTP_OPTf_OPTIMIZE)
- PL_perldb &= ~PERLDBf_NOOPT;
- else PL_perldb |= PERLDBf_NOOPT;
-
- if (profile_opts & NYTP_OPTf_SAVESRC) {
- /* ask perl to keep the source lines so we can copy them */
- PL_perldb |= PERLDBf_SAVESRC | PERLDBf_SAVESRC_NOSUBS;
- }

if (trace_level)
- logwarn("NYTProf init pid %d, clock %d, start %d\n",
- last_pid, profile_clock, profile_start);
+ logwarn("~ init_profiler for pid %d, clock %d, start %d,
perldb %lx\n",
+ last_pid, profile_clock, profile_start, PL_perldb);

if (get_hv("DB::sub", 0) == NULL) {
logwarn("NYTProf internal error - perl not in debug mode\n");
@@ -3063,7 +3079,7 @@
if (!svp || !SvIOK(*svp)) croak("Time::HiRes is required");
u2time = INT2PTR(int(*)(pTHX_ UV*), SvIV(*svp));
if (trace_level)
- logwarn("Using Time::HiRes %p\n", u2time);
+ logwarn("NYTProf using Time::HiRes %p\n", u2time);
#endif

/* create file id mapping hash */
@@ -3089,7 +3105,6 @@
PL_ppaddr[OP_LEAVEWRITE] = pp_leave_profiler;
PL_ppaddr[OP_LEAVEEVAL] = pp_leave_profiler;
PL_ppaddr[OP_LEAVETRY] = pp_leave_profiler;
- PL_ppaddr[OP_DUMP] = pp_leave_profiler;
PL_ppaddr[OP_RETURN] = pp_leave_profiler;
/* natural end of simple loop */
PL_ppaddr[OP_UNSTACK] = pp_leave_profiler;
@@ -3099,32 +3114,11 @@
PL_ppaddr[OP_EXEC] = pp_exit_profiler;
}
}
+ /* calls reinit_if_forked() asap after a fork */
+ PL_ppaddr[OP_FORK] = pp_fork_profiler;

if (profile_slowops) {
- /* possible list of sys ops to profile:
- sysopen open close readline rcatline getc read
- print prtf sysread syswrite send recv
- eof tell seek sysseek readdir telldir seekdir rewinddir
- rand srand dbmopen dbmclose
- stat lstat readlink link unlink rename symlink truncate
- sselect select pipe_op bind connect listen accept shutdown
- ftatime ftblk ftchr ftctime ftdir fteexec fteowned fteread
- ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned
- ftrread ftsgid ftsize ftsock ftsuid fttty ftzero ftrwrite
ftsvtx
- fttext ftbinary custom
- ghbyname ghbyaddr ghostent shostent ehostent -- hosts
- gnbyname gnbyaddr gnetent snetent enetent -- networks
- gpbyname gpbynumber gprotoent sprotoent eprotoent -- protocols
- gsbyname gsbyport gservent sservent eservent -- services
- gpwnam gpwuid gpwent spwent epwent getlogin -- users
- ggrnam ggrgid ggrent sgrent egrent -- groups
- open_dir closedir mkdir rmdir utime chmod chown fcntl
- backtick system fork wait waitpid glob
- msgget msgrcv msgsnd semget semop
- chdir flock ioctl sleep syscall dump chroot
- Perhaps make configurable. Could interate with Opcode module.
- */
- /* XXX this will turn into a loop over an array that maps
+ /* XXX this should turn into a loop over an array that maps
* opcodes to the subname we'll use: OP_PRTF => "printf"
*/
#include "slowops.h"
@@ -3156,8 +3150,8 @@
get_time_of_day(start_time);
}

- if (trace_level >= 3)
- logwarn("NYTProf init done\n");
+ if (trace_level >= 2)
+ logwarn("~ init_profiler done\n");

return 1;
}
@@ -3263,7 +3257,7 @@
unsigned int fid;

if (trace_level >= 2)
- logwarn("writing sub line ranges\n");
+ logwarn("~ writing sub line ranges\n");

/* Skim through PL_DBsub hash to build a package to filename hash
* by associating the package part of the sub_name in the key
@@ -3383,7 +3377,7 @@
if (!sub_callers_hv)
return;
if (trace_level >= 2)
- logwarn("writing sub callers\n");
+ logwarn("~ writing sub callers\n");

hv_iterinit(sub_callers_hv);
while (NULL != (fid_line_rvhv = hv_iternextsv(sub_callers_hv,
&called_subname, &called_subname_len))) {
@@ -3465,8 +3459,8 @@
int t_no_src = 0;
long t_lines = 0;

- if (trace_level >= 1)
- logwarn("writing file source code\n");
+ if (trace_level >= 2)
+ logwarn("~ writing file source code\n");

for (e = hashtable.first_inserted; e; e = (Hash_entry
*)e->next_inserted) {
I32 lines;
@@ -3520,8 +3514,8 @@
}
}

- if (trace_level >= 1)
- logwarn("wrote %ld source lines for %d files (%d skipped without
savesrc option, %d others had no source available)\n",
+ if (trace_level >= 2)
+ logwarn("~ wrote %ld source lines for %d files (%d skipped without
savesrc option, %d others had no source available)\n",
t_lines, t_save_src, t_has_src-t_save_src, t_no_src);
}

@@ -4545,6 +4539,7 @@
newCONSTSUB(stash, "NYTP_SCi_CALLING_SUB",
newSViv(NYTP_SCi_CALLING_SUB));
/* others */
newCONSTSUB(stash, "NYTP_DEFAULT_COMPRESSION",
newSViv(default_compression_level));
+ newCONSTSUB(stash, "NYTP_ZLIB_VERSION", newSVpv(ZLIB_VERSION, 0));
}

@@ -4639,8 +4634,8 @@
}
else if (profile_start == NYTP_START_END) {
SV *enable_profile_sv = (SV *)get_cv("DB::enable_profile",
GV_ADDWARN);
- if (trace_level >= 1)
- logwarn("enable_profile defered until END\n");
+ if (trace_level >= 2)
+ logwarn("~ enable_profile defered until END\n");
av_unshift(PL_endav, 1); /* we want to be first */
av_store(PL_endav, 0, SvREFCNT_inc(enable_profile_sv));
}
@@ -4649,6 +4644,8 @@
* so it's likely to be the last thing run.
*/
av_push(PL_endav, (SV *)get_cv("DB::finish_profile", GV_ADDWARN));
+ if (trace_level >= 2)
+ logwarn("~ INIT done\n");

=======================================
--- /trunk/slowops.h Wed Oct 28 14:21:24 2009
+++ /trunk/slowops.h Thu Oct 29 10:45:04 2009
@@ -25,7 +25,6 @@
PL_ppaddr[OP_ESERVENT] = pp_slowop_profiler;
PL_ppaddr[OP_FCNTL] = pp_slowop_profiler;
PL_ppaddr[OP_FLOCK] = pp_slowop_profiler;
-PL_ppaddr[OP_FORK] = pp_slowop_profiler;
PL_ppaddr[OP_FORMLINE] = pp_slowop_profiler;
PL_ppaddr[OP_FTATIME] = pp_slowop_profiler;
PL_ppaddr[OP_FTBINARY] = pp_slowop_profiler;
=======================================
--- /trunk/t/00-load.t Tue Jun 23 13:33:57 2009
+++ /trunk/t/00-load.t Thu Oct 29 10:45:04 2009
@@ -10,9 +10,13 @@

diag( "Testing Devel::NYTProf $Devel::NYTProf::Core::VERSION on perl $]
$Config{archname}" );

-use_ok( 'Devel::NYTProf::Constants', qw(NYTP_DEFAULT_COMPRESSION) );
-
-diag( sprintf "default compression level is %d",
NYTP_DEFAULT_COMPRESSION() );
+use_ok( 'Devel::NYTProf::Constants', qw(
+ NYTP_DEFAULT_COMPRESSION NYTP_ZLIB_VERSION
+) );
+
+diag( sprintf "Compression: default level is %d, zlib version %s",
+ NYTP_DEFAULT_COMPRESSION(), NYTP_ZLIB_VERSION()
+);

if ("$Config{archname} $Config{osvers}" =~ /\b xen \b/x) {
diag("It looks like this is running inside a Xen virtual machine.");
=======================================
--- /trunk/t/60-forkdepth.t Sat Oct 24 08:56:24 2009
+++ /trunk/t/60-forkdepth.t Thu Oct 29 10:45:04 2009
@@ -21,13 +21,14 @@

sub run_forkdepth {
my ($forkdepth) = @_;
+ printf "run_forkdepth %s\n", defined($forkdepth) ?
$forkdepth : "undef";

unlink $_ for glob("$out.*");

- $ENV{NYTPROF} = "file=$out:addpid=1";
+ $ENV{NYTPROF} = "file=$out:addpid=1:trace=0";
$ENV{NYTPROF} .= ":forkdepth=$forkdepth" if defined $forkdepth;

- my $forkdepth_cmd = q{-d:NYTProf -e "fork and wait,exit 0; fork and
wait"};
+ my $forkdepth_cmd = q{-d:NYTProf -e "sub f { fork or return; wait;
exit \$? } f; f; exit 0"};
run_perl_command($forkdepth_cmd);

my @files = glob("$out.*");
=======================================
--- /trunk/t/test30-fork-0.rdt Thu Oct 22 07:42:40 2009
+++ /trunk/t/test30-fork-0.rdt Thu Oct 29 10:45:04 2009
@@ -22,7 +22,6 @@
fid_block_time 1 22 [ 0 1 ]
fid_fileinfo 1 [ test30-fork-0.p 1 2 0 0 ]
fid_fileinfo 1 sub main::BEGIN 0-0
-fid_fileinfo 1 sub main::CORE:fork 0-0
fid_fileinfo 1 sub main::CORE:print 0-0
fid_fileinfo 1 sub main::CORE:wait 0-0
fid_fileinfo 1 sub main::RUNTIME 1-1
@@ -35,7 +34,6 @@
fid_fileinfo 1 call 11 main::CORE:print [ 1 0 0 0 0 0 0 main::postfork ]
fid_fileinfo 1 call 12 main::other [ 1 0 0 0 0 0 0 main::postfork ]
fid_fileinfo 1 call 15 main::prefork [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 17 main::CORE:fork [ 1 0 0 0 0 0 0 main::RUNTIME ]
fid_fileinfo 1 call 19 main::postfork [ 1 0 0 0 0 0 0 main::RUNTIME ]
fid_fileinfo 1 call 20 main::other [ 1 0 0 0 0 0 0 main::RUNTIME ]
fid_fileinfo 1 call 22 main::CORE:wait [ 1 0 0 0 0 0 0 main::RUNTIME ]
@@ -61,8 +59,6 @@
profile_modes fid_line_time line
profile_modes fid_sub_time sub
sub_subinfo main::BEGIN [ 1 0 0 0 0 0 0 0 ]
-sub_subinfo main::CORE:fork [ 1 0 0 1 0 0 0 0 ]
-sub_subinfo main::CORE:fork called_by 1 17 [ 1 0 0 0 0 0 0 main::RUNTIME ]
sub_subinfo main::CORE:print [ 1 0 0 5 0 0 0 0 ]
sub_subinfo main::CORE:print called_by 1 2 [ 1 0 0 0 0 0 0 main::prefork ]
sub_subinfo main::CORE:print called_by 1 7 [ 3 0 0 0 0 0 0 main::other ]