Dump literals separately to avoid incomplete heap data

When a literal was used from several processes, the literal would
be dumped in only one of the processes. The other processes
that referenced the literals would have incomplete heap data.

3 files changed, 257 insertions, 7 deletions

diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 9ae1a36d6f..d893853063 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -52,6 +52,9 @@ static void print_function_from_pc(fmtfn_t to, void *to_arg, BeamInstr* x);
 static void heap_dump(fmtfn_t to, void *to_arg, Eterm x);
 static void dump_binaries(fmtfn_t to, void *to_arg, Binary* root);
 static void dump_externally(fmtfn_t to, void *to_arg, Eterm term);
+static void dump_literals(fmtfn_t to, void *to_arg);
+static void dump_module_literals(fmtfn_t to, void *to_arg,
+                                 struct erl_module_instance* mp);
 
 static Binary* all_binaries;
 
@@ -59,7 +62,6 @@ extern BeamInstr beam_apply[];
 extern BeamInstr beam_exit[];
 extern BeamInstr beam_continue_exit[];
 
-
 void
 erts_deep_process_dump(fmtfn_t to, void *to_arg)
 {
@@ -76,6 +78,7 @@ erts_deep_process_dump(fmtfn_t to, void *to_arg)
        }
     }
 
+    dump_literals(to, to_arg);
     dump_binaries(to, to_arg, all_binaries);
 }
 
