Add user tag spreading functionality to VM and use in file

User tags in a dynamic trace enabled VM are spread throughout the system
in the same way as seq_trace tokens. This is used by the file module
and various other modules to get hold of the tag from the user process
without changing the protocol.

19 files changed, 629 insertions, 80 deletions

diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 7be40976f6..9ce1068b23 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -248,6 +248,7 @@ atom global_heaps_size
 atom Gt='>'
 atom grun
 atom group_leader
+atom have_dt_utag
 atom heap_block_size
 atom heap_size
 atom heap_sizes
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 1dbe2cad00..deeb7357d6 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1892,23 +1892,52 @@ void process_main(void)
 	 save_calls(c_p, &exp_receive);
      }
      if (ERL_MESSAGE_TOKEN(msgp) == NIL) {
-	 SEQ_TRACE_TOKEN(c_p) = NIL;
+#ifdef HAVE_DTRACE
+	 if (DT_UTAG(c_p) != NIL) {
+	     if (DT_UTAG_FLAGS(c_p) & DT_UTAG_PERMANENT) {
+		 SEQ_TRACE_TOKEN(c_p) = am_have_dt_utag;
+		 if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING) 
+		     erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) stop spreading tag %T with message %T\r\n",c_p->id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp));
+	     } else {
+		 erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) kill tag %T with message %T\r\n",c_p->id,DT_UTAG(c_p),ERL_MESSAGE_TERM(msgp));
+		 DT_UTAG(c_p) = NIL;
+		 SEQ_TRACE_TOKEN(c_p) = NIL;
+	     }
+	 } else {
+#endif
+	     SEQ_TRACE_TOKEN(c_p) = NIL;
+#ifdef HAVE_DTRACE
+	 }
+	 DT_UTAG_FLAGS(c_p) &= ~DT_UTAG_SPREADING;
+#endif
      } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) {
 	 Eterm msg;
 	 SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp);
-	 ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p)));
-	 ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
-	 ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p)));
-	 ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p)));
-	 ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p)));
-	 ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p)));
-	 c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
-	 if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) {
-	     c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
+#ifdef HAVE_DTRACE
+	 if (ERL_MESSAGE_TOKEN(msgp) == am_have_dt_utag) {
+	     if (DT_UTAG(c_p) == NIL) {
+		 DT_UTAG(c_p) = ERL_MESSAGE_DT_UTAG(msgp);
+	     }
+	     DT_UTAG_FLAGS(c_p) |= DT_UTAG_SPREADING;
+	     erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) receive tag (%T) with message %T\r\n",c_p->id, DT_UTAG(c_p), ERL_MESSAGE_TERM(msgp));
+	 } else {
+#endif
+	     ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p)));
+	     ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5);
+	     ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p)));
+	     ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p)));
+	     ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p)));
+	     ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p)));
+	     c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
+	     if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) {
+		 c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p));
+	     }
+	     msg = ERL_MESSAGE_TERM(msgp);
+	     seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE, 
+			      c_p->id, c_p);
+#ifdef HAVE_DTRACE
 	 }
