Make the swap instruction known to the compiler

BEAM has had a `swap` instruction for several releases, but it was not
known to the compiler. The loader would translate a sequence of three
`move` instructions to the `swap` instructions, but only when it was
possible to determine that it would be safe.

By making `swap` known to the compiler, it can be applied in more
situations since it is easier for the compiler than for the loader
to ensure that the usage is safe, and the loader shenanigans can be
eliminated.

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