Add process_info binary_full that provides more details

In particular, this includes the full original binary and all the references.
Gathering this information requires full heap traversal, so is fairly expensive -
that's why we keep both the existing `binary` and this new API.

Example:

```
1> A = <<0:(1024*8)>>.
2> <<B:550/bitstring,D:550/bits,E:550/bits,C/bitstring>> = A.
3> erlang:process_info(self(),[binary_full]).
[{binary_full,[{126812357133856,1024,1,
           <<0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,...>>,
           [{1100,1650},{550,1100},{1650,8192},{0,550},{0,8192}]}]}]
```

Co-authored-by: Lukas Backström <[email protected]>

Author: garazdawi

erts/emulator/beam/atom.names

@@ -136,6 +136,7 @@ atom bif_return_trap
 atom binary
 atom binary_copy_trap
 atom binary_find_trap
+atom binary_full
 atom binary_longest_prefix_trap
 atom binary_longest_suffix_trap
 atom binary_to_list_continue

erts/emulator/beam/erl_bif_info.c

@@ -796,6 +796,7 @@ collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp, Sint reds)
 #define ERTS_PI_IX_DICTIONARY_LOOKUP                    38
 #define ERTS_PI_IX_LABEL                                39
 #define ERTS_PI_IX_PRIORITY_MESSAGES                    40
+#define ERTS_PI_IX_BINARY_FULL                          41
 
 #define ERTS_PI_UNRESERVE(RS, SZ) \
     (ASSERT((RS) >= (SZ)), (RS) -= (SZ))
@@ -849,7 +850,8 @@ static ErtsProcessInfoArgs pi_args[] = {
     {am_async_dist, 0, 0, ERTS_PROC_LOCK_MAIN},
     {am_dictionary, 3, ERTS_PI_FLAG_FORCE_SIG_SEND|ERTS_PI_FLAG_KEY_TUPLE2, ERTS_PROC_LOCK_MAIN},
     {am_label, 0, ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN},
-    {am_priority_messages, 0, 0, ERTS_PROC_LOCK_MAIN}
+    {am_priority_messages, 0, 0, ERTS_PROC_LOCK_MAIN},
+    {am_binary_full, 0, ERTS_PI_FLAG_NEED_MSGQ|ERTS_PI_FLAG_FORCE_SIG_SEND, ERTS_PROC_LOCK_MAIN}
 };
 
 #define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(pi_args[0])))
@@ -948,6 +950,8 @@ pi_arg2ix(Eterm arg, Eterm *extrap)
         return ERTS_PI_IX_TRACE;
     case am_binary:
         return ERTS_PI_IX_BINARY;
+    case am_binary_full:
+        return ERTS_PI_IX_BINARY_FULL;
     case am_sequential_trace_token:
         return ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN;
     case am_catchlevel:
@@ -2156,6 +2160,10 @@ process_info_aux(Process *c_p,
         break;
     }
 
+    case ERTS_PI_IX_BINARY_FULL:
+        res = erts_gather_binaries(hfact, rp);
+        break;
+
     case ERTS_PI_IX_SEQUENTIAL_TRACE_TOKEN: {
         Uint sz = size_object(rp->seq_trace_token);
         hp = erts_produce_heap(hfact, sz, reserve_size);

erts/emulator/beam/erl_gc.c

@@ -3839,6 +3839,173 @@ erts_max_heap_size(Eterm arg, Uint *max_heap_size, Uint *max_heap_flags)
     return 1;
 }
 
