From: Andy Armstrong Date: Thu, 10 Jan 2008 22:20:52 +0000 (+0000) Subject: Add dtrace support X-Git-Tag: GitLive-blead~1359 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/5ac1e9b286b068746476878a8a6206b06828a175 Add dtrace support Message-Id: with fixups as discussed on list, plus adding usedtrace to Glossary, plus propagating all the new config variables everywhere. (Was there an automatic way to do that? I did it with emacs macros) p4raw-id: //depot/perl@32953 --- diff --git a/Configure b/Configure index f033581..0704273 100755 --- a/Configure +++ b/Configure @@ -238,6 +238,7 @@ cpio='' cpp='' csh='' date='' +dtrace='' echo='' egrep='' emacs='' @@ -1193,6 +1194,7 @@ use5005threads='' useithreads='' usereentrant='' usethreads='' +usedtrace='' incpath='' mips_type='' usrinc='' @@ -8949,6 +8951,71 @@ esac set usefaststdio eval $setvar +: DTrace support +dflt_dtrace='/usr/sbin/dtrace' +cat </dev/null 2>&1 \ + && rm -f perldtrace.tmp + then + cat >&2 </dev/null 2>&1 \ + && rm -f perldtrace.tmp && dtrace_o='perldtrace$(OBJ_EXT)' + ;; +esac + echo "Extracting Makefile (with variable substitutions)" $spitshell >Makefile <>Makefile <<'!NO!SUBS!' +$(DTRACE_H): perldtrace.d + $(DTRACE) -h -s perldtrace.d -o $(DTRACE_H) + +mydtrace.h: $(DTRACE_H) + +!NO!SUBS! + ;; + esac + case "$dtrace_o" in + ?*) + $spitshell >>Makefile <<'!NO!SUBS!' +$(DTRACE_O): perldtrace.d + $(DTRACE) -G -s perldtrace.d -o $(DTRACE_O) $(ndt_obj) + +!NO!SUBS! + ;; + esac $spitshell >>Makefile <<'!NO!SUBS!' $(LIBPERL): $& $(obj) $(DYNALOADER) $(LIBPERLEXPORT) !NO!SUBS! @@ -1082,7 +1117,7 @@ _mopup: -rm -f cygwin.c libperl*.def libperl*.dll cygperl*.dll *.exe.stackdump -rm -f perl$(EXE_EXT) suidperl$(EXE_EXT) miniperl$(EXE_EXT) $(LIBPERL) libperl.* microperl -rm -f opcode.h-old opnames.h-old pp.sym-old pp_proto.h-old - -rm -f config.over + -rm -f config.over $(DTRACE_H) # Do not 'make _tidy' directly. _tidy: diff --git a/NetWare/config.wc b/NetWare/config.wc index 2afe65e..942226c 100644 --- a/NetWare/config.wc +++ b/NetWare/config.wc @@ -522,6 +522,7 @@ dlsrc='dl_netware.xs' doublesize='8' drand01='(rand()/(double)((unsigned)1<$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un #$d_oldpthreads OLD_PTHREADS_API /**/ #$usereentrant USE_REENTRANT_API /**/ +/* USE_DTRACE + * This symbol, if defined, indicates that Perl should + * be built with support for DTrace. + */ +#$usedtrace USE_DTRACE /**/ + /* PERL_VENDORARCH: * If defined, this symbol contains the name of a private library. * The library is private in the sense that it needn't be in anyone's diff --git a/configure.com b/configure.com index 800f054..f36d5c6 100644 --- a/configure.com +++ b/configure.com @@ -6127,6 +6127,7 @@ $ WC "dlobj='" + dlobj + "'" $ WC "dlsrc='dl_vms.c'" $ WC "doublesize='" + doublesize + "'" $ WC "drand01='" + drand01 + "'" +$ WC "dtrace=''" $! $! The extensions symbol may be quite long $! @@ -6442,6 +6443,7 @@ $ WC "usedebugging_perl='"+use_debugging_perl+"'" $ WC "usedefaulttypes='" + usedefaulttypes + "'" ! VMS-specific $ WC "usecrosscompile='undef'" $ WC "usedl='" + usedl + "'" +$ WC "usedtrace='undef'" $ WC "usefaststdio='" + usefaststdio + "'" $ WC "useieee='" + useieee + "'" ! VMS-specific $ WC "useithreads='" + useithreads + "'" diff --git a/cop.h b/cop.h index 39dc9cb..0b63c67 100644 --- a/cop.h +++ b/cop.h @@ -132,6 +132,7 @@ typedef struct jmpenv JMPENV; #define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) +#include "mydtrace.h" struct cop { BASEOP @@ -295,6 +296,10 @@ struct block_sub { * decremented by LEAVESUB, the other by LEAVE. */ #define PUSHSUB_BASE(cx) \ + ENTRY_PROBE(GvENAME(CvGV(cv)), \ + CopFILE((COP*)CvSTART(cv)), \ + CopLINE((COP*)CvSTART(cv))); \ + \ cx->blk_sub.cv = cv; \ cx->blk_sub.olddepth = CvDEPTH(cv); \ cx->blk_sub.hasargs = hasargs; \ @@ -342,6 +347,10 @@ struct block_sub { #define POPSUB(cx,sv) \ STMT_START { \ + RETURN_PROBE(GvENAME(CvGV((CV*)cx->blk_sub.cv)), \ + CopFILE((COP*)CvSTART((CV*)cx->blk_sub.cv)), \ + CopLINE((COP*)CvSTART((CV*)cx->blk_sub.cv))); \ + \ if (cx->blk_sub.hasargs) { \ POP_SAVEARRAY(); \ /* abandon @_ if it got reified */ \ diff --git a/epoc/config.sh b/epoc/config.sh index e54f568..bd1a20f 100644 --- a/epoc/config.sh +++ b/epoc/config.sh @@ -498,6 +498,7 @@ dlsrc='dl_none.xs' doublesize='8' drand01='(rand()/(double)(1U<. + */ + +provider perl { + probe sub__entry(char *, char *, int); + probe sub__return(char *, char *, int); +}; diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index 9d11665..9ce1038 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -529,6 +529,7 @@ dlsrc='dl_none.xs' doublesize='8' drand01='(rand() / (double) ((unsigned long)1 << 15))' drand48_r_proto='0' +dtrace='' dynamic_ext='' eagain='EAGAIN' ebcdic='undef' @@ -956,6 +957,7 @@ use64bitall='undef' use64bitint='undef' usecrosscompile='undef' usedl='undef' +usedtrace='undef' usefaststdio='undef' useithreads='undef' uselargefiles='define' diff --git a/symbian/config.sh b/symbian/config.sh index c31d4be..e53ed93 100644 --- a/symbian/config.sh +++ b/symbian/config.sh @@ -476,6 +476,7 @@ dlsrc='dl_symbian.xs' doublesize='8' drand01="((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))" drand48_r_proto='0' +dtrace='' eagain='EAGAIN' ebcdic='undef' endgrent_r_proto='0' @@ -771,6 +772,7 @@ use64bitall='undef' use64bitint='undef' usecrosscompile='undef' usedl='undef' +usedtrace='undef' usefaststdio='undef' useithreads='undef' uselargefiles='undef' diff --git a/uconfig.h b/uconfig.h index 78bef6f..18b6f57 100644 --- a/uconfig.h +++ b/uconfig.h @@ -4358,6 +4358,12 @@ /*#define OLD_PTHREADS_API / **/ /*#define USE_REENTRANT_API / **/ +/* USE_DTRACE + * This symbol, if defined, indicates that Perl should + * be built with support for DTrace. + */ +/*#define USE_DTRACE / **/ + /* PERL_VENDORARCH: * If defined, this symbol contains the name of a private library. * The library is private in the sense that it needn't be in anyone's diff --git a/uconfig.sh b/uconfig.sh index 2503c1b..7f513af 100755 --- a/uconfig.sh +++ b/uconfig.sh @@ -465,6 +465,7 @@ direntrytype='struct dirent' doublesize='8' drand01="((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))" drand48_r_proto='0' +dtrace='' eagain='EAGAIN' ebcdic='undef' endgrent_r_proto='0' @@ -737,6 +738,7 @@ use64bitall='undef' use64bitint='undef' usecrosscompile='undef' usedl='undef' +usedtrace='undef' usefaststdio='undef' useithreads='undef' uselargefiles='undef' diff --git a/win32/config.bc b/win32/config.bc index 7f7cc38..ec883a9 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -518,6 +518,7 @@ dlsrc='dl_win32.xs' doublesize='8' drand01='(rand()/(double)((unsigned)1<