erts: Create heap binaries in bs_get_binary2

ErlSubBin is a large struct that often dwarfs the region of memory
it points at, and it's common for them to refer to a ProcBin which
must be kept around as long as the SubBin lives, using up even more
heap space and keeping the referenced binary alive regardless of
how small the sub-binary is.

5 files changed, 95 insertions, 52 deletions

diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab
index 4a878ac1db..5f25bc2ad3 100644
--- a/erts/emulator/beam/bs_instrs.tab
+++ b/erts/emulator/beam/bs_instrs.tab
@@ -149,7 +149,7 @@ i_bs_get_binary_all2.execute(Fail, Live, Unit, Dst) {
     ErlBinMatchBuffer *_mb;
     Eterm _result;
 
-    $GC_TEST_PRESERVE(ERL_SUB_BIN_SIZE, $Live, context);
+    $GC_TEST_PRESERVE(EXTRACT_SUB_BIN_HEAP_NEED, $Live, context);
     _mb = ms_matchbuffer(context);
     if (((_mb->size - _mb->offset) % $Unit) == 0) {
         LIGHT_SWAPOUT;
@@ -179,7 +179,7 @@ i_bs_get_binary2.execute(Fail, Live, Sz, Flags, Dst) {
     Eterm _result;
     Uint _size;
     $BS_GET_FIELD_SIZE($Sz, (($Flags) >> 3), $FAIL($Fail), _size);
-    $GC_TEST_PRESERVE(ERL_SUB_BIN_SIZE, $Live, context);
+    $GC_TEST_PRESERVE(EXTRACT_SUB_BIN_HEAP_NEED, $Live, context);
     _mb = ms_matchbuffer(context);
     LIGHT_SWAPOUT;
     _result = erts_bs_get_binary_2(c_p, _size, $Flags, _mb);
@@ -206,8 +206,7 @@ i_bs_get_binary_imm2.fetch(Ctx) {
 i_bs_get_binary_imm2.execute(Fail, Live, Sz, Flags, Dst) {
     ErlBinMatchBuffer *_mb;
     Eterm _result;
-    $GC_TEST_PRESERVE(heap_bin_size(ERL_ONHEAP_BIN_LIMIT),
-                      $Live, context);
+    $GC_TEST_PRESERVE(EXTRACT_SUB_BIN_HEAP_NEED, $Live, context);
     _mb = ms_matchbuffer(context);
     LIGHT_SWAPOUT;
     _result = erts_bs_get_binary_2(c_p, $Sz, $Flags, _mb);
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index df4d79651f..a0edbc81a4 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -458,29 +458,25 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
 Eterm
 erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb)
 {
-    ErlSubBin* sb;
+    Eterm result;
 
     CHECK_MATCH_BUFFER(mb);
-    if (mb->size - mb->offset < num_bits) {	/* Asked for too many bits.  */
-	return THE_NON_VALUE;
+    if (mb->size - mb->offset < num_bits) {
+        /* Asked for too many bits.  */
+        return THE_NON_VALUE;
     }
 
     /*
      * From now on, we can't fail.
      */
 
-    sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE);
-    
-    sb->thing_word = HEADER_SUB_BIN;
-    sb->orig = mb->orig;
-    sb->size = BYTE_OFFSET(num_bits);
-    sb->bitsize = BIT_OFFSET(num_bits);
-    sb->offs = BYTE_OFFSET(mb->offset);
-    sb->bitoffs = BIT_OFFSET(mb->offset);
-    sb->is_writable = 0;
+    result = erts_extract_sub_binary(&HEAP_TOP(p),
+                                     mb->orig, mb->base,
+                                     mb->offset, num_bits);
+
     mb->offset += num_bits;
-    
-    return make_binary(sb);
+
+    return result;
 }
 
 Eterm
@@ -544,21 +540,19 @@ erts_bs_get_float_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer
 Eterm
 erts_bs_get_binary_all_2(Process *p, ErlBinMatchBuffer* mb)
 {
-    ErlSubBin* sb;
-    Uint size;
+    Uint bit_size;
+    Eterm result;
 
     CHECK_MATCH_BUFFER(mb);
-    size =  mb->size-mb->offset;
-    sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE);
-    sb->thing_word = HEADER_SUB_BIN;
-    sb->size = BYTE_OFFSET(size);
-    sb->bitsize = BIT_OFFSET(size);
-    sb->offs = BYTE_OFFSET(mb->offset);
-    sb->bitoffs = BIT_OFFSET(mb->offset);
-    sb->is_writable = 0;
-    sb->orig = mb->orig;
-    mb->offset = mb->size;  
-    return make_binary(sb);
+    bit_size = mb->size - mb->offset;
+
+    result = erts_extract_sub_binary(&HEAP_TOP(p),
+                                     mb->orig, mb->base,
+                                     mb->offset, bit_size);
+
+    mb->offset = mb->size;
+
+    return result;
 }
 
 /****************************************************************
@@ -2096,3 +2090,39 @@ erts_copy_bits(byte* src,	/* Base pointer to source. */
     }
 }
 
+Eterm erts_extract_sub_binary(Eterm **hp, Eterm base_bin, byte *base_data,
+                              Uint bit_offset, Uint bit_size)
+{
+    Uint byte_offset, byte_size;
+
+    ERTS_CT_ASSERT(ERL_SUB_BIN_SIZE <= ERL_ONHEAP_BIN_LIMIT);
+
+    byte_offset = BYTE_OFFSET(bit_offset);
+    byte_size = BYTE_OFFSET(bit_size);
+
+    if (BIT_OFFSET(bit_size) == 0 && byte_size <= ERL_ONHEAP_BIN_LIMIT) {
+        ErlHeapBin *hb = (ErlHeapBin*)*hp;
+        *hp += heap_bin_size(byte_size);
+
+        hb->thing_word = header_heap_bin(byte_size);
+        hb->size = byte_size;
+
+        copy_binary_to_buffer(hb->data, 0, base_data, bit_offset, bit_size);
+
+        return make_binary(hb);
+    } else {
+        ErlSubBin *sb = (ErlSubBin*)*hp;
+        *hp += ERL_SUB_BIN_SIZE;
+
+        sb->thing_word = HEADER_SUB_BIN;
+        sb->size = byte_size;
+        sb->offs = byte_offset;
+        sb->orig = base_bin;
+        sb->bitoffs = BIT_OFFSET(bit_offset);
+        sb->bitsize = BIT_OFFSET(bit_size);
+        sb->is_writable = 0;
+
+        return make_binary(sb);
+    }
+}
+
diff --git a/erts/emulator/beam/erl_bits.h b/erts/emulator/beam/erl_bits.h
index 50d353e1fa..0b2a6f3760 100644
--- a/erts/emulator/beam/erl_bits.h
+++ b/erts/emulator/beam/erl_bits.h
@@ -116,7 +116,7 @@ typedef struct erl_bin_match_struct{
   do {											    \
     if (BIT_OFFSET(DstBufOffset) == 0 && (SrcBufferOffset == 0) &&			    \
         (BIT_OFFSET(NumBits)==0) && (NumBits != 0)) {					    \
-      sys_memcpy(DstBuffer+BYTE_OFFSET(DstBufOffset),					    \
+      sys_memcpy(((byte*)DstBuffer)+BYTE_OFFSET(DstBufOffset),					    \
 		 SrcBuffer, NBYTES(NumBits));						    \
     } else {										    \
       erts_copy_bits(SrcBuffer, SrcBufferOffset, 1,					    \
@@ -150,8 +150,11 @@ void erts_bits_destroy_state(ERL_BITS_PROTO_0);
 Eterm erts_bs_start_match_2(Process *p, Eterm Bin, Uint Max);
 ErlBinMatchState *erts_bs_start_match_3(Process *p, Eterm Bin);
 Eterm erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb);
-Eterm erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb);
 Eterm erts_bs_get_float_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb);
+
+/* These will create heap binaries when appropriate, so they require free space
+ * up to EXTRACT_SUB_BIN_HEAP_NEED. */
+Eterm erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb);
 Eterm erts_bs_get_binary_all_2(Process *p, ErlBinMatchBuffer* mb);
 
 /*
@@ -182,6 +185,17 @@ void erts_copy_bits(byte* src, size_t soffs, int sdir,
 		    byte* dst, size_t doffs,int ddir, size_t n);        
 int erts_cmp_bits(byte* a_ptr, size_t a_offs, byte* b_ptr, size_t b_offs, size_t size); 
 
+
+/* Extracts a region from base_bin as a sub-binary or heap binary, whichever
+ * is the most appropriate.
+ *
+ * The caller must ensure that there's enough free space at *hp */
+Eterm erts_extract_sub_binary(Eterm **hp, Eterm base_bin, byte *base_data,
+                              Uint bit_offset, Uint num_bits);
+
+/* Pessimistic estimate of the words required for erts_extract_sub_binary */
+#define EXTRACT_SUB_BIN_HEAP_NEED (heap_bin_size(ERL_ONHEAP_BIN_LIMIT))
+
 /*
  * Flags for bs_get_* / bs_put_* / bs_init* instructions.
  */
diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl
index 84ed99afa5..10d88c994a 100644
--- a/lib/observer/test/crashdump_helper.erl
+++ b/lib/observer/test/crashdump_helper.erl
@@ -48,7 +48,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) ->
     Ref = make_ref(),
     Pid = self(),
     Bin = list_to_binary(lists:seq(1, 255)),
-    <<_:2,SubBin:17/binary,_/bits>> = Bin,
+    <<_:2,SubBin:65/binary,_/bits>> = Bin,
 
     register(named_port,Port),
 
@@ -102,7 +102,7 @@ remote_proc(P1,Creator) ->
 	  end).
 
 create_binaries() ->
