Allow refc binaries in literal pools

To simplify the implementation of literal pools (constant pools)
for the R12 release, a shortcut was taken regarding binaries --
all binaries would be stored as heap binaries regardless of size.

To allow a module containing literals to be unloaded, literal
terms are copied when sent to another process. That means that
huge literal binaries will also be copied if they are sent to
another process, which could be surprising.

Another problem is that the arity field in the header for the heap
object may not be wide enough to handle big binaries.

Therefore, bite the bullet and allow refc binaries to be stored
in literal pools. In short, the following need to be changed:

* Each loaded module needs a MSO list, linking all refc binaries
  in the literal pool.

* When check_process_code/2 copies literals to a process heap,
  it must link each referenced binary into the MSO list for the
  process and increment the reference counter for the binary.

* purge_module/1 must decrement the reference counter for each
  refc binary in the literal pool.

7 files changed, 270 insertions, 14 deletions

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index efb72cd3e7..bc8c001454 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -40,6 +40,7 @@ static Eterm check_process_code(Process* rp, Module* modp);
 static void delete_code(Process *c_p, ErtsProcLocks c_p_locks, Module* modp);
 static void delete_export_references(Eterm module);
 static int purge_module(int module);
+static void decrement_refc(BeamInstr* code);
 static int is_native(BeamInstr* code);
 static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
 static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size);
@@ -553,6 +554,7 @@ check_process_code(Process* rp, Module* modp)
 	} else {
 	    Eterm* literals;
 	    Uint lit_size;
+	    struct erl_off_heap_header* oh;
 
 	    /*
 	     * Try to get rid of constants by by garbage collecting.
@@ -566,7 +568,9 @@ check_process_code(Process* rp, Module* modp)
 	    (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity);
 	    literals = (Eterm *) modp->old_code[MI_LITERALS_START];
 	    lit_size = (Eterm *) modp->old_code[MI_LITERALS_END] - literals;
-	    erts_garbage_collect_literals(rp, literals, lit_size);
+	    oh = (struct erl_off_heap_header *)
+		modp->old_code[MI_LITERALS_OFF_HEAP];
+	    erts_garbage_collect_literals(rp, literals, lit_size, oh);
 	}
     }
     return am_false;
@@ -664,6 +668,7 @@ purge_module(int module)
     end = (BeamInstr *)((char *)code + modp->old_code_length);
     erts_cleanup_funs_on_purge(code, end);
     beam_catches_delmod(modp->old_catches, code, modp->old_code_length);
+    decrement_refc(code);
     erts_free(ERTS_ALC_T_CODE, (void *) code);
     modp->old_code = NULL;
     modp->old_code_length = 0;
@@ -673,6 +678,23 @@ purge_module(int module)
 }
 
 static void
+decrement_refc(BeamInstr* code)
+{
+    struct erl_off_heap_header* oh =
+	(struct erl_off_heap_header *) code[MI_LITERALS_OFF_HEAP];
+
+    while (oh) {
+	Binary* bptr;
+	ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
+	bptr = ((ProcBin*)oh)->val;
+	if (erts_refc_dectest(&bptr->refc, 0) == 0) {
+	    erts_bin_free(bptr);
+	}
+	oh = oh->next;
+    }
+}
+
+static void
 remove_from_address_table(BeamInstr* code)
 {
     int i;
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 10ed46417b..9f96a40c37 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -206,6 +206,7 @@ typedef struct {
     Eterm term;			/* The tagged term (in the heap). */
     Uint heap_size;		/* (Exact) size on the heap. */
     Uint offset;		/* Offset from temporary location to final. */
+    ErlOffHeap off_heap;	/* Start of linked list of ProcBins. */
     Eterm* heap;		/* Heap for term. */
 } Literal;
 
@@ -1419,12 +1420,14 @@ read_literal_table(LoaderState* stp)
 
 	GetInt(stp, 4, sz);	/* Size of external term format. */
 	GetString(stp, p, sz);
