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 ] --~--~---------~--~----~------------~-------~--~----~ 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] -~----------~----~----~----~------~----~------~--~---
