diff options
-rw-r--r-- | lib/compiler/src/beam_bool.erl | 50 | ||||
-rw-r--r-- | lib/compiler/test/guard_SUITE.erl | 27 |
2 files changed, 27 insertions, 50 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 14b6381230..d14be83496 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -142,11 +142,6 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> - failed; - %% The optimization is not safe. (A register %% used by the instructions following the %% optimized code is either not assigned a @@ -215,37 +210,14 @@ ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> false -> throw(all_registers_not_killed); true -> ok end, - Same = assigned_same_value(Bl, NewCode), MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), - ordsets:union(MustBeKilled, Same)), + MustBeKilled), case none_used(MustBeUnused, OldIs, Fail, St) of false -> throw(registers_used); true -> ok end, ok. -%% assigned_same_value(OldCode, NewCodeReversed) -> [DestinationRegs] -%% Return an ordset with a list of all y registers that are always -%% assigned the same value in the old and new code. Currently, we -%% are very conservative in that we only consider identical move -%% instructions in the same order. -%% -assigned_same_value(Old, New) -> - case reverse(New) of - [{block,Bl}|_] -> - assigned_same_value(Old, Bl, []); - _ -> - ordsets:new() - end. - -assigned_same_value([{set,[{y,_}=D],[S],move}|T1], - [{set,[{y,_}=D],[S],move}|T2], Acc) -> - assigned_same_value(T1, T2, [D|Acc]); -assigned_same_value(_, _, Acc) -> - ordsets:from_list(Acc). - -update_fail_label([{set,_,_,move}=I|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [I|Acc]); update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> @@ -314,8 +286,6 @@ split_block_1(Is, Fail, ProhibitFailLabel) -> end end. -split_block_2([{set,_,_,move}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> @@ -343,8 +313,6 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); -dst_regs([{set,[D],_,move}|Is], Acc) -> - dst_regs(Is, [D|Acc]); dst_regs([_|Is], Acc) -> dst_regs(Is, Acc); dst_regs([], Acc) -> ordsets:from_list(Acc). @@ -411,13 +379,6 @@ bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> _Res -> throw(not_boolean_expr) end; -bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> - case {Src,Dst} of - {{tmp,_},_} -> throw(move); - {_,{tmp,_}} -> throw(move); - _ -> ok - end, - bopt_tree(Is, Forest, [Move|Pre]); bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> Ar = length(As), case safe_bool_op(N, Ar) of @@ -589,10 +550,6 @@ free_variables(Is) -> E = gb_sets:empty(), free_vars_1(Is, E, E, E). -free_vars_1([{set,Ds,As,move}|Is], F0, N0, A) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), N = gb_sets:union(N0, var_list(Ds)), @@ -632,8 +589,6 @@ free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. rename_regs(Is, Regs) -> rename_regs(Is, Regs, []). -rename_regs([{set,_,_,move}=I|Is], Regs, Acc) -> - rename_regs(Is, Regs, [I|Acc]); rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> Live = live_regs(Regs0), Ss = rename_sources(Ss0, Regs0), @@ -737,8 +692,7 @@ ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> Sub1 = gb_trees:update(R, NewReg, Sub0), Sub = gb_trees:insert(NewReg, NewReg, Sub1), Ssa#ssa{sub=Sub} - end; -ssa_assign(_, Ssa) -> Ssa. + end. ssa_sub_list(List, Sub) -> [ssa_sub(E, Sub) || E <- List]. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index b3b67155b3..3f073d79cb 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -34,7 +34,7 @@ tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, - bad_constants/1,bad_guards/1]). + bad_constants/1,bad_guards/1,scotland/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -52,7 +52,7 @@ groups() -> rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants,bad_guards]}]. + bad_constants,bad_guards,scotland]}]. init_per_suite(Config) -> Config. @@ -1831,6 +1831,29 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) -> ok. +%% beam_bool would remove the initialization of {y,0}. +%% (Thanks to Thomas Arts and QuickCheck.) + +scotland(_Config) -> + million = do_scotland(placed), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)), + ok. + +do_scotland(Echo) -> + found(case Echo of + Echo when true; Echo, Echo, Echo -> + Echo; + echo -> + [] + end, + Echo = placed). + +found(_, _) -> million. + + + %% Call this function to turn off constant propagation. id(I) -> I. |