-	if ((heap_size = erts_decode_ext_size(p, sz, 1)) < 0) {
+	if ((heap_size = erts_decode_ext_size(p, sz, 0)) < 0) {
 	    LoadError1(stp, "literal %d: bad external format", i);
 	}
 	hp = stp->literals[i].heap = erts_alloc(ERTS_ALC_T_LOADER_TMP,
 						heap_size*sizeof(Eterm));
-	val = erts_decode_ext(&hp, NULL, &p);
+	stp->literals[i].off_heap.first = 0;
+	stp->literals[i].off_heap.overhead = 0;
+	val = erts_decode_ext(&hp, &stp->literals[i].off_heap, &p);
 	stp->literals[i].heap_size = hp - stp->literals[i].heap;
 	if (stp->literals[i].heap_size > heap_size) {
 	    erl_exit(1, "overrun by %d word(s) for literal heap, term %d",
@@ -3955,6 +3958,8 @@ freeze_code(LoaderState* stp)
 	Uint* low;
 	Uint* high;
 	LiteralPatch* lp;
+	struct erl_off_heap_header* off_heap = 0;
+	struct erl_off_heap_header** off_heap_last = &off_heap;
 
 	low = (Uint *) (code+stp->ci);
 	high = low + stp->total_literal_size;
@@ -3963,6 +3968,7 @@ freeze_code(LoaderState* stp)
 	ptr = low;
 	for (i = 0; i < stp->num_literals; i++) {
 	    Uint offset;
+	    struct erl_off_heap_header* t_off_heap;
 
 	    sys_memcpy(ptr, stp->literals[i].heap,
 		       stp->literals[i].heap_size*sizeof(Eterm));
@@ -3977,9 +3983,19 @@ freeze_code(LoaderState* stp)
 		    *ptr++ = offset_ptr(val, offset);
 		    break;
 		case TAG_PRIMARY_HEADER:
-		    ptr++;
-		    if (header_is_thing(val)) {
-			ptr += thing_arityval(val);
+		    if (header_is_transparent(val)) {
+			ptr++;
+		    } else {
+			if (thing_subtag(val) == REFC_BINARY_SUBTAG) {
+			    struct erl_off_heap_header* oh;
+
+			    oh = (struct erl_off_heap_header*) ptr;
+			    if (oh->next) {
+				Eterm** uptr = (Eterm **) (void *) &oh->next;
+				*uptr += offset;
+			    }
+			}
+			ptr += 1 + thing_arityval(val);
 		    }
 		    break;
 		default:
@@ -3988,7 +4004,23 @@ freeze_code(LoaderState* stp)
 		}
 	    }
 	    ASSERT(ptr == high);
+
+	    /*
+	     * Re-link the off_heap list for this term onto the
+	     * off_heap list for the entire module.
+	     */
+	    t_off_heap = stp->literals[i].off_heap.first;
+	    if (t_off_heap) {
+		t_off_heap = (struct erl_off_heap_header *)
+		    offset_ptr((UWord) t_off_heap, offset);
+		while (t_off_heap) {
+		    *off_heap_last = t_off_heap;
+		    off_heap_last = &t_off_heap->next;
+		    t_off_heap = t_off_heap->next;
+		}
+	    }
 	}
+	code[MI_LITERALS_OFF_HEAP] = (BeamInstr) off_heap;
 	lp = stp->literal_patches;
 	while (lp != 0) {
 	    BeamInstr* op_ptr;
@@ -4908,6 +4940,8 @@ new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size)
     lit->heap_size = heap_size;
     lit->heap = erts_alloc(ERTS_ALC_T_LOADER_TMP, heap_size*sizeof(Eterm));
     lit->term = make_boxed(lit->heap);
+    lit->off_heap.first = 0;
+    lit->off_heap.overhead = 0;
     *hpp = lit->heap;
     return stp->num_literals++;
 }
@@ -5844,6 +5878,9 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info)
     code[MI_COMPILE_SIZE] = 0;
     code[MI_COMPILE_SIZE_ON_HEAP] = 0;
     code[MI_NUM_BREAKPOINTS] = 0;
+    code[MI_LITERALS_START] = 0;
+    code[MI_LITERALS_END] = 0;
+    code[MI_LITERALS_OFF_HEAP] = 0;
     code[MI_ON_LOAD_FUNCTION_PTR] = 0;
     ci = MI_FUNCTIONS + n + 1;
 
diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h
index 126d9a3935..4e22ee4d79 100644
--- a/erts/emulator/beam/beam_load.h
+++ b/erts/emulator/beam/beam_load.h
@@ -103,16 +103,18 @@ extern Uint erts_total_code_size;
  */
 #define MI_LITERALS_START	8
 #define MI_LITERALS_END		9
+#define MI_LITERALS_OFF_HEAP	10
+
 
 /*
  * Pointer to the on_load function (or NULL if none).
  */
-#define MI_ON_LOAD_FUNCTION_PTR 10
+#define MI_ON_LOAD_FUNCTION_PTR 11
 
 /*
  * Pointer to the line table (or NULL if none).
  */
-#define MI_LINE_TABLE 11
+#define MI_LINE_TABLE 12
 
 /*
  * Start of function pointer table.  This table contains pointers to
@@ -123,5 +125,5 @@ extern Uint erts_total_code_size;
  * this table.
  */
 
-#define MI_FUNCTIONS         12
+#define MI_FUNCTIONS         13
 #endif /* _BEAM_LOAD_H */
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index c29352a227..eb2b945877 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -595,7 +595,9 @@ erts_garbage_collect_hibernate(Process* p)
 
 
 void
-erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
+erts_garbage_collect_literals(Process* p, Eterm* literals,
+			      Uint lit_size,
+			      struct erl_off_heap_header* oh)
 {
     Uint byte_lit_size = sizeof(Eterm)*lit_size;
     Uint old_heap_size;
@@ -607,6 +609,7 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
     Uint area_size;
     Eterm* old_htop;
     Uint n;
+    struct erl_off_heap_header** prev;
 
     /*
      * Set GC state.
@@ -640,6 +643,9 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
     offset_heap(temp_lit, lit_size, offs, (char *) literals, byte_lit_size);
     offset_heap(p->heap, p->htop - p->heap, offs, (char *) literals, byte_lit_size);
     offset_rootset(p, offs, (char *) literals, byte_lit_size, p->arg_reg, p->arity);
+    if (oh) {
+	oh = (struct erl_off_heap_header *) ((Eterm *)(void *) oh + offs);
+    }
 
     /*
      * Now the literals are placed in memory that is safe to write into,
@@ -707,6 +713,45 @@ erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size)
     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
+     * current MSO list and use that as a starting point.
+     */
+
+    if (oh) {
+	prev = &MSO(p).first;
+	while (*prev) {
+	    prev = &(*prev)->next;
+	}
+    }
+
+    /*
+     * Sweep through all binaries 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.
+	     * We must increment its reference count and
+	     * link it into the MSO list for the process.
+	     */
+
+	    erts_refc_inc(&bptr->refc, 1);
+	    *prev = ptr;
+	    prev = &ptr->next;
+	}
+	oh = oh->next;
+    }
+
+    /*
      * We no longer need this temporary area.
      */
     erts_free(ERTS_ALC_T_TMP, (void *) temp_lit);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 9f19172e08..b247576f1c 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1126,7 +1126,9 @@ void erts_init_gc(void);
 int erts_garbage_collect(Process*, int, Eterm*, int);
 void erts_garbage_collect_hibernate(Process* p);
 Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity);
-void erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size);
+void erts_garbage_collect_literals(Process* p, Eterm* literals,
+				   Uint lit_size,
+				   struct erl_off_heap_header* oh);
 Uint erts_next_heap_size(Uint, Uint);
 Eterm erts_heap_sizes(Process* p);
 
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 9d15184530..2f9b01cc92 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -24,9 +24,10 @@
 	 t_check_process_code/1,t_check_old_code/1,
 	 t_check_process_code_ets/1,
 	 external_fun/1,get_chunk/1,module_md5/1,make_stub/1,
-	 make_stub_many_funs/1,constant_pools/1,
+	 make_stub_many_funs/1,constant_pools/1,constant_refc_binaries/1,
 	 false_dependency/1,coverage/1,fun_confusion/1]).
 
+-define(line_trace, 1).
 -include_lib("test_server/include/test_server.hrl").
 
 suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -35,15 +36,18 @@ all() ->
     [new_binary_types, t_check_process_code,
      t_check_process_code_ets, t_check_old_code, external_fun, get_chunk,
      module_md5, make_stub, make_stub_many_funs,
-     constant_pools, false_dependency, coverage, fun_confusion].
+     constant_pools, constant_refc_binaries, false_dependency,
+     coverage, fun_confusion].
 
 groups() -> 
     [].
 
 init_per_suite(Config) ->
+    erts_debug:set_internal_state(available_internal_state, true),
     Config.
 
 end_per_suite(_Config) ->
+    catch erts_debug:set_internal_state(available_internal_state, false),
     ok.
 
 init_per_group(_GroupName, Config) ->
@@ -475,6 +479,131 @@ create_old_heap() ->
 	    create_old_heap()
     end.
 