-    Sizes = lists:seq(60, 70) ++ lists:seq(120, 140),
+    Sizes = lists:seq(100, 120) ++ lists:seq(200, 240),
     [begin
          <<H:16/unit:8>> = erlang:md5(<<Size:32>>),
          Data = ((H bsl (8*150)) div (H+7919)),
@@ -113,7 +113,7 @@ create_sub_binaries(Bins) ->
     [create_sub_binary(Bin, Start, LenSub) ||
         Bin <- Bins,
         Start <- [0,1,2,3,4,5,10,22],
-        LenSub <- [0,1,2,3,4,6,9]].
+        LenSub <- [0,1,2,3,4,6,9,65]].
 
 create_sub_binary(Bin, Start, LenSub) ->
     Len = byte_size(Bin) - LenSub - Start,
diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl
index 9b2033ec4a..be8ab3b98e 100644
--- a/lib/stdlib/test/binary_module_SUITE.erl
+++ b/lib/stdlib/test/binary_module_SUITE.erl
@@ -716,22 +716,22 @@ referenced(Config) when is_list(Config) ->
     badarg = ?MASK_ERROR(binary:referenced_byte_size(apa)),
     badarg = ?MASK_ERROR(binary:referenced_byte_size({})),
     badarg = ?MASK_ERROR(binary:referenced_byte_size(1)),
