Update dtrace for changes in R15

9 files changed, 66 insertions, 43 deletions

diff --git a/lib/dtrace/c_src/Makefile b/lib/dtrace/c_src/Makefile
index f3320bb766..a65491d45d 100644
--- a/lib/dtrace/c_src/Makefile
+++ b/lib/dtrace/c_src/Makefile
@@ -1,4 +1,4 @@
 #
-# Invoke with GNU make or clearmake -C gnu.
+# Invoke with GNU make
 #
 include $(ERL_TOP)/make/run_make.mk
diff --git a/lib/dtrace/c_src/Makefile.in b/lib/dtrace/c_src/Makefile.in
index ed13684a95..831ce5ce75 100644
--- a/lib/dtrace/c_src/Makefile.in
+++ b/lib/dtrace/c_src/Makefile.in
@@ -72,7 +72,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/dtrace-$(VSN)
 # ----------------------------------------------------
 # Misc Macros
 # ----------------------------------------------------
-OBJS = $(OBJDIR)/dtrace$(TYPEMARKER).o
+before_DTrace_OBJS = $(OBJDIR)/dtrace$(TYPEMARKER).o
 ## NIF_MAKEFILE = $(PRIVDIR)/Makefile
 
 # Higher-level makefiles says that we can only compile on UNIX flavors
@@ -100,18 +100,17 @@ else
 DTRACE_USER_HEADER=
 endif
 
+DTRACE_OBJS =
 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_OBJS += $(OBJDIR)/dtrace_user.o
+$(OBJDIR)/dtrace_user.o: $(before_DTrace_OBJS) $(OBJDIR)/dtrace_user.h
 	dtrace -G -C \
 	  -s ./dtrace_user.d \
-	  -o $@ $(OBJS)
+	  -o $@ $(before_DTrace_OBJS)
 endif
 
+OBJS = $(before_DTrace_OBJS) $(DTRACE_OBJS)
+
 $(OBJDIR):
 	-@mkdir -p $(OBJDIR)
 
diff --git a/lib/dtrace/c_src/dtrace.c b/lib/dtrace/c_src/dtrace.c
index c9d25ece9c..90bb39a4b8 100644
--- a/lib/dtrace/c_src/dtrace.c
+++ b/lib/dtrace/c_src/dtrace.c
@@ -25,7 +25,6 @@
 #include "erl_nif.h"
 #include "config.h"
 #include "sys.h"
-#define DTRACE_DRIVER_SKIP_FUNC_DECLARATIONS
 #include "dtrace-wrapper.h"
 #ifdef  HAVE_DTRACE
 #include "dtrace_user.h"
