Merge pull request #1644 from bjorng/bjorn/erts/fix-literal-gc/ERL-508

Fix purging of modules with "fake literals"

OTP-14791

3 files changed, 124 insertions, 18 deletions

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 23258dbe9c..adf8779f11 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -5665,13 +5665,36 @@ erts_release_literal_area(ErtsLiteralArea* literal_area)
 	return;
 
     oh = literal_area->off_heap;
-	
+
     while (oh) {
-	Binary* bptr;
-	ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
-	bptr = ((ProcBin*)oh)->val;
-        erts_bin_release(bptr);
-	oh = oh->next;
+        switch (thing_subtag(oh->thing_word)) {
+        case REFC_BINARY_SUBTAG:
+            {
+                Binary* bptr = ((ProcBin*)oh)->val;
+                erts_bin_release(bptr);
+                break;
+            }
+        case FUN_SUBTAG:
+            {
+                ErlFunEntry* fe = ((ErlFunThing*)oh)->fe;
+                if (erts_smp_refc_dectest(&fe->refc, 0) == 0) {
+                    erts_erase_fun_entry(fe);
+                }
+                break;
+            }
+        case REF_SUBTAG:
+            {
+                ErtsMagicBinary *bptr;
+                ASSERT(is_magic_ref_thing(oh));
+                bptr = ((ErtsMRefThing *) oh)->mb;
+                erts_bin_release((Binary *) bptr);
+                break;
+            }
+        default:
+            ASSERT(is_external_header(oh->thing_word));
+            erts_deref_node_entry(((ExternalThing*)oh)->node);
+        }
+        oh = oh->next;
     }
     erts_free(ERTS_ALC_T_LITERAL, literal_area);
 }
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 8cb977a7f3..6a87136463 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1234,8 +1234,8 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
     p->old_htop = old_htop;
 
     /*
-     * Prepare to sweep binaries. Since all MSOs on the new heap
-     * must be come before MSOs on the old heap, find the end of
+     * Prepare to sweep off-heap objects. Since all MSOs on the new
+     * heap must be come before MSOs on the old heap, find the end of
      * current MSO list and use that as a starting point.
      */
 
@@ -1247,25 +1247,50 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
     }
 
     /*
-     * Sweep through all binaries in the temporary literal area.
+     * Sweep through all off-heap objects in the temporary literal area.
      */
 
     while (oh) {
 	if (IS_MOVED_BOXED(oh->thing_word)) {
-	    Binary* bptr;
 	    struct erl_off_heap_header* ptr;
 
-	    ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
-	    ASSERT(thing_subtag(ptr->thing_word) == REFC_BINARY_SUBTAG);
-	    bptr = ((ProcBin*)ptr)->val;
-
-	    /*
-	     * This binary has been copied to the heap.
+            /*
+	     * This off-heap object has been copied to the heap.
 	     * We must increment its reference count and
 	     * link it into the MSO list for the process.
 	     */
 
-	    erts_refc_inc(&bptr->intern.refc, 1);
+	    ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
+            switch (thing_subtag(ptr->thing_word)) {
+            case REFC_BINARY_SUBTAG:
+                {
+                    Binary* bptr = ((ProcBin*)ptr)->val;
+                    erts_refc_inc(&bptr->intern.refc, 1);
+                    break;
+                }
+            case FUN_SUBTAG:
+                {
+                    ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe;
+                    erts_refc_inc(&fe->refc, 1);
+                    break;
+                }
+            case REF_SUBTAG:
+                {
+                    ErtsMagicBinary *bptr;
+                    ASSERT(is_magic_ref_thing(ptr));
+                    bptr = ((ErtsMRefThing *) ptr)->mb;
+                    erts_refc_inc(&bptr->intern.refc, 1);
+                    break;
+                }
+            default:
+                {
+                    ExternalThing *etp;
+                    ASSERT(is_external_header(ptr->thing_word));
+                    etp = (ExternalThing *) ptr;
+                    erts_smp_refc_inc(&etp->node->refc, 1);
+                    break;
+                }
+            }
 	    *prev = ptr;
 	    prev = &ptr->next;
 	}
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 77321aa50f..dca600bc7b 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -25,6 +25,7 @@
          multi_proc_purge/1, t_check_old_code/1,
          external_fun/1,get_chunk/1,module_md5/1,
          constant_pools/1,constant_refc_binaries/1,
+         fake_literals/1,
          false_dependency/1,coverage/1,fun_confusion/1,
          t_copy_literals/1, t_copy_literals_frags/1]).
 
@@ -38,7 +39,8 @@ all() ->
      call_purged_fun_code_reload, call_purged_fun_code_there,
      multi_proc_purge, t_check_old_code, external_fun, get_chunk,
      module_md5,
-     constant_pools, constant_refc_binaries, false_dependency,
+     constant_pools, constant_refc_binaries, fake_literals,
+     false_dependency,
      coverage, fun_confusion, t_copy_literals, t_copy_literals_frags].
 
 init_per_suite(Config) ->
@@ -554,6 +556,62 @@ wait_for_memory_deallocations() ->
             wait_for_memory_deallocations()
     end.
 
+fake_literals(_Config) ->
+    Mod = fake__literals__module,
+    try
+        do_fake_literals(Mod)
+    after
+        _ = code:purge(Mod),
+        _ = code:delete(Mod),
+        _ = code:purge(Mod),
+        _ = code:delete(Mod)
+    end,
+    ok.
+
+do_fake_literals(Mod) ->
+    Tid = ets:new(test, []),
+    ExtTerms = get_external_terms(),
+    Term0 = {self(),make_ref(),Tid,fun() -> ok end,ExtTerms},
+    Terms = [begin
+                 make_literal_module(Mod, Term0),
+                 Mod:term()
+             end || _ <- lists:seq(1, 10)],
+    verify_lit_terms(Terms, Term0),
+    true = ets:delete(Tid),
+    ok.
+
+make_literal_module(Mod, Term) ->
+    Exp = [{term,0}],
+    Attr = [],
+    Fs = [{function,term,0,2,
+           [{label,1},
+            {line,[]},
+            {func_info,{atom,Mod},{atom,term},0},
+            {label,2},
+            {move,{literal,Term},{x,0}},
+            return]}],
+    Asm = {Mod,Exp,Attr,Fs,2},
+    {ok,Mod,Beam} = compile:forms(Asm, [from_asm,binary,report]),
+    code:load_binary(Mod, atom_to_list(Mod), Beam).
+
+verify_lit_terms([H|T], Term) ->
+    case H =:= Term of
+        true ->
+            verify_lit_terms(T, Term);
+        false ->
+            error({bad_term,H})
+    end;
+verify_lit_terms([], _) ->
+    ok.
+
+get_external_terms() ->
+    {ok,Node} =	test_server:start_node(?FUNCTION_NAME, slave, []),
+    Ref = rpc:call(Node, erlang, make_ref, []),
+    Ports = rpc:call(Node, erlang, ports, []),
+    Pid = rpc:call(Node, erlang, self, []),
+    _ = test_server:stop_node(Node),
+    {Ref,hd(Ports),Pid}.
+
 %% OTP-7559: c_p->cp could contain garbage and create a false dependency
 %% to a module in a process. (Thanks to Richard Carlsson.)
 false_dependency(Config) when is_list(Config) ->