The R13B03 release.OTP_R13B03

1 files changed, 191 insertions, 0 deletions

diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
new file mode 100644
index 0000000000..d03ac4b1f4
--- /dev/null
+++ b/lib/compiler/src/beam_peep.erl
@@ -0,0 +1,191 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+
+-module(beam_peep).
+
+-export([module/2]).
+
+-import(lists, [reverse/1,member/2]).
+
+module({Mod,Exp,Attr,Fs0,_}, _Opts) ->
+    %% First coalesce adjacent labels.
+    {Fs1,Lc} = beam_clean:clean_labels(Fs0),
+
+    %% Do the peep hole optimizations.
+    Fs = [function(F) || F <- Fs1],
+    {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+function({function,Name,Arity,CLabel,Is0}) ->
+    try
+	Is1 = peep(Is0),
+	Is = beam_jump:remove_unused_labels(Is1),
+	{function,Name,Arity,CLabel,Is}
+    catch
+	Class:Error ->
+	    Stack = erlang:get_stacktrace(),
+	    io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+	    erlang:raise(Class, Error, Stack)
+    end.
+
+
+%% Peep-hole optimizations suitable to perform when most of the
+%% optimations passes have been run.
+%%
+%% (1) In a sequence of tests, we can remove any test instruction
+%%     that has been previously seen, because it will certainly
+%%     succeed.
+%%
+%%     For instance, in the following code sequence
+%%
+%%       is_eq_exact _Fail SomeRegister SomeLiteral
+%%       is_ne_exact _Fail SomeOtherRegister SomeOtherLiteral
+%%       is_eq_exact _Fail SomeRegister SomeLiteral
+%%       is_ne_exact _Fail SomeOtherRegister StillSomeOtherLiteral
+%%
+%%     the third test is redundant. The code sequence will be produced
+%%     by a combination of semicolon and command guards, such as
+%%  
+%%      InEncoding =:= latin1, OutEncoding =:= unicode; 
+%%      InEncoding =:= latin1, OutEncoding =:= utf8 ->
+%%
+%% (2) Code like
+%%
+%%        is_ne_exact Fail Reg Literal1
+%%        is_ne_exact Fail Reg Literal2
+%%        is_ne_exact Fail Reg Literal3
+%%        is_eq_exact UltimateFail Reg Literal4
+%%      Fail: ....
+%%
+%%     can be rewritten to
+%% 
+%%        select_val Reg UltimateFail   [ Literal1 Fail
+%%                                        Literal2 Fail
+%%                                        Literal3 Fail
+%%                                        Literal4 Fail ]
+%%
+%% (3) A select_val/4 instruction that only verifies that
+%%     its argument is either 'true' or 'false' can be
+%%     be replaced with an is_boolean/2 instruction. That is:
+%%
+%%          select_val Reg Fail   [ true Next false Next ]
+%%        Next: ...
+%%         
+%%     can be rewritten to
+%%
+%%          is_boolean Fail Reg
+%%        Next: ...
+%%
+
+peep(Is) ->
+    peep(Is, gb_sets:empty(), []).
+
+peep([{bif,tuple_size,_,[_]=Ops,Dst}=I|Is], SeenTests0, Acc) ->
+    %% Pretend that we have seen {test,is_tuple,_,Ops}.
+    SeenTests1 = gb_sets:add({is_tuple,Ops}, SeenTests0),
+    %% Kill all remembered tests that depend on the destination register.
+    SeenTests = kill_seen(Dst, SeenTests1),
+    peep(Is, SeenTests, [I|Acc]);
+peep([{bif,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
+    %% Kill all remembered tests that depend on the destination register.
+    SeenTests = kill_seen(Dst, SeenTests0),
+    peep(Is, SeenTests, [I|Acc]);
+peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
+    %% Kill all remembered tests that depend on the destination register.
+    SeenTests = kill_seen(Dst, SeenTests0),
+    peep(Is, SeenTests, [I|Acc]);
+peep([{test,is_boolean,{f,Fail},Ops}|_]=Is, SeenTests,
+     [{test,is_atom,{f,Fail},Ops}|Acc]) ->
+    %% The previous is_atom/2 test (with the same failure label) is redundant.
+    %% (If is_boolean(Src) is true, is_atom(Src) is also true, so it is
+    %% OK to still remember that we have seen is_atom/1.)
+    peep(Is, SeenTests, Acc);
+peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
+    case beam_utils:is_pure_test(I) of
+	false ->
+	    %% Bit syntax matching, which may modify registers and/or
+	    %% match state. Clear all information about tests that
+	    %% has succeeded.
+	    peep(Is, gb_sets:empty(), [I|Acc]);
+	true ->
+	    Test = {Op,Ops},
+	    case gb_sets:is_element(Test, SeenTests0) of
+		true ->
+		    %% This test has already succeeded and
+		    %% is therefore redundant.
+		    peep(Is, SeenTests0, Acc);
+		false ->
+		    %% Remember that we have seen this test.
+		    SeenTests = gb_sets:insert(Test, SeenTests0),
+		    make_select_val(I, Is, SeenTests, Acc)
+	    end
+    end;
+peep([{select_val,Src,Fail,
+	{list,[{atom,false},{f,L},{atom,true},{f,L}]}}|
+      [{label,L}|_]=Is], SeenTests, Acc) ->
+    I = {test,is_boolean,Fail,[Src]},
+    peep([I|Is], SeenTests, Acc);
+peep([{select_val,Src,Fail,
+       {list,[{atom,true},{f,L},{atom,false},{f,L}]}}|
+      [{label,L}|_]=Is], SeenTests, Acc) ->
+    I = {test,is_boolean,Fail,[Src]},
+    peep([I|Is], SeenTests, Acc);
+peep([I|Is], _, Acc) ->
+    %% An unknown instruction. Throw away all information we
+    %% have collected about test instructions.
+    peep(Is, gb_sets:empty(), [I|Acc]);
+peep([], _, Acc) -> reverse(Acc).
+
+make_select_val({test,is_ne_exact,{f,Fail},[Val,Lit]}=I0,
+		Is0, SeenTests, Acc) ->
+    try
+	Type = case Lit of
+		   {atom,_} -> atom;
+		   {integer,_} -> integer;
+		   _ -> throw(impossible)
+	       end,
+	{I,Is} = make_select_val_1(Is0, Fail, Val, Type, [Lit,{f,Fail}]),
+	peep([I|Is], SeenTests, Acc)
+    catch
+	impossible ->
+	    peep(Is0, SeenTests, [I0|Acc])
+    end;
+make_select_val(I, Is, SeenTests, Acc) ->
+    peep(Is, SeenTests, [I|Acc]).
+
+make_select_val_1([{test,is_ne_exact,{f,Fail},[Val,{Type,_}=Lit]}|Is],
+		  Fail, Val, Type, Acc) ->
+      make_select_val_1(Is, Fail, Val, Type, [Lit,{f,Fail}|Acc]);
+make_select_val_1([{test,is_eq_exact,{f,UltimateFail},[Val,{Type,_}=Lit]} |
+		   [{label,Fail}|_]=Is], Fail, Val, Type, Acc) ->
+    Choices = [Lit,{f,Fail}|Acc],
+    I = {select_val,Val,{f,UltimateFail},{list,Choices}},
+    {I,Is};
+make_select_val_1(_Is, _Fail, _Val, _Type, _Acc) -> throw(impossible).
+    
+kill_seen(Dst, Seen0) ->
+    gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)).
+
+kill_seen_1([{_,Ops}=Test|T], Dst) ->
+    case member(Dst, Ops) of
+	true -> kill_seen_1(T, Dst);
+	false -> [Test|kill_seen_1(T, Dst)]
+    end;
+kill_seen_1([], _) -> [].
+
+