From 6b00105e25aa243045878ad804e9928604f0c566 Mon Sep 17 00:00:00 2001
From: Frej Drejhammar <frej.drejhammar@gmail.com>
Date: Tue, 2 Jul 2024 15:52:58 +0200
Subject: [PATCH] compiler: Fix crash in beam_ssa_private_append

With the right input, the beam_ssa_private_append pass could crash
when it, during the initial value tracking phase, selected literals
which were not compatible with the tracked element structure for later
patching. This patch ensures that only compatible literals are
scheduled for later patching.

This crash is only present in OTP versions >= 26 && <= 27 and this fix
should not be merged to master as dce585f933d0 ("compiler: In-place
update of tuples/records"), merged for OTP 27, includes essentially
the same functionality.

Closes #8630
---
 lib/compiler/src/beam_ssa_private_append.erl  | 35 +++++++++++--------
 .../private_append.erl                        | 13 ++++++-
 2 files changed, 32 insertions(+), 16 deletions(-)

diff --git a/lib/compiler/src/beam_ssa_private_append.erl b/lib/compiler/src/beam_ssa_private_append.erl
index e1911f173b1..36fb46babca 100644
--- a/lib/compiler/src/beam_ssa_private_append.erl
+++ b/lib/compiler/src/beam_ssa_private_append.erl
@@ -185,17 +185,10 @@ get_results([{Lbl,#b_blk{last=#b_ret{arg=#b_literal{val=Lit}}}}|Rest],
     %% appendable binary, it can happen that we encounter literals
     %% which do not match the type of the element. We can safely stop
     %% the tracking in that case.
-    Continue = case Element of
-                   {tuple_element,_,_} ->
-                       is_tuple(Lit);
-                   self ->
-                       is_bitstring(Lit);
-                   {hd,_} ->
-                       is_list(Lit) andalso (Lit =/= [])
-               end,
-    DefSt = if Continue ->
+    DefSt = case is_lit_compatible_with_element(Lit, Element) of
+                true ->
                     add_literal(Fun, {ret,Lbl,Element}, DefSt0);
-               true ->
+                false ->
                     DefSt0
             end,
     get_results(Rest, Acc, Element, Fun, DefSt);
@@ -204,6 +197,16 @@ get_results([_|Rest], Acc, Element, Fun, DefSt) ->
 get_results([], Acc, _, _Fun, DefSt) ->
     {Acc, DefSt}.
 
+is_lit_compatible_with_element(Lit, Element) ->
+    case Element of
+        {tuple_element,_,_} ->
+            is_tuple(Lit);
+        self ->
+            is_bitstring(Lit);
+        {hd,_} ->
+            is_list(Lit) andalso (Lit =/= [])
+    end.
+
 track_value_in_fun([{#b_var{}=V,Element}|Rest], Fun, Work,
                    Defs, ValuesInFun, DefSt0)
   when is_map_key({V,Element}, ValuesInFun) ->
@@ -378,15 +381,17 @@ gca(Args, Element, Idx, Fun, Dst, DefSt) ->
 gca([#b_var{}=V|_], I, Element, I, _Fun, _Dst, DefSt) ->
     %% This is the argument we are tracking.
     {[{V,Element}], DefSt};
-gca([#b_literal{val=Lit}|_], I, self, I, _Fun, _Dst, DefSt)
-  when not is_bitstring(Lit)->
+gca([#b_literal{val=Lit}|_], I, Element, I, Fun, Dst, DefSt) ->
     %% As value tracking is done without type information, we can
     %% follow def chains which don't terminate in a bitstring. This is
     %% harmless, but we should ignore them and not, later on, try to
     %% patch them to a bs_writable_binary.
-    {[], DefSt};
-gca([#b_literal{val=Lit}|_], I, Element, I, Fun, Dst, DefSt) ->
-    {[], add_literal(Fun, {opargs,Dst,I+1,Lit,Element}, DefSt)};
+    case is_lit_compatible_with_element(Lit, Element) of
+        true ->
+            {[], add_literal(Fun, {opargs,Dst,I+1,Lit,Element}, DefSt)};
+        false ->
+            {[], DefSt}
+    end;
 gca([_|Args], I, Element, Idx, Fun, Dst, DefSt) ->
     gca(Args, I + 1, Element, Idx, Fun, Dst, DefSt).
 
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 c522607b2d7..b3f929c9e2d 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
@@ -83,7 +83,8 @@
          bs_create_bin_on_literal/0,
 
          crash_in_value_tracking/3,
-         crash_in_value_tracking_inner/3]).
+         crash_in_value_tracking_inner/3,
+         gh8630/1]).
 
 %% Trivial smoke test
 transformable0(L) ->
@@ -1025,3 +1026,13 @@ crash_in_value_tracking(_, _V0, _) ->
     ((<<((crash_in_value_tracking_inner(
             {#{#{ ok => ok || _ := _ <- ok} => ok},
              _V0, false, _V0, "Bo"}, _V0, ok)))/bytes>>) =/= ok).
+
+gh8630(<<"\\",R/binary>>, Xs) ->
+%ssa% (_, _) when post_ssa_opt ->
+%ssa% _ = bs_init_writable(_).
+    gh8630(R, [<<>> | Xs]);
+gh8630(<<A:8,R/binary>>, [X|Xs]) ->
+    gh8630(R, [<<X/binary,A:8>> | Xs]).
+
+gh8630(I) ->
+    gh8630(I, []).