From 5277d99c337d85766dd8c087413ae7598390e743 Mon Sep 17 00:00:00 2001
From: Frej Drejhammar <frej.drejhammar@gmail.com>
Date: Thu, 4 May 2023 14:57:56 +0200
Subject: compiler: Avoid invalid code for bs_create_bin with initial literal

This change stops the compiler from generating invalid code when
bs_create_bin is given a literal <<>> as its first fragment. As the
type analyzer considers a literal <<>> an appendable bitstring, code
sequences such as:

_6 = bs_create_bin `append`, `[8,{segment,1}]`, `<<>>`, `all`
...
_14 = bs_create_bin `append`, `[8,{segment,1}]`, _6, `all`

would be rewritten to:

_6 = bs_create_bin `private_append`, `[8,{segment,1}]`, `<<>>`, `all`
...
_14 = bs_create_bin `private_append`, `[8,{segment,1}]`, _6, `all`

which is not legal, as private_append on a literal will crash the
runtime system.

By inserting a bs_init_writable in front of bs_create_bin instructions
with a literal <<>> as the first fragment, and then using the freshly
created writable binary instead of the literal, the code sequence
becomes valid:

_1 = bs_init_writable `256`
_6 = bs_create_bin `private_append`, `[8,{segment,1}]`, _1, `all`
...
_14 = bs_create_bin `private_append`, `[8,{segment,1}]`, _6, `all`
---
 lib/compiler/src/beam_ssa_private_append.erl       | 21 +++++++++++++++++
 .../beam_ssa_check_SUITE_data/private_append.erl   | 27 +++++++++++++++++++++-
 2 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/lib/compiler/src/beam_ssa_private_append.erl b/lib/compiler/src/beam_ssa_private_append.erl
index bf51e8b81a..c295492762 100644
--- a/lib/compiler/src/beam_ssa_private_append.erl
+++ b/lib/compiler/src/beam_ssa_private_append.erl
@@ -85,6 +85,17 @@ find_appends_blk([{_Lbl,#b_blk{is=Is}}|Linear], Fun, Found0) ->
 find_appends_blk([], _, Found) ->
     Found.
 
+find_appends_is([#b_set{dst=Dst, op=bs_create_bin,
+                        args=[#b_literal{val=append},
+                              _,
+                              Lit=#b_literal{val= <<>>}|_]}|Is],
+                Fun, Found0) ->
+    %% Special case for when the first fragment is a literal <<>> as
+    %% it won't be annotated as unique nor will it die with the
+    %% instruction.
+    AlreadyFound = maps:get(Fun, Found0, []),
+    Found = Found0#{Fun => [{append,Dst,Lit}|AlreadyFound]},
+    find_appends_is(Is, Fun, Found);
 find_appends_is([#b_set{dst=Dst, op=bs_create_bin,
                         args=[#b_literal{val=append},SegmentInfo,Var|_],
                         anno=#{first_fragment_dies:=Dies}=Anno}|Is],
@@ -468,6 +479,16 @@ patch_appends_is([I0=#b_set{dst=Dst}|Rest], PD0, Cnt0, Acc, BlockAdditions0)
             Ps = keysort(1, map(ExtractOpargs, Patches)),
             {Is, Cnt} = patch_opargs(I0, Ps, Cnt0),
             patch_appends_is(Rest, PD, Cnt, Is++Acc, BlockAdditions0);
+        [{append,Dst,#b_literal{val= <<>>}=Lit}] ->
+            %% Special case for when the first fragment is a literal
+            %% <<>> and it has to be replaced with a bs_init_writable.
+            #b_set{op=bs_create_bin,dst=Dst,args=Args0}=I0,
+            [#b_literal{val=append},SegInfo,Lit|OtherArgs] = Args0,
+            {V,Cnt} = new_var(Cnt0),
+            Init = #b_set{op=bs_init_writable,dst=V,args=[#b_literal{val=256}]},
+            I = I0#b_set{args=[#b_literal{val=private_append},
+                               SegInfo,V|OtherArgs]},
+            patch_appends_is(Rest, PD, Cnt, [I,Init|Acc], BlockAdditions0);
         [{append,Dst,_}] ->
             #b_set{op=bs_create_bin,dst=Dst,args=Args0}=I0,
             [#b_literal{val=append}|OtherArgs] = Args0,
diff --git a/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl b/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl
index 4d4b0f1bbd..c1edc54460 100644
--- a/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl
+++ b/lib/compiler/test/beam_ssa_check_SUITE_data/private_append.erl
@@ -22,6 +22,8 @@
 %%
 -module(private_append).
 
+-feature(maybe_expr, enable).
+
 -export([transformable0/1,
 	 transformable1/1,
 	 transformable1b/1,
@@ -76,7 +78,9 @@
          not_transformable14/0,
          not_transformable15/2,
 
-         id/1]).
+         id/1,
+
+         bs_create_bin_on_literal/0]).
 
 %% Trivial smoke test
 transformable0(L) ->
@@ -977,3 +981,24 @@ not_transformable15(_, V) ->
 
 id(I) ->
     I.
+
+%% Check that we don't try to private_append to something created by
+%% bs_create_bin `append`, _, `<<>>`, ...
+bs_create_bin_on_literal() ->
+%ssa% () when post_ssa_opt ->
+%ssa% X = bs_init_writable(_),
+%ssa% Y = bs_create_bin(private_append, _, X, ...),
+%ssa% Z = bs_create_bin(private_append, _, Y, ...),
+%ssa% ret(Z).
+    <<
+      <<
+	(maybe
+	     2147483647 ?= ok
+	 else
+	     <<_>> ->
+		 ok;
+	     _ ->
+		 <<>>
+	 end)/bytes
+      >>/binary
+    >>.
-- 
cgit v1.2.1