-	 msg = ERL_MESSAGE_TERM(msgp);
-	 seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE, 
-			  c_p->id, c_p);
+#endif
      }
      if (DTRACE_ENABLED(message_receive)) {
          Eterm token2 = NIL;
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index ebdca87f4a..6478e54996 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -563,7 +563,11 @@ erts_queue_monitor_message(Process *p,
     ref_copy    = copy_struct(ref, ref_size, &hp, ohp);
 
     tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy);
-    erts_queue_message(p, p_locksp, bp, tup, NIL);
+    erts_queue_message(p, p_locksp, bp, tup, NIL
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
 }
 
 static BIF_RETTYPE
@@ -1944,7 +1948,11 @@ do_send(Process *p, Eterm to, Eterm msg, int suspend) {
 	if (ERTS_PROC_GET_SAVED_CALLS_BUF(p))
 	    save_calls(p, &exp_send);
 	
-	if (SEQ_TRACE_TOKEN(p) != NIL) {
+	if (SEQ_TRACE_TOKEN(p) != NIL
+#ifdef HAVE_DTRACE
+	    && SEQ_TRACE_TOKEN(p) != am_have_dt_utag
+#endif
+	    ) {
 	    seq_trace_update_send(p);
 	    seq_trace_output(SEQ_TRACE_TOKEN(p), msg, 
 			     SEQ_TRACE_SEND, portid, p);
@@ -4226,13 +4234,21 @@ BIF_RETTYPE system_flag_2(BIF_ALIST_2)
 	for (i = 0; i < erts_max_processes; i++) {
 	    if (process_tab[i] != (Process*) 0) {
 		Process* p = process_tab[i];
+#ifdef HAVE_DTRACE
+		p->seq_trace_token = (p->dt_utag != NIL) ? am_have_dt_utag : NIL;
+#else
 		p->seq_trace_token = NIL;
+#endif
 		p->seq_trace_clock = 0;
 		p->seq_trace_lastcnt = 0;
 		ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p);
 		mp = p->msg.first;
 		while(mp != NULL) {
+#ifdef HAVE_DTRACE
+		    ERL_MESSAGE_TOKEN(mp) = (ERL_MESSAGE_DT_UTAG(mp) != NIL) ? am_have_dt_utag : NIL;
+#else
 		    ERL_MESSAGE_TOKEN(mp) = NIL;
+#endif
 		    mp = mp->next;
 		}
 	    }
@@ -4630,3 +4646,171 @@ BIF_RETTYPE get_module_info_2(BIF_ALIST_2)
     }
     BIF_RET(ret);
 }
+
+BIF_RETTYPE put_utag_1(BIF_ALIST_1)
+{
+#ifdef HAVE_DTRACE
+    Eterm otag;
+    if (BIF_ARG_1 == am_undefined) {
+	otag = (DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P);
+	DT_UTAG(BIF_P) = NIL;
+	DT_UTAG_FLAGS(BIF_P) = 0;
+	if (SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag) {
+	    SEQ_TRACE_TOKEN(BIF_P) = NIL;
+	}
+	BIF_RET(otag);
+    }
+    if (!is_binary(BIF_ARG_1)) {
+	BIF_ERROR(BIF_P,BADARG);
+    }
+    otag = (DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P);
+    DT_UTAG(BIF_P) = BIF_ARG_1;
+    DT_UTAG_FLAGS(BIF_P) |= DT_UTAG_PERMANENT;
+    if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
+	SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag;
+    }
+    BIF_RET(otag);
+#else
+    BIF_RET(am_undefined);
+#endif
+}
+
+BIF_RETTYPE get_utag_0(BIF_ALIST_0)
+{
+#ifdef HAVE_DTRACE
+    BIF_RET((DT_UTAG(BIF_P) == NIL || !(DT_UTAG_FLAGS(BIF_P) & DT_UTAG_PERMANENT)) ? am_undefined : DT_UTAG(BIF_P));
+#else
+    BIF_RET(am_undefined);
+#endif
+}
+BIF_RETTYPE get_utag_data_0(BIF_ALIST_0)
+{
+#ifdef HAVE_DTRACE
+    BIF_RET((DT_UTAG(BIF_P) == NIL) ? am_undefined : DT_UTAG(BIF_P));
+#else
+    BIF_RET(am_undefined);
+#endif
+}
+BIF_RETTYPE prepend_vm_utag_data_1(BIF_ALIST_1)
+{
+#ifdef HAVE_DTRACE
+    Eterm b; 
+    Eterm *hp;
+    hp = HAlloc(BIF_P,2);
+    if (is_binary((DT_UTAG(BIF_P)))) {
+	Uint sz = binary_size(DT_UTAG(BIF_P));
+	int i;
+	unsigned char *p,*q;
+	byte *temp_alloc = NULL;
+	b = new_binary(BIF_P,NULL,sz+1);
+	q = binary_bytes(b);
+	p = erts_get_aligned_binary_bytes(DT_UTAG(BIF_P),&temp_alloc);
+	for(i=0;i<sz;++i) {
+	    q[i] = p[i];
+	} 
+	erts_free_aligned_binary_bytes(temp_alloc);
+	q[sz] = '\0';
+    } else {
+	b = new_binary(BIF_P,(byte *)"\0",1);
+    }
+    BIF_RET(CONS(hp,b,BIF_ARG_1));
+#else
+    BIF_RET(BIF_ARG_1);
+#endif
+}
+BIF_RETTYPE append_vm_utag_data_1(BIF_ALIST_1)
+{
+#ifdef HAVE_DTRACE
+    Eterm b; 
+    Eterm *hp;
+    hp = HAlloc(BIF_P,2);
+    if (is_binary((DT_UTAG(BIF_P)))) {
+	Uint sz = binary_size(DT_UTAG(BIF_P));
+	int i;
+	unsigned char *p,*q;
+	byte *temp_alloc = NULL;
+	b = new_binary(BIF_P,NULL,sz+1);
+	q = binary_bytes(b);
+	p = erts_get_aligned_binary_bytes(DT_UTAG(BIF_P),&temp_alloc);
+	for(i=0;i<sz;++i) {
+	    q[i] = p[i];
+	} 
+	erts_free_aligned_binary_bytes(temp_alloc);
+	q[sz] = '\0';
+    } else {
+	b = new_binary(BIF_P,(byte *)"\0",1);
+    }
+    BIF_RET(CONS(hp,BIF_ARG_1,b));
+#else
+    BIF_RET(BIF_ARG_1);
+#endif
+}
+BIF_RETTYPE spread_utag_1(BIF_ALIST_1)
+{
+#ifdef HAVE_DTRACE
+    Eterm ret;
+    Eterm *hp;
+#endif
+    if (BIF_ARG_1 != am_true && BIF_ARG_1 != am_false) {
+	BIF_ERROR(BIF_P,BADARG);
+    }
+#ifdef HAVE_DTRACE
+    hp = HAlloc(BIF_P,3);
+    ret = TUPLE2(hp,make_small(DT_UTAG_FLAGS(BIF_P)),DT_UTAG(BIF_P));
+    if (DT_UTAG(BIF_P) != NIL) {
+	if (BIF_ARG_1 == am_true) {
+	    DT_UTAG_FLAGS(BIF_P) |= DT_UTAG_SPREADING;
+	    erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) start spreading tag %T\r\n",BIF_P->id,DT_UTAG(BIF_P));
+	} else {
+	    DT_UTAG_FLAGS(BIF_P) &= ~DT_UTAG_SPREADING;
+	    erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) stop spreading tag %T\r\n",BIF_P->id,DT_UTAG(BIF_P));
+	}
+    }
+    BIF_RET(ret);
+#else
+    BIF_RET(am_true);
+#endif
+}
+BIF_RETTYPE restore_utag_1(BIF_ALIST_1)
+{
+#ifdef HAVE_DTRACE
+    Eterm *tpl;
+    Uint x;
+    if (is_not_tuple(BIF_ARG_1)) {
+	BIF_ERROR(BIF_P,BADARG);
+    }
+    tpl = tuple_val(BIF_ARG_1);
+    if(arityval(*tpl) != 2 || is_not_small(tpl[1]) || (is_not_binary(tpl[2]) && tpl[2] != NIL)) {
+	BIF_ERROR(BIF_P,BADARG);
+    }
+    if (tpl[2] == NIL) {
+	if (DT_UTAG(BIF_P) != NIL) {
+	    erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) restore Killing tag!\r\n",BIF_P->id);
+	}
+	DT_UTAG(BIF_P) = NIL;
+	if (SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag) {
+	    SEQ_TRACE_TOKEN(BIF_P) = NIL;
+	}
+	DT_UTAG_FLAGS(BIF_P) = 0;
+    } else {
+	x = unsigned_val(tpl[1]) & (DT_UTAG_SPREADING | DT_UTAG_PERMANENT);
+	if (!(x & DT_UTAG_SPREADING) && (DT_UTAG_FLAGS(BIF_P) & DT_UTAG_SPREADING)) {
+	    erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) restore stop spreading tag %T\r\n",BIF_P->id,tpl[2]);
+	} else if ((x & DT_UTAG_SPREADING) && !(DT_UTAG_FLAGS(BIF_P) & DT_UTAG_SPREADING)) {
+	    erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) restore start spreading tag %T\r\n",BIF_P->id,tpl[2]);
+	}
+	DT_UTAG_FLAGS(BIF_P) = x;
+	DT_UTAG(BIF_P) = tpl[2];
+	if (SEQ_TRACE_TOKEN(BIF_P) == NIL) {
+	    SEQ_TRACE_TOKEN(BIF_P) = am_have_dt_utag;
+	}
+    }
+#else    
+    if (BIF_ARG_1 != am_true) {
+	BIF_ERROR(BIF_P,BADARG);
+    }
+#endif
+    BIF_RET(am_true);
+}
+
+
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 007c884a6a..7940544156 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -814,6 +814,23 @@ bif erlang:check_old_code/1
 #
 bif erlang:universaltime_to_posixtime/1
 bif erlang:posixtime_to_universaltime/1
