aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/beam_block.erl39
-rw-r--r--lib/compiler/src/beam_clean.erl52
-rw-r--r--lib/compiler/src/beam_disasm.erl7
-rw-r--r--lib/compiler/src/beam_ssa_codegen.erl57
-rw-r--r--lib/compiler/src/beam_trim.erl7
-rw-r--r--lib/compiler/src/beam_validator.erl17
-rw-r--r--lib/compiler/src/compile.erl6
-rwxr-xr-xlib/compiler/src/genop.tab4
8 files changed, 142 insertions, 47 deletions
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 707974b2c1..a734ca3a10 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -33,8 +33,9 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
function({function,Name,Arity,CLabel,Is0}) ->
try
- Is1 = blockify(Is0),
- Is = embed_lines(Is1),
+ Is1 = swap_opt(Is0),
+ Is2 = blockify(Is1),
+ Is = embed_lines(Is2),
{function,Name,Arity,CLabel,Is}
catch
Class:Error:Stack ->
@@ -42,6 +43,40 @@ function({function,Name,Arity,CLabel,Is0}) ->
erlang:raise(Class, Error, Stack)
end.
+%%%
+%%% Try to use a `swap` instruction instead of a sequence of moves.
+%%%
+%%% Note that beam_ssa_codegen generates `swap` instructions only for
+%%% the moves within a single SSA instruction (such as `call`), not
+%%% for the moves generated by a sequence of SSA instructions.
+%%% Therefore, this optimization is needed.
+%%%
+
+swap_opt([{move,Reg1,{x,X}=Temp}=Move1,
+ {move,Reg2,Reg1}=Move2,
+ {move,Temp,Reg2}=Move3|Is]) when Reg1 =/= Temp ->
+ case is_unused(X, Is) of
+ true ->
+ [{swap,Reg1,Reg2}|swap_opt(Is)];
+ false ->
+ [Move1|swap_opt([Move2,Move3|Is])]
+ end;
+swap_opt([I|Is]) ->
+ [I|swap_opt(Is)];
+swap_opt([]) -> [].
+
+is_unused(X, [{call,A,_}|_]) when A =< X -> true;
+is_unused(X, [{call_ext,A,_}|_]) when A =< X -> true;
+is_unused(X, [{make_fun2,_,_,_,A}|_]) when A =< X -> true;
+is_unused(X, [{move,Src,Dst}|Is]) ->
+ case {Src,Dst} of
+ {{x,X},_} -> false;
+ {_,{x,X}} -> true;
+ {_,_} -> is_unused(X, Is)
+ end;
+is_unused(X, [{line,_}|Is]) -> is_unused(X, Is);
+is_unused(_, _) -> false.
+
%% blockify(Instructions0) -> Instructions
%% Collect sequences of instructions to basic blocks.
%% Also do some simple optimations on instructions outside the blocks.
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 7299654476..6b2b2ce085 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -34,7 +34,8 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) ->
Used = find_all_used(WorkList, All, cerl_sets:from_list(WorkList)),
Fs1 = remove_unused(Order, Used, All),
{Fs2,Lc} = clean_labels(Fs1),
- Fs = maybe_remove_lines(Fs2, Opts),
+ Fs3 = fix_swap(Fs2, Opts),
+ Fs = maybe_remove_lines(Fs3, Opts),
{ok,{Mod,Exp,Attr,Fs,Lc}}.
%% Determine the rootset, i.e. exported functions and
@@ -137,31 +138,54 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
function_replace([], _, Acc) -> Acc.
%%%
+%%% If compatibility with a previous release (OTP 22 or earlier) has
+%%% been requested, replace swap instructions with a sequence of moves.
+%%%
+
+fix_swap(Fs, Opts) ->
+ case proplists:get_bool(no_swap, Opts) of
+ false -> Fs;
+ true -> fold_functions(fun swap_moves/1, Fs)
+ end.
+
+swap_moves([{swap,Reg1,Reg2}|Is]) ->
+ Temp = {x,1022},
+ [{move,Reg1,Temp},{move,Reg2,Reg1},{move,Temp,Reg2}|swap_moves(Is)];
+swap_moves([I|Is]) ->
+ [I|swap_moves(Is)];
+swap_moves([]) -> [].
+
+%%%
%%% Remove line instructions if requested.
%%%
maybe_remove_lines(Fs, Opts) ->
case proplists:get_bool(no_line_info, Opts) of
false -> Fs;
- true -> remove_lines(Fs)
+ true -> fold_functions(fun remove_lines/1, Fs)
end.
-remove_lines([{function,N,A,Lbl,Is0}|T]) ->
- Is = remove_lines_fun(Is0),
- [{function,N,A,Lbl,Is}|remove_lines(T)];
-remove_lines([]) -> [].
-
-remove_lines_fun([{line,_}|Is]) ->
- remove_lines_fun(Is);
-remove_lines_fun([{block,Bl0}|Is]) ->
+remove_lines([{line,_}|Is]) ->
+ remove_lines(Is);
+remove_lines([{block,Bl0}|Is]) ->
Bl = remove_lines_block(Bl0),
- [{block,Bl}|remove_lines_fun(Is)];
-remove_lines_fun([I|Is]) ->
- [I|remove_lines_fun(Is)];
-remove_lines_fun([]) -> [].
+ [{block,Bl}|remove_lines(Is)];
+remove_lines([I|Is]) ->
+ [I|remove_lines(Is)];
+remove_lines([]) -> [].
remove_lines_block([{set,_,_,{line,_}}|Is]) ->
remove_lines_block(Is);
remove_lines_block([I|Is]) ->
[I|remove_lines_block(Is)];
remove_lines_block([]) -> [].
+
+
+%%%
+%%% Helpers.
+%%%
+
+fold_functions(F, [{function,N,A,Lbl,Is0}|T]) ->
+ Is = F(Is0),
+ [{function,N,A,Lbl,Is}|fold_functions(F, T)];
+fold_functions(_F, []) -> [].
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 7d048716e4..45b69d7e95 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1123,6 +1123,13 @@ resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) ->
{put_tuple2,Dst,{list,List}};
%%
+%% OTP 23.
+%%
+resolve_inst({swap,[_,_]=List},_,_,_) ->
+ [R1,R2] = resolve_args(List),
+ {swap,R1,R2};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl
index c2d5035b19..649d4e0f8f 100644
--- a/lib/compiler/src/beam_ssa_codegen.erl
+++ b/lib/compiler/src/beam_ssa_codegen.erl
@@ -28,7 +28,7 @@
-include("beam_ssa.hrl").
--import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3,
+-import(lists, [foldl/3,keymember/3,keysort/2,map/2,mapfoldl/3,
reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]).
-record(cg, {lcount=1 :: beam_label(), %Label counter
@@ -1247,8 +1247,7 @@ cg_copy(T0, St) ->
end, T0),
Moves0 = cg_copy_1(Copies, St),
Moves1 = [Move || {move,Src,Dst}=Move <- Moves0, Src =/= Dst],
- Scratch = {x,1022},
- Moves = order_moves(Moves1, Scratch),
+ Moves = order_moves(Moves1),
{Moves,T}.
cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) ->
@@ -1707,7 +1706,7 @@ cg_catch(Agg, T0, Context, St0) ->
cg_try(Agg, Tag, T0, Context, St0) ->
{Moves0,T1} = cg_extract(T0, Agg, St0),
- Moves = order_moves(Moves0, {x,3}),
+ Moves = order_moves(Moves0),
[#cg_set{op=kill_try_tag}|T2] = T1,
{T,St} = cg_block(T2, Context, St0),
{[{try_case,Tag}|Moves++T],St}.
@@ -1863,8 +1862,7 @@ setup_args([]) ->
[];
setup_args([_|_]=Args) ->
Moves = gen_moves(Args, 0, []),
- Scratch = {x,1+last(sort([length(Args)-1|[X || {x,X} <- Args]]))},
- order_moves(Moves, Scratch).
+ order_moves(Moves).
%% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}].
%% Kill Y registers that will not be used again.
@@ -1884,47 +1882,48 @@ gen_moves([A|As], I, Acc) ->
gen_moves([], _, Acc) ->
keysort(3, Acc).
-%% order_moves([Move], ScratchReg) -> [Move]
+%% order_moves([Move]) -> [Move]
%% Orders move instruction so that source registers are not
%% destroyed before they are used. If there are cycles
%% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}),
-%% the scratch register is used to break up the cycle.
-%% If possible, the first move of the input list is placed
+%% swap instructions will be used to break up the cycle.
+%%
+%% If possible, the first move of the input list is placed
%% last in the result list (to make the move to {x,0} occur
%% just before the call to allow the Beam loader to coalesce
%% the instructions).
-order_moves(Ms, Scr) -> order_moves(Ms, Scr, []).
+order_moves(Ms) -> order_moves(Ms, []).
-order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) ->
- {Chain,Ms} = collect_chain(Ms0, [M], ScrReg),
+order_moves([{move,_,_}=M|Ms0], Acc0) ->
+ {Chain,Ms} = collect_chain(Ms0, [M]),
Acc = reverse(Chain, Acc0),
- order_moves(Ms, ScrReg, Acc);
-order_moves([], _, Acc) -> Acc.
+ order_moves(Ms, Acc);
+order_moves([], Acc) -> Acc.
-collect_chain(Ms, Path, ScrReg) ->
- collect_chain(Ms, Path, [], ScrReg).
+collect_chain(Ms, Path) ->
+ collect_chain(Ms, Path, []).
-collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) ->
+collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others) ->
case keymember(Src, 3, Path) of
false ->
- collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg);
+ collect_chain(reverse(Others, Ms0), [M|Path], []);
true ->
- %% There is a cycle, which we must break up.
- {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)}
+ %% There is a cycle.
+ {break_up_cycle(M, Path),reverse(Others, Ms0)}
end;
-collect_chain([M|Ms], Path, Others, ScrReg) ->
- collect_chain(Ms, Path, [M|Others], ScrReg);
-collect_chain([], Path, Others, _) ->
+collect_chain([M|Ms], Path, Others) ->
+ collect_chain(Ms, Path, [M|Others]);
+collect_chain([], Path, Others) ->
{Path,Others}.
-break_up_cycle({move,Src,_}=M, Path, ScrReg) ->
- [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)].
+break_up_cycle({move,Src,_Dst}=M, Path) ->
+ break_up_cycle_1(Src, [M|Path], []).
-break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) ->
- [{move,Src,ScrReg}|Path];
-break_up_cycle1(Dst, [M|Path], LastMove) ->
- [M|break_up_cycle1(Dst, Path, LastMove)].
+break_up_cycle_1(Dst, [{move,_Src,Dst}|Path], Acc) ->
+ reverse(Acc, Path);
+break_up_cycle_1(Dst, [{move,S,D}|Path], Acc) ->
+ break_up_cycle_1(Dst, Path, [{swap,S,D}|Acc]).
%%%
%%% General utility functions.
diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl
index acf3838da4..ad8839cc7d 100644
--- a/lib/compiler/src/beam_trim.erl
+++ b/lib/compiler/src/beam_trim.erl
@@ -244,6 +244,9 @@ remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) ->
remap([{deallocate,N}|Is], Map, Acc) ->
I = {deallocate,Map({frame_size,N})},
remap(Is, Map, [I|Acc]);
+remap([{swap,Reg1,Reg2}|Is], Map, Acc) ->
+ I = {swap,Map(Reg1),Map(Reg2)},
+ remap(Is, Map, [I|Acc]);
remap([{test,Name,Fail,Ss}|Is], Map, Acc) ->
I = {test,Name,Fail,[Map(S) || S <- Ss]},
remap(Is, Map, [I|Acc]);
@@ -382,6 +385,8 @@ frame_size([{bs_set_position,_,_}|Is], Safe) ->
frame_size(Is, Safe);
frame_size([{bs_get_tail,_,_,_}|Is], Safe) ->
frame_size(Is, Safe);
+frame_size([{swap,_,_}|Is], Safe) ->
+ frame_size(Is, Safe);
frame_size(_, _) -> throw(not_possible).
frame_size_branch(0, Is, Safe) ->
@@ -444,6 +449,8 @@ is_not_used(Y, [{line,_}|Is]) ->
is_not_used(Y, Is);
is_not_used(Y, [{make_fun2,_,_,_,_}|Is]) ->
is_not_used(Y, Is);
+is_not_used(Y, [{swap,Reg1,Reg2}|Is]) ->
+ Y =/= Reg1 andalso Y =/= Reg2 andalso is_not_used(Y, Is);
is_not_used(Y, [{test,_,_,Ss}|Is]) ->
not member(Y, Ss) andalso is_not_used(Y, Is);
is_not_used(Y, [{test,_Op,{f,_},_Live,Ss,Dst}|Is]) ->
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 09a5a6c104..b4acebbfae 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -392,6 +392,23 @@ valfun_1(build_stacktrace=I, Vst) ->
call(I, 1, Vst);
valfun_1({move,Src,Dst}, Vst) ->
assign(Src, Dst, Vst);
+valfun_1({swap,RegA,RegB}, Vst0) ->
+ assert_movable(RegA, Vst0),
+ assert_movable(RegB, Vst0),
+
+ %% We don't expect fragile registers to be swapped.
+ %% Therefore, we can conservatively make both registers
+ %% fragile if one of the register is fragile instead of
+ %% swapping the fragility of the registers.
+ Sources = [RegA,RegB],
+ Vst1 = propagate_fragility(RegA, Sources, Vst0),
+ Vst2 = propagate_fragility(RegB, Sources, Vst1),
+
+ %% Swap the value references.
+ VrefA = get_reg_vref(RegA, Vst2),
+ VrefB = get_reg_vref(RegB, Vst2),
+ Vst = set_reg_vref(VrefB, RegA, Vst2),
+ set_reg_vref(VrefA, RegB, Vst);
valfun_1({fmove,Src,{fr,_}=Dst}, Vst) ->
assert_type(float, Src, Vst),
set_freg(Dst, Vst);
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 28db8986ff..2878edcbbe 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -265,7 +265,9 @@ expand_opt(r19, Os) ->
expand_opt(r20, Os) ->
expand_opt_before_21(Os);
expand_opt(r21, Os) ->
- [no_put_tuple2 | expand_opt(no_bsm3, Os)];
+ [no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)];
+expand_opt(r22, Os) ->
+ [no_swap | Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_type_opt, Os) ->
@@ -275,7 +277,7 @@ expand_opt(no_type_opt, Os) ->
expand_opt(O, Os) -> [O|Os].
expand_opt_before_21(Os) ->
- [no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
+ [no_swap, no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
no_utf8_atoms | expand_opt(no_bsm3, Os)].
%% format_error(ErrorDescriptor) -> string()
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 86590fad87..03507bafb3 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -596,3 +596,7 @@ BEAM_FORMAT_NUMBER=0
## @spec bs_set_positon Ctx Pos
## @doc Sets the current position of Ctx to Pos
168: bs_set_position/2
+
+## @spec swap Register1 Register2
+## @doc Swaps the contents of two registers.
+169: swap/2