#!/bin/sh # Steps to use: # # 1. Assume that the otp_src_R14B04.tar.gz file is in the current working dir. # 2. Assume that you want to build in the current working dir. # 2b. Assume that "uudecode" is available on your platform. If you're # using a Linux system, you may need to install a package like # "sharutils" (CentOS and perhaps Fedora). # 3. Edit the CONFIGURE_OPTIONS variable below to suit yourself. Its # current value is what I use to build on a OS X box. # 4. Run "sh -x THIS-SCRIPT-FILE". # 5. Wait for the build to finish. # 6. Run "/usr/local/erlang/R14B04.via-patch.dtrace/bin/erl +A 5" # 7. Do not use the "dtrace" example in the README.md file. # 8. Run as root: "dtrace -q -s /usr/local/erlang/R14B04.via-patch.dtrace/lib/erlang/lib/dtrace-0.8/examples/process-scheduling.d" # 9. Type stuff in the Erlang shell. Watch the process scheduling # events in the D script output. CONFIGURE_OPTIONS="--prefix=/usr/local/erlang/R14B04.via-patch.dtrace --enable-darwin-64bit --enable-dtrace" set -x rm -rf otp_src_R14B04 gunzip -c otp_src_R14B04.tar.gz | tar xf - cd otp_src_R14B04 patch -p1 <<'EOFEOFEOFEOFEOFEOFEOFEOF' diff --git a/README.md b/README.md index c38f097..d683b7b 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,368 @@ +The dtrace-experiment branch of Erlang/OTP +========================================== + +The purpose of this branch is to bring DTrace user-space probes to the +Erlang virtual machine. At the moment, it is a proof of concept: +unpolished, rough, and occasionally ugly. The goal: merge this code +(or something philosophically similar) into Ericsson's Erlang/OTP +source distribution. + +History +------- + +The first implementation of DTrace probes for the Erlang virtual +machine was presented at the [2008 Erlang User Conference] [4]. Most +of the source from that effort has been lost. If you have a copy of +that work, please contact **slfritchie**. + +Several users have created Erlang port drivers, linked-in drivers, or +NIFs that allow Erlang code to try to activate a probe, +e.g. `foo_module:dtrace_probe("message goes here!")`. + +Goals +----- + +1. Annotate as much of the Erlang VM as is practical. + * The initial goal is to trace file I/O operations. +2. Support all platforms that implement DTrace: OS X, Solaris, + and (I hope) FreeBSD and NetBSD. +3. To the extent that it's practical, support SystemTap on Linux + via DTrace provider compatibility. +4. Allow Erlang code to supply annotations. + +Supported platforms +------------------- + +The autoconf procedure is supported, I believe, for OS X/Snow Leopard +and OpenSolaris/64-bit. Just add the `--enable-dtrace` option your +command to run the `configure` script. + +The code has been only very lightly tested on OS X. It ought to +compile on a Solaris 10 or OpenSolaris machine, but no promises yet. + +The autoconf stuff is ugly right now. It could use some cleaning up. +For example: + +* After editing the `erlang_dtrace.d` file, you need to re-run the +* top-level "configure" script in order to update `erlang_dtrace.h`. +* `make clean` will remove `erlang_dtrace.h`. A build will fail + unless the top-level "configure" script is re-run to re-create that + file. +* The `erlang_dtrace.h` file's location should probably be moved to an + OTP platform-specific build dir, for example, + `path/to/somewhere/i386-apple-darwin10.8.0` +* There are probably some other build by-products that are also being + put into the "wrong" directory, for example, `erlang_dtrace.o` for + Solaris platforms. + +Contributions +------------- + +Code contributions are welcome! This is a side project for me (SLF), +so things would go faster if other people are willing to pitch in. +Please use the GitHub pull request mechanism or send me an email +message. + +To build from scratch, use this recipe. If you're an experienced Git +user and wish to add my repository as a remote repository, be my +guest. Just resume the recipe at command #4. + + % git clone git://github.com/slfritchie/otp.git + % cd otp + % git checkout -b dtrace-experiment origin/dtrace-experiment + % env ERL_TOP=`pwd` ./otp_build autoconf + % env ERL_TOP=`pwd` ./configure --enable-dtrace + whatever args you need + % env ERL_TOP=`pwd` make + +Then `make install` and then start an Erlang shell via +`/path/to/installed/bin/erl +A 8`. The Erlang shell's banner should +include `[dtrace]`. + +Try using this (ugly) DTrace command to watch file I/O probes in use +(tested on OS X only, sorry): + + dtrace -Z -n 'erlang*:::file_drv_entry {printf("%d %d %s | %d | %s %s , %d %d %d", arg0, arg1, arg2 == NULL ? "" : copyinstr(arg2), arg3, arg4 == NULL ? "" : copyinstr(arg4), arg5 == NULL ? "" : copyinstr(arg5), arg6, arg7, arg8)} erlang*:::file_drv_int* {printf("%d %d %d | %d", arg0, arg1, arg2, arg3);} erlang*:::file_drv_return {printf("%d %d %s | %d | %d %d %d", arg0, arg1, arg2 == NULL ? "" : copyinstr(arg2), arg3, arg4, arg5, arg6 ) ; } erlang*:::xx {printf("%s", arg1 == NULL ? "-null-" : copyinstr(arg1));}' +Implementation summary +---------------------- + +So far, most effort has been focused on the `efile_drv.erl` code, +which implements most file I/O on behalf of the Erlang virtual +machine. This driver also presents a big challenge: its use of an I/O +worker pool (enabled by using the `erl +A 8` flag, for example) makes +it much more difficult to trace I/O activity because each of the +following may be executed in a different Pthread: + +* I/O initiation (Erlang code) +* I/O proxy process handling, e.g. read/write when file is not opened + in `raw` mode, operations executed by the code & file server processes. + (Erlang code) +* `efile_drv` command setup (C code) +* `efile_drv` command execution (C code) +* `efile_drv` status return (C code) + +**TODO: keep this description up-to-date.** + +In the current prototype, probes for a `file:rename("old-name", "new-name")`of the last three steps can be +formatted like this: + + FUNCTION-NAME:PROBE-NAME ARGUMENTS + ------------------------ --------- + file_output:file_drv_entry 0 517 some-user-tag | 12 | old-name new-name + invoke_rename:file_drv_int_entry 0 517 5004 | 12 + invoke_rename:file_drv_int_return 0 517 5004 | 12 + file_async_ready:file_drv_return 0 517 some-user-tag | 12 | 0 2 5004 + +... where the following key can help decipher the output: + +* `0 517` is the Erlang scheduler thread number (0) and operation + counter number (517) assigned to this I/O operation. Together, + these two numbers form a unique ID for the I/O operation. +* `12` is the command number for the rename operation. See the + definition for `FILE_RENAME` in the source code file `efile_drv.c`. +* `old-name` and `new-name` are the two string arguments for the + source and destination of the `rename(2)` system call. +* `5004` is the worker pool thread number that will perform the actual + I/O work. (I/O worker pool thread ID numbers start at 5,000 to make + it more difficult to confuse them with Erlang scheduler thread + numbers.) +* `0 2` means that the command was not successful (0) and that the + POSIX errno value was 2, a.k.a. `ENOENT`, because the file + `old-name` does not exist. +* The `file_drv_return` probe was activated by thread 5004, i.e. the + same thread as the `file_drv_int_entry` and `file_drv_int_return` + probes. +* The `file_drv_int_return` probe is provided in case the user is + interested in measuring only the latency of code executed by + `efile_drv` asynchronous functions by I/O worker pool threads. + +So, where does the `some-user-tag` string come from? + +At the moment, the user tag comes from code like the following: + + put(dtrace_utag, "some-user-tag"), + file:rename("old-name", "new-name"). + +This method of tagging I/O at the Erlang level is subject to change. + +Example DTrace probe specification +---------------------------------- + + /* Async driver pool */ + + /** + * Show the post-add length of the async driver thread pool member's queue. + * + * @param pool member number + * @param new queue length + */ + probe async_io_pool_add(int, int); + + /** + * Show the post-get length of the async driver thread pool member's queue. + * + * @param pool member number + * @param new queue length + */ + probe async_io_pool_get(int, int); + + /* Probes for efile_drv.c */ + + /** + * Entry into the efile_drv.c file I/O driver + * + * For a list of command numbers used by this driver, see the section + * "Guide to probe arguments" in ../../../README.md. That section + * also contains explanation of the various integer and string + * arguments that may be present when any particular probe fires. + * + * @param thread-id number of the scheduler Pthread arg0 + * @param tag number: {thread-id, tag} uniquely names a driver operation + * @param user-tag string arg2 + * @param command number arg3 + * @param string argument 1 arg4 + * @param string argument 2 arg5 + * @param integer argument 1 arg6 + * @param integer argument 2 arg7 + * @param integer argument 3 arg8 + * @param integer argument 4 arg9 + */ + probe file_drv_entry(int, int, char *, int, char *, char *, + int64_t, int64_t, int64_t, int64_t); + + /* 0 1 2 3 */ + /* thread-id, tag, work-thread-id, command */ + /** + * Entry into the driver's internal work function. Computation here + * is performed by a async worker pool Pthread. + * + * @param thread-id number + * @param tag number + * @param worker pool thread-id number + * @param command number + */ + probe file_drv_int_entry(int, int, int, int); + + /** + * Return from the driver's internal work function. + * + * @param thread-id number + * @param tag number + * @param worker pool thread-id number + * @param command number + */ + probe file_drv_int_return(int, int, int, int); + + /** + * Return from the efile_drv.c file I/O driver + * + * @param thread-id number arg0 + * @param tag number arg1 + * @param user-tag string arg2 + * @param command number arg3 + * @param Success? 1 is success, 0 is failure arg4 + * @param If failure, the errno of the error. arg5 + * @param thread-id number of the scheduler Pthread executing now arg6 + */ + probe file_drv_return(int, int, char *, int, int, int, int); + +Guide to probe arguments +------------------------ + + /* Driver op code: used by file_drv_entry arg3 */ + /* used by file_drv_int_entry arg3 */ + /* used by file_drv_int_return arg3 */ + /* used by file_drv_return arg3 */ + + #define FILE_OPEN 1 (probe arg3) + probe arg6 = C driver dt_i1 = flags; + probe arg4 = C driver dt_s1 = path; + + #define FILE_READ 2 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + probe arg8 = C driver dt_i3 = size; + + #define FILE_LSEEK 3 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = offset; + probe arg8 = C driver dt_i3 = origin; + + #define FILE_WRITE 4 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + probe arg8 = C driver dt_i3 = size; + + #define FILE_FSTAT 5 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + + #define FILE_PWD 6 (probe arg3) + none + + #define FILE_READDIR 7 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_CHDIR 8 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_FSYNC 9 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + + #define FILE_MKDIR 10 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_DELETE 11 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_RENAME 12 (probe arg3) + probe arg4 = C driver dt_s1 = old_name; + probe arg5 = C driver dt_s2 = new_name; + + #define FILE_RMDIR 13 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_TRUNCATE 14 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + + #define FILE_READ_FILE 15 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_WRITE_INFO 16 (probe arg3) + probe arg6 = C driver dt_i1 = mode; + probe arg7 = C driver dt_i2 = uid; + probe arg8 = C driver dt_i3 = gid; + + #define FILE_LSTAT 19 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_READLINK 20 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_LINK 21 (probe arg3) + probe arg4 = C driver dt_s1 = existing_path; + probe arg5 = C driver dt_s2 = new_path; + + #define FILE_SYMLINK 22 (probe arg3) + probe arg4 = C driver dt_s1 = existing_path; + probe arg5 = C driver dt_s2 = new_path; + + #define FILE_CLOSE 23 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + + #define FILE_PWRITEV 24 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + probe arg8 = C driver dt_i3 = size; + + #define FILE_PREADV 25 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + probe arg8 = C driver dt_i3 = size; + + #define FILE_SETOPT 26 (probe arg3) + probe arg6 = C driver dt_i1 = opt_name; + probe arg7 = C driver dt_i2 = opt_specific_value; + + #define FILE_IPREAD 27 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + probe arg8 = C driver dt_i3 = offsets[0]; + probe arg9 = C driver dt_i4 = size; + + #define FILE_ALTNAME 28 (probe arg3) + probe arg4 = C driver dt_s1 = path; + + #define FILE_READ_LINE 29 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = flags; + probe arg8 = C driver dt_i3 = read_offset; + probe arg9 = C driver dt_i4 = read_ahead; + + #define FILE_FDATASYNC 30 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + + #define FILE_FADVISE 31 (probe arg3) + probe arg6 = C driver dt_i1 = fd; + probe arg7 = C driver dt_i2 = offset; + probe arg8 = C driver dt_i3 = length; + probe arg9 = C driver dt_i4 = advise_type; + + /* Return codes: used by file_drv_return arg4 */ + + #define FILE_RESP_OK 0 + #define FILE_RESP_ERROR 1 + #define FILE_RESP_DATA 2 + #define FILE_RESP_NUMBER 3 + #define FILE_RESP_INFO 4 + #define FILE_RESP_NUMERR 5 + #define FILE_RESP_LDATA 6 + #define FILE_RESP_N2DATA 7 + #define FILE_RESP_EOF 8 + #define FILE_RESP_FNAME 9 + #define FILE_RESP_ALL_DATA 10 + + Erlang/OTP ========== @@ -74,3 +439,4 @@ Copyright and License [1]: http://www.erlang.org [2]: http://wiki.github.com/erlang/otp/submitting-patches [3]: http://www.erlang.org/faq.html + [4]: http://www.erlang.org/euc/08/ diff --git a/configure.in b/configure.in index 36b33ec..364be0c 100644 --- a/configure.in +++ b/configure.in @@ -225,6 +225,10 @@ AC_ARG_ENABLE(native-libs, AS_HELP_STRING([--enable-native-libs], [compile Erlang libraries to native code])) +AC_ARG_ENABLE(dtrace, +AS_HELP_STRING([--enable-dtrace], + [Enable DTrace probes])) + AC_ARG_WITH(javac, AS_HELP_STRING([--with-javac=JAVAC], [specify Java compiler to use]) AS_HELP_STRING([--with-javac], [use a Java compiler if found (default)]) diff --git a/erts/configure.in b/erts/configure.in index 3b9be41..7e2768a 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -3515,6 +3515,65 @@ dnl LM_FIND_EMU_CC dnl +dnl DTrace +dnl + +AC_MSG_CHECKING(if --enable-dtrace option specified) +AC_ARG_ENABLE(dtrace, + [AC_HELP_STRING([--enable-dtrace], + [Configure with dtrace static probes])], + [enable_dtrace="$enable_dtrace"]) dnl, [enable_dtrace="no"]) + +if test "$enable_dtrace" = "yes"; then + AC_CHECK_TOOL(DTRACE, dtrace, none) + test "$DTRACE" = "none" && AC_MSG_ERROR([No dtrace utility found.]) +else + AC_MSG_RESULT([not specified]) +fi + +AC_SUBST(DTRACE) + +AC_SUBST(DTRACE_CPP) +AC_SUBST(DTRACE_ENABLED) +AC_SUBST(DTRACE_ENABLED_2STEP) +DTRACE_CPP=-C +DTRACE_ENABLED= +DTRACE_ENABLED_2STEP= +DTRACE_2STEP_TEST=./dtrace-test.o +if test "$enable_dtrace" = "yes" ; then + if test "$DTRACE" = "dtrace" ; then + AC_CHECK_HEADERS(sys/sdt.h) + # The OS X version of dtrace prints a spurious line here. + if ! dtrace -h $DTRACE_CPP -Iemulator/beam -o ./foo-dtrace.h -s emulator/beam/erlang_dtrace.d; then + AC_MSG_ERROR([Could not precompile erlang_dtrace.d: dtrace -h failed]) + fi + rm -f foo-dtrace.h + + $RM -f $DTRACE_2STEP_TEST + if dtrace -G $DTRACE_CPP -Iemulator/beam -o $DTRACE_2STEP_TEST -s emulator/beam/erlang_dtrace.d 2> /dev/null && \ + test -f $DTRACE_2STEP_TEST ; then + rm $DTRACE_2STEP_TEST + DTRACE_ENABLED_2STEP=yes + AC_MSG_NOTICE([dtrace precompilation for 2-stage DTrace successful]) + else + AC_MSG_NOTICE([dtrace precompilation for 1-stage DTrace successful]) + fi + DTRACE_ENABLED=yes + AC_DEFINE(HAVE_DTRACE, 1, [Define to enable DTrace probes (or SystemTap probes on Linux systems)]) + case $OPSYS in + linux) + : # No extra libs to add to LIBS + ;; + *) + LIBS="$LIBS -ldtrace" + ;; + esac + else + AC_MSG_ERROR([Dtrace preprocessing test failed.]) + fi +fi + +dnl dnl SSL, SSH and CRYPTO need the OpenSSL libraries dnl dnl Check flags --with-ssl, --without-ssl --with-ssl=PATH. @@ -4328,6 +4387,7 @@ dnl ../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in ../lib/crypto/c_src/$host/Makefile:../lib/crypto/c_src/Makefile.in + ../lib/dtrace/c_src/$host/Makefile:../lib/dtrace/c_src/Makefile.in ../lib/orber/c_src/$host/Makefile:../lib/orber/c_src/Makefile.in ../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in ../lib/tools/c_src/$host/Makefile:../lib/tools/c_src/Makefile.in diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 620402f..0631b5e 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -23,6 +23,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@ HIPE_ENABLED=@HIPE_ENABLED@ +DTRACE_ENABLED=@DTRACE_ENABLED@ +DTRACE_ENABLED_2STEP=@DTRACE_ENABLED_2STEP@ LIBS = @LIBS@ Z_LIB=@Z_LIB@ NO_INLINE_FUNCTIONS=false @@ -499,6 +501,10 @@ ifeq ($(FLAVOR)-@ERTS_BUILD_SMP_EMU@,smp-no) GENERATE= endif +ifdef DTRACE_ENABLED +GENERATE += $(TARGET)/erlang_dtrace.h +endif + generate: $(GENERATE) ifdef HIPE_ENABLED @@ -575,6 +581,11 @@ $(TARGET)/preload.c: $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ LANG=C $(PERL) utils/make_preload -old $^ > $@ endif +$(TARGET)/erlang_dtrace.h: beam/erlang_dtrace.d + dtrace -h -C -Ibeam -s $< -o ./erlang_dtrace.tmp + sed -e '/^#define[ ]*ERLANG_[A-Z0-9_]*(.*)/y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/' ./erlang_dtrace.tmp > $@ + rm ./erlang_dtrace.tmp + # ---------------------------------------------------------------------- # Pattern rules # @@ -618,7 +629,6 @@ $(OBJDIR)/beam_emu.o: beam/beam_emu.c $(EMU_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ endif - $(OBJDIR)/%.o: beam/%.c $(CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ @@ -834,6 +844,18 @@ BASE_OBJS = $(RUN_OBJS) $(EMU_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) OBJS = $(BASE_OBJS) $(DRV_OBJS) +ifdef DTRACE_ENABLED_2STEP +OBJS += $(OBJDIR)/erlang_dtrace.o +$(OBJDIR)/erlang_dtrace.o: $(OBJS) $(TARGET)/erlang_dtrace.h + touch $(OBJDIR)/erlang_dtrace.c + $(CC) $(CFLAGS) -c -o $@ $(OBJDIR)/erlang_dtrace.c + # The object file created above is immediately clobbered below. + # But creating it above avoids chicken-and-egg problem with OBJS + dtrace -G -C -Ibeam \ + -s beam/erlang_dtrace.d \ + -o $@ $(OBJS) +endif + ######################################## # HiPE section diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 937b3d9..e41b268 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -41,6 +41,9 @@ #include "hipe_bif1.h" #endif +#include +#include "dtrace-wrapper.h" + /* #define HARDDEBUG 1 */ #if defined(NO_JUMP_TABLE) @@ -1080,6 +1083,127 @@ init_emulator(void) # define REG_tmp_arg2 #endif +ERTS_INLINE void +dtrace_proc_str(Process *process, char *process_buf) { + dtrace_pid_str(process->id, process_buf); +} + +ERTS_INLINE void +dtrace_pid_str(Eterm pid, char *process_buf) { + snprintf(process_buf, DTRACE_TERM_BUF_SIZE, "<%lu.%lu.%lu>", + pid_channel_no(pid), + pid_number(pid), + pid_serial(pid)); +} + +ERTS_INLINE void +dtrace_port_str(Port *port, char *port_buf) { + snprintf(port_buf, DTRACE_TERM_BUF_SIZE, "#Port<%lu.%lu>", + port_channel_no(port->id), + port_number(port->id)); +} + +ERTS_INLINE void +dtrace_fun_decode(Process *process, + Eterm module, Eterm function, int arity, + char *process_buf, char *mfa_buf) { + char funbuf[DTRACE_TERM_BUF_SIZE]; + char *funptr = funbuf; + char *p = NULL; + + if (process_buf) { + dtrace_proc_str(process, process_buf); + } + + erts_snprintf(funbuf, sizeof(funbuf), "%T", function); + /* I'm not quite sure how these function names are synthesized, + but they almost always seem to be in the form of + '-name/arity-fun-0-' so I'm chopping them up when it's -fun-0- + (which seems to be the toplevel) */ + if (funbuf[0] == '\'' && funbuf[1] == '-' + && strlen(funbuf) > 3 && funbuf[strlen(funbuf) - 3] == '0') { + p = strchr(funbuf, '/'); + if (p) { + *p = 0; + } + funptr += 2; + } + + erts_snprintf(mfa_buf, DTRACE_TERM_BUF_SIZE, "%T:%s/%d", + module, funptr, arity); +} + +#ifdef HAVE_DTRACE + +#define DTRACE_CALL(p, m, f, a) \ + if (DTRACE_ENABLED(function_entry)) { \ + char process_name[DTRACE_TERM_BUF_SIZE]; \ + char mfa[DTRACE_TERM_BUF_SIZE]; \ + int depth = (STACK_START(p) - STACK_TOP(p)) \ + / sizeof(Eterm*); \ + dtrace_fun_decode(p, m, f, a, \ + process_name, mfa); \ + DTRACE3(function_entry, process_name, mfa, depth); \ + } + +#define DTRACE_RETURN(p, m, f, a) \ + if (DTRACE_ENABLED(function_return)) { \ + char process_name[DTRACE_TERM_BUF_SIZE]; \ + char mfa[DTRACE_TERM_BUF_SIZE]; \ + int depth = (STACK_START(p) - STACK_TOP(p)) \ + / sizeof(Eterm*); \ + dtrace_fun_decode(p, m, f, a, \ + process_name, mfa); \ + DTRACE3(function_return, process_name, mfa, depth); \ + } + +#define DTRACE_BIF_ENTRY(p, m, f, a) \ + if (DTRACE_ENABLED(bif_entry)) { \ + char process_name[DTRACE_TERM_BUF_SIZE]; \ + char mfa[DTRACE_TERM_BUF_SIZE]; \ + dtrace_fun_decode(p, m, f, a, \ + process_name, mfa); \ + DTRACE2(bif_entry, process_name, mfa); \ + } + +#define DTRACE_BIF_RETURN(p, m, f, a) \ + if (DTRACE_ENABLED(bif_return)) { \ + char process_name[DTRACE_TERM_BUF_SIZE]; \ + char mfa[DTRACE_TERM_BUF_SIZE]; \ + dtrace_fun_decode(p, m, f, a, \ + process_name, mfa); \ + DTRACE2(bif_return, process_name, mfa); \ + } + +#define DTRACE_NIF_ENTRY(p, m, f, a) \ + if (DTRACE_ENABLED(nif_entry)) { \ + char process_name[DTRACE_TERM_BUF_SIZE]; \ + char mfa[DTRACE_TERM_BUF_SIZE]; \ + dtrace_fun_decode(p, m, f, a, \ + process_name, mfa); \ + DTRACE2(nif_entry, process_name, mfa); \ + } + +#define DTRACE_NIF_RETURN(p, m, f, a) \ + if (DTRACE_ENABLED(nif_return)) { \ + char process_name[DTRACE_TERM_BUF_SIZE]; \ + char mfa[DTRACE_TERM_BUF_SIZE]; \ + dtrace_fun_decode(p, m, f, a, \ + process_name, mfa); \ + DTRACE2(nif_return, process_name, mfa); \ + } + +#else /* HAVE_DTRACE */ + +#define DTRACE_CALL(p, m, f, a) do {} while (0) +#define DTRACE_RETURN(p, m, f, a) do {} while (0) +#define DTRACE_BIF_ENTRY(p, m, f, a) do {} while (0) +#define DTRACE_BIF_RETURN(p, m, f, a) do {} while (0) +#define DTRACE_NIF_ENTRY(p, m, f, a) do {} while (0) +#define DTRACE_NIF_RETURN(p, m, f, a) do {} while (0) + +#endif /* HAVE_DTRACE */ + /* * process_main() is called twice: * The first call performs some initialisation, including exporting @@ -1276,6 +1400,28 @@ void process_main(void) #endif SWAPIN; ASSERT(VALID_INSTR(next)); + + if (DTRACE_ENABLED(process_scheduled)) { + char process_buf[DTRACE_TERM_BUF_SIZE]; + char fun_buf[DTRACE_TERM_BUF_SIZE]; + dtrace_proc_str(c_p, process_buf); + + if (ERTS_PROC_IS_EXITING(c_p)) { + strcpy(fun_buf, ""); + } else { + BeamInstr *fptr = find_function_from_pc(c_p->i); + if (fptr) { + dtrace_fun_decode(c_p, (Eterm)fptr[0], + (Eterm)fptr[1], (Uint)fptr[2], + NULL, fun_buf); + } else { + snprintf(fun_buf, sizeof(fun_buf), "", next); + } + } + + DTRACE2(process_scheduled, process_buf, fun_buf); + } + Goto(next); } @@ -1541,7 +1687,13 @@ void process_main(void) OpCase(return): { + BeamInstr* fptr; SET_I(c_p->cp); + + if (DTRACE_ENABLED(function_return) && (fptr = find_function_from_pc(c_p->cp))) { + DTRACE_RETURN(c_p, (Eterm)fptr[0], (Eterm)fptr[1], (Uint)fptr[2]); + } + /* * We must clear the CP to make sure that a stale value do not * create a false module dependcy preventing code upgrading. @@ -3303,6 +3455,8 @@ void process_main(void) */ BifFunction vbf; + DTRACE_NIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); + c_p->current = I-3; /* current and vbf set to please handle_error */ SWAPOUT; c_p->fcalls = FCALLS - 1; @@ -3324,6 +3478,9 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); + + DTRACE_NIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); + goto apply_bif_or_nif_epilogue; OpCase(apply_bif): @@ -3343,6 +3500,8 @@ void process_main(void) c_p->arity = 0; /* To allow garbage collection on ourselves * (check_process_code/2). */ + DTRACE_BIF_ENTRY(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); + SWAPOUT; c_p->fcalls = FCALLS - 1; vbf = (BifFunction) Arg(0); @@ -3401,6 +3560,8 @@ void process_main(void) bif_nif_arity); } + DTRACE_BIF_RETURN(c_p, (Eterm)I[-3], (Eterm)I[-2], (Uint)I[-1]); + apply_bif_or_nif_epilogue: ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); ERTS_HOLE_CHECK(c_p); @@ -6154,6 +6315,13 @@ apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) save_calls(p, ep); } + if (DTRACE_ENABLED(function_entry) && ep->address) { + BeamInstr *fptr = find_function_from_pc(ep->address); + if (fptr) { + DTRACE_CALL(p, (Eterm)fptr[0], (Eterm)fptr[1], (Uint)fptr[2]); + } + } + return ep->address; } @@ -6203,6 +6371,13 @@ fixed_apply(Process* p, Eterm* reg, Uint arity) save_calls(p, ep); } + if (DTRACE_ENABLED(function_entry)) { + BeamInstr *fptr = find_function_from_pc(ep->address); + if (fptr) { + DTRACE_CALL(p, (Eterm)fptr[0], (Eterm)fptr[1], (Uint)fptr[2]); + } + } + return ep->address; } @@ -6252,6 +6427,14 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re c_p->max_arg_reg = sizeof(c_p->def_arg_reg)/sizeof(c_p->def_arg_reg[0]); } + if (DTRACE_ENABLED(process_hibernate)) { + char process_name[DTRACE_TERM_BUF_SIZE]; + char mfa[DTRACE_TERM_BUF_SIZE]; + dtrace_fun_decode(c_p, module, function, arity, + process_name, mfa); + DTRACE2(process_hibernate, process_name, mfa); + } + /* * Arrange for the process to be resumed at the given MFA with * the stack cleared. @@ -6326,6 +6509,14 @@ call_fun(Process* p, /* Current process. */ code_ptr = fe->address; actual_arity = (int) code_ptr[-1]; + if (DTRACE_ENABLED(function_entry)) { + BeamInstr *fptr = find_function_from_pc(code_ptr); + + if (fptr) { + DTRACE_CALL(p, fe->module, (Eterm)fptr[1], actual_arity); + } + } + if (actual_arity == arity+num_free) { if (num_free == 0) { return code_ptr; @@ -6344,7 +6535,7 @@ call_fun(Process* p, /* Current process. */ } else { /* * Something wrong here. First build a list of the arguments. - */ + */ if (is_non_value(args)) { Uint sz = 2 * arity; @@ -6419,11 +6610,12 @@ call_fun(Process* p, /* Current process. */ actual_arity = (int) ep->code[2]; if (arity == actual_arity) { + DTRACE_CALL(p, ep->code[0], ep->code[1], (Uint)ep->code[2]); return ep->address; } else { /* * Wrong arity. First build a list of the arguments. - */ + */ if (is_non_value(args)) { args = NIL; @@ -6474,6 +6666,7 @@ call_fun(Process* p, /* Current process. */ reg[1] = function; reg[2] = args; } + DTRACE_CALL(p, module, function, arity); return ep->address; } else { badfun: diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 68b3350..d46e59c 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -36,6 +36,7 @@ #include "beam_bp.h" #include "erl_db_util.h" #include "register.h" +#include "dtrace-wrapper.h" static Export* flush_monitor_message_trap = NULL; static Export* set_cpu_topology_trap = NULL; @@ -55,6 +56,7 @@ BIF_RETTYPE spawn_3(BIF_ALIST_3) Eterm pid; so.flags = 0; + pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so); if (is_non_value(pid)) { BIF_ERROR(BIF_P, so.error_code); diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 90201f3..e86e1b6 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -31,6 +31,8 @@ #include "erl_binary.h" #include "erl_bits.h" +#include "dtrace-wrapper.h" + #ifdef HYBRID MA_STACK_DECLARE(src); MA_STACK_DECLARE(dst); @@ -59,6 +61,11 @@ copy_object(Eterm obj, Process* to) Eterm* hp = HAlloc(to, size); Eterm res; + if (DTRACE_ENABLED(copy_object)) { + char proc_name[64]; + erts_snprintf(proc_name, sizeof(proc_name), "%T", to->id); + DTRACE2(copy_object, proc_name, size); + } res = copy_struct(obj, size, &hp, &to->off_heap); #ifdef DEBUG if (eq(obj, res) == 0) { @@ -213,6 +220,8 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) if (IS_CONST(obj)) return obj; + DTRACE1(copy_struct, (int32_t)sz); + hp = htop = *hpp; hbot = htop + sz; hstart = (char *)htop; diff --git a/erts/emulator/beam/dtrace-wrapper.h b/erts/emulator/beam/dtrace-wrapper.h new file mode 100644 index 0000000..8089f49 --- /dev/null +++ b/erts/emulator/beam/dtrace-wrapper.h @@ -0,0 +1,76 @@ +/* + * %CopyrightBegin% + * + * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011. + * All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __DTRACE_WRAPPER_H +#define __DTRACE_WRAPPER_H + +#define DTRACE_TERM_BUF_SIZE 256 + +#ifndef DTRACE_DRIVER_SKIP_FUNC_DECLARATIONS +inline void dtrace_proc_str(Process *process, char *process_buf); +inline void dtrace_pid_str(Eterm pid, char *process_buf); +inline void dtrace_port_str(Port *port, char *port_buf); +inline void dtrace_fun_decode(Process *process, + Eterm module, Eterm function, int arity, + char *process_buf, char *mfa_buf); +#endif + +#ifdef HAVE_DTRACE + +#include "erlang_dtrace.h" + +#define DTRACE_ENABLED(name) \ + erlang_##name##_enabled() +#define DTRACE0(name) \ + erlang_##name() +#define DTRACE1(name, a0) \ + erlang_##name(a0) +#define DTRACE2(name, a0, a1) \ + erlang_##name((a0), (a1)) +#define DTRACE3(name, a0, a1, a2) \ + erlang_##name((a0), (a1), (a2)) +#define DTRACE4(name, a0, a1, a2, a3) \ + erlang_##name((a0), (a1), (a2), (a3)) +#define DTRACE5(name, a0, a1, a2, a3, a4) \ + erlang_##name((a0), (a1), (a2), (a3), (a4)) +#define DTRACE6(name, a0, a1, a2, a3, a4, a5) \ + erlang_##name((a0), (a1), (a2), (a3), (a4), (a5)) +#define DTRACE7(name, a0, a1, a2, a3, a4, a5, a6) \ + erlang_##name((a0), (a1), (a2), (a3), (a4), (a5), (a6)) +#define DTRACE10(name, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ + erlang_##name((a0), (a1), (a2), (a3), (a4), (a5), (a6), (a7), (a8), (a9)) + +#else /* HAVE_DTRACE */ + +/* Render all macros to do nothing */ +#define DTRACE_ENABLED(name) 0 +#define DTRACE0(name) do {} while (0) +#define DTRACE1(name, a0) do {} while (0) +#define DTRACE2(name, a0, a1) do {} while (0) +#define DTRACE3(name, a0, a1, a2) do {} while (0) +#define DTRACE4(name, a0, a1, a2, a3) do {} while (0) +#define DTRACE5(name, a0, a1, a2, a3, a4) do {} while (0) +#define DTRACE6(name, a0, a1, a2, a3, a4, a5) do {} while (0) +#define DTRACE7(name, a0, a1, a2, a3, a4, a5, a6) do {} while (0) +#define DTRACE10(name, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \ + do {} while (0) +#endif /* HAVE_DTRACE */ + +#endif /* __DTRACE_WRAPPER_H */ diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index 91b6441..231b0e5 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -24,6 +24,7 @@ #include "erl_sys_driver.h" #include "global.h" #include "erl_threads.h" +#include "dtrace-wrapper.h" typedef struct _erl_async { struct _erl_async* next; @@ -50,11 +51,21 @@ typedef struct { #ifdef ERTS_ENABLE_LOCK_CHECK int no; #endif +#ifdef HAVE_DTRACE + int pool_member; +#endif /* HAVE_DTRACE */ } AsyncQueue; static erts_smp_spinlock_t async_id_lock; static long async_id = 0; +/* + * Some compilers, e.g. GCC 4.2.1 and -O3, will optimize away DTrace + * calls if they're the last thing in the function. :-( + * Many thanks to Trond Norbye, via: + * https://github.com/memcached/memcached/commit/6298b3978687530bc9d219b6ac707a1b681b2a46 + */ +static int gcc_optimizer_hack = 0; #ifndef ERTS_SMP @@ -79,7 +90,7 @@ static void async_detach(DE_Handle* dh) static AsyncQueue* async_q; static void* async_main(void*); -static void async_add(ErlAsync*, AsyncQueue*); +static void async_add(ErlAsync*, AsyncQueue*, int); #ifndef ERTS_SMP typedef struct ErtsAsyncReadyCallback_ ErtsAsyncReadyCallback; @@ -138,6 +149,9 @@ int init_async(int hndl) #ifdef ERTS_ENABLE_LOCK_CHECK q->no = i; #endif +#ifdef HAVE_DTRACE + q->pool_member = i; +#endif erts_mtx_init(&q->mtx, "asyncq"); erts_cnd_init(&q->cv); erts_thr_create(&q->thr, async_main, (void*)q, &thr_opts); @@ -156,7 +170,7 @@ int exit_async() ErlAsync* a = (ErlAsync*) erts_alloc(ERTS_ALC_T_ASYNC, sizeof(ErlAsync)); a->port = NIL; - async_add(a, &async_q[i]); + async_add(a, &async_q[i], i); } for (i = 0; i < erts_async_max_threads; i++) { @@ -173,8 +187,12 @@ int exit_async() } -static void async_add(ErlAsync* a, AsyncQueue* q) +static void async_add(ErlAsync* a, AsyncQueue* q, int pool_member) { +#ifdef HAVE_DTRACE + int len = 0; +#endif /* HAVE_DTRACE */ + if (is_internal_port(a->port)) { ERTS_LC_ASSERT(erts_drvportid2port(a->port)); /* make sure the driver will stay around */ @@ -182,6 +200,9 @@ static void async_add(ErlAsync* a, AsyncQueue* q) } erts_mtx_lock(&q->mtx); +#ifdef HAVE_DTRACE + len = q->len; +#endif /* HAVE_DTRACE */ if (q->len == 0) { q->head = a; @@ -196,11 +217,17 @@ static void async_add(ErlAsync* a, AsyncQueue* q) q->len++; } erts_mtx_unlock(&q->mtx); + DTRACE2(aio_pool_add, pool_member+11000, len + 1); + gcc_optimizer_hack++; } static ErlAsync* async_get(AsyncQueue* q) { ErlAsync* a; + int len; +#ifdef HAVE_DTRACE + int pool_member; +#endif erts_mtx_lock(&q->mtx); while((a = q->tail) == NULL) { @@ -218,7 +245,12 @@ static ErlAsync* async_get(AsyncQueue* q) q->tail = q->tail->prev; q->len--; } + len = q->len; +#ifdef HAVE_DTRACE + pool_member = q->pool_member; +#endif erts_mtx_unlock(&q->mtx); + DTRACE2(aio_pool_get, pool_member+11000, len); return a; } @@ -437,7 +469,7 @@ long driver_async(ErlDrvPort ix, unsigned int* key, driver_pdl_inc_refc(prt->port_data_lock); a->pdl = prt->port_data_lock; } - async_add(a, &async_q[qix]); + async_add(a, &async_q[qix], qix); return id; } #endif diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index f264bf4..32508f2 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -109,6 +109,9 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE #ifdef VALGRIND " [valgrind-compiled]" #endif +#ifdef HAVE_DTRACE + " [dtrace]" +#endif "\n"); #define ASIZE(a) (sizeof(a)/sizeof(a[0])) diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index e3445bc..e5a287f 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -36,6 +36,8 @@ #include "hipe_mode_switch.h" #endif +#include "dtrace-wrapper.h" + #define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 #define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 #define ERTS_INACT_WR_PB_LEAVE_LIMIT 10 @@ -344,6 +346,7 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) Uint reclaimed_now = 0; int done = 0; Uint ms1, s1, us1; + char pidbuf[DTRACE_TERM_BUF_SIZE]; if (IS_TRACED_FL(p, F_TRACE_GC)) { trace_gc(p, am_gc_start); @@ -366,14 +369,26 @@ erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) FLAGS(p) |= F_NEED_FULLSWEEP; } + pidbuf[0] = '\0'; + if (DTRACE_ENABLED(gc_major_start) + || DTRACE_ENABLED(gc_major_end) + || DTRACE_ENABLED(gc_minor_start) + || DTRACE_ENABLED(gc_minor_end)) { + dtrace_proc_str(p, pidbuf); + } + /* * Test which type of GC to do. */ while (!done) { if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) { + DTRACE2(gc_major_start, pidbuf, need); done = major_collection(p, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_major_end, pidbuf, reclaimed_now); } else { + DTRACE2(gc_minor_start, pidbuf, need); done = minor_collection(p, need, objv, nobj, &reclaimed_now); + DTRACE2(gc_minor_end, pidbuf, reclaimed_now); } } @@ -1064,6 +1079,15 @@ do_minor(Process *p, Uint new_sz, Eterm* objv, int nobj) sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm)); p->stop = n_heap + new_sz - n; + if(HEAP_SIZE(p) != new_sz) { + char pidbuf[DTRACE_TERM_BUF_SIZE]; + + if(DTRACE_ENABLED(process_heap_grow)) { + dtrace_proc_str(p, pidbuf); + DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz); + } + } + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*)HEAP_START(p), HEAP_SIZE(p) * sizeof(Eterm)); @@ -1285,6 +1309,15 @@ major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm)); p->stop = n_heap + new_sz - n; + if(HEAP_SIZE(p) != new_sz) { + char pidbuf[DTRACE_TERM_BUF_SIZE]; + + if(DTRACE_ENABLED(process_heap_grow)) { + dtrace_proc_str(p, pidbuf); + DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz); + } + } + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void *) HEAP_START(p), (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm)); @@ -1955,6 +1988,14 @@ grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj) HEAP_TOP(p) = new_heap + heap_size; HEAP_START(p) = new_heap; } + + if(DTRACE_ENABLED(process_heap_grow)) { + char pidbuf[DTRACE_TERM_BUF_SIZE]; + + dtrace_proc_str(p, pidbuf); + DTRACE3(process_heap_grow, pidbuf, HEAP_SIZE(p), new_sz); + } + HEAP_SIZE(p) = new_sz; } @@ -1993,6 +2034,14 @@ shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj) HEAP_TOP(p) = new_heap + heap_size; HEAP_START(p) = new_heap; } + + if(DTRACE_ENABLED(process_heap_shrink)) { + char pidbuf[DTRACE_TERM_BUF_SIZE]; + + dtrace_proc_str(p, pidbuf); + DTRACE3(process_heap_shrink, pidbuf, HEAP_SIZE(p), new_sz); + } + HEAP_SIZE(p) = new_sz; } diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 587d82f..3d1018f 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -192,6 +192,9 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "save_ops_lock", NULL }, #endif #endif +#ifdef HAVE_DTRACE + { "efile_drv dtrace mutex", NULL }, +#endif { "mtrace_buf", NULL }, { "erts_alloc_hard_debug", NULL } }; diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 82f272d..921cfe3 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -32,6 +32,8 @@ #include "erl_nmgc.h" #include "erl_binary.h" +#include "dtrace-wrapper.h" + ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message, ErlMessage, ERL_MESSAGE_BUF_SZ, @@ -462,12 +464,20 @@ erts_queue_message(Process* receiver, LINK_MESSAGE(receiver, mp); #endif + if (DTRACE_ENABLED(message_receive)) { + char receiver_name[DTRACE_TERM_BUF_SIZE]; + + dtrace_proc_str(receiver, receiver_name); + DTRACE3(message_receive, + receiver_name, size_object(message), receiver->msg.len); + } + notify_new_message(receiver); if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { trace_receive(receiver, message); } - + #ifndef ERTS_SMP ERTS_HOLE_CHECK(receiver); #endif @@ -779,6 +789,15 @@ erts_send_message(Process* sender, BM_MESSAGE(message,sender,receiver); BM_START_TIMER(send); + + if (DTRACE_ENABLED(message_send)) { + char sender_name[64]; + char receiver_name[64]; + erts_snprintf(sender_name, sizeof(sender_name), "%T", sender->id); + erts_snprintf(receiver_name, sizeof(receiver_name), "%T", receiver->id); + DTRACE3(message_send, sender_name, receiver_name, size_object(message)); + } + if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) { Eterm* hp; @@ -841,6 +860,11 @@ erts_send_message(Process* sender, LINK_MESSAGE(receiver, mp); ACTIVATE(receiver); + if (DTRACE_ENABLED(message_send)) { + msize = size_object(message); + DTRACE3(message_send, sender, receiver, (uint32_t)msize); + } + if (receiver->status == P_WAITING) { erts_add_to_runq(receiver); } else if (receiver->status == P_SUSPENDED) { @@ -916,7 +940,9 @@ erts_send_message(Process* sender, BM_SWAP_TIMER(send,size); msize = size_object(message); BM_SWAP_TIMER(size,send); - + + DTRACE3(message_send, sender, receiver, (uint32_t)msize); + if (receiver->stop - receiver->htop <= msize) { BM_SWAP_TIMER(send,system); erts_garbage_collect(receiver, msize, receiver->arg_reg, receiver->arity); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 6e7ac43..8ed0f8f 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -65,7 +65,8 @@ static void add_readonly_check(ErlNifEnv*, unsigned char* ptr, unsigned sz); static int is_offheap(const ErlOffHeap* off_heap); #endif - +void dtrace_nifenv_str(ErlNifEnv *, char *); + #define MIN_HEAP_FRAG_SZ 200 static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need, Eterm* hp); @@ -1700,6 +1701,10 @@ void erl_nif_init() resource_type_list.name = THE_NON_VALUE; } +void dtrace_nifenv_str(ErlNifEnv *env, char *process_buf) { + dtrace_pid_str(env->proc->id, process_buf); +} + #ifdef READONLY_CHECK /* Use checksums to assert that NIFs do not write into inspected binaries */ diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ba3b32d..09ca59c 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -40,6 +40,8 @@ #include "beam_bp.h" #include "erl_cpu_topology.h" +#include "dtrace-wrapper.h" + #define ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED (2000*CONTEXT_REDS) #define ERTS_RUNQ_CALL_CHECK_BALANCE_REDS \ (ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED/2) @@ -5171,6 +5173,12 @@ Process *schedule(Process *p, int calls) int actual_reds; int reds; + if (DTRACE_ENABLED(process_unscheduled)) { + char process_buf[DTRACE_TERM_BUF_SIZE]; + dtrace_proc_str(p, process_buf); + DTRACE1(process_unscheduled, process_buf); + } + if (ERTS_USE_MODIFIED_TIMING()) { context_reds = ERTS_MODIFIED_TIMING_CONTEXT_REDS; input_reductions = ERTS_MODIFIED_TIMING_INPUT_REDS; @@ -5698,6 +5706,7 @@ Process *schedule(Process *p, int calls) p->fcalls = reds; ASSERT(IS_ACTIVE(p)); ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + return p; } } @@ -6377,6 +6386,13 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). VERBOSE(DEBUG_PROCESSES, ("Created a new process: %T\n",p->id)); + if (DTRACE_ENABLED(process_spawn)) { + char process_name[DTRACE_TERM_BUF_SIZE]; + char mfa[DTRACE_TERM_BUF_SIZE]; + dtrace_fun_decode(p, mod, func, arity, process_name, mfa); + DTRACE2(process_spawn, process_name, mfa); + } + error: erts_smp_proc_unlock(parent, ERTS_PROC_LOCKS_ALL_MINOR); @@ -6945,6 +6961,17 @@ send_exit_signal(Process *c_p, /* current process if and only ASSERT(reason != THE_NON_VALUE); + if(DTRACE_ENABLED(process_exit_signal) && is_pid(from)) { + char sender_str[DTRACE_TERM_BUF_SIZE]; + char receiver_str[DTRACE_TERM_BUF_SIZE]; + char reason_buf[DTRACE_TERM_BUF_SIZE]; + + dtrace_pid_str(from, sender_str); + dtrace_proc_str(rp, receiver_str); + erts_snprintf(reason_buf, sizeof(reason_buf) - 1, "%T", reason); + DTRACE3(process_exit_signal, sender_str, receiver_str, reason_buf); + } + if (ERTS_PROC_IS_TRAPPING_EXITS(rp) && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { if (is_not_nil(token) && token_update) @@ -7380,7 +7407,15 @@ erts_do_exit_process(Process* p, Eterm reason) p->arity = 0; /* No live registers */ p->fvalue = reason; - + + if (DTRACE_ENABLED(process_exit)) { + char process_buf[DTRACE_TERM_BUF_SIZE]; + char reason_buf[256]; + dtrace_proc_str(p, process_buf); + erts_snprintf(reason_buf, sizeof(reason_buf) - 1, "%T", reason); + DTRACE2(process_exit, process_buf, reason_buf); + } + #ifdef ERTS_SMP ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); /* By locking all locks (main lock is already locked) when going diff --git a/erts/emulator/beam/erlang_dtrace.d b/erts/emulator/beam/erlang_dtrace.d new file mode 100644 index 0000000..1f9f6de --- /dev/null +++ b/erts/emulator/beam/erlang_dtrace.d @@ -0,0 +1,357 @@ +/* + * %CopyrightBegin% + * + * Copyright Dustin Sallings, Michal Ptaszek, Scott Lystig Fritchie 2011. + * All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * A note on probe naming: if "__" appears in a provider probe + * definition, then two things happen during compilation: + * + * 1. The "__" will turn into a hypen, "-", for the probe name. + * 2. The "__" will turn into a single underscore, "_", for the + * macro names and function definitions that the compiler and + * C developers will see. + * + * We'll try to use the following naming convention. We're a bit + * limited because, as a USDT probe, we can only specify the 4th part + * of the probe name, e.g. erlang*:::mumble. The 2nd part of the + * probe name is always going to be "beam" or "beam.smp", and the 3rd + * part of the probe name will always be the name of the function + * that's calling the probe. + * + * So, all probes will be have names defined in this file using the + * convention category__name or category__sub_category__name. This + * will translate to probe names of category-name or + * category-sub_category-name. + * + * Each of "category", "sub_category", and "name" may have underscores + * but may not have hyphens. + */ + +provider erlang { + /** + * Fired when a message is sent from one local process to another. + * + * @param sender the PID (string form) of the sender + * @param receiver the PID (string form) of the receiver + * @param size the size of the message being delivered + */ + probe message__send(char *sender, char *receiver, uint32_t size); + + /** + * Fired when a message is delivered to a local process. + * + * @param receiver the PID (string form) of the receiver + * @param size the size of the message being delivered + * @param queue_len length of the queue of the receiving process + */ + probe message__receive(char *receiver, uint32_t size, uint32_t queue_len); + + /** + * Fired when an Eterm structure is being copied. + * + * NOTE: Due to the placement of this probe, the process ID of + * owner of the Eterm is not available. + * + * @param size the size of the structure + */ + probe copy__struct(uint32_t size); + + /** + * Fired when an Eterm is being copied onto a process. + * + * @param proc the PID (string form) of the recipient process + * @param size the size of the structure + */ + probe copy__object(char *proc, uint32_t size); + + /* PID, Module, Function, Arity */ + + /** + * Fired whenever a user function is being called. + * + * @param p the PID (string form) of the process + * @param mfa the m:f/a of the function + * @param depth the stack depth + */ + probe function__entry(char *p, char *mfa, int depth); + + /** + * Fired whenever a user function returns. + * + * @param p the PID (string form) of the process + * @param mfa the m:f/a of the function + * @param depth the stack depth + */ + probe function__return(char *p, char *mfa, int depth); + + /** + * Fired whenever a Built In Function is called. + * + * @param p the PID (string form) of the process + * @param mfa the m:f/a of the function + */ + probe bif__entry(char *p, char *mfa); + + /** + * Fired whenever a Built In Function returns. + * + * @param p the PID (string form) of the process + * @param mfa the m:f/a of the function + */ + probe bif__return(char *p, char *mfa); + + /** + * Fired whenever a Native Function is called. + * + * @param p the PID (string form) of the process + * @param mfa the m:f/a of the function + */ + probe nif__entry(char *p, char *mfa); + + /** + * Fired whenever a Native Function returns. + * + * @param p the PID (string form) of the process + * @param mfa the m:f/a of the function + */ + probe nif__return(char *p, char *mfa); + + /** + * Fired when a major GC is starting. + * + * @param p the PID (string form) of the exiting process + * @param need the number of words needed on the heap + */ + probe gc_major__start(char *p, int need); + + /** + * Fired when a minor GC is starting. + * + * @param p the PID (string form) of the exiting process + * @param need the number of words needed on the heap + */ + probe gc_minor__start(char *p, int need); + + /** + * Fired when a major GC is starting. + * + * @param p the PID (string form) of the exiting process + * @param reclaimed the amount of space reclaimed + */ + probe gc_major__end(char *p, int reclaimed); + + /** + * Fired when a minor GC is starting. + * + * @param p the PID (string form) of the exiting process + * @param reclaimed the amount of space reclaimed + */ + probe gc_minor__end(char *p, int reclaimed); + + /** + * Fired when a process is spawned. + * + * @param p the PID (string form) of the new process. + * @param mfa the m:f/a of the function + */ + probe process__spawn(char *p, char *mfa); + + /** + * Fired when a process is exiting. + * + * @param p the PID (string form) of the exiting process + * @param reason the reason for the exit (may be truncated) + */ + probe process__exit(char *p, char *reason); + + /** + * Fired when exit signal is delivered to a local process. + * + * @param sender the PID (string form) of the exiting process + * @param receiver the PID (string form) of the process receiving EXIT signal + * @param reason the reason for the exit (may be truncated) + */ + probe process__exit_signal(char *sender, char *receiver, char *reason); + + /** + * Fired when a process is scheduled. + * + * @param p the PID (string form) of the newly scheduled process + * @param mfa the m:f/a of the function it should run next + */ + probe process__scheduled(char *p, char *mfa); + + /** + * Fired when a process is unscheduled. + * + * @param p the PID (string form) of the process that has been + * unscheduled. + */ + probe process__unscheduled(char *p); + + /** + * Fired when a process goes into hibernation. + * + * @param p the PID (string form) of the process entering hibernation + * @param mfa the m:f/a of the location to resume + */ + probe process__hibernate(char *p, char *mfa); + + /** + * Fired when process' heap is growing. + * + * @param p the PID (string form) of the existing process + * @param old_size the size of the old heap + * @param new_size the size of the new heap + */ + probe process__heap_grow(char *p, int old_size, int new_size); + + /** + * Fired when process' heap is shrinking. + * + * @param p the PID (string form) of the existing process + * @param old_size the size of the old heap + * @param new_size the size of the new heap + */ + probe process__heap_shrink(char *p, int old_size, int new_size); + + /** + * Fired when port_command is issued. + * + * @param proces the PID (string form) of the existing process + * @param port the Port (string form) of the existing port + * @param port_name the string used when opening a port + * @param command_type type of the issued command, one of: "close", "command" or "connect" + */ + probe port__command(char *process, char *port, char *port_name, char *command_type); + + /** + * Fired when port_control is issued. + * + * @param proces the PID (string form) of the existing process + * @param port the Port (string form) of the existing port + * @param port_name the string used when opening a port + * @param command_no command number that has been issued to the port + */ + probe port__control(char *process, char *port, char *port_name, int command_no); + + + /* Async driver pool */ + + /** + * Show the post-add length of the async driver thread pool member's queue. + * + * @param pool member number + * @param new queue length + */ + probe aio_pool__add(int, int); + + /** + * Show the post-get length of the async driver thread pool member's queue. + * + * @param pool member number + * @param new queue length + */ + probe aio_pool__get(int, int); + + /* Probes for efile_drv.c */ + + /** + * Entry into the efile_drv.c file I/O driver + * + * For a list of command numbers used by this driver, see the section + * "Guide to probe arguments" in ../../../README.md. That section + * also contains explanation of the various integer and string + * arguments that may be present when any particular probe fires. + * + * @param thread-id number of the scheduler Pthread arg0 + * @param tag number: {thread-id, tag} uniquely names a driver operation + * @param user-tag string arg2 + * @param command number arg3 + * @param string argument 1 arg4 + * @param string argument 2 arg5 + * @param integer argument 1 arg6 + * @param integer argument 2 arg7 + * @param integer argument 3 arg8 + * @param integer argument 4 arg9 + */ + probe efile_drv__entry(int, int, char *, int, char *, char *, + int64_t, int64_t, int64_t, int64_t); + + /* 0 1 2 3 */ + /* thread-id, tag, work-thread-id, command */ + /** + * Entry into the driver's internal work function. Computation here + * is performed by a async worker pool Pthread. + * + * @param thread-id number + * @param tag number + * @param worker pool thread-id number + * @param command number + */ + probe efile_drv__int_entry(int, int, int, int); + + /** + * Return from the driver's internal work function. + * + * @param thread-id number + * @param tag number + * @param worker pool thread-id number + * @param command number + */ + probe efile_drv__int_return(int, int, int, int); + + /** + * Return from the efile_drv.c file I/O driver + * + * @param thread-id number arg0 + * @param tag number arg1 + * @param user-tag string arg2 + * @param command number arg3 + * @param Success? 1 is success, 0 is failure arg4 + * @param If failure, the errno of the error. arg5 + * @param thread-id number of the scheduler Pthread executing now arg6 + */ + probe efile_drv__return(int, int, char *, int, int, int, int); + +/* + * NOTE: + * For formatting int64_t arguments within a D script, see: + * + * http://mail.opensolaris.org/pipermail/dtrace-discuss/2006-November/002830.html + * Summary: + * "1) you don't need the 'l' printf() modifiers with DTrace ever" + */ + +/* + * NOTE: For file_drv_return + SMP + R14B03 (and perhaps other + * releases), the sched-thread-id will be the same as the + * work-thread-id: erl_async.c's async_main() function + * will call the asynchronous invoke function and then + * immediately call the drivers ready_async function while + * inside the same I/O worker pool thread. + * For R14B03's source, see erl_async.c lines 302-317. + */ +}; + +#pragma D attributes Evolving/Evolving/Common provider erlang provider +#pragma D attributes Private/Private/Common provider erlang module +#pragma D attributes Private/Private/Common provider erlang function +#pragma D attributes Evolving/Evolving/Common provider erlang name +#pragma D attributes Evolving/Evolving/Common provider erlang args diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 499bdd7..a37bf5e 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1052,6 +1052,12 @@ void init_emulator(void); void process_main(void); Eterm build_stacktrace(Process* c_p, Eterm exc); Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value); +ERTS_INLINE void dtrace_proc_str(Process *process, char *process_buf); +ERTS_INLINE void dtrace_pid_str(Eterm pid, char *process_buf); +ERTS_INLINE void dtrace_port_str(Port *port, char *port_buf); +ERTS_INLINE void dtrace_fun_decode(Process *process, + Eterm module, Eterm function, int arity, + char *process_buf, char *mfa_buf); /* erl_init.c */ diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index df5f8b2..026bfeb 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -43,6 +43,8 @@ #include "erl_version.h" #include "error.h" +#include "dtrace-wrapper.h" + extern ErlDrvEntry fd_driver_entry; extern ErlDrvEntry vanilla_driver_entry; extern ErlDrvEntry spawn_driver_entry; @@ -1174,6 +1176,15 @@ int erts_write_to_port(Eterm caller_id, Port *p, Eterm list) buf = erts_alloc(ERTS_ALC_T_TMP, size+1); r = io_list_to_buf(list, buf, size); + if(DTRACE_ENABLED(port_command)) { + char process_str[DTRACE_TERM_BUF_SIZE]; + char port_str[DTRACE_TERM_BUF_SIZE]; + + dtrace_pid_str(caller_id, process_str); + dtrace_port_str(p, port_str); + DTRACE4(port_command, process_str, port_str, p->name, "command"); + } + if (r >= 0) { size -= r; fpe_was_unmasked = erts_block_fpe(); @@ -2103,6 +2114,15 @@ void erts_port_command(Process *proc, if (tp[2] == am_close) { erts_port_status_bor_set(port, ERTS_PORT_SFLG_SEND_CLOSED); erts_do_exit_port(port, pid, am_normal); + + if(DTRACE_ENABLED(port_command)) { + char process_str[DTRACE_TERM_BUF_SIZE]; + char port_str[DTRACE_TERM_BUF_SIZE]; + + dtrace_proc_str(proc, process_str); + dtrace_port_str(port, port_str); + DTRACE4(port_command, process_str, port_str, port->name, "close"); + } goto done; } else if (is_tuple_arity(tp[2], 2)) { tp = tuple_val(tp[2]); @@ -2110,6 +2130,14 @@ void erts_port_command(Process *proc, if (erts_write_to_port(caller_id, port, tp[2]) == 0) goto done; } else if ((tp[1] == am_connect) && is_internal_pid(tp[2])) { + if(DTRACE_ENABLED(port_command)) { + char process_str[DTRACE_TERM_BUF_SIZE]; + char port_str[DTRACE_TERM_BUF_SIZE]; + + dtrace_proc_str(proc, process_str); + dtrace_port_str(port, port_str); + DTRACE4(port_command, process_str, port_str, port->name, "connect"); + } port->connected = tp[2]; deliver_result(port->id, pid, am_connected); goto done; @@ -2211,6 +2239,15 @@ erts_port_control(Process* p, Port* prt, Uint command, Eterm iolist) erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); ERTS_SMP_CHK_NO_PROC_LOCKS; + if(DTRACE_ENABLED(port_control)) { + char process_str[DTRACE_TERM_BUF_SIZE]; + char port_str[DTRACE_TERM_BUF_SIZE]; + + dtrace_proc_str(p, process_str); + dtrace_port_str(prt, port_str); + DTRACE4(port_control, process_str, port_str, prt->name, command); + } + /* * Call the port's control routine. */ diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index f0ff3f5..5131d4a 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -103,6 +103,8 @@ #include "erl_threads.h" #include "zlib.h" #include "gzio.h" +#define DTRACE_DRIVER_SKIP_FUNC_DECLARATIONS +#include "dtrace-wrapper.h" #include #include @@ -110,6 +112,41 @@ void erl_exit(int n, char *fmt, ...); static ErlDrvSysInfo sys_info; +/* For explanation of this var, see comment for same var in erl_async.c */ +static int gcc_optimizer_hack = 0; + +#ifdef HAVE_DTRACE + +#define DTRACE_INVOKE_SETUP(op) \ + dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base) ; \ + do { DTRACE4(efile_drv_int_entry, d->sched_i1, d->sched_i2, \ + dt_priv->thread_num, op); } while (0) +#define DTRACE_INVOKE_SETUP_BY_NAME(op) \ + struct t_data *d = (struct t_data *) data ; \ + DTRACE_INVOKE_SETUP(op) +#define DTRACE_INVOKE_RETURN(op) \ + do { DTRACE4(efile_drv_int_return, d->sched_i1, d->sched_i2, \ + dt_priv->thread_num, op); } while (0) ; gcc_optimizer_hack++ ; + +int dt_driver_idnum = 0; +int dt_driver_io_worker_base = 5000; +erts_mtx_t dt_driver_mutex; +pthread_key_t dt_driver_key; + +typedef struct { + int thread_num; + Uint64 tag; +} dt_private; + +dt_private *get_dt_private(int); +#else /* HAVE_DTRACE */ +typedef struct { +} dt_private; + +#define DTRACE_INVOKE_SETUP(op) do {} while (0) +#define DTRACE_INVOKE_SETUP_BY_NAME(op) do {} while (0) +#define DTRACE_INVOKE_RETURN(op) do {} while (0) +#endif /* HAVE_DTRACE */ /* #define TRACE 1 */ #ifdef TRACE @@ -248,6 +285,9 @@ typedef struct { unsigned long write_delay; int write_error; Efile_error write_errInfo; +#ifdef HAVE_DTRACE + int idnum; /* Unique ID # for this driver thread/desc */ +#endif /* HAVE_DTRACE */ ErlDrvPDL q_mtx; /* Mutex for the driver queue, known by the emulator. Also used for mutual exclusion when accessing field(s) below. */ size_t write_buffered; @@ -337,6 +377,13 @@ struct t_data void (*free)(void *); int again; int reply; +#ifdef HAVE_DTRACE + int sched_i1; + Uint64 sched_i2; + char sched_utag[128+1]; +#else + char sched_utag[1]; +#endif int result_ok; Efile_error errInfo; int flags; @@ -399,8 +446,6 @@ struct t_data char b[1]; }; - - #define EF_ALLOC(S) driver_alloc((S)) #define EF_REALLOC(P, S) driver_realloc((P), (S)) #define EF_SAFE_ALLOC(S) ef_safe_alloc((S)) @@ -429,7 +474,7 @@ static void *ef_safe_realloc(void *op, Uint s) * ErlIOVec manipulation functions. */ -/* char EV_CHAR(ErlIOVec *ev, int p, int q) */ +/* char EV_CHAR_P(ErlIOVec *ev, int p, int q) */ #define EV_CHAR_P(ev, p, q) \ (((char *)(ev)->iov[(q)].iov_base) + (p)) @@ -625,6 +670,10 @@ file_init(void) ? atoi(buf) : 0); driver_system_info(&sys_info, sizeof(ErlDrvSysInfo)); +#ifdef HAVE_DTRACE + erts_mtx_init(&dt_driver_mutex, "efile_drv dtrace mutex"); + pthread_key_create(&dt_driver_key, NULL); +#endif /* HAVE_DTRACE */ return 0; } @@ -661,6 +710,9 @@ file_start(ErlDrvPort port, char* command) desc->write_error = 0; MUTEX_INIT(desc->q_mtx, port); /* Refc is one, referenced by emulator now */ desc->write_buffered = 0; +#ifdef HAVE_DTRACE + get_dt_private(0); /* throw away return value */ +#endif /* HAVE_DTRACE */ return (ErlDrvData) desc; } @@ -680,8 +732,10 @@ static void do_close(int flags, SWord fd) { static void invoke_close(void *data) { struct t_data *d = (struct t_data *) data; + DTRACE_INVOKE_SETUP(FILE_CLOSE); d->again = 0; do_close(d->flags, d->fd); + DTRACE_INVOKE_RETURN(FILE_CLOSE); } /********************************************************************* @@ -904,49 +958,63 @@ static void invoke_name(void *data, int (*f)(Efile_error *, char *)) static void invoke_mkdir(void *data) { + DTRACE_INVOKE_SETUP_BY_NAME(FILE_MKDIR); invoke_name(data, efile_mkdir); + DTRACE_INVOKE_RETURN(FILE_MKDIR); } static void invoke_rmdir(void *data) { + DTRACE_INVOKE_SETUP_BY_NAME(FILE_RMDIR); invoke_name(data, efile_rmdir); + DTRACE_INVOKE_RETURN(FILE_RMDIR); } static void invoke_delete_file(void *data) { + DTRACE_INVOKE_SETUP_BY_NAME(FILE_DELETE); invoke_name(data, efile_delete_file); + DTRACE_INVOKE_RETURN(FILE_DELETE); } static void invoke_chdir(void *data) { + DTRACE_INVOKE_SETUP_BY_NAME(FILE_CHDIR); invoke_name(data, efile_chdir); + DTRACE_INVOKE_RETURN(FILE_CHDIR); } static void invoke_fdatasync(void *data) { struct t_data *d = (struct t_data *) data; int fd = (int) d->fd; + DTRACE_INVOKE_SETUP(FILE_FDATASYNC); d->again = 0; d->result_ok = efile_fdatasync(&d->errInfo, fd); + DTRACE_INVOKE_RETURN(FILE_FDATASYNC); } static void invoke_fsync(void *data) { struct t_data *d = (struct t_data *) data; int fd = (int) d->fd; + DTRACE_INVOKE_SETUP(FILE_FSYNC); d->again = 0; d->result_ok = efile_fsync(&d->errInfo, fd); + DTRACE_INVOKE_RETURN(FILE_FSYNC); } static void invoke_truncate(void *data) { struct t_data *d = (struct t_data *) data; int fd = (int) d->fd; + DTRACE_INVOKE_SETUP(FILE_TRUNCATE); d->again = 0; d->result_ok = efile_truncate_file(&d->errInfo, &fd, d->flags); + DTRACE_INVOKE_RETURN(FILE_TRUNCATE); } static void invoke_read(void *data) @@ -954,6 +1022,7 @@ static void invoke_read(void *data) struct t_data *d = (struct t_data *) data; int status, segment; size_t size, read_size; + DTRACE_INVOKE_SETUP(FILE_READ); segment = d->again && d->c.read.bin_size >= 2*FILE_SEGMENT_READ; if (segment) { @@ -988,6 +1057,7 @@ static void invoke_read(void *data) } else { d->again = 0; } + DTRACE_INVOKE_RETURN(FILE_READ); } static void free_read(void *data) @@ -1004,6 +1074,7 @@ static void invoke_read_line(void *data) int status; size_t read_size; int local_loop = (d->again == 0); + DTRACE_INVOKE_SETUP(FILE_READ_LINE); do { size_t size = (d->c.read_line.binp)->orig_size - @@ -1095,6 +1166,7 @@ static void invoke_read_line(void *data) break; } } while (local_loop); + DTRACE_INVOKE_RETURN(FILE_READ_LINE); } static void free_read_line(void *data) @@ -1110,6 +1182,7 @@ static void invoke_read_file(void *data) struct t_data *d = (struct t_data *) data; size_t read_size; int chop; + DTRACE_INVOKE_SETUP(FILE_READ_FILE); if (! d->c.read_file.binp) { /* First invocation only */ int fd; @@ -1146,12 +1219,14 @@ static void invoke_read_file(void *data) &read_size); if (d->result_ok) { d->c.read_file.offset += read_size; - if (chop) return; /* again */ + if (chop) goto chop_done; /* again */ } close: efile_closefile((int) d->fd); done: d->again = 0; + chop_done: + DTRACE_INVOKE_RETURN(FILE_READ_FILE); } static void free_read_file(void *data) @@ -1171,6 +1246,7 @@ static void invoke_preadv(void *data) ErlIOVec *ev = &c->eiov; size_t bytes_read_so_far = 0; unsigned char *p = (unsigned char *)ev->iov[0].iov_base + 4+4+8*c->cnt; + DTRACE_INVOKE_SETUP(FILE_PREADV); while (c->cnt < c->n) { size_t read_size = ev->iov[1 + c->cnt].iov_len - c->size; @@ -1192,7 +1268,7 @@ static void invoke_preadv(void *data) bytes_read_so_far += bytes_read; if (chop && bytes_read == read_size) { c->size += bytes_read; - return; + goto done; } ASSERT(bytes_read <= read_size); ev->iov[1 + c->cnt].iov_len = bytes_read + c->size; @@ -1203,7 +1279,7 @@ static void invoke_preadv(void *data) if (d->again && bytes_read_so_far >= FILE_SEGMENT_READ && c->cnt < c->n) { - return; + goto done; } } else { /* In case of a read error, ev->size will not be correct, @@ -1214,6 +1290,8 @@ static void invoke_preadv(void *data) } } d->again = 0; + done: + DTRACE_INVOKE_RETURN(FILE_PREADV); } static void free_preadv(void *data) { @@ -1235,6 +1313,7 @@ static void invoke_ipread(void *data) size_t bytes_read = 0; char buf[2*sizeof(Uint32)]; Uint32 offset, size; + DTRACE_INVOKE_SETUP(FILE_IPREAD); /* Read indirection header */ if (! efile_pread(&d->errInfo, (int) d->fd, c->offsets[0], @@ -1273,14 +1352,17 @@ static void invoke_ipread(void *data) /* Read data block */ d->invoke = invoke_preadv; invoke_preadv(data); + DTRACE_INVOKE_RETURN(FILE_IPREAD); return; error: d->result_ok = 0; d->again = 0; + DTRACE_INVOKE_RETURN(FILE_IPREAD); return; done: d->result_ok = !0; d->again = 0; + DTRACE_INVOKE_RETURN(FILE_IPREAD); } /* invoke_writev and invoke_pwritev are the only thread functions that @@ -1303,6 +1385,7 @@ static void invoke_writev(void *data) { size_t size; size_t p; int segment; + DTRACE_INVOKE_SETUP(FILE_WRITE); segment = d->again && d->c.writev.size >= 2*FILE_SEGMENT_WRITE; if (segment) { @@ -1372,6 +1455,7 @@ static void invoke_writev(void *data) { TRACE_F(("w%lu", (unsigned long)size)); } + DTRACE_INVOKE_RETURN(FILE_WRITE); } static void free_writev(void *data) { @@ -1385,34 +1469,40 @@ static void free_writev(void *data) { static void invoke_pwd(void *data) { struct t_data *d = (struct t_data *) data; + DTRACE_INVOKE_SETUP(FILE_PWD); d->again = 0; d->result_ok = efile_getdcwd(&d->errInfo,d->drive, d->b+1, RESBUFSIZE-1); + DTRACE_INVOKE_RETURN(FILE_PWD); } static void invoke_readlink(void *data) { struct t_data *d = (struct t_data *) data; char resbuf[RESBUFSIZE]; /* Result buffer. */ + DTRACE_INVOKE_SETUP(FILE_READLINK); d->again = 0; d->result_ok = efile_readlink(&d->errInfo, d->b, resbuf+1, RESBUFSIZE-1); if (d->result_ok != 0) FILENAME_COPY((char *) d->b + 1, resbuf+1); + DTRACE_INVOKE_RETURN(FILE_READLINK); } static void invoke_altname(void *data) { struct t_data *d = (struct t_data *) data; char resbuf[RESBUFSIZE]; /* Result buffer. */ + DTRACE_INVOKE_SETUP(FILE_ALTNAME); d->again = 0; d->result_ok = efile_altname(&d->errInfo, d->b, resbuf+1, RESBUFSIZE-1); if (d->result_ok != 0) FILENAME_COPY((char *) d->b + 1, resbuf+1); + DTRACE_INVOKE_RETURN(FILE_ALTNAME); } static void invoke_pwritev(void *data) { @@ -1425,6 +1515,7 @@ static void invoke_pwritev(void *data) { size_t p; int segment; size_t size, write_size; + DTRACE_INVOKE_SETUP(FILE_PWRITEV); segment = d->again && c->size >= 2*FILE_SEGMENT_WRITE; if (segment) { @@ -1504,6 +1595,7 @@ static void invoke_pwritev(void *data) { } done: EF_FREE(iov); /* Free our copy of the vector, nothing to restore */ + DTRACE_INVOKE_RETURN(FILE_PWRITEV); } static void free_pwritev(void *data) { @@ -1518,10 +1610,20 @@ static void free_pwritev(void *data) { static void invoke_flstat(void *data) { struct t_data *d = (struct t_data *) data; +#ifdef HAVE_DTRACE + dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base); +#endif + DTRACE4(efile_drv_int_entry, d->sched_i1, d->sched_i2, + dt_priv->thread_num, d->command == FILE_LSTAT ? FILE_LSTAT : + FILE_FSTAT); d->again = 0; d->result_ok = efile_fileinfo(&d->errInfo, &d->info, d->b, d->command == FILE_LSTAT); + DTRACE4(efile_drv_int_entry, d->sched_i1, d->sched_i2, + dt_priv->thread_num, d->command == FILE_LSTAT ? FILE_LSTAT : + FILE_FSTAT); + gcc_optimizer_hack++; } static void invoke_link(void *data) @@ -1529,10 +1631,12 @@ static void invoke_link(void *data) struct t_data *d = (struct t_data *) data; char *name = d->b; char *new_name; + DTRACE_INVOKE_SETUP(FILE_LINK); d->again = 0; new_name = name+FILENAME_BYTELEN(name)+FILENAME_CHARSIZE; d->result_ok = efile_link(&d->errInfo, name, new_name); + DTRACE_INVOKE_RETURN(FILE_LINK); } static void invoke_symlink(void *data) @@ -1540,10 +1644,12 @@ static void invoke_symlink(void *data) struct t_data *d = (struct t_data *) data; char *name = d->b; char *new_name; + DTRACE_INVOKE_SETUP(FILE_SYMLINK); d->again = 0; new_name = name+FILENAME_BYTELEN(name)+FILENAME_CHARSIZE; d->result_ok = efile_symlink(&d->errInfo, name, new_name); + DTRACE_INVOKE_RETURN(FILE_SYMLINK); } static void invoke_rename(void *data) @@ -1551,24 +1657,29 @@ static void invoke_rename(void *data) struct t_data *d = (struct t_data *) data; char *name = d->b; char *new_name; + DTRACE_INVOKE_SETUP(FILE_RENAME); d->again = 0; new_name = name+FILENAME_BYTELEN(name)+FILENAME_CHARSIZE; d->result_ok = efile_rename(&d->errInfo, name, new_name); + DTRACE_INVOKE_RETURN(FILE_RENAME); } static void invoke_write_info(void *data) { struct t_data *d = (struct t_data *) data; + DTRACE_INVOKE_SETUP(FILE_WRITE_INFO); d->again = 0; d->result_ok = efile_write_info(&d->errInfo, &d->info, d->b); + DTRACE_INVOKE_RETURN(FILE_WRITE_INFO); } static void invoke_lseek(void *data) { struct t_data *d = (struct t_data *) data; int status; + DTRACE_INVOKE_SETUP(FILE_LSEEK); d->again = 0; if (d->flags & EFILE_COMPRESSED) { @@ -1593,6 +1704,7 @@ static void invoke_lseek(void *data) &d->c.lseek.location); } d->result_ok = status; + DTRACE_INVOKE_RETURN(FILE_LSEEK); } static void invoke_readdir(void *data) @@ -1602,6 +1714,7 @@ static void invoke_readdir(void *data) char *p = NULL; int buf_sz = 0; size_t tmp_bs; + DTRACE_INVOKE_SETUP(FILE_READDIR); d->again = 0; d->errInfo.posix_errno = 0; @@ -1646,13 +1759,14 @@ static void invoke_readdir(void *data) break; } } + DTRACE_INVOKE_RETURN(FILE_READDIR); } static void invoke_open(void *data) { struct t_data *d = (struct t_data *) data; - int status = 1; /* Status of open call. */ + DTRACE_INVOKE_SETUP(FILE_OPEN); d->again = 0; if ((d->flags & EFILE_COMPRESSED) == 0) { @@ -1685,6 +1799,7 @@ static void invoke_open(void *data) } d->result_ok = status; + DTRACE_INVOKE_RETURN(FILE_OPEN); } static void invoke_fadvise(void *data) @@ -1694,15 +1809,18 @@ static void invoke_fadvise(void *data) off_t offset = (off_t) d->c.fadvise.offset; off_t length = (off_t) d->c.fadvise.length; int advise = (int) d->c.fadvise.advise; + DTRACE_INVOKE_SETUP(FILE_FADVISE); d->again = 0; d->result_ok = efile_fadvise(&d->errInfo, fd, offset, length, advise); + DTRACE_INVOKE_RETURN(FILE_FADVISE); } static void free_readdir(void *data) { struct t_data *d = (struct t_data *) data; struct t_readdir_buf *b1 = d->c.read_dir.first_buf; + while (b1) { struct t_readdir_buf *b2 = b1; b1 = b1->next; @@ -1767,12 +1885,13 @@ static void cq_execute(file_descriptor *desc) { DRIVER_ASYNC(d->level, desc, d->invoke, void_ptr=d, d->free); } -static int async_write(file_descriptor *desc, int *errp, - int reply, Uint32 reply_size) { +static struct t_data *async_write(file_descriptor *desc, int *errp, + int reply, Uint32 reply_size, + Sint64 *dt_i1, Sint64 *dt_i2, Sint64 *dt_i3) { struct t_data *d; if (! (d = EF_ALLOC(sizeof(struct t_data) - 1))) { if (errp) *errp = ENOMEM; - return -1; + return NULL; } TRACE_F(("w%lu", (unsigned long)desc->write_buffered)); d->command = FILE_WRITE; @@ -1781,6 +1900,11 @@ static int async_write(file_descriptor *desc, int *errp, d->c.writev.port = desc->port; d->c.writev.q_mtx = desc->q_mtx; d->c.writev.size = desc->write_buffered; + if (dt_i1 != NULL) { + *dt_i1 = d->fd; + *dt_i2 = d->flags; + *dt_i3 = d->c.writev.size; + } d->reply = reply; d->c.writev.free_size = 0; d->c.writev.reply_size = reply_size; @@ -1789,18 +1913,41 @@ static int async_write(file_descriptor *desc, int *errp, d->level = 1; cq_enq(desc, d); desc->write_buffered = 0; - return 0; + return d; } -static int flush_write(file_descriptor *desc, int *errp) { - int result; +static int flush_write(file_descriptor *desc, int *errp, + dt_private *dt_priv, char *dt_utag) { + int result = 0; + Sint64 dt_i1 = 0, dt_i2 = 0, dt_i3 = 0; + struct t_data *d = NULL; + MUTEX_LOCK(desc->q_mtx); if (desc->write_buffered > 0) { - result = async_write(desc, errp, 0, 0); - } else { - result = 0; + if ((d = async_write(desc, errp, 0, 0, + &dt_i1, &dt_i2, &dt_i3)) == NULL) { + result = -1; + } } MUTEX_UNLOCK(desc->q_mtx); +#ifdef HAVE_DTRACE + if (d != NULL) { + d->sched_i1 = dt_priv->thread_num; + d->sched_i2 = dt_priv->tag; + d->sched_utag[0] = '\0'; + if (dt_utag != NULL) { + if (dt_utag[0] == '\0') { + dt_utag = NULL; + } else { + strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1); + d->sched_utag[sizeof(d->sched_utag) - 1] = '\0'; + } + } + DTRACE10(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++, + dt_utag, FILE_WRITE, + NULL, NULL, dt_i1, dt_i2, dt_i3, 0); + } +#endif /* HAVE_DTRACE */ return result; } @@ -1813,9 +1960,10 @@ static int check_write_error(file_descriptor *desc, int *errp) { return 0; } -static int flush_write_check_error(file_descriptor *desc, int *errp) { +static int flush_write_check_error(file_descriptor *desc, int *errp, + dt_private *dt_priv, char *dt_utag) { int r; - if ( (r = flush_write(desc, errp)) != 0) { + if ( (r = flush_write(desc, errp, dt_priv, dt_utag)) != 0) { check_write_error(desc, NULL); return r; } else { @@ -1823,12 +1971,13 @@ static int flush_write_check_error(file_descriptor *desc, int *errp) { } } -static int async_lseek(file_descriptor *desc, int *errp, int reply, - Sint64 offset, int origin) { +static struct t_data *async_lseek(file_descriptor *desc, int *errp, int reply, + Sint64 offset, int origin, + Sint64 *dt_i1, Sint64 *dt_i2, Sint64 *dt_i3) { struct t_data *d; if (! (d = EF_ALLOC(sizeof(struct t_data)))) { *errp = ENOMEM; - return -1; + return NULL; } d->flags = desc->flags; d->fd = desc->fd; @@ -1836,11 +1985,16 @@ static int async_lseek(file_descriptor *desc, int *errp, int reply, d->reply = reply; d->c.lseek.offset = offset; d->c.lseek.origin = origin; + if (dt_i1 != NULL) { + *dt_i1 = d->fd; + *dt_i2 = d->c.lseek.offset; + *dt_i3 = d->c.lseek.origin; + } d->invoke = invoke_lseek; d->free = free_data; d->level = 1; cq_enq(desc, d); - return 0; + return d; } static void flush_read(file_descriptor *desc) { @@ -1852,18 +2006,37 @@ static void flush_read(file_descriptor *desc) { } } -static int lseek_flush_read(file_descriptor *desc, int *errp) { +static int lseek_flush_read(file_descriptor *desc, int *errp, + dt_private *dt_priv, char *dt_utag) { int r = 0; size_t read_size = desc->read_size; + Sint64 dt_i1 = 0, dt_i2 = 0, dt_i3 = 0; + struct t_data *d; + + flush_read(desc); if (read_size != 0) { - flush_read(desc); - if ((r = async_lseek(desc, errp, 0, - -((ssize_t)read_size), EFILE_SEEK_CUR)) - < 0) { - return r; - } - } else { - flush_read(desc); + if ((d = async_lseek(desc, errp, 0, + -((ssize_t)read_size), EFILE_SEEK_CUR, + &dt_i1, &dt_i2, &dt_i3)) == NULL) { + r = -1; + } else { +#ifdef HAVE_DTRACE + d->sched_i1 = dt_priv->thread_num; + d->sched_i2 = dt_priv->tag; + d->sched_utag[0] = '\0'; + if (dt_utag != NULL) { + if (dt_utag[0] == '\0') { + dt_utag = NULL; + } else { + strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1); + d->sched_utag[sizeof(d->sched_utag) - 1] = '\0'; + } + } + DTRACE10(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++, + dt_utag, FILE_LSEEK, + NULL, NULL, dt_i1, dt_i2, dt_i3, 0); +#endif /* HAVE_DTRACE */ + } } return r; } @@ -1880,11 +2053,24 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) struct t_data *d = (struct t_data *) data; char header[5]; /* result code + count */ char resbuf[RESBUFSIZE]; /* Result buffer. */ - +#ifdef HAVE_DTRACE + dt_private *dt_priv = get_dt_private(0); + int sched_i1 = d->sched_i1, sched_i2 = d->sched_i2, command = d->command, + result_ok = d->result_ok, + posix_errno = d->result_ok ? 0 : d->errInfo.posix_errno; + char sched_utag[128+1]; + + sched_utag[0] = '\0'; + if (DTRACE_ENABLED(efile_drv_return)) { + strncpy(sched_utag, d->sched_utag, sizeof(sched_utag) - 1); + sched_utag[sizeof(sched_utag) - 1] = '\0'; + } +#endif /* HAVE_DTRACE */ TRACE_C('r'); if (try_again(desc, d)) { + /* SLF TODO: what to do here? */ return; } @@ -2087,6 +2273,9 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) if (d->reply) { TRACE_C('K'); reply_ok(desc); +#ifdef HAVE_DTRACE + result_ok = 1; +#endif } free_data(data); break; @@ -2119,6 +2308,8 @@ file_async_ready(ErlDrvData e, ErlDrvThreadData data) default: abort(); } + DTRACE7(efile_drv_return, sched_i1, sched_i2, sched_utag, + command, result_ok, posix_errno, dt_priv->thread_num); if (desc->write_buffered != 0 && desc->timer_state == timer_idle) { desc->timer_state = timer_write; driver_set_timer(desc->port, desc->write_delay); @@ -2140,7 +2331,11 @@ file_output(ErlDrvData e, char* buf, int count) char* name; /* Points to the filename in buf. */ int command; struct t_data *d = NULL; - + char *dt_utag = NULL, *dt_s1 = NULL, *dt_s2 = NULL; + Sint64 dt_i1 = 0, dt_i2 = 0, dt_i3 = 0, dt_i4 = 0; +#ifdef HAVE_DTRACE + dt_private *dt_priv = get_dt_private(0); +#endif /* HAVE_DTRACE */ TRACE_C('o'); @@ -2155,6 +2350,8 @@ file_output(ErlDrvData e, char* buf, int count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->command = command; d->invoke = invoke_mkdir; d->free = free_data; @@ -2166,6 +2363,8 @@ file_output(ErlDrvData e, char* buf, int count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->command = command; d->invoke = invoke_rmdir; d->free = free_data; @@ -2177,6 +2376,8 @@ file_output(ErlDrvData e, char* buf, int count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->command = command; d->invoke = invoke_delete_file; d->free = free_data; @@ -2193,7 +2394,10 @@ file_output(ErlDrvData e, char* buf, int count) + FILENAME_BYTELEN(new_name) + FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; FILENAME_COPY(d->b + namelen, new_name); + dt_s2 = d->b + namelen; + dt_utag = buf + namelen + strlen(dt_s2) + 1; d->flags = desc->flags; d->fd = fd; d->command = command; @@ -2207,6 +2411,8 @@ file_output(ErlDrvData e, char* buf, int count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(name) + FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->command = command; d->invoke = invoke_chdir; d->free = free_data; @@ -2218,6 +2424,7 @@ file_output(ErlDrvData e, char* buf, int count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + RESBUFSIZE + 1); d->drive = *(uchar*)buf; + dt_utag = buf + 1; d->command = command; d->invoke = invoke_pwd; d->free = free_data; @@ -2233,6 +2440,8 @@ file_output(ErlDrvData e, char* buf, int count) FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->dir_handle = NULL; d->command = command; d->invoke = invoke_readdir; @@ -2253,6 +2462,8 @@ file_output(ErlDrvData e, char* buf, int count) dir_handle = NULL; resbuf[0] = FILE_RESP_FNAME; resbufsize = RESBUFSIZE; + dt_s1 = name; + dt_utag = name + strlen(dt_s1) + 1; while (efile_readdir(&errInfo, name, &dir_handle, resbuf+1, &resbufsize)) { @@ -2263,6 +2474,10 @@ file_output(ErlDrvData e, char* buf, int count) reply_error(desc, &errInfo); return; } +#ifdef HAVE_DTRACE + DTRACE10(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++, + dt_utag, command, name, dt_s2, dt_i1, dt_i2, dt_i3, dt_i4); +#endif TRACE_C('R'); driver_output2(desc->port, resbuf, 1, NULL, 0); return; @@ -2273,8 +2488,11 @@ file_output(ErlDrvData e, char* buf, int count) FILENAME_CHARSIZE); d->flags = get_int32((uchar*)buf); + dt_i1 = d->flags; name = buf+4; FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->command = command; d->invoke = invoke_open; d->free = free_data; @@ -2286,7 +2504,9 @@ file_output(ErlDrvData e, char* buf, int count) { d = EF_SAFE_ALLOC(sizeof(struct t_data)); + dt_utag = name; d->fd = fd; + dt_i1 = fd; d->command = command; d->invoke = invoke_fdatasync; d->free = free_data; @@ -2298,7 +2518,9 @@ file_output(ErlDrvData e, char* buf, int count) { d = EF_SAFE_ALLOC(sizeof(struct t_data)); + dt_utag = name; d->fd = fd; + dt_i1 = fd; d->command = command; d->invoke = invoke_fsync; d->free = free_data; @@ -2314,7 +2536,13 @@ file_output(ErlDrvData e, char* buf, int count) FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_utag = name + strlen(d->b) + 1; d->fd = fd; + if (command == FILE_LSTAT) { + dt_s1 = d->b; + } else { + dt_i1 = fd; + } d->command = command; d->invoke = invoke_flstat; d->free = free_data; @@ -2326,8 +2554,11 @@ file_output(ErlDrvData e, char* buf, int count) { d = EF_SAFE_ALLOC(sizeof(struct t_data)); + dt_utag = name; d->flags = desc->flags; d->fd = fd; + dt_i1 = fd; + dt_i2 = d->flags; d->command = command; d->invoke = invoke_truncate; d->free = free_data; @@ -2341,12 +2572,17 @@ file_output(ErlDrvData e, char* buf, int count) + FILENAME_BYTELEN(buf+21*4) + FILENAME_CHARSIZE); d->info.mode = get_int32(buf + 0 * 4); + dt_i1 = d->info.mode; d->info.uid = get_int32(buf + 1 * 4); + dt_i2 = d->info.uid; d->info.gid = get_int32(buf + 2 * 4); + dt_i3 = d->info.gid; GET_TIME(d->info.accessTime, buf + 3 * 4); GET_TIME(d->info.modifyTime, buf + 9 * 4); GET_TIME(d->info.cTime, buf + 15 * 4); FILENAME_COPY(d->b, buf+21*4); + dt_s1 = d->b; + dt_utag = buf + 21 * 4 + strlen(d->b) + 1; d->command = command; d->invoke = invoke_write_info; d->free = free_data; @@ -2359,6 +2595,8 @@ file_output(ErlDrvData e, char* buf, int count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + RESBUFSIZE + 1); FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->command = command; d->invoke = invoke_readlink; d->free = free_data; @@ -2370,6 +2608,8 @@ file_output(ErlDrvData e, char* buf, int count) { d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + RESBUFSIZE + 1); FILENAME_COPY(d->b, name); + dt_s1 = d->b; + dt_utag = name + strlen(d->b) + 1; d->command = command; d->invoke = invoke_altname; d->free = free_data; @@ -2389,7 +2629,10 @@ file_output(ErlDrvData e, char* buf, int count) + FILENAME_BYTELEN(new_name) + FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; FILENAME_COPY(d->b + namelen, new_name); + dt_s2 = d->b + namelen; + dt_utag = buf + namelen + strlen(dt_s2) + 1; d->flags = desc->flags; d->fd = fd; d->command = command; @@ -2410,7 +2653,10 @@ file_output(ErlDrvData e, char* buf, int count) + FILENAME_BYTELEN(new_name) + FILENAME_CHARSIZE); FILENAME_COPY(d->b, name); + dt_s1 = d->b; FILENAME_COPY(d->b + namelen, new_name); + dt_s2 = d->b + namelen; + dt_utag = buf + namelen + strlen(dt_s2) + 1; d->flags = desc->flags; d->fd = fd; d->command = command; @@ -2425,13 +2671,18 @@ file_output(ErlDrvData e, char* buf, int count) d = EF_SAFE_ALLOC(sizeof(struct t_data)); d->fd = fd; + dt_i1 = d->fd; d->command = command; d->invoke = invoke_fadvise; d->free = free_data; d->level = 2; d->c.fadvise.offset = get_int64((uchar*) buf); + dt_i2 = d->c.fadvise.offset; d->c.fadvise.length = get_int64(((uchar*) buf) + sizeof(Sint64)); + dt_i3 = d->c.fadvise.length; d->c.fadvise.advise = get_int32(((uchar*) buf) + 2 * sizeof(Sint64)); + dt_i4 = d->c.fadvise.advise; + dt_utag = buf + 3 * sizeof(Sint64); goto done; } @@ -2445,6 +2696,21 @@ file_output(ErlDrvData e, char* buf, int count) done: if (d) { +#ifdef HAVE_DTRACE + d->sched_i1 = dt_priv->thread_num; + d->sched_i2 = dt_priv->tag; + d->sched_utag[0] = '\0'; + if (dt_utag != NULL) { + if (dt_utag[0] == '\0') { + dt_utag = NULL; + } else { + strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1); + d->sched_utag[sizeof(d->sched_utag) - 1] = '\0'; + } + } + DTRACE10(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++, + dt_utag, command, dt_s1, dt_s2, dt_i1, dt_i2, dt_i3, dt_i4); +#endif cq_enq(desc, d); } } @@ -2456,10 +2722,15 @@ static void file_flush(ErlDrvData e) { file_descriptor *desc = (file_descriptor *)e; int r; +#ifdef HAVE_DTRACE + dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base); +#else + dt_private *dt_priv = NULL; +#endif TRACE_C('f'); - r = flush_write(desc, NULL); + r = flush_write(desc, NULL, dt_priv, desc->d->sched_utag); /* Only possible reason for bad return value is ENOMEM, and * there is nobody to tell... */ @@ -2493,6 +2764,11 @@ static void file_timeout(ErlDrvData e) { file_descriptor *desc = (file_descriptor *)e; enum e_timer timer_state = desc->timer_state; +#ifdef HAVE_DTRACE + dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base); +#else + dt_private *dt_priv = NULL; +#endif TRACE_C('t'); @@ -2507,7 +2783,7 @@ file_timeout(ErlDrvData e) { driver_async(desc->port, KEY(desc), desc->invoke, desc->d, desc->free); break; case timer_write: { - int r = flush_write(desc, NULL); + int r = flush_write(desc, NULL, dt_priv, desc->d->sched_utag); /* Only possible reason for bad return value is ENOMEM, and * there is nobody to tell... */ @@ -2529,7 +2805,14 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { char command; int p, q; int err; - + struct t_data *d = NULL; + Sint64 dt_i1 = 0, dt_i2 = 0, dt_i3 = 0, dt_i4 = 0; + char *dt_utag = NULL, *dt_s1 = NULL; +#ifdef HAVE_DTRACE + dt_private *dt_priv = get_dt_private(dt_driver_io_worker_base); +#else + dt_private *dt_priv = NULL; +#endif TRACE_C('v'); p = 0; q = 1; @@ -2548,25 +2831,22 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { switch (command) { case FILE_CLOSE: { + dt_utag = EV_CHAR_P(ev, p, q); flush_read(desc); - if (flush_write_check_error(desc, &err) < 0) { + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } - if (ev->size != 1) { - /* Wrong command length */ - reply_posix_error(desc, EINVAL); - goto done; - } if (desc->fd != FILE_FD_INVALID) { - struct t_data *d; if (! (d = EF_ALLOC(sizeof(struct t_data)))) { reply_posix_error(desc, ENOMEM); } else { d->command = command; d->reply = !0; d->fd = desc->fd; + dt_i1 = d->fd; d->flags = desc->flags; + dt_i2 = d->flags; d->invoke = invoke_close; d->free = free_data; d->level = 2; @@ -2582,8 +2862,15 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { case FILE_READ: { Uint32 sizeH, sizeL; size_t size, alloc_size; - struct t_data *d; - if (flush_write_check_error(desc, &err) < 0) { + + if (!EV_GET_UINT32(ev, &sizeH, &p, &q) + || !EV_GET_UINT32(ev, &sizeL, &p, &q)) { + /* Wrong buffer length to contain the read count */ + reply_posix_error(desc, EINVAL); + goto done; + } + dt_utag = EV_CHAR_P(ev, p, q); + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } @@ -2591,19 +2878,12 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { if (desc->read_bufsize == 0 && desc->read_binp != NULL && desc->read_size > 0) { /* We have allocated a buffer for line mode but should not really have a read-ahead buffer... */ - if (lseek_flush_read(desc, &err) < 0) { + if (lseek_flush_read(desc, &err, dt_priv) < 0) { reply_posix_error(desc, err); goto done; } } #endif - if (ev->size != 1+8 - || !EV_GET_UINT32(ev, &sizeH, &p, &q) - || !EV_GET_UINT32(ev, &sizeL, &p, &q)) { - /* Wrong buffer length to contain the read count */ - reply_posix_error(desc, EINVAL); - goto done; - } #if SIZEOF_SIZE_T == 4 if (sizeH != 0) { reply_posix_error(desc, EINVAL); @@ -2674,11 +2954,14 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->command = command; d->reply = !0; d->fd = desc->fd; + dt_i1 = d->fd; d->flags = desc->flags; + dt_i2 = d->flags; d->c.read.binp = desc->read_binp; d->c.read.bin_offset = desc->read_offset + desc->read_size; d->c.read.bin_size = desc->read_binp->orig_size - d->c.read.bin_offset; d->c.read.size = size; + dt_i3 = d->c.read.size; driver_binary_inc_refc(d->c.read.binp); d->invoke = invoke_read; d->free = free_read; @@ -2696,12 +2979,12 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { * allocated binary + dealing with offsets and lengts are done in file_async ready * for this OP. */ - struct t_data *d; - if (flush_write_check_error(desc, &err) < 0) { + dt_utag = EV_CHAR_P(ev, p, q); + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } - if (ev->size != 1) { + if (ev->size != 1+strlen(dt_utag)+1) { /* Wrong command length */ reply_posix_error(desc, EINVAL); goto done; @@ -2753,13 +3036,17 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->command = command; d->reply = !0; d->fd = desc->fd; + dt_i1 = d->fd; d->flags = desc->flags; + dt_i2 = d->flags; d->c.read_line.binp = desc->read_binp; d->c.read_line.read_offset = desc->read_offset; d->c.read_line.read_size = desc->read_size; + dt_i3 = d->c.read_line.read_offset; #if !ALWAYS_READ_LINE_AHEAD d->c.read_line.read_ahead = (desc->read_bufsize > 0); #endif + dt_i4 = d->c.read_line.read_ahead; driver_binary_inc_refc(d->c.read.binp); d->invoke = invoke_read_line; d->free = free_read_line; @@ -2768,8 +3055,22 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { } goto done; case FILE_WRITE: { int skip = 1; - int size = ev->size - skip; - if (lseek_flush_read(desc, &err) < 0) { + int size; + + dt_utag = EV_CHAR_P(ev, p, q); + skip += strlen(dt_utag) + 1; + size = ev->size - skip; + /* + ** SLF: Interesting dependency on using port # for key to async + ** I/O worker pool thread: lseek_flush_read() can enqueue a + ** lseek() op. If that lseek() were scheduled on a different + ** thread than the write that we'll enqueue later in this case, + ** then Bad Things could happen. This DTrace work is probably + ** well worthwhile to get a sense of how often there's head-of- + ** line blocking/unfairness during busy file I/O because of the + ** mapping of port #/key -> thread. + */ + if (lseek_flush_read(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } @@ -2796,7 +3097,8 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { driver_set_timer(desc->port, desc->write_delay); } } else { - if (async_write(desc, &err, !0, size) != 0) { + if ((d = async_write(desc, &err, !0, size, + &dt_i1, &dt_i2, &dt_i3)) == NULL) { MUTEX_UNLOCK(desc->q_mtx); reply_posix_error(desc, err); goto done; @@ -2809,19 +3111,25 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { case FILE_PWRITEV: { Uint32 i, j, n; size_t total; - struct t_data *d; - if (lseek_flush_read(desc, &err) < 0) { - reply_Uint_posix_error(desc, 0, err); + char tmp; + int dt_utag_bytes = 1; + + dt_utag = EV_CHAR_P(ev, p, q); + while (EV_GET_CHAR(ev, &tmp, &p, &q) && tmp != '\0') { + dt_utag_bytes++; + } + if (ev->size < 1+4+dt_utag_bytes + || !EV_GET_UINT32(ev, &n, &p, &q)) { + /* Buffer too short to contain even the number of pos/size specs */ + reply_Uint_posix_error(desc, 0, EINVAL); goto done; } - if (flush_write_check_error(desc, &err) < 0) { + if (lseek_flush_read(desc, &err, dt_priv, dt_utag) < 0) { reply_Uint_posix_error(desc, 0, err); goto done; } - if (ev->size < 1+4 - || !EV_GET_UINT32(ev, &n, &p, &q)) { - /* Buffer too short to contain even the number of pos/size specs */ - reply_Uint_posix_error(desc, 0, EINVAL); + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { + reply_Uint_posix_error(desc, 0, err); goto done; } if (n == 0) { @@ -2833,7 +3141,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { } goto done; } - if (ev->size < 1+4+8*(2*n)) { + if (ev->size < 1+4+8*(2*n)+dt_utag_bytes) { /* Buffer too short to contain even the pos/size specs */ reply_Uint_posix_error(desc, 0, EINVAL); goto done; @@ -2847,7 +3155,9 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->command = command; d->reply = !0; d->fd = desc->fd; + dt_i1 = d->fd; d->flags = desc->flags; + dt_i2 = d->flags; d->c.pwritev.port = desc->port; d->c.pwritev.q_mtx = desc->q_mtx; d->c.pwritev.n = n; @@ -2885,13 +3195,14 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { } } d->c.pwritev.size = total; + dt_i3 = d->c.pwritev.size; d->c.pwritev.free_size = 0; if (j == 0) { /* Trivial case - nothing to write */ EF_FREE(d); reply_Uint(desc, 0); } else { - size_t skip = 1 + 4 + 8*(2*n); + size_t skip = 1 + 4 + 8*(2*n) + dt_utag_bytes; if (skip + total != ev->size) { /* Actual amount of data does not match * total of all pos/size specs @@ -2915,24 +3226,30 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { case FILE_PREADV: { register void * void_ptr; Uint32 i, n; - struct t_data *d; ErlIOVec *res_ev; - if (lseek_flush_read(desc, &err) < 0) { + char tmp; + int dt_utag_bytes = 1; + + dt_utag = EV_CHAR_P(ev, p, q); + while (EV_GET_CHAR(ev, &tmp, &p, &q) && tmp != '\0') { + dt_utag_bytes++; + } + if (lseek_flush_read(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } - if (flush_write_check_error(desc, &err) < 0) { + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } - if (ev->size < 1+8 + if (ev->size < 1+8+dt_utag_bytes || !EV_GET_UINT32(ev, &n, &p, &q) || !EV_GET_UINT32(ev, &n, &p, &q)) { /* Buffer too short to contain even the number of pos/size specs */ reply_posix_error(desc, EINVAL); goto done; } - if (ev->size != 1+8+8*(2*n)) { + if (ev->size < 1+8+8*(2*n)+dt_utag_bytes) { /* Buffer wrong length to contain the pos/size specs */ reply_posix_error(desc, EINVAL); goto done; @@ -2951,7 +3268,9 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->command = command; d->reply = !0; d->fd = desc->fd; + dt_i1 = d->fd; d->flags = desc->flags; + dt_i2 = d->flags; d->c.preadv.n = n; d->c.preadv.cnt = 0; d->c.preadv.size = 0; @@ -2979,6 +3298,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { #else size = ((size_t)sizeH<<32) | sizeL; #endif + dt_i3 += size; if (! (res_ev->binv[i] = driver_alloc_binary(size))) { reply_posix_error(desc, ENOMEM); break; @@ -3027,29 +3347,31 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { case FILE_LSEEK: { Sint64 offset; /* Offset for seek */ Uint32 origin; /* Origin of seek. */ - if (lseek_flush_read(desc, &err) < 0) { - reply_posix_error(desc, err); + + if (ev->size < 1+8+4 + || !EV_GET_UINT64(ev, &offset, &p, &q) + || !EV_GET_UINT32(ev, &origin, &p, &q)) { + /* Wrong length of buffer to contain offset and origin */ + reply_posix_error(desc, EINVAL); goto done; } - if (flush_write_check_error(desc, &err) < 0) { + dt_utag = EV_CHAR_P(ev, p, q); + if (lseek_flush_read(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } - if (ev->size != 1+8+4 - || !EV_GET_UINT64(ev, &offset, &p, &q) - || !EV_GET_UINT32(ev, &origin, &p, &q)) { - /* Wrong length of buffer to contain offset and origin */ - reply_posix_error(desc, EINVAL); + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { + reply_posix_error(desc, err); goto done; } - if (async_lseek(desc, &err, !0, offset, origin) < 0) { + if ((d = async_lseek(desc, &err, !0, offset, origin, + &dt_i1, &dt_i2, &dt_i3)) == NULL) { reply_posix_error(desc, err); goto done; } } goto done; case FILE_READ_FILE: { - struct t_data *d; char *filename; if (ev->size < 1+1) { /* Buffer contains empty name */ @@ -3071,6 +3393,8 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->reply = !0; /* Copy name */ FILENAME_COPY(d->b, filename); + dt_s1 = d->b; + dt_utag = filename + strlen(d->b) + 1; d->c.read_file.binp = NULL; d->invoke = invoke_read_file; d->free = free_read_file; @@ -3090,7 +3414,6 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { char mode; Sint64 hdr_offset; Uint32 max_size; - struct t_data *d; ErlIOVec *res_ev; int vsize; if (! EV_GET_CHAR(ev, &mode, &p, &q)) { @@ -3102,14 +3425,6 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { reply_posix_error(desc, EINVAL); goto done; } - if (lseek_flush_read(desc, &err) < 0) { - reply_posix_error(desc, err); - goto done; - } - if (flush_write_check_error(desc, &err) < 0) { - reply_posix_error(desc, err); - goto done; - } if (ev->size < 1+1+8+4 || !EV_GET_UINT64(ev, &hdr_offset, &p, &q) || !EV_GET_UINT32(ev, &max_size, &p, &q)) { @@ -3118,6 +3433,15 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { reply_posix_error(desc, EINVAL); goto done; } + dt_utag = EV_CHAR_P(ev, p, q); + if (lseek_flush_read(desc, &err, dt_priv, dt_utag) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { + reply_posix_error(desc, err); + goto done; + } /* Create the thread data structure with the contained ErlIOVec * and corresponding binaries for the response */ @@ -3131,9 +3455,13 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { d->command = command; d->reply = !0; d->fd = desc->fd; + dt_i1 = d->fd; d->flags = desc->flags; + dt_i2 = d->flags; d->c.preadv.offsets[0] = hdr_offset; + dt_i3 = d->c.preadv.offsets[0]; d->c.preadv.size = max_size; + dt_i4 = d->c.preadv.size; res_ev = &d->c.preadv.eiov; /* XXX possible alignment problems here for weird machines */ res_ev->iov = void_ptr = d + 1; @@ -3148,16 +3476,19 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { case FILE_SETOPT: { char opt; + if (ev->size < 1+1 || !EV_GET_CHAR(ev, &opt, &p, &q)) { /* Buffer too short to contain even the option type */ reply_posix_error(desc, EINVAL); goto done; } + dt_i1 = opt; + dt_utag = EV_CHAR_P(ev, p, q); switch (opt) { case FILE_OPT_DELAYED_WRITE: { Uint32 sizeH, sizeL, delayH, delayL; - if (ev->size != 1+1+4*sizeof(Uint32) + if (ev->size != 1+1+4*sizeof(Uint32)+strlen(dt_utag)+1 || !EV_GET_UINT32(ev, &sizeH, &p, &q) || !EV_GET_UINT32(ev, &sizeL, &p, &q) || !EV_GET_UINT32(ev, &delayH, &p, &q) @@ -3184,12 +3515,13 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { #else desc->write_delay = ((unsigned long)delayH << 32) | delayL; #endif + dt_i2 = desc->write_delay; TRACE_C('K'); reply_ok(desc); } goto done; case FILE_OPT_READ_AHEAD: { Uint32 sizeH, sizeL; - if (ev->size != 1+1+2*sizeof(Uint32) + if (ev->size != 1+1+2*sizeof(Uint32)+strlen(dt_utag)+1 || !EV_GET_UINT32(ev, &sizeH, &p, &q) || !EV_GET_UINT32(ev, &sizeL, &p, &q)) { /* Buffer has wrong length to contain the option values */ @@ -3205,6 +3537,7 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { #else desc->read_bufsize = ((size_t)sizeH << 32) | sizeL; #endif + dt_i2 = desc->read_bufsize; TRACE_C('K'); reply_ok(desc); } goto done; @@ -3216,11 +3549,11 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { } /* switch(command) */ - if (lseek_flush_read(desc, &err) < 0) { + if (lseek_flush_read(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } - if (flush_write_check_error(desc, &err) < 0) { + if (flush_write_check_error(desc, &err, dt_priv, dt_utag) < 0) { reply_posix_error(desc, err); goto done; } else { @@ -3238,5 +3571,45 @@ file_outputv(ErlDrvData e, ErlIOVec *ev) { } done: + if (d != NULL) { +#ifdef HAVE_DTRACE + /* + ** If d == NULL, then either: + ** 1). There was an error of some sort, or + ** 2). The command given to us is actually implemented + ** by file_output() instead. + ** + ** Case #1 is probably a TODO item, perhaps? + ** Case #2 we definitely don't want to activate a probe. + */ + d->sched_i1 = dt_priv->thread_num; + d->sched_i2 = dt_priv->tag; + d->sched_utag[0] = '\0'; + if (dt_utag != NULL) { + strncpy(d->sched_utag, dt_utag, sizeof(d->sched_utag) - 1); + d->sched_utag[sizeof(d->sched_utag) - 1] = '\0'; + } + DTRACE10(efile_drv_entry, dt_priv->thread_num, dt_priv->tag++, + dt_utag, command, dt_s1, NULL, dt_i1, dt_i2, dt_i3, dt_i4); +#endif + } cq_execute(desc); } + +#ifdef HAVE_DTRACE +dt_private * +get_dt_private(int base) +{ + dt_private *dt_priv = (dt_private *) pthread_getspecific(dt_driver_key); + + if (dt_priv == NULL) { + dt_priv = EF_SAFE_ALLOC(sizeof(dt_private)); + erts_mtx_lock(&dt_driver_mutex); + dt_priv->thread_num = (base + dt_driver_idnum++); + erts_mtx_unlock(&dt_driver_mutex); + dt_priv->tag = 0; + pthread_setspecific(dt_driver_key, dt_priv); + } + return dt_priv; +} +#endif /* HAVE_DTRACE */ diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c index 108a8bb..a320aac 100644 --- a/erts/lib_src/common/erl_printf.c +++ b/erts/lib_src/common/erl_printf.c @@ -176,16 +176,18 @@ write_sn(void *vwsnap, char* buf, size_t len) write_sn_arg_t *wsnap = (write_sn_arg_t *) vwsnap; ASSERT(wsnap); ASSERT(len > 0); + int rv = 0; if (wsnap->len > 0) { size_t sz = len; if (sz >= wsnap->len) sz = wsnap->len; + rv = (int)sz; memcpy((void *) wsnap->buf, (void *) buf, sz); wsnap->buf += sz; wsnap->len -= sz; return sz; } - return 0; + return rv; } static int diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam index 00a1cf0..80a930d 100644 Binary files a/erts/preloaded/ebin/prim_file.beam and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index fd2d4a1..158bdb0 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -25,12 +25,17 @@ %%% Interface towards a single file's contents. Uses ?FD_DRV. %% Generic file contents operations --export([open/2, close/1, datasync/1, sync/1, advise/4, position/2, truncate/1, - write/2, pwrite/2, pwrite/3, read/2, read_line/1, pread/2, pread/3, copy/3]). +-export([open/2, open/3, close/1, close/2, + datasync/1, datasync/2, sync/1, sync/2, + advise/4, advise/5, + position/2, position/3, truncate/1, truncate/2, + write/2, write/3, pwrite/2, pwrite/3, pwrite/4, + read/2, read/3, read_line/1, read_line/2, + pread/2, pread/3, pread/4, copy/3, copy/4]). %% Specialized file operations --export([open/1, open/3]). --export([read_file/1, read_file/2, write_file/2]). +-export([open/1]). +-export([read_file/1, read_file/2, read_file/3, write_file/2, write_file/3]). -export([ipread_s32bu_p32bu/3]). @@ -38,25 +43,28 @@ %%% Interface towards file system and metadata. Uses ?DRV. %% Takes an optional port (opens a ?DRV port per default) as first argument. --export([get_cwd/0, get_cwd/1, get_cwd/2, - set_cwd/1, set_cwd/2, - delete/1, delete/2, - rename/2, rename/3, - make_dir/1, make_dir/2, - del_dir/1, del_dir/2, - read_file_info/1, read_file_info/2, - altname/1, altname/2, - write_file_info/2, write_file_info/3, - make_link/2, make_link/3, - make_symlink/2, make_symlink/3, - read_link/1, read_link/2, - read_link_info/1, read_link_info/2, - list_dir/1, list_dir/2]). +-export([get_cwd/0, get_cwd/1, get_cwd/3, + set_cwd/1, set_cwd/3, + delete/1, delete/2, delete/3, + rename/2, rename/3, rename/4, + make_dir/1, make_dir/3, + del_dir/1, del_dir/3, + read_file_info/1, read_file_info/2, read_file_info/3, + altname/1, altname/3, + write_file_info/2, write_file_info/4, + make_link/2, make_link/3, make_link/4, + make_symlink/2, make_symlink/3, make_symlink/4, + read_link/1, read_link/3, + read_link_info/1, read_link_info/3, + list_dir/1, list_dir/3]). %% How to start and stop the ?DRV port. -export([start/0, stop/1]). %% Debug exports --export([open_int/4, open_mode/1, open_mode/4]). +-export([open_int/4, open_int/5, open_mode/1, open_mode/4]). + +%% For DTrace/Systemtap tracing +-export([get_dtrace_utag/0]). %%%----------------------------------------------------------------- %%% Includes and defines @@ -152,30 +160,21 @@ %%% Supposed to be called by applications through module file. -%% Opens a file using the driver port Port. Returns {error, Reason} -%% | {ok, FileDescriptor} -open(Port, File, ModeList) when is_port(Port), - (is_list(File) orelse is_binary(File)), - is_list(ModeList) -> - case open_mode(ModeList) of - {Mode, _Portopts, _Setopts} -> - open_int(Port, File, Mode, []); - Reason -> - {error, Reason} - end; -open(_,_,_) -> - {error, badarg}. - %% Opens a file. Returns {error, Reason} | {ok, FileDescriptor}. -open(File, ModeList) when (is_list(File) orelse is_binary(File)), - is_list(ModeList) -> +open(File, ModeList) -> + open(File, ModeList, get_dtrace_utag()). + +open(File, ModeList, DTraceUtag) + when (is_list(File) orelse is_binary(File)), + is_list(ModeList), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> case open_mode(ModeList) of {Mode, Portopts, Setopts} -> - open_int({?FD_DRV, Portopts},File, Mode, Setopts); + open_int({?FD_DRV, Portopts}, File, Mode, Setopts, DTraceUtag); Reason -> {error, Reason} end; -open(_, _) -> +open(_, _, _) -> {error, badarg}. %% Opens a port that can be used for open/3 or read_file/2. @@ -190,29 +189,34 @@ open(Portopts) when is_list(Portopts) -> open(_) -> {error, badarg}. -open_int({Driver, Portopts}, File, Mode, Setopts) -> +open_int(Arg, File, Mode, Setopts) -> + open_int(Arg, File, Mode, Setopts, get_dtrace_utag()). + +open_int({Driver, Portopts}, File, Mode, Setopts, DTraceUtag) -> + %% TODO: add DTraceUtag to drv_open()? case drv_open(Driver, Portopts) of {ok, Port} -> - open_int(Port, File, Mode, Setopts); + open_int(Port, File, Mode, Setopts, DTraceUtag); {error, _} = Error -> Error end; -open_int(Port, File, Mode, Setopts) -> +open_int(Port, File, Mode, Setopts, DTraceUtag) -> M = Mode band ?EFILE_MODE_MASK, - case drv_command(Port, [<>, pathname(File)]) of + case drv_command(Port, [<>, + pathname(File), enc_utag(DTraceUtag)]) of {ok, Number} -> - open_int_setopts(Port, Number, Setopts); + open_int_setopts(Port, Number, Setopts, DTraceUtag); Error -> drv_close(Port), Error end. -open_int_setopts(Port, Number, []) -> +open_int_setopts(Port, Number, [], _DTraceUtag) -> {ok, #file_descriptor{module = ?MODULE, data = {Port, Number}}}; -open_int_setopts(Port, Number, [Cmd | Tail]) -> - case drv_command(Port, Cmd) of +open_int_setopts(Port, Number, [Cmd | Tail], DTraceUtag) -> + case drv_command(Port, [Cmd, enc_utag(DTraceUtag)]) of ok -> - open_int_setopts(Port, Number, Tail); + open_int_setopts(Port, Number, Tail, DTraceUtag); Error -> drv_close(Port), Error @@ -222,50 +226,64 @@ open_int_setopts(Port, Number, [Cmd | Tail]) -> %% Returns ok. -close(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> - case drv_command(Port, <>) of +close(Arg) -> + close(Arg, get_dtrace_utag()). + +close(#file_descriptor{module = ?MODULE, data = {Port, _}}, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + case drv_command(Port, [<>, enc_utag(DTraceUtag)]) of ok -> drv_close(Port); Error -> Error end; %% Closes a port opened with open/1. -close(Port) when is_port(Port) -> +close(Port, _DTraceUtag) when is_port(Port) -> drv_close(Port). --define(ADVISE(Offs, Len, Adv), +-define(ADVISE(Offs, Len, Adv, BUtag), <>). + Adv:32/signed, BUtag/binary>>). %% Returns {error, Reason} | ok. +advise(FD, Offset, Length, Advise) -> + advise(FD, Offset, Length, Advise, get_dtrace_utag()). + advise(#file_descriptor{module = ?MODULE, data = {Port, _}}, - Offset, Length, Advise) -> + Offset, Length, Advise, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + BUtag = term_to_binary(enc_utag(DTraceUtag)), case Advise of normal -> - Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NORMAL), + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NORMAL, BUtag), drv_command(Port, Cmd); random -> - Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_RANDOM), + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_RANDOM, BUtag), drv_command(Port, Cmd); sequential -> - Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_SEQUENTIAL), + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_SEQUENTIAL, BUtag), drv_command(Port, Cmd); will_need -> - Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_WILLNEED), + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_WILLNEED, BUtag), drv_command(Port, Cmd); dont_need -> - Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_DONTNEED), + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_DONTNEED, BUtag), drv_command(Port, Cmd); no_reuse -> - Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NOREUSE), + Cmd = ?ADVISE(Offset, Length, ?POSIX_FADV_NOREUSE, BUtag), drv_command(Port, Cmd); _ -> {error, einval} end. %% Returns {error, Reason} | ok. -write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes) -> - case drv_command(Port, [?FILE_WRITE,Bytes]) of +write(Desc, Bytes) -> + write(Desc, Bytes, get_dtrace_utag()). + +write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + %% This is rare case where DTraceUtag is not at end of command list. + case drv_command(Port, [?FILE_WRITE,enc_utag(DTraceUtag),Bytes]) of {ok, _Size} -> ok; Error -> @@ -275,39 +293,40 @@ write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes) -> %% Returns ok | {error, {WrittenCount, Reason}} pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, L) when is_list(L) -> - pwrite_int(Port, L, 0, [], []). + pwrite_int(Port, L, 0, [], [], get_dtrace_utag()). -pwrite_int(_, [], 0, [], []) -> +pwrite_int(_, [], 0, [], [], _DTraceUtag) -> ok; -pwrite_int(Port, [], N, Spec, Data) -> - Header = list_to_binary([<> | reverse(Spec)]), +pwrite_int(Port, [], N, Spec, Data, DTraceUtag) -> + Header = list_to_binary([<>, enc_utag(DTraceUtag), + <>, reverse(Spec)]), case drv_command_raw(Port, [Header | reverse(Data)]) of {ok, _Size} -> ok; Error -> Error end; -pwrite_int(Port, [{Offs, Bytes} | T], N, Spec, Data) +pwrite_int(Port, [{Offs, Bytes} | T], N, Spec, Data, DTraceUtag) when is_integer(Offs) -> if -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE -> - pwrite_int(Port, T, N, Spec, Data, Offs, Bytes); + pwrite_int(Port, T, N, Spec, Data, Offs, Bytes, DTraceUtag); true -> {error, einval} end; -pwrite_int(_, [_|_], _N, _Spec, _Data) -> +pwrite_int(_, [_|_], _N, _Spec, _Data, _DTraceUtag) -> {error, badarg}. -pwrite_int(Port, T, N, Spec, Data, Offs, Bin) +pwrite_int(Port, T, N, Spec, Data, Offs, Bin, DTraceUtag) when is_binary(Bin) -> Size = byte_size(Bin), pwrite_int(Port, T, N+1, [<> | Spec], - [Bin | Data]); -pwrite_int(Port, T, N, Spec, Data, Offs, Bytes) -> + [Bin | Data], DTraceUtag); +pwrite_int(Port, T, N, Spec, Data, Offs, Bytes, DTraceUtag) -> try list_to_binary(Bytes) of Bin -> - pwrite_int(Port, T, N, Spec, Data, Offs, Bin) + pwrite_int(Port, T, N, Spec, Data, Offs, Bin, DTraceUtag) catch error:Reason -> {error, Reason} @@ -316,11 +335,28 @@ pwrite_int(Port, T, N, Spec, Data, Offs, Bytes) -> %% Returns {error, Reason} | ok. -pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Bytes) +pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, L, DTraceUtag) + when is_list(L), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + pwrite_int(Port, L, 0, [], [], DTraceUtag); + +pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Bytes) when is_integer(Offs) -> + pwrite_int2(Port, Offs, Bytes, get_dtrace_utag()); +pwrite(#file_descriptor{module = ?MODULE}, _, _) -> + {error, badarg}. + +pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Bytes, DTraceUtag) + when is_integer(Offs), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + pwrite_int2(Port, Offs, Bytes, DTraceUtag); +pwrite(#file_descriptor{module = ?MODULE}, _, _, _DTraceUtag) -> + {error, badarg}. + +pwrite_int2(Port, Offs, Bytes, DTraceUtag) -> if -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE -> - case pwrite_int(Port, [], 0, [], [], Offs, Bytes) of + case pwrite_int(Port, [], 0, [], [], Offs, Bytes, DTraceUtag) of {error, {_, Reason}} -> {error, Reason}; Result -> @@ -328,22 +364,30 @@ pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Bytes) end; true -> {error, einval} - end; -pwrite(#file_descriptor{module = ?MODULE}, _, _) -> - {error, badarg}. - + end. %% Returns {error, Reason} | ok. -datasync(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> - drv_command(Port, [?FILE_FDATASYNC]). +datasync(FD) -> + datasync(FD, get_dtrace_utag()). + +datasync(#file_descriptor{module = ?MODULE, data = {Port, _}}, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + drv_command(Port, [?FILE_FDATASYNC, enc_utag(DTraceUtag)]). %% Returns {error, Reason} | ok. -sync(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> - drv_command(Port, [?FILE_FSYNC]). +sync(FD) -> + sync(FD, get_dtrace_utag()). + +sync(#file_descriptor{module = ?MODULE, data = {Port, _}}, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + drv_command(Port, [?FILE_FSYNC, enc_utag(DTraceUtag)]). %% Returns {ok, Data} | eof | {error, Reason}. -read_line(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> - case drv_command(Port, <>) of +read_line(FD) -> + read_line(FD, get_dtrace_utag()). + +read_line(#file_descriptor{module = ?MODULE, data = {Port, _}}, DTraceUtag) -> + case drv_command(Port, [<>, enc_utag(DTraceUtag)]) of {ok, {0, _Data}} -> eof; {ok, {_Size, Data}} -> @@ -363,11 +407,17 @@ read_line(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> end. %% Returns {ok, Data} | eof | {error, Reason}. -read(#file_descriptor{module = ?MODULE, data = {Port, _}}, Size) - when is_integer(Size), 0 =< Size -> +read(FD, Size) -> + read(FD, Size, get_dtrace_utag()). + +read(#file_descriptor{module = ?MODULE, data = {Port, _}}, Size, DTraceUtag) + when is_integer(Size), + 0 =< Size, + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> if Size < ?LARGEFILESIZE -> - case drv_command(Port, <>) of + case drv_command(Port, [<>, + enc_utag(DTraceUtag)]) of {ok, {0, _Data}} when Size =/= 0 -> eof; {ok, {_Size, Data}} -> @@ -376,7 +426,8 @@ read(#file_descriptor{module = ?MODULE, data = {Port, _}}, Size) %% Garbage collecting here might help if %% the current processes have some old binaries left. erlang:garbage_collect(), - case drv_command(Port, <>) of + case drv_command(Port, [<>, + enc_utag(DTraceUtag)]) of {ok, {0, _Data}} when Size =/= 0 -> eof; {ok, {_Size, Data}} -> @@ -394,35 +445,43 @@ read(#file_descriptor{module = ?MODULE, data = {Port, _}}, Size) %% Returns {ok, [Data|eof, ...]} | {error, Reason} pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, L) when is_list(L) -> - pread_int(Port, L, 0, []). + pread_int(Port, L, 0, [], get_dtrace_utag()). -pread_int(_, [], 0, []) -> +pread_int(_, [], 0, [], _DTraceUtag) -> {ok, []}; -pread_int(Port, [], N, Spec) -> - drv_command(Port, [<> | reverse(Spec)]); -pread_int(Port, [{Offs, Size} | T], N, Spec) +pread_int(Port, [], N, Spec, DTraceUtag) -> + drv_command(Port, [<>, enc_utag(DTraceUtag), + <<0:32, N:32>>, reverse(Spec)]); +pread_int(Port, [{Offs, Size} | T], N, Spec, DTraceUtag) when is_integer(Offs), is_integer(Size), 0 =< Size -> if -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE, Size < ?LARGEFILESIZE -> - pread_int(Port, T, N+1, [<> | Spec]); + pread_int(Port, T, N+1, [<> | Spec], + DTraceUtag); true -> {error, einval} end; -pread_int(_, [_|_], _N, _Spec) -> +pread_int(_, [_|_], _N, _Spec, _DTraceUtag) -> {error, badarg}. - - %% Returns {ok, Data} | eof | {error, Reason}. -pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Size) +pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, L, DTraceUtag) + when is_list(L), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + pread_int(Port, L, 0, [], get_dtrace_utag()); +pread(FD, Offs, Size) when is_integer(Offs), is_integer(Size), 0 =< Size -> + pread(FD, Offs, Size, get_dtrace_utag()). + +pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Size, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> if -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE, Size < ?LARGEFILESIZE -> case drv_command(Port, - <>) of + [<>, enc_utag(DTraceUtag), + <<0:32, 1:32, Offs:64/signed, Size:64>>]) of {ok, [eof]} -> eof; {ok, [Data]} -> @@ -433,17 +492,22 @@ pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Size) true -> {error, einval} end; -pread(#file_descriptor{module = ?MODULE, data = {_, _}}, _, _) -> +pread(_, _, _, _) -> {error, badarg}. %% Returns {ok, Position} | {error, Reason}. -position(#file_descriptor{module = ?MODULE, data = {Port, _}}, At) -> +position(FD, At) -> + position(FD, At, get_dtrace_utag()). + +position(#file_descriptor{module = ?MODULE, data = {Port, _}}, At, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> case lseek_position(At) of {Offs, Whence} when -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE -> - drv_command(Port, <>); + drv_command(Port, [<>, + enc_utag(DTraceUtag)]); {_, _} -> {error, einval}; Reason -> @@ -451,63 +515,90 @@ position(#file_descriptor{module = ?MODULE, data = {Port, _}}, At) -> end. %% Returns {error, Reaseon} | ok. -truncate(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> - drv_command(Port, <>). +truncate(FD) -> + truncate(FD, get_dtrace_utag()). + +truncate(#file_descriptor{module = ?MODULE, data = {Port, _}}, DTraceUtag) + when (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + drv_command(Port, [<>, enc_utag(DTraceUtag)]). %% Returns {error, Reason} | {ok, BytesCopied} +copy(Source, Dest, Length) -> + copy(Source, Dest, Length, get_dtrace_utag()). + copy(#file_descriptor{module = ?MODULE} = Source, #file_descriptor{module = ?MODULE} = Dest, - Length) + Length, DTraceUtag) when is_integer(Length), Length >= 0; - is_atom(Length) -> + is_atom(Length), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> %% XXX Should be moved down to the driver for optimization. - file:copy_opened(Source, Dest, Length). +io:format(user, "YO line ~p: ~p -> ~p\n", [?LINE, Source, Dest]), + file:copy_opened(Source, Dest, Length, DTraceUtag). + +ipread_s32bu_p32bu(FD, Offs, Arg) -> + ipread_s32bu_p32bu(FD, Offs, Arg, get_dtrace_utag()). ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {_, _}} = Handle, Offs, - Infinity) when is_atom(Infinity) -> + Infinity, + DTraceUtag) + when is_atom(Infinity), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> ipread_s32bu_p32bu(Handle, Offs, (1 bsl 31)-1); ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, - MaxSize) - when is_integer(Offs), is_integer(MaxSize) -> + MaxSize, + DTraceUtag) + when is_integer(Offs), + is_integer(MaxSize), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> if -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE, 0 =< MaxSize, MaxSize < (1 bsl 31) -> - drv_command(Port, <>); + drv_command(Port, [<>, enc_utag(DTraceUtag)]); true -> {error, einval} end; ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {_, _}}, _Offs, - _MaxSize) -> + _MaxSize, + _DTraceUtag) -> {error, badarg}. %% Returns {ok, Contents} | {error, Reason} read_file(File) when (is_list(File) orelse is_binary(File)) -> + read_file(File, get_dtrace_utag()); +read_file(_) -> + {error, badarg}. + +read_file(File, DTraceUtag) + when (is_list(File) orelse is_binary(File)), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag))-> case drv_open(?FD_DRV, [binary]) of {ok, Port} -> - Result = read_file(Port, File), + Result = read_file(Port, File, DTraceUtag), close(Port), Result; {error, _} = Error -> Error end; -read_file(_) -> +read_file(_, _) -> {error, badarg}. %% Takes a Port opened with open/1. -read_file(Port, File) when is_port(Port), +read_file(Port, File, DTraceUtag) when is_port(Port), (is_list(File) orelse is_binary(File)) -> - Cmd = [?FILE_READ_FILE | pathname(File)], + Cmd = [?FILE_READ_FILE | + list_to_binary([pathname(File), enc_utag(DTraceUtag)])], case drv_command(Port, Cmd) of {error, enomem} -> %% It could possibly help to do a @@ -519,22 +610,30 @@ read_file(Port, File) when is_port(Port), Result -> Result end; -read_file(_,_) -> +read_file(_,_,_) -> {error, badarg}. %% Returns {error, Reason} | ok. -write_file(File, Bin) when (is_list(File) orelse is_binary(File)) -> +write_file(File, Bin) -> + write_file(File, Bin, get_dtrace_utag()). + +write_file(File, Bin, DTraceUtag) + when (is_list(File) orelse is_binary(File)), + (is_list(DTraceUtag) orelse is_binary(DTraceUtag)) -> + OldUtag = put(dtrace_utag, DTraceUtag), % TODO: API? case open(File, [binary, write]) of {ok, Handle} -> Result = write(Handle, Bin), close(Handle), + put(dtrace_utag, OldUtag), Result; Error -> + put(dtrace_utag, OldUtag), Error end; -write_file(_, _) -> +write_file(_, _, _) -> {error, badarg}. @@ -574,54 +673,56 @@ stop(Port) when is_port(Port) -> -%% get_cwd/{0,1,2} +%% get_cwd/{0,1,3} get_cwd() -> - get_cwd_int(0). + get_cwd_int(0, get_dtrace_utag()). get_cwd(Port) when is_port(Port) -> - get_cwd_int(Port, 0); + get_cwd_int(Port, 0, get_dtrace_utag()); get_cwd([]) -> - get_cwd_int(0); + get_cwd_int(0, get_dtrace_utag()); get_cwd([Letter, $: | _]) when $a =< Letter, Letter =< $z -> - get_cwd_int(Letter - $a + 1); + get_cwd_int(Letter - $a + 1, get_dtrace_utag()); get_cwd([Letter, $: | _]) when $A =< Letter, Letter =< $Z -> - get_cwd_int(Letter - $A + 1); + get_cwd_int(Letter - $A + 1, get_dtrace_utag()); get_cwd([_|_]) -> {error, einval}; get_cwd(_) -> {error, badarg}. -get_cwd(Port, []) when is_port(Port) -> - get_cwd_int(Port, 0); -get_cwd(Port, [Letter, $: | _]) +get_cwd(Port, [], DTraceUtag) when is_port(Port) -> + get_cwd_int(Port, 0, DTraceUtag); +get_cwd(Port, no_drive, DTraceUtag) when is_port(Port) -> + get_cwd_int(Port, 0, DTraceUtag); +get_cwd(Port, [Letter, $: | _], DTraceUtag) when is_port(Port), $a =< Letter, Letter =< $z -> - get_cwd_int(Port, Letter - $a + 1); -get_cwd(Port, [Letter, $: | _]) + get_cwd_int(Port, Letter - $a + 1, DTraceUtag); +get_cwd(Port, [Letter, $: | _], DTraceUtag) when is_port(Port), $A =< Letter, Letter =< $Z -> - get_cwd_int(Port, Letter - $A + 1); -get_cwd(Port, [_|_]) when is_port(Port) -> + get_cwd_int(Port, Letter - $A + 1, DTraceUtag); +get_cwd(Port, [_|_], _DTraceUtag) when is_port(Port) -> {error, einval}; -get_cwd(_, _) -> +get_cwd(_, _, _DTraceUtag) -> {error, badarg}. -get_cwd_int(Drive) -> - get_cwd_int({?DRV, [binary]}, Drive). +get_cwd_int(Drive, DTraceUtag) -> + get_cwd_int({?DRV, [binary]}, Drive, DTraceUtag). -get_cwd_int(Port, Drive) -> - drv_command(Port, <>). +get_cwd_int(Port, Drive, DTraceUtag) -> + drv_command(Port, list_to_binary([?FILE_PWD, Drive, enc_utag(DTraceUtag)])). -%% set_cwd/{1,2} +%% set_cwd/{1,3} set_cwd(Dir) -> - set_cwd_int({?DRV, [binary]}, Dir). + set_cwd_int({?DRV, [binary]}, Dir, get_dtrace_utag()). -set_cwd(Port, Dir) when is_port(Port) -> - set_cwd_int(Port, Dir). +set_cwd(Port, Dir, DTraceUtag) when is_port(Port) -> + set_cwd_int(Port, Dir, DTraceUtag). -set_cwd_int(Port, Dir0) -> +set_cwd_int(Port, Dir0, DTraceUtag) -> Dir = (catch case os:type() of @@ -631,7 +732,7 @@ set_cwd_int(Port, Dir0) -> %% must call get_cwd from here and use %% absname/2, since %% absname/1 uses file:get_cwd ... - case get_cwd_int(Port, 0) of + case get_cwd_int(Port, 0, "") of {ok, AbsPath} -> filename:absname(Dir0, AbsPath); _Badcwd -> @@ -642,91 +743,99 @@ set_cwd_int(Port, Dir0) -> end), %% Dir is now either a string or an EXIT tuple. %% An EXIT tuple will fail in the following catch. - drv_command(Port, [?FILE_CHDIR, pathname(Dir)]). + drv_command(Port, [?FILE_CHDIR, pathname(Dir), enc_utag(DTraceUtag)]). -%% delete/{1,2} +%% delete/{1,2,3} delete(File) -> - delete_int({?DRV, [binary]}, File). + delete_int({?DRV, [binary]}, File, get_dtrace_utag()). delete(Port, File) when is_port(Port) -> - delete_int(Port, File). + delete_int(Port, File, get_dtrace_utag()). + +delete(Port, File, DTraceUtag) when is_port(Port) -> + delete_int(Port, File, DTraceUtag). -delete_int(Port, File) -> - drv_command(Port, [?FILE_DELETE, pathname(File)]). +delete_int(Port, File, DTraceUtag) -> + drv_command(Port, [?FILE_DELETE, pathname(File), enc_utag(DTraceUtag)]). -%% rename/{2,3} +%% rename/{2,3,4} rename(From, To) -> - rename_int({?DRV, [binary]}, From, To). + rename_int({?DRV, [binary]}, From, To, get_dtrace_utag()). rename(Port, From, To) when is_port(Port) -> - rename_int(Port, From, To). + rename_int(Port, From, To, get_dtrace_utag()). -rename_int(Port, From, To) -> - drv_command(Port, [?FILE_RENAME, pathname(From), pathname(To)]). +rename(Port, From, To, DTraceUtag) when is_port(Port) -> + rename_int(Port, From, To, DTraceUtag). +rename_int(Port, From, To, DTraceUtag) -> + drv_command(Port, [?FILE_RENAME, pathname(From), pathname(To), + enc_utag(DTraceUtag)]). -%% make_dir/{1,2} + +%% make_dir/{1,3} make_dir(Dir) -> - make_dir_int({?DRV, [binary]}, Dir). + make_dir_int({?DRV, [binary]}, Dir, get_dtrace_utag()). -make_dir(Port, Dir) when is_port(Port) -> - make_dir_int(Port, Dir). +make_dir(Port, Dir, DTraceUtag) when is_port(Port) -> + make_dir_int(Port, Dir, DTraceUtag). -make_dir_int(Port, Dir) -> - drv_command(Port, [?FILE_MKDIR, pathname(Dir)]). +make_dir_int(Port, Dir, DTraceUtag) -> + drv_command(Port, [?FILE_MKDIR, pathname(Dir), enc_utag(DTraceUtag)]). -%% del_dir/{1,2} +%% del_dir/{1,3} del_dir(Dir) -> - del_dir_int({?DRV, [binary]}, Dir). - -del_dir(Port, Dir) when is_port(Port) -> - del_dir_int(Port, Dir). - -del_dir_int(Port, Dir) -> - drv_command(Port, [?FILE_RMDIR, pathname(Dir)]). + del_dir_int({?DRV, [binary]}, Dir, get_dtrace_utag()). +del_dir(Port, Dir, DTraceUtag) when is_port(Port) -> + del_dir_int(Port, Dir, DTraceUtag). +del_dir_int(Port, Dir, DTraceUtag) -> + drv_command(Port, [?FILE_RMDIR, pathname(Dir), enc_utag(DTraceUtag)]). -%% read_file_info/{1,2} +%% read_file_info/{1,2,3} read_file_info(File) -> - read_file_info_int({?DRV, [binary]}, File). + read_file_info_int({?DRV, [binary]}, File, get_dtrace_utag()). read_file_info(Port, File) when is_port(Port) -> - read_file_info_int(Port, File). + read_file_info_int(Port, File, get_dtrace_utag()). -read_file_info_int(Port, File) -> - drv_command(Port, [?FILE_FSTAT, pathname(File)]). +read_file_info(Port, File, DTraceUtag) when is_port(Port) -> + read_file_info_int(Port, File, DTraceUtag). -%% altname/{1,2} +read_file_info_int(Port, File, DTraceUtag) -> + drv_command(Port, [?FILE_FSTAT, pathname(File), enc_utag(DTraceUtag)]). + +%% altname/{1,3} altname(File) -> - altname_int({?DRV, [binary]}, File). + altname_int({?DRV, [binary]}, File, get_dtrace_utag()). -altname(Port, File) when is_port(Port) -> - altname_int(Port, File). +altname(Port, File, DTraceUtag) when is_port(Port) -> + altname_int(Port, File, DTraceUtag). -altname_int(Port, File) -> - drv_command(Port, [?FILE_ALTNAME, pathname(File)]). +altname_int(Port, File, DTraceUtag) -> + drv_command(Port, [?FILE_ALTNAME, pathname(File), enc_utag(DTraceUtag)]). -%% write_file_info/{2,3} +%% write_file_info/{2,4} write_file_info(File, Info) -> - write_file_info_int({?DRV, [binary]}, File, Info). + write_file_info_int({?DRV, [binary]}, File, Info, get_dtrace_utag()). -write_file_info(Port, File, Info) when is_port(Port) -> - write_file_info_int(Port, File, Info). +write_file_info(Port, File, Info, DTraceUtag) when is_port(Port) -> + write_file_info_int(Port, File, Info, DTraceUtag). write_file_info_int(Port, File, @@ -735,7 +844,8 @@ write_file_info_int(Port, gid=Gid, atime=Atime0, mtime=Mtime0, - ctime=Ctime}) -> + ctime=Ctime}, + DTraceUtag) -> {Atime, Mtime} = case {Atime0, Mtime0} of {undefined, Mtime0} -> {erlang:localtime(), Mtime0}; @@ -749,72 +859,81 @@ write_file_info_int(Port, date_to_bytes(Atime), date_to_bytes(Mtime), date_to_bytes(Ctime), - pathname(File)]). + pathname(File), + enc_utag(DTraceUtag)]). -%% make_link/{2,3} +%% make_link/{2,3,4} make_link(Old, New) -> - make_link_int({?DRV, [binary]}, Old, New). + make_link_int({?DRV, [binary]}, Old, New, get_dtrace_utag()). make_link(Port, Old, New) when is_port(Port) -> - make_link_int(Port, Old, New). + make_link_int(Port, Old, New, get_dtrace_utag()). + +make_link(Port, Old, New, DTraceUtag) when is_port(Port) -> + make_link_int(Port, Old, New, DTraceUtag). -make_link_int(Port, Old, New) -> - drv_command(Port, [?FILE_LINK, pathname(Old), pathname(New)]). +make_link_int(Port, Old, New, DTraceUtag) -> + drv_command(Port, [?FILE_LINK, pathname(Old), pathname(New), + enc_utag(DTraceUtag)]). -%% make_symlink/{2,3} +%% make_symlink/{2,3,4} make_symlink(Old, New) -> - make_symlink_int({?DRV, [binary]}, Old, New). + make_symlink_int({?DRV, [binary]}, Old, New, get_dtrace_utag()). make_symlink(Port, Old, New) when is_port(Port) -> - make_symlink_int(Port, Old, New). + make_symlink_int(Port, Old, New, get_dtrace_utag()). + +make_symlink(Port, Old, New, DTraceUtag) when is_port(Port) -> + make_symlink_int(Port, Old, New, DTraceUtag). -make_symlink_int(Port, Old, New) -> - drv_command(Port, [?FILE_SYMLINK, pathname(Old), pathname(New)]). +make_symlink_int(Port, Old, New, DTraceUtag) -> + drv_command(Port, [?FILE_SYMLINK, pathname(Old), pathname(New), + enc_utag(DTraceUtag)]). -%% read_link/{2,3} +%% read_link/{1,3} read_link(Link) -> - read_link_int({?DRV, [binary]}, Link). + read_link_int({?DRV, [binary]}, Link, get_dtrace_utag()). -read_link(Port, Link) when is_port(Port) -> - read_link_int(Port, Link). +read_link(Port, Link, DTraceUtag) when is_port(Port) -> + read_link_int(Port, Link, DTraceUtag). -read_link_int(Port, Link) -> - drv_command(Port, [?FILE_READLINK, pathname(Link)]). +read_link_int(Port, Link, DTraceUtag) -> + drv_command(Port, [?FILE_READLINK, pathname(Link), enc_utag(DTraceUtag)]). -%% read_link_info/{2,3} +%% read_link_info/{1,3} read_link_info(Link) -> - read_link_info_int({?DRV, [binary]}, Link). + read_link_info_int({?DRV, [binary]}, Link, get_dtrace_utag()). -read_link_info(Port, Link) when is_port(Port) -> - read_link_info_int(Port, Link). +read_link_info(Port, Link, DTraceUtag) when is_port(Port) -> + read_link_info_int(Port, Link, DTraceUtag). -read_link_info_int(Port, Link) -> - drv_command(Port, [?FILE_LSTAT, pathname(Link)]). +read_link_info_int(Port, Link, DTraceUtag) -> + drv_command(Port, [?FILE_LSTAT, pathname(Link), enc_utag(DTraceUtag)]). -%% list_dir/{1,2} +%% list_dir/{1,3} list_dir(Dir) -> - list_dir_int({?DRV, [binary]}, Dir). + list_dir_int({?DRV, [binary]}, Dir, get_dtrace_utag()). -list_dir(Port, Dir) when is_port(Port) -> - list_dir_int(Port, Dir). +list_dir(Port, Dir, DTraceUtag) when is_port(Port) -> + list_dir_int(Port, Dir, DTraceUtag). -list_dir_int(Port, Dir) -> - drv_command(Port, [?FILE_READDIR, pathname(Dir)], []). +list_dir_int(Port, Dir, DTraceUtag) -> + drv_command(Port, [?FILE_READDIR, pathname(Dir), enc_utag(DTraceUtag)], []). @@ -1230,3 +1349,20 @@ reverse(L, T) -> lists:reverse(L, T). % in list_to_binary, which is caught and generates the {error,badarg} return pathname(File) -> (catch prim_file:internal_name2native(File)). + +%% TODO: Duplicate code! +get_dtrace_utag() -> + case get(dtrace_utag) of + X when is_list(X) -> + X; + _ -> + "" + end. + +%% TODO: Measure if it's worth checking (re:run()?) for NUL byte first? +enc_utag([0|Cs]) -> + enc_utag(Cs); +enc_utag([C|Cs]) -> + [C|enc_utag(Cs)]; +enc_utag([]) -> + [0]. diff --git a/lib/Makefile b/lib/Makefile index 98d7469..3d4be3a 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -73,7 +73,8 @@ else runtime_tools diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh inviso typer docbuilder erl_docgen common_test percept + xmerl edoc eunit ssh inviso typer docbuilder erl_docgen common_test percept \ + dtrace # dialyzer OTHER_SUB_DIRECTORIES += hipe $(TSP_APP) endif diff --git a/lib/dtrace/Makefile b/lib/dtrace/Makefile new file mode 100644 index 0000000..21181db --- /dev/null +++ b/lib/dtrace/Makefile @@ -0,0 +1,38 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# +# Macros +# + +SUB_DIRECTORIES = src c_src + +include vsn.mk +VSN = $(DTRACE_VSN) + +SPECIAL_TARGETS = + +# +# Default Subdir Targets +# +include $(ERL_TOP)/make/otp_subdir.mk + + diff --git a/lib/dtrace/c_src/Makefile b/lib/dtrace/c_src/Makefile new file mode 100644 index 0000000..19184f2 --- /dev/null +++ b/lib/dtrace/c_src/Makefile @@ -0,0 +1,5 @@ +# +# Invoke with GNU make or clearmake -C gnu. +# +include $(ERL_TOP)/make/run_make.mk + diff --git a/lib/dtrace/c_src/Makefile.in b/lib/dtrace/c_src/Makefile.in new file mode 100644 index 0000000..bda1795 --- /dev/null +++ b/lib/dtrace/c_src/Makefile.in @@ -0,0 +1,153 @@ +# +# %CopyrightBegin% +# +# Copyright Scott Lystig Fritchie 2011. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk +include $(ERL_TOP)/make/$(TARGET)/otp_ded.mk + +# ---------------------------------------------------- +# Items from top-level configure +# ---------------------------------------------------- +DTRACE_ENABLED=@DTRACE_ENABLED@ +DTRACE_ENABLED_2STEP=@DTRACE_ENABLED_2STEP@ + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(DTRACE_VSN) + +# ---------------------------------------------------- +# The following variables differ between systems. +# Set by configure. +# ---------------------------------------------------- +CC = $(DED_CC) +LD = $(DED_LD) +SHELL = /bin/sh +LIBS = $(DED_LIBS) +LDFLAGS += $(DED_LDFLAGS) +CFLAGS = $(DED_CFLAGS) + +DTRACE_LIBNAME = dtrace + + +INCLUDES = $(DED_INCLUDES) + +ifeq ($(TYPE),debug) +TYPEMARKER = .debug +TYPE_FLAGS = $(subst -O3,,$(subst -O2,,$(CFLAGS))) -DDEBUG +else +ifeq ($(TYPE),valgrind) +TYPEMARKER = .valgrind +TYPE_FLAGS = $(subst -O3,,$(subst -O2,,$(CFLAGS))) -DVALGRIND +else +TYPEMARKER = +TYPE_FLAGS = $(CFLAGS) +endif +endif + +ALL_CFLAGS = $(TYPE_FLAGS) $(INCLUDES) -I$(OBJDIR) \ + -I$(ERL_TOP)/erts/emulator/$(TARGET) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/dtrace-$(VSN) + +# ---------------------------------------------------- +# Misc Macros +# ---------------------------------------------------- +OBJS = $(OBJDIR)/dtrace$(TYPEMARKER).o +## NIF_MAKEFILE = $(PRIVDIR)/Makefile + +# Higher-level makefiles says that we can only compile on UNIX flavors +NIF_LIB = $(LIBDIR)/dtrace$(TYPEMARKER).so + +ifeq ($(HOST_OS),) +HOST_OS := $(shell $(ERL_TOP)/erts/autoconf/config.guess) +endif + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt valgrind: $(OBJDIR) $(LIBDIR) $(NIF_LIB) + +ifdef DTRACE_ENABLED +DTRACE_USER_HEADER=$(OBJDIR)/dtrace_user.h +$(OBJDIR)/dtrace_user.h: ./dtrace_user.d + dtrace -h -C $(INCLUDES) \ + -s ./dtrace_user.d \ + -o ./dtrace_user.tmp + sed -e '/^#define[ ]*ERLANG_[A-Z0-9_]*(.*)/y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/' ./dtrace_user.tmp > $@ + rm ./dtrace_user.tmp +else +DTRACE_USER_HEADER= +endif + +ifdef DTRACE_ENABLED_2STEP +OBJS += $(OBJDIR)/dtrace_user.o +$(OBJDIR)/dtrace_user.o: $(OBJS) $(OBJDIR)/dtrace_user.h + touch $(OBJDIR)/erlang_dtrace.c + $(CC) $(CFLAGS) -c -o $@ $(OBJDIR)/erlang_dtrace.c + # The object file created above is immediately clobbered below. + # But creating it above avoids chicken-and-egg problem with OBJS + dtrace -G -C \ + -s ./dtrace_user.d \ + -o $@ $(OBJS) +endif + +$(OBJDIR): + -@mkdir -p $(OBJDIR) + +$(LIBDIR): + -@mkdir -p $(LIBDIR) + +$(OBJDIR)/%$(TYPEMARKER).o: %.c $(DTRACE_USER_HEADER) + $(INSTALL_DIR) $(OBJDIR) + $(CC) -c -o $@ $(ALL_CFLAGS) $< + +$(LIBDIR)/dtrace$(TYPEMARKER).so: $(OBJS) + $(INSTALL_DIR) $(LIBDIR) + $(LD) $(LDFLAGS) -o $@ $^ $(LDLIBS) + +clean: + rm -f $(LIBDIR)/dtrace.so + rm -f $(LIBDIR)/dtrace.debug.so + rm -f $(LIBDIR)/dtrace.valgrind.so + rm -f $(OBJDIR)/dtrace.o + rm -f $(OBJDIR)/dtrace.debug.o + rm -f $(OBJDIR)/dtrace.valgrind.o + rm -f core *~ + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/priv/obj + $(INSTALL_DIR) $(RELSYSDIR)/priv/lib + # $(INSTALL_DATA) $(NIF_MAKEFILE) $(RELSYSDIR)/priv/obj + $(INSTALL_PROGRAM) $(OBJS) $(RELSYSDIR)/priv/obj + $(INSTALL_PROGRAM) $(NIF_LIB) $(RELSYSDIR)/priv/lib + +release_docs_spec: + diff --git a/lib/dtrace/c_src/dtrace.c b/lib/dtrace/c_src/dtrace.c new file mode 100644 index 0000000..e5f4d50 --- /dev/null +++ b/lib/dtrace/c_src/dtrace.c @@ -0,0 +1,173 @@ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Purpose: Dynamically loadable NIF library for DTrace + */ + + +#include "erl_nif.h" +#include "config.h" +#include "sys.h" +#define DTRACE_DRIVER_SKIP_FUNC_DECLARATIONS +#include "dtrace-wrapper.h" +#include "dtrace_user.h" + +void dtrace_nifenv_str(ErlNifEnv *env, char *process_buf); +void get_string_maybe(ErlNifEnv *env, const ERL_NIF_TERM term, char **ptr, char *buf, int bufsiz); + +#ifdef VALGRIND + # include +#endif + +#ifdef __GNUC__ + # define INLINE __inline__ +#else + # define INLINE +#endif + +#define MESSAGE_BUFSIZ 1024 + +/* NIF interface declarations */ +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info); + +/* The NIFs: */ +static ERL_NIF_TERM available(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM user_trace_s1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); + +static ErlNifFunc nif_funcs[] = { + {"available", 0, available}, + {"user_trace_s1", 1, user_trace_s1}, + {"user_trace_i4s4", 9, user_trace_i4s4} +}; + +ERL_NIF_INIT(dtrace, nif_funcs, load, NULL, NULL, NULL) + +static ERL_NIF_TERM atom_true; +static ERL_NIF_TERM atom_false; +static ERL_NIF_TERM atom_error; +static ERL_NIF_TERM atom_not_available; +static ERL_NIF_TERM atom_badarg; +static ERL_NIF_TERM atom_ok; + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + atom_true = enif_make_atom(env,"true"); + atom_false = enif_make_atom(env,"false"); + atom_error = enif_make_atom(env,"error"); + atom_not_available = enif_make_atom(env,"not_available"); + atom_badarg = enif_make_atom(env,"badarg"); + atom_ok = enif_make_atom(env,"ok"); + + return 0; +} + +static ERL_NIF_TERM available(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef HAVE_DTRACE + return atom_true; +#else + return atom_false; +#endif +} + +static ERL_NIF_TERM user_trace_s1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef HAVE_DTRACE + ErlNifBinary message_bin; + char messagebuf[MESSAGE_BUFSIZ + 1]; + + if (DTRACE_ENABLED(user_trace_s1)) { + if (!enif_inspect_iolist_as_binary(env, argv[0], &message_bin) || + message_bin.size > MESSAGE_BUFSIZ) { + return atom_badarg; + } + memcpy(messagebuf, (char *) message_bin.data, message_bin.size); + messagebuf[message_bin.size] = '\0'; + DTRACE1(user_trace_s1, messagebuf); + return atom_true; + } else { + return atom_false; + } +#else + return atom_error; +#endif +} + +void +get_string_maybe(ErlNifEnv *env, + const ERL_NIF_TERM term, char **ptr, char *buf, int bufsiz) +{ + ErlNifBinary str_bin; + + if (!enif_inspect_iolist_as_binary(env, term, &str_bin) || + str_bin.size > bufsiz) { + *ptr = NULL; + } else { + memcpy(buf, (char *) str_bin.data, str_bin.size); + buf[str_bin.size] = '\0'; + *ptr = buf; + } +} + +static ERL_NIF_TERM user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ +#ifdef HAVE_DTRACE + char procbuf[32 + 1]; + char user_tagbuf[MESSAGE_BUFSIZ + 1]; + char *utbuf = NULL; + ErlNifSInt64 i1, i2, i3, i4; + char messagebuf1[MESSAGE_BUFSIZ + 1]; + char messagebuf2[MESSAGE_BUFSIZ + 1]; + char messagebuf3[MESSAGE_BUFSIZ + 1]; + char messagebuf4[MESSAGE_BUFSIZ + 1]; + char *mbuf1 = NULL, *mbuf2 = NULL, *mbuf3 = NULL, *mbuf4 = NULL; + + if (DTRACE_ENABLED(user_trace_i4s4)) { + dtrace_nifenv_str(env, procbuf); + get_string_maybe(env, argv[0], &utbuf, + user_tagbuf, sizeof(user_tagbuf)-1); + if (! enif_get_int64(env, argv[1], &i1)) + i1 = 0; + if (! enif_get_int64(env, argv[2], &i2)) + i2 = 0; + if (! enif_get_int64(env, argv[3], &i3)) + i3 = 0; + if (! enif_get_int64(env, argv[4], &i4)) + i4 = 0; + get_string_maybe(env, argv[5], &mbuf1, + messagebuf1, sizeof(messagebuf1)-1); + get_string_maybe(env, argv[6], &mbuf2, + messagebuf2, sizeof(messagebuf2)-1); + get_string_maybe(env, argv[7], &mbuf3, + messagebuf3, sizeof(messagebuf3)-1); + get_string_maybe(env, argv[8], &mbuf4, + messagebuf4, sizeof(messagebuf4)-1); + DTRACE10(user_trace_i4s4, procbuf, utbuf, + i1, i2, i3, i4, mbuf1, mbuf2, mbuf3, mbuf4); + return atom_true; + } else { + return atom_false; + } +#else + return atom_error; +#endif +} + diff --git a/lib/dtrace/c_src/dtrace_user.d b/lib/dtrace/c_src/dtrace_user.d new file mode 100644 index 0000000..45d3ef3 --- /dev/null +++ b/lib/dtrace/c_src/dtrace_user.d @@ -0,0 +1,53 @@ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. + * All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +provider erlang { + /** + * Send a single string to a probe. + * + * @param NUL-terminated string + */ + probe user_trace__s1(char* message); + + /** + * Multi-purpose probe: up to 4 NUL-terminated strings and 4 + * 64-bit integer arguments. + * + * @param proc, the PID (string form) of the sending process + * @param user_tag, the user tag of the sender + * @param i1, integer + * @param i2, integer + * @param i3, integer + * @param i4, integer + * @param s1, string/iolist. D's arg6 is NULL if not given by Erlang + * @param s2, string/iolist. D's arg7 is NULL if not given by Erlang + * @param s3, string/iolist. D's arg8 is NULL if not given by Erlang + * @param s4, string/iolist. D's arg9 is NULL if not given by Erlang + */ + probe user_trace__i4s4(char *proc, char *user_tag, + int i1, int i2, int i3, int i4, + char *s1, char *s2, char *s3, char *s4); +}; + +#pragma D attributes Evolving/Evolving/Common provider erlang provider +#pragma D attributes Private/Private/Common provider erlang module +#pragma D attributes Private/Private/Common provider erlang function +#pragma D attributes Evolving/Evolving/Common provider erlang name +#pragma D attributes Evolving/Evolving/Common provider erlang args diff --git a/lib/dtrace/ebin/.placeholder b/lib/dtrace/ebin/.placeholder new file mode 100644 index 0000000..e69de29 diff --git a/lib/dtrace/examples/efile_drv.d b/lib/dtrace/examples/efile_drv.d new file mode 100644 index 0000000..cf29057 --- /dev/null +++ b/lib/dtrace/examples/efile_drv.d @@ -0,0 +1,48 @@ +/* example usage: dtrace -q -s /path/to/efile_drv.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::aio_pool-add +{ + printf("async I/O pool add thread %d queue len %d\n", arg0, arg1); +} + +erlang*:::aio_pool-get +{ + printf("async I/O pool get thread %d queue len %d\n", arg0, arg1); +} + +erlang*:::efile_drv-entry +{ + printf("efile_drv enter %d %d %s | %d | %s %s , %d %d\n", + arg0, arg1, arg2 == NULL ? "" : copyinstr(arg2), arg3, + arg4 == NULL ? "" : copyinstr(arg4), + arg5 == NULL ? "" : copyinstr(arg5), arg6, arg7) +} + +erlang*:::efile_drv-int* +{ + printf("async I/O worker %d %d %d | %d\n", arg0, arg1, arg2, arg3); +} + +erlang*:::efile_drv-return +{ + printf("efile_drv return %d %d %s | %d | %d %d %d\n", arg0, arg1, + arg2 == NULL ? "" : copyinstr(arg2), arg3, arg4, arg5, arg6); +} diff --git a/lib/dtrace/examples/function-calls.d b/lib/dtrace/examples/function-calls.d new file mode 100644 index 0000000..1d04cd8 --- /dev/null +++ b/lib/dtrace/examples/function-calls.d @@ -0,0 +1,52 @@ +/* example usage: dtrace -q -s /path/to/function-calls.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::function-entry +{ + printf("pid %s enter %s depth %d\n", + copyinstr(arg0), copyinstr(arg1), arg2); +} + +erlang*:::function-return +{ + printf("pid %s return %s depth %d\n", + copyinstr(arg0), copyinstr(arg1), arg2); +} + +erlang*:::bif-entry +{ + printf("pid %s BIF entry mfa %s\n", copyinstr(arg0), copyinstr(arg1)); +} + +erlang*:::bif-return +{ + printf("pid %s BIF return mfa %s\n", copyinstr(arg0), copyinstr(arg1)); +} + +erlang*:::nif-entry +{ + printf("pid %s NIF entry mfa %s\n", copyinstr(arg0), copyinstr(arg1)); +} + +erlang*:::nif-return +{ + printf("pid %s NIF return mfa %s\n", copyinstr(arg0), copyinstr(arg1)); +} + diff --git a/lib/dtrace/examples/garbage-collection.d b/lib/dtrace/examples/garbage-collection.d new file mode 100644 index 0000000..0b98630 --- /dev/null +++ b/lib/dtrace/examples/garbage-collection.d @@ -0,0 +1,40 @@ +/* example usage: dtrace -q -s /path/to/garbage-collection.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::gc_major-start +{ + printf("GC major start pid %s need %d words\n", copyinstr(arg0), arg1); +} + +erlang*:::gc_minor-start +{ + printf("GC minor start pid %s need %d words\n", copyinstr(arg0), arg1); +} + +erlang*:::gc_major-end +{ + printf("GC major end pid %s reclaimed %d words\n", copyinstr(arg0), arg1); +} + +erlang*:::gc_minor-start +{ + printf("GC minor end pid %s reclaimed %d words\n", copyinstr(arg0), arg1); +} + diff --git a/lib/dtrace/examples/memory1.d b/lib/dtrace/examples/memory1.d new file mode 100644 index 0000000..30b6eee --- /dev/null +++ b/lib/dtrace/examples/memory1.d @@ -0,0 +1,42 @@ +/* example usage: dtrace -q -s /path/to/memory1.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::copy-struct +{ + printf("copy_struct %d bytes\n", arg0); +} + +erlang*:::copy-object +{ + printf("copy_object pid %s %d bytes\n", copyinstr(arg0), arg1); +} + +erlang*:::process-heap_grow +{ + printf("proc heap grow pid %s %d -> %d bytes\n", copyinstr(arg0), + arg1, arg2); +} + +erlang*:::process-heap_shrink +{ + printf("proc heap shrink pid %s %d -> %d bytes\n", copyinstr(arg0), + arg1, arg2); +} + diff --git a/lib/dtrace/examples/messages.d b/lib/dtrace/examples/messages.d new file mode 100644 index 0000000..6501058 --- /dev/null +++ b/lib/dtrace/examples/messages.d @@ -0,0 +1,29 @@ +/* example usage: dtrace -q -s /path/to/messages.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::message-send +{ + printf("send: %s -> %s: %d bytes\n", copyinstr(arg0), copyinstr(arg1), arg2); +} + +erlang*:::message-receive +{ + printf("recv: %s: %d bytes, queue len %d\n", copyinstr(arg0), arg1, arg2); +} diff --git a/lib/dtrace/examples/port1.d b/lib/dtrace/examples/port1.d new file mode 100644 index 0000000..37d1f0b --- /dev/null +++ b/lib/dtrace/examples/port1.d @@ -0,0 +1,42 @@ +/* example usage: dtrace -q -s /path/to/port1.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::port-command +{ + printf("port command pid %s port %s port name %s command type %s\n", + copyinstr(arg0), copyinstr(arg1), copyinstr(arg2), copyinstr(arg3)); +} + +erlang*:::port-control +{ + printf("port control pid %s port %s port name %s command %d\n", + copyinstr(arg0), copyinstr(arg1), copyinstr(arg2), arg3); +} + +erlang*:::aio_pool-add +{ + printf("async I/O pool add thread %d queue len %d\n", arg0, arg1); +} + +erlang*:::aio_pool-get +{ + printf("async I/O pool get thread %d queue len %d\n", arg0, arg1); +} + diff --git a/lib/dtrace/examples/process-scheduling.d b/lib/dtrace/examples/process-scheduling.d new file mode 100644 index 0000000..31a26f6 --- /dev/null +++ b/lib/dtrace/examples/process-scheduling.d @@ -0,0 +1,36 @@ +/* example usage: dtrace -q -s /path/to/process-scheduling.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::process-scheduled +{ + printf(" Schedule pid %s mfa %s\n", copyinstr(arg0), copyinstr(arg1)); +} + +erlang*:::process-unscheduled +{ + printf("Unschedule pid %s\n", copyinstr(arg0)); +} + +erlang*:::process-hibernate +{ + printf(" Hibernate pid %s resume mfa %s\n", + copyinstr(arg0), copyinstr(arg1)); +} + diff --git a/lib/dtrace/examples/spawn-exit.d b/lib/dtrace/examples/spawn-exit.d new file mode 100644 index 0000000..4619b7e --- /dev/null +++ b/lib/dtrace/examples/spawn-exit.d @@ -0,0 +1,35 @@ +/* example usage: dtrace -q -s /path/to/spawn-exit.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::process-spawn +{ + printf("pid %s mfa %s\n", copyinstr(arg0), copyinstr(arg1)); +} + +erlang*:::process-exit +{ + printf("pid %s reason %s\n", copyinstr(arg0), copyinstr(arg1)); +} + +erlang*:::process-exit_signal +{ + printf("sender %s -> pid %s reason %s\n", + copyinstr(arg0), copyinstr(arg1), copyinstr(arg2)); +} diff --git a/lib/dtrace/examples/user-probe.d b/lib/dtrace/examples/user-probe.d new file mode 100644 index 0000000..8cc84e3 --- /dev/null +++ b/lib/dtrace/examples/user-probe.d @@ -0,0 +1,36 @@ +/* example usage: dtrace -q -s /path/to/user-probe.d */ +/* + * %CopyrightBegin% + * + * Copyright Scott Lystig Fritchie 2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +erlang*:::user_trace-s1 +{ + printf("%s\n", copyinstr(arg0)); +} + +erlang*:::user_trace-i4s4 +{ + printf("%s %s %d %d %d %d '%s' '%s' '%s' '%s'\n", + copyinstr(arg0), + arg1 == NULL ? "" : copyinstr(arg1), + arg2, arg3, arg4, arg5, + arg6 == NULL ? "" : copyinstr(arg6), + arg7 == NULL ? "" : copyinstr(arg7), + arg8 == NULL ? "" : copyinstr(arg8), + arg9 == NULL ? "" : copyinstr(arg9)); +} diff --git a/lib/dtrace/src/Makefile b/lib/dtrace/src/Makefile new file mode 100644 index 0000000..d0fa1e7 --- /dev/null +++ b/lib/dtrace/src/Makefile @@ -0,0 +1,109 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2011. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(DTRACE_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/dtrace-$(VSN) + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- + +MODULES= \ + dtrace + +HRL_FILES= \ + +INTERNAL_HRL_FILES= \ + +ERL_FILES= $(MODULES:%=%.erl) +EXAMPLE_FILES= \ + ../examples/* + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) + +EXECUTABLES= \ + +APP_FILE= dtrace.app + +APP_SRC= $(APP_FILE).src +APP_TARGET= $(EBIN)/$(APP_FILE) + +APPUP_FILE= dtrace.appup + +APPUP_SRC= $(APPUP_FILE).src +APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += \ + -I../include \ + -I ../../et/include \ + -I ../../../libraries/et/include + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f errs core *~ + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src + # $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/examples + $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: + + + + + + + diff --git a/lib/dtrace/src/dtrace.app.src b/lib/dtrace/src/dtrace.app.src new file mode 100644 index 0000000..6bcd211 --- /dev/null +++ b/lib/dtrace/src/dtrace.app.src @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +{application, dtrace, + [{description, "DTRACE version 1"}, + {vsn, "%VSN%"}, + {modules, [ + dtrace + ]}, + {registered, []}, + {applications, [kernel, stdlib]}, + {env, []}]}. + + diff --git a/lib/dtrace/src/dtrace.appup.src b/lib/dtrace/src/dtrace.appup.src new file mode 100644 index 0000000..1d5a0d9 --- /dev/null +++ b/lib/dtrace/src/dtrace.appup.src @@ -0,0 +1,19 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +{"%VSN%",[],[]}. diff --git a/lib/dtrace/src/dtrace.erl b/lib/dtrace/src/dtrace.erl new file mode 100644 index 0000000..b0c1f46 --- /dev/null +++ b/lib/dtrace/src/dtrace.erl @@ -0,0 +1,216 @@ +-module(dtrace). + +%%% @doc The DTrace interface module +%%% +%%% This DTrace interface module, with the corresponding NIFs, should +%%% work on any operating system platform where user-space DTrace +%%% probes are supported. +%%% +%%% Use the `dtrace:init()' function to load the NIF shared library and +%%% to initialize library's private state. +%%% +%%% It is recommended that you use the `dtrace:p()' function to add +%%% DTrace probes to your Erlang code. This function can accept up to +%%% four integer arguments and four string arguments; the integer +%%% argument(s) must come before any string argument. For example: +%%% ``` +%%% 1> put(dtrace_utag, "GGOOOAAALL!!!!!"). +%%% undefined +%%% 2> dtrace:init(). +%%% ok +%%% +%%% % % % Enable the DTrace probe using the 'dtrace' command. +%%% +%%% 3> dtrace:p(7, 8, 9, "one", "four"). +%%% true +%%% ''' +%%% +%%% Output from the example D script `user-probe.d' looks like: +%%% ``` +%%% <0.34.0> GGOOOAAALL!!!!! 7 8 9 0 'one' 'four' '' '' +%%% ''' +%%% +%%% If the expected type of variable is not present, e.g. integer when +%%% integer() is expected, or an I/O list when iolist() is expected, +%%% then the driver will ignore the user's input and use a default +%%% value of 0 or NULL, respectively. + +-export([init/0, available/0, + user_trace_s1/1, % TODO: unify with pid & tag args like user_trace_i4s4 + p/0, p/1, p/2, p/3, p/4, p/5, p/6, p/7, p/8]). +-export([scaff/0]). % Development only +-export([user_trace_i4s4/9]). % Know what you're doing! + +-type probe_arg() :: integer() | iolist(). +-type int_p_arg() :: integer() | iolist() | undef. +%% The *_maybe() types use atom() instead of a stricter 'undef' +%% because user_trace_i4s4/9 is exposed to the outside world, and +%% because the driver will allow any atom to be used as a "not +%% present" indication, we'll allow any atom in the types. +-type integer_maybe() :: integer() | atom(). +-type iolist_maybe() :: iolist() | atom(). + +-spec init() -> ok | {error, {term(), term()}}. + +init() -> + PrivDir = code:priv_dir(dtrace), + Lib = filename:join([PrivDir, "lib", "dtrace"]), + erlang:load_nif(Lib, 0). + +%%% +%%% NIF placeholders +%%% + +-spec available() -> true | false. + +available() -> + erlang:nif_error(nif_not_loaded). + +-spec user_trace_s1(iolist()) -> true | false | error | badarg. + +user_trace_s1(Message) -> + erlang:nif_error(nif_not_loaded). + +-spec user_trace_i4s4(iolist(), + integer_maybe(), integer_maybe(), + integer_maybe(), integer_maybe(), + iolist_maybe(), iolist_maybe(), + iolist_maybe(), iolist_maybe()) -> + true | false | error | badarg. + +user_trace_i4s4(_, _, _, _, _, _, _, _, _) -> + erlang:nif_error(nif_not_loaded). + +%%% +%%% Erlang support functions +%%% + +-spec p() -> true | false | error | badarg. + +p() -> + user_trace_int(undef, undef, undef, undef, undef, undef, undef, undef). + +-spec p(probe_arg()) -> true | false | error | badarg. + +p(I1) when is_integer(I1) -> + user_trace_int(I1, undef, undef, undef, undef, undef, undef, undef); +p(S1) -> + user_trace_int(undef, undef, undef, undef, S1, undef, undef, undef). + +-spec p(probe_arg(), probe_arg()) -> true | false | error | badarg. + +p(I1, I2) when is_integer(I1), is_integer(I2) -> + user_trace_int(I1, I2, undef, undef, undef, undef, undef, undef); +p(I1, S1) when is_integer(I1) -> + user_trace_int(I1, undef, undef, undef, S1, undef, undef, undef); +p(S1, S2) -> + user_trace_int(undef, undef, undef, undef, S1, S2, undef, undef). + +-spec p(probe_arg(), probe_arg(), probe_arg()) -> true | false | error | badarg. + +p(I1, I2, I3) when is_integer(I1), is_integer(I2), is_integer(I3) -> + user_trace_int(I1, I2, I3, undef, undef, undef, undef, undef); +p(I1, I2, S1) when is_integer(I1), is_integer(I2) -> + user_trace_int(I1, I2, undef, undef, S1, undef, undef, undef); +p(I1, S1, S2) when is_integer(I1) -> + user_trace_int(I1, undef, undef, undef, S1, S2, undef, undef); +p(S1, S2, S3) -> + user_trace_int(undef, undef, undef, undef, S1, S2, S3, undef). + +-spec p(probe_arg(), probe_arg(), probe_arg(), probe_arg()) -> + true | false | error | badarg. + +p(I1, I2, I3, I4) when is_integer(I1), is_integer(I2), is_integer(I3), is_integer(I4) -> + user_trace_int(I1, I2, I3, I4, undef, undef, undef, undef); +p(I1, I2, I3, S1) when is_integer(I1), is_integer(I2), is_integer(I3) -> + user_trace_int(I1, I2, I3, undef, S1, undef, undef, undef); +p(I1, I2, S1, S2) when is_integer(I1), is_integer(I2) -> + user_trace_int(I1, I2, undef, undef, S1, S2, undef, undef); +p(I1, S1, S2, S3) when is_integer(I1) -> + user_trace_int(I1, undef, undef, undef, S1, S2, S3, undef); +p(S1, S2, S3, S4) -> + user_trace_int(undef, undef, undef, undef, S1, S2, S3, S4). + +-spec p(probe_arg(), probe_arg(), probe_arg(), probe_arg(), + probe_arg()) -> + true | false | error | badarg. + +p(I1, I2, I3, I4, S1) when is_integer(I1), is_integer(I2), is_integer(I3), is_integer(I4) -> + user_trace_int(I1, I2, I3, I4, S1, undef, undef, undef); +p(I1, I2, I3, S1, S2) when is_integer(I1), is_integer(I2), is_integer(I3) -> + user_trace_int(I1, I2, I3, undef, S1, S2, undef, undef); +p(I1, I2, S1, S2, S3) when is_integer(I1), is_integer(I2) -> + user_trace_int(I1, I2, undef, undef, S1, S2, S3, undef); +p(I1, S1, S2, S3, S4) when is_integer(I1) -> + user_trace_int(I1, undef, undef, undef, S1, S2, S3, S4). + +-spec p(probe_arg(), probe_arg(), probe_arg(), probe_arg(), + probe_arg(), probe_arg()) -> + true | false | error | badarg. + +p(I1, I2, I3, I4, S1, S2) when is_integer(I1), is_integer(I2), is_integer(I3), is_integer(I4) -> + user_trace_int(I1, I2, I3, I4, S1, S2, undef, undef); +p(I1, I2, I3, S1, S2, S3) when is_integer(I1), is_integer(I2), is_integer(I3) -> + user_trace_int(I1, I2, I3, undef, S1, S2, S3, undef); +p(I1, I2, S1, S2, S3, S4) when is_integer(I1), is_integer(I2) -> + user_trace_int(I1, I2, undef, undef, S1, S2, S3, S4). + +-spec p(probe_arg(), probe_arg(), probe_arg(), probe_arg(), + probe_arg(), probe_arg(), probe_arg()) -> + true | false | error | badarg. + +p(I1, I2, I3, I4, S1, S2, S3) when is_integer(I1), is_integer(I2), is_integer(I3), is_integer(I4) -> + user_trace_int(I1, I2, I3, I4, S1, S2, S3, undef); +p(I1, I2, I3, S1, S2, S3, S4) when is_integer(I1), is_integer(I2), is_integer(I3) -> + user_trace_int(I1, I2, I3, undef, S1, S2, S3, S4). + +-spec p(probe_arg(), probe_arg(), probe_arg(), probe_arg(), + probe_arg(), probe_arg(), probe_arg(), probe_arg()) -> + true | false | error | badarg. + +p(I1, I2, I3, I4, S1, S2, S3, S4) when is_integer(I1), is_integer(I2), is_integer(I3), is_integer(I4) -> + user_trace_int(I1, I2, I3, I4, S1, S2, S3, S4). + +-spec user_trace_int(int_p_arg(), int_p_arg(), int_p_arg(), int_p_arg(), + int_p_arg(), int_p_arg(), int_p_arg(), int_p_arg()) -> + true | false | error | badarg. + +user_trace_int(I1, I2, I3, I4, S1, S2, S3, S4) -> + UTag = prim_file:get_dtrace_utag(), + user_trace_i4s4(UTag, I1, I2, I3, I4, S1, S2, S3, S4). + +%% Scaffolding to write tedious code: quick brute force and not 100% correct. + +scaff_int_args(N) -> + L = lists:sublist(["I1", "I2", "I3", "I4"], N), + [string:join(L, ", ")]. + +scaff_int_guards(N) -> + L = lists:sublist(["is_integer(I1)", "is_integer(I2)", "is_integer(I3)", + "is_integer(I4)"], N), + lists:flatten(string:join(L, ", ")). + +scaff_char_args(N) -> + L = lists:sublist(["S1", "S2", "S3", "S4"], N), + [string:join(L, ", ")]. + +scaff_fill(N) -> + [string:join(lists:duplicate(N, "undef"), ", ")]. + +scaff() -> + L = [begin + IntArgs = scaff_int_args(N_int), + IntGuards = scaff_int_guards(N_int), + IntFill = scaff_fill(4 - N_int), + CharArgs = scaff_char_args(N_char), + CharFill = scaff_fill(4 - N_char), + InArgs = string:join(IntArgs ++ CharArgs, ", "), + OutArgs = string:join(IntArgs ++ IntFill ++ CharArgs ++ CharFill, + ", "), + {N_int + N_char, + lists:flatten([io_lib:format("p(~s) when ~s ->\n", + [InArgs, IntGuards]), + io_lib:format(" user_trace_int(~s);\n", [OutArgs]) + ])} + end || N_int <- [0,1,2,3,4], N_char <- [0,1,2,3,4]], + [io:format("%%~p\n~s", [N, Str]) || {N, Str} <- lists:sort(L)]. diff --git a/lib/dtrace/vsn.mk b/lib/dtrace/vsn.mk new file mode 100644 index 0000000..73bf983 --- /dev/null +++ b/lib/dtrace/vsn.mk @@ -0,0 +1 @@ +DTRACE_VSN = 0.8 diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 5e4e1b0..e62edba 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -37,7 +37,7 @@ -export([ipread_s32bu_p32bu/3]). %% Generic file contents. -export([open/2, close/1, advise/4, - read/2, write/2, + read/2, write/2, pread/2, pread/3, pwrite/2, pwrite/3, read_line/1, position/2, truncate/1, datasync/1, sync/1, @@ -57,7 +57,7 @@ %% Internal export to prim_file and ram_file until they implement %% an efficient copy themselves. --export([copy_opened/3]). +-export([copy_opened/4]). -export([ipread_s32bu_p32bu_int/3]). @@ -157,7 +157,7 @@ pid2name(Pid) when is_pid(Pid) -> Reason :: posix(). get_cwd() -> - call(get_cwd, []). + call(get_cwd, [no_drive, get_dtrace_utag()]). -spec get_cwd(Drive) -> {ok, Dir} | {error, Reason} when Drive :: string(), @@ -165,21 +165,21 @@ get_cwd() -> Reason :: posix() | badarg. get_cwd(Drive) -> - check_and_call(get_cwd, [file_name(Drive)]). + check_and_call(get_cwd, [file_name(Drive), get_dtrace_utag()]). -spec set_cwd(Dir) -> ok | {error, Reason} when Dir :: name(), Reason :: posix() | badarg. set_cwd(Dirname) -> - check_and_call(set_cwd, [file_name(Dirname)]). + check_and_call(set_cwd, [file_name(Dirname), get_dtrace_utag()]). -spec delete(Filename) -> ok | {error, Reason} when Filename :: name(), Reason :: posix() | badarg. delete(Name) -> - check_and_call(delete, [file_name(Name)]). + check_and_call(delete, [file_name(Name), get_dtrace_utag()]). -spec rename(Source, Destination) -> ok | {error, Reason} when Source :: name(), @@ -187,21 +187,21 @@ delete(Name) -> Reason :: posix() | badarg. rename(From, To) -> - check_and_call(rename, [file_name(From), file_name(To)]). + check_and_call(rename, [file_name(From), file_name(To), get_dtrace_utag()]). -spec make_dir(Dir) -> ok | {error, Reason} when Dir :: name(), Reason :: posix() | badarg. make_dir(Name) -> - check_and_call(make_dir, [file_name(Name)]). + check_and_call(make_dir, [file_name(Name), get_dtrace_utag()]). -spec del_dir(Dir) -> ok | {error, Reason} when Dir :: name(), Reason :: posix() | badarg. del_dir(Name) -> - check_and_call(del_dir, [file_name(Name)]). + check_and_call(del_dir, [file_name(Name), get_dtrace_utag()]). -spec read_file_info(Filename) -> {ok, FileInfo} | {error, Reason} when Filename :: name(), @@ -209,12 +209,12 @@ del_dir(Name) -> Reason :: posix() | badarg. read_file_info(Name) -> - check_and_call(read_file_info, [file_name(Name)]). + check_and_call(read_file_info, [file_name(Name), get_dtrace_utag()]). -spec altname(Name :: name()) -> any(). altname(Name) -> - check_and_call(altname, [file_name(Name)]). + check_and_call(altname, [file_name(Name), get_dtrace_utag()]). -spec read_link_info(Name) -> {ok, FileInfo} | {error, Reason} when Name :: name(), @@ -222,7 +222,7 @@ altname(Name) -> Reason :: posix() | badarg. read_link_info(Name) -> - check_and_call(read_link_info, [file_name(Name)]). + check_and_call(read_link_info, [file_name(Name), get_dtrace_utag()]). -spec read_link(Name) -> {ok, Filename} | {error, Reason} when Name :: name(), @@ -230,7 +230,7 @@ read_link_info(Name) -> Reason :: posix() | badarg. read_link(Name) -> - check_and_call(read_link, [file_name(Name)]). + check_and_call(read_link, [file_name(Name), get_dtrace_utag()]). -spec write_file_info(Filename, FileInfo) -> ok | {error, Reason} when Filename :: name(), @@ -238,7 +238,7 @@ read_link(Name) -> Reason :: posix() | badarg. write_file_info(Name, Info = #file_info{}) -> - check_and_call(write_file_info, [file_name(Name), Info]). + check_and_call(write_file_info, [file_name(Name), Info, get_dtrace_utag()]). -spec list_dir(Dir) -> {ok, Filenames} | {error, Reason} when Dir :: name(), @@ -246,7 +246,7 @@ write_file_info(Name, Info = #file_info{}) -> Reason :: posix() | badarg. list_dir(Name) -> - check_and_call(list_dir, [file_name(Name)]). + check_and_call(list_dir, [file_name(Name), get_dtrace_utag()]). -spec read_file(Filename) -> {ok, Binary} | {error, Reason} when Filename :: name(), @@ -254,7 +254,7 @@ list_dir(Name) -> Reason :: posix() | badarg | terminated | system_limit. read_file(Name) -> - check_and_call(read_file, [file_name(Name)]). + check_and_call(read_file, [file_name(Name), get_dtrace_utag()]). -spec make_link(Existing, New) -> ok | {error, Reason} when Existing :: name(), @@ -262,7 +262,7 @@ read_file(Name) -> Reason :: posix() | badarg. make_link(Old, New) -> - check_and_call(make_link, [file_name(Old), file_name(New)]). + check_and_call(make_link, [file_name(Old), file_name(New), get_dtrace_utag()]). -spec make_symlink(Name1, Name2) -> ok | {error, Reason} when Name1 :: name(), @@ -270,7 +270,7 @@ make_link(Old, New) -> Reason :: posix() | badarg. make_symlink(Old, New) -> - check_and_call(make_symlink, [file_name(Old), file_name(New)]). + check_and_call(make_symlink, [file_name(Old), file_name(New), get_dtrace_utag()]). -spec write_file(Filename, Bytes) -> ok | {error, Reason} when Filename :: name(), @@ -278,7 +278,7 @@ make_symlink(Old, New) -> Reason :: posix() | badarg | terminated | system_limit. write_file(Name, Bin) -> - check_and_call(write_file, [file_name(Name), make_binary(Bin)]). + check_and_call(write_file, [file_name(Name), make_binary(Bin), get_dtrace_utag()]). %% This whole operation should be moved to the file_server and prim_file %% when it is time to change file server protocol again. @@ -330,7 +330,7 @@ raw_write_file_info(Name, #file_info{} = Info) -> case check_args(Args) of ok -> [FileName] = Args, - ?PRIM_FILE:write_file_info(FileName, Info); + ?PRIM_FILE:write_file_info(FileName, Info, get_dtrace_utag()); Error -> Error end. @@ -363,7 +363,7 @@ open(Item, ModeList) when is_list(ModeList) -> [FileName | _] = Args, %% We rely on the returned Handle (in {ok, Handle}) %% being a pid() or a #file_descriptor{} - ?PRIM_FILE:open(FileName, ModeList); + ?PRIM_FILE:open(FileName, ModeList, get_dtrace_utag()); Error -> Error end @@ -384,7 +384,7 @@ open(Item, ModeList) when is_list(ModeList) -> case check_args(Args) of ok -> [FileName | _] = Args, - call(open, [FileName, ModeList]); + call(open, [FileName, ModeList, get_dtrace_utag()]); Error -> Error end @@ -430,7 +430,7 @@ advise(File, Offset, Length, Advise) when is_pid(File) -> R = file_request(File, {advise, Offset, Length, Advise}), wait_file_reply(File, R); advise(#file_descriptor{module = Module} = Handle, Offset, Length, Advise) -> - Module:advise(Handle, Offset, Length, Advise); + Module:advise(Handle, Offset, Length, Advise, get_dtrace_utag()); advise(_, _, _, _) -> {error, badarg}. @@ -440,17 +440,21 @@ advise(_, _, _, _) -> Data :: string() | binary(), Reason :: posix() | badarg | terminated. -read(File, Sz) when (is_pid(File) orelse is_atom(File)), is_integer(Sz), Sz >= 0 -> +read(File, Sz) -> + read(File, Sz, get_dtrace_utag()). + +read(File, Sz, _DTraceUtag) + when (is_pid(File) orelse is_atom(File)), is_integer(Sz), Sz >= 0 -> case io:request(File, {get_chars, '', Sz}) of Data when is_list(Data); is_binary(Data) -> {ok, Data}; Other -> Other end; -read(#file_descriptor{module = Module} = Handle, Sz) +read(#file_descriptor{module = Module} = Handle, Sz, DTraceUtag) when is_integer(Sz), Sz >= 0 -> - Module:read(Handle, Sz); -read(_, _) -> + Module:read(Handle, Sz, DTraceUtag); +read(_, _, _) -> {error, badarg}. -spec read_line(IoDevice) -> {ok, Data} | eof | {error, Reason} when @@ -466,7 +470,7 @@ read_line(File) when (is_pid(File) orelse is_atom(File)) -> Other end; read_line(#file_descriptor{module = Module} = Handle) -> - Module:read_line(Handle); + Module:read_line(Handle, get_dtrace_utag()); read_line(_) -> {error, badarg}. @@ -480,7 +484,7 @@ read_line(_) -> pread(File, L) when is_pid(File), is_list(L) -> pread_int(File, L, []); pread(#file_descriptor{module = Module} = Handle, L) when is_list(L) -> - Module:pread(Handle, L); + Module:pread(Handle, L, get_dtrace_utag()); pread(_, _) -> {error, badarg}. @@ -520,16 +524,19 @@ pread(_, _, _) -> Bytes :: iodata(), Reason :: posix() | badarg | terminated. -write(File, Bytes) when (is_pid(File) orelse is_atom(File)) -> +write(File, Bytes) -> + write(File, Bytes, get_dtrace_utag()). + +write(File, Bytes, _DTraceUtag) when (is_pid(File) orelse is_atom(File)) -> case make_binary(Bytes) of Bin when is_binary(Bin) -> io:request(File, {put_chars,Bin}); Error -> Error end; -write(#file_descriptor{module = Module} = Handle, Bytes) -> - Module:write(Handle, Bytes); -write(_, _) -> +write(#file_descriptor{module = Module} = Handle, Bytes, DTraceUtag) -> + Module:write(Handle, Bytes, DTraceUtag); +write(_, _, _) -> {error, badarg}. -spec pwrite(IoDevice, LocBytes) -> ok | {error, {N, Reason}} when @@ -541,7 +548,7 @@ write(_, _) -> pwrite(File, L) when is_pid(File), is_list(L) -> pwrite_int(File, L, 0); pwrite(#file_descriptor{module = Module} = Handle, L) when is_list(L) -> - Module:pwrite(Handle, L); + Module:pwrite(Handle, L, get_dtrace_utag()); pwrite(_, _) -> {error, badarg}. @@ -579,7 +586,7 @@ datasync(File) when is_pid(File) -> R = file_request(File, datasync), wait_file_reply(File, R); datasync(#file_descriptor{module = Module} = Handle) -> - Module:datasync(Handle); + Module:datasync(Handle, get_dtrace_utag()); datasync(_) -> {error, badarg}. @@ -591,7 +598,7 @@ sync(File) when is_pid(File) -> R = file_request(File, sync), wait_file_reply(File, R); sync(#file_descriptor{module = Module} = Handle) -> - Module:sync(Handle); + Module:sync(Handle, get_dtrace_utag()); sync(_) -> {error, badarg}. @@ -605,7 +612,7 @@ position(File, At) when is_pid(File) -> R = file_request(File, {position,At}), wait_file_reply(File, R); position(#file_descriptor{module = Module} = Handle, At) -> - Module:position(Handle, At); + Module:position(Handle, At, get_dtrace_utag()); position(_, _) -> {error, badarg}. @@ -617,7 +624,7 @@ truncate(File) when is_pid(File) -> R = file_request(File, truncate), wait_file_reply(File, R); truncate(#file_descriptor{module = Module} = Handle) -> - Module:truncate(Handle); + Module:truncate(Handle, get_dtrace_utag()); truncate(_) -> {error, badarg}. @@ -673,7 +680,7 @@ copy_int({SourceName, SourceOpts}, {DestName, DestOpts}, Length) check_and_call(copy, [file_name(SourceName), SourceOpts, file_name(DestName), DestOpts, - Length]); + Length, get_dtrace_utag()]); %% Filename -> open file; must open Source and do client copy copy_int({SourceName, SourceOpts}, Dest, Length) when is_list(SourceOpts), is_pid(Dest); @@ -736,45 +743,46 @@ copy_int(Source, Dest, Length) -> -copy_opened(Source, Dest, Length) +copy_opened(Source, Dest, Length, DTraceUtag) when is_integer(Length), Length >= 0; is_atom(Length) -> - copy_opened_int(Source, Dest, Length); -copy_opened(_, _, _) -> + copy_opened_int(Source, Dest, Length, DTraceUtag); +copy_opened(_, _, _, _) -> {error, badarg}. %% Here we know that Length is either an atom or an integer >= 0 %% (by the way, atoms > integers) -copy_opened_int(Source, Dest, Length) +copy_opened_int(Source, Dest, Length, DTraceUtag) when is_pid(Source), is_pid(Dest) -> - copy_opened_int(Source, Dest, Length, 0); -copy_opened_int(Source, Dest, Length) + copy_opened_int(Source, Dest, Length, 0, DTraceUtag); +copy_opened_int(Source, Dest, Length, DTraceUtag) when is_pid(Source), is_record(Dest, file_descriptor) -> - copy_opened_int(Source, Dest, Length, 0); -copy_opened_int(Source, Dest, Length) + copy_opened_int(Source, Dest, Length, 0, DTraceUtag); +copy_opened_int(Source, Dest, Length, DTraceUtag) when is_record(Source, file_descriptor), is_pid(Dest) -> - copy_opened_int(Source, Dest, Length, 0); -copy_opened_int(Source, Dest, Length) + copy_opened_int(Source, Dest, Length, 0, DTraceUtag); +copy_opened_int(Source, Dest, Length, DTraceUtag) when is_record(Source, file_descriptor), is_record(Dest, file_descriptor) -> - copy_opened_int(Source, Dest, Length, 0); -copy_opened_int(_, _, _) -> + copy_opened_int(Source, Dest, Length, 0, DTraceUtag); +copy_opened_int(_, _, _, _) -> {error, badarg}. %% Here we know that Source and Dest are handles to open files, Length is %% as above, and Copied is an integer >= 0 %% Copy loop in client process -copy_opened_int(_, _, Length, Copied) when Length =< 0 -> % atom() > integer() +copy_opened_int(_, _, Length, Copied, _DTraceUtag) + when Length =< 0 -> % atom() > integer() {ok, Copied}; -copy_opened_int(Source, Dest, Length, Copied) -> +copy_opened_int(Source, Dest, Length, Copied, DTraceUtag) -> N = if Length > 65536 -> 65536; true -> Length end, % atom() > integer() ! - case read(Source, N) of + case read(Source, N, DTraceUtag) of {ok, Data} -> M = if is_binary(Data) -> byte_size(Data); is_list(Data) -> length(Data) end, - case write(Dest, Data) of + case write(Dest, Data, DTraceUtag) of ok -> if M < N -> %% Got less than asked for - must be end of file @@ -784,7 +792,8 @@ copy_opened_int(Source, Dest, Length, Copied) -> NewLength = if is_atom(Length) -> Length; true -> Length-M end, - copy_opened_int(Source, Dest, NewLength, Copied+M) + copy_opened_int(Source, Dest, NewLength, Copied+M, + DTraceUtag) end; {error, _} = Error -> Error @@ -1273,3 +1282,6 @@ wait_file_reply(From, Ref) -> %% receive {'EXIT', From, _} -> ok after 0 -> ok end, {error, terminated} end. + +get_dtrace_utag() -> + prim_file:get_dtrace_utag(). diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 14da9c1..56049d6 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -21,7 +21,7 @@ %% A simple file server for io to one file instance per server instance. -export([format_error/1]). --export([start/3, start_link/3]). +-export([start/4, start_link/4]). -export([count_and_find/3]). @@ -43,18 +43,18 @@ format_error({_Line, Mod, Reason}) -> format_error(ErrorId) -> erl_posix_msg:message(ErrorId). -start(Owner, FileName, ModeList) +start(Owner, FileName, ModeList, DTraceUtag) when is_pid(Owner), (is_list(FileName) orelse is_binary(FileName)), is_list(ModeList) -> - do_start(spawn, Owner, FileName, ModeList). + do_start(spawn, Owner, FileName, ModeList, DTraceUtag). -start_link(Owner, FileName, ModeList) +start_link(Owner, FileName, ModeList, DTraceUtag) when is_pid(Owner), (is_list(FileName) orelse is_binary(FileName)), is_list(ModeList) -> - do_start(spawn_link, Owner, FileName, ModeList). + do_start(spawn_link, Owner, FileName, ModeList, DTraceUtag). %%%----------------------------------------------------------------- %%% Server starter, dispatcher and helpers -do_start(Spawn, Owner, FileName, ModeList) -> +do_start(Spawn, Owner, FileName, ModeList, DTraceUtag) -> Self = self(), Ref = make_ref(), Pid = @@ -63,11 +63,12 @@ do_start(Spawn, Owner, FileName, ModeList) -> %% process_flag(trap_exit, true), case parse_options(ModeList) of {ReadMode, UnicodeMode, Opts} -> - case ?PRIM_FILE:open(FileName, Opts) of + case ?PRIM_FILE:open(FileName, Opts, DTraceUtag) of {error, Reason} = Error -> Self ! {Ref, Error}, exit(Reason); {ok, Handle} -> + put(dtrace_utag, DTraceUtag), % TODO: API? %% XXX must I handle R6 nodes here? M = erlang:monitor(process, Owner), Self ! {Ref, ok}, diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 64c61ba..851532b 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -76,6 +76,7 @@ stop() -> init([]) -> process_flag(trap_exit, true), + put(dtrace_utag, atom_to_list(?FILE_SERVER)), case ?PRIM_FILE:start() of {ok, Handle} -> ets:new(?FILE_IO_SERVER_TABLE, [named_table]), @@ -99,9 +100,9 @@ init([]) -> {'reply', 'eof' | 'ok' | {'error', term()} | {'ok', term()}, state()} | {'stop', 'normal', 'stopped', state()}. -handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle) +handle_call({open, Name, ModeList, DTraceUtag}, {Pid, _Tag} = _From, Handle) when is_list(ModeList) -> - Child = ?FILE_IO_SERVER:start_link(Pid, Name, ModeList), + Child = ?FILE_IO_SERVER:start_link(Pid, Name, ModeList, DTraceUtag), case Child of {ok, P} when is_pid(P) -> ets:insert(?FILE_IO_SERVER_TABLE, {P, Name}); @@ -110,78 +111,80 @@ handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle) end, {reply, Child, Handle}; -handle_call({open, _Name, _Mode}, _From, Handle) -> +handle_call({open, _Name, _Mode, _DTraceUtag}, _From, Handle) -> {reply, {error, einval}, Handle}; -handle_call({read_file, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_file(Name), Handle}; +handle_call({read_file, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:read_file(Name, DTraceUtag), Handle}; -handle_call({write_file, Name, Bin}, _From, Handle) -> - {reply, ?PRIM_FILE:write_file(Name, Bin), Handle}; +handle_call({write_file, Name, Bin, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:write_file(Name, Bin, DTraceUtag), Handle}; -handle_call({set_cwd, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:set_cwd(Handle, Name), Handle}; +handle_call({set_cwd, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:set_cwd(Handle, Name, DTraceUtag), Handle}; -handle_call({delete, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:delete(Handle, Name), Handle}; +handle_call({delete, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:delete(Handle, Name, DTraceUtag), Handle}; -handle_call({rename, Fr, To}, _From, Handle) -> - {reply, ?PRIM_FILE:rename(Handle, Fr, To), Handle}; +handle_call({rename, Fr, To, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:rename(Handle, Fr, To, DTraceUtag), Handle}; -handle_call({make_dir, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:make_dir(Handle, Name), Handle}; +handle_call({make_dir, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:make_dir(Handle, Name, DTraceUtag), Handle}; -handle_call({del_dir, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:del_dir(Handle, Name), Handle}; +handle_call({del_dir, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:del_dir(Handle, Name, DTraceUtag), Handle}; -handle_call({list_dir, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:list_dir(Handle, Name), Handle}; +handle_call({list_dir, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:list_dir(Handle, Name, DTraceUtag), Handle}; handle_call(get_cwd, _From, Handle) -> - {reply, ?PRIM_FILE:get_cwd(Handle), Handle}; -handle_call({get_cwd}, _From, Handle) -> - {reply, ?PRIM_FILE:get_cwd(Handle), Handle}; -handle_call({get_cwd, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:get_cwd(Handle, Name), Handle}; + {reply, ?PRIM_FILE:get_cwd(Handle, no_drive, "TODO-fixme"), Handle}; +handle_call({get_cwd, no_drive, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:get_cwd(Handle, no_drive, DTraceUtag), Handle}; +handle_call({get_cwd, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:get_cwd(Handle, Name, DTraceUtag), Handle}; -handle_call({read_file_info, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_file_info(Handle, Name), Handle}; +handle_call({read_file_info, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:read_file_info(Handle, Name, DTraceUtag), Handle}; -handle_call({altname, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:altname(Handle, Name), Handle}; +handle_call({altname, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:altname(Handle, Name, DTraceUtag), Handle}; -handle_call({write_file_info, Name, Info}, _From, Handle) -> - {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info), Handle}; +handle_call({write_file_info, Name, Info, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, DTraceUtag), Handle}; -handle_call({read_link_info, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_link_info(Handle, Name), Handle}; +handle_call({read_link_info, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link_info(Handle, Name, DTraceUtag), Handle}; -handle_call({read_link, Name}, _From, Handle) -> - {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; +handle_call({read_link, Name, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link(Handle, Name, DTraceUtag), Handle}; -handle_call({make_link, Old, New}, _From, Handle) -> - {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle}; +handle_call({make_link, Old, New, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:make_link(Handle, Old, New, DTraceUtag), Handle}; -handle_call({make_symlink, Old, New}, _From, Handle) -> - {reply, ?PRIM_FILE:make_symlink(Handle, Old, New), Handle}; +handle_call({make_symlink, Old, New, DTraceUtag}, _From, Handle) -> + {reply, ?PRIM_FILE:make_symlink(Handle, Old, New, DTraceUtag), Handle}; -handle_call({copy, SourceName, SourceOpts, DestName, DestOpts, Length}, +handle_call({copy, SourceName, SourceOpts, DestName, DestOpts, Length, DTraceUtag}, _From, Handle) -> Reply = - case ?PRIM_FILE:open(SourceName, [read, binary | SourceOpts]) of + case ?PRIM_FILE:open(SourceName, [read, binary | SourceOpts], + DTraceUtag) of {ok, Source} -> SourceReply = case ?PRIM_FILE:open(DestName, - [write, binary | DestOpts]) of + [write, binary | DestOpts], + DTraceUtag) of {ok, Dest} -> DestReply = - ?PRIM_FILE:copy(Source, Dest, Length), - ?PRIM_FILE:close(Dest), + ?PRIM_FILE:copy(Source, Dest, Length, DTraceUtag), + ?PRIM_FILE:close(Dest, DTraceUtag), DestReply; {error, _} = Error -> Error end, - ?PRIM_FILE:close(Source), + ?PRIM_FILE:close(Source, DTraceUtag), SourceReply; {error, _} = Error -> Error EOFEOFEOFEOFEOFEOFEOFEOF mkdir -p lib/dtrace/ebin uudecode -o ./erts/preloaded/ebin/prim_file.beam <<'ENDOFDAFILEENDOFDAFILE' begin 664 - M1D]2,0``1G1"14%-071O;0``!C4```"B"7!R:6U?9FEL901O<&5N!'1R=64& M97)L86YG"6ES7V)I;F%R>0=I6YC!'-Y;F,)0-R87<.;'-E M96M?<&]S:71I;VX#8F]F`V-U09D979I M8V4%;W1H97(+9FEL95]A8V-E71EY`!!-` M`R-`%`,%,$4@`3`"$B(P`4`W50-`,C,]90%0"J4``S,!8`JE$!-#-W4C0#)3 M/84!<`JE`"-3`8`KI3,R*Z5#,BNE4S(,(#!``Q1`$P-`(P0$$"UP.94#.I4# M,!`P$$(#`!-"`Q`C0@,@,T8@`T='`$M``P1`)`,$$"WQ$&`010,"(T4$(R-%%",3$001%$!$`P0@+5$Y M#18#.@T6`R!"`P`30@,0(RL-%A.20",30#0C0"0S0$0#!4`-&5`!"!9``Q-` M1`-`$T2(0!`$$"U)0`0#$A`3`0@72@,!"!@"$K)``0@9.`T;(PQ00$$C!$1` M`S1`,P-``Q1`$R0$$"WQ$$`010,"(T4$(Q,1!$`T`P0@+5$K#1H#DD!$(T`D M$T`4,T`T`P5`#1E0`0@:0`-$0#0#B$`0!!`M24`$`Q(0$P$(&S0-&",0H"!& M("-'`T<31C`31\)'$D`A+2(`$('SD-(P,Z#2,#,$(#`"-"`Q`S0@,@0RL-(R/" M*PTC,Q(Y#2-#.@TC0R!"0P!3-PT@$ST-(0$((#4-(Q,!""$,$&!`$P-`4P0$ M$"WQ$$`010,"(T5'(",30`0#!"`M42L-(@.20`0#!1`M21`!""(2$!,!"",S M#1X#!A`M20$()`(2XD`!""4,0$!`,P1`(Q1`$R1``S0$`"WN0!0C0`0S0"03 M0`-#0#0#!5`-)T`!""8"$N)0`0@G.0TF`SH-)@,P0@,`4T(#$&-"`R!S*PTF M4\(K#29C$CD-)G,Z#29S($)S`(,W#2A#/0TI`0@H-0TF0P$(*0Q`D$!#`T`S M!$`C%$`3)$"#-`00+?$'$#`P#3`$.P0-,!?`"A`-*@H1#2L*$@TL"A,-+0H4 M#2X*%0TO`0@J0`$3?`4@0`,C;P43(Q`3;P43"140$VT%$P`0`!-<$!!9!0E` M$$`D604)0!!`%%Q`(%H%"A>```-`-`,%("U10`$(*T`!$WP%($`#(V\%$R,0 M$V\%$PD5$!-M!1,`$``37!`0604)0!!`)%D%"4`00!1<0&!:!0H7@``#0#0# M!2`M44`!""Q``1-\!2!``R-O!1,C$!-O!1,)%1`3;043`!``$UP0$%D%"4`0 M0"19!0E`$$`47$"@6@4*%X```T`T`P4@+5%``0@M0`$3?`4@0`,C;P43(Q`3 M;P43"140$VT%$P`0`!-<$!!9!0E`$$`D604)0!!`%%Q`X%H%"A>```-`-`,% M("U10`$(+D`!$WP%($`#(V\%$R,0$V\%$PD5$!-M!1,`$``37!`0604)0!!` M)%D%"4`00!1<0`@26@4*%X```T`T`P4@+5%``0@O0`$3?`4@0`,C;P43(Q`3 M;P43"140$VT%$P`0`!-<$!!9!0E`$$`D604)0!!`%%Q`"!9:!0H7@``#0#0# M!2`M44`!"#!`1S`#$D`3`0@Q`A(*&"`!"#(,("!`$P1``Q0$`"WN0`030`,C M0!0#!3`--"`!"#,"$@H8,`$(-#D-,P,Z#3,#,$(#`#-"`Q!#0@,@4RL-,S/" M*PTS0Q(Y#3-3.@TS4R!"4P!C-PTU(ST--@$(-34-,R,!"#8,('!`(P-`$P1` M8Q0$$"WQ$&`0100"(T4#(R-%02,30!0#$001%`0@+5$Y#3<#.@TW`R!"`P`3 M*PTW$Y)`D@,2(!,!"#<2(!,!"#@"$@H9(`$(.3D-.`,Z#3@#,$(#`"-"`Q`S M0@,@0RL-."/"*PTX,Q(Y#3A#.@TX0R!"0P!3-PTX$PP@8$`3!$!3%`0`+>Y` M`C-``2-``D-`!!-``U-`%`,%8`T[(`$(.@(2"AI@`0@[.`T^$T$38W,Y#3UC M.@T]8R!"8P"#0F,0DRT-/8,H#3R#V8``````````)PT\@_D``(`````````` M0)-C0',30%-S0(-3!H`-0@$(/$!',`,3`0@]0$<0`Q,!"#XT#3H3*PT_(P$T M#3\S-`T_0T"2`Q,!"#\,0&!``S1`4P-`(P1`,Q1`0R0$$"WQ;05``!``$UD% M"2`0``1``R-`%`-`$P1`(Q0$$"WG$(`010,"`T4$`P-%%`,314=`$P,1!!$4 M!Q!00`,30"0#0!,D!!`MYQ`@$$4D`Q-`-`,1)!$T!"`M3SD-0`,Z#4`#($(# M`!,K#4`3DD"2`Q)`$P$(0!)`$P$(00(2"AJ``0A"-0U#8WP%@$!C@WT%D&`C M$2-M!0@00)``DUD%"4`00%-9!0E`$`"#19,S,T5C0T-`0`$(4B@-5!/9@``````````G#503^0``@``````````,`$!` M$U-``D-`(V-``2-`,W-``C-``A,$@`U".0U3`SH-4P,@0@,`$T(#$",K#5,3 MY``Q-`!`,%(`U8$`$(5P(2"A\@`0A8.0U7`SH- M5P,P0@,`(T(#$#-"`R!#*PU7(\(K#5(Q-`!`,%("U1$`$( M6P(2"B`0`0A<#!`00`,$!``M[D`#$T`$`P4@#5X0`0A=`A(*("`!"%XY#5T# M.@U=`S!"`P`C0@,0,T(#($,K#5TCPBL-73,2.0U=0SH-74,@0D,`4S<-7Q,] M#6`!"%\U#5T3`0A@#!!@0!,#0%,$!!`M\1!`$$4#`B-%D2,30`0#!2`M41`! M"&$"$@HA$`$(8@P0$$`#!`0`+>Y``Q-`!`,%(`UD$`$(8P(2"B$@`0AD.0UC M`SH-8P,P0@,`(T(#$#-"`R!#*PUC(\(K#6,S$CD-8T,Z#6-#(`P04$)#``1` M$P,$$"WQ$$`010,"(T5'4",30`0#!"`M43D-:0,Z#6D#($(#`!-"`Q`C,`UI M$SL3#6D70)(-97(-9@$(93D-:2,Z#6DC($(C`#-"(Q!#+`UG,P$]#6@!"&8K M#6DC"B('`(!`1U`30`0#$00$("U1.0UI`SH-:0,@0@,`$T(#$",K#6D3DCD- M:2,Z#6DC($(C`#-"(Q!#*PUH,P$!"&=`"B0#$A`3`0AH$#!01B`#1Y)'0Q(0 M$P$(:1(0$P$(:@(2"B4@`0AK#"`@0!,$0`,4!``M[D`$$T`#(T`4`P4P#6T@ M`0AL`A(*)3`!"&TY#6P#.@UL`S!"`P`S0@,00T(#(%,K#6PSPBL-;$,2.0UL M4SH-;%,@0E,`8PH-;'`321T,20!,!"'020!,!"'5`1S`#$D`3`0AV M`A(*)R`!"'2`! M"'@"$@HH4`$(>3@-?!-!$U-C.0U[4SH->U,@0E,`X,!"PUZD-F``````````',3"PUZH'/Y``"``````````%,+#7J@@_D``(`` M````````DPL->K!3DU,+#7JP$U,3*PUZ$S)]!9!@(Q$3;04($""0`"-9!0E` M$$!S604)0!``@T4C,S-`$R-`8Q,&4`UY`0AZ0$!,K#7TC`30-?3-`1V`#$P$(?0PP4$`#)$!#`T`C!$`S%`00+?%M!8``$``3 M7$`(%ED%"2`0``1``R-`%`-`$P1`(Q0$$"WG$(`010,"(T4$(R-%%",C14=P M(Q-`)`,%("U1,`$(?@(2"BY``2-``C-`!!-``T-`%`,%4`UY M(`$(@BT-?A,M#7XC*`U^(P$,,#!`(P1`$Q1``R0$`"WN0`0C0!030`,S0"0# M!4`-A#`!"(,"$@HG0`$(A#D-B@,Z#8H#,$(#`$-"`Q!30@,@8RL-BD/"*PV* M4Q(Y#8IC.@V*8R!"8P!S-PV%,ST-A@$(A34-BC,!"(8.,(`H#8D3V8`````` M````)PV)$_D``(``````````)PV)(_D``(``````````0#,#0",$0!,40',D M!!`M\6T%"!A@$``37(`(&ED%"4`00!19!0E`$``$11,"(T4#(R-%1W`C$T`D M`Q$$$101)`0@+5$Y#8@#.@V(`R!"`P`30@,0(RL-B!.2.`V((T$C,T,K#80$T`* M,0,',.!`)"-`%!-`-#-`!`,(0/!``0BB`A(*-C`!"*,,,#!`(P1`$Q1``R0$ M`"WN0`0C0!030`,S0"0#!4`-I3`!"*0"$@HV0`$(I3D-I`,Z#:0#,$(#`$-" M`Q!30@,@8RL-I$/"*PVD4Q(Y#:1C.@VD8R!"8P!S"@VHT".#-PVF,T`RDST- MIP$(I@H-J``SDP$(IRL-J(,R*PVHDS)`67____\C!C`-HP$(J`H-K'`3@PH- MK'`CDS<-J3-`,J,]#:H!"*D*#:P`,Z,!"*HK#:R#,BL-K),R*PVLHS(.((`H M#:L3V8``````````)PVK$_D``(``````````*`VK(P$G#:LC>0"`````;07@ M`(```UP@"")9!0E`$``3604)(!``(T`#!$`S`T!S%`00+?$00!!%`P(C100C M$T`4`P4@+5$@`0BK0$Y``Q-`!`,%(`VS$`$(L4!'$`,3`0BR`A(* M-R`!"+,W#;0#0#(C/0VU`0BT"@VZ``,C`0BU-PVV$T`R,ST-MP$(M@H-N@`3 M,P$(MRL-NB,R*PVZ,S(,("!``Q1`$P1`1Z`30$<``P0@+44Y#;L#.@V[`R!" M`P`30@,0(S`-NQ,[$PV[%T"2#;AR#;D!"+A`%!-`(P-`!"-``Q2($!`$,`V] M0`,30`0#0!,$!!`-'4`$`Q(0$P$(N1(@$P$(ND!'$`,3`0B[2@,!"+P"$@HW M,`$(O0H-P0@0`S,W#;X30#)#/0V_`0B^"@W!`!-#`0B_*PW!,S(K#<%#,@P@ M,$`#%$`3`T`C!`00+>M``Q-`!`-`$P0$$"WQ$$`010,"$T4$$P,1!`<04!`@ M$$7Q`Q-`$P1`%`,$("U1*PW``T>P!P"`0`030!0#!2`M42`!",`2(!,!",%` M1Q`#$P$(P@(2"CD@`0C##"`@0!,$0`,4!``M[D`$$T`#(T`4`P4P#<4@`0C$ M`A(*.3`!",4W#<8#0#(S/0W'`0C&"@W+``,S`0C'-PW((T`R0ST-R0$(R`H- MRP`C0P$(R2L-RS,R*PW+0S(,(#!``P1`$Q1`(Q-`"CH#!R`($4`#(T!'P!-` M!`-`(P0$("4Y#21P-`$P,2$!,!",YJ!"L-SP-R$#`@1B`#1W)'$Q(0 M$P$(SVPC$Q(0$P$(T`(2"CX0`0C1,PW0`PX0$&@$#=('$`@3:01`D@,2$!,! M"-)J!$"2`Q(0$P$(TP(2"D```0C4#```!``M[D`#$T`!`P4@#>0``0C5`A(* M0!`!"-8S#=<##!`00`,$!``M[D`!$T`#(T`$`P4P#>80`0C7.`W:`T$#$R,X M#=DC02,S0RL-V3,).B@-V!,)82@-V`EZ$PX0('T%(`@4$PEA`WT%(&`#$00$ M`"WN0`,30`0#!2`-Y!`!"-@H#=D3"4$H#=D)6A,.$"!]!2`(%!,)00-]!2!@ M`Q$$!``M[D`#$T`$`P4@#>00`0C90$0``0C;0$<0`Q,!"-P"$@I`,`$(W3@-X!-!$S-#.`W?0T%#4V,K#=]3 M"3HS#>(#*`W>,PEA*`W>"7HS?05`"!0S"6$3?05`8!,1$P8P#>8!"-XS#>(# M*`W?,PE!*`W?"5HS?05`"!0S"4$3?05`8!,1$P8P#>8!"-\S#>(#0$$3*PWB$PI",PWB`T`!$P8P#>8!".$T#>(3,PWB`T`!$P8P#>8!".)` M1Q`#$P$(XP(2"D,@`0CD0!,C0`,30$?@`P8P#>8!".4"$@I#,`$(Y@P@,$`# M%$`C`T`3!`00+?$08!!%`P(#100#$T5A$P.($!`'$%!``Q-`!`,%("U1$`$( MYP(2"D00`0CH#!`00`,$!``M[D`$$T`#(T!'X`,%,`WL$`$(Z0(2"D0P`0CJ M,PWI`P8P#>P!".L"$@I%,`$([`Q`,#XT#>Y`$P1`(Q1``R0'``@5*PWM`PI( M0`$30`(C0"0#!#`-YCD-[0,Z#>T#($(#`!-"`Q`C*PWM$Y)`(Q-`!`,1!`<@ M"!8]#>X!".U`!`,!".X_-(@0,`00+>M``R1`!`.($"`$$"WQ$&`010,"(T44 M(R-%@2,30`0#!2`M42`!".\"$@I+$`$(\`P0$$`#!`0`+>Y`!!-``R-`1^`# M!3`-]A`!"/$"$@I+(`$(\C,-\0,,("!`$P1``Q0$`"WN0`030`,C0!0#!3`- M]B`!"/,"$@I+,`$(]#,-\P,&,`WV`0CU`A(*3#`!"/8,(#!``Q1`$P-`(P0$ M$"WK0`,30`0#0!,$!!`M\1!@$$4#`B-%!",C1;$C$T`4`P4@+5$@`0CW`A(* M32`!"/@,("!`$P1``Q0$`"WN0`0C0!030`,S0$?@`P5`#?X@`0CY`A(*33`! M"/HS#?D###`P0",$0!,40`,D!``M[D`$(T`4$T`#,T`D`P5`#?XP`0C[`A(* M34`!"/PS#?L#!D`-_@$(_0(2"DY``0C^##!`0`,D0!,#0",$0#,4!!`MZT`# M$T`$`T`3!`00+>M``Q-`%`-`$Q0$$"WQ$(`010,"(T44(R-%!",C1<$C$T`D M`P4@+5$P`0C_`A(*3Q`!*``,$!!``P0$`"WN0`030`,C0$?@`P4P+000`2@! M`A(*3S`!*`(S+0$#!C`M!`$H`P(2"E`P`2@$#"`P0`,40!,#0",$!!`MZT`# M$T`$`T`3!`00+?$08!!%`P(C100C(T6A(Q-`%`,%("U1(`$H!0(2"E$0`2@& M#!`00`,$!``M[D`$$T`#(T!'X`,%,"T*$`$H!P(2"E$P`2@(,RT'`P8P+0H! M*`D"$@I2,`$H"@P@,$`#%$`3`T`C!`00+>M``Q-`!`-`$P0$$"WQ$&`010," M(T4$(R-%T2,30!0#!2`M42`!*`L"$@I3$`$H#`P0$$`#!`0`+>Y`!!-``R-` M1^`#!3`M$A`!*`T"$@I3(`$H#C,M#0,,("!`$P1``Q0$`"WN0`030`,C0!0# M!3`M$B`!*`\"$@I3,`$H$#,M#P,&,"T2`2@1`A(*5#`!*!(,(#!``Q1`$P-` M(P0$$"WK0`,30`0#0!,$!!`M\1!@$$4#`B-%!",C15$C$T`4`P4@+5$@`2@3 M`A(*51`!*!0,$!!``P0$`"WN0`030`,C0$?@`P4P+1@0`2@5`A(*53`!*!8S M+14#!C`M&`$H%P(2"E8P`2@8#"`P0`,40!,#0",$!!`MZT`#$T`$`T`3!`00 M+?$08!!%`P(C100C(T4)'",30!0#!2`M42`!*!D"$@I7(`$H&@P@($`3!$`# M%`0`+>Y`!"-`%!-``S-`1^`#!4`M'B`!*!L"$@I70`$H'#,M&P,&0"T>`2@= M`A(*6$`!*!XY+1TC.BT=(^!"(P!#0B-`4T(C4&-"(V!S0B-P@T(CP)-"(]"C M*RT=0PI9#("P$01`@Q1`DR1`HS1`M``Q-`9`-`$V0$$"WQ$`@2$$4#`B-%9",C150C(T5$(R-%%",C100C(T4T M(R-%)",C10D0(Q-`=`,%("U1@`$H(@(2"EP@`2@C#"`@0!,$0`,4!``M[D`$ M(T`4$T`#,T!'X`,%0"TI(`$H)`(2"EPP`2@E,RTD`PPP,$`C!$`3%$`#)`0` M+>Y`!"-`%!-``S-`)`,%0"TI,`$H)@(2"EQ``2@G,RTF`P9`+2D!*"@"$@I= M0`$H*0PP0$`#)$`3`T`C!$`S%`00+>M``Q-`!`-`$P0$$"WK0`,30!0#0!,4 M!!`M\1"`$$4#`B-%%",C100C(T4)%2,30"0#!2`M43`!*"H"$@I>(`$H*PP@ M($`3!$`#%`0`+>Y`!"-`%!-``S-`1^`#!4`M,2`!*"P"$@I>,`$H+3,M+`,, M,#!`(P1`$Q1``R0$`"WN0`0C0!030`,S0"0#!4`M,3`!*"X"$@I>0`$H+S,M M+@,&0"TQ`2@P`A(*7T`!*#$,,$!``R1`$P-`(P1`,Q0$$"WK0`,30`0#0!,$ M!!`MZT`#$T`4`T`3%`00+?$0@!!%`P(C110C(T4$(R-%"18C$T`D`P4@+5$P M`2@R`A(*8!`!*#,,$!!``P0$`"WN0`030`,C0$?@`P4P+3<0`2@T`A(*8#`! M*#4S+30#!C`M-P$H-@(2"F$P`2@W#"`P0`,40!,#0",$!!`MZT`#$T`$`T`3 M!`00+?$08!!%`P(C100C(T4)%",30!0#!2`M42`!*#@"$@IB$`$H.0P0$$`# M!`0`+>Y`!!-``R-`1^`#!3`M/1`!*#H"$@IB,`$H.S,M.@,&,"T]`2@\`A(* M8S`!*#T,(#!``Q1`$P-`(P0$$"WK0`,30`0#0!,$!!`M\1!@$$4#`B-%!",C M10D3(Q-`%`,%("U1(`$H/@(2"F00`2@_#!`00`,$!``M[D`$$T`#(T!'X`,% M,"U#$`$H0`(2"F0P`2A!,RU``P8P+4,!*$("$@IE,`$H0PP@,$`#%$`3`T`C M!`00+>M``Q-`!`-`$P0$$"WQ$&`010,",T4$,S-%<3,30`(C0!0#!3`M4R`! M*$0"$@IF(`$H10X0(&@$+480,"!&("-'"F='`T`C`P<@"!)I!!`P$$8@$T>2 M1P-`$P,2$!,!*$9J!"LM1P-R$#`@1B`#1W)'$Q(0$P$H1VPC$Q(0$P$H2`(2 M"F@0`2A)#B`0:!0M2D`#!`<0"!-I%#TM2P$H2FH4+"U+`W)L(Q,!*$L7+4T# M.2U,`SHM3`,P0@,`$T(#$",K+4P3"FDK+4PC!!5`D@,2(!,!*$P8+4L!*$T6 M0)(#$B`3`2A.`A(*:B`!*$]`"EHS0`HP(P9`+5@!*%`"$@IK(`$H44`*6B,& M,"U3`2A2`A(*:S`!*%,U+5030",S0#(C!D`M6`$H5`Y`,&@T+55``R1`$P-` M(P1``Q0'$`@8:31`,B-`%!-`!#-`)`,%0"U80`$H56HT*RU6`W(0,"!&(`-' MRUY"GPM>@H8+7L*)2U\"G@M?0IW+7X*?2U_"GXM@`$H>'T%8`@<$PD0 M$T!3`P9`+7,!*'E]!6`('!.!$T!3`P9`+7,!*'I]!6`('!-!`WT%8`@<`R$3 M0%,#!D`MWT%8`@<$R$30%,#!D`M=``Q-`!`-`$P0$ M$"WG$$`01C`31Q1'!$<#0!,#$B`3`2B"0`IN`Q,!*(,"$@I_$`$HA"TMA0,0 M,!!&(!-'"H!'`T`3`P80+80!*(4Y+8D#.BV-`R!"`P`30@,0(S`MC1,[$RV- M%V`*)"V&"H$MAPJ`+8@!*(8M+8TC$#`P1B`#1R-'(1,!*( M42V?82V@(2VA,2VB`2B0="V1$R``(W4ME",P"4`0`#.$+90C"$`(%G4ME"-` M"4`0`$-Y+90C`!!P4$8P$T=#1S-'"B1&(`-'DD<3$P$HD3@ME!-!$R,S="V4 M(T`00W4ME$-0"4`0`%-U+91#8`E`$`!C>D,`*RV38P%U+91#<`E`$`!S>2V2 M0P`K+:,S1P@4$'"`1C`31W-'4T<*)$8@`T>21Q,3`2B2>T,``2B3=2V40W`) M0!``21Q,3`2B4-RVC$PY` M($`#-$`3`T`#)`00+<(Y+:0#.BVD`R!"`P`40@,0`P00+<(Y+:0#.BVD`R!" M`P`$0@,0`P00+<(Y+:0#.BVD`R!"`P`30@,0(RLME@0!-"V5(Q!P($8P(T<3 M1Q1'"B1&(`-'DD$PP`($`3`P<0"!T0,!!&(!-' MDD<#0!,#$@`3`2B:-"VC$T"2`Q,!*)LT+:,30`HD`Q,!*)PW+:,3#``@0!,# M!Q`('A`P$$8@$T=R1P-`$P,2`!,!*)TW+:,3#``@0!,#!!`MQP00+:80,!!& M(!-'DD<#0!,#$@`3`2B>$#`@1B`#1Y)'$Q,!*)\.$"!`$P,$$"W".2VD`SHM MI`,@0@,`!$(#$`,'$`@>$&`01B`31P1'`T8@`T=R1Q,2$!,!**`,`"!`$P,$ M$"W*$#`01B`31Y)'`T`3`Q(`$P$HH0P`($`3`P00+<(Y+:0#.BVD`R`0,!!& M(!-'DD<#0!,#$@`3`2BB#``@0!,#!!`MPCDMI`,Z+:0#($(#`!-"`Q`C-"VD M(Q`P($8@`T>21Q,2`!,!**,0@"!%`Q,#1B`31PIS1P-&(`-'0$``````WT%<&`#,P,X+:IC06,3(S@MJB-!(S-#."VJ0T%#,C0S@MJ4-!0V.#."VI@T&#H\,X+:G# M0,+$`L2."VH"Q)!"Q(+%0L6."VH"Q9!"Q8+%PL8."VH"QA!"Q@+ M&0L:."VG"QI!"QJ#XS@MI^-!XPL2"Q0X+:<+%$$+%`L6"Q@X+:<+&$$+&`L; M"QPX+:<+'$$+'`L="QXX+:<+'D$+'@L?"R`X+:<+($$+(`LA"R(X+:<+(D$+ M(@LC"R0T+:<+)$`##!-`4P-`"R,$0#,40',D0!,T0)-$0+-40--D0"-T0&.$ M0*.40/.D0`L1M$`+$\1`0]1`P^1`"Q#T0`L5#!!`"Q<,$4`+&0P20(,,%$`+ M$@P50`L6#!9`"QL,%T`+'0P80`L?#!E`"R$,&@00+:U``Q-`!`-`$P0$$"VT M$`@P$$8P$T$1Y1&,"-'I$>T M1\1&($-'$T`02VN M,2VO(2VP$2VQ`2BN0`J(`Q,!**]`"HD#$P$HL$`*B@,3`2BQ0`J+`Q,!*+)` M"HP#$P$HLP(2"HT0`2BT+2VS`SL#+;,7@!$MM3$MMB$MMP$MN`$HM4`*&`,3 M`2BV0`J.`Q,!*+=`"B4#$P$HN$`*CP,3`2BY`A(*D!`!*+HM+;L#;05``!`` M$UD%"2`0``-`$P,3`2B[*RVY`PI:0$<(%0,3`2B\`A(*D1`!*+TY+;X#.BV\ M`R!"`P`30@,0(SDMO!,Z+;P3,$(3`#-"$Q!#0A,@4SDMO",Z+;PC,$(C`&-" M(Q!S0B,@@VT%"!@`D``#604)(!``,UD%"2`0`$-9!0D@$`!3604)(!``8UD% M"2`0`'-9!0D@$`"#$P$HOBLMO`,*6D!'"!8#$P$HOP(2"I)``2C`?05`""`# M"1@#?05`""`3"1`3?05`"!P#$P-]!4`((".!$WT%0`@<`Q,#?05`"!P#,P,3 M`2C!`A(*E!`!*,(.$!`$$"W%.2W#`SHMPP,@0@,`!$(#$`,$$"W%.2W#`SHM MPP,@0@,`$T(#$"-]!3`((`0)(`-]!3`('`,3`Q`P,$8@$T<#1R-`$P,2$!,! M*,-(`P$HQ`(2"I40`2C%."W$`T$#$R,X+<0C02,S0S@MQ$-!0U-C."W$8T%C M#0!,#$P$HQ@(2"I80`2C'."W(`T$#$R,X+<8C02,S M0S@MQD-!0U-C."W&8PP0<$%C2W6 M0P`K+=4C1P@40$<(%Q-`,P,&("WI`2C5>2W60P!\+=9@0"-C*RW68U,0($!% M(P(30#,#!B`MZ0$HUG0MV1-`$$-U+=E#4`E`$`!3>D,`*RW84P%W+=E#8`H7 M@`!C."W7(T$C`3`1!`($43`B-%`R,30`IN`TX@""$!*.`W+=T#+2W=$PP@($`" M(T`3!$`#%`0P+>,L+>$#"ID2(!,!*.$00`!%!`(#110#$T`*;@,((`@A(`$H MX@(2"I@P`2CC*RWD$P$,$#!``P1`(P,$$"WG$#`01B`31P-'!$`3`Q(0$P$H MY#@MY0-!`S-#?050"!03$0,0(%!%,R,C0`,30$,#!C`MXP$HY30MX@-`"ID# M$P$HY@(2"IH0`2CG0`(33B`((@$HZ`(2"IH@`2CI3B`((@$HZ@(2"IP0`2CK M#!`0/@0M[`<0"",!*.P_!!(0$P$H[0(2"IX``2CN"@4()`HZ`ST]<@;R/$3O),YB'?OMXH\)7+N2Z):K-OW5 M0K/Q]E7BF8OO,R]KWKC>>Z_1WL/#BZ:A'A@:&VEX*V:F9A4E1!4>\`G!1%TS M+VQF7",KBSA58B#MG'OPZ0```!X````$````4@```!H````(```` M0@```!H````&````.P````L````$````&4%T='(````H@VP````!:`)D``-V M