@@ -144,8 +143,7 @@ static ERL_NIF_TERM user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM
 
     if (DTRACE_ENABLED(user_trace_i4s4)) {
 	dtrace_nifenv_str(env, procbuf);
-        get_string_maybe(env, argv[0], &utbuf,
-                         user_tagbuf, sizeof(user_tagbuf)-1);
+        get_string_maybe(env, argv[0], &utbuf, user_tagbuf, MESSAGE_BUFSIZ);
         if (! enif_get_int64(env, argv[1], &i1))
             i1 = 0;
         if (! enif_get_int64(env, argv[2], &i2))
@@ -154,14 +152,10 @@ static ERL_NIF_TERM user_trace_i4s4(ErlNifEnv* env, int argc, const ERL_NIF_TERM
             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);
+        get_string_maybe(env, argv[5], &mbuf1, messagebuf1, MESSAGE_BUFSIZ);
+        get_string_maybe(env, argv[6], &mbuf2, messagebuf2, MESSAGE_BUFSIZ);
+        get_string_maybe(env, argv[7], &mbuf3, messagebuf3, MESSAGE_BUFSIZ);
+        get_string_maybe(env, argv[8], &mbuf4, messagebuf4, MESSAGE_BUFSIZ);
 	DTRACE10(user_trace_i4s4, procbuf, utbuf,
 		 i1, i2, i3, i4, mbuf1, mbuf2, mbuf3, mbuf4);
 	return atom_true;
diff --git a/lib/dtrace/examples/dist.d b/lib/dtrace/examples/dist.d
index f37c827f14..550e10d363 100644
--- a/lib/dtrace/examples/dist.d
+++ b/lib/dtrace/examples/dist.d
@@ -30,13 +30,13 @@ erlang*:::dist-port_busy
 {
     printf("dist port_busy: node %s, port %s, remote_node %s, blocked pid %s\n",
            copyinstr(arg0), copyinstr(arg1), copyinstr(arg2), copyinstr(arg3));
-    blocked_procs[copyinstr(arg3)] = timestamp;
-}
-
-erlang*:::dist-port_busy
-{
-    printf("dist port_busy: node %s, port %s, remote_node %s, blocked pid %s\n",
-           copyinstr(arg0), copyinstr(arg1), copyinstr(arg2), copyinstr(arg3));
+    /*
+     * For variable use advice, see:
+     *    http://dtrace.org/blogs/brendan/2011/11/25/dtrace-variable-types/
+     *
+     * Howevever, it's quite possible for the blocked events to span
+     * threads, so we'll use globals.
+     */
     blocked_procs[copyinstr(arg3)] = timestamp;
 }
 
diff --git a/lib/dtrace/examples/port1.d b/lib/dtrace/examples/port1.d
index b82e783a14..204abbd3b8 100644
--- a/lib/dtrace/examples/port1.d
+++ b/lib/dtrace/examples/port1.d
@@ -99,10 +99,12 @@ erlang*:::port-command
 
 erlang*:::port-control
 {
-    cmd = driver_map[copyinstr(arg2), arg3];
-    cmd_str = (cmd == 0) ? "unknown" : cmd;
+    /* http://dtrace.org/blogs/brendan/2011/11/25/dtrace-variable-types/ */
+    this->cmd = driver_map[copyinstr(arg2), arg3];
+    this->cmd_str = (this->cmd == 0) ? "unknown" : this->cmd;
     printf("port control pid %s port %s port name %s command %d %s\n",
-	   copyinstr(arg0), copyinstr(arg1), copyinstr(arg2), arg3, cmd_str);
+	   copyinstr(arg0), copyinstr(arg1), copyinstr(arg2), arg3,
+           this->cmd_str);
 }
 
 /* port-exit is fired as a result of port_close() or exit signal */
diff --git a/lib/dtrace/examples/process-scheduling.d b/lib/dtrace/examples/process-scheduling.d
index 9e31da2774..79e9cc598c 100644
--- a/lib/dtrace/examples/process-scheduling.d
+++ b/lib/dtrace/examples/process-scheduling.d
@@ -31,5 +31,5 @@ erlang*:::process-unscheduled
 erlang*:::process-hibernate
 {
     printf("  Hibernate pid %s resume mfa %s\n",
-     copyinstr(arg0), copyinstr(arg1));
+           copyinstr(arg0), copyinstr(arg1));
 }
diff --git a/lib/dtrace/src/dtrace.erl b/lib/dtrace/src/dtrace.erl
index 45addafc53..6951c03215 100644
--- a/lib/dtrace/src/dtrace.erl
+++ b/lib/dtrace/src/dtrace.erl
@@ -14,8 +14,8 @@
 %%% 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
+%%% 1> dtrace:put_tag("GGOOOAAALL!!!!!").
+%%% true
 %%% 2> dtrace:init().
 %%% ok
 %%%
@@ -35,9 +35,13 @@
 %%% then the driver will ignore the user's input and use a default
 %%% value of 0 or NULL, respectively.
 
+-define(DTRACE_UT_KEY, '_dtrace_utag_@_@'). % Match prim_file:get_dtrace_utag()!
+
 -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([put_utag/1, get_utag/0]).
+
 -export([scaff/0]). % Development only
 -export([user_trace_i4s4/9]). % Know what you're doing!
 
@@ -68,7 +72,7 @@ available() ->
 
 -spec user_trace_s1(iolist()) -> true | false | error | badarg.
 
-user_trace_s1(Message) ->
+user_trace_s1(_Message) ->
     erlang:nif_error(nif_not_loaded).
 
 -spec user_trace_i4s4(iolist(),
@@ -176,8 +180,32 @@ p(I1, I2, I3, I4, S1, S2, S3, S4) when is_integer(I1), is_integer(I2), is_intege
       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).
