Revision: 1323
Author: [email protected]
Date: Wed Jul 7 10:05:28 2010
Log: Profile records presence of the slow regex match vars ($& $' $`).
(not included in reports yet)
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1323
Modified:
/trunk/Changes
/trunk/FileHandle.h
/trunk/FileHandle.xs
/trunk/NYTProf.xs
/trunk/demo/demo-code.pl
/trunk/lib/Devel/NYTProf/Data.pm
/trunk/t/test14.rdt
=======================================
--- /trunk/Changes Mon Jun 28 01:14:14 2010
+++ /trunk/Changes Wed Jul 7 10:05:28 2010
@@ -14,6 +14,9 @@
=head2 Changes in Devel::NYTProf 4.04
+ Profile records presence of the slow regex match vars ($& $' $`).
+XXX not included in reports yet
+
Trace log messages are now flushed immediately.
Reduced risk of crashes in embedded applications that don't handle
PL_endav
carefully, like mod_perl.
=======================================
--- /trunk/FileHandle.h Tue Jun 1 06:17:33 2010
+++ /trunk/FileHandle.h Wed Jul 7 10:05:28 2010
@@ -58,6 +58,7 @@
#define NYTP_TAG_STRING '\''
#define NYTP_TAG_STRING_UTF8 '"'
#define NYTP_TAG_START_DEFLATE 'z'
+/* also add new items to nytp_tax_index below */
typedef enum {
nytp_no_tag,
@@ -95,6 +96,7 @@
unsigned int ppid, NV time_of_day);
size_t NYTP_write_process_end(NYTP_file ofile, unsigned int pid,
NV time_of_day);
+size_t NYTP_write_sawampersand(NYTP_file ofile, unsigned int fid, unsigned
int line);
size_t NYTP_write_new_fid(NYTP_file ofile, unsigned int id,
unsigned int eval_fid, unsigned int
eval_line_num,
unsigned int flags, unsigned int size,
=======================================
--- /trunk/FileHandle.xs Tue Jun 1 06:17:55 2010
+++ /trunk/FileHandle.xs Wed Jul 7 10:05:28 2010
@@ -886,6 +886,23 @@
return total;
}
+
+size_t
+NYTP_write_sawampersand(NYTP_file ofile, unsigned int fid, unsigned int
line)
+{
+ size_t total;
+ size_t retval;
+
+ total += retval = NYTP_write_attribute_unsigned(ofile,
STR_WITH_LEN("sawampersand_fid"), fid);
+ if (retval < 1)
+ return retval;
+
+ total += retval = NYTP_write_attribute_unsigned(ofile,
STR_WITH_LEN("sawampersand_line"), line);
+ if (retval < 1)
+ return retval;
+
+ return total;
+}
size_t
NYTP_write_new_fid(NYTP_file ofile, unsigned int id, unsigned int eval_fid,
=======================================
--- /trunk/NYTProf.xs Mon Jun 28 01:14:14 2010
+++ /trunk/NYTProf.xs Wed Jul 7 10:05:28 2010
@@ -329,6 +329,7 @@
static char *last_executed_fileptr;
static unsigned int last_block_line;
static unsigned int last_sub_line;
+static bool last_sawampersand;
static unsigned int is_profiling; /* disable_profile() &
enable_profile() */
static Pid_t last_pid;
static NV cumulative_overhead_ticks = 0.0;
@@ -374,6 +375,15 @@
static HV *sub_callers_hv;
static HV *pkg_fids_hv; /* currently just package names */
+#define CHECK_SAWAMPERSAND(fid,line) STMT_START { \
+ if (PL_sawampersand != last_sawampersand) { \
+ if (trace_level >= 1) \
+ logwarn("Slow regex match variable seen (first noted
at %u:%u)\n", fid, line); \
+ NYTP_write_sawampersand(out, fid, line); \
+ last_sawampersand = PL_sawampersand; \
+ } \
+} STMT_END
+
/* macros for outputing profile data */
#ifndef HAS_GETPPID
#define getppid() 0
@@ -1376,6 +1386,8 @@
reinit_if_forked(aTHX);
+ CHECK_SAWAMPERSAND(last_executed_fid, last_executed_line);
+
if (last_executed_fid) {
if (profile_blocks)
NYTP_write_time_block(out, elapsed, last_executed_fid,
@@ -2421,8 +2433,10 @@
return run_original_op(op_type);
}
- if (!profile_stmts)
+ if (!profile_stmts) {
reinit_if_forked(aTHX);
+ CHECK_SAWAMPERSAND(last_executed_fid, last_executed_line);
+ }
if (trace_level >= 99) {
logwarn("profiling a call [op %ld, %s, seix %d]\n",
@@ -3213,7 +3227,7 @@
}
if (trace_level >= 1)
- logwarn("~ writing sub line ranges of %ld subs\n", HvKEYS(hv));
+ logwarn("~ writing sub line ranges of %ld subs\n",
(long)HvKEYS(hv));
/* Iterate over PL_DBsub writing out fid and source line range of subs.
* If filename is missing (i.e., because it's an xsub so has no source
file)
@@ -3270,7 +3284,7 @@
if (!sub_callers_hv)
return;
if (trace_level >= 1)
- logwarn("~ writing sub callers for %ld subs\n",
HvKEYS(sub_callers_hv));
+ logwarn("~ writing sub callers for %ld subs\n",
(long)HvKEYS(sub_callers_hv));
hv_iterinit(sub_callers_hv);
while (NULL != (fid_line_rvhv = hv_iternextsv(sub_callers_hv,
&called_subname, &called_subname_len))) {
=======================================
--- /trunk/demo/demo-code.pl Sun May 30 01:17:44 2010
+++ /trunk/demo/demo-code.pl Wed Jul 7 10:05:28 2010
@@ -28,6 +28,10 @@
# With all line profilers except NYTProf, the time for that expression
gets
# assigned to the previous statement, i.e., the last statement
executed in foo()!
foo() && 'aaaaaaaaaaa' =~ /((a{0,5}){0,5})*[c]/;
+
+ # $&, $' and $` cause global slowdown in regex performance
+ my $dummy = $&;
+
1;
}
=======================================
--- /trunk/lib/Devel/NYTProf/Data.pm Thu Jun 17 07:51:01 2010
+++ /trunk/lib/Devel/NYTProf/Data.pm Wed Jul 7 10:05:28 2010
@@ -542,8 +542,8 @@
$profile->normalize_variables;
Traverses the profile data structure and normalizes highly variable data,
such
-as the time, in order that the data can more easily be compared. This is
used,
-for example, by the test suite.
+as the time, in order that the data can more easily be compared. This is
mainly of
+use to the test suite.
The data normalized is:
@@ -582,9 +582,9 @@
basetime xs_version perl_version clock_id ticks_per_sec nv_size
profiler_duration profiler_end_time profiler_start_time
total_stmts_duration total_stmts_measured total_stmts_discounted
- total_sub_calls
+ total_sub_calls sawampersand_line
)) {
- $attributes->{$attr} = 0;
+ $attributes->{$attr} = 0 if exists $attributes->{$attr};
}
for my $attr (qw(PL_perldb)) {
=======================================
--- /trunk/t/test14.rdt Tue Jun 1 04:28:28 2010
+++ /trunk/t/test14.rdt Wed Jul 7 10:05:28 2010
@@ -7,6 +7,8 @@
attribute profiler_duration 0
attribute profiler_end_time 0
attribute profiler_start_time 0
+attribute sawampersand_fid 3
+attribute sawampersand_line 0
attribute ticks_per_sec 0
attribute total_stmts_discounted 0
attribute total_stmts_duration 0
--
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]
