Merge branch 'sverker/seq-trace-label-old-heap-bug/ERL-700/OTP-15849/OTP-15858/OTP-15859' into maint-21

* sverker/seq-trace-label-old-heap-bug/ERL-700/OTP-15849/OTP-15858/OTP-15859:
  erts: Fix faulty spec for seq_trace:set_token/2
  erts: Fix seq_trace:print/2 for arbitrary labels
  erts: Fix bug in seq_trace:set_token(label,_)

4 files changed, 49 insertions, 19 deletions

diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c
index 711e62c795..b31d5b86cb 100644
--- a/erts/emulator/beam/erl_bif_trace.c
+++ b/erts/emulator/beam/erl_bif_trace.c
@@ -74,7 +74,7 @@ static void smp_bp_finisher(void* arg);
 static BIF_RETTYPE
 system_monitor(Process *p, Eterm monitor_pid, Eterm list);
 
-static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/
+static void new_seq_trace_token(Process* p, int); /* help func for seq_trace_2*/
 static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key);
 static Eterm trace_info_func(Process* p, Eterm pid_spec, Eterm key);
 static Eterm trace_info_on_load(Process* p, Eterm key);
@@ -1874,7 +1874,7 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
 
     if (current_flag && ( (arg2 == am_true) || (arg2 == am_false)) ) {
 	/* Flags */
-        new_seq_trace_token(p);
+        new_seq_trace_token(p, 0);
         flags = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(p));
 	if (build_result) {
 	    old_value = flags & current_flag ? am_true : am_false;
@@ -1889,11 +1889,11 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
 	return old_value;
     }
     else if (arg1 == am_label) {
-        new_seq_trace_token(p);
+        new_seq_trace_token(p, is_not_immed(arg2));
 	if (build_result) {
 	    old_value = SEQ_TRACE_TOKEN_LABEL(p);
 	}
-	SEQ_TRACE_TOKEN_LABEL(p) = arg2;
+        SEQ_TRACE_TOKEN_LABEL(p) = arg2;
     	return old_value;
     }
     else if (arg1 == am_serial) {
@@ -1905,7 +1905,7 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
 	if ((*tp != make_arityval(2)) || is_not_small(*(tp+1)) || is_not_small(*(tp+2))) {
 	    return THE_NON_VALUE;
         }
-        new_seq_trace_token(p);
+        new_seq_trace_token(p, 0);
 	if (build_result) {
 	    hp = HAlloc(p,3);
 	    old_value = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(p),
@@ -1940,8 +1940,8 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2,
     }
 }
 
-void
-new_seq_trace_token(Process* p)
+static void
+new_seq_trace_token(Process* p, int ensure_new_heap)
 {
     Eterm* hp;
 
@@ -1953,6 +1953,16 @@ new_seq_trace_token(Process* p)
 				    p->common.id, /* Internal pid */	/* From   */
 				    make_small(p->seq_trace_lastcnt));
     }
+    else if (ensure_new_heap) {
+        Eterm* tpl = tuple_val(SEQ_TRACE_TOKEN(p));
+        ASSERT(arityval(tpl[0]) == 5);
+        if (ErtsInArea(tpl, OLD_HEAP(p),
+                       (OLD_HEND(p) - OLD_HEAP(p))*sizeof(Eterm))) {
+            hp = HAlloc(p, 6);
+            sys_memcpy(hp, tpl, 6*sizeof(Eterm));
+            SEQ_TRACE_TOKEN(p) = make_tuple(hp);
+        }
+    }
 }
 
 BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item)
@@ -2050,10 +2060,7 @@ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2)
     if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) {
 	BIF_RET(am_false);
     }
