Skip to content
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

Closed
p5pRT opened this issue Aug 28, 2012 · 6 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Aug 28, 2012

Migrated from rt.perl.org#114638 (status was 'resolved')

Searchable as RT114638$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2012

From p5p@sartak.org

This is a bug report for perl from p5p@​sartak.org,
generated with the help of perlbug 1.39 running under perl 5.17.3.


These two patches add two additional sets of DTrace probes​:
"loading-file" and "loading-file" for tracing "use", "require", and
"do"; also "op-entry" for tracing each opcode execution.

The patches include documentation and tests.



Flags​:
  category=core
  severity=low


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​:
  Local Commit​: f119ce935900f01c5baa3e5e40e825ac228b68a6
  Ancestor​: 40429ee
  Platform​:
  osname=darwin, osvers=12.0.0, archname=darwin-2level
  uname='darwin kaitain.local 12.0.0 darwin kernel version 12.0.0​:
sun jun 24 23​:00​:16 pdt 2012; root​:xnu-2050.7.9~1release_x86_64 x86_64 '
  config_args='-de -Dprefix=/Users/sartak/.perl/perls/dtrace
-Dusedtrace -Dusedevel'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=undef, usemultiplicity=undef
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=define, use64bitall=define, uselongdouble=undef
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-fno-common -DPERL_DARWIN -fno-strict-aliasing
-pipe -fstack-protector -I/usr/local/include',
  optimize='-O3',
  cppflags='-fno-common -DPERL_DARWIN -fno-strict-aliasing -pipe
-fstack-protector -I/usr/local/include'
  ccversion='', gccversion='4.2.1 Compatible Apple Clang 4.0
((tags/Apple/clang-421.0.57))', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags ='
-fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib /usr/lib
  libs=-lgdbm -ldbm -ldl -lm -lutil -lc
  perllibs=-ldl -lm -lutil -lc
  libc=, so=dylib, useshrplib=false, libperl=libperl.a
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
  cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup
-L/usr/local/lib -fstack-protector'

Locally applied patches​:


@​INC for perl 5.17.3​:
  /Users/sartak/.perl/perls/dtrace/lib/site_perl/5.17.3/darwin-2level
  /Users/sartak/.perl/perls/dtrace/lib/site_perl/5.17.3
  /Users/sartak/.perl/perls/dtrace/lib/5.17.3/darwin-2level
  /Users/sartak/.perl/perls/dtrace/lib/5.17.3
  .


Environment for perl 5.17.3​:
  DYLD_LIBRARY_PATH (unset)
  HOME=/Users/sartak
  LANG=ja_JP.UTF-8
  LANGUAGE (unset)
  LC_ALL=en_US.UTF-8
  LC_CTYPE=ja_JP.UTF-8
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)

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_BASHRC_VERSION=0.42
  PERLBREW_HOME=/Users/sartak/.perlbrew
  PERLBREW_MANPATH=/Users/sartak/.perl/perls/dtrace/man

PERLBREW_PATH=/Users/sartak/.perl/bin​:/Users/sartak/.perl/perls/dtrace/bin
  PERLBREW_PERL=dtrace
  PERLBREW_ROOT=/Users/sartak/.perl
  PERLBREW_VERSION=0.42
  PERL_BADLANG (unset)
  PERL_CPANM_OPT=--prompt
  PERL_PREFER_CPAN_CLIENT=cpanm
  SHELL=/usr/local/bin/zsh

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2012

From p5p@sartak.org

0001-op-entry-DTrace-probe.patch
From 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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2012

From p5p@sartak.org

0002-loading-file-and-loaded-file-DTrace-probes.patch
From 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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2012

From @cpansprout

On Tue Aug 28 02​:31​:29 2012, p5p@​sartak.org wrote​:

These two patches add two additional sets of DTrace probes​:
"loading-file" and "loading-file" for tracing "use", "require", and
"do"; also "op-entry" for tracing each opcode execution.

The patches include documentation and tests.

Thank you. Applied as fe83c36 and 32aeab2.

--

Father Chrysostomos

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2012

The RT System itself - Status changed from 'new' to 'open'

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2012

@cpansprout - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this Aug 28, 2012
@p5pRT p5pRT added the Severity Low label Oct 19, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
1 participant
You can’t perform that action at this time.