New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
DTrace probes for loading-file, loaded-file, op-entry #12361
Comments
From p5p@sartak.orgThis is a bug report for perl from p5p@sartak.org, These two patches add two additional sets of DTrace probes: The patches include documentation and tests. Flags: Site configuration information for perl 5.17.3: Configured by sartak at Fri Aug 24 11:18:40 CEST 2012. Summary of my perl5 (revision 5 version 17 subversion 3) configuration: Locally applied patches: @INC for perl 5.17.3: Environment for perl 5.17.3: PATH=/Users/sartak/.perl/bin:/Users/sartak/.perl/perls/dtrace/bin:/Users/sartak/.bin:/Users/sartak/.versioned-bin:/Users/sartak/devel/anki-bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:/usr/X11/bin PERLBREW_PATH=/Users/sartak/.perl/bin:/Users/sartak/.perl/perls/dtrace/bin |
From p5p@sartak.org0001-op-entry-DTrace-probe.patchFrom cccc7b615b0874bf9ec30a6c21a77cc695e4732b Mon Sep 17 00:00:00 2001
From: Shawn M Moore <code@sartak.org>
Date: Fri, 24 Aug 2012 10:35:08 +0200
Subject: [PATCH 1/2] "op-entry" DTrace probe
---
dump.c | 2 ++
mydtrace.h | 12 ++++++++++++
perldtrace.d | 2 ++
pod/perldtrace.pod | 33 +++++++++++++++++++++++++++++++++
run.c | 2 ++
t/run/dtrace.t | 24 ++++++++++++++++++++++--
6 files changed, 73 insertions(+), 2 deletions(-)
diff --git a/dump.c b/dump.c
index 0733b30..ada6ae9 100644
--- a/dump.c
+++ b/dump.c
@@ -2129,6 +2129,8 @@ Perl_runops_debug(pTHX)
if (DEBUG_t_TEST_) debop(PL_op);
if (DEBUG_P_TEST_) debprof(PL_op);
}
+
+ OP_ENTRY_PROBE(OP_NAME(PL_op));
} while ((PL_op = PL_op->op_ppaddr(aTHX)));
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
diff --git a/mydtrace.h b/mydtrace.h
index 1c969ee..8ee130f 100644
--- a/mydtrace.h
+++ b/mydtrace.h
@@ -32,6 +32,12 @@
PERL_SUB_RETURN(tmp_func, file, line, stash); \
}
+# define OP_ENTRY_PROBE(name) \
+ if (PERL_OP_ENTRY_ENABLED()) { \
+ const char *tmp_name = name; \
+ PERL_OP_ENTRY(tmp_name, file, line, stash); \
+ }
+
# else
# define ENTRY_PROBE(func, file, line, stash) \
@@ -44,6 +50,11 @@
PERL_SUB_RETURN(func, file, line, stash); \
}
+# define OP_ENTRY_PROBE(name) \
+ if (PERL_OP_ENTRY_ENABLED()) { \
+ PERL_OP_ENTRY(name); \
+ }
+
# endif
# define PHASE_CHANGE_PROBE(new_phase, old_phase) \
@@ -57,6 +68,7 @@
# define ENTRY_PROBE(func, file, line, stash)
# define RETURN_PROBE(func, file, line, stash)
# define PHASE_CHANGE_PROBE(new_phase, old_phase)
+# define OP_ENTRY_PROBE(name)
#endif
diff --git a/perldtrace.d b/perldtrace.d
index 8c051f6..f352b31 100644
--- a/perldtrace.d
+++ b/perldtrace.d
@@ -8,6 +8,8 @@ provider perl {
probe sub__return(const char *, const char *, int, const char *);
probe phase__change(const char *, const char *);
+
+ probe op__entry(const char *);
};
/*
diff --git a/pod/perldtrace.pod b/pod/perldtrace.pod
index 39551e1..60a9370 100644
--- a/pod/perldtrace.pod
+++ b/pod/perldtrace.pod
@@ -55,6 +55,10 @@ package name of the function.
The C<phase-change> probe was added.
+=item 5.18.0
+
+The C<op-entry> probe was added.
+
=back
=head1 PROBES
@@ -97,6 +101,17 @@ C<${^GLOBAL_PHASE}> reports.
copyinstr(arg1), copyinstr(arg0));
}
+=item op-entry(OPNAME)
+
+Traces the execution of each opcode in the Perl runloop. This probe
+is fired before the opcode is executed. When the Perl debugger is
+enabled, the DTrace probe is fired I<after> the debugger hooks (but
+still before the opcode itself is executed).
+
+ :*perl*::op-entry {
+ printf("About to execute opcode %s\n", copyinstr(arg0));
+ }
+
=back
=head1 EXAMPLES
@@ -156,6 +171,14 @@ C<${^GLOBAL_PHASE}> reports.
read 374
stat64 1056
+=item Perl functions that execute the most opcodes
+
+ # dtrace -qZn 'sub-entry { self->fqn = strjoin(copyinstr(arg3), strjoin("::", copyinstr(arg0))) } op-entry /self->fqn != ""/ { @[self->fqn] = count() } END { trunc(@, 3) }'
+
+ warnings::unimport 4589
+ Exporter::Heavy::_rebuild_cache 5039
+ Exporter::import 14578
+
=back
=head1 REFERENCES
@@ -172,6 +195,16 @@ L<http://www.amazon.com/DTrace-Dynamic-Tracing-Solaris-FreeBSD/dp/0132091518/>
=back
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Devel::DTrace::Provider>
+
+This CPAN module lets you create application-level DTrace probes written in Perl.
+
+=back
+
=head1 AUTHORS
Shawn M Moore C<sartak@gmail.com>
diff --git a/run.c b/run.c
index 8c2622a..01b5f06 100644
--- a/run.c
+++ b/run.c
@@ -38,7 +38,9 @@ Perl_runops_standard(pTHX)
{
dVAR;
OP *op = PL_op;
+ OP_ENTRY_PROBE(OP_NAME(op));
while ((PL_op = op = op->op_ppaddr(aTHX))) {
+ OP_ENTRY_PROBE(OP_NAME(op));
}
TAINT_NOT;
diff --git a/t/run/dtrace.t b/t/run/dtrace.t
index 625e403..183868d 100644
--- a/t/run/dtrace.t
+++ b/t/run/dtrace.t
@@ -24,7 +24,7 @@ use strict;
use warnings;
use IPC::Open2;
-plan(tests => 5);
+plan(tests => 7);
dtrace_like(
'1',
@@ -117,6 +117,21 @@ PHASES
'make sure sub-entry and phase-change interact well',
);
+dtrace_like(<< 'PERL_SCRIPT',
+ my $tmp = "foo";
+ $tmp =~ s/f/b/;
+ chop $tmp;
+PERL_SCRIPT
+ << 'D_SCRIPT',
+ op-entry { printf("op-entry <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+ [
+ qr/op-entry <subst>/,
+ qr/op-entry <schop>/,
+ ],
+ 'basic op probe',
+);
+
sub dtrace_like {
my $perl = shift;
my $probes = shift;
@@ -152,6 +167,11 @@ sub dtrace_like {
die "Unexpected error from DTrace: $result"
if $child_exit_status != 0;
- like($result, $expected, $name);
+ if (ref($expected) eq 'ARRAY') {
+ like($result, $_, $name) for @$expected;
+ }
+ else {
+ like($result, $expected, $name);
+ }
}
--
1.7.11.2
|
From p5p@sartak.org0002-loading-file-and-loaded-file-DTrace-probes.patchFrom 0777ae979ff5796951874d5ce75af29b2b8f01e4 Mon Sep 17 00:00:00 2001
From: Shawn M Moore <code@sartak.org>
Date: Sun, 19 Aug 2012 17:12:27 +0200
Subject: [PATCH 2/2] "loading-file" and "loaded-file" DTrace probes
---
mydtrace.h | 24 ++++++++++++++++++++++++
perldtrace.d | 3 +++
pod/perldtrace.pod | 27 ++++++++++++++++++++++++++-
pp_ctl.c | 4 ++++
t/run/dtrace.pl | 1 +
t/run/dtrace.t | 21 ++++++++++++++++++++-
6 files changed, 78 insertions(+), 2 deletions(-)
create mode 100644 t/run/dtrace.pl
diff --git a/mydtrace.h b/mydtrace.h
index 8ee130f..951d177 100644
--- a/mydtrace.h
+++ b/mydtrace.h
@@ -38,6 +38,18 @@
PERL_OP_ENTRY(tmp_name, file, line, stash); \
}
+# define LOADING_FILE_PROBE(name) \
+ if (PERL_LOADING_FILE_ENABLED()) { \
+ const char *tmp_name = name; \
+ PERL_LOADING_FILE(tmp_name); \
+ }
+
+# define LOADED_FILE_PROBE(name) \
+ if (PERL_LOADED_FILE_ENABLED()) { \
+ const char *tmp_name = name; \
+ PERL_LOADED_FILE(tmp_name); \
+ }
+
# else
# define ENTRY_PROBE(func, file, line, stash) \
@@ -55,6 +67,16 @@
PERL_OP_ENTRY(name); \
}
+# define LOADING_FILE_PROBE(name) \
+ if (PERL_LOADING_FILE_ENABLED()) { \
+ PERL_LOADING_FILE(name); \
+ }
+
+# define LOADED_FILE_PROBE(name) \
+ if (PERL_LOADED_FILE_ENABLED()) { \
+ PERL_LOADED_FILE(name); \
+ }
+
# endif
# define PHASE_CHANGE_PROBE(new_phase, old_phase) \
@@ -69,6 +91,8 @@
# define RETURN_PROBE(func, file, line, stash)
# define PHASE_CHANGE_PROBE(new_phase, old_phase)
# define OP_ENTRY_PROBE(name)
+# define LOADING_FILE_PROBE(name)
+# define LOADED_FILE_PROBE(name)
#endif
diff --git a/perldtrace.d b/perldtrace.d
index f352b31..0fdb7ea 100644
--- a/perldtrace.d
+++ b/perldtrace.d
@@ -10,6 +10,9 @@ provider perl {
probe phase__change(const char *, const char *);
probe op__entry(const char *);
+
+ probe loading__file(const char *);
+ probe loaded__file(const char *);
};
/*
diff --git a/pod/perldtrace.pod b/pod/perldtrace.pod
index 60a9370..c5af761 100644
--- a/pod/perldtrace.pod
+++ b/pod/perldtrace.pod
@@ -57,7 +57,7 @@ The C<phase-change> probe was added.
=item 5.18.0
-The C<op-entry> probe was added.
+The C<op-entry>, C<loading-file>, and C<loaded-file> probes weree added.
=back
@@ -112,6 +112,29 @@ still before the opcode itself is executed).
printf("About to execute opcode %s\n", copyinstr(arg0));
}
+=item loading-file(FILENAME)
+
+Fires when Perl is about to load an individual file, whether from
+C<use>, C<require>, or C<do>. This probe fires before the file is
+read from disk. The filename argument is converted to local filesystem
+paths instead of providing C<Module::Name>-style names.
+
+ :*perl*:loading-file {
+ printf("About to load %s\n", copyinstr(arg0));
+ }
+
+=item loaded-file(FILENAME)
+
+Fires when Perl has successfully loaded an individual file, whether
+from C<use>, C<require>, or C<do>. This probe fires after the file
+is read from disk and its contentss evaluated. The filename argument
+is converted to local filesystem paths instead of providing
+C<Module::Name>-style names.
+
+ :*perl*:loaded-file {
+ printf("Successfully loaded %s\n", copyinstr(arg0));
+ }
+
=back
=head1 EXAMPLES
@@ -179,6 +202,8 @@ still before the opcode itself is executed).
Exporter::Heavy::_rebuild_cache 5039
Exporter::import 14578
+=item
+
=back
=head1 REFERENCES
diff --git a/pp_ctl.c b/pp_ctl.c
index b4fd4dd..d7b09bd 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3694,6 +3694,8 @@ PP(pp_require)
}
}
+ LOADING_FILE_PROBE(unixname);
+
/* prepare to compile file */
if (path_is_absolute(name)) {
@@ -3996,6 +3998,8 @@ PP(pp_require)
/* Restore encoding. */
PL_encoding = encoding;
+ LOADED_FILE_PROBE(unixname);
+
return op;
}
diff --git a/t/run/dtrace.pl b/t/run/dtrace.pl
new file mode 100644
index 0000000..d81cc07
--- /dev/null
+++ b/t/run/dtrace.pl
@@ -0,0 +1 @@
+42
diff --git a/t/run/dtrace.t b/t/run/dtrace.t
index 183868d..2fa27a3 100644
--- a/t/run/dtrace.t
+++ b/t/run/dtrace.t
@@ -24,7 +24,7 @@ use strict;
use warnings;
use IPC::Open2;
-plan(tests => 7);
+plan(tests => 9);
dtrace_like(
'1',
@@ -132,6 +132,25 @@ D_SCRIPT
'basic op probe',
);
+dtrace_like(<< 'PERL_SCRIPT',
+ use strict;
+ require HTTP::Tiny;
+ do "run/dtrace.pl";
+PERL_SCRIPT
+ << 'D_SCRIPT',
+ loading-file { printf("loading-file <%s>\n", copyinstr(arg0)) }
+ loaded-file { printf("loaded-file <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+ [
+ # the original test made sure that each file generated a loading-file then a loaded-file,
+ # but that had a race condition when the kernel would push the perl process onto a different
+ # CPU, so the DTrace output would appear out of order
+ qr{loading-file <strict\.pm>.*loading-file <HTTP/Tiny\.pm>.*loading-file <run/dtrace\.pl>}s,
+ qr{loaded-file <strict\.pm>.*loaded-file <HTTP/Tiny\.pm>.*loaded-file <run/dtrace\.pl>}s,
+ ],
+ 'loading-file, loaded-file probes',
+);
+
sub dtrace_like {
my $perl = shift;
my $probes = shift;
--
1.7.11.2
|
From @cpansproutOn Tue Aug 28 02:31:29 2012, p5p@sartak.org wrote:
Thank you. Applied as fe83c36 and 32aeab2. -- Father Chrysostomos |
The RT System itself - Status changed from 'new' to 'open' |
@cpansprout - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#114638 (status was 'resolved')
Searchable as RT114638$
The text was updated successfully, but these errors were encountered: