Merge pull request #1691 from bjorng/bjorn/compiler/local-cse

Do local common sub expression elimination (CSE)

3 files changed, 165 insertions, 5 deletions

diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl
index 55d5f2dbe8..fac18789e0 100644
--- a/lib/compiler/test/beam_block_SUITE.erl
+++ b/lib/compiler/test/beam_block_SUITE.erl
@@ -22,7 +22,7 @@
 -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
 	 init_per_group/2,end_per_group/2,
 	 get_map_elements/1,otp_7345/1,move_opt_across_gc_bif/1,
-	 erl_202/1,repro/1]).
+	 erl_202/1,repro/1,local_cse/1]).
 
 %% The only test for the following functions is that
 %% the code compiles and is accepted by beam_validator.
@@ -40,7 +40,8 @@ groups() ->
        otp_7345,
        move_opt_across_gc_bif,
        erl_202,
-       repro
+       repro,
+       local_cse
       ]}].
 
 init_per_suite(Config) ->
@@ -237,6 +238,63 @@ find_operands(Cfg,XsiGraph,ActiveList,Count) ->
     [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))],
     find_operands(NewCfg,XsiGraph,NewActiveList,Count+1).
 
+%% Some tests of local common subexpression elimination (CSE).
+
+local_cse(_Config) ->
+    {Self,{ok,Self}} = local_cse_1(),
+
+    local_cse_2([]),
+    local_cse_2(lists:seq(1, 512)),
+    local_cse_2(?MODULE:module_info()),
+
+    {[b],[a,b]} = local_cse_3(a, b),
+
+    {2000,Self,{Self,write_cache}} = local_cse_4(),
+
+    ok.
+
+local_cse_1() ->
+    %% Cover handling of unsafe tuple construction in
+    %% eliminate_use_of_from_reg/4. It became necessary to handle
+    %% unsafe tuples when local CSE was introduced.
+
+    {self(),{ok,self()}}.
+
+local_cse_2(Term) ->
+    case cse_make_binary(Term) of
+        <<Size:8,BinTerm:Size/binary>> ->
+            Term = binary_to_term(BinTerm);
+        <<Size:8,SizeTerm:Size/binary,BinTerm/binary>> ->
+            {'$size',TermSize} = binary_to_term(SizeTerm),
+            TermSize = byte_size(BinTerm),
+            Term = binary_to_term(BinTerm)
+    end.
+
+%% Copy of observer_backend:ttb_make_binary/1. During development of
+%% the local CSE optimization this function was incorrectly optimized.
+
+cse_make_binary(Term) ->
+    B = term_to_binary(Term),
+    SizeB = byte_size(B),
+    if SizeB > 255 ->
+            SB = term_to_binary({'$size',SizeB}),
+            <<(byte_size(SB)):8, SB/binary, B/binary>>;
+       true ->
+            <<SizeB:8, B/binary>>
+    end.
+
+local_cse_3(X, Y) ->
+    %% The following expression was incorrectly transformed to {[X,Y],[X,Y]}
+    %% during development of the local CSE optimization.
+
+    {[Y],[X,Y]}.
+
+local_cse_4() ->
+    do_local_cse_4(2000, self(), {self(), write_cache}).
+
+do_local_cse_4(X, Y, Z) ->
+    {X,Y,Z}.
+
 %%%
 %%% Common functions.
 %%%
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 685eb2a72e..63a13281a8 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -33,8 +33,8 @@
 	 state_after_fault_in_catch/1,no_exception_in_catch/1,
 	 undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,
 	 map_field_lists/1,cover_bin_opt/1,
-	 val_dsetel/1]).
-	 
+	 val_dsetel/1,bad_tuples/1]).
+
 -include_lib("common_test/include/ct.hrl").
 
 init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
@@ -61,7 +61,8 @@ groups() ->
        freg_state,bad_bin_match,bad_dsetel,
        state_after_fault_in_catch,no_exception_in_catch,
        undef_label,illegal_instruction,failing_gc_guard_bif,
-       map_field_lists,cover_bin_opt,val_dsetel]}].
+       map_field_lists,cover_bin_opt,val_dsetel,
+       bad_tuples]}].
 
 init_per_suite(Config) ->
     Config.
@@ -509,6 +510,19 @@ destroy_reg({Tag,N}) ->
 	    {y,N+1}
     end.
 
+bad_tuples(Config) ->
+    Errors = do_val(bad_tuples, Config),
+    [{{bad_tuples,heap_overflow,1},
+      {{put,{x,0}},8,{heap_overflow,{left,0},{wanted,1}}}},
+     {{bad_tuples,long,2},
+      {{put,{atom,too_long}},8,not_building_a_tuple}},
+     {{bad_tuples,self_referential,1},
+      {{put,{x,1}},7,{tuple_in_progress,{x,1}}}},
+     {{bad_tuples,short,1},
+      {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors,
+
+    ok.
+
 %%%-------------------------------------------------------------------------
 
 transform_remove(Remove, Module) ->
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S
new file mode 100644
index 0000000000..7980241c37
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S
@@ -0,0 +1,88 @@
+{module, bad_tuples}.  %% version = 0
+
+{exports, [{heap_overflow,1},
+           {long,2},
+           {module_info,0},
+           {module_info,1},
+           {self_referential,1},
+           {short,1}]}.
+
+{attributes, []}.
+
+{labels, 13}.
+
+
+{function, short, 1, 2}.
+  {label,1}.
+    {line,[{location,"bad_tuples.erl",4}]}.
+    {func_info,{atom,bad_tuples},{atom,short},1}.
+  {label,2}.
+    {test_heap,3,1}.
+    {put_tuple,2,{x,1}}.
+    {put,{atom,ok}}.
+    {move,{x,1},{x,0}}.
+    return.
+
+
+{function, long, 2, 4}.
+  {label,3}.
+    {line,[{location,"bad_tuples.erl",7}]}.
+    {func_info,{atom,bad_tuples},{atom,long},2}.
+  {label,4}.
+    {test_heap,6,2}.
+    {put_tuple,2,{x,2}}.
+    {put,{x,0}}.
+    {put,{x,1}}.
+    {put,{atom,too_long}}.
+    {put_tuple,2,{x,0}}.
+    {put,{atom,ok}}.
+    {put,{x,2}}.
+    return.
+
+
+{function, heap_overflow, 1, 6}.
+  {label,5}.
+    {line,[{location,"bad_tuples.erl",10}]}.
+    {func_info,{atom,bad_tuples},{atom,heap_overflow},1}.
+  {label,6}.
+    {test_heap,3,1}.
+    {put_tuple,2,{x,1}}.
+    {put,{atom,ok}}.
+    {put,{x,0}}.
+    {put,{x,0}}.
+    {move,{x,1},{x,0}}.
+    return.
+
+
+{function, self_referential, 1, 8}.
+  {label,7}.
+    {line,[{location,"bad_tuples.erl",13}]}.
+    {func_info,{atom,bad_tuples},{atom,self_referential},1}.
+  {label,8}.
+    {test_heap,3,1}.
+    {put_tuple,2,{x,1}}.
+    {put,{atom,ok}}.
+    {put,{x,1}}.
+    {move,{x,1},{x,0}}.
+    return.
+
+
+{function, module_info, 0, 10}.
+  {label,9}.
+    {line,[]}.
+    {func_info,{atom,bad_tuples},{atom,module_info},0}.
+  {label,10}.
+    {move,{atom,bad_tuples},{x,0}}.
+    {line,[]}.
+    {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 12}.
+  {label,11}.
+    {line,[]}.
+    {func_info,{atom,bad_tuples},{atom,module_info},1}.
+  {label,12}.
+    {move,{x,0},{x,1}}.
+    {move,{atom,bad_tuples},{x,0}}.
+    {line,[]}.
+    {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.