-    if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) {
-	BIF_ERROR(BIF_P, BADARG);
-    }
-    if (SEQ_TRACE_TOKEN_LABEL(BIF_P) != BIF_ARG_1)
+    if (!EQ(BIF_ARG_1, SEQ_TRACE_TOKEN_LABEL(BIF_P)))
 	BIF_RET(am_false);
     seq_trace_update_send(BIF_P);
     seq_trace_output(SEQ_TRACE_TOKEN(BIF_P), BIF_ARG_2, 
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 43937f216c..86798df64e 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1226,9 +1226,10 @@ void erts_check_for_holes(Process* p);
 
 /* The sequential tracing token is a tuple of size 5:
  *
- *    {Flags, Label, Serial, Sender}
+ *    {Flags, Label, Serial, Sender, LastCnt}
+ *
+ *  WARNING: The top 5-tuple is *MUTABLE* and thus INTERNAL ONLY.
  */
-
 #define SEQ_TRACE_TOKEN_ARITY(p)    (arityval(*(tuple_val(SEQ_TRACE_TOKEN(p)))))
 #define SEQ_TRACE_TOKEN_FLAGS(p)    (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 1))
 #define SEQ_TRACE_TOKEN_LABEL(p)    (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 2))
diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl
index 4f9d7b3e5c..f0bd1fabe9 100644
--- a/lib/kernel/src/seq_trace.erl
+++ b/lib/kernel/src/seq_trace.erl
@@ -59,7 +59,7 @@ set_token({Flags,Label,Serial,_From,Lastcnt}) ->
     F = decode_flags(Flags),
     set_token2([{label,Label},{serial,{Lastcnt, Serial}} | F]).
 
--spec set_token(Component, Val) -> {Component, OldVal} when
+-spec set_token(Component, Val) -> OldVal when
       Component :: component(),
       Val :: value(),
       OldVal :: value().
diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl
index ee8f4e94f8..07a46ac51e 100644
--- a/lib/kernel/test/seq_trace_SUITE.erl
+++ b/lib/kernel/test/seq_trace_SUITE.erl
@@ -23,6 +23,7 @@
 	 init_per_group/2,end_per_group/2,
 	 init_per_testcase/2,end_per_testcase/2]).
 -export([token_set_get/1, tracer_set_get/1, print/1,
+         old_heap_token/1,
 	 send/1, distributed_send/1, recv/1, distributed_recv/1,
 	 trace_exit/1, distributed_exit/1, call/1, port/1,
 	 match_set_seq_token/1, gc_seq_token/1, label_capability_mismatch/1,
@@ -47,6 +48,7 @@ suite() ->
 all() -> 
     [token_set_get, tracer_set_get, print, send, send_literal,
      distributed_send, recv, distributed_recv, trace_exit,
+     old_heap_token,
      distributed_exit, call, port, match_set_seq_token,
      gc_seq_token, label_capability_mismatch].
 
@@ -146,17 +148,19 @@ tracer_set_get(Config) when is_list(Config) ->
     ok.
 
 print(Config) when is_list(Config) ->
-    lists:foreach(fun do_print/1, ?TIMESTAMP_MODES).
+    [do_print(TsType, Label) || TsType <- ?TIMESTAMP_MODES,
+                                Label <- [17, "label"]].
     
-do_print(TsType) ->
+do_print(TsType, Label) ->
     start_tracer(),
+    seq_trace:set_token(label, Label),
     set_token_flags([print, TsType]),
-    seq_trace:print(0,print1),
+    seq_trace:print(Label,print1),
     seq_trace:print(1,print2),
     seq_trace:print(print3),
     seq_trace:reset_trace(),
-    [{0,{print,_,_,[],print1}, Ts0},
-	   {0,{print,_,_,[],print3}, Ts1}] = stop_tracer(2),
+    [{Label,{print,_,_,[],print1}, Ts0},
+     {Label,{print,_,_,[],print3}, Ts1}] = stop_tracer(2),
     check_ts(TsType, Ts0),
     check_ts(TsType, Ts1).
 
@@ -560,6 +564,24 @@ get_port_message(Port) ->
     end.
 
 
+%% OTP-15849 ERL-700
+%% Verify changing label on existing token when it resides on old heap.
+%% Bug caused faulty ref from old to new heap.
+old_heap_token(Config) when is_list(Config) ->
+    seq_trace:set_token(label, 1),
+    erlang:garbage_collect(self(), [{type, minor}]),
+    erlang:garbage_collect(self(), [{type, minor}]),
+    %% Now token tuple should be on old-heap.
+    %% Set a new non-literal label which should reside on new-heap.
+    NewLabel = {self(), "new label"},
+    1 = seq_trace:set_token(label, NewLabel),
+
+    %% If bug, we now have a ref from old to new heap. Yet another minor gc
+    %% will make that a ref to deallocated memory.
+    erlang:garbage_collect(self(), [{type, minor}]),
+    {label,NewLabel} = seq_trace:get_token(label),
+    ok.
+
 
 match_set_seq_token(doc) ->
     ["Tests that match spec function set_seq_token does not "