+typedef struct debug_binary {
+    BinRef *bin_ref;
+    ErtsDynamicWStack ws;
+} DebugBinary;
+
+static void gather_binaries(DebugBinary *bins, Uint count, Eterm *start, Eterm *stop) {
+    Eterm* tp = start;
+    while (tp < stop) {
+        Eterm val = *tp++;
+
+        switch (primary_tag(val)) {
+        case TAG_PRIMARY_IMMED1:
+        case TAG_PRIMARY_LIST:
+        case TAG_PRIMARY_BOXED:
+            break;
+        case TAG_PRIMARY_HEADER:
+            if (header_is_transparent(val)) {
+                continue;
+            }
+            switch (thing_subtag(val)) {
+                case SUB_BITS_SUBTAG:
+                {
+                    const ErlSubBits *sb = (ErlSubBits*)(tp-1);
+                    const BinRef *underlying = (BinRef*)boxed_val(sb->orig);
+                    if (thing_subtag(underlying->thing_word) != HEAP_BITS_SUBTAG) {
+                        for (Uint i = 0; i < count; i++) {
+                            DebugBinary* b = &bins[i];
+                            if (b->bin_ref == underlying) {
+                                WSTACK_PUSH2(b->ws.ws, sb->start, sb->end);
+                                break;
+                            }
+                        }
+                    }
+                }
+                ERTS_FALLTHROUGH();
+            default:
+                {
+                    tp += header_arity(val);
+                }
+                break;
+            }
+            break;
+        }
+    }
+}
+
+Eterm
+erts_gather_binaries(ErtsHeapFactory *hfact, Process *rp) {
+    #define PSTACK_TYPE DebugBinary
+    PSTACK_DECLARE(binaries, 16);
+
+    union erl_off_heap_ptr u;
+    Eterm res = NIL;
+    Eterm tuple;
+    union erts_tmp_aligned_offheap tmp;
+    Uint binaries_count;
+    DebugBinary* binariesp;
+
+    ErlHeapFragment* bp;
+    ErtsMessage* mp;
+    Eterm *htop, *heap;
+    Uint sz = 0;
+    Eterm *hp;
+
+    for (u.hdr = MSO(rp).first; u.hdr; u.hdr = u.hdr->next) {
+        erts_align_offheap(&u, &tmp);
+        if (u.hdr->thing_word == HEADER_BIN_REF) {
+            DebugBinary* bin = PSTACK_PUSH(binaries);
+            bin->bin_ref = u.br;
+            WSTACK_INIT(&bin->ws, ERTS_ALC_T_ESTACK);
+        }
+    }
+
+    for (u.hdr = rp->wrt_bins; u.hdr; u.hdr = u.hdr->next) {
+        erts_align_offheap(&u, &tmp);
+        if (u.hdr->thing_word == HEADER_BIN_REF) {
+            DebugBinary* bin = PSTACK_PUSH(binaries);
+            bin->bin_ref = u.br;
+            WSTACK_INIT(&bin->ws, ERTS_ALC_T_ESTACK);
+        }
+    }
+    binariesp = (DebugBinary*)binaries.pstart;
+    binaries_count = PSTACK_COUNT(binaries);
+
+    if (rp->abandoned_heap) {
+        heap = get_orig_heap(rp, &htop, NULL);
+        gather_binaries(binariesp, binaries_count, heap, htop);
+    }
+
+    if (OLD_HEAP(rp))
+        gather_binaries(binariesp, binaries_count, OLD_HEAP(rp), OLD_HTOP(rp) /*OLD_HEND(p)*/);
+
+    gather_binaries(binariesp, binaries_count, HEAP_START(rp), HEAP_TOP(rp));
+
+    mp = rp->msg_frag;
+    bp = rp->mbuf;
+
+    if (bp)
+        goto search_heap_frags;
+
+    while (mp) {
+
+        bp = erts_message_to_heap_frag(mp);
+        mp = mp->next;
+
+    search_heap_frags:
+
+        while (bp) {
+            gather_binaries(binariesp, binaries_count,
+                bp->mem, bp->mem + bp->used_size);
+            bp = bp->next;
+        }
+    }
+
+    for (Uint i = 0; i < binaries_count; i++) {
+        DebugBinary b = binariesp[i];
+        sz += 2 /* cons */ + 6 /* tuple (ptr, sz, refc, binary, subs) */;
+        erts_bld_uword(NULL, &sz, (UWord) b.bin_ref->val);
+        erts_bld_uint(NULL, &sz, b.bin_ref->val->orig_size);
+        sz += ERL_REFC_BITS_SIZE;
+        for (UWord *bits = b.ws.ws.wstart; bits < b.ws.ws.wsp; bits += 2) {
+            sz += 2 /* cons */ + 3 /* tuple*/;
+            erts_bld_uword(NULL, &sz, bits[0]);
+            erts_bld_uword(NULL, &sz, bits[1]);
+        }
+    }
+
+    hp = erts_produce_heap(hfact, sz, 2);
+
+    for (Uint i = 0; i < binaries_count; i++) {
+        DebugBinary b = binariesp[i];
+        Eterm bitslist = NIL;
+        Eterm val = erts_bld_uword(&hp, NULL, (UWord)b.bin_ref->val);
+        Eterm orig_size = erts_bld_uint(&hp, NULL, b.bin_ref->val->orig_size);
+        Eterm bitstring;
+        for (UWord *bits = b.ws.ws.wstart; bits < b.ws.ws.wsp; bits += 2) {
+            Eterm offset = erts_bld_uword(&hp, NULL, bits[0]);
+            Eterm size = erts_bld_uword(&hp, NULL, bits[1]);
+            Eterm tuple = TUPLE2(hp, offset, size);
+            hp += 3;
+            bitslist = CONS(hp, tuple, bitslist);
+            hp += 2;
+        }
+        erts_refc_inc(&b.bin_ref->val->intern.refc, 1);
+        bitstring = erts_wrap_refc_bitstring(
+                &hfact->off_heap->first,
+                &hfact->off_heap->overhead,
+                &hp, b.bin_ref->val, (byte*)b.bin_ref->val->orig_bytes,
+                0, b.bin_ref->val->orig_size * 8);
+        WSTACK_DESTROY(b.ws.ws);
+        tuple = TUPLE5(hp, val,
+                orig_size,
+                /* We subtract the bump we did above when copying the binary */
+                make_small(erts_refc_read(&b.bin_ref->val->intern.refc, 1) - 1),
+                bitstring, bitslist);
+        hp += 6;
+        res = CONS(hp, tuple, res);
+        hp += 2;
+
+    }
+
+    PSTACK_DESTROY(binaries);
+    #undef PSTACK_TYPE
+
+    return res;
+}
+
 #if defined(DEBUG) && defined(ERLANG_FRAME_POINTERS)
 void erts_validate_stack(Process *p, Eterm *frame_ptr, Eterm *stack_top) {
     Eterm *stack_bottom = HEAP_END(p);

erts/emulator/beam/erl_gc.h

@@ -190,6 +190,7 @@ int erts_max_heap_size(Eterm, Uint *, Uint *);
 void erts_deallocate_young_generation(Process *c_p);
 void erts_copy_one_frag(Eterm** hpp, ErlOffHeap* off_heap,
                         ErlHeapFragment *bp, Eterm *refs, int nrefs);
+Eterm erts_gather_binaries(ErtsHeapFactory *hfact, Process *p);
 #if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG)
 int erts_dbg_within_proc(Eterm *ptr, Process *p, Eterm* real_htop);
 #endif

erts/emulator/test/binary_SUITE.erl

@@ -80,7 +80,8 @@
          t2b_system_limit/1,
          term_to_iovec/1,
          is_binary_test/1,
-         local_ext/1]).
+         local_ext/1,
+         process_info/1]).
 
 %% Internal exports.
 -export([sleeper/0,trapping_loop/4]).
