Merge branch 'egil/erts/fix-purge_code-literals'

* egil/erts/fix-purge_code-literals:
  erts: Refactor ERTS_MSG_COMBINED_HFRAG to heap fragment
  erts: Copy literals in messages on module purge
  erts: Add testcase for purge of literals

4 files changed, 256 insertions, 37 deletions

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 40d44dda4c..15e878ba65 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -762,6 +762,11 @@ check_mod_funs(Process *p, ErlOffHeap *off_heap, char *area, size_t area_size)
     return 0;
 }
 
+static Uint hfrag_literal_size(Eterm* start, Eterm* end,
+                               char* lit_start, Uint lit_size);
+static void hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
+                               Eterm *start, Eterm *end,
+                               char *lit_start, Uint lit_size);
 
 static Eterm
 check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls)
@@ -842,9 +847,14 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
     }
 
     /*
-     * Message queue can contains funs, but (at least currently) no
+     * Message queue can contains funs, and may contain
      * literals. If we got references to this module from the message
-     * queue, a GC cannot remove these...
+     * queue.
+     *
+     * If a literal is in the message queue we maka an explicit copy of
+     * and attach it to the heap fragment. Each message needs to be
+     * self contained, we cannot save the literal in the old_heap or
+     * any other heap than the message it self.
      */
 
     erts_smp_proc_lock(rp, ERTS_PROC_LOCK_MSGQ);
@@ -861,15 +871,31 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
 	    hfrag = msgp->data.heap_frag;
 	else
 	    continue;
-	for (; hfrag; hfrag = hfrag->next) {
-	    if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size))
-		return am_true;
-	    /* Should not contain any literals... */
-	    ASSERT(!any_heap_refs(&hfrag->mem[0],
-				  &hfrag->mem[hfrag->used_size],
-                                  literals,
-				  lit_bsize));
-	}
+        {
+            ErlHeapFragment *hf;
+            Uint lit_sz;
+            for (hf=hfrag; hf; hf = hf->next) {
+                if (check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size))
+                    return am_true;
+                lit_sz = hfrag_literal_size(&hf->mem[0], &hf->mem[hf->used_size],
+                                            literals, lit_bsize);
+            }
+            if (lit_sz > 0) {
+                ErlHeapFragment *bp = new_message_buffer(lit_sz);
+                Eterm *hp = bp->mem;
+
+                for (hf=hfrag; hf; hf = hf->next) {
+                    hfrag_literal_copy(&hp, &bp->off_heap,
+                                       &hf->mem[0], &hf->mem[hf->used_size],
+                                       literals, lit_bsize);
+                    hfrag=hf;
+                }
+                /* link new hfrag last */
+                ASSERT(hfrag->next == NULL);
+                hfrag->next = bp;
+                bp->next = NULL;
+            }
+        }
     }
 
     while (1) {
@@ -916,29 +942,26 @@ check_process_code(Process* rp, Module* modp, Uint flags, int *redsp, int fcalls
 		goto try_literal_gc;
 	}
 
-#ifdef DEBUG
 	/*
-	 * Message buffer fragments should not have any references
-	 * to literals, and off heap lists should already have
-	 * been moved into process off heap structure.
+	 * Message buffer fragments (matched messages) 
+         *  - off heap lists should already have been moved into
+         *    process off heap structure.
+         *  - Check for literals
 	 */
 	for (msgp = rp->msg_frag; msgp; msgp = msgp->next) {
-	    if (msgp->data.attached == ERTS_MSG_COMBINED_HFRAG)
-		hfrag = &msgp->hfrag;
-	    else
-		hfrag = msgp->data.heap_frag;
+            hfrag = erts_message_to_heap_frag(msgp);
 	    for (; hfrag; hfrag = hfrag->next) {
 		Eterm *hp, *hp_end;
 		ASSERT(!check_mod_funs(rp, &hfrag->off_heap, mod_start, mod_size));
 
 		hp = &hfrag->mem[0];
 		hp_end = &hfrag->mem[hfrag->used_size];
-		ASSERT(!any_heap_refs(hp, hp_end, literals, lit_bsize));
+
+                if (any_heap_refs(hp, hp_end, literals, lit_bsize))
+                    goto try_literal_gc;
 	    }
 	}
 
-#endif
-
 	return am_false;
 
     try_literal_gc:
@@ -1038,6 +1061,80 @@ any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size)
     return 0;
 }
 