+
+#
+# New in R15B01
+#
+
+# The dtrace BIF's are always present, but give dummy results if dynamic trace is not enabled in the build
+bif erlang:put_utag/1
+bif erlang:get_utag/0
+bif erlang:get_utag_data/0
+bif erlang:spread_utag/1
+bif erlang:restore_utag/1
+
+# These are dummies even with enabled dynamic trace unless vm probes are enabled. 
+# They are also internal, for dtrace tags sent to the VM's own drivers (efile)
+bif erlang:prepend_vm_utag_data/1
+bif erlang:append_vm_utag_data/1
+
 #
 # Obsolete
 #
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index ba55a1918a..43fc910054 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -382,7 +382,11 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
 	    Eterm tup;
 	    Eterm *hp = erts_alloc_message_heap(3,&bp,&ohp,rp,&rp_locks);
 	    tup = TUPLE2(hp, am_nodedown, name);
-	    erts_queue_message(rp, &rp_locks, bp, tup, NIL);
+	    erts_queue_message(rp, &rp_locks, bp, tup, NIL
+#ifdef HAVE_DTRACE
+			       , NIL
+#endif
+			       );
 	}
 	erts_smp_proc_unlock(rp, rp_locks);
     }
@@ -750,7 +754,11 @@ erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message)
     DTRACE_CHARBUF(receiver_name, 64);
 
     UseTmpHeapNoproc(5);
-    if (SEQ_TRACE_TOKEN(sender) != NIL) {
+    if (SEQ_TRACE_TOKEN(sender) != NIL 
+#ifdef HAVE_DTRACE
+	&& SEQ_TRACE_TOKEN(sender) != am_have_dt_utag 
+#endif
+	) {
 	seq_trace_update_send(sender);
 	token = SEQ_TRACE_TOKEN(sender);
 	seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender);
@@ -799,7 +807,11 @@ erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message)
     DTRACE_CHARBUF(receiver_name, 128);
 
     UseTmpHeapNoproc(6);
-    if (SEQ_TRACE_TOKEN(sender) != NIL) {
+    if (SEQ_TRACE_TOKEN(sender) != NIL
+#ifdef HAVE_DTRACE
+	&& SEQ_TRACE_TOKEN(sender) != am_have_dt_utag 
+#endif
+	) {
 	seq_trace_update_send(sender);
 	token = SEQ_TRACE_TOKEN(sender);
 	seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender);
@@ -851,7 +863,11 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
     DTRACE_CHARBUF(reason_str, 128);
 
     UseTmpHeapNoproc(6);
-    if (token != NIL) {	
+    if (token != NIL 
+#ifdef HAVE_DTRACE
+	&& token != am_have_dt_utag
+#endif
+	) {	
 	seq_trace_update_send(dsdp->proc);
 	seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local);
 	ctl = TUPLE5(&ctl_heap[0],
@@ -866,7 +882,7 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
         erts_snprintf(remote_name, sizeof(remote_name),
                       "{%T,%s}", remote, node_name);
         erts_snprintf(reason_str, sizeof(reason), "%T", reason);
-        if (token != NIL) {
+        if (token != NIL && token != am_have_dt_utag) {
             tok_label = signed_val(SEQ_TRACE_T_LABEL(token));
             tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token));
             tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token));
@@ -3094,7 +3110,11 @@ send_nodes_mon_msg(Process *rp,
     }
 
     ASSERT(hend == hp);
-    erts_queue_message(rp, rp_locksp, bp, msg, NIL);
+    erts_queue_message(rp, rp_locksp, bp, msg, NIL
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
 }
 
 static void
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index df27186680..d575e30092 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -3001,7 +3001,11 @@ reply_alloc_info(void *vair)
 	HRelease(rp, hp_end, hp);	    
     }
 
-    erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+    erts_queue_message(rp, &rp_locks, bp, msg, NIL
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
 
     if (air->req_sched == sched_id)
 	rp_locks &= ~ERTS_PROC_LOCK_MAIN;
diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c
index 3326fd84df..b58c5ab761 100644
--- a/erts/emulator/beam/erl_bif_ddll.c
+++ b/erts/emulator/beam/erl_bif_ddll.c
@@ -1762,7 +1762,11 @@ static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type,
 	hp += REF_THING_SIZE;
 	mess = TUPLE5(hp,type,r,am_driver,driver_name,tag);
     }
-    erts_queue_message(proc, &rp_locks, bp, mess, am_undefined);
+    erts_queue_message(proc, &rp_locks, bp, mess, am_undefined
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
     erts_smp_proc_unlock(proc, rp_locks);
     ERTS_SMP_CHK_NO_PROC_LOCKS;
 }
diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c
index a922a33da3..fbc2f08c09 100644
--- a/erts/emulator/beam/erl_bif_timer.c
+++ b/erts/emulator/beam/erl_bif_timer.c
@@ -373,7 +373,11 @@ bif_timer_timeout(ErtsBifTimer* btm)
 		message = TUPLE3(hp, am_timeout, ref, message);
 	    }
 
-	    erts_queue_message(rp, &rp_locks, bp, message, NIL);
+	    erts_queue_message(rp, &rp_locks, bp, message, NIL
+#ifdef HAVE_DTRACE
+			       , NIL
+#endif
+			       );
 	    erts_smp_proc_unlock(rp, rp_locks);
 	    erts_smp_proc_dec_refc(rp);
 	}
diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index b0a58c80ea..c518aa6866 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -1744,9 +1744,17 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
 	    return THE_NON_VALUE;
         }
 	if (build_result) {
+#ifdef HAVE_DTRACE
+	    old_value = (SEQ_TRACE_TOKEN(p) == am_have_dt_utag) ? NIL : SEQ_TRACE_TOKEN(p);
+#else
 	    old_value = SEQ_TRACE_TOKEN(p);
+#endif
 	}
+#ifdef HAVE_DTRACE
+        SEQ_TRACE_TOKEN(p) = (DT_UTAG(p) != NIL) ? am_have_dt_utag : NIL;
+#else
         SEQ_TRACE_TOKEN(p) = NIL;
+#endif
         return old_value;
     }
     else {
@@ -1759,7 +1767,11 @@ new_seq_trace_token(Process* p)
 {
     Eterm* hp;
 
-    if (SEQ_TRACE_TOKEN(p) == NIL) {
+    if (SEQ_TRACE_TOKEN(p) == NIL
+#ifdef HAVE_DTRACE
+	|| SEQ_TRACE_TOKEN(p) == am_have_dt_utag
+#endif
+	) {
 	hp = HAlloc(p, 6);
 	SEQ_TRACE_TOKEN(p) = TUPLE5(hp, make_small(0),		/* Flags  */ 
 				    make_small(0),		/* Label  */
@@ -1779,7 +1791,11 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
 	BIF_ERROR(p, BADARG);
     }
 
-    if (SEQ_TRACE_TOKEN(p) == NIL) {
+    if (SEQ_TRACE_TOKEN(p) == NIL
+#ifdef HAVE_DTRACE
+	|| SEQ_TRACE_TOKEN(p) == am_have_dt_utag
+#endif
+	) {
 	if ((item == am_send) || (item == am_receive) || 
 	    (item == am_print) || (item == am_timestamp)) {
 	    hp = HAlloc(p,3);
@@ -1836,8 +1852,13 @@ BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1)
  */
 BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1)    
 {
-    if (SEQ_TRACE_TOKEN(BIF_P) == NIL) 
+    if (SEQ_TRACE_TOKEN(BIF_P) == NIL 
+#ifdef HAVE_DTRACE
+	|| SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag
+#endif
+	) {
 	BIF_RET(am_false);
+    }
     seq_trace_update_send(BIF_P);
     seq_trace_output(SEQ_TRACE_TOKEN(BIF_P), BIF_ARG_1, 
 		     SEQ_TRACE_PRINT, NIL, BIF_P);
@@ -1854,8 +1875,13 @@ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1)
  */
 BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2)    
 {
-    if (SEQ_TRACE_TOKEN(BIF_P) == NIL) 
+    if (SEQ_TRACE_TOKEN(BIF_P) == NIL
+#ifdef HAVE_DTRACE
+	|| SEQ_TRACE_TOKEN(BIF_P) == am_have_dt_utag
+#endif
+	) {
 	BIF_RET(am_false);
+    }
     if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) {
 	BIF_ERROR(BIF_P, BADARG);
     }
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 4821a7d9fb..eb05ceaaf1 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -2203,7 +2203,11 @@ restart:
 	    *esp++ = am_true;
 	    break;
 	case matchIsSeqTrace:
-	    if (SEQ_TRACE_TOKEN(c_p) != NIL)
+	    if (SEQ_TRACE_TOKEN(c_p) != NIL
+#ifdef HAVE_DTRACE
+		&& SEQ_TRACE_TOKEN(c_p) != am_have_dt_utag
+#endif
+		)
 		*esp++ = am_true;
 	    else
 		*esp++ = am_false;
@@ -2227,7 +2231,11 @@ restart:
 	    --esp;
 	    break;
 	case matchGetSeqToken:
-	    if (SEQ_TRACE_TOKEN(c_p) == NIL) 
+	    if (SEQ_TRACE_TOKEN(c_p) == NIL
+#ifdef HAVE_DTRACE
+		|| SEQ_TRACE_TOKEN(c_p) == am_have_dt_utag
+#endif
+		) 
 		*esp++ = NIL;
 	    else {
 		Eterm sender = SEQ_TRACE_TOKEN_SENDER(c_p);
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 679a3645ba..6dfccfe52f 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1935,7 +1935,13 @@ setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset)
 	roots[n].sz = 1;
 	n++;
     }
-
+#ifdef HAVE_DTRACE
+    if (is_not_immed(p->dt_utag)) {
+	roots[n].v = &p->dt_utag;
+	roots[n].sz = 1;
+	n++;
+    }
+#endif
     ASSERT(is_nil(p->tracer_proc) ||
 	   is_internal_pid(p->tracer_proc) ||
 	   is_internal_port(p->tracer_proc));
@@ -2472,6 +2478,13 @@ offset_mqueue(Process *p, Sint offs, char* area, Uint area_size)
 	if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
 	    ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs);
         }
+#ifdef HAVE_DTRACE
+	mesg = ERL_MESSAGE_DT_UTAG(mp);
+	if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) {
+	    ERL_MESSAGE_DT_UTAG(mp) = offset_ptr(mesg, offs);
+        }
+#endif	
+	
         ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) ||
 		is_tuple(ERL_MESSAGE_TOKEN(mp)) ||
 		is_atom(ERL_MESSAGE_TOKEN(mp))));
@@ -2491,6 +2504,9 @@ offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size,
     offset_heap_ptr(&p->fvalue, 1, offs, area, area_size);
     offset_heap_ptr(&p->ftrace, 1, offs, area, area_size);
     offset_heap_ptr(&p->seq_trace_token, 1, offs, area, area_size);
+#ifdef HAVE_DTRACE
+    offset_heap_ptr(&p->dt_utag, 1, offs, area, area_size);
+#endif
     offset_heap_ptr(&p->group_leader, 1, offs, area, area_size);
     offset_mqueue(p, offs, area, area_size);
     offset_heap_ptr(p->stop, (STACK_START(p) - p->stop), offs, area, area_size);
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 786d6ac52c..dc59b9c2c4 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -393,13 +393,26 @@ erts_queue_dist_message(Process *rcvr,
                         receiver_name, size_object(msg), rcvr->msg.len,
                         tok_label, tok_lastcnt, tok_serial);
             }