+    UTag = get_utag(),
+    try
+        user_trace_i4s4(UTag, I1, I2, I3, I4, S1, S2, S3, S4)
+    catch
+        error:nif_not_loaded ->
+            false
+    end.
+
+-spec put_utag(undefined | iolist()) -> ok.
+
+put_utag(undefined) ->
+    put_utag(<<>>);
+put_utag(T) when is_binary(T) ->
+    put(?DTRACE_UT_KEY, T),
+    ok;
+put_utag(T) when is_list(T) ->
+    put(?DTRACE_UT_KEY, list_to_binary(T)),
+    ok.
+
+get_utag() ->
+    case get(?DTRACE_UT_KEY) of
+        undefined ->
+            <<>>;
+        X ->
+            X
+    end.
 
 %% Scaffolding to write tedious code: quick brute force and not 100% correct.
 
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
index a2e0d261ee..aecb9f7923 100644
--- a/lib/kernel/src/file.erl
+++ b/lib/kernel/src/file.erl
@@ -227,7 +227,7 @@ read_file_info(Name) ->
       Reason :: posix() | badarg.
 
 read_file_info(Name, Opts) when is_list(Opts) ->
-    check_and_call(read_file_info, [file_name(Name), Opts]).
+    check_and_call(read_file_info, [file_name(Name), Opts, get_dtrace_utag()]).
 
 -spec altname(Name :: name()) -> any().
 
@@ -249,7 +249,7 @@ read_link_info(Name) ->
       Reason :: posix() | badarg.
 
 read_link_info(Name, Opts) when is_list(Opts) ->
-    check_and_call(read_link_info, [file_name(Name),Opts]).
+    check_and_call(read_link_info, [file_name(Name),Opts, get_dtrace_utag()]).
 
 
 -spec read_link(Name) -> {ok, Filename} | {error, Reason} when
@@ -275,7 +275,7 @@ write_file_info(Name, Info = #file_info{}) ->
       Reason :: posix() | badarg.
 
 write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) ->
-    check_and_call(write_file_info, [file_name(Name), Info, Opts]).
+    check_and_call(write_file_info, [file_name(Name), Info, Opts, get_dtrace_utag()]).
 
 -spec list_dir(Dir) -> {ok, Filenames} | {error, Reason} when
       Dir :: name(),
@@ -1504,4 +1504,4 @@ wait_file_reply(From, Ref) ->
     end.
 
 get_dtrace_utag() ->
-    prim_file:get_dtrace_utag().
+    dtrace:get_utag().
diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl
index c917819508..82adc45795 100644
--- a/lib/kernel/src/file_server.erl
+++ b/lib/kernel/src/file_server.erl
@@ -146,7 +146,7 @@ handle_call({get_cwd, Name, DTraceUtag}, _From, Handle) ->
     {reply, ?PRIM_FILE:get_cwd(Handle, Name, DTraceUtag), Handle};
 
 handle_call({read_file_info, Name, DTraceUtag}, _From, Handle) ->
-    {reply, ?PRIM_FILE:read_file_info(Handle, Name, DTraceUtag), Handle};
+    {reply, ?PRIM_FILE:read_file_info(Handle, Name, [], DTraceUtag), Handle};
 handle_call({read_file_info, Name, Opts, DTraceUtag}, _From, Handle) ->
     {reply, ?PRIM_FILE:read_file_info(Handle, Name, Opts, DTraceUtag), Handle};
 
@@ -154,12 +154,12 @@ handle_call({altname, Name, DTraceUtag}, _From, Handle) ->
     {reply, ?PRIM_FILE:altname(Handle, Name, DTraceUtag), Handle};
 
 handle_call({write_file_info, Name, Info, DTraceUtag}, _From, Handle) ->
-    {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, DTraceUtag), Handle};
+    {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, [], DTraceUtag), Handle};
 handle_call({write_file_info, Name, Info, Opts, DTraceUtag}, _From, Handle) ->
     {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, Opts, DTraceUtag), Handle};
 
 handle_call({read_link_info, Name, DTraceUtag}, _From, Handle) ->
-    {reply, ?PRIM_FILE:read_link_info(Handle, Name, DTraceUtag), Handle};
+    {reply, ?PRIM_FILE:read_link_info(Handle, Name, [], DTraceUtag), Handle};
 handle_call({read_link_info, Name, Opts, DTraceUtag}, _From, Handle) ->
     {reply, ?PRIM_FILE:read_link_info(Handle, Name, Opts, DTraceUtag), Handle};