+static Uint
+hfrag_literal_size(Eterm* start, Eterm* end, char* lit_start, Uint lit_size)
+{
+    Eterm* p;
+    Eterm val;
+    Uint sz = 0;
+
+    for (p = start; p < end; p++) {
+        val = *p;
+        switch (primary_tag(val)) {
+        case TAG_PRIMARY_BOXED:
+        case TAG_PRIMARY_LIST:
+            if (ErtsInArea(val, lit_start, lit_size)) {
+                sz += size_object(val);
+            }
+            break;
+        case TAG_PRIMARY_HEADER:
+            if (!header_is_transparent(val)) {
+                Eterm* new_p;
+                if (header_is_bin_matchstate(val)) {
+                    ErlBinMatchState *ms = (ErlBinMatchState*) p;
+                    ErlBinMatchBuffer *mb = &(ms->mb);
+                    if (ErtsInArea(mb->orig, lit_start, lit_size)) {
+                        sz += size_object(mb->orig);
+                    }
+                }
+                new_p = p + thing_arityval(val);
+                ASSERT(start <= new_p && new_p < end);
+                p = new_p;
+            }
+        }
+    }
+    return sz;
+}
+
+static void
+hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
+                   Eterm *start, Eterm *end,
+                   char *lit_start, Uint lit_size) {
+    Eterm* p;
+    Eterm val;
+    Uint sz;
+
+    for (p = start; p < end; p++) {
+        val = *p;
+        switch (primary_tag(val)) {
+        case TAG_PRIMARY_BOXED:
+        case TAG_PRIMARY_LIST:
+            if (ErtsInArea(val, lit_start, lit_size)) {
+                sz = size_object(val);
+                val = copy_struct(val, sz, hpp, ohp);
+                *p = val; 
+            }
+            break;
+        case TAG_PRIMARY_HEADER:
+            if (!header_is_transparent(val)) {
+                Eterm* new_p;
+                /* matchstate in message, not possible. */
+                if (header_is_bin_matchstate(val)) {
+                    ErlBinMatchState *ms = (ErlBinMatchState*) p;
+                    ErlBinMatchBuffer *mb = &(ms->mb);
+                    if (ErtsInArea(mb->orig, lit_start, lit_size)) {
+                        sz = size_object(mb->orig);
+                        mb->orig = copy_struct(mb->orig, sz, hpp, ohp);
+                    }
+                }
+                new_p = p + thing_arityval(val);
+                ASSERT(start <= new_p && new_p < end);
+                p = new_p;
+            }
+        }
+    }
+}
+
 #undef in_area
 
 #ifdef ERTS_SMP
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index d740b2baec..374da9407c 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -2279,10 +2279,7 @@ move_msgq_to_heap(Process *p)
 	    }
 	    else {
 
-		if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG)
-		    bp = &mp->hfrag;
-		else
-		    bp = mp->data.heap_frag;
+                bp = erts_message_to_heap_frag(mp);
 
 		if (bp->next)
 		    erts_move_multi_frags(&factory.hp, factory.off_heap, bp,
@@ -3304,11 +3301,7 @@ within2(Eterm *ptr, Process *p, Eterm *real_htop)
 
     while (mp) {
 
-	if (mp->data.attached == ERTS_MSG_COMBINED_HFRAG)
-	    bp = &mp->hfrag;
-	else
-	    bp = mp->data.heap_frag;
-
+        bp = erts_message_to_heap_frag(mp);
 	mp = mp->next;
 
     search_heap_frags:
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index 4493df1c1a..46063ea0c2 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -369,6 +369,10 @@ ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg);
 
 #define ERTS_MSG_COMBINED_HFRAG ((void *) 0x1)
 
+#define erts_message_to_heap_frag(MP)                   \
+    (((MP)->data.attached == ERTS_MSG_COMBINED_HFRAG) ? \
+        &(MP)->hfrag : (MP)->data.heap_frag)
+
 #if ERTS_GLB_INLINE_INCL_FUNC_DEF
 
 ERTS_GLB_FORCE_INLINE ErtsMessage *erts_alloc_message(Uint sz, Eterm **hpp)
@@ -449,10 +453,7 @@ ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg)
     ASSERT(msg->data.attached);
     if (is_value(ERL_MESSAGE_TERM(msg))) {
 	ErlHeapFragment *bp;
-	if (msg->data.attached == ERTS_MSG_COMBINED_HFRAG)
-	    bp = &msg->hfrag;
-	else
-	    bp = msg->data.heap_frag;
+        bp = erts_message_to_heap_frag(msg);
 	return erts_used_frag_sz(bp);
     }
     else if (msg->data.dist_ext->heap_size < 0)
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 29b95ef674..2347a3d4ef 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -26,7 +26,7 @@
          external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
          make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1,
          false_dependency/1,coverage/1,fun_confusion/1,