-	    erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token);
+	    erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token
+#ifdef HAVE_DTRACE
+			       , NIL
+#endif
+			       );
     }
     else {
 	/* Enqueue message on external format */
 
 	ERL_MESSAGE_TERM(mp) = THE_NON_VALUE;
-	ERL_MESSAGE_TOKEN(mp) = token;
+#ifdef HAVE_DTRACE
+	ERL_MESSAGE_DT_UTAG(mp) = NIL;
+	if (token == am_have_dt_utag) {
+	    ERL_MESSAGE_TOKEN(mp) = NIL;
+	} else {
+#endif
+	    ERL_MESSAGE_TOKEN(mp) = token;
+#ifdef HAVE_DTRACE
+	}
+#endif
 	mp->next = NULL;
 
         if (DTRACE_ENABLED(message_queued)) {
@@ -431,7 +444,11 @@ erts_queue_message(Process* receiver,
 		   ErtsProcLocks *receiver_locks,
 		   ErlHeapFragment* bp,
 		   Eterm message,
-		   Eterm seq_trace_token)
+		   Eterm seq_trace_token
+#ifdef HAVE_DTRACE
+		   , Eterm dt_utag
+#endif
+)
 {
     ErlMessage* mp;
 #ifdef ERTS_SMP
@@ -472,6 +489,9 @@ erts_queue_message(Process* receiver,
 
     ERL_MESSAGE_TERM(mp) = message;
     ERL_MESSAGE_TOKEN(mp) = seq_trace_token;
+#ifdef HAVE_DTRACE
+    ERL_MESSAGE_DT_UTAG(mp) = dt_utag;
+#endif
     mp->next = NULL;
     mp->data.heap_frag = bp;
 
@@ -547,6 +567,9 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
     Sint offs;
     Uint sz;
     ErlHeapFragment *bp;
+#ifdef HAVE_DTRACE
+    Eterm utag;
+#endif
 
 #ifdef HARD_DEBUG
     ProcBin *dbg_mso_start = off_heap->mso;
@@ -556,32 +579,56 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
     ErlHeapFragment *dbg_bp;
     Uint *dbg_hp, *dbg_thp_start;
     Uint dbg_term_sz, dbg_token_sz;
+#ifdef HAVE_DTRACE
+    Eterm dbg_utag;
+    Uint dbg_utag_sz;
+#endif
 #endif
 
     bp = msg->data.heap_frag;
     term = ERL_MESSAGE_TERM(msg);
     token = ERL_MESSAGE_TOKEN(msg);
+#ifdef HAVE_DTRACE
+    utag = ERL_MESSAGE_DT_UTAG(msg);
+#endif
     if (!bp) {
+#ifdef HAVE_DTRACE
+	ASSERT(is_immed(term) && is_immed(token) && is_immed(utag));
+#else
 	ASSERT(is_immed(term) && is_immed(token));
+#endif
 	return;
     }
 
 #ifdef HARD_DEBUG
     dbg_term_sz = size_object(term);
     dbg_token_sz = size_object(token);
+    dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz);
+#ifdef HAVE_DTRACE
+    dbg_utag_sz = size_object(utag);
+    dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz + dbg_utag_sz );
+#endif
     /*ASSERT(dbg_term_sz + dbg_token_sz == erts_msg_used_frag_sz(msg));
       Copied size may be smaller due to removed SubBins's or garbage.
       Copied size may be larger due to duplicated shared terms.
     */
-    dbg_bp = new_message_buffer(dbg_term_sz + dbg_token_sz);
     dbg_hp = dbg_bp->mem;
     dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap);
     dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap);
-    dbg_thp_start = *hpp;
+#ifdef HAVE_DTRACE
+    dbg_utag = copy_struct(utag, dbg_utag_sz, &dbg_hp, &dbg_bp->off_heap);
+#endif
+   dbg_thp_start = *hpp;
 #endif
 
     if (bp->next != NULL) {
-	move_multi_frags(hpp, off_heap, bp, msg->m, 2);
+	move_multi_frags(hpp, off_heap, bp, msg->m, 
+#ifdef HAVE_DTRACE
+			 3
+#else
+			 2
+#endif
+			 );
 	goto copy_done;
     }
 
@@ -683,6 +730,16 @@ erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg)
 	ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg)));
 #endif
     }
+#ifdef HAVE_DTRACE
+    if (is_not_immed(utag)) {
+	ASSERT(in_heapfrag(ptr_val(utag), bp));
+	ERL_MESSAGE_DT_UTAG(msg) = offset_ptr(utag, offs);
+#ifdef HARD_DEBUG
+	ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
+	ASSERT(hp > ptr_val(ERL_MESSAGE_DT_UTAG(msg)));
+#endif
+    }
+#endif
 
 copy_done:
 
@@ -749,6 +806,9 @@ copy_done:
 #ifdef HARD_DEBUG
     ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term));
     ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token));
+#ifdef HAVE_DTRACE
+    ASSERT(eq(ERL_MESSAGE_DT_UTAG(msg), dbg_utag));
+#endif
     free_message_buffer(dbg_bp);
 #endif
 
@@ -841,42 +901,85 @@ erts_send_message(Process* sender,
     }
     if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) {
         Eterm* hp;
+	Eterm stoken = SEQ_TRACE_TOKEN(sender);
+	Uint seq_trace_size = 0;
+#ifdef HAVE_DTRACE
+	Uint dt_utag_size = 0;
+	Eterm utag = NIL;
+#endif
 
-        BM_SWAP_TIMER(send,size);
+	BM_SWAP_TIMER(send,size);
 	msize = size_object(message);
-        BM_SWAP_TIMER(size,send);
+	BM_SWAP_TIMER(size,send);
+
+#ifdef HAVE_DTRACE
+	if (stoken != am_have_dt_utag) {
+#endif
 
-	seq_trace_update_send(sender);
-	seq_trace_output(SEQ_TRACE_TOKEN(sender), message, SEQ_TRACE_SEND, 
-			 receiver->id, sender);
-	bp = new_message_buffer(msize + 6 /* TUPLE5 */);
+	    seq_trace_update_send(sender);
+	    seq_trace_output(stoken, message, SEQ_TRACE_SEND, 
+			     receiver->id, sender);
+	    seq_trace_size = 6; /* TUPLE5 */
+#ifdef HAVE_DTRACE
+	}
+	if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
+	    dt_utag_size = size_object(DT_UTAG(sender));
+	} else if (stoken == am_have_dt_utag ) {
+	    stoken = NIL;
+	}
+#endif
+
+	bp = new_message_buffer(msize + seq_trace_size 
+#ifdef HAVE_DTRACE
+				+ dt_utag_size
+#endif
+				);
 	hp = bp->mem;
 
         BM_SWAP_TIMER(send,copy);
