mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

"op-entry" DTrace probe

Browse Source
This commit is contained in:
Shawn M Moore 2012-08-24 10:35:08 +02:00 committed by Father Chrysostomos
parent 9e7f031c18
commit fe83c362fb
6 changed files with 73 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
dump.c
View File

@ -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"));

12
mydtrace.h
View File

@ -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

2
perldtrace.d
View File

@ -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 *);
};
/*

33
pod/perldtrace.pod
View File

@ -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>

2
run.c
View File

@ -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;

24
t/run/dtrace.t
View File

@ -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);
}
}