From f0c91912a6bb1a892ac4cadc2ffa92635ca61c9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sun, 7 Apr 2024 09:11:31 +0200 Subject: [PATCH] compiler: Do strength reduction of the hint for update_record Change the hint from `reuse` to `copy` when reusing clearly will not work. Extending this optimization to be module-global, and not just work at the function level, increases the time spent on this pass by a factor of between 4 and 5 and only triggers infrequently, and for example, never allows for additional destructive updates. For the moment this is considered good enough. Co-authored-by: Frej Drejhammar --- lib/compiler/src/beam_ssa_opt.erl | 86 ++++++++++++++- lib/compiler/test/beam_ssa_check_SUITE.erl | 5 + .../test/beam_ssa_check_SUITE_data/alias.erl | 4 +- .../no_reuse_hint.erl | 102 ++++++++++++++++++ 4 files changed, 194 insertions(+), 3 deletions(-) create mode 100644 lib/compiler/test/beam_ssa_check_SUITE_data/no_reuse_hint.erl diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index dd1c985421da..913663d26c32 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -295,7 +295,8 @@ epilogue_module_passes(Opts) -> early_epilogue_passes(Opts) -> Ps = [?PASS(ssa_opt_type_finish), ?PASS(ssa_opt_float), - ?PASS(ssa_opt_sw)], + ?PASS(ssa_opt_sw), + ?PASS(ssa_opt_no_reuse)], passes_1(Ps, Opts). late_epilogue_passes(Opts) -> @@ -3711,6 +3712,89 @@ build_bs_ensure_match(L, {_,Size,Unit}, Count0, Blocks0) -> {Blocks,Count}. +%%% +%%% Change the `reuse` hint to `copy` when it is highly probable that +%%% reuse will not happen. +%%% + +ssa_opt_no_reuse({#opt_st{ssa=Linear0}=St, FuncDb}) when is_list(Linear0) -> + New = sets:new([{version,2}]), + Linear = ssa_opt_no_reuse_blks(Linear0, New), + {St#opt_st{ssa=Linear}, FuncDb}. + +ssa_opt_no_reuse_blks([{L,#b_blk{is=Is0}=Blk0}|Bs], New0) -> + {Is,New} = ssa_opt_no_reuse_is(Is0, New0, []), + Blk = Blk0#b_blk{is=Is}, + [{L,Blk}|ssa_opt_no_reuse_blks(Bs, New)]; +ssa_opt_no_reuse_blks([], _) -> + []. + +ssa_opt_no_reuse_is([#b_set{op=update_record,args=Args}=I0|Is], New, Acc) -> + [_,_,_|Updates] = Args, + case cannot_reuse(Updates, New) of + true -> + I = I0#b_set{args=[#b_literal{val=copy}|tl(Args)]}, + ssa_opt_no_reuse_is(Is, New, [I|Acc]); + false -> + ssa_opt_no_reuse_is(Is, New, [I0|Acc]) + end; +ssa_opt_no_reuse_is([#b_set{dst=Dst}=I|Is], New0, Acc) -> + case inhibits_reuse(I, New0) of + true -> + New = sets:add_element(Dst, New0), + ssa_opt_no_reuse_is(Is, New, [I|Acc]); + false -> + ssa_opt_no_reuse_is(Is, New0, [I|Acc]) + end; +ssa_opt_no_reuse_is([], New, Acc) -> + {reverse(Acc),New}. + +inhibits_reuse(#b_set{op=phi,args=Args}, New) -> + all(fun({Value,_}) -> + sets:is_element(Value, New) + end, Args); +inhibits_reuse(#b_set{op=put_map,args=[_|Args]}, New) -> + cannot_reuse(Args, New); +inhibits_reuse(#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=Name}}|_]}, + _New) -> + case Name of + '++' -> true; + '--' -> true; + atom_to_list -> true; + atom_to_binary -> true; + list_to_tuple -> true; + make_ref -> true; + monitor -> true; + setelement -> true; + send_after -> true; + spawn -> true; + spawn_link -> true; + spawn_monitor -> true; + tuple_to_list -> true; + _ -> false + end; +inhibits_reuse(#b_set{op={bif,Arith},args=[#b_var{},#b_literal{}]}, _New) + when Arith =:= '+'; Arith =:= '-' -> + %% This is probably a counter in a record being updated. (Heuristic, + %% but with a high probability of being correct). + true; +inhibits_reuse(#b_set{op=Op}, _New) -> + case Op of + bs_create_bin -> true; + bs_get_tail -> true; + make_fun -> true; + put_list -> true; + put_tuple -> true; + _ -> false + end. + +cannot_reuse([V|Values], New) -> + sets:is_element(V, New) orelse cannot_reuse(Values, New); +cannot_reuse([], _New) -> + false. + %%% %%% Common utilities. %%% diff --git a/lib/compiler/test/beam_ssa_check_SUITE.erl b/lib/compiler/test/beam_ssa_check_SUITE.erl index 013aacad7487..54baeb07f286 100644 --- a/lib/compiler/test/beam_ssa_check_SUITE.erl +++ b/lib/compiler/test/beam_ssa_check_SUITE.erl @@ -32,6 +32,7 @@ annotation_checks/1, appendable_checks/1, bs_size_unit_checks/1, + no_reuse_hint_checks/1, private_append_checks/1, ret_annotation_checks/1, sanity_checks/1, @@ -47,6 +48,7 @@ groups() -> [alias_checks, annotation_checks, appendable_checks, + no_reuse_hint_checks, private_append_checks, ret_annotation_checks, sanity_checks, @@ -99,6 +101,9 @@ appendable_checks(Config) when is_list(Config) -> bs_size_unit_checks(Config) when is_list(Config) -> gen_and_run_post_ssa_opt(bs_size_unit_checks, Config). +no_reuse_hint_checks(Config) when is_list(Config) -> + run_post_ssa_opt(no_reuse_hint, Config). + private_append_checks(Config) when is_list(Config) -> run_post_ssa_opt(private_append, Config). diff --git a/lib/compiler/test/beam_ssa_check_SUITE_data/alias.erl b/lib/compiler/test/beam_ssa_check_SUITE_data/alias.erl index d2020dc2a88c..197bc0d7410d 100644 --- a/lib/compiler/test/beam_ssa_check_SUITE_data/alias.erl +++ b/lib/compiler/test/beam_ssa_check_SUITE_data/alias.erl @@ -1071,7 +1071,7 @@ update_record0() -> update_record0([Val|Ls], Acc=#r0{not_aliased=N}) -> %ssa% (_, Rec) when post_ssa_opt -> -%ssa% _ = update_record(reuse, 3, Rec, 3, A, 2, NA) {unique => [Rec, NA], aliased => [A]}. +%ssa% _ = update_record(copy, 3, Rec, 3, A, 2, NA) {unique => [Rec, NA], aliased => [A]}. R = Acc#r0{not_aliased=N+1,aliased=Val}, update_record0(Ls, R); update_record0([], Acc) -> @@ -1084,7 +1084,7 @@ update_record1() -> update_record1([Val|Ls], Acc=#r1{not_aliased0=N0,not_aliased1=N1}) -> %ssa% (_, Rec) when post_ssa_opt -> -%ssa% _ = update_record(reuse, 3, Rec, 3, NA0, 2, NA1) {unique => [Rec, NA1, NA0], source_dies => true}. +%ssa% _ = update_record(copy, 3, Rec, 3, NA0, 2, NA1) {unique => [Rec, NA1, NA0], source_dies => true}. R = Acc#r1{not_aliased0=N0+1,not_aliased1=[Val|N1]}, update_record1(Ls, R); update_record1([], Acc) -> diff --git a/lib/compiler/test/beam_ssa_check_SUITE_data/no_reuse_hint.erl b/lib/compiler/test/beam_ssa_check_SUITE_data/no_reuse_hint.erl new file mode 100644 index 000000000000..c04c63e4567e --- /dev/null +++ b/lib/compiler/test/beam_ssa_check_SUITE_data/no_reuse_hint.erl @@ -0,0 +1,102 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%% This module tests the ssa_opt_no_reuse compiler pass. The test +%% strategy is to ensure 100% coverage of the pass and to check for +%% correct functioning for each of the different categories of +%% operations inhibiting reuse: phis, known bifs, functions and +%% instructions. +%% + +-module(no_reuse_hint). + +-export([coverage0/0, + inhibit_by_known_bif/2, + inhibit_by_known_fun/1, + inhibit_by_known_op/2, + inhibit_by_map/4, + inhibit_by_map_key/2, + inhibit_by_map_value/2, + inhibit_by_phi/1]). + +inhibit_by_known_bif({_}=X, Y) -> +%ssa% (X, Y) when post_ssa_opt -> +%ssa% Bif = bif:'+'(...), +%ssa% R = update_record(copy, 1, X, 1, Bif), +%ssa% ret(R). + setelement(1, X, Y + 1). + +inhibit_by_known_fun(X) -> + case X of + {_} -> +%ssa% (X) when post_ssa_opt -> +%ssa% KnownFun = call(fun erlang:'++'/2, ...), +%ssa% R = update_record(copy, 1, X, 1, KnownFun), +%ssa% ret(R). + setelement(1, X, e:f() ++ e:f()) + end. + +inhibit_by_known_op({_, _}=X, Y) -> +%ssa% (X, Y) when post_ssa_opt -> +%ssa% Op = put_tuple(...), +%ssa% R = update_record(copy, 2, X, 1, Op), +%ssa% ret(R). + setelement(1, X, {Y}). + +inhibit_by_map(A, B, C, {_}=D) -> +%ssa% (A, B, C, D) when post_ssa_opt -> +%ssa% Map1 = put_map(_, C, B, _), +%ssa% Map = put_map(_, Map1, A, _), +%ssa% R = update_record(copy, 1, D, 1, Map), +%ssa% ret(R). + setelement(1, D, C#{B => {e:f()}, A => e:f()}). + +inhibit_by_map_key({Y0}=Z, K) -> +%ssa% (X, Y) when post_ssa_opt -> +%ssa% Key = put_tuple(...), +%ssa% Map = put_map(_, _, Key, value), +%ssa% R = update_record(copy, 1, Z, 1, Map), +%ssa% ret(R). + Y = Y0#{{K} => value}, + setelement(1, Z, Y). + +inhibit_by_map_value(X, {Y}=Z) -> +%ssa% (X, Y) when post_ssa_opt -> +%ssa% T = put_tuple(...), +%ssa% Map = put_map(_, _, key, T), +%ssa% R = update_record(copy, 1, Z, 1, Map), +%ssa% ret(R). + M = Y#{key => {X}}, + setelement(1, Z, M). + +inhibit_by_phi({_}=X) -> +%ssa% (X) when post_ssa_opt -> +%ssa% Phi = phi(...), +%ssa% R = update_record(copy, 1, X, 1, Phi), +%ssa% ret(R). + Y = case e:f() of + a -> {e:f(), 1}; + b -> {e:f(), 2} + end, + setelement(1, X, Y). + +%% +%% Ensure full coverage of the functions in the ssa_opt_no_reuse pass. +%% +coverage0() -> + erlang:send_after(500, self(), fun() -> ok end).