-	token = copy_struct(SEQ_TRACE_TOKEN(sender),
-			    6 /* TUPLE5 */,
+	token = copy_struct(stoken,
+			    seq_trace_size,
 			    &hp,
 			    &bp->off_heap);
 
 	message = copy_struct(message, msize, &hp, &bp->off_heap);
+#ifdef HAVE_DTRACE
+	if (DT_UTAG_FLAGS(sender) & DT_UTAG_SPREADING) {
+	    utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, &bp->off_heap);
+	    erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) Spreading tag (%T) with message %T!\r\n",sender->id, utag, message);
+	}
+#if 0
+	DT_UTAG_FLAGS(sender) &= ~DT_UTAG_SPREADING;
+	if (!(DT_UTAG_FLAGS(sender) & DT_UTAG_PERMANENT)) {
+	    erts_fprintf(stderr,"XXX: PaN: Dtrace -> (%T) Killing tag!\r\n",sender->id);
+	    DT_UTAG(sender) = NIL;
+	    if (SEQ_TRACE_TOKEN(sender) == am_have_dt_utag) {
+		SEQ_TRACE_TOKEN(sender) = NIL;
+	    }
+	}
+#endif
+#endif
         BM_MESSAGE_COPIED(msize);
         BM_SWAP_TIMER(copy,send);
 
         if (DTRACE_ENABLED(message_send)) {
-            Eterm token2 = NIL;
-
-            token2 = SEQ_TRACE_TOKEN(sender);
-            tok_label = signed_val(SEQ_TRACE_T_LABEL(token2));
-            tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(token2));
-            tok_serial = signed_val(SEQ_TRACE_T_SERIAL(token2));
-            DTRACE6(message_send, sender_name, receiver_name,
-                    msize, tok_label, tok_lastcnt, tok_serial);
+	    if (stoken != NIL) {
+		tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken));
+		tok_lastcnt = signed_val(SEQ_TRACE_T_LASTCNT(stoken));
+		tok_serial = signed_val(SEQ_TRACE_T_SERIAL(stoken));
+	    }
+	    DTRACE6(message_send, sender_name, receiver_name,
+		    msize, tok_label, tok_lastcnt, tok_serial);
         }
         erts_queue_message(receiver,
 			   receiver_locks,
 			   bp,
 			   message,
-			   token);
+			   token
+#ifdef HAVE_DTRACE
+			   , utag
+#endif
+			   );
         BM_SWAP_TIMER(send,system);
 #ifdef HYBRID
     } else {
@@ -909,6 +1012,9 @@ erts_send_message(Process* sender,
                 size_object(message)msize, tok_label, tok_lastcnt, tok_serial);
         ERL_MESSAGE_TERM(mp) = message;
         ERL_MESSAGE_TOKEN(mp) = NIL;
+#ifdef HAVE_DTRACE
+	ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
         mp->next = NULL;
 	LINK_MESSAGE(receiver, mp);
         ACTIVATE(receiver);
@@ -951,6 +1057,9 @@ erts_send_message(Process* sender,
 	    mp->data.attached = NULL;
 	    ERL_MESSAGE_TERM(mp) = message;
 	    ERL_MESSAGE_TOKEN(mp) = NIL;
+#ifdef HAVE_DTRACE
+	    ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
 	    mp->next = NULL;
 	    /*
 	     * We move 'in queue' to 'private queue' and place
@@ -984,7 +1093,11 @@ erts_send_message(Process* sender,
 	BM_SWAP_TIMER(copy,send);
         DTRACE6(message_send, sender_name, receiver_name,
                 msize, tok_label, tok_lastcnt, tok_serial);
-	erts_queue_message(receiver, receiver_locks, bp, message, token);
+	erts_queue_message(receiver, receiver_locks, bp, message, token
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
         BM_SWAP_TIMER(send,system);
 #else
 	ErlMessage* mp = message_alloc();
@@ -1008,6 +1121,9 @@ erts_send_message(Process* sender,
                 (uint32_t)msize, tok_label, tok_lastcnt, tok_serial);
 	ERL_MESSAGE_TERM(mp) = message;
 	ERL_MESSAGE_TOKEN(mp) = NIL;
+#ifdef HAVE_DTRACE
+	ERL_MESSAGE_DT_UTAG(mp) = NIL;
+#endif
 	mp->next = NULL;
 	mp->data.attached = NULL;
 	LINK_MESSAGE(receiver, mp);
@@ -1046,7 +1162,11 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp,
     Eterm temptoken;
     ErlHeapFragment* bp = NULL;
 
-    if (token != NIL) {
+    if (token != NIL
+#ifdef HAVE_DTRACE
+	&& token != am_have_dt_utag
+#endif
+	) {
 
 	ASSERT(is_tuple(token));
 	sz_reason = size_object(reason);
@@ -1061,7 +1181,11 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp,
 	/* the trace token must in this case be updated by the caller */
 	seq_trace_output(token, save, SEQ_TRACE_SEND, to->id, NULL);
 	temptoken = copy_struct(token, sz_token, &hp, &bp->off_heap);
-	erts_queue_message(to, to_locksp, bp, save, temptoken);
+	erts_queue_message(to, to_locksp, bp, save, temptoken
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
     } else {
 	ErlOffHeap *ohp;
 	sz_reason = size_object(reason);
@@ -1078,7 +1202,11 @@ erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp,
 		     ? from
 		     : copy_struct(from, sz_from, &hp, ohp));
 	save = TUPLE3(hp, am_EXIT, from_copy, mess);
-	erts_queue_message(to, to_locksp, bp, save, NIL);
+	erts_queue_message(to, to_locksp, bp, save, NIL
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
     }
 }
 
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index 5aca0db6fe..98321dd2c6 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -70,11 +70,18 @@ typedef struct erl_mesg {
 	ErlHeapFragment *heap_frag;
 	void *attached;
     } data;
+#ifdef HAVE_DTRACE
+    Eterm m[3];                 /* m[0] = message, m[1] = seq trace token, m[3] = dynamic trace user tag */
+#else
     Eterm m[2];			/* m[0] = message, m[1] = seq trace token */
+#endif
 } ErlMessage;
 
 #define ERL_MESSAGE_TERM(mp) ((mp)->m[0])
 #define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1])
