1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21-module(beam_peep).
22
23-export([module/2]).
24
25-import(lists, [reverse/1,member/2]).
26
27-spec module(beam_utils:module_code(), [compile:option()]) ->
28                    {'ok',beam_utils:module_code()}.
29
30module({Mod,Exp,Attr,Fs0,_}, _Opts) ->
31    %% First coalesce adjacent labels.
32    {Fs1,Lc} = beam_clean:clean_labels(Fs0),
33
34    %% Do the peep hole optimizations.
35    Fs = [function(F) || F <- Fs1],
36    {ok,{Mod,Exp,Attr,Fs,Lc}}.
37
38function({function,Name,Arity,CLabel,Is0}) ->
39    try
40	Is1 = peep(Is0),
41	Is = beam_jump:remove_unused_labels(Is1),
42	{function,Name,Arity,CLabel,Is}
43    catch
44        Class:Error:Stack ->
45	    io:fwrite("Function: ~w/~w\n", [Name,Arity]),
46	    erlang:raise(Class, Error, Stack)
47    end.
48
49
50%% Peep-hole optimizations suitable to perform when most of the
51%% optimations passes have been run.
52%%
53%% (1) In a sequence of tests, we can remove any test instruction
54%%     that has been previously seen, because it will certainly
55%%     succeed.
56%%
57%%     For instance, in the following code sequence
58%%
59%%       is_eq_exact _Fail SomeRegister SomeLiteral
60%%       is_ne_exact _Fail SomeOtherRegister SomeOtherLiteral
61%%       is_eq_exact _Fail SomeRegister SomeLiteral
62%%       is_ne_exact _Fail SomeOtherRegister StillSomeOtherLiteral
63%%
64%%     the third test is redundant. The code sequence will be produced
65%%     by a combination of semicolon and command guards, such as
66%%
67%%      InEncoding =:= latin1, OutEncoding =:= unicode;
68%%      InEncoding =:= latin1, OutEncoding =:= utf8 ->
69%%
70
71peep(Is) ->
72    peep(Is, gb_sets:empty(), []).
73
74peep([{bif,tuple_size,_,[_]=Ops,Dst}=I|Is], SeenTests0, Acc) ->
75    %% Pretend that we have seen {test,is_tuple,_,Ops}.
76    SeenTests1 = gb_sets:add({is_tuple,Ops}, SeenTests0),
77    %% Kill all remembered tests that depend on the destination register.
78    SeenTests = kill_seen(Dst, SeenTests1),
79    peep(Is, SeenTests, [I|Acc]);
80peep([{bif,map_get,_,[Key,Map],Dst}=I|Is], SeenTests0, Acc) ->
81    %% Pretend that we have seen {test,has_map_fields,_,[Map,Key]}
82    SeenTests1 = gb_sets:add({has_map_fields,[Map,Key]}, SeenTests0),
83    %% Kill all remembered tests that depend on the destination register.
84    SeenTests = kill_seen(Dst, SeenTests1),
85    peep(Is, SeenTests, [I|Acc]);
86peep([{bif,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
87    %% Kill all remembered tests that depend on the destination register.
88    SeenTests = kill_seen(Dst, SeenTests0),
89    peep(Is, SeenTests, [I|Acc]);
90peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
91    %% Kill all remembered tests that depend on the destination register.
92    SeenTests = kill_seen(Dst, SeenTests0),
93    peep(Is, SeenTests, [I|Acc]);
94peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) ->
95    %% Sometimes beam_jump has missed this optimization.
96    peep(Is, gb_sets:empty(), [I|Acc]);
97peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) ->
98    case prune_redundant_values(Vls0, F) of
99	[] ->
100	    %% No values left. Must convert to plain jump.
101	    I = {jump,F},
102	    peep([I|Is], gb_sets:empty(), Acc0);
103        [{atom,_}=Value,Lbl] when Op =:= select_val ->
104            %% Single value left. Convert to regular test and pop redundant tests.
105            Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is],
106            case Acc0 of
107                [{test,is_atom,F,[R]}|Acc] ->
108                    peep(Is1, SeenTests0, Acc);
109                _ ->
110                    peep(Is1, SeenTests0, Acc0)
111            end;
112        [{integer,_}=Value,Lbl] when Op =:= select_val ->
113            %% Single value left. Convert to regular test and pop redundant tests.
114            Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is],
115            case Acc0 of
116                [{test,is_integer,F,[R]}|Acc] ->
117                    peep(Is1, SeenTests0, Acc);
118                _ ->
119                    peep(Is1, SeenTests0, Acc0)
120            end;
121        [Arity,Lbl] when Op =:= select_tuple_arity ->
122            %% Single value left. Convert to regular test
123            Is1 = [{test,test_arity,F,[R,Arity]},{jump,Lbl}|Is],
124            peep(Is1, SeenTests0, Acc0);
125	[_|_]=Vls ->
126	    I = {select,Op,R,F,Vls},
127	    peep(Is, gb_sets:empty(), [I|Acc0])
128    end;
129peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
130    case beam_utils:is_pure_test(I) of
131	false ->
132	    %% Bit syntax matching, which may modify registers and/or
133	    %% match state. Clear all information about tests that
134	    %% has succeeded.
135	    peep(Is, gb_sets:empty(), [I|Acc]);
136	true ->
137	    case is_test_redundant(Op, Ops, SeenTests0) of
138		true ->
139		    %% This test or a similar test has already succeeded and
140		    %% is therefore redundant.
141		    peep(Is, SeenTests0, Acc);
142		false ->
143		    %% Remember that we have seen this test.
144		    Test = {Op,Ops},
145		    SeenTests = gb_sets:insert(Test, SeenTests0),
146		    peep(Is, SeenTests, [I|Acc])
147	    end
148    end;
149peep([I|Is], _, Acc) ->
150    %% An unknown instruction. Throw away all information we
151    %% have collected about test instructions.
152    peep(Is, gb_sets:empty(), [I|Acc]);
153peep([], _, Acc) -> reverse(Acc).
154
155is_test_redundant(Op, Ops, Seen) ->
156    gb_sets:is_element({Op,Ops}, Seen) orelse
157	is_test_redundant_1(Op, Ops, Seen).
158
159is_test_redundant_1(is_boolean, [R], Seen) ->
160    gb_sets:is_element({is_eq_exact,[R,{atom,false}]}, Seen) orelse
161	gb_sets:is_element({is_eq_exact,[R,{atom,true}]}, Seen);
162is_test_redundant_1(_, _, _) -> false.
163
164kill_seen(Dst, Seen0) ->
165    gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)).
166
167kill_seen_1([{_,Ops}=Test|T], Dst) ->
168    case member(Dst, Ops) of
169	true -> kill_seen_1(T, Dst);
170	false -> [Test|kill_seen_1(T, Dst)]
171    end;
172kill_seen_1([], _) -> [].
173
174prune_redundant_values([_Val,F|Vls], F) ->
175    prune_redundant_values(Vls, F);
176prune_redundant_values([Val,Lbl|Vls], F) ->
177    [Val,Lbl|prune_redundant_values(Vls, F)];
178prune_redundant_values([], _) -> [].
179