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"));
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) \
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) \
# 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
probe sub__return(const char *, const char *, int, const char *);
probe phase__change(const char *, const char *);
+
+ probe op__entry(const char *);
};
/*
The C<phase-change> probe was added.
+=item 5.18.0
+
+The C<op-entry> probe was added.
+
=back
=head1 PROBES
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
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
=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>
{
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;
use warnings;
use IPC::Open2;
-plan(tests => 5);
+plan(tests => 7);
dtrace_like(
'1',
'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;
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);
+ }
}