+#ifdef HAVE_DTRACE
+#define ERL_MESSAGE_DT_UTAG(mp) ((mp)->m[2])
+#endif
 
 /* Size of default message buffer (erl_message.c) */
 #define ERL_MESSAGE_BUF_SZ 500
@@ -221,7 +228,11 @@ ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint,
 					    Eterm *, Uint);
 void free_message_buffer(ErlHeapFragment *);
 void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm);
-void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*, Eterm, Eterm);
+void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*, Eterm, Eterm
+#ifdef HAVE_DTRACE
+		   , Eterm dt_utag
+#endif
+);
 void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm);
 void erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned);
 void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp);
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index dc4049327d..ebc771b016 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -351,7 +351,11 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
     if (flush_me) {	
 	flush_env(env); /* Needed for ERTS_HOLE_CHECK */ 
     }
-    erts_queue_message(rp, &rp_locks, frags, msg, am_undefined);
+    erts_queue_message(rp, &rp_locks, frags, msg, am_undefined
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
     if (rp_locks) {	
 	ERTS_SMP_LC_ASSERT(rp_locks == (rp_had_locks | (ERTS_PROC_LOCK_MSGQ | 
 							ERTS_PROC_LOCK_STATUS)));
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 1173624f51..6771e00c7e 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -679,7 +679,11 @@ reply_sched_wall_time(void *vswtrp)
 	hpp = &hp;
     }
 
-    erts_queue_message(rp, &rp_locks, bp, msg, NIL);
+    erts_queue_message(rp, &rp_locks, bp, msg, NIL
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+		       );
 
     if (swtrp->req_sched == esdp->no)
 	rp_locks &= ~ERTS_PROC_LOCK_MAIN;
@@ -7260,6 +7264,10 @@ erl_create_process(Process* parent, /* Parent of process (default group leader).
     p->seq_trace_lastcnt = 0;
     p->seq_trace_clock = 0;
     SEQ_TRACE_TOKEN(p) = NIL;
+#ifdef HAVE_DTRACE
+    DT_UTAG(p) = NIL;
+    DT_UTAG_FLAGS(p) = 0;
+#endif
     p->parent = parent->id == ERTS_INVALID_PID ? NIL : parent->id;
 
 #ifdef HYBRID
@@ -7851,7 +7859,11 @@ static ERTS_INLINE void
 send_exit_message(Process *to, ErtsProcLocks *to_locksp,
 		  Eterm exit_term, Uint term_size, Eterm token)
 {
-    if (token == NIL) {
+    if (token == NIL 
+#ifdef HAVE_DTRACE
+	|| token == am_have_dt_utag
+#endif
+	) {
 	Eterm* hp;
 	Eterm mess;
 	ErlHeapFragment* bp;
@@ -7859,7 +7871,11 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp,
 
 	hp = erts_alloc_message_heap(term_size, &bp, &ohp, to, to_locksp);
 	mess = copy_struct(exit_term, term_size, &hp, ohp);
-	erts_queue_message(to, to_locksp, bp, mess, NIL);
+	erts_queue_message(to, to_locksp, bp, mess, NIL
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
     } else {
 	ErlHeapFragment* bp;
 	Eterm* hp;
@@ -7875,7 +7891,11 @@ send_exit_message(Process *to, ErtsProcLocks *to_locksp,
 	/* the trace token must in this case be updated by the caller */
 	seq_trace_output(token, mess, SEQ_TRACE_SEND, to->id, NULL);
 	temp_token = copy_struct(token, sz_token, &hp, &bp->off_heap);
-	erts_queue_message(to, to_locksp, bp, mess, temp_token);
+	erts_queue_message(to, to_locksp, bp, mess, temp_token
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
     }
 }
 
@@ -7981,7 +8001,11 @@ send_exit_signal(Process *c_p,		/* current process if and only
 
     if (ERTS_PROC_IS_TRAPPING_EXITS(rp)
 	&& (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) {
-	if (is_not_nil(token) && token_update)
+	if (is_not_nil(token) 
+#ifdef HAVE_DTRACE
+	    && token != am_have_dt_utag
+#endif
+	    && token_update)
 	    seq_trace_update_send(token_update);
 	if (is_value(exit_tuple))
 	    send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token);
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index d671638ce8..35b31b1009 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -683,6 +683,10 @@ struct process {
     Uint seq_trace_lastcnt;
     Eterm seq_trace_token;	/* Sequential trace token (tuple size 5 see below) */
 
+#ifdef HAVE_DTRACE
+    Eterm dt_utag;              /* Place to store the dynamc trace user tag */
+    Uint dt_utag_flags;         /* flag field for the dt_utag */
+#endif       
     BeamInstr initial[3];	/* Initial module(0), function(1), arity(2), often used instead
 				   of pointer to funcinfo instruction, hence the BeamInstr datatype */
     BeamInstr* current;		/* Current Erlang function, part of the funcinfo:
@@ -998,6 +1002,14 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
 #define SEQ_TRACE_PRINT    (1 << 2)
 #define SEQ_TRACE_TIMESTAMP (1 << 3)
 
+#ifdef HAVE_DTRACE
+#define DT_UTAG_PERMANENT (1 << 0)
+#define DT_UTAG_SPREADING (1 << 1)
+#define DT_UTAG(P) ((P)->dt_utag)
+#define DT_UTAG_FLAGS(P)  ((P)->dt_utag_flags) 
+#endif
+
+
 #ifdef ERTS_SMP
 /* Status flags ... */
 #define ERTS_PROC_SFLG_PENDADD2SCHEDQ	(((Uint32) 1) << 0)	/* Pending
diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c
index b1d1e1d9b0..a4aed0122b 100644
--- a/erts/emulator/beam/erl_trace.c
+++ b/erts/emulator/beam/erl_trace.c
@@ -125,8 +125,13 @@ do { \
     enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \
 } while(0)
 #else
+#ifdef HAVE_DTRACE
 #define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
-  erts_queue_message((TPROC), NULL, (BP), (MSG), NIL)
+    erts_queue_message((TPROC), NULL, (BP), (MSG), NIL, NIL)
+#else
+#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \
+    erts_queue_message((TPROC), NULL, (BP), (MSG), NIL)
+#endif
 #endif
 
 /*
@@ -583,7 +588,11 @@ profile_send(Eterm from, Eterm message) {
 	hp = erts_alloc_message_heap(sz, &bp, &off_heap, profile_p, 0);
 	msg = copy_struct(message, sz, &hp, &bp->off_heap);
 	
-    	erts_queue_message(profile_p, NULL, bp, msg, NIL);
+    	erts_queue_message(profile_p, NULL, bp, msg, NIL
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
     }
 }
 
@@ -994,9 +1003,13 @@ seq_trace_update_send(Process *p)
 {
     Eterm seq_tracer = erts_get_system_seq_tracer();
     ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p))));
-    if ( (p->id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL))
+    if ( (p->id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL)
+#ifdef HAVE_DTRACE
+	 || (SEQ_TRACE_TOKEN(p) == am_have_dt_utag)
+#endif
+	 ) {
 	return 0;
-
+    }
     SEQ_TRACE_TOKEN_SENDER(p) = p->id; /* Internal pid */
     SEQ_TRACE_TOKEN_SERIAL(p) = 
 	make_small(++(p -> seq_trace_clock));
@@ -1178,7 +1191,11 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type,
 	enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SEQTRACE, NIL, NIL, mess, bp);
 	erts_smp_mtx_unlock(&smq_mtx);
 #else
-	erts_queue_message(tracer, NULL, bp, mess, NIL); /* trace_token must be NIL here */
+	erts_queue_message(tracer, NULL, bp, mess, NIL
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   ); /* trace_token must be NIL here */
 #endif
     }
 }
