aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/compiler/src/beam_block.erl168
-rw-r--r--lib/compiler/src/beam_validator.erl33
-rw-r--r--lib/compiler/test/beam_block_SUITE.erl62
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl20
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S88
5 files changed, 333 insertions, 38 deletions
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 39ae8d5347..d0536e0669 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -43,12 +43,13 @@ function({function,Name,Arity,CLabel,Is0}, Blockify) ->
false ->
Is0
end,
- Is3 = beam_utils:anno_defs(Is2),
- Is4 = move_allocates(Is3),
- Is5 = beam_utils:live_opt(Is4),
- Is6 = opt_blocks(Is5),
- Is7 = beam_utils:delete_annos(Is6),
- Is = opt_allocs(Is7),
+ Is3 = local_cse(Is2),
+ Is4 = beam_utils:anno_defs(Is3),
+ Is5 = move_allocates(Is4),
+ Is6 = beam_utils:live_opt(Is5),
+ Is7 = opt_blocks(Is6),
+ Is8 = beam_utils:delete_annos(Is7),
+ Is = opt_allocs(Is8),
%% Done.
{function,Name,Arity,CLabel,Is}
@@ -231,7 +232,7 @@ alloc_may_pass({set,_,_,_}) -> true.
%% Optimize the instruction stream inside a basic block.
opt([{set,[X],[X],move}|Is]) -> opt(Is);
-opt([{set,[X],_,move},{set,[X],_,move}=I|Is]) ->
+opt([{set,[Dst],_,move},{set,[Dst],[Src],move}=I|Is]) when Dst =/= Src ->
opt([I|Is]);
opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[{x,0}],move}|Is]) ->
opt([I1,{set,[D2],[S1],move}|Is]);
@@ -289,7 +290,7 @@ opt_move(Dest, Is) ->
opt_move_1(R, [{set,[D],[R],move}|Is0], Acc) ->
%% Provided that the source register is killed by instructions
%% that follow, the optimization is safe.
- case eliminate_use_of_from_reg(Is0, R, D, []) of
+ case eliminate_use_of_from_reg(Is0, R, D) of
{yes,Is} -> opt_move_rev(D, Acc, Is);
no -> not_possible
end;
@@ -347,7 +348,7 @@ opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) ->
opt_tuple_element_1([{set,_,_,{try_catch,_,_}}|_], _, _, _) ->
no;
opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) ->
- case eliminate_use_of_from_reg(Is0, S, D, []) of
+ case eliminate_use_of_from_reg(Is0, S, D) of
no ->
no;
{yes,Is} ->
@@ -389,6 +390,14 @@ is_killed_or_used(R, {set,Ss,Ds,_}) ->
%% that FromRegister is still used and that the optimization is not
%% possible.
+eliminate_use_of_from_reg(Is, From, To) ->
+ try
+ eliminate_use_of_from_reg(Is, From, To, [])
+ catch
+ throw:not_possible ->
+ no
+ end.
+
eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) ->
if
X < Live ->
@@ -397,21 +406,32 @@ eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) ->
{yes,reverse(Acc, Is0)}
end;
eliminate_use_of_from_reg([{set,Ds,Ss0,Op}=I0|Is], From, To, Acc) ->
+ ensure_safe_tuple(I0, To),
I = case member(From, Ss0) of
- true ->
- Ss = [case S of
- From -> To;
- _ -> S
- end || S <- Ss0],
- {set,Ds,Ss,Op};
- false ->
- I0
- end,
+ true ->
+ Ss = [case S of
+ From -> To;
+ _ -> S
+ end || S <- Ss0],
+ {set,Ds,Ss,Op};
+ false ->
+ I0
+ end,
case member(From, Ds) of
- true ->
- {yes,reverse(Acc, [I|Is])};
- false ->
- eliminate_use_of_from_reg(Is, From, To, [I|Acc])
+ true ->
+ {yes,reverse(Acc, [I|Is])};
+ false ->
+ case member(To, Ds) of
+ true ->
+ case beam_utils:is_killed_block(From, Is) of
+ true ->
+ {yes,reverse(Acc, [I|Is])};
+ false ->
+ no
+ end;
+ false ->
+ eliminate_use_of_from_reg(Is, From, To, [I|Acc])
+ end
end;
eliminate_use_of_from_reg([I]=Is, From, _To, Acc) ->
case beam_utils:is_killed_block(From, [I]) of
@@ -421,6 +441,10 @@ eliminate_use_of_from_reg([I]=Is, From, _To, Acc) ->
no
end.
+ensure_safe_tuple({set,[To],[],{put_tuple,_}}, To) ->
+ throw(not_possible);
+ensure_safe_tuple(_, _) -> ok.
+
%% opt_allocs(Instructions) -> Instructions. Optimize allocate
%% instructions inside blocks. If safe, replace an allocate_zero
%% instruction with the slightly cheaper allocate instruction.
@@ -541,3 +565,103 @@ defined_regs([{set,Ds,_,{alloc,Live,_}}|_], Regs) ->
x_live(Ds, Regs bor ((1 bsl Live) - 1));
defined_regs([{set,Ds,_,_}|Is], Regs) ->
defined_regs(Is, x_live(Ds, Regs)).
+
+%%%
+%%% Do local common sub expression elimination (CSE) in each block.
+%%%
+
+local_cse([{block,Bl0}|Is]) ->
+ Bl = cse_block(Bl0, orddict:new(), []),
+ [{block,Bl}|local_cse(Is)];
+local_cse([I|Is]) ->
+ [I|local_cse(Is)];
+local_cse([]) -> [].
+
+cse_block([I|Is], Es0, Acc0) ->
+ Es1 = cse_clear(I, Es0),
+ case cse_expr(I) of
+ none ->
+ %% Instruction is not suitable for CSE.
+ cse_block(Is, Es1, [I|Acc0]);
+ {ok,D,Expr} ->
+ %% Suitable instruction. First update the dictionary of
+ %% suitable expressions for the next iteration.
+ Es = cse_add(D, Expr, Es1),
+
+ %% Search for a previous identical expression.
+ case cse_find(Expr, Es0) of
+ error ->
+ %% Nothing found
+ cse_block(Is, Es, [I|Acc0]);
+ Src ->
+ %% Use the previously calculated result.
+ %% Also eliminate any line instruction.
+ Move = {set,[D],[Src],move},
+ case Acc0 of
+ [{set,_,_,{line,_}}|Acc] ->
+ cse_block(Is, Es, [Move|Acc]);
+ [_|_] ->
+ cse_block(Is, Es, [Move|Acc0])
+ end
+ end
+ end;
+cse_block([], _, Acc) ->
+ reverse(Acc).
+
+%% cse_find(Expr, Expressions) -> error | Register.
+%% Find a previously evaluated expression whose result can be reused,
+%% or return 'error' if no such expression is found.
+
+cse_find(Expr, Es) ->
+ case orddict:find(Expr, Es) of
+ {ok,{Src,_}} -> Src;
+ error -> error
+ end.
+
+cse_expr({set,[D],Ss,{bif,N,_}}) ->
+ {ok,D,{{bif,N},Ss}};
+cse_expr({set,[D],Ss,{alloc,_,{gc_bif,N,_}}}) ->
+ {ok,D,{{gc_bif,N},Ss}};
+cse_expr({set,[D],Ss,put_list}) ->
+ {ok,D,{put_list,Ss}};
+cse_expr(_) -> none.
+
+%% cse_clear(Instr, Expressions0) -> Expressions.
+%% Remove all previous expressions that will become
+%% invalid when this instruction is executed. Basically,
+%% an expression is no longer safe to reuse when the
+%% register it has been stored to has been modified, killed,
+%% or if any of the source operands have changed.
+
+cse_clear({set,Ds,_,{alloc,Live,_}}, Es) ->
+ cse_clear_1(Es, Live, Ds);
+cse_clear({set,Ds,_,_}, Es) ->
+ cse_clear_1(Es, all, Ds).
+
+cse_clear_1(Es, Live, Ds0) ->
+ Ds = ordsets:from_list(Ds0),
+ [E || E <- Es, cse_is_safe(E, Live, Ds)].
+
+cse_is_safe({_,{Dst,Interfering}}, Live, Ds) ->
+ ordsets:is_disjoint(Interfering, Ds) andalso
+ case Dst of
+ {x,X} ->
+ X < Live;
+ _ ->
+ true
+ end.
+
+%% cse_add(Dest, Expr, Expressions0) -> Expressions.
+%% Provided that it is safe, add a new expression to the dictionary
+%% of already evaluated expressions.
+
+cse_add(D, {_,Ss}=Expr, Es) ->
+ case member(D, Ss) of
+ false ->
+ Interfering = ordsets:from_list([D|Ss]),
+ orddict:store(Expr, {D,Interfering}, Es);
+ true ->
+ %% Unsafe because the instruction overwrites one of
+ %% source operands.
+ Es
+ end.
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 22ceef097c..f8bf935132 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -85,8 +85,6 @@ format_error(Error) ->
%%% Things currently not checked. XXX
%%%
%%% - Heap allocation for binaries.
-%%% - That put_tuple is followed by the correct number of
-%%% put instructions.
%%%
%% validate(Module, [Function]) -> [] | [Error]
@@ -148,7 +146,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
hf=0, %Available heap size for floats.
fls=undefined, %Floating point state.
ct=[], %List of hot catch/try labels
- setelem=false %Previous instruction was setelement/3.
+ setelem=false, %Previous instruction was setelement/3.
+ puts_left=none %put/1 instructions left.
}).
-type label() :: integer().
@@ -340,11 +339,25 @@ valfun_1({put_list,A,B,Dst}, Vst0) ->
Vst = eat_heap(2, Vst0),
set_type_reg(cons, Dst, Vst);
valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) ->
+ Vst1 = eat_heap(1, Vst0),
+ Vst = set_type_reg(tuple_in_progress, Dst, Vst1),
+ #vst{current=St0} = Vst,
+ St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}},
+ Vst#vst{current=St};
+valfun_1({put,Src}, Vst0) ->
+ assert_term(Src, Vst0),
Vst = eat_heap(1, Vst0),
- set_type_reg({tuple,Sz}, Dst, Vst);
-valfun_1({put,Src}, Vst) ->
- assert_term(Src, Vst),
- eat_heap(1, Vst);
+ #vst{current=St0} = Vst,
+ case St0 of
+ #st{puts_left=none} ->
+ error(not_building_a_tuple);
+ #st{puts_left={1,{Dst,Type}}} ->
+ St = St0#st{puts_left=none},
+ set_type_reg(Type, Dst, Vst#vst{current=St});
+ #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) ->
+ St = St0#st{puts_left={PutsLeft-1,Info}},
+ Vst#vst{current=St}
+ end;
%% Instructions for optimization of selective receives.
valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
@@ -1274,6 +1287,7 @@ get_move_term_type(Src, Vst) ->
initialized -> error({unassigned,Src});
{catchtag,_} -> error({catchtag,Src});
{trytag,_} -> error({trytag,Src});
+ tuple_in_progress -> error({tuple_in_progress,Src});
Type -> Type
end.
@@ -1282,10 +1296,7 @@ get_move_term_type(Src, Vst) ->
%% a standard Erlang type (no catch/try tags or match contexts).
get_term_type(Src, Vst) ->
- case get_term_type_1(Src, Vst) of
- initialized -> error({unassigned,Src});
- {catchtag,_} -> error({catchtag,Src});
- {trytag,_} -> error({trytag,Src});
+ case get_move_term_type(Src, Vst) of
#ms{} -> error({match_context,Src});
Type -> Type
end.
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}}.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-17 05:51:43 +0000