+constant_refc_binaries(Config) when is_list(Config) ->
+    wait_for_memory_deallocations(),
+    Bef = memory_binary(),
+    io:format("Binary data (bytes) before test: ~p\n", [Bef]),
+
+    %% Compile the the literals module.
+    Data = ?config(data_dir, Config),
+    File = filename:join(Data, "literals"),
+    {ok,literals,Code} = compile:file(File, [report,binary]),
+
+    %% Load the code and make sure that the binary is a refc binary.
+    {module,literals} = erlang:load_module(literals, Code),
+    Bin = literals:binary(),
+    Sz = byte_size(Bin),
+    Check = erlang:md5(Bin),
+    io:format("Size of literal refc binary: ~p\n", [Sz]),
+    {refc_binary,Sz,_,_} = erts_debug:get_internal_state({binary_info,Bin}),
+    true = erlang:delete_module(literals),
+    false = erlang:check_process_code(self(), literals),
+    true = erlang:purge_module(literals),
+
+    %% Now try to provoke a memory leak.
+    provoke_mem_leak(10, Code, Check),
+
+    %% Calculate the change in allocated binary data.
+    erlang:garbage_collect(),
+    wait_for_memory_deallocations(),
+    Aft = memory_binary(),
+    io:format("Binary data (bytes) after test: ~p", [Aft]),
+    Diff = Aft - Bef,
+    if
+	Diff < 0 ->
+	    io:format("~p less bytes", [abs(Diff)]);
+	Diff > 0 ->
+	    io:format("~p more bytes", [Diff]);
+	true ->
+	    ok
+    end,
+
+    %% Test for leaks. We must accept some natural variations in
+    %% the size of allocated binaries.
+    if
+	Diff > 64*1024 ->
+	    ?t:fail(binary_leak);
+	true ->
+	    ok
+    end.
+
+memory_binary() ->
+    try
+	erlang:memory(binary)
+    catch
+	error:notsup ->
+	    0
+    end.
+
+provoke_mem_leak(0, _, _) -> ok;
+provoke_mem_leak(N, Code, Check) ->
+    {module,literals} = erlang:load_module(literals, Code),
+
+    %% Create several processes with references to the literal binary.
+    Self = self(),
+    Pids = [spawn_link(fun() ->
+			       create_binaries(Self, NumRefs, Check)
+		       end) || NumRefs <- lists:seq(1, 10)],
+    [receive {started,Pid} -> ok end || Pid <- Pids],
+
+    %% Make the code old and remove references to the constant pool
+    %% in all processes.
+    true = erlang:delete_module(literals),
+    Ms = [spawn_monitor(fun() ->
+				false = erlang:check_process_code(Pid, literals)
+			end) || Pid <- Pids],
+    [receive
+	 {'DOWN',R,process,P,normal} ->
+	     ok
+     end || {P,R} <- Ms],
+
+    %% Purge the code.
+    true = erlang:purge_module(literals),
+
+    %% Tell the processes that the code has been purged.
+    [begin
+	 monitor(process, Pid),
+	 Pid ! purged
+     end || Pid <- Pids],
+
+    %% Wait for all processes to terminate.
+    [receive
+	 {'DOWN',_,process,Pid,normal} ->
+	     ok
+     end || Pid <- Pids],
+
+    %% We now expect that the binary has been deallocated.
+    provoke_mem_leak(N-1, Code, Check).
+
+create_binaries(Parent, NumRefs, Check) ->
+    Bin = literals:binary(),
+    Bins = lists:duplicate(NumRefs, Bin),
+    {bits,Bits} = literals:bits(),
+    Parent ! {started,self()},
+    receive
+	purged ->
+	    %% The code has been purged. Now make sure that
+	    %% the binaries haven't been corrupted.
+	    Check = erlang:md5(Bin),
+	    [Bin = B || B <- Bins],
+	    <<42:13,Bin/binary>> = Bits,
+
+	    %% Remove all references to the binaries
+	    %% Doing it explicitly like this ensures that
+	    %% the binaries are gone when the parent process
+	    %% receives the 'DOWN' message.
+	    erlang:garbage_collect()
+    end.
+
+wait_for_memory_deallocations() ->
+    try
+	erts_debug:set_internal_state(wait, deallocations)
+    catch
+	error:undef ->
+	    erts_debug:set_internal_state(available_internal_state, true),
+	    wait_for_memory_deallocations()
+    end.
+
 %% 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) ->
diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl
index 9f99b1a780..d9cb8938db 100644
--- a/erts/emulator/test/code_SUITE_data/literals.erl
+++ b/erts/emulator/test/code_SUITE_data/literals.erl
@@ -18,7 +18,7 @@
 %%
 
 -module(literals).
--export([a/0,b/0,huge_bignum/0]).
+-export([a/0,b/0,huge_bignum/0,binary/0,unused_binaries/0,bits/0]).
 
 a() ->
     {a,42.0,[7,38877938333399637266518333334747]}.
@@ -81,3 +81,22 @@ b() ->
 
 huge_bignum() ->
     36#9987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987779JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR073737676679877.
+
+-define(TIMES_FOUR(X), X,X,X,X).
+-define(BYTES_256, 0:256,1:256,2:256,3:256, 4:256,5:256,6:256,7:256).
+-define(KB_1, ?TIMES_FOUR(?BYTES_256)).
+-define(KB_4, ?TIMES_FOUR(?KB_1)).
+-define(KB_16, ?TIMES_FOUR(?KB_4)).
+-define(KB_64, ?TIMES_FOUR(?KB_16)).
+-define(KB_128, ?TIMES_FOUR(?KB_64)).
+-define(MB_1, ?TIMES_FOUR(?KB_128)).
+
+binary() ->
+    %% Too big to be a heap binary.
+    <<?MB_1>>.
+
+unused_binaries() ->
+    {<<?KB_128>>,<<?BYTES_256>>}.
+
+bits() ->
+    {bits,<<42:13,?MB_1>>}.