@@ -2469,7 +2486,11 @@ monitor_long_gc(Process *p, Uint time) {
 #ifdef ERTS_SMP
     enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->id, NIL, msg, bp);
 #else
-    erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+    erts_queue_message(monitor_p, NULL, bp, msg, NIL
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+		       );
 #endif
 }
 
@@ -2541,7 +2562,11 @@ monitor_large_heap(Process *p) {
 #ifdef ERTS_SMP
     enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->id, NIL, msg, bp);
 #else
-    erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+    erts_queue_message(monitor_p, NULL, bp, msg, NIL
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
 #endif
 }
 
@@ -2571,7 +2596,11 @@ monitor_generic(Process *p, Eterm type, Eterm spec) {
 #ifdef ERTS_SMP
     enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->id, NIL, msg, bp);
 #else
-    erts_queue_message(monitor_p, NULL, bp, msg, NIL);
+    erts_queue_message(monitor_p, NULL, bp, msg, NIL
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
 #endif
 
 }
@@ -3357,7 +3386,11 @@ sys_msg_dispatcher_func(void *unused)
 		}
 		else {
 		queue_proc_msg:
-		    erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL);
+		    erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL
+#ifdef HAVE_DTRACE
+				       , NIL
+#endif
+				       );
 #ifdef DEBUG_PRINTOUTS
 		    erts_fprintf(stderr, "delivered\n");
 #endif
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 81f79b8f85..75ea53c2b7 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1564,7 +1564,11 @@ deliver_result(Eterm sender, Eterm pid, Eterm res)
 	    hp = erts_alloc_message_heap(sz_res + 3, &bp, &ohp, rp, &rp_locks);
 	    res = copy_struct(res, sz_res, &hp, ohp);
 	    tuple = TUPLE2(hp, sender, res);
-	erts_queue_message(rp, &rp_locks, bp, tuple, NIL);
+	erts_queue_message(rp, &rp_locks, bp, tuple, NIL
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
 	erts_smp_proc_unlock(rp, rp_locks);
 	erts_smp_proc_dec_refc(rp);
     }
@@ -1653,7 +1657,11 @@ static void deliver_read_message(Port* prt, Eterm to,
     tuple = TUPLE2(hp, prt->id, tuple);
     hp += 3;
 
-    erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+    erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+		       );
     erts_smp_proc_unlock(rp, rp_locks);
     erts_smp_proc_dec_refc(rp);
 }
@@ -1806,7 +1814,11 @@ deliver_vec_message(Port* prt,			/* Port */
     tuple = TUPLE2(hp, prt->id, tuple);
     hp += 3;
 
-    erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+    erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
     erts_smp_proc_unlock(rp, rp_locks);
     erts_smp_proc_dec_refc(rp);
 }
@@ -2772,7 +2784,11 @@ void driver_report_exit(int ix, int status)
    hp += 3;
    tuple = TUPLE2(hp, prt->id, tuple);
 
-   erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined);
+   erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined
+#ifdef HAVE_DTRACE
+		      , NIL
+#endif
+		      );
 
    erts_smp_proc_unlock(rp, rp_locks);
    erts_smp_proc_dec_refc(rp);
@@ -3322,7 +3338,11 @@ driver_deliver_term(ErlDrvPort port,
 	    HRelease(rp, hp_end, hp);	    
 	}
 	/* send message */
-	erts_queue_message(rp, &rp_locks, bp, mess, am_undefined);
+	erts_queue_message(rp, &rp_locks, bp, mess, am_undefined
+#ifdef HAVE_DTRACE
+			   , NIL
+#endif
+			   );
     }
     else {
 	if (b2t.ix > b2t.used)
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 49b6618f73..2efcd19162 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1697,7 +1697,11 @@ static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
 	erts_queue_error_logger_message(from, tuple3, bp);
     }
 #else
-    erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL);
+    erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL
+#ifdef HAVE_DTRACE
+		       , NIL
+#endif
+		       );
 #endif
     return 0;
 }