@@ -374,7 +377,7 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x)
 	    next = (Eterm *) x;
 	} else if (is_list(x)) {
 	    ptr = list_val(x);
-	    if (ptr[0] != OUR_NIL) {
+	    if (ptr[0] != OUR_NIL && !erts_is_literal(x, ptr)) {
 		erts_print(to, to_arg, PTR_FMT ":l", ptr);
 		dump_element(to, to_arg, ptr[0]);
 		erts_putc(to, to_arg, '|');
@@ -393,7 +396,7 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x)
 
 	    ptr = boxed_val(x);
 	    hdr = *ptr;
-	    if (hdr != OUR_NIL) {	/* If not visited */
+	    if (hdr != OUR_NIL && !erts_is_literal(x, ptr)) {
 		erts_print(to, to_arg, PTR_FMT ":", ptr);
 	        if (is_arity_value(hdr)) {
 		    Uint i;
@@ -639,6 +642,204 @@ dump_externally(fmtfn_t to, void *to_arg, Eterm term)
     }
 }
 
+static void
+dump_literals(fmtfn_t to, void *to_arg)
+{
+    int i;
+    Module* modp;
+    ErtsCodeIndex code_ix;
+
+    code_ix = erts_active_code_ix();
+    erts_rlock_old_code(code_ix);
+
+    erts_print(to, to_arg, "=literals\n");
+
+    for (i = 0; i < module_code_size(code_ix); i++) {
+	modp = module_code(i, code_ix);
+        if (modp == NULL) {
+            continue;
+        }
+        dump_module_literals(to, to_arg, &modp->curr);
+        dump_module_literals(to, to_arg, &modp->old);
+    }
+    erts_runlock_old_code(code_ix);
+}
+
+static void
+dump_module_literals(fmtfn_t to, void *to_arg, struct erl_module_instance* mp)
+{
+    BeamCodeHeader* code;
+    ErtsLiteralArea* lit_area;
+    Eterm* htop;
+    Eterm* hend;
+
+    if (mp->code_length == 0) {
+        return;
+    }
+    code = mp->code_hdr;
+    lit_area = code->literal_area;
+    htop = lit_area->start;
+    hend = lit_area->end;
+    while (htop < hend) {
+        Eterm w = *htop;
+        Eterm term;
+        Uint size;
+
+        switch (primary_tag(w)) {
+        case TAG_PRIMARY_HEADER:
+            term = make_boxed(htop);
+            erts_print(to, to_arg, PTR_FMT ":", htop);
+            if (is_arity_value(w)) {
+                Uint i;
+                Uint arity = arityval(w);
+
+                erts_print(to, to_arg, "t" ETERM_FMT ":", arity);
+                for (i = 1; i <= arity; i++) {
+                    dump_element(to, to_arg, htop[i]);
+                    if (i < arity) {
+                        erts_putc(to, to_arg, ',');
+                    }
+                }
+                erts_putc(to, to_arg, '\n');
+            } else if (w == HEADER_FLONUM) {
+                FloatDef f;
+                char sbuf[31];
+                int i;
+
+                GET_DOUBLE_DATA((htop+1), f);
+                i = sys_double_to_chars(f.fd, sbuf, sizeof(sbuf));
+                sys_memset(sbuf+i, 0, 31-i);
+                erts_print(to, to_arg, "F%X:%s\n", i, sbuf);
+            } else if (_is_bignum_header(w)) {
+                erts_print(to, to_arg, "B%T\n", term);
+            } else if (is_binary_header(w)) {
+                Uint tag = thing_subtag(w);
+                Uint size = binary_size(term);
+                Uint i;
+
+                if (tag == HEAP_BINARY_SUBTAG) {
+                    byte* p;
+
+                    erts_print(to, to_arg, "Yh%X:", size);
+                    p = binary_bytes(term);
+                    for (i = 0; i < size; i++) {
+                        erts_print(to, to_arg, "%02X", p[i]);
+                    }
+                } else if (tag == REFC_BINARY_SUBTAG) {
+                    ProcBin* pb = (ProcBin *) binary_val(term);
+                    Binary* val = pb->val;
+
+                    if (erts_atomic_xchg_nob(&val->intern.refc, 0) != 0) {
+                        val->intern.flags = (UWord) all_binaries;
+                        all_binaries = val;
+                    }
+                    erts_print(to, to_arg,
+                               "Yc" PTR_FMT ":" PTR_FMT ":" PTR_FMT,
+                               val,
+                               pb->bytes - (byte *)val->orig_bytes,
+                               size);
+                } else if (tag == SUB_BINARY_SUBTAG) {
+                    ErlSubBin* Sb = (ErlSubBin *) binary_val(term);
+                    Eterm* real_bin;
+                    void* val;
+
+                    real_bin = boxed_val(Sb->orig);
+                    if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) {
+                        /*
+                         * Unvisited REFC_BINARY: Point directly to
+                         * the binary.
+                         */
+                        ProcBin* pb = (ProcBin *) real_bin;
+                        val = pb->val;
+                    } else {
+                        /*
+                         * Heap binary or visited REFC binary: Point
+                         * to heap binary or ProcBin on the heap.
+                         */
+                        val = real_bin;
+                    }
+                    erts_print(to, to_arg,
+                               "Ys" PTR_FMT ":" PTR_FMT ":" PTR_FMT,
+                               val, Sb->offs, size);
+                }
+                erts_putc(to, to_arg, '\n');
+            } else if (is_map_header(w)) {
+                if (is_flatmap_header(w)) {
+                    flatmap_t* fmp = (flatmap_t *) flatmap_val(term);
+                    Eterm* values = htop + sizeof(flatmap_t) / sizeof(Eterm);
+                    Uint map_size = fmp->size;
+                    int i;
+
+                    erts_print(to, to_arg, "Mf" ETERM_FMT ":", map_size);
+                    dump_element(to, to_arg, fmp->keys);
+                    erts_putc(to, to_arg, ':');
+                    for (i = 0; i < map_size; i++) {
+                        dump_element(to, to_arg, values[i]);
+                        if (i < map_size-1) {
+                            erts_putc(to, to_arg, ',');
+                        }
+                    }
+                    erts_putc(to, to_arg, '\n');
+                } else {
+                    Uint i;
+                    Uint sz = 0;
+                    Eterm* nodes = htop + 1;
+
+                    switch (MAP_HEADER_TYPE(w)) {
+                    case MAP_HEADER_TAG_HAMT_HEAD_ARRAY:
+                        nodes++;
+                        sz = 16;
+                        erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":",
+                                   hashmap_size(term), sz);
+                        break;
+                    case MAP_HEADER_TAG_HAMT_HEAD_BITMAP:
+                        nodes++;
+                        sz = hashmap_bitcount(MAP_HEADER_VAL(w));
+                        erts_print(to, to_arg, "Mh" ETERM_FMT ":" ETERM_FMT ":",
+                                   hashmap_size(term), sz);
+                        break;
+                    case MAP_HEADER_TAG_HAMT_NODE_BITMAP:
+                        sz = hashmap_bitcount(MAP_HEADER_VAL(w));
+                        erts_print(to, to_arg, "Mn" ETERM_FMT ":", sz);
+                        break;
+                    }
+                    for (i = 0; i < sz; i++) {
+                        dump_element(to, to_arg, nodes[i]);
+                        if (i < sz-1) {
+                            erts_putc(to, to_arg, ',');
+                        }
+                    }
+                    erts_putc(to, to_arg, '\n');
+                }
+            }
+            size = 1 + header_arity(w);
+            switch (w & _HEADER_SUBTAG_MASK) {
+            case MAP_SUBTAG:
+                if (is_flatmap_header(w)) {
+                    size += 1 + flatmap_get_size(htop);
+                } else {
+                    size += hashmap_bitcount(MAP_HEADER_VAL(w));
+                }
+                break;
+            case SUB_BINARY_SUBTAG:
+                size += 1;
+                break;
+            }
+            break;
+        default:
+            ASSERT(!is_header(htop[1]));
+            erts_print(to, to_arg, PTR_FMT ":l", htop);
+            dump_element(to, to_arg, htop[0]);
+            erts_putc(to, to_arg, '|');
+            dump_element(to, to_arg, htop[1]);
+            erts_putc(to, to_arg, '\n');
+            size = 2;
+            break;
+        }
+        htop += size;
+    }
+}
+
 void erts_dump_process_state(fmtfn_t to, void *to_arg, erts_aint32_t psflg)
 {
     char *s;
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index bc3ce5d547..ddf2879a97 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -104,6 +104,7 @@
 -define(index_table,index_table).
 -define(instr_data,instr_data).
 -define(internal_ets,internal_ets).
+-define(literals,literals).
 -define(loaded_modules,loaded_modules).
 -define(memory,memory).
 -define(memory_map,memory_map).
@@ -785,6 +786,9 @@ parse_vsn_str(Str,WS) ->
 %%% Progress is reported during the time and MUST be checked with
 %%% crashdump_viewer:get_progress/0 until it returns {ok,done}.
 do_read_file(File) ->
+    erase(?literals),                           %Clear literal cache.
+    put(truncated,false),                       %Not truncated (yet).
+    erase(truncated_reason),                    %Not truncated (yet).
     case file:read_file_info(File) of
 	{ok,#file_info{type=regular,
 		       access=FileA,
@@ -856,6 +860,19 @@ indexify(Fd,AddrAdj,Bin,N) ->
                 {?proc_heap,LastId} ->
                     [{_,LastPos}] = lookup_index(?proc_heap,LastId),
                     ets:insert(cdv_heap_file_chars,{LastId,N+Start+1-LastPos});
+                {?literals,[]} ->
+                    case get(truncated_reason) of
+                        undefined ->
+                            [{_,LastPos}] = lookup_index(?literals,[]),
+                            ets:insert(cdv_heap_file_chars,
+                                       {literals,N+Start+1-LastPos});
+                        _ ->
+                            %% Literals are truncated. Make sure we never
+                            %% attempt to read in the literals. (Heaps that
+                            %% references literals will show markers for
+                            %% incomplete heaps, but will otherwise work.)
+                            delete_index(?literals, [])
+                    end;
                 _ -> ok
             end,
 	    indexify(Fd,AddrAdj,Rest,N1);
@@ -908,6 +925,7 @@ check_if_truncated() ->
 find_truncated_proc({Tag,_Id}) when Tag==?atoms;
                                     Tag==?binary;
                                     Tag==?instr_data;
+                                    Tag==?literals;
                                     Tag==?memory_status;
                                     Tag==?memory_map ->
     put(truncated_proc,false);
@@ -1386,13 +1404,33 @@ maybe_other_node2(Channel) ->
 expand_memory(Fd,Pid,DumpVsn) ->
     BinAddrAdj = get_bin_addr_adj(DumpVsn),
     put(fd,Fd),
-    Dict = read_heap(Fd,Pid,BinAddrAdj,gb_trees:empty()),
+    Dict0 = case get(?literals) of
+                undefined ->
+                    Literals = read_literals(Fd),
+                    put(?literals,Literals),
+                    put(fd,Fd),
+                    Literals;
+                Literals ->
+                    Literals
+            end,
+    Dict = read_heap(Fd,Pid,BinAddrAdj,Dict0),
     Expanded = {read_stack_dump(Fd,Pid,BinAddrAdj,Dict),
 		read_messages(Fd,Pid,BinAddrAdj,Dict),
 		read_dictionary(Fd,Pid,BinAddrAdj,Dict)},
     erase(fd),
     Expanded.
 
+read_literals(Fd) ->
+    case lookup_index(?literals,[]) of
+	[{_,Start}] ->
+            [{_,Chars}] = ets:lookup(cdv_heap_file_chars,literals),
+            init_progress("Reading literals",Chars),
+	    pos_bof(Fd,Start),
+	    read_heap(0,gb_trees:empty());
+        [] ->
+            gb_trees:empty()
+    end.
+
 %%%-----------------------------------------------------------------
 %%% This is a workaround for a bug in dump versions prior to 0.3:
 %%% Addresses were truncated to 32 bits. This could cause binaries to
@@ -2829,6 +2867,10 @@ reset_tables() ->
 insert_index(Tag,Id,Pos) ->
     ets:insert(cdv_dump_index_table,{{Tag,Pos},Id}).
 
+delete_index(Tag,Id) ->
+    Ms = [{{{Tag,'$1'},Id},[],[true]}],
+    ets:select_delete(cdv_dump_index_table, Ms).
+
 lookup_index({Tag,Id}) ->
     lookup_index(Tag,Id);
 lookup_index(Tag) ->
@@ -2845,6 +2887,7 @@ insert_binary_index(Addr,Pos) ->
 lookup_binary_index(Addr) ->
     ets:lookup(cdv_binary_index_table,Addr).
 
+
 %%-----------------------------------------------------------------
 %% Convert tags read from crashdump to atoms used as first part of key
 %% in cdv_dump_index_table
@@ -2862,6 +2905,7 @@ tag_to_atom("hidden_node") -> ?hidden_node;
 tag_to_atom("index_table") -> ?index_table;
 tag_to_atom("instr_data") -> ?instr_data;
 tag_to_atom("internal_ets") -> ?internal_ets;
+tag_to_atom("literals") -> ?literals;
 tag_to_atom("loaded_modules") -> ?loaded_modules;
 tag_to_atom("memory") -> ?memory;
 tag_to_atom("mod") -> ?mod;
@@ -2885,8 +2929,10 @@ tag_to_atom(UnknownTag) ->
 %%%-----------------------------------------------------------------
 %%% Store last tag for use when truncated, and reason if aborted
 put_last_tag(?abort,Reason) ->
-    %% Don't overwrite the real last tag
-    put(truncated_reason,Reason);
+    %% Don't overwrite the real last tag, and make sure to return
+    %% the previous last tag.
+    put(truncated_reason,Reason),
+    get(last_tag);
 put_last_tag(Tag,Id) ->
     put(last_tag,{Tag,Id}).
 
diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl
index 0ec6d8dcfc..6ac9d7d3fb 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -613,7 +613,10 @@ truncate_dump(File) ->
                   {win32,_} -> <<"\r\n">>;
                   _ -> <<"\n">>
               end,
-    [StartBin,AfterTag] = binary:split(Bin,BinTag),
+    %% Split after "our binary" created by crashdump_helper
+    %% (it may not be the first binary).
+    RE = <<"\n=binary:(?=[0-9A-Z]+",NewLine/binary,"FF:010203)">>,
+    [StartBin,AfterTag] = re:split(Bin,RE,[{parts,2}]),
     [AddrAndSize,BinaryAndRest] = binary:split(AfterTag,Colon),
     [Binary,_Rest] = binary:split(BinaryAndRest,NewLine),
     TruncSize = byte_size(Binary) - 2,