-         t_copy_literals/1]).
+         t_copy_literals/1, t_copy_literals_frags/1]).
 
 -define(line_trace, 1).
 -include_lib("common_test/include/ct.hrl").
@@ -38,7 +38,7 @@ all() ->
      t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
      module_md5, make_stub, make_stub_many_funs,
      constant_pools, constant_refc_binaries, false_dependency,
-     coverage, fun_confusion, t_copy_literals].
+     coverage, fun_confusion, t_copy_literals, t_copy_literals_frags].
 
 init_per_suite(Config) ->
     erts_debug:set_internal_state(available_internal_state, true),
@@ -766,6 +766,134 @@ t_copy_literals(Config) when is_list(Config) ->
     ok  = flush(),
     ok.
 
+-define(mod, t_copy_literals_frags).
+t_copy_literals_frags(Config) when is_list(Config) ->
+    Bin = gen_lit(?mod,[{a,{1,2,3,4,5,6,7}},
+                        {b,"hello world"},
+                        {c, <<"hello world">>},
+                        {d, {"hello world", {1.0, 2.0, <<"some">>, "string"}}},
+                        {e, <<"off heap", 0, 1, 2, 3, 4, 5, 6, 7,
+                                          8, 9,10,11,12,13,14,15,
+                                          0, 1, 2, 3, 4, 5, 6, 7,
+                                          8, 9,10,11,12,13,14,15,
+                                          0, 1, 2, 3, 4, 5, 6, 7,
+                                          8, 9,10,11,12,13,14,15,
+                                          0, 1, 2, 3, 4, 5, 6, 7,
+                                          8, 9,10,11,12,13,14,15>>}]),
+
+    {module, ?mod} = erlang:load_module(?mod, Bin),
+    N = 6000,
+    Recv = spawn_opt(fun() -> receive
+                                  read ->
+                                      io:format("reading"),
+                                      literal_receiver()
+                              end
+                     end, [link,{min_heap_size, 10000}]),
+    Switcher = spawn_link(fun() -> literal_switcher() end),
+    Pids = [spawn_opt(fun() -> receive
+                                   {Pid, go, Recv, N} ->
+                                       io:format("sender batch (~w) start ~w~n",[N,self()]),
+                                       literal_sender(N,Recv),
+                                       Pid ! {self(), ok}
+                               end
+                      end, [link,{min_heap_size,800}]) || _ <- lists:seq(1,100)],
+    _ = [Pid ! {self(), go, Recv, N} || Pid <- Pids],
+    %% don't read immediately
+    timer:sleep(5),
+    Recv ! read,
+    Switcher ! {switch,?mod,Bin,[Recv|Pids],200},
+    _ = [receive {Pid, ok} -> ok end || Pid <- Pids],
+    Switcher ! {self(), done},
+    receive {Switcher, ok} -> ok end,
+    Recv ! {self(), done},
+    receive {Recv, ok} -> ok end,
+    ok.
+
+literal_receiver() ->
+    receive
+        {Pid, done} ->
+            io:format("reader_done~n"),
+            Pid ! {self(), ok};
+        {_Pid, msg, [A,B,C,D,E]} ->
+            A = ?mod:a(),
+            B = ?mod:b(),
+            C = ?mod:c(),
+            D = ?mod:d(),
+            E = ?mod:e(),
+            literal_receiver();
+        {Pid, sender_confirm} ->
+            io:format("sender confirm ~w~n", [Pid]),
+            Pid ! {self(), ok},
+            literal_receiver()
+    end.
+
+literal_sender(0, Recv) ->
+    Recv ! {self(), sender_confirm},
+    receive {Recv, ok} -> ok end;
+literal_sender(N, Recv) ->
+    Recv ! {self(), msg, [?mod:a(),
+                          ?mod:b(),
+                          ?mod:c(),
+                          ?mod:d(),
+                          ?mod:e()]},
+    literal_sender(N - 1, Recv).
+
+literal_switcher() ->
+    receive
+        {switch,Mod,Bin,Pids,Tmo} ->
+            literal_switcher(Mod,Bin,Pids,Tmo)
+    end.
+literal_switcher(Mod,Bin,Pids,Tmo) ->
+    receive
+        {Pid,done} ->
+            Pid ! {self(),ok}
+    after Tmo ->
+              io:format("load module ~w~n", [Mod]),
+              {module, Mod} = erlang:load_module(Mod,Bin),
+              ok = check_and_purge(Pids,Mod),
+              io:format("purge complete ~w~n", [Mod]),
+              literal_switcher(Mod,Bin,Pids,Tmo+Tmo)
+    end.
+
+check_and_purge([],Mod) ->
+    erlang:purge_module(Mod),
+    ok;
+check_and_purge(Pids,Mod) ->
+    io:format("purge ~w~n", [Mod]),
+    Tag = make_ref(),
+    _ = [begin
+             erlang:check_process_code(Pid,Mod,[{async,{Tag,Pid}}])
+         end || Pid <- Pids],
+    Retry = check_and_purge_receive(Pids,Tag,[]),
+    check_and_purge(Retry,Mod).
+
+check_and_purge_receive([Pid|Pids],Tag,Retry) ->
+    receive
+        {check_process_code, {Tag, Pid}, false} ->
+            check_and_purge_receive(Pids,Tag,Retry);
+        {check_process_code, {Tag, Pid}, true} ->
+            check_and_purge_receive(Pids,Tag,[Pid|Retry])
+    end;
+check_and_purge_receive([],_,Retry) ->
+    Retry.
+
+
+gen_lit(Module,Terms) ->
+    FunStrings = [lists:flatten(io_lib:format("~w() -> ~w.~n", [F,Term]))||{F,Term}<-Terms],
+    FunForms = function_forms(FunStrings),
+    Forms    = [{attribute,erl_anno:new(1),module,Module},
+                {attribute,erl_anno:new(2),export,[FA || {FA,_} <- FunForms]}] ++
+               [Function || {_, Function} <- FunForms],
+    {ok, Module, Bin} = compile:forms(Forms),
+    Bin.
+
+function_forms([]) -> [];
+function_forms([S|Ss]) ->
+    {ok, Ts,_} = erl_scan:string(S),
+    {ok, Form} = erl_parse:parse_form(Ts),
+    Fun   = element(3, Form),
+    Arity = element(4, Form),
+    [{{Fun,Arity}, Form}|function_forms(Ss)].
 
 chase_msg(0, Pid) ->
     chase_loop(Pid);