@@ -110,7 +111,7 @@ all() ->
      robustness, otp_8180, trapping, large,
      error_after_yield, cmp_old_impl,
      is_binary_test,
-     local_ext].
+     local_ext, process_info].
 
 groups() -> 
     [
@@ -2527,3 +2528,40 @@ call_local_fail(Port, [Lext1, Lext3 | Rest]) ->
             ok
     end,
     call_local_fail(Port, Rest).
+
+process_info(_Config) ->
+    Parent = self(),
+    WaitGo = fun() -> receive go -> ok end end,
+    Pid = spawn(fun() ->
+        WaitGo(),
+        A = <<0:(1024*8)>>,
+        <<B:550/bitstring,D:550/bits,E:550/bits,C/bitstring>> = A,
+        State0 = {A, B, C, D, E},
+        Parent ! go,
+        (fun Loop(State) ->
+            receive
+                {new_state, State1} -> Loop(State1);
+                {gc, From} -> erlang:garbage_collect(), From ! go, Loop(State);
+                {get_state, From} -> From ! State, Loop(State)
+            end
+        end)(State0)
+    end),
+    [{binary_full, []}, {binary, []}] = process_info(Pid, [binary_full, binary]),
+    Pid ! go,
+    WaitGo(),
+    [{binary_full, FullInfo}, {binary, Info}] = process_info(Pid, [binary_full, binary]),
+    [{Id, Size, Count}] = Info,
+    [{Id, Size, Count, Bin, Refs}] = FullInfo,
+    true = (lists:sort(Refs) =:=
+        lists:sort([{0,550},{0,8192},{550,1100},{1100,1650},{1650,8192},{1650,8192}])),
+    Pid ! {stuck_in_queue, Bin},
+    Pid ! {new_state, {}},
+    Pid ! {gc, self()},
+    WaitGo(),
+    erlang:garbage_collect(),
+    {binary_full,[{Id,Size,2,Bin,[{0,8192}]}]} = process_info(Pid, binary_full),
+    NewBin = <<0:(1000*8)>>,
+    Pid ! {new_state, NewBin},
+    {binary_full, Info3} = process_info(Pid, binary_full),
+    {value, {Id, Size, 3, Bin, [{0,8192}]}, [NewBinInfo]} = lists:keytake(Id, 1, Info3),
+    {_, 1000, 2, NewBin, [{0,8000}]} = NewBinInfo.

erts/preloaded/src/erlang.erl

@@ -8176,6 +8176,7 @@ process_flag(_Flag, _Value) ->
       async_dist |
       backtrace |
       binary |
+      binary_full |
       catchlevel |
       current_function |
       current_location |
@@ -8218,6 +8219,11 @@ process_flag(_Flag, _Value) ->
       {binary, BinInfo :: [{non_neg_integer(),
                             non_neg_integer(),
                             non_neg_integer()}]} |
+      {binary_full, FullBinInfo :: [{non_neg_integer(),
+                                     non_neg_integer(),
+                                     non_neg_integer(),
+                                     bitstring(),
+                                     [{non_neg_integer(), non_neg_integer()}]}]} |
       {catchlevel, CatchLevel :: non_neg_integer()} |
       {current_function,
        {Module :: module(), Function :: atom(), Arity :: arity()} | undefined} |
@@ -8319,6 +8325,24 @@ Valid `InfoTuple`s with corresponding `Item`s:
   [`message_queue_data`](#process_flag_message_queue_data) process
   flag the message queue may be stored on the heap.
 
+- **`{binary_full, FullBinInfo}`** - `FullBinInfo` is a list containing
+  comprehensive information about binaries on the heap of this process.
+  This `InfoTuple` can be changed or removed without prior notice. In the
+  current implementation `FullBinInfo` is a list of tuples. The tuples begin
+  the same way as the `BinInfo` tuples with `BinaryId`, `BinarySize`,
+  `BinaryRefcCount`, followed by the binary itself and a list of bit ranges
+  for each reference held by the process.
+
+  > #### Warning {: .warning }
+  >
+  > The message will contain the binary itself, meaning the calling process will
+  > hold a new reference to this binary preventing it from being freed, even if the
+  > target process released all references. It is recommended to immediately call
+  > `erlang:garbage_collect/0` from the caller process as soon as it finishes handling
+  > the result of this call to release those extra references.
+
+  Since: OTP 29
+
 - **`{catchlevel, CatchLevel}`** - `CatchLevel` is the number of currently
   active catches in this process. This `InfoTuple` can be changed or removed
   without prior notice.