diff options
Diffstat (limited to 'lib/compiler/src')
-rw-r--r-- | lib/compiler/src/Makefile | 2 | ||||
-rw-r--r-- | lib/compiler/src/beam_a.erl | 4 | ||||
-rw-r--r-- | lib/compiler/src/beam_jump.erl | 43 | ||||
-rw-r--r-- | lib/compiler/src/beam_kernel_to_ssa.erl | 5 | ||||
-rw-r--r-- | lib/compiler/src/beam_ssa.erl | 5 | ||||
-rw-r--r-- | lib/compiler/src/beam_ssa_opt.erl | 137 | ||||
-rw-r--r-- | lib/compiler/src/beam_ssa_pre_codegen.erl | 197 | ||||
-rw-r--r-- | lib/compiler/src/beam_ssa_type.erl | 215 | ||||
-rw-r--r-- | lib/compiler/src/beam_validator.erl | 308 | ||||
-rw-r--r-- | lib/compiler/src/compile.erl | 32 | ||||
-rw-r--r-- | lib/compiler/src/compiler.app.src | 1 | ||||
-rw-r--r-- | lib/compiler/src/erl_bifs.erl | 16 | ||||
-rw-r--r-- | lib/compiler/src/sys_core_dsetel.erl | 360 | ||||
-rw-r--r-- | lib/compiler/src/v3_core.erl | 24 | ||||
-rw-r--r-- | lib/compiler/src/v3_kernel.erl | 1 |
15 files changed, 642 insertions, 708 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 97c73d0e07..c971e8844d 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -90,7 +90,6 @@ MODULES = \ rec_env \ sys_core_alias \ sys_core_bsm \ - sys_core_dsetel \ sys_core_fold \ sys_core_fold_lists \ sys_core_inline \ @@ -209,7 +208,6 @@ $(EBIN)/core_lint.beam: core_parse.hrl $(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl $(EBIN)/core_pp.beam: core_parse.hrl $(EBIN)/sys_core_alias.beam: core_parse.hrl -$(EBIN)/sys_core_dsetel.beam: core_parse.hrl $(EBIN)/sys_core_fold.beam: core_parse.hrl $(EBIN)/sys_core_fold_lists.beam: core_parse.hrl $(EBIN)/sys_core_inline.beam: core_parse.hrl diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 1ac892a8f1..0bccad1ecd 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -122,10 +122,6 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; rename_instr(bs_init_writable=I) -> {bs_init,{f,0},I,1,[{x,0}],{x,0}}; -rename_instr({test,bs_match_string=Op,F,[Ctx,Bits,{string,Str}]}) when is_list(Str) -> - %% When compiling from an old .S file. Starting from OTP 22, Str is a binary. - <<Bs:Bits/bits,_/bits>> = list_to_binary(Str), - {test,Op,F,[Ctx,Bs]}; rename_instr({put_map_assoc,Fail,S,D,R,L}) -> {put_map,Fail,assoc,S,D,R,L}; rename_instr({put_map_exact,Fail,S,D,R,L}) -> diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 8b0e3e32f8..6f50bfdb9c 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -182,18 +182,20 @@ eliminate_moves(Is) -> eliminate_moves([{select,select_val,Reg,_,List}=I|Is], D0, Acc) -> D = update_value_dict(List, Reg, D0), eliminate_moves(Is, D, [I|Acc]); -eliminate_moves([{label,Lbl},{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk0|Is], - D, Acc0) -> +eliminate_moves([{test,is_eq_exact,_,[Reg,Val]}=I, + {block,BlkIs0}|Is], D0, Acc) -> + D = update_unsafe_labels(I, D0), + RegVal = {Reg,Val}, + BlkIs = eliminate_moves_blk(BlkIs0, RegVal), + eliminate_moves([{block,BlkIs}|Is], D, [I|Acc]); +eliminate_moves([{label,Lbl},{block,BlkIs0}=Blk|Is], D, Acc0) -> Acc = [{label,Lbl}|Acc0], - case already_has_value(Lit, Lbl, Dst, D) andalso - no_fallthrough(Acc0) of - true -> - %% Remove redundant 'move' instruction. - Blk = {block,BlkIs}, - eliminate_moves([Blk|Is], D, Acc); - false -> - %% Keep 'move' instruction. - eliminate_moves([Blk0|Is], D, Acc) + case {no_fallthrough(Acc0),D} of + {true,#{Lbl:={_,_}=RegVal}} -> + BlkIs = eliminate_moves_blk(BlkIs0, RegVal), + eliminate_moves([{block,BlkIs}|Is], D, Acc); + {_,_} -> + eliminate_moves([Blk|Is], D, Acc) end; eliminate_moves([{block,[]}|Is], D, Acc) -> %% Empty blocks can prevent further jump optimizations. @@ -203,17 +205,20 @@ eliminate_moves([I|Is], D0, Acc) -> eliminate_moves(Is, D, [I|Acc]); eliminate_moves([], _, Acc) -> reverse(Acc). +eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {_,Dst}) -> + Is; +eliminate_moves_blk([{set,[Dst],[Lit],move}|Is], {Dst,Lit}) -> + %% Remove redundant 'move' instruction. + Is; +eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {Dst,_}) -> + Is; +eliminate_moves_blk([{set,[_],[_],move}=I|Is], {_,_}=RegVal) -> + [I|eliminate_moves_blk(Is, RegVal)]; +eliminate_moves_blk(Is, _) -> Is. + no_fallthrough([I|_]) -> is_unreachable_after(I). -already_has_value(Lit, Lbl, Reg, D) -> - case D of - #{Lbl:={Reg,Lit}} -> - true; - #{} -> - false - end. - update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> D = case D0 of #{Lbl:=unsafe} -> D0; diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl index d6e675ae72..410bafe0bb 100644 --- a/lib/compiler/src/beam_kernel_to_ssa.erl +++ b/lib/compiler/src/beam_kernel_to_ssa.erl @@ -707,11 +707,6 @@ bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, %% internal_cg(Bif, [Arg], [Ret], Le, State) -> %% {[Ainstr],State}. -internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, _Le, St) -> - [New,Tuple,#b_literal{val=Index1}] = ssa_args([New0,Tuple0,Index0], St), - Index = #b_literal{val=Index1-1}, - Set = #b_set{op=set_tuple_element,args=[New,Tuple,Index]}, - {[Set],St}; internal_cg(make_fun, [Name0,Arity0|As], Rs, _Le, St0) -> #k_atom{val=Name} = Name0, #k_int{val=Arity} = Arity0, diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl index 0f662d851d..a9977b0b1d 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -109,7 +109,7 @@ 'make_fun' | 'new_try_tag' | 'peek_message' | 'phi' | 'put_list' | 'put_map' | 'put_tuple' | 'raw_raise' | 'recv_next' | 'remove_message' | 'resume' | - 'set_tuple_element' | 'succeeded' | + 'succeeded' | 'timeout' | 'wait' | 'wait_timeout'. @@ -118,7 +118,8 @@ %% Primops only used internally during code generation. -type cg_prim_op() :: 'bs_get' | 'bs_match_string' | 'bs_restore' | 'bs_skip' | - 'copy' | 'put_tuple_arity' | 'put_tuple_element'. + 'copy' | 'put_tuple_arity' | 'put_tuple_element' | + 'set_tuple_element'. -import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1]). diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index 2bd3612c06..f8e19d0aa7 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -164,12 +164,14 @@ repeated_passes(Opts) -> epilogue_passes(Opts) -> Ps = [?PASS(ssa_opt_type_finish), ?PASS(ssa_opt_float), - ?PASS(ssa_opt_live), %One last time to clean up the - %mess left by the float pass. + ?PASS(ssa_opt_sw), + + %% Run live one more time to clean up after the float and sw + %% passes. + ?PASS(ssa_opt_live), ?PASS(ssa_opt_bsm), ?PASS(ssa_opt_bsm_units), ?PASS(ssa_opt_bsm_shortcut), - ?PASS(ssa_opt_sw), ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_sink), ?PASS(ssa_opt_merge_blocks), @@ -249,22 +251,14 @@ fdb_update(Caller, Callee, FuncDb) -> FuncDb#{ Caller => CallerVertex#func_info{out=Calls}, Callee => CalleeVertex#func_info{in=CalledBy} }. -%% Returns the post-order of all local calls in this module. That is, it starts -%% with the functions that don't call any others and then walks up the call -%% chain. +%% Returns the post-order of all local calls in this module. That is, +%% called functions will be ordered before the functions calling them. %% %% Functions where module-level optimization is disabled are added last in %% arbitrary order. get_call_order_po(StMap, FuncDb) -> - Leaves = maps:fold(fun(Id, #func_info{out=[]}, Acc) -> - [Id | Acc]; - (_, _, Acc) -> - Acc - end, [], FuncDb), - - Order = gco_po_1(sort(Leaves), FuncDb, [], #{}), - + Order = gco_po(FuncDb), Order ++ maps:fold(fun(K, _V, Acc) -> case is_map_key(K, FuncDb) of false -> [K | Acc]; @@ -272,20 +266,23 @@ get_call_order_po(StMap, FuncDb) -> end end, [], StMap). -gco_po_1([Id | Ids], FuncDb, Children, Seen) when not is_map_key(Id, Seen) -> - [Id | gco_po_1(Ids, FuncDb, [Id | Children], Seen#{ Id => true })]; -gco_po_1([_Id | Ids], FuncDb, Children, Seen) -> - gco_po_1(Ids, FuncDb, Children, Seen); -gco_po_1([], FuncDb, [_|_]=Children, Seen) -> - gco_po_1(gco_po_parents(Children, FuncDb), FuncDb, [], Seen); -gco_po_1([], _FuncDb, [], _Seen) -> - []. +gco_po(FuncDb) -> + All = sort(maps:keys(FuncDb)), + {RPO,_} = gco_rpo(All, FuncDb, cerl_sets:new(), []), + reverse(RPO). -gco_po_parents([Child | Children], FuncDb) -> - #{ Child := #func_info{in=Parents}} = FuncDb, - Parents ++ gco_po_parents(Children, FuncDb); -gco_po_parents([], _FuncDb) -> - []. +gco_rpo([Id|Ids], FuncDb, Seen0, Acc0) -> + case cerl_sets:is_element(Id, Seen0) of + true -> + gco_rpo(Ids, FuncDb, Seen0, Acc0); + false -> + #func_info{out=Successors} = map_get(Id, FuncDb), + Seen1 = cerl_sets:add_element(Id, Seen0), + {Acc,Seen} = gco_rpo(Successors, FuncDb, Seen1, Acc0), + gco_rpo(Ids, FuncDb, Seen, [Id|Acc]) + end; +gco_rpo([], _, Seen, Acc) -> + {Acc,Seen}. %%% %%% Trivial sub passes. @@ -1835,12 +1832,16 @@ opt_tup_size_is([], _, _, _Acc) -> none. %%% ssa_opt_sw({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> - {Linear,Count} = opt_sw(Linear0, #{}, Count0, []), + {Linear,Count} = opt_sw(Linear0, Count0, []), {St#st{ssa=Linear,cnt=Count}, FuncDb}. -opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) -> - Phis = opt_sw_phis(Is, Phis0), - case opt_sw_last(Last0, Phis) of +opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) -> + %% Ensure that no label in the switch list is the same + %% as the failure label. + #b_switch{fail=Fail,list=List0} = Sw0, + List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], + Sw1 = beam_ssa:normalize(Sw0#b_switch{list=List}), + case Sw1 of #b_switch{arg=Arg,fail=Fail,list=[{Lit,Lbl}]} -> %% Rewrite a single value switch to a br. Bool = #b_var{name={'@ssa_bool',Count0}}, @@ -1848,7 +1849,7 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) - IsEq = #b_set{op={bif,'=:='},dst=Bool,args=[Arg,Lit]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsEq],last=Br}, - opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]); + opt_sw(Bs, Count, [{L,Blk}|Acc]); #b_switch{arg=Arg,fail=Fail, list=[{#b_literal{val=B1},Lbl},{#b_literal{val=B2},Lbl}]} when B1 =:= not B2 -> @@ -1858,71 +1859,18 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) - IsBool = #b_set{op={bif,is_boolean},dst=Bool,args=[Arg]}, Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, Blk = Blk0#b_blk{is=Is++[IsBool],last=Br}, - opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]); - Last0 -> - opt_sw(Bs, Phis, Count0, [{L,Blk0}|Acc]); - Last -> - Blk = Blk0#b_blk{last=Last}, - opt_sw(Bs, Phis, Count0, [{L,Blk}|Acc]) + opt_sw(Bs, Count, [{L,Blk}|Acc]); + Sw0 -> + opt_sw(Bs, Count0, [{L,Blk0}|Acc]); + Sw -> + Blk = Blk0#b_blk{last=Sw}, + opt_sw(Bs, Count0, [{L,Blk}|Acc]) end; -opt_sw([{L,#b_blk{is=Is}=Blk}|Bs], Phis0, Count, Acc) -> - Phis = opt_sw_phis(Is, Phis0), - opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]); -opt_sw([], _Phis, Count, Acc) -> +opt_sw([{L,#b_blk{}=Blk}|Bs], Count, Acc) -> + opt_sw(Bs, Count, [{L,Blk}|Acc]); +opt_sw([], Count, Acc) -> {reverse(Acc),Count}. -opt_sw_phis([#b_set{op=phi,dst=Dst,args=Args}|Is], Phis) -> - case opt_sw_literals(Args, []) of - error -> - opt_sw_phis(Is, Phis); - Literals -> - opt_sw_phis(Is, Phis#{Dst=>Literals}) - end; -opt_sw_phis(_, Phis) -> Phis. - -opt_sw_last(#b_switch{arg=Arg,fail=Fail,list=List0}=Sw0, Phis) -> - case Phis of - #{Arg:=Values0} -> - Values = gb_sets:from_list(Values0), - - %% Prune the switch list to only contain the possible values. - List1 = [P || {Lit,_}=P <- List0, gb_sets:is_member(Lit, Values)], - - %% Now test whether the failure label can ever be reached. - Sw = case gb_sets:size(Values) =:= length(List1) of - true -> - %% The switch list has the same number of values as the phi node. - %% The values must be the same, because the values that were not - %% possible were pruned from the switch list. Therefore, the - %% failure label can't possibly be reached, and we can choose a - %% a new failure label by picking a value from the list. - case List1 of - [{#b_literal{},Lbl}|List] -> - Sw0#b_switch{fail=Lbl,list=List}; - [] -> - Sw0#b_switch{list=List1} - end; - false -> - %% There are some values in the phi node that are not in the - %% switch list; thus, the failure label can still be reached. - Sw0 - end, - beam_ssa:normalize(Sw); - #{} -> - %% Ensure that no label in the switch list is the same - %% as the failure label. - List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], - Sw = Sw0#b_switch{list=List}, - beam_ssa:normalize(Sw) - end. - -opt_sw_literals([{#b_literal{}=Lit,_}|T], Acc) -> - opt_sw_literals(T, [Lit|Acc]); -opt_sw_literals([_|_], _Acc) -> - error; -opt_sw_literals([], Acc) -> Acc. - - %%% %%% Merge blocks. %%% @@ -2201,7 +2149,6 @@ insert_def_is([#b_set{op=Op}=I|Is]=Is0, V, Def) -> Action0 = case Op of call -> beyond; 'catch_end' -> beyond; - set_tuple_element -> beyond; timeout -> beyond; _ -> here end, diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index df4de8d7bd..bad43a9c4e 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -124,6 +124,7 @@ passes(Opts) -> false -> ignore; true -> ?PASS(fix_tuples) end, + ?PASS(use_set_tuple_element), ?PASS(place_frames), ?PASS(fix_receives), @@ -857,6 +858,202 @@ fix_tuples(#st{ssa=Blocks0,cnt=Count0}=St) -> St#st{ssa=Blocks,cnt=Count}. %%% +%%% Introduce the set_tuple_element instructions to make +%%% multiple-field record updates faster. +%%% +%%% The expansion of record field updates, when more than one field is +%%% updated, but not a majority of the fields, will create a sequence of +%%% calls to `erlang:setelement(Index, Value, Tuple)` where Tuple in the +%%% first call is the original record tuple, and in the subsequent calls +%%% Tuple is the result of the previous call. Furthermore, all Index +%%% values are constant positive integers, and the first call to +%%% `setelement` will have the greatest index. Thus all the following +%%% calls do not actually need to test at run-time whether Tuple has type +%%% tuple, nor that the index is within the tuple bounds. +%%% +%%% Since this optimization introduces destructive updates, it used to +%%% be done as the very last Core Erlang pass before going to +%%% lower-level code. However, it turns out that this kind of destructive +%%% updates are awkward also in SSA code and can prevent or complicate +%%% type analysis and aggressive optimizations. +%%% +%%% NOTE: Because there no write barriers in the system, this kind of +%%% optimization can only be done when we are sure that garbage +%%% collection will not be triggered between the creation of the tuple +%%% and the destructive updates - otherwise we might insert pointers +%%% from an older generation to a newer. +%%% + +use_set_tuple_element(#st{ssa=Blocks0}=St) -> + Uses = count_uses(Blocks0), + RPO = reverse(beam_ssa:rpo(Blocks0)), + Blocks = use_ste_1(RPO, Uses, Blocks0), + St#st{ssa=Blocks}. + +use_ste_1([L|Ls], Uses, Blocks0) -> + {Blk0,Blocks} = use_ste_across(L, Uses, Blocks0), + #b_blk{is=Is0} = Blk0, + case use_ste_is(Is0, Uses) of + Is0 -> + use_ste_1(Ls, Uses, Blocks); + Is -> + Blk = Blk0#b_blk{is=Is}, + use_ste_1(Ls, Uses, Blocks#{L:=Blk}) + end; +use_ste_1([], _, Blocks) -> Blocks. + +%%% Optimize within a single block. + +use_ste_is([#b_set{}=I|Is0], Uses) -> + Is = use_ste_is(Is0, Uses), + case extract_ste(I) of + none -> + [I|Is]; + Extracted -> + use_ste_call(Extracted, I, Is, Uses) + end; +use_ste_is([], _Uses) -> []. + +use_ste_call({Dst0,Pos0,_Var0,_Val0}, Call1, Is0, Uses) -> + case get_ste_call(Is0, []) of + {Prefix,{Dst1,Pos1,Dst0,Val1},Call2,Is} + when Pos1 > 0, Pos0 > Pos1 -> + case is_single_use(Dst0, Uses) of + true -> + Call = Call1#b_set{dst=Dst1}, + Args = [Val1,Dst1,#b_literal{val=Pos1-1}], + Dsetel = Call2#b_set{op=set_tuple_element, + dst=Dst0, + args=Args}, + [Call|Prefix] ++ [Dsetel|Is]; + false -> + [Call1|Is0] + end; + _ -> + [Call1|Is0] + end. + +get_ste_call([#b_set{op=get_tuple_element}=I|Is], Acc) -> + get_ste_call(Is, [I|Acc]); +get_ste_call([#b_set{op=call}=I|Is], Acc) -> + case extract_ste(I) of + none -> + none; + Extracted -> + {reverse(Acc),Extracted,I,Is} + end; +get_ste_call(_, _) -> none. + +extract_ste(#b_set{op=call,dst=Dst, + args=[#b_remote{mod=#b_literal{val=M}, + name=#b_literal{val=F}}|Args]}) -> + case {M,F,Args} of + {erlang,setelement,[#b_literal{val=Pos},Tuple,Val]} -> + {Dst,Pos,Tuple,Val}; + {_,_,_} -> + none + end; +extract_ste(#b_set{}) -> none. + +%%% Optimize accross blocks within a try/catch block. + +use_ste_across(L, Uses, Blocks) -> + case map_get(L, Blocks) of + #b_blk{last=#b_br{bool=#b_var{}}}=Blk -> + try + use_ste_across_1(L, Blk, Uses, Blocks) + catch + throw:not_possible -> + {Blk,Blocks} + end; + #b_blk{}=Blk -> + {Blk,Blocks} + end. + +use_ste_across_1(L, Blk0, Uses, Blocks0) -> + #b_blk{is=IsThis,last=#b_br{bool=Bool,succ=Next}} = Blk0, + case reverse(IsThis) of + [#b_set{op=succeeded,dst=Bool,args=[Result]}=Succ0, + #b_set{op=call,args=[#b_remote{}|_],dst=Result}=Call1|Prefix] -> + case is_single_use(Bool, Uses) andalso + is_n_uses(2, Result, Uses) of + true -> ok; + false -> throw(not_possible) + end, + Call2 = use_ste_across_next(Next, Uses, Blocks0), + Is = [Call1,Call2], + case use_ste_is(Is, decrement_uses(Result, Uses)) of + [#b_set{}=Call,#b_set{op=set_tuple_element}=Ste] -> + Blocks1 = use_ste_fix_next(Ste, Next, Blocks0), + Succ = Succ0#b_set{args=[Call#b_set.dst]}, + Blk = Blk0#b_blk{is=reverse(Prefix, [Call,Succ])}, + Blocks = Blocks1#{L:=Blk}, + {Blk,Blocks}; + _ -> + throw(not_possible) + end; + _ -> + throw(not_possible) + end. + +use_ste_across_next(Next, Uses, Blocks) -> + case map_get(Next, Blocks) of + #b_blk{is=[#b_set{op=call,dst=Result,args=[#b_remote{}|_]}=Call, + #b_set{op=succeeded,dst=Bool,args=[Result]}], + last=#b_br{bool=Bool}} -> + case is_single_use(Bool, Uses) andalso + is_n_uses(2, Result, Uses) of + true -> ok; + false -> throw(not_possible) + end, + Call; + #b_blk{} -> + throw(not_possible) + end. + +use_ste_fix_next(Ste, Next, Blocks) -> + Blk0 = map_get(Next, Blocks), + #b_blk{is=[#b_set{op=call},#b_set{op=succeeded}],last=Br0} = Blk0, + Br = beam_ssa:normalize(Br0#b_br{bool=#b_literal{val=true}}), + Blk = Blk0#b_blk{is=[Ste],last=Br}, + Blocks#{Next:=Blk}. + +%% Count how many times each variable is used. + +count_uses(Blocks) -> + count_uses_blk(maps:values(Blocks), #{}). + +count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> + F = fun(I, CountMap) -> + foldl(fun(Var, Acc) -> + case Acc of + #{Var:=3} -> Acc; + #{Var:=C} -> Acc#{Var:=C+1}; + #{} -> Acc#{Var=>1} + end + end, CountMap, beam_ssa:used(I)) + end, + CountMap = F(Last, foldl(F, CountMap0, Is)), + count_uses_blk(Bs, CountMap); +count_uses_blk([], CountMap) -> CountMap. + +decrement_uses(V, Uses) -> + #{V:=C} = Uses, + Uses#{V:=C-1}. + +is_n_uses(N, V, Uses) -> + case Uses of + #{V:=N} -> true; + #{} -> false + end. + +is_single_use(V, Uses) -> + case Uses of + #{V:=1} -> true; + #{} -> false + end. + +%%% %%% Find out where frames should be placed. %%% diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 6fa02da89d..5fbb679c6f 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -23,7 +23,8 @@ -include("beam_ssa_opt.hrl"). -import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - partition/2,reverse/1,reverse/2,seq/2,sort/1]). + keyfind/3,partition/2,reverse/1,reverse/2, + seq/2,sort/1]). -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). @@ -260,29 +261,34 @@ opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]) end; opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb0, D, Sub, Acc) -> - Args = simplify_args(Args0, Sub, Ts0), + Ts0, Ds0, Fdb0, D, Sub0, Acc) -> + Args = simplify_args(Args0, Sub0, Ts0), I1 = beam_ssa:normalize(I0#b_set{args=Args}), - {Ts,Ds,Fdb,I} = opt_call(I1, D, Ts0, Ds0, Fdb0), - case {map_get(Dst, Ts),Is} of - {none,[#b_set{op=succeeded}]} -> + {Ts1,Ds,Fdb,I2} = opt_call(I1, D, Ts0, Ds0, Fdb0), + case {map_get(Dst, Ts1),Is} of + {_,[#b_set{op=succeeded}]} -> %% This call instruction is inside a try/catch %% block. Don't attempt to optimize it. - opt_is(Is, Ts, Ds, Fdb, D, Sub, [I|Acc]); + opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I2|Acc]); {none,_} -> %% This call never returns. The rest of the %% instructions will not be executed. Ret = #b_ret{arg=Dst}, - {no_return,Ret,reverse(Acc, [I]),Ds,Fdb,Sub}; - _ -> - opt_is(Is, Ts, Ds, Fdb, D, Sub, [I|Acc]) + {no_return,Ret,reverse(Acc, [I2]),Ds,Fdb,Sub0}; + {_,_} -> + case simplify_call(I2) of + #b_set{}=I -> + opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I|Acc]); + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + Ts = maps:remove(Dst, Ts1), + opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc); + #b_var{}=Var -> + Ts = maps:remove(Dst, Ts1), + Sub = Sub0#{Dst=>Var}, + opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) + end end; -opt_is([#b_set{op=set_tuple_element}=I0|Is], - Ts0, Ds0, Fdb, D, Sub, Acc) -> - %% This instruction lacks a return value and destructively updates its - %% source, so it needs special handling to update the source type. - {Ts, Ds, I} = opt_set_tuple_element(I0, Ts0, Ds0, Sub), - opt_is(Is, Ts, Ds, Fdb, D, Sub, [I|Acc]); opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], Ts0, Ds0, Fdb, D, Sub0, Acc) -> case Ds0 of @@ -334,6 +340,48 @@ opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) -> {reverse(Acc), Ts, Ds, Fdb, Sub}. +simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) -> + case Rem of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}} -> + case erl_bifs:is_pure(Mod, Name, length(Args)) of + true -> + simplify_remote_call(Mod, Name, Args, I); + false -> + I + end; + #b_remote{} -> + I + end; +simplify_call(I) -> I. + +%% Simplify a remote call to a pure BIF. +simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> + Tl; +simplify_remote_call(Mod, Name, Args0, I) -> + case make_literal_list(Args0) of + none -> + I; + Args -> + %% The arguments are literals. Try to evaluate the BIF. + try apply(Mod, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + #b_literal{val=Val}; + false -> + %% The value can't be expressed as a literal + %% (e.g. a pid). + I + end + catch + _:_ -> + %% Failed. Don't bother trying to optimize + %% the call. + I + end + end. + opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), case Fdb0 of @@ -381,28 +429,6 @@ update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> update_arg_types([], [], _CallId, _Ts) -> []. -opt_set_tuple_element(#b_set{op=set_tuple_element,args=Args0,dst=Dst}=I0, - Ts0, Ds0, Sub) -> - Args = simplify_args(Args0, Sub, Ts0), - [Val,#b_var{}=Src,#b_literal{val=N}] = Args, - - SrcType0 = get_type(Src, Ts0), - ValType = get_type(Val, Ts0), - Index = N + 1, - - #t_tuple{size=Size,elements=Es0} = SrcType0, - true = Index =< Size, %Assertion. - - Es = set_element_type(Index, ValType, Es0), - SrcType = SrcType0#t_tuple{elements=Es}, - - I = beam_ssa:normalize(I0#b_set{args=Args}), - - Ts = Ts0#{ Dst => any, Src => SrcType }, - Ds = Ds0#{ Dst => I }, - - {Ts, Ds, I}. - simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> case is_safe_bool_op(Args, Ts) of true -> @@ -480,10 +506,19 @@ simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) -> end; simplify(#b_set{op={bif,'=:='},args=[Same,Same]}, _Ts) -> #b_literal{val=true}; -simplify(#b_set{op={bif,'=:='},args=Args}=I, Ts) -> - case meet(get_types(Args, Ts)) of - none -> #b_literal{val=false}; - _ -> eval_bif(I, Ts) +simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) -> + [T1,T2] = get_types(Args, Ts), + case meet(T1, T2) of + none -> + #b_literal{val=false}; + _ -> + case {t_is_boolean(T1),T2} of + {true,#t_atom{elements=[true]}} -> + %% Bool =:= true ==> Bool + A1; + {_,_} -> + eval_bif(I, Ts) + end end; simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> Types = get_types(Args, Ts), @@ -626,41 +661,49 @@ anno_float_arg(_) -> convert. opt_terminator(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> beam_ssa:normalize(Br); -opt_terminator(#b_br{bool=#b_var{}=V}=Br, Ts, Ds) -> - #{V:=Set} = Ds, - case Set of - #b_set{op={bif,'=:='},args=[Bool,#b_literal{val=true}]} -> - case t_is_boolean(get_type(Bool, Ts)) of - true -> - %% Bool =:= true ==> Bool - simplify_not(Br#b_br{bool=Bool}, Ts, Ds); - false -> - Br - end; - #b_set{} -> - simplify_not(Br, Ts, Ds) - end; +opt_terminator(#b_br{bool=#b_var{}}=Br, Ts, Ds) -> + simplify_not(Br, Ts, Ds); opt_terminator(#b_switch{arg=#b_literal{}}=Sw, _Ts, _Ds) -> beam_ssa:normalize(Sw); -opt_terminator(#b_switch{arg=#b_var{}=V}=Sw0, Ts, Ds) -> - Type = get_type(V, Ts), +opt_terminator(#b_switch{arg=#b_var{}=V}=Sw, Ts, Ds) -> + case get_type(V, Ts) of + any -> + beam_ssa:normalize(Sw); + Type -> + beam_ssa:normalize(opt_switch(Sw, Type, Ts, Ds)) + end; +opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. + + +opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) -> + List = prune_switch_list(List0, Fail, Type, Ts), + Sw1 = Sw0#b_switch{list=List}, case Type of #t_integer{elements={_,_}=Range} -> - simplify_switch_int(Sw0, Range); - _ -> + simplify_switch_int(Sw1, Range); + #t_atom{elements=[_|_]} -> case t_is_boolean(Type) of true -> - case simplify_switch_bool(Sw0, Ts, Ds) of - #b_br{}=Br -> - opt_terminator(Br, Ts, Ds); - Sw -> - beam_ssa:normalize(Sw) - end; + #b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds), + opt_terminator(Br, Ts, Ds); false -> - beam_ssa:normalize(Sw0) - end + simplify_switch_atom(Type, Sw1) + end; + _ -> + Sw1 + end. + +prune_switch_list([{_,Fail}|T], Fail, Type, Ts) -> + prune_switch_list(T, Fail, Type, Ts); +prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) -> + case meet(get_type(Arg, Ts), Type) of + none -> + %% Different types. This value can never match. + prune_switch_list(T, Fail, Type, Ts); + _ -> + [Pair|prune_switch_list(T, Fail, Type, Ts)] end; -opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. +prune_switch_list([], _, _, _) -> []. update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) -> update_successor(S, Ts, D); @@ -669,8 +712,8 @@ update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> true -> %% This variable is defined in this block and is only %% referenced by this br terminator. Therefore, there is - %% no need to include the type database passed on to the - %% successors of this block. + %% no need to include it in the type database passed on to + %% the successors of this block. Ts = maps:remove(Bool, Ts0), {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), D = update_successor(Fail, FailTs, D0), @@ -1057,6 +1100,17 @@ bs_match_type(utf16, _) -> bs_match_type(utf32, _) -> ?UNICODE_INT. +simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) -> + case sort([A || {#b_literal{val=A},_} <- List0]) of + Atoms -> + %% All possible atoms are included in the list. The + %% failure label will never be used. + [{_,Fail}|List] = List0, + Sw#b_switch{fail=Fail,list=List}; + _ -> + Sw + end. + simplify_switch_int(#b_switch{list=List0}=Sw, {Min,Max}) -> List1 = sort(List0), Vs = [V || {#b_literal{val=V},_} <- List1], @@ -1101,14 +1155,14 @@ simplify_is_record(I, any, _Size, _Tag, _Ts) -> simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> #b_literal{val=false}. -simplify_switch_bool(#b_switch{arg=B,list=List0}=Sw, Ts, Ds) -> - List = sort(List0), - case List of - [{#b_literal{val=false},Fail},{#b_literal{val=true},Succ}] -> - simplify_not(#b_br{bool=B,succ=Succ,fail=Fail}, Ts, Ds); - [_|_] -> - Sw - end. +simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds) -> + FalseVal = #b_literal{val=false}, + TrueVal = #b_literal{val=true}, + List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}], + {_,FalseLbl} = keyfind(FalseVal, 1, List1), + {_,TrueLbl} = keyfind(TrueVal, 1, List1), + Br = beam_ssa:normalize(#b_br{bool=B,succ=TrueLbl,fail=FalseLbl}), + simplify_not(Br, Ts, Ds). simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> case Ds of @@ -1122,7 +1176,8 @@ simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> end; #{} -> Br0 - end. + end; +simplify_not(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> Br. %%% %%% Calculate the set of variables that are only used once in the diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 3b197f7bae..aa7b190670 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -28,7 +28,7 @@ -export([module/2, format_error/1]). -export([type_anno/1, type_anno/2, type_anno/4]). --import(lists, [any/2,dropwhile/2,foldl/3,map/2,foreach/2,reverse/1]). +-import(lists, [any/2,dropwhile/2,foldl/3,map/2,reverse/1,zip/2]). %% To be called by the compiler. @@ -372,7 +372,7 @@ valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> Type = get_term_type(Val, Vst0), Es = set_element_type(Index, Type, Es0), {Es, Index + 1} - end, {#{}, 1}, Elements), + end, {#{}, 1}, Elements), Type = {tuple,Size,Es}, create_term(Type, Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> @@ -539,19 +539,20 @@ valfun_2(_, _) -> %% Handle the remaining floating point instructions here. %% Floating point. -valfun_3({fconv,Src,{fr,_}=Dst}, Vst) -> - assert_term(Src, Vst), +valfun_3({fconv,Src,{fr,_}=Dst}, Vst0) -> + assert_term(Src, Vst0), + Vst = update_type(fun meet/2, number, Src, Vst0), set_freg(Dst, Vst); -valfun_3({bif,fadd,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fdiv,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fmul,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fnegate,_,[_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fsub,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); +valfun_3({bif,fadd,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fmul,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fnegate,_,[_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fsub,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); valfun_3(fclearerror, Vst) -> case get_fls(Vst) of undefined -> ok; @@ -603,8 +604,7 @@ valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}=I, Vst0) -> - Vst1 = branch_state(Fail, Vst0), - Vst = update_type(fun meet/2, {tuple,[0],#{}}, Tuple, Vst1), + Vst = type_test(Fail, {tuple,[0],#{}}, Tuple, Vst0), set_type_reg_expr({integer,[]}, I, Dst, Vst); valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> PosType = get_durable_term_type(Pos, Vst0), @@ -634,13 +634,20 @@ valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> valfun_4({bif,Op,{f,Fail},[Cons]=Ss,Dst}, Vst0) when Op =:= hd; Op =:= tl -> validate_src(Ss, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = update_type(fun meet/2, cons, Cons, Vst1), + Vst = type_test(Fail, cons, Cons, Vst0), Type = bif_type(Op, Ss, Vst), extract_term(Type, Ss, Dst, Vst); valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst0) -> validate_src(Ss, Vst0), - Vst = branch_state(Fail, Vst0), + Vst1 = branch_state(Fail, Vst0), + + %% Infer argument types. Note that we can't type_test in the general case + %% as the BIF could fail for reasons other than bad arguments. + ArgTypes = bif_arg_types(Op, Ss), + Vst = foldl(fun({Arg, T}, Vsti) -> + update_type(fun meet/2, T, Arg, Vsti) + end, Vst1, zip(Ss, ArgTypes)), + Type = bif_type(Op, Ss, Vst), extract_term(Type, Ss, Dst, Vst); valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> @@ -650,11 +657,12 @@ valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> St = kill_heap_allocation(St0), Vst1 = Vst0#vst{current=St}, Vst2 = branch_state(Fail, Vst1), - Vst3 = case Op of - length -> update_type(fun meet/2, list, hd(Ss), Vst2); - map_size -> update_type(fun meet/2, map, hd(Ss), Vst2); - _ -> Vst2 - end, + + ArgTypes = bif_arg_types(Op, Ss), + Vst3 = foldl(fun({Arg, T}, Vsti) -> + update_type(fun meet/2, T, Arg, Vsti) + end, Vst2, zip(Ss, ArgTypes)), + Type = bif_type(Op, Ss, Vst3), Vst = prune_x_regs(Live, Vst3), extract_term(Type, Ss, Dst, Vst, Vst0); @@ -697,12 +705,11 @@ valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) -> assert_choices(Choices), Vst = branch_state(Fail, Vst0), kill_state(select_val_branches(Src, Choices, Vst)); -valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> - assert_type(tuple, Tuple, Vst), +valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst0) -> + assert_type(tuple, Tuple, Vst0), assert_arities(Choices), - TupleType = get_durable_term_type(Tuple, Vst), - kill_state(branch_arities(Choices, Tuple, TupleType, - branch_state(Fail, Vst))); + Vst = branch_state(Fail, Vst0), + kill_state(branch_arities(Choices, Tuple, Vst)); %% New bit syntax matching instructions. valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> @@ -783,9 +790,10 @@ valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) -> assert_term(Src, Vst), kill_state(Vst) end; -valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> - assert_type(tuple, Tuple, Vst), - update_type(fun meet/2, {tuple,Sz,#{}}, Tuple, branch_state(Lbl, Vst)); +valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst0) when is_integer(Sz) -> + assert_type(tuple, Tuple, Vst0), + Vst = branch_state(Lbl, Vst0), + update_type(fun meet/2, {tuple,Sz,#{}}, Tuple, Vst); valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst0) -> assert_term(Src, Vst0), Vst = branch_state(Lbl, Vst0), @@ -794,20 +802,24 @@ valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), assert_unique_map_keys(List), branch_state(Lbl, Vst); -valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> - validate_src(Ss, Vst0), - Infer = infer_types(Src, Vst0), - Vst1 = Infer(Val, Vst0), - Vst2 = update_ne_types(Src, Val, Vst1), - Vst3 = branch_state(Lbl, Vst2), - Vst = Vst3#vst{current=Vst1#vst.current}, - update_eq_types(Src, Val, Vst); -valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) -> - validate_src(Ss, Vst0), - Vst1 = update_eq_types(Src, Val, Vst0), - Vst2 = branch_state(Lbl, Vst1), - Vst = Vst2#vst{current=Vst0#vst.current}, - update_ne_types(Src, Val, Vst); +valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> + validate_src(Ss, Vst), + complex_test(Lbl, + fun(FailVst) -> + update_ne_types(Src, Val, FailVst) + end, + fun(SuccVst) -> + update_eq_types(Src, Val, SuccVst) + end, Vst); +valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> + validate_src(Ss, Vst), + complex_test(Lbl, + fun(FailVst) -> + update_eq_types(Src, Val, FailVst) + end, + fun(SuccVst) -> + update_ne_types(Src, Val, SuccVst) + end, Vst); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); @@ -897,36 +909,50 @@ valfun_4(_, _) -> verify_get_map(Fail, Src, List, Vst0) -> assert_not_literal(Src), %OTP 22. assert_type(map, Src, Vst0), - Vst1 = foldl(fun(D, Vsti) -> - case is_reg_defined(D,Vsti) of - true -> create_term(term, D, Vsti); - false -> Vsti - end - end, Vst0, extract_map_vals(List)), - Vst2 = branch_state(Fail, Vst1), - Keys = extract_map_keys(List), - assert_unique_map_keys(Keys), - verify_get_map_pair(List, Src, Vst0, Vst2). -extract_map_vals([_Key,Val|T]) -> - [Val|extract_map_vals(T)]; -extract_map_vals([]) -> []. + complex_test(Fail, + fun(FailVst) -> + clobber_map_vals(List, Src, FailVst) + end, + fun(SuccVst) -> + Keys = extract_map_keys(List), + assert_unique_map_keys(Keys), + extract_map_vals(List, Src, SuccVst, SuccVst) + end, Vst0). + +%% get_map_elements may leave its destinations in an inconsistent state when +%% the fail label is taken. Consider the following: +%% +%% {get_map_elements,{f,7},{x,1},{list,[{atom,a},{x,1},{atom,b},{x,2}]}}. +%% +%% If 'a' exists but not 'b', {x,1} is overwritten when we jump to {f,7}. +clobber_map_vals([_Key,Dst|T], Map, Vst0) -> + case is_reg_defined(Dst, Vst0) of + true -> + Vst = extract_term(term, [Map], Dst, Vst0), + clobber_map_vals(T, Map, Vst); + false -> + clobber_map_vals(T, Map, Vst0) + end; +clobber_map_vals([], _Map, Vst) -> + Vst. extract_map_keys([Key,_Val|T]) -> [Key|extract_map_keys(T)]; extract_map_keys([]) -> []. -verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) -> +extract_map_vals([Src,Dst|Vs], Map, Vst0, Vsti0) -> assert_term(Src, Vst0), Vsti = extract_term(term, [Map], Dst, Vsti0), - verify_get_map_pair(Vs, Map, Vst0, Vsti); -verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst. + extract_map_vals(Vs, Map, Vst0, Vsti); +extract_map_vals([], _Map, _Vst0, Vst) -> + Vst. verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), - foreach(fun (Term) -> assert_not_fragile(Term, Vst0) end, List), + [assert_not_fragile(Term, Vst0) || Term <- List], Vst1 = heap_alloc(0, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), @@ -938,17 +964,21 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> %% Common code for validating bs_start_match* instructions. %% -validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst0) -> - verify_live(Live, Vst0), - verify_y_init(Vst0), +validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> + verify_live(Live, Vst), + verify_y_init(Vst), %% #ms{} can represent either a match context or a term, so we have to mark %% the source as a term if it fails, and retain the incoming type if it %% succeeds (match context or not). - Vst1 = set_aliased_type(term, Src, Vst0), - Vst2 = prune_x_regs(Live, Vst1), - Vst3 = branch_state(Fail, Vst2), - extract_term(Type, [Src], Dst, Vst3, Vst0). + complex_test(Fail, + fun(FailVst) -> + set_aliased_type(term, Src, FailVst) + end, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + extract_term(Type, [Src], Dst, SuccVst, Vst) + end, Vst). %% %% Common code for validating bs_get* instructions. @@ -1036,12 +1066,10 @@ verify_call_args_1(N, Vst) -> verify_call_args_1(X, Vst). verify_local_call(Lbl, Live, Vst) -> - F = fun({R, Type}) -> - verify_arg_type(Lbl, R, Type, Vst) - end, TRegs = typed_call_regs(Live, Vst), + [verify_arg_type(Lbl, R, Type, Vst) || {R, Type} <- TRegs], verify_no_ms_aliases(TRegs), - foreach(F, TRegs). + ok. typed_call_regs(0, _Vst) -> []; @@ -1190,8 +1218,8 @@ assert_arities(_) -> error(bad_tuple_arity_list). %%% fmove Src {fr,_} %% Move INTO floating point register. %%% -float_op(Src, Dst, Vst0) -> - foreach (fun(S) -> assert_freg_set(S, Vst0) end, Src), +float_op(Ss, Dst, Vst0) -> + [assert_freg_set(S, Vst0) || S <- Ss], assert_fls(cleared, Vst0), Vst = set_fls(cleared, Vst0), set_freg(Dst, Vst). @@ -1322,10 +1350,6 @@ select_val_branches_1([], _, _, Vst) -> Vst. infer_types(Src, Vst) -> case get_def(Src, Vst) of - {bif,is_map,{f,_},[Map],_} -> - fun({atom,true}, S) -> update_type(fun meet/2, map, Map, S); - (_, S) -> S - end; {bif,tuple_size,{f,_},[Tuple],_} -> fun({integer,Arity}, S) -> update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); @@ -1337,10 +1361,37 @@ infer_types(Src, Vst) -> Infer(Val, S); (_, S) -> S end; + {bif,is_atom,{f,_},[Src],_} -> + infer_type_test_bif({atom,[]}, Src); + {bif,is_boolean,{f,_},[Src],_} -> + infer_type_test_bif(bool, Src); + {bif,is_binary,{f,_},[Src],_} -> + infer_type_test_bif(binary, Src); + {bif,is_bitstring,{f,_},[Src],_} -> + infer_type_test_bif(binary, Src); + {bif,is_float,{f,_},[Src],_} -> + infer_type_test_bif(float, Src); + {bif,is_integer,{f,_},[Src],_} -> + infer_type_test_bif({integer,{}}, Src); + {bif,is_list,{f,_},[Src],_} -> + infer_type_test_bif(list, Src); + {bif,is_map,{f,_},[Src],_} -> + infer_type_test_bif(map, Src); + {bif,is_number,{f,_},[Src],_} -> + infer_type_test_bif(number, Src); + {bif,is_tuple,{f,_},[Src],_} -> + infer_type_test_bif({tuple,[],#{}}, Src); _ -> fun(_, S) -> S end end. +infer_type_test_bif(Type, Src) -> + fun({atom,true}, S) -> + update_type(fun meet/2, Type, Src, S); + (_, S) -> + S + end. + %%% %%% Keeping track of types. %%% @@ -1372,11 +1423,25 @@ extract_term(Type0, Ss, Dst, Vst, OrigVst) -> Type = propagate_fragility(Type0, Ss, OrigVst), set_type_reg(Type, Dst, Vst). +%% Helper functions for tests that alter state on both the success and fail +%% branches, keeping the states from tainting each other. +complex_test(Fail, FailFun, SuccFun, Vst0) -> + #vst{current=St0} = Vst0, + Vst1 = FailFun(Vst0), + Vst2 = branch_state(Fail, Vst1), + Vst = Vst2#vst{current=St0}, + SuccFun(Vst). + %% Helper function for simple "is_type" tests. -type_test(Fail, Type, Reg, Vst0) -> - assert_term(Reg, Vst0), - Vst = branch_state(Fail, update_type(fun subtract/2, Type, Reg, Vst0)), - update_type(fun meet/2, Type, Reg, Vst). +type_test(Fail, Type, Reg, Vst) -> + assert_term(Reg, Vst), + complex_test(Fail, + fun(FailVst) -> + update_type(fun subtract/2, Type, Reg, FailVst) + end, + fun(SuccVst) -> + update_type(fun meet/2, Type, Reg, SuccVst) + end, Vst). %% This is used when linear code finds out more and more information about a %% type, so that the type gets more specialized. @@ -1395,32 +1460,20 @@ update_type(Merge, Type0, Reg, Vst) -> none -> Type0; T -> T end, - set_aliased_type(propagate_fragility(Type, [Reg], Vst), Reg, Vst). + set_aliased_type(Type, Reg, Vst). update_ne_types(LHS, RHS, Vst) -> - T1 = get_durable_term_type(LHS, Vst), - T2 = get_durable_term_type(RHS, Vst), - Type = propagate_fragility(subtract(T1, T2), [LHS], Vst), - set_aliased_type(Type, LHS, Vst). + update_type(fun subtract/2, get_durable_term_type(RHS, Vst), LHS, Vst). update_eq_types(LHS, RHS, Vst0) -> - T1 = get_durable_term_type(LHS, Vst0), - T2 = get_durable_term_type(RHS, Vst0), - Meet = meet(T1, T2), - Vst = case T1 =/= Meet of - true -> - LType = propagate_fragility(Meet, [LHS], Vst0), - set_aliased_type(LType, LHS, Vst0); - false -> - Vst0 - end, - case T2 =/= Meet of - true -> - RType = propagate_fragility(Meet, [RHS], Vst0), - set_aliased_type(RType, RHS, Vst); - false -> - Vst - end. + Infer = infer_types(LHS, Vst0), + Vst1 = Infer(RHS, Vst0), + + T1 = get_durable_term_type(LHS, Vst1), + T2 = get_durable_term_type(RHS, Vst1), + + Vst = update_type(fun meet/2, T2, LHS, Vst1), + update_type(fun meet/2, T1, RHS, Vst). %% Helper functions for the above. @@ -1779,7 +1832,8 @@ get_tuple_size({integer,Sz}) -> Sz; get_tuple_size(_) -> 0. validate_src(Ss, Vst) when is_list(Ss) -> - foreach(fun(S) -> get_term_type(S, Vst) end, Ss). + [assert_term(S, Vst) || S <- Ss], + ok. %% get_durable_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be @@ -1865,6 +1919,10 @@ value_to_type(T) when is_tuple(T) -> {tuple, tuple_size(T), Es}; value_to_type(L) -> {literal, L}. +branch_arities(List, Tuple, Vst) -> + Type = get_durable_term_type(Tuple, Vst), + branch_arities(List, Tuple, Type, Vst). + branch_arities([Sz,{f,L}|T], Tuple, {tuple,[_],Es0}=Type0, Vst0) when is_integer(Sz) -> %% Filter out element types that are no longer valid. Es = maps:filter(fun(Index, _Type) -> Index =< Sz end, Es0), @@ -2161,6 +2219,42 @@ propagate_fragility(Type, Ss, Vst) -> false -> Type end. +%% Generic +bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; +bif_arg_types(map_size, [_]) -> [map]; +bif_arg_types(length, [_]) -> [list]; +bif_arg_types(hd, [_]) -> [cons]; +bif_arg_types(tl, [_]) -> [cons]; +%% Boolean +bif_arg_types('not', [_]) -> [bool]; +bif_arg_types('and', [_,_]) -> [bool, bool]; +bif_arg_types('or', [_,_]) -> [bool, bool]; +bif_arg_types('xor', [_,_]) -> [bool, bool]; +%% Binary +bif_arg_types('byte_size', [_]) -> [binary]; +bif_arg_types('bit_size', [_]) -> [binary]; +%% Numerical +bif_arg_types('-', [_]) -> [number]; +bif_arg_types('+', [_]) -> [number]; +bif_arg_types('*', [_,_]) -> [number, number]; +bif_arg_types('/', [_,_]) -> [number, number]; +bif_arg_types(ceil, [_]) -> [number]; +bif_arg_types(floor, [_]) -> [number]; +bif_arg_types(trunc, [_]) -> [number]; +bif_arg_types(round, [_]) -> [number]; +%% Integer-specific +bif_arg_types('div', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('rem', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('band', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bor', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bxor', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bnot', [_]) -> [{integer,[]}]; +bif_arg_types('bsl', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}]; +%% Unsafe type tests that may fail if an argument doesn't have the right type. +bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}]; +bif_arg_types(_, Args) -> [term || _Arg <- Args]. + bif_type('-', Src, Vst) -> arith_type(Src, Vst); bif_type('+', Src, Vst) -> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 53d3cec2d7..11dea9524b 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -814,8 +814,6 @@ kernel_passes() -> %% Optimizations that must be done after all other optimizations. [{pass,sys_core_bsm}, {iff,dcbsm,{listing,"core_bsm"}}, - {pass,sys_core_dsetel}, - {iff,dsetel,{listing,"dsetel"}}, {iff,clint,?pass(core_lint_module)}, {iff,core,?pass(save_core_code)}, @@ -827,20 +825,21 @@ kernel_passes() -> {pass,beam_kernel_to_ssa}, {iff,dssa,{listing,"ssa"}}, {iff,ssalint,{pass,beam_ssa_lint}}, - {unless,no_share_opt,{pass,beam_ssa_share}}, - {iff,dssashare,{listing,"ssashare"}}, - {iff,ssalint,{pass,beam_ssa_lint}}, - {unless,no_bsm_opt,{pass,beam_ssa_bsm}}, - {iff,dssabsm,{listing,"ssabsm"}}, - {iff,ssalint,{pass,beam_ssa_lint}}, - {unless,no_fun_opt,{pass,beam_ssa_funs}}, - {iff,dssafuns,{listing,"ssafuns"}}, - {iff,ssalint,{pass,beam_ssa_lint}}, - {unless,no_ssa_opt,{pass,beam_ssa_opt}}, - {iff,dssaopt,{listing,"ssaopt"}}, - {iff,ssalint,{pass,beam_ssa_lint}}, - {unless,no_recv_opt,{pass,beam_ssa_recv}}, - {iff,drecv,{listing,"recv"}}, + {delay, + [{unless,no_share_opt,{pass,beam_ssa_share}}, + {iff,dssashare,{listing,"ssashare"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_bsm_opt,{pass,beam_ssa_bsm}}, + {iff,dssabsm,{listing,"ssabsm"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_fun_opt,{pass,beam_ssa_funs}}, + {iff,dssafuns,{listing,"ssafuns"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_ssa_opt,{pass,beam_ssa_opt}}, + {iff,dssaopt,{listing,"ssaopt"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_recv_opt,{pass,beam_ssa_recv}}, + {iff,drecv,{listing,"recv"}}]}, {pass,beam_ssa_pre_codegen}, {iff,dprecg,{listing,"precodegen"}}, {iff,ssalint,{pass,beam_ssa_lint}}, @@ -2121,7 +2120,6 @@ pre_load() -> erl_scan, sys_core_alias, sys_core_bsm, - sys_core_dsetel, sys_core_fold, v3_core, v3_kernel], diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 108a0ca100..a086a3a8d3 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -65,7 +65,6 @@ rec_env, sys_core_alias, sys_core_bsm, - sys_core_dsetel, sys_core_fold, sys_core_fold_lists, sys_core_inline, diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index d925decce6..94a5dfe012 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -32,6 +32,22 @@ %% Returns `true' if the function `Module:Name/Arity' does not %% affect the state, nor depend on the state, although its %% evaluation is not guaranteed to complete normally for all input. +%% +%% NOTE: There is no need to include every new pure BIF +%% here. Including it here means that the value of the function +%% will be evaluated at compile-time if the arguments are +%% constant. If that optimization is not useful/desired, there is +%% no need to include the new BIF here. +%% +%% Functions whose return value could conceivably change in a +%% future version of the runtime system must NOT be included here. +%% +%% Here are some example of functions that should not be +%% included: `term_to_binary/1', hashing functions, non-trivial +%% encode/decode functions. +%% +%% When unsure whether a new BIF should be included here, the +%% conservative safe choice is NOT to include it. -spec is_pure(atom(), atom(), arity()) -> boolean(). diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl deleted file mode 100644 index 9ab83c210f..0000000000 --- a/lib/compiler/src/sys_core_dsetel.erl +++ /dev/null @@ -1,360 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% -%% Purpose : Using dsetelement to make multiple-field record updates -%% faster. - -%% The expansion of record field updates, when more than one field is -%% updated, but not a majority of the fields, will create a sequence of -%% calls to 'erlang:setelement(Index, Value, Tuple)' where Tuple in the -%% first call is the original record tuple, and in the subsequent calls -%% Tuple is the result of the previous call. Furthermore, all Index -%% values are constant positive integers, and the first call to -%% 'setelement' will have the greatest index. Thus all the following -%% calls do not actually need to test at run-time whether Tuple has type -%% tuple, nor that the index is within the tuple bounds. -%% -%% Since this introduces destructive updates in the Core Erlang code, it -%% must be done as a last stage before going to lower-level code. -%% -%% NOTE: Because there are currently no write barriers in the system, -%% this kind of optimization can only be done when we are sure that -%% garbage collection will not be triggered between the creation of the -%% tuple and the destructive updates - otherwise we might insert -%% pointers from an older generation to a newer. -%% -%% The rewriting is done as follows: -%% -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in call 'erlang':'setelement(3, X1, Value2) -%% => -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X1, Value2) -%% X1 -%% and -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in let X2 = call 'erlang':'setelement(3, X1, Value2) -%% in ... -%% => -%% let X2 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop 'dsetelement(3, X2, Value2) -%% ... -%% if X1 is used exactly once. -%% Thus, we need to track variable usage. -%% - --module(sys_core_dsetel). - --export([module/2]). - --include("core_parse.hrl"). - --spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}. - -module(M0, _Options) -> - M = visit_module(M0), - {ok,M}. - -visit_module(#c_module{defs=Ds0}=R) -> - Env = #{}, - Ds = visit_module_1(Ds0, Env, []), - R#c_module{defs=Ds}. - -visit_module_1([{Name,F0}|Fs], Env, Acc) -> - try visit(Env, F0) of - {F,_} -> - visit_module_1(Fs, Env, [{Name,F}|Acc]) - catch - Class:Error:Stack -> - #c_var{name={Func,Arity}} = Name, - io:fwrite("Function: ~w/~w\n", [Func,Arity]), - erlang:raise(Class, Error, Stack) - end; -visit_module_1([], _, Acc) -> - lists:reverse(Acc). - -visit(Env, #c_var{name={_,_}}=R) -> - %% Ignore local function name. - {R, Env}; -visit(Env0, #c_var{name=X}=R) -> - %% There should not be any free variables. If there are, - %% the case will fail with an exception. - case Env0 of - #{X:=N} -> - {R, Env0#{X:=N+1}} - end; -visit(Env, #c_literal{}=R) -> - {R, Env}; -visit(Env0, #c_tuple{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_tuple{es=Es1}, Env1}; -visit(Env0, #c_map{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_map{es=Es1}, Env1}; -visit(Env0, #c_map_pair{key=K0,val=V0}=R) -> - {K,Env1} = visit(Env0, K0), - {V,Env2} = visit(Env1, V0), - {R#c_map_pair{key=K,val=V}, Env2}; -visit(Env0, #c_cons{hd=H0,tl=T0}=R) -> - {H1,Env1} = visit(Env0, H0), - {T1,Env2} = visit(Env1, T0), - {R#c_cons{hd=H1,tl=T1}, Env2}; -visit(Env0, #c_binary{segments=Segs}=R) -> - Env = visit_bin_segs(Env0, Segs), - {R, Env}; -visit(Env0, #c_values{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_values{es=Es1}, Env1}; -visit(Env0, #c_fun{vars=Vs, body=B0}=R) -> - {Xs, Env1} = bind_vars(Vs, Env0), - {B1,Env2} = visit(Env1, B0), - {R#c_fun{body=B1}, restore_vars(Xs, Env0, Env2)}; -visit(Env0, #c_let{vars=Vs, arg=A0, body=B0}=R) -> - {A1,Env1} = visit(Env0, A0), - {Xs,Env2} = bind_vars(Vs, Env1), - {B1,Env3} = visit(Env2, B0), - rewrite(R#c_let{arg=A1,body=B1}, Env3, restore_vars(Xs, Env1, Env3)); -visit(Env0, #c_seq{arg=A0, body=B0}=R) -> - {A1,Env1} = visit(Env0, A0), - {B1,Env2} = visit(Env1, B0), - {R#c_seq{arg=A1,body=B1}, Env2}; -visit(Env0, #c_case{arg=A0,clauses=Cs0}=R) -> - {A1,Env1} = visit(Env0, A0), - {Cs1,Env2} = visit_list(Env1, Cs0), - {R#c_case{arg=A1,clauses=Cs1}, Env2}; -visit(Env0, #c_clause{pats=Ps,guard=G0,body=B0}=R) -> - {Vs, Env1} = visit_pats(Ps, Env0), - {G1,Env2} = visit(Env1, G0), - {B1,Env3} = visit(Env2, B0), - {R#c_clause{guard=G1,body=B1}, restore_vars(Vs, Env0, Env3)}; -visit(Env0, #c_receive{clauses=Cs0,timeout=T0,action=A0}=R) -> - {T1,Env1} = visit(Env0, T0), - {Cs1,Env2} = visit_list(Env1, Cs0), - {A1,Env3} = visit(Env2, A0), - {R#c_receive{clauses=Cs1,timeout=T1,action=A1}, Env3}; -visit(Env0, #c_apply{op=Op0, args=As0}=R) -> - {Op1,Env1} = visit(Env0, Op0), - {As1,Env2} = visit_list(Env1, As0), - {R#c_apply{op=Op1,args=As1}, Env2}; -visit(Env0, #c_call{module=M0,name=N0,args=As0}=R) -> - {M1,Env1} = visit(Env0, M0), - {N1,Env2} = visit(Env1, N0), - {As1,Env3} = visit_list(Env2, As0), - {R#c_call{module=M1,name=N1,args=As1}, Env3}; -visit(Env0, #c_primop{name=N0, args=As0}=R) -> - {N1,Env1} = visit(Env0, N0), - {As1,Env2} = visit_list(Env1, As0), - {R#c_primop{name=N1,args=As1}, Env2}; -visit(Env0, #c_try{arg=E0, vars=Vs, body=B0, evars=Evs, handler=H0}=R) -> - {E1,Env1} = visit(Env0, E0), - {Xs, Env2} = bind_vars(Vs, Env1), - {B1,Env3} = visit(Env2, B0), - Env4 = restore_vars(Xs, Env1, Env3), - {Ys, Env5} = bind_vars(Evs, Env4), - {H1,Env6} = visit(Env5, H0), - {R#c_try{arg=E1,body=B1,handler=H1}, restore_vars(Ys, Env4, Env6)}; -visit(Env0, #c_catch{body=B0}=R) -> - {B1,Env1} = visit(Env0, B0), - {R#c_catch{body=B1}, Env1}; -visit(Env0, #c_letrec{defs=Ds0,body=B0}=R) -> - {Xs, Env1} = bind_vars([V || {V,_} <- Ds0], Env0), - {Ds1,Env2} = visit_def_list(Env1, Ds0), - {B1,Env3} = visit(Env2, B0), - {R#c_letrec{defs=Ds1,body=B1}, restore_vars(Xs, Env0, Env3)}. -%% The following general code for handling modules is slow if a module -%% contains very many functions. There is special code in visit_module/1 -%% which is much faster. -%% visit(Env0, #c_module{defs=D0}=R) -> -%% {R1,Env1} = visit(Env0, #c_letrec{defs=D0,body=#c_nil{}}), -%% {R#c_module{defs=R1#c_letrec.defs}, Env1}; - -visit_list(Env, L) -> - lists:mapfoldl(fun (E, A) -> visit(A, E) end, Env, L). - -visit_def_list(Env, L) -> - lists:mapfoldl(fun ({Name,V0}, E0) -> - {V1,E1} = visit(E0, V0), - {{Name,V1}, E1} - end, Env, L). - -visit_bin_segs(Env, Segs) -> - lists:foldl(fun (#c_bitstr{val=Val,size=Sz}, E0) -> - {_, E1} = visit(E0, Val), - {_, E2} = visit(E1, Sz), - E2 - end, Env, Segs). - -bind_vars(Vs, Env) -> - bind_vars(Vs, Env, []). - -bind_vars([#c_var{name=X}|Vs], Env0, Xs)-> - bind_vars(Vs, Env0#{X=>0}, [X|Xs]); -bind_vars([], Env,Xs) -> - {Xs, Env}. - -visit_pats(Ps, Env) -> - visit_pats(Ps, Env, []). - -visit_pats([P|Ps], Env0, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, P, Vs0), - visit_pats(Ps, Env1, Vs1); -visit_pats([], Env, Vs) -> - {Vs, Env}. - -visit_pat(Env0, #c_var{name=V}, Vs) -> - {[V|Vs], Env0#{V=>0}}; -visit_pat(Env0, #c_tuple{es=Es}, Vs) -> - visit_pats(Es, Env0, Vs); -visit_pat(Env0, #c_map{es=Es}, Vs) -> - visit_pats(Es, Env0, Vs); -visit_pat(Env0, #c_map_pair{op=#c_literal{val=exact},key=V,val=K}, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, V, Vs0), - visit_pat(Env1, K, Vs1); -visit_pat(Env0, #c_cons{hd=H,tl=T}, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, H, Vs0), - visit_pat(Env1, T, Vs1); -visit_pat(Env0, #c_binary{segments=Segs}, Vs) -> - visit_pats(Segs, Env0, Vs); -visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) -> - {Vs1, Env1} = - case Sz of - #c_var{name=V} -> - %% We don't tolerate free variables. - case Env0 of - #{V:=N} -> - {Vs0, Env0#{V:=N+1}} - end; - _ -> - visit_pat(Env0, Sz, Vs0) - end, - visit_pat(Env1, Val, Vs1); -visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) -> - visit_pat(Env0#{V=>0}, P, [V|Vs]); -visit_pat(Env, #c_literal{}, Vs) -> - {Vs, Env}. - -restore_vars([V|Vs], Env0, Env1) -> - case Env0 of - #{V:=N} -> - restore_vars(Vs, Env0, Env1#{V=>N}); - _ -> - restore_vars(Vs, Env0, maps:remove(V, Env1)) - end; -restore_vars([], _, Env1) -> - Env1. - - -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in call 'erlang':'setelement(3, X1, Value2) -%% => -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X1, Value2) -%% X1 - -rewrite(#c_let{vars=[#c_var{name=X}=V]=Vs, - arg=#c_call{module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index1}, _Tuple, _Val1] - }=A, - body=#c_call{anno=Banno,module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index2}, - #c_var{name=X}, - Val2] - } - }=R, - _BodyEnv, FinalEnv) - when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 -> - case is_safe(Val2) of - true -> - {R#c_let{vars=Vs, - arg=A, - body=#c_seq{arg=#c_primop{ - anno=Banno, - name=#c_literal{val='dsetelement'}, - args=[#c_literal{val=Index2}, - V, - Val2]}, - body=V} - }, - FinalEnv}; - false -> - {R, FinalEnv} - end; - -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in let X2 = 'erlang':'setelement(3, X1, Value2) -%% in ... -%% => -%% let X2 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X2, Value2) -%% ... -%% if X1 is used exactly once. - -rewrite(#c_let{vars=[#c_var{name=X1}], - arg=#c_call{module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index1}, _Tuple, _Val1] - }=A, - body=#c_let{vars=[#c_var{}=V]=Vs, - arg=#c_call{anno=Banno, - module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index2}, - #c_var{name=X1}, - Val2]}, - body=B} - }=R, - BodyEnv, FinalEnv) - when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 -> - case is_single_use(X1, BodyEnv) andalso is_safe(Val2) of - true -> - {R#c_let{vars=Vs, - arg=A, - body=#c_seq{arg=#c_primop{ - anno=Banno, - name=#c_literal{val='dsetelement'}, - args=[#c_literal{val=Index2}, - V, - Val2]}, - body=B} - }, - FinalEnv}; - false -> - {R, FinalEnv} - end; - -rewrite(R, _, FinalEnv) -> - {R, FinalEnv}. - -%% is_safe(CoreExpr) -> true|false -%% Determines whether the Core expression can cause a GC collection at run-time. -%% Note: Assumes that the constant pool is turned on. - -is_safe(#c_var{}) -> true; -is_safe(#c_literal{}) -> true; -is_safe(_) -> false. - -is_single_use(V, Env) -> - case Env of - #{V:=1} -> - true; - _ -> - false - end. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 34930c3afe..3699c9d22e 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -330,7 +330,7 @@ gexpr({protect,Line,Arg}, Bools0, St0) -> {#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St} end; gexpr({op,_,'andalso',_,_}=E0, Bools, St0) -> - {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0), + {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -338,7 +338,7 @@ gexpr({op,_,'andalso',_,_}=E0, Bools, St0) -> E = make_bool_switch_guard(L, E1, V, E2, False), gexpr(E, Bools, St); gexpr({op,_,'orelse',_,_}=E0, Bools, St0) -> - {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0), + {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -767,14 +767,16 @@ expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> {Qs,St2} = preprocess_quals(Llc, Qs0, St1), {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; -expr({op,L,'andalso',E1,E2}, St0) -> +expr({op,_,'andalso',_,_}=E0, St0) -> + {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, False = {atom,L,false}, E = make_bool_switch(L, E1, V, E2, False, St0), expr(E, St); -expr({op,L,'orelse',E1,E2}, St0) -> +expr({op,_,'orelse',_,_}=E0, St0) -> + {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -2058,17 +2060,9 @@ fail_clause(Pats, Anno, Arg) -> args=[Arg]}]}. %% Optimization for Dialyzer. -right_assoc(E, Op, St) -> - case member(dialyzer, St#core.opts) of - true -> - right_assoc2(E, Op); - false -> - E - end. - -right_assoc2({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> - right_assoc2({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); -right_assoc2(E, _Op) -> E. +right_assoc({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> + right_assoc({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); +right_assoc(E, _Op) -> E. annotate_tuple(A, Es, St) -> case member(dialyzer, St#core.opts) of diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index f7ca66b1da..86351bc0c5 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1414,7 +1414,6 @@ is_remote_bif(_, _, _) -> false. %% return multiple values. Only used in bodies where a BIF may be %% called for effect only. -bif_vals(dsetelement, 3) -> 0; bif_vals(_, _) -> 1. bif_vals(_, _, _) -> 1. |