-    A = <<1,2,3>>,
-    B = binary:copy(A,1000),
-    3 = binary:referenced_byte_size(A),
-    3000 = binary:referenced_byte_size(B),
-    <<_:8,C:2/binary>> = A,
-    3 = binary:referenced_byte_size(C),
-    2 = binary:referenced_byte_size(binary:copy(C)),
-    <<_:7,D:2/binary,_:1>> = A,
-    2 = binary:referenced_byte_size(binary:copy(D)),
-    3 = binary:referenced_byte_size(D),
-    <<_:8,E:2/binary,_/binary>> = B,
-    3000 = binary:referenced_byte_size(E),
-    2 = binary:referenced_byte_size(binary:copy(E)),
-    <<_:7,F:2/binary,_:1,_/binary>> = B,
-    2 = binary:referenced_byte_size(binary:copy(F)),
-    3000 = binary:referenced_byte_size(F),
+    A = <<0:(1024 * 8)>>,
+    B = binary:copy(A, 1000),
+    1024 = binary:referenced_byte_size(A),
+    1024000 = binary:referenced_byte_size(B),
+    <<_:8,C:1023/binary>> = A,
+    1024 = binary:referenced_byte_size(C),
+    1023 = binary:referenced_byte_size(binary:copy(C)),
+    <<_:7,D:1023/binary,_:1>> = A,
+    1023 = binary:referenced_byte_size(binary:copy(D)),
+    1024 = binary:referenced_byte_size(D),
+    <<_:8,E:128/binary,_/binary>> = B,
+    1024000 = binary:referenced_byte_size(E),
+    128 = binary:referenced_byte_size(binary:copy(E)),
+    <<_:7,F:128/binary,_:1,_/binary>> = B,
+    128 = binary:referenced_byte_size(binary:copy(F)),
+    1024000 = binary:referenced_byte_size(F),
     ok.