Fix purging of modules with "fake literals"

When compiling Erlang source code, the literal area for the
module can only contain data types that have a literal
syntax.

However, it is possible to sneak in other data types
(such as references) in the literal pool by compiling from
abstract or assembly code. Those "fake literals" would work
fine, but would crash the runtime system when the module containing
the literals was purged.

Although fake literals are not officially supported, the
runtime should not crash when attempting to use them.
Therefore, fix the garbage collection of literals and releasing
of literal areas.

https://bugs.erlang.org/browse/ERL-508

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) ->