diff options
Diffstat (limited to 'lib/compiler')
28 files changed, 2008 insertions, 1686 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_except.erl b/lib/compiler/src/beam_except.erl index 09925b2872..28c89782c9 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -225,7 +225,11 @@ moves_from_stack(nil, I, Acc) -> {reverse(Acc),I}; moves_from_stack({literal,[H|T]}, I, Acc) -> Cons = {cons,tag_literal(H),tag_literal(T)}, - moves_from_stack(Cons, I, Acc). + moves_from_stack(Cons, I, Acc); +moves_from_stack(_, _, _) -> + %% Not understood. Give up. + {[],-1}. + get_reg(R, Regs) -> case Regs of 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 9c29c98064..a9977b0b1d 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -23,7 +23,7 @@ -export([add_anno/3,get_anno/2,get_anno/3, clobbers_xregs/1,def/2,def_used/2, definitions/1, - dominators/1, + dominators/1,common_dominators/3, flatmapfold_instrs_rpo/4, fold_po/3,fold_po/4,fold_rpo/3,fold_rpo/4, fold_instrs_rpo/4, @@ -85,7 +85,8 @@ -type anno() :: #{atom() := any()}. -type block_map() :: #{label():=b_blk()}. --type dominator_map() :: #{label():=ordsets:ordset(label())}. +-type dominator_map() :: #{label():=[label()]}. +-type numbering_map() :: #{label():=non_neg_integer()}. -type usage_map() :: #{b_var():=[{label(),b_set() | terminator()}]}. -type definition_map() :: #{b_var():=b_set()}. -type rename_map() :: #{b_var():=value()}. @@ -108,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'. @@ -117,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]). @@ -327,18 +329,41 @@ def_used(Ls, Blocks) -> Preds = cerl_sets:from_list(Top), def_used_1(Blks, Preds, [], []). +%% dominators(BlockMap) -> {Dominators,Numbering}. +%% Calculate the dominator tree, returning a map where each entry +%% in the map is a list that gives the path from that block to +%% the top of the dominator tree. (Note that the suffixes of the +%% paths are shared with each other, which make the representation +%% of the dominator tree highly memory-efficient.) +%% +%% The implementation is based on: +%% +%% http://www.hipersoft.rice.edu/grads/publications/dom14.pdf +%% Cooper, Keith D.; Harvey, Timothy J; Kennedy, Ken (2001). +%% A Simple, Fast Dominance Algorithm. + -spec dominators(Blocks) -> Result when Blocks :: block_map(), - Result :: dominator_map(). - + Result :: {dominator_map(), numbering_map()}. dominators(Blocks) -> Preds = predecessors(Blocks), Top0 = rpo(Blocks), - Top = [{L,map_get(L, Preds)} || L <- Top0], + Df = maps:from_list(number(Top0, 0)), + [{0,[]}|Top] = [{L,map_get(L, Preds)} || L <- Top0], %% The flow graph for an Erlang function is reducible, and %% therefore one traversal in reverse postorder is sufficient. - iter_dominators(Top, #{}). + Acc = #{0=>[0]}, + {dominators_1(Top, Df, Acc),Df}. + +%% common_dominators([Label], Dominators, Numbering) -> [Label]. +%% Calculate the common dominators for the given list of blocks +%% and Dominators and Numbering as returned from dominators/1. + +-spec common_dominators([label()], dominator_map(), numbering_map()) -> [label()]. +common_dominators(Ls, Dom, Numbering) -> + Doms = [map_get(L, Dom) || L <- Ls], + dom_intersection(Doms, Numbering). -spec fold_instrs_rpo(Fun, From, Acc0, Blocks) -> any() when Fun :: fun((b_blk()|terminator(), any()) -> any()), @@ -657,14 +682,37 @@ def_is([#b_set{dst=Dst}|Is], Def) -> def_is(Is, [Dst|Def]); def_is([], Def) -> Def. -iter_dominators([{0,[]}|Ls], _Doms) -> - Dom = [0], - iter_dominators(Ls, #{0=>Dom}); -iter_dominators([{L,Preds}|Ls], Doms) -> +dominators_1([{L,Preds}|Ls], Df, Doms) -> DomPreds = [map_get(P, Doms) || P <- Preds, is_map_key(P, Doms)], - Dom = ordsets:add_element(L, ordsets:intersection(DomPreds)), - iter_dominators(Ls, Doms#{L=>Dom}); -iter_dominators([], Doms) -> Doms. + Dom = [L|dom_intersection(DomPreds, Df)], + dominators_1(Ls, Df, Doms#{L=>Dom}); +dominators_1([], _Df, Doms) -> Doms. + +dom_intersection([S], _Df) -> + S; +dom_intersection([S|Ss], Df) -> + dom_intersection(S, Ss, Df). + +dom_intersection(S1, [S2|Ss], Df) -> + dom_intersection(dom_intersection_1(S1, S2, Df), Ss, Df); +dom_intersection(S, [], _Df) -> S. + +dom_intersection_1([E1|Es1]=Set1, [E2|Es2]=Set2, Df) -> + %% Blocks are numbered in the order they are found in + %% reverse postorder. + #{E1:=Df1,E2:=Df2} = Df, + if Df1 > Df2 -> + dom_intersection_1(Es1, Set2, Df); + Df2 > Df1 -> + dom_intersection_1(Es2, Set1, Df); %switch arguments! + true -> %Set1 == Set2 + %% The common suffix of the sets is the intersection. + Set1 + end. + +number([L|Ls], N) -> + [{L,N}|number(Ls, N+1)]; +number([], _) -> []. fold_rpo_1([L|Ls], Fun, Blocks, Acc0) -> Block = map_get(L, Blocks), diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl index 466337db0e..382e6f635e 100644 --- a/lib/compiler/src/beam_ssa_bsm.erl +++ b/lib/compiler/src/beam_ssa_bsm.erl @@ -300,7 +300,8 @@ get_fa(#b_function{ anno = Anno }) -> promotions = #{} :: promotion_map() }). alias_matched_binaries(Blocks0, Counter, AliasMap) when AliasMap =/= #{} -> - State0 = #amb{ dominators = beam_ssa:dominators(Blocks0), + {Dominators, _} = beam_ssa:dominators(Blocks0), + State0 = #amb{ dominators = Dominators, match_aliases = AliasMap, cnt = Counter }, {Blocks, State} = beam_ssa:mapfold_blocks_rpo(fun amb_1/3, [0], State0, @@ -347,7 +348,7 @@ amb_get_alias(#b_var{}=Arg, Lbl, State) -> %% Our context may not have been created yet, so we skip assigning %% an alias unless the given block is among our dominators. Dominators = maps:get(Lbl, State#amb.dominators), - case ordsets:is_element(AliasAfter, Dominators) of + case member(AliasAfter, Dominators) of true -> amb_create_alias(Arg, Context, Lbl, State); false -> {Arg, State} end; @@ -444,6 +445,7 @@ combine_matches({Fs0, ModInfo}) -> combine_matches(#b_function{bs=Blocks0,cnt=Counter0}=F, ModInfo) -> case funcinfo_get(F, has_bsm_ops, ModInfo) of true -> + {Dominators, _} = beam_ssa:dominators(Blocks0), {Blocks1, State} = beam_ssa:mapfold_blocks_rpo( fun(Lbl, #b_blk{is=Is0}=Block0, State0) -> @@ -451,7 +453,7 @@ combine_matches(#b_function{bs=Blocks0,cnt=Counter0}=F, ModInfo) -> {Block0#b_blk{is=Is}, State} end, [0], #cm{ definitions = beam_ssa:definitions(Blocks0), - dominators = beam_ssa:dominators(Blocks0), + dominators = Dominators, blocks = Blocks0 }, Blocks0), @@ -491,7 +493,7 @@ cm_handle_priors(Src, DstCtx, Bool, Acc, MatchSeq, Lbl, State0) -> %% dominate us. Dominators = maps:get(Lbl, State0#cm.dominators, []), [Ctx || {ValidAfter, Ctx} <- Priors, - ordsets:is_element(ValidAfter, Dominators)]; + member(ValidAfter, Dominators)]; error -> [] end, diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index ca5eefe4fc..6e548dd529 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -84,7 +84,7 @@ phase([FuncId | Ids], Ps, StMap, FuncDb0) -> phase(Ids, Ps, StMap#{ FuncId => St }, FuncDb) catch Class:Error:Stack -> - #b_local{name=Name,arity=Arity} = FuncId, + #b_local{name=#b_literal{val=Name},arity=Arity} = FuncId, io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end; @@ -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. @@ -852,6 +849,7 @@ cse_expr(#b_set{op=Op,args=Args}=I) -> cse_suitable(#b_set{op=get_hd}) -> true; cse_suitable(#b_set{op=get_tl}) -> true; cse_suitable(#b_set{op=put_list}) -> true; +cse_suitable(#b_set{op=get_tuple_element}) -> true; cse_suitable(#b_set{op=put_tuple}) -> true; cse_suitable(#b_set{op={bif,tuple_size}}) -> %% Doing CSE for tuple_size/1 can prevent the @@ -1835,12 +1833,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 +1850,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 +1860,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. %%% @@ -2021,7 +1970,7 @@ do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> Used = used_blocks(Linear, Defs, []), %% Calculate dominators. - Dom0 = beam_ssa:dominators(Blocks0), + {Dom,Numbering} = beam_ssa:dominators(Blocks0), %% It is not safe to move get_tuple_element instructions to blocks %% that begin with certain instructions. It is also unsafe to move @@ -2029,20 +1978,10 @@ do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> %% unsafe moves, pretend that the unsuitable blocks are not %% dominators. Unsuitable = unsuitable(Linear, Blocks0), - Dom = case gb_sets:is_empty(Unsuitable) of - true -> - Dom0; - false -> - F = fun(_, DomBy) -> - [L || L <- DomBy, - not gb_sets:is_element(L, Unsuitable)] - end, - maps:map(F, Dom0) - end, %% Calculate new positions for get_tuple_element instructions. The new %% position is a block that dominates all uses of the variable. - DefLoc = new_def_locations(Used, Defs, Dom), + DefLoc = new_def_locations(Used, Defs, Dom, Numbering, Unsuitable), %% Now move all suitable get_tuple_element instructions to their %% new blocks. @@ -2136,50 +2075,42 @@ unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> end; unsuitable_loop_1([], _, _, Acc) -> Acc. -%% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs, Dominators) -> -%% [{Variable,NewDefinitionBlock}] -%% Calculate new locations for get_tuple_element instructions. For each -%% variable, the new location is a block that dominates all uses of -%% variable and as near to the uses of as possible. If no such block -%% distinct from the block where the instruction currently is, the -%% variable will not be included in the result list. +%% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs, +%% Dominators, Numbering, Unsuitable) -> +%% [{Variable,NewDefinitionBlock}] +%% +%% Calculate new locations for get_tuple_element instructions. For +%% each variable, the new location is a block that dominates all uses +%% of the variable and as near to the uses of as possible. -new_def_locations([{V,UsedIn}|Vs], Defs, Dom) -> +new_def_locations([{V,UsedIn}|Vs], Defs, Dom, Numbering, Unsuitable) -> DefIn = map_get(V, Defs), - case common_dom(UsedIn, DefIn, Dom) of - [] -> - new_def_locations(Vs, Defs, Dom); - [_|_]=BetterDef -> - L = most_dominated(BetterDef, Dom), - [{V,L}|new_def_locations(Vs, Defs, Dom)] - end; -new_def_locations([], _, _) -> []. - -common_dom([L|Ls], DefIn, Dom) -> - DomBy0 = map_get(L, Dom), - DomBy = ordsets:subtract(DomBy0, map_get(DefIn, Dom)), - common_dom_1(Ls, Dom, DomBy). - -common_dom_1(_, _, []) -> - []; -common_dom_1([L|Ls], Dom, [_|_]=DomBy0) -> - DomBy1 = map_get(L, Dom), - DomBy = ordsets:intersection(DomBy0, DomBy1), - common_dom_1(Ls, Dom, DomBy); -common_dom_1([], _, DomBy) -> DomBy. - -most_dominated([L|Ls], Dom) -> - most_dominated(Ls, L, map_get(L, Dom), Dom). - -most_dominated([L|Ls], L0, DomBy, Dom) -> - case member(L, DomBy) of + Common = common_dominator(UsedIn, Dom, Numbering, Unsuitable), + case member(Common, map_get(DefIn, Dom)) of true -> - most_dominated(Ls, L0, DomBy, Dom); + %% The common dominator is either DefIn or an + %% ancestor of DefIn. + new_def_locations(Vs, Defs, Dom, Numbering, Unsuitable); false -> - most_dominated(Ls, L, map_get(L, Dom), Dom) + %% We have found a suitable descendant of DefIn, + %% to which the get_tuple_element instruction can + %% be sunk. + [{V,Common}|new_def_locations(Vs, Defs, Dom, Numbering, Unsuitable)] end; -most_dominated([], L, _, _) -> L. +new_def_locations([], _, _, _, _) -> []. +common_dominator(Ls0, Dom, Numbering, Unsuitable) -> + [Common|_] = beam_ssa:common_dominators(Ls0, Dom, Numbering), + case gb_sets:is_member(Common, Unsuitable) of + true -> + %% It is not allowed to place the instruction here. Try + %% to find another suitable dominating block by going up + %% one step in the dominator tree. + [Common,OneUp|_] = map_get(Common, Dom), + common_dominator([OneUp], Dom, Numbering, Unsuitable); + false -> + Common + end. %% Move get_tuple_element instructions to their new locations. @@ -2219,7 +2150,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 274f78052d..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. %%% @@ -874,7 +1071,7 @@ fix_tuples(#st{ssa=Blocks0,cnt=Count0}=St) -> %% a stack frame or set up a stack frame with a different size. place_frames(#st{ssa=Blocks}=St) -> - Doms = beam_ssa:dominators(Blocks), + {Doms,_} = beam_ssa:dominators(Blocks), Ls = beam_ssa:rpo(Blocks), Tried = gb_sets:empty(), Frames0 = [], @@ -1001,7 +1198,7 @@ phi_predecessors(L, Blocks) -> is_dominated_by(L, DomBy, Doms) -> DominatedBy = map_get(L, Doms), - ordsets:is_element(DomBy, DominatedBy). + member(DomBy, DominatedBy). %% need_frame(#b_blk{}) -> true|false. %% Test whether any of the instructions in the block requires a stack frame. @@ -1993,11 +2190,12 @@ reserve_zregs(Blocks, Intervals, Res) -> end, beam_ssa:fold_rpo(F, [0], Res, Blocks). -reserve_zreg([#b_set{op=call,dst=Dst}], - #b_br{bool=Dst}, _ShortLived, A) -> - %% If type optimization has determined that the result of a call can be - %% used directly in a branch, we must avoid reserving a z register or code - %% generation will fail. +reserve_zreg([#b_set{op=Op,dst=Dst}], + #b_br{bool=Dst}, _ShortLived, A) when Op =:= call; + Op =:= get_tuple_element -> + %% If type optimization has determined that the result of these + %% instructions can be used directly in a branch, we must avoid reserving a + %% z register or code generation will fail. A; reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, #b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) -> diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 32583f5abf..aa4720d222 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,sort/1]). + keyfind/3,partition/2,reverse/1,reverse/2, + seq/2,sort/1,split/2]). -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). @@ -44,12 +45,13 @@ -record(t_bs_match, {type :: type()}). -record(t_tuple, {size=0 :: integer(), exact=false :: boolean(), - elements=[] :: [any()] - }). + %% Known element types (1-based index), unknown elements are + %% are assumed to be 'any'. + elements=#{} :: #{ non_neg_integer() => type() }}). -type type() :: 'any' | 'none' | #t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} | - {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' |'number'. + {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'. -type type_db() :: #{beam_ssa:var_name():=type()}. -spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when @@ -123,7 +125,7 @@ opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) -> ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, once=UsedOnce }, - {Linear, FuncDb, NewRet} = opt_1(Linear0, D, []), + {Linear, FuncDb, NewRet} = opt(Linear0, D, []), case FuncDb of #{ Id := Entry0 } -> @@ -166,8 +168,11 @@ opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) -> opt_finish_1([], [], ParamInfo) -> ParamInfo. -validator_anno(#t_tuple{size=Size,exact=Exact}) -> - beam_validator:type_anno(tuple, Size, Exact); +validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) -> + Elements = maps:fold(fun(Index, Type, Acc) -> + Acc#{ Index => validator_anno(Type) } + end, #{}, Elements0), + beam_validator:type_anno(tuple, Size, Exact, Elements); validator_anno(#t_integer{elements={Same,Same}}) -> beam_validator:type_anno(integer, Same); validator_anno(#t_integer{}) -> @@ -188,57 +193,42 @@ get_func_id(Anno) -> #{func_info:={_Mod, Name, Arity}} = Anno, #b_local{name=#b_literal{val=Name}, arity=Arity}. -opt_1([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) -> +opt([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) -> case Ls of #{L:=Ts} -> - opt_2(L, Blk, Bs, Ts, D, Acc); + opt_1(L, Blk, Bs, Ts, D, Acc); #{} -> %% This block is never reached. Discard it. - opt_1(Bs, D, Acc) + opt(Bs, D, Acc) end; -opt_1([], D, Acc) -> +opt([], D, Acc) -> #d{func_db=FuncDb,ret_type=NewRet} = D, {reverse(Acc), FuncDb, NewRet}. -opt_2(L, #b_blk{is=Is0}=Blk0, Bs, Ts, #d{sub=Sub}=D0, Acc) -> - case Is0 of - [#b_set{op=call,dst=Dst, - args=[#b_remote{mod=#b_literal{val=Mod}, - name=#b_literal{val=Name}}=Rem|Args0]}=I0] -> - case erl_bifs:is_exit_bif(Mod, Name, length(Args0)) of - true -> - %% This call will never reach the successor block. - %% Rewrite the terminator to a 'ret', and remove - %% all type information for this label. That will - %% simplify the phi node in the former successor. - Args = simplify_args(Args0, Sub, Ts), - I = I0#b_set{args=[Rem|Args]}, - Ret = #b_ret{arg=Dst}, - Blk = Blk0#b_blk{is=[I],last=Ret}, - Ls = maps:remove(L, D0#d.ls), - - %% We potentially lack a return value. - RetType = join([none | D0#d.ret_type]), - - D = D0#d{ls=Ls,ret_type=[RetType]}, - opt_1(Bs, D, [{L,Blk} | Acc]); - false -> - opt_3(L, Blk0, Bs, Ts, D0, Acc) - end; - _ -> - opt_3(L, Blk0, Bs, Ts, D0, Acc) +opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, + #d{ds=Ds0,sub=Sub0,func_db=Fdb0}=D0, Acc) -> + case opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []) of + {Is,Ts,Ds,Fdb,Sub} -> + D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, + Last1 = simplify_terminator(Last0, Sub, Ts, Ds), + Last = opt_terminator(Last1, Ts, Ds), + D = update_successors(Last, Ts, D1), + Blk = Blk0#b_blk{is=Is,last=Last}, + opt(Bs, D, [{L,Blk}|Acc]); + {no_return,Ret,Is,Ds,Fdb,Sub} -> + %% This call will never reach the successor block. + %% Rewrite the terminator to a 'ret', and remove + %% all type information for this label. That can + %% potentially narrow the type of the phi node + %% in the former successor. + Ls = maps:remove(L, D0#d.ls), + RetType = join([none|D0#d.ret_type]), + D = D0#d{ds=Ds,ls=Ls,sub=Sub, + func_db=Fdb,ret_type=[RetType]}, + Blk = Blk0#b_blk{is=Is,last=Ret}, + opt(Bs, D, [{L,Blk}|Acc]) end. -opt_3(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, - #d{ds=Ds0,ls=Ls0,sub=Sub0,func_db=Fdb0}=D0, Acc) -> - {Is,Ts,Ds,Fdb,Sub} = opt_is(Is0, Ts0, Ds0, Fdb0, Ls0, D0, Sub0, []), - D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, - Last1 = simplify_terminator(Last0, Sub, Ts, Ds), - Last = opt_terminator(Last1, Ts, Ds), - D = update_successors(Last, Ts, D1), - Blk = Blk0#b_blk{is=Is,last=Last}, - opt_1(Bs, D, [{L,Blk} | Acc]). - simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) -> Br#b_br{bool=simplify_arg(Bool, Sub, Ts)}; simplify_terminator(#b_switch{arg=Arg}=Sw, Sub, Ts, _Ds) -> @@ -252,7 +242,7 @@ simplify_terminator(#b_ret{arg=Arg}=Ret, Sub, Ts, Ds) -> end. opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], - Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) -> + Ts0, Ds0, Fdb, #d{ls=Ls}=D, Sub0, Acc) -> %% Simplify the phi node by removing all predecessor blocks that no %% longer exists or no longer branches to this block. Args = [{simplify_arg(Arg, Sub0, Ts0),From} || @@ -263,37 +253,44 @@ opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], %% value or if the values are identical. [{Val,_}|_] = Args, Sub = Sub0#{Dst=>Val}, - opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc); + opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); false -> I = I0#b_set{args=Args}, Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]) + 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, Ls, D, Sub, Acc) -> - Args = simplify_args(Args0, Sub, Ts0), +opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], + Ts0, Ds0, Fdb0, D, Sub0, Acc) -> + Args = simplify_args(Args0, Sub0, Ts0), I1 = beam_ssa:normalize(I0#b_set{args=Args}), - - %% This is a bit of a kludge; we know that any instruction whose return - %% type is 'none' will fail at runtime, but we don't yet have a way to cut - %% a block short so we move on like nothing nothing happened. - %% - %% This complicates argument type optimization as unreachable calls can - %% add types that will never occur, so we skip optimizing this call if - %% the type of any of its arguments is 'none'. - [_Callee | Rest] = Args, - case all(fun(Arg) -> get_type(Arg, Ts0) =/= none end, Rest) of - true -> - {Ts, Ds, Fdb, I} = opt_call(I1, D, Ts0, Ds0, Fdb0), - opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub, [I|Acc]); - false -> - Ts = Ts0#{ Dst => any }, - Ds = Ds0#{ Dst => I1 }, - opt_is(Is, Ts, Ds, Fdb0, Ls, D, Sub, [I1|Acc]) + {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, 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, [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=succeeded,args=[Arg],dst=Dst}=I], - Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) -> + Ts0, Ds0, Fdb, D, Sub0, Acc) -> case Ds0 of #{ Arg := #b_set{op=call} } -> %% The success check of a call is part of exception handling and @@ -302,22 +299,22 @@ opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{Dst=>I}, - opt_is([], Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]); + opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]); #{} -> Args = simplify_args([Arg], Sub0, Ts0), Type = type(succeeded, Args, Ts0, Ds0), case get_literal_from_type(Type) of #b_literal{}=Lit -> Sub = Sub0#{Dst=>Lit}, - opt_is([], Ts0, Ds0, Fdb, Ls, D, Sub, Acc); + opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); none -> Ts = Ts0#{Dst=>Type}, Ds = Ds0#{Dst=>I}, - opt_is([], Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]) + opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]) end end; opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) -> + Ts0, Ds0, Fdb, D, Sub0, Acc) -> Args = simplify_args(Args0, Sub0, Ts0), I1 = beam_ssa:normalize(I0#b_set{args=Args}), case simplify(I1, Ts0) of @@ -325,24 +322,77 @@ opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], I = beam_ssa:normalize(I2), Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{Dst=>I}, - opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]); + opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]); #b_literal{}=Lit -> Sub = Sub0#{Dst=>Lit}, - opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc); + opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); #b_var{}=Var -> case Is of [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] -> %% We must remove this 'succeeded' instruction. Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, - opt_is([], Ts0, Ds0, Fdb, Ls, D, Sub, Acc); + opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); _ -> Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc) + opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc) end end; -opt_is([], Ts, Ds, Fdb, _Ls, _D, Sub, Acc) -> +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(erlang, setelement, + [#b_literal{val=Pos}, + #b_literal{val=Tuple}, + #b_var{}=Value], I) + when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> + %% Position is a literal integer and the shape of the + %% tuple is known. + Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], + {Bef,[_|Aft]} = split(Pos - 1, Els0), + Els = Bef ++ [Value|Aft], + I#b_set{op=put_tuple,args=Els}; +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 @@ -365,14 +415,13 @@ opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> {Ts, Ds, Fdb, I}. opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> - %% We skip propagating 'none' as we don't yet have a good way to cut a - %% block short. Type = case Fdb of - #{ Id := #func_info{ret_type=[T]} } when T =/= none -> T; + #{ Id := #func_info{ret_type=[T]} } -> T; #{} -> any end, I = case Type of any -> I0; + none -> I0; _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0) end, Ts = Ts0#{ Dst => Type }, @@ -386,11 +435,6 @@ update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> #t_bs_match{} -> {binary, 1}; Type -> Type end, - PrevType = maps:get(CallId, TypeMap0, NewType), - - %% The new type must be narrower than the old one. - true = meet(NewType, PrevType) =/= none, %Assertion. - TypeMap = TypeMap0#{ CallId => NewType }, [TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)]; update_arg_types([], [], _CallId, _Ts) -> @@ -418,12 +462,14 @@ simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) -> false -> I end; -simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I, Ts) -> +simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> case t_tuple_size(get_type(Tuple, Ts)) of {_,Size} when is_integer(Index), 1 =< Index, Index =< Size -> - I#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=Index-1}]}; + I = I0#b_set{op=get_tuple_element, + args=[Tuple,#b_literal{val=Index-1}]}, + simplify(I, Ts); _ -> - eval_bif(I, Ts) + eval_bif(I0, Ts) end; simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) -> case get_type(List, Ts) of @@ -471,10 +517,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), @@ -485,11 +540,17 @@ simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> AnnoArgs = [anno_float_arg(A) || A <- Types], eval_bif(beam_ssa:add_anno(float_op, AnnoArgs, I), Ts) end; -simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=0}]}=I, Ts) -> +simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> case get_type(Tuple, Ts) of - #t_tuple{elements=[First]} -> - #b_literal{val=First}; - #t_tuple{} -> + #t_tuple{size=Size,elements=Es} when Size > N -> + ElemType = get_element_type(N + 1, Es), + case get_literal_from_type(ElemType) of + #b_literal{}=Lit -> Lit; + none -> I + end; + none -> + %% Will never be executed because of type conflict. + %% #b_literal{val=ignored}; I end; simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> @@ -500,24 +561,8 @@ simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> _ -> #b_literal{val=false} end; simplify(#b_set{op=is_tagged_tuple, - args=[Src,#b_literal{val=Size},#b_literal{val=Tag}]}=I, Ts) -> - case get_type(Src, Ts) of - #t_tuple{exact=true,size=Size,elements=[Tag]} -> - #b_literal{val=true}; - #t_tuple{exact=true,size=ActualSize,elements=[]} -> - if - Size =/= ActualSize -> - #b_literal{val=false}; - true -> - I - end; - #t_tuple{exact=false} -> - I; - any -> - I; - _ -> - #b_literal{val=false} - end; + args=[Src,#b_literal{val=Size},#b_literal{}=Tag]}=I, Ts) -> + simplify_is_record(I, get_type(Src, Ts), Size, Tag, Ts); simplify(#b_set{op=put_list,args=[#b_literal{val=H}, #b_literal{val=T}]}, _Ts) -> #b_literal{val=[H|T]}; @@ -627,41 +672,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); @@ -670,38 +723,39 @@ 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(Bool, Ts, D0), + {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), D = update_successor(Fail, FailTs, D0), update_successor(Succ, SuccTs, D); false -> - {SuccTs,FailTs} = infer_types(Bool, Ts0, D0), + {SuccTs,FailTs} = infer_types_br(Bool, Ts0, D0), D = update_successor_bool(Bool, false, Fail, FailTs, D0), update_successor_bool(Bool, true, Succ, SuccTs, D) end; -update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> +update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) -> case cerl_sets:is_element(V, D0#d.once) of true -> %% This variable is defined in this block and is only %% referenced by this switch terminator. Therefore, there is - %% no need to include the type database passed on to the - %% successors of this block. - Ts = maps:remove(V, Ts0), + %% no need to include it in the type database passed on to + %% the successors of this block. D = update_successor(Fail, Ts, D0), - F = fun({_Val,S}, A) -> - update_successor(S, Ts, A) + F = fun({Val,S}, A) -> + SuccTs0 = infer_types_switch(V, Val, Ts, D), + SuccTs = maps:remove(V, SuccTs0), + update_successor(S, SuccTs, A) end, foldl(F, D, List); false -> %% V can not be equal to any of the values in List at the fail %% block. - FailTs = subtract_sw_list(V, List, Ts0), + FailTs = subtract_sw_list(V, List, Ts), D = update_successor(Fail, FailTs, D0), F = fun({Val,S}, A) -> - T = get_type(Val, Ts0), - update_successor(S, Ts0#{V=>T}, A) + SuccTs = infer_types_switch(V, Val, Ts, D), + update_successor(S, SuccTs, A) end, foldl(F, D, List) end; @@ -785,19 +839,40 @@ type(bs_get_tail, _Args, _Ts, _Ds) -> type(call, [#b_remote{mod=#b_literal{val=Mod}, name=#b_literal{val=Name}}|Args], Ts, _Ds) -> case {Mod,Name,Args} of - {erlang,setelement,[Pos,Tuple,_]} -> + {erlang,setelement,[Pos,Tuple,Arg]} -> case {get_type(Pos, Ts),get_type(Tuple, Ts)} of - {#t_integer{elements={MinIndex,_}},#t_tuple{}=T} - when MinIndex > 1 -> - %% First element is not updated. The result - %% will have the same type. - T; + {#t_integer{elements={Index,Index}}, + #t_tuple{elements=Es0,size=Size}=T} -> + %% This is an exact index, update the type of said element + %% or return 'none' if it's known to be out of bounds. + Es = set_element_type(Index, get_type(Arg, Ts), Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{size=max(Index, Size),elements=Es}; + true when Index =< Size -> + T#t_tuple{elements=Es}; + true -> + none + end; + {#t_integer{elements={Min,Max}}, + #t_tuple{elements=Es0,size=Size}=T} -> + %% We know this will land between Min and Max, so kill the + %% types for those indexes. + Es = maps:without(seq(Min, Max), Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{elements=Es,size=max(Min, Size)}; + true when Min =< Size -> + T#t_tuple{elements=Es,size=Size}; + true -> + none + end; {_,#t_tuple{}=T} -> - %% Position is 1 or unknown. May update the first - %% element of the tuple. - T#t_tuple{elements=[]}; - {#t_integer{elements={MinIndex,_}},_} -> - #t_tuple{size=MinIndex}; + %% Position unknown, so we have to discard all element + %% information. + T#t_tuple{elements=#{}}; + {#t_integer{elements={Min,_Max}},_} -> + #t_tuple{size=Min}; {_,_} -> #t_tuple{} end; @@ -809,6 +884,9 @@ type(call, [#b_remote{mod=#b_literal{val=Mod}, end; {erlang,'--',[_,_]} -> list; + {lists,F,Args} -> + Types = get_types(Args, Ts), + lists_function_type(F, Types); {math,_,_} -> case is_math_bif(Name, length(Args)) of false -> any; @@ -820,6 +898,11 @@ type(call, [#b_remote{mod=#b_literal{val=Mod}, false -> any end end; +type(get_tuple_element, [Tuple, Offset], Ts, _Ds) -> + #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts), + #b_literal{val=N} = Offset, + true = Size > N, %Assertion. + get_element_type(N + 1, Es); type(is_nonempty_list, [_], _Ts, _Ds) -> t_boolean(); type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) -> @@ -828,13 +911,13 @@ type(put_map, _Args, _Ts, _Ds) -> map; type(put_list, _Args, _Ts, _Ds) -> cons; -type(put_tuple, Args, _Ts, _Ds) -> - case Args of - [#b_literal{val=First}|_] -> - #t_tuple{exact=true,size=length(Args),elements=[First]}; - _ -> - #t_tuple{exact=true,size=length(Args)} - end; +type(put_tuple, Args, Ts, _Ds) -> + {Es, _} = foldl(fun(Arg, {Es0, Index}) -> + Type = get_type(Arg, Ts), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, Args), + #t_tuple{exact=true,size=length(Args),elements=Es}; type(succeeded, [#b_var{}=Src], Ts, Ds) -> case maps:get(Src, Ds) of #b_set{op={bif,Bif},args=BifArgs} -> @@ -895,6 +978,70 @@ arith_op_type(Args, Ts) -> (_, _) -> none end, unknown, Types). +lists_function_type(F, Types) -> + case {F,Types} of + %% Functions that return booleans. + {all,[_,_]} -> + t_boolean(); + {any,[_,_]} -> + t_boolean(); + {keymember,[_,_,_]} -> + t_boolean(); + {member,[_,_]} -> + t_boolean(); + {prefix,[_,_]} -> + t_boolean(); + {suffix,[_,_]} -> + t_boolean(); + + %% Functions that return lists. + {dropwhile,[_,_]} -> + list; + {duplicate,[_,_]} -> + list; + {filter,[_,_]} -> + list; + {flatten,[_]} -> + list; + {map,[_Fun,List]} -> + same_length_type(List); + {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; + MapFold =:= mapfoldr -> + #t_tuple{size=2,exact=true, + elements=#{1=>same_length_type(List)}}; + {partition,[_,_]} -> + t_two_tuple(list, list); + {reverse,[List]} -> + same_length_type(List); + {sort,[List]} -> + same_length_type(List); + {splitwith,[_,_]} -> + t_two_tuple(list, list); + {takewhile,[_,_]} -> + list; + {unzip,[List]} -> + ListType = same_length_type(List), + t_two_tuple(ListType, ListType); + {usort,[List]} -> + same_length_type(List); + {zip,[_,_]} -> + list; + {zipwith,[_,_,_]} -> + list; + {_,_} -> + any + end. + +%% For a lists function that return a list of the same +%% length as the input list, return the type of the list. +same_length_type(cons) -> cons; +same_length_type(nil) -> nil; +same_length_type(_) -> list. + +t_two_tuple(Type1, Type2) -> + #t_tuple{size=2,exact=true, + elements=#{1=>Type1,2=>Type2}}. + %% will_succeed(TestOperation, Type) -> yes|no|maybe. %% Test whether TestOperation applied to an argument of type Type %% will succeed. Return yes, no, or maybe. @@ -1031,6 +1178,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], @@ -1047,14 +1205,42 @@ eq_ranges([H], H, H) -> true; eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); eq_ranges(_, _, _) -> 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_is_record(I, #t_tuple{exact=Exact, + size=Size, + elements=Es}, + RecSize, RecTag, Ts) -> + TagType = maps:get(1, Es, any), + TagMatch = case get_literal_from_type(TagType) of + #b_literal{}=RecTag -> yes; + #b_literal{} -> no; + none -> + %% Is it at all possible for the tag to match? + case meet(get_type(RecTag, Ts), TagType) of + none -> no; + _ -> maybe + end + end, + if + Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no -> + #b_literal{val=false}; + Size =:= RecSize, Exact, TagMatch =:= yes -> + #b_literal{val=true}; + true -> + I + end; +simplify_is_record(I, any, _Size, _Tag, _Ts) -> + I; +simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> + #b_literal{val=false}. + +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 @@ -1068,7 +1254,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 @@ -1149,8 +1336,12 @@ get_type(#b_literal{val=Val}, _Ts) -> Val =:= {} -> #t_tuple{exact=true}; is_tuple(Val) -> - #t_tuple{exact=true,size=tuple_size(Val), - elements=[element(1, Val)]}; + {Es, _} = foldl(fun(E, {Es0, Index}) -> + Type = get_type(#b_literal{val=E}, #{}), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(Val)), + #t_tuple{exact=true,size=tuple_size(Val),elements=Es}; Val =:= [] -> nil; true -> @@ -1192,7 +1383,7 @@ get_type(#b_literal{val=Val}, _Ts) -> %% failed and that L is not 'cons'. 'cons' can be subtracted from the %% previously known type for L and the result put in FailTypes. -infer_types(#b_var{}=V, Ts, #d{ds=Ds}) -> +infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> #{V:=#b_set{op=Op,args=Args}} = Ds, Types0 = infer_type(Op, Args, Ds), @@ -1213,11 +1404,14 @@ infer_types(#b_var{}=V, Ts, #d{ds=Ds}) -> Types = Types1 ++ Types0, {meet_types(EqTypes++Types, Ts),subtract_types(Types, Ts)}. +infer_types_switch(V, Lit, Ts, #d{ds=Ds}) -> + Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds), + meet_types(Types, Ts). + infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> Def = maps:get(Src, Ds), Type = get_type(Lit, Ts), - [{Src,Type}|infer_tuple_size(Def, Lit) ++ - infer_first_element(Def, Lit)]; + [{Src,Type} | infer_eq_lit(Def, Lit)]; infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> %% As an example, assume that L1 is known to be 'list', and L2 is %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can @@ -1232,6 +1426,17 @@ infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> infer_eq_type(_Op, _Args, _Ts, _Ds) -> []. +infer_eq_lit(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, + #b_literal{val=Size}) when is_integer(Size) -> + [{Tuple,#t_tuple{exact=true,size=Size}}]; +infer_eq_lit(#b_set{op=get_tuple_element, + args=[#b_var{}=Tuple,#b_literal{val=N}]}, + #b_literal{}=Lit) -> + Index = N + 1, + Es = set_element_type(Index, get_type(Lit, #{}), #{}), + [{Tuple,#t_tuple{size=Index,elements=Es}}]; +infer_eq_lit(_, _) -> []. + infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> if is_integer(Pos), 1 =< Pos -> @@ -1265,8 +1470,9 @@ infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> [{Src,cons}]; infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, - #b_literal{val=Tag}], _Ds) -> - [{Src,#t_tuple{exact=true,size=Size,elements=[Tag]}}]; + #b_literal{}=Tag], _Ds) -> + Es = set_element_type(1, get_type(Tag, #{}), #{}), + [{Src,#t_tuple{exact=true,size=Size,elements=Es}}]; infer_type(succeeded, [#b_var{}=Src], Ds) -> #b_set{op=Op,args=Args} = maps:get(Src, Ds), infer_type(Op, Args, Ds); @@ -1359,17 +1565,6 @@ inferred_bif_type('*', [_,_]) -> number; inferred_bif_type('/', [_,_]) -> number; inferred_bif_type(_, _) -> any. -infer_tuple_size(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, - #b_literal{val=Size}) when is_integer(Size) -> - [{Tuple,#t_tuple{exact=true,size=Size}}]; -infer_tuple_size(_, _) -> []. - -infer_first_element(#b_set{op=get_tuple_element, - args=[#b_var{}=Tuple,#b_literal{val=0}]}, - #b_literal{val=First}) -> - [{Tuple,#t_tuple{size=1,elements=[First]}}]; -infer_first_element(_, _) -> []. - is_math_bif(cos, 1) -> true; is_math_bif(cosh, 1) -> true; is_math_bif(sin, 1) -> true; @@ -1468,6 +1663,19 @@ t_tuple_size(_) -> is_singleton_type(Type) -> get_literal_from_type(Type) =/= none. +get_element_type(Index, Es) -> + case Es of + #{ Index := T } -> T; + #{} -> any + end. + +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, any, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. + %% join(Type1, Type2) -> Type %% Return the "join" of Type1 and Type2. The join is a more general %% type than Type1 and Type2. For example: @@ -1515,15 +1723,41 @@ join(#t_integer{}, number) -> number; join(number, #t_integer{}) -> number; join(float, number) -> number; join(number, float) -> number; -join(#t_tuple{size=Sz,exact=Exact1}, #t_tuple{size=Sz,exact=Exact2}) -> - Exact = Exact1 and Exact2, - #t_tuple{size=Sz,exact=Exact}; -join(#t_tuple{size=Sz1}, #t_tuple{size=Sz2}) -> - #t_tuple{size=min(Sz1, Sz2)}; +join(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, + #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> + Exact = ExactA and ExactB, + Es = join_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,exact=Exact,elements=Es}; +join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> + Sz = min(SzA, SzB), + Es = join_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,elements=Es}; join(_T1, _T2) -> %%io:format("~p ~p\n", [_T1,_T2]), any. +join_tuple_elements(MinSize, EsA, EsB) -> + Es0 = join_elements(EsA, EsB), + maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + +join_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + join_elements_1(Keys, Es1, Es2, #{}). + +join_elements_1([Key | Keys], Es1, Es2, Acc0) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + Acc = set_element_type(Key, join(Type1, Type2), Acc0), + join_elements_1(Keys, Es1, Es2, Acc); + {#{}, #{}} -> + join_elements_1(Keys, Es1, Es2, Acc0) + end; +join_elements_1([], _Es1, _Es2, Acc) -> + Acc. + gcd(A, B) -> case A rem B of 0 -> B; @@ -1620,9 +1854,6 @@ meet(_, _) -> %% Inconsistent types. There will be an exception at runtime. none. -meet_tuples(#t_tuple{elements=[E1]}, #t_tuple{elements=[E2]}) - when E1 =/= E2 -> - none; meet_tuples(#t_tuple{size=Sz1,exact=true}, #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 -> none; @@ -1630,12 +1861,31 @@ meet_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> Size = max(Sz1, Sz2), Exact = Ex1 or Ex2, - Es = case {Es1,Es2} of - {[],[_|_]} -> Es2; - {[_|_],[]} -> Es1; - {_,_} -> Es1 - end, - #t_tuple{size=Size,exact=Exact,elements=Es}. + case meet_elements(Es1, Es2) of + none -> + none; + Es -> + #t_tuple{size=Size,exact=Exact,elements=Es} + end. + +meet_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + meet_elements_1(Keys, Es1, Es2, #{}). + +meet_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + case meet(Type1, Type2) of + none -> none; + Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +meet_elements_1([], _Es1, _Es2, Acc) -> + Acc. %% verified_type(Type) -> Type %% Returns the passed in type if it is one of the defined types. @@ -1674,5 +1924,13 @@ verified_type(map=T) -> T; verified_type(nil=T) -> T; verified_type(cons=T) -> T; verified_type(number=T) -> T; -verified_type(#t_tuple{}=T) -> T; +verified_type(#t_tuple{size=Size,elements=Es}=T) -> + %% All known elements must have a valid index and type. 'any' is prohibited + %% since it's implicit and should never be present in the map. + maps:fold(fun(Index, Element, _) when is_integer(Index), + 1 =< Index, Index =< Size, + Element =/= any, Element =/= none -> + verified_type(Element) + end, [], Es), + T; verified_type(float=T) -> T. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index b56d53d4ce..5175be3ad5 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -26,9 +26,10 @@ %% Interface for compiler. -export([module/2, format_error/1]). --export([type_anno/1, type_anno/2, type_anno/3]). +-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,member/2,reverse/1, + seq/2,sort/1,zip/2]). %% To be called by the compiler. @@ -65,11 +66,12 @@ type_anno(atom, Value) -> {atom, Value}; type_anno(float, Value) -> {float, Value}; type_anno(integer, Value) -> {integer, Value}. --spec type_anno(term(), term(), term()) -> term(). -type_anno(tuple, Size, Exact) when is_integer(Size) -> +-spec type_anno(term(), term(), term(), term()) -> term(). +type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0, + is_map(Elements) -> case Exact of - true -> {tuple, Size}; - false -> {tuple, [Size]} + true -> {tuple, Size, Elements}; + false -> {tuple, [Size], Elements} end. -spec format_error(term()) -> iolist(). @@ -139,8 +141,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> -type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}). -record(st, %Emulation state - {x=init_regs(0, term) :: reg_tab(),%x register info. - y=init_regs(0, initialized) :: reg_tab(),%y register info. + {x :: reg_tab(), %x register info. + y :: reg_tab(), %y register info. f=init_fregs(), % numy=none, %Number of y registers. h=0, %Available heap size. @@ -187,7 +189,7 @@ index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> index_parameter_types(Fs, Acc0) end; index_parameter_types([], Acc) -> - gb_trees:from_orddict(lists:sort(Acc)). + gb_trees:from_orddict(sort(Acc)). index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> Type = case Type0 of @@ -210,14 +212,10 @@ validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> Offset = 1 + length(Ls1) + 1 + length(Ls2), - EntryOK = lists:member(Entry, Ls2), + EntryOK = member(Entry, Ls2), if EntryOK -> - St = init_state(Arity), - Vst0 = #vst{current=St, - branched=gb_trees_from_list([{L,St} || L <- Ls1]), - labels=gb_sets:from_list(Ls1++Ls2), - ft=Ft}, + Vst0 = init_vst(Arity, Ls1, Ls2, Ft), MFA = {Mod,Name,Arity}, Vst = valfun(Is, MFA, Offset, Vst0), validate_fun_info_branches(Ls1, MFA, Vst); @@ -261,10 +259,16 @@ labels_1([{line,_}|Is], R) -> labels_1(Is, R) -> {reverse(R),Is}. -init_state(Arity) -> +init_vst(Arity, Ls1, Ls2, Ft) -> Xs = init_regs(Arity, term), Ys = init_regs(0, initialized), - kill_heap_allocation(#st{x=Xs,y=Ys,numy=none,ct=[]}). + St = #st{x=Xs,y=Ys}, + Branches = gb_trees_from_list([{L,St} || L <- Ls1]), + Labels = gb_sets:from_list(Ls1++Ls2), + #vst{branched=Branches, + current=St, + labels=Labels, + ft=Ft}. kill_heap_allocation(St) -> St#st{h=0,hf=0}. @@ -272,7 +276,7 @@ kill_heap_allocation(St) -> init_regs(0, _) -> gb_trees:empty(); init_regs(N, Type) -> - gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]). + gb_trees_from_list([{R,Type} || R <- seq(0, N-1)]). valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Targets = gb_trees:keys(Targets0), @@ -323,7 +327,7 @@ valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - extract_term(binary, [Ctx], Dst, Vst, Vst0); + extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0); valfun_1(bs_init_writable=I, Vst) -> call(I, 1, Vst); valfun_1(build_stacktrace=I, Vst) -> @@ -337,15 +341,15 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - create_term({float,[]}, Dst, Vst); -valfun_1({kill,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); -valfun_1({init,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); + create_term({float,[]}, fmove, [], Dst, Vst); +valfun_1({kill,Reg}, Vst) -> + create_tag(initialized, kill, [], Reg, Vst); +valfun_1({init,Reg}, Vst) -> + create_tag(initialized, init, [], Reg, Vst); valfun_1({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> - case is_bif_safe(Op, length(Src)) of +valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> + case is_bif_safe(Op, length(Ss)) of false -> %% Since the BIF can fail, make sure that any catch state %% is updated. @@ -353,27 +357,32 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> true -> %% It can't fail, so we finish handling it here (not updating %% catch state). - validate_src(Src, Vst), - Type = bif_type(Op, Src, Vst), - set_type_reg_expr(Type, I, Dst, Vst) + validate_src(Ss, Vst), + Type = bif_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst) end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> assert_not_fragile(A, Vst0), assert_not_fragile(B, Vst0), Vst = eat_heap(2, Vst0), - create_term(cons, Dst, Vst); + create_term(cons, put_list, [A, B], Dst, Vst); valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> _ = [assert_not_fragile(El, Vst0) || El <- Elements], Size = length(Elements), Vst = eat_heap(Size+1, Vst0), - Type = {tuple,Size}, - create_term(Type, Dst, Vst); + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = get_term_type(Val, Vst0), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, Elements), + Type = {tuple,Size,Es}, + create_term(Type, put_tuple2, [], Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = create_term(tuple_in_progress, Dst, Vst1), + Vst = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1), #vst{current=St0} = Vst, - St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}}, + St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; valfun_1({put,Src}, Vst0) -> assert_not_fragile(Src, Vst0), @@ -382,11 +391,13 @@ valfun_1({put,Src}, Vst0) -> case St0 of #st{puts_left=none} -> error(not_building_a_tuple); - #st{puts_left={1,{Dst,Type}}} -> + #st{puts_left={1,{Dst,Sz,Es}}} -> St = St0#st{puts_left=none}, - create_term(Type, Dst, Vst#vst{current=St}); - #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) -> - St = St0#st{puts_left={PutsLeft-1,Info}}, + create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St}); + #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> + Index = Sz - PutsLeft + 1, + Es = Es0#{ Index => get_term_type(Src, Vst0) }, + St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; %% Instructions for optimization of selective receives. @@ -412,7 +423,7 @@ valfun_1({line,_}, Vst) -> Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> - case return_type(Func, Vst) of + case call_return_type(Func, Vst) of exception -> verify_live(Live, Vst), %% The stack will be scanned, so Y registers @@ -439,70 +450,73 @@ valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> deallocate(Vst); valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_1({trim,N,Remaining}, #vst{current=#st{y=Yregs0,numy=NumY}=St}=Vst) -> +valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> + #st{numy=NumY} = St0, if - N =< NumY, N+Remaining =:= NumY -> - Yregs1 = [{Y-N,Type} || {Y,Type} <- gb_trees:to_list(Yregs0), Y >= N], - Yregs = gb_trees_from_list(Yregs1), - Vst#vst{current=St#st{y=Yregs,numy=NumY-N,aliases=#{}}}; - true -> - error({trim,N,Remaining,allocated,NumY}) + N =< NumY, N+Remaining =:= NumY -> + Vst#vst{current=trim_stack(N, 0, NumY, St0)}; + N > NumY; N+Remaining =/= NumY -> + error({trim,N,Remaining,allocated,NumY}) end; %% Catch & try. valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(catchtag, Dst, Fail, Vst); valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(trytag, Dst, Fail, Vst); -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {catchtag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xregs = gb_trees:enter(0, term, St#st.x), - Vst#vst{current=St#st{x=Xregs,ct=Fails,fls=undefined,aliases=#{}}}; - Type -> - error({bad_type,Type}) +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {catchtag,Fail} -> + %% {x,0} contains the caught term, if any. + create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst) -> - case get_special_y_type(Reg, Vst) of - {trytag,Fail} -> - St = St0#st{ct=Fails,fls=undefined}, - set_catch_end(Reg, Vst#vst{current=St}); - Type -> - error({bad_type,Type}) +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) -> + case get_tag_type(Reg, Vst) of + {trytag,Fail} -> + %% Kill the catch tag, note that x registers are unaffected. + kill_catch_tag(Reg, Vst); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {trytag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined,aliases=#{}}}; - Type -> - error({bad_type,Type}) +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {trytag,Fail} -> + %% Kill the catch tag and all x registers. + Vst1 = prune_x_regs(0, kill_catch_tag(Reg, Vst0)), + + %% Class:Error:Stacktrace + Vst2 = create_term({atom,[]}, try_case, [], {x,0}, Vst1), + Vst = create_term(term, try_case, [], {x,1}, Vst2), + create_term(term, try_case, [], {x,2}, Vst); + Type -> + error({wrong_tag_type,Type}) end; valfun_1({get_list,Src,D1,D2}, Vst0) -> assert_not_literal(Src), assert_type(cons, Src, Vst0), - Vst = extract_term(term, [Src], D1, Vst0), - extract_term(term, [Src], D2, Vst); + Vst = extract_term(term, get_hd, [Src], D1, Vst0), + extract_term(term, get_tl, [Src], D2, Vst); valfun_1({get_hd,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - extract_term(term, [Src], Dst, Vst); + extract_term(term, get_hd, [Src], Dst, Vst); valfun_1({get_tl,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - extract_term(term, [Src], Dst, Vst); -valfun_1({get_tuple_element,Src,I,Dst}, Vst) -> + extract_term(term, get_tl, [Src], Dst, Vst); +valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> assert_not_literal(Src), - assert_type({tuple_element,I+1}, Src, Vst), - extract_term(term, [Src], Dst, Vst); + assert_type({tuple_element,N+1}, Src, Vst), + Type = get_element_type(N+1, Src, Vst), + extract_term(Type, get_tuple_element, [Src], Dst, Vst); valfun_1({jump,{f,Lbl}}, Vst) -> kill_state(branch_state(Lbl, Vst)); valfun_1(I, Vst) -> valfun_2(I, Vst). init_try_catch_branch(Tag, Dst, Fail, Vst0) -> - Vst1 = set_type_y({Tag,[Fail]}, Dst, Vst0), + Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0), #vst{current=#st{ct=Fails}=St0} = Vst1, CurrentSt = St0#st{ct=[[Fail]|Fails]}, @@ -530,19 +544,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; @@ -593,43 +608,40 @@ valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> 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), - 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), + ElementType = case PosType of + {integer,I} -> get_element_type(I, Tuple, Vst0); + _ -> term + end, + InferredType = {tuple,[get_tuple_size(PosType)],#{}}, Vst1 = branch_state(Fail, Vst0), - Type = {tuple,[get_tuple_size(PosType)]}, - Vst = update_type(fun meet/2, Type, Tuple, Vst1), - extract_term(term, [Tuple], Dst, Vst); + Vst = update_type(fun meet/2, InferredType, Tuple, Vst1), + extract_term(ElementType, {bif,element}, [Tuple], Dst, Vst); valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); valfun_4(raw_raise=I, Vst) -> call(I, 3, Vst); -valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> - validate_src(Ss, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = update_type(fun meet/2, map, Map, Vst1), - extract_term(term, Ss, Dst, Vst); -valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Ss,Dst}, Vst0) -> - validate_src(Ss, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = update_type(fun meet/2, map, Map, Vst1), - extract_term(bool, Ss, Dst, Vst); 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), - Type = bif_type(Op, Ss, Vst), - extract_term(Type, Ss, Dst, Vst); + Vst = type_test(Fail, cons, Cons, Vst0), + Type = bif_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst); valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst0) -> validate_src(Ss, Vst0), - Vst = branch_state(Fail, Vst0), - Type = bif_type(Op, Ss, Vst), - extract_term(Type, Ss, Dst, Vst); + 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_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst); valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> validate_src(Ss, Vst0), verify_live(Live, Vst0), @@ -637,14 +649,15 @@ 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, - Type = bif_type(Op, Ss, Vst3), + + 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_return_type(Op, Ss, Vst3), Vst = prune_x_regs(Live, Vst3), - extract_term(Type, Ss, Dst, Vst, Vst0); + extract_term(Type, {gc_bif,Op}, Ss, Dst, Vst, Vst0); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> assert_not_fragile({x,0}, Vst), kill_state(Vst); @@ -656,7 +669,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst0) -> %% remove_message/0 is executed. If control transfers %% to the loop_rec_end/1 instruction, no part of %% this term must be stored in a Y register. - create_term({fragile,term}, Dst, Vst); + create_term({fragile,term}, loop_rec, [], Dst, Vst); valfun_4({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -671,22 +684,26 @@ valfun_4(timeout, #vst{current=St}=Vst) -> Vst#vst{current=St#st{x=init_regs(0, term)}}; valfun_4(send, Vst) -> call(send, 2, Vst); -valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> +valfun_4({set_tuple_element,Src,Tuple,N}, Vst) -> + I = N + 1, assert_not_fragile(Src, Vst), - assert_type({tuple_element,I+1}, Tuple, Vst), - Vst; + assert_type({tuple_element,I}, Tuple, Vst), + %% Manually update the tuple type; we can't rely on the ordinary update + %% helpers as we must support overwriting (rather than just widening or + %% narrowing) known elements, and we can't use extract_term either since + %% the source tuple may be aliased. + {tuple, Sz, Es0} = get_term_type(Tuple, Vst), + Es = set_element_type(I, get_term_type(Src, Vst), Es0), + override_type({tuple, Sz, Es}, Tuple, Vst); %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) -> assert_term(Src, Vst0), assert_choices(Choices), - Vst = branch_state(Fail, Vst0), - kill_state(select_val_branches(Src, Choices, Vst)); + select_val_branches(Fail, Src, Choices, Vst0); valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> assert_type(tuple, Tuple, Vst), assert_arities(Choices), - TupleType = get_durable_term_type(Tuple, Vst), - kill_state(branch_arities(Choices, Tuple, TupleType, - branch_state(Fail, Vst))); + select_arity_branches(Fail, Choices, Tuple, Vst); %% New bit syntax matching instructions. valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> @@ -712,19 +729,18 @@ valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); valfun_4({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_4({test,bs_get_integer2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst); -valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - Type = propagate_fragility(term, [Ctx], Vst), - validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst); -valfun_4({test,bs_get_utf8,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_utf32,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst); +valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst); +valfun_4({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); valfun_4({bs_save2,Ctx,SavePoint}, Vst) -> bsm_save(Ctx, SavePoint, Vst); valfun_4({bs_restore2,Ctx,SavePoint}, Vst) -> @@ -734,7 +750,7 @@ valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - create_term(bs_position, Dst, Vst); + create_term(bs_position, bs_get_position, [Ctx], Dst, Vst); valfun_4({bs_set_position, Ctx, Pos}, Vst) -> bsm_validate_context(Ctx, Vst), assert_type(bs_position, Pos, Vst), @@ -748,7 +764,7 @@ valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) -> valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) -> type_test(Lbl, {float,[]}, Src, Vst); valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {tuple,[0]}, Src, Vst); + type_test(Lbl, {tuple,[0],#{}}, Src, Vst); valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) -> type_test(Lbl, {integer,[]}, Src, Vst); valfun_4({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> @@ -767,43 +783,49 @@ 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,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) -> - assert_term(Src, Vst), - update_type(fun meet/2, {tuple,Sz}, Src, 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), + update_type(fun meet/2, {tuple,Sz,#{ 1 => Atom }}, Src, Vst); 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); valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> assert_not_fragile(A, Vst), assert_not_fragile(B, Vst), - create_term({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, bs_add, [A, B], Dst, branch_state(Fail, Vst)); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - create_term({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, bs_utf8_size, [A], Dst, branch_state(Fail, Vst)); valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - create_term({integer,[]}, Dst, branch_state(Fail, Vst)); + create_term({integer,[]}, bs_utf16_size, [A], Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -816,7 +838,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - create_term(binary, Dst, Vst); + create_term(binary, bs_init2, [], Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -829,7 +851,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - create_term(binary, Dst, Vst); + create_term(binary, bs_init_bits, [], Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -838,12 +860,12 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - create_term(binary, Dst, Vst); + create_term(binary, bs_append, [Bin], Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_not_fragile(Bits, Vst0), assert_not_fragile(Bin, Vst0), Vst = branch_state(Fail, Vst0), - create_term(binary, Dst, Vst); + create_term(binary, bs_private_append, [Bin], Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> @@ -868,10 +890,10 @@ valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> assert_not_fragile(Src, Vst), branch_state(Fail, Vst); %% Map instructions. -valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); -valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> verify_get_map(Fail, Src, List, Vst); valfun_4(_, _) -> @@ -880,69 +902,90 @@ 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, {bif,map_get}, [Key, 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) -> - 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([Key,Dst|Vs], Map, Vst0, Vsti0) -> + assert_term(Key, Vst0), + Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0), + extract_map_vals(Vs, Map, Vst0, Vsti); +extract_map_vals([], _Map, _Vst0, Vst) -> + Vst. -verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> +verify_put_map(Op, 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), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - create_term(map, Dst, Vst). + create_term(map, Op, [Src], Dst, Vst). %% %% 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). + %% + %% The override_type hack is only needed until we get proper union types. + complex_test(Fail, + fun(FailVst) -> + override_type(term, Src, FailVst) + end, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + extract_term(Type, bs_start_match, [Src], Dst, + SuccVst, Vst) + end, Vst). %% %% Common code for validating bs_get* instructions. %% -validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) -> +validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst0) -> bsm_validate_context(Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), Vst1 = prune_x_regs(Live, Vst0), Vst = branch_state(Fail, Vst1), - create_term(Type, Dst, Vst). + extract_term(Type, Op, [Ctx], Dst, Vst). %% %% Common code for validating bs_skip_utf* instructions. @@ -983,14 +1026,15 @@ kill_state(Vst) -> %% A "plain" call. %% The stackframe must be initialized. %% The instruction will return to the instruction following the call. -call(Name, Live, #vst{current=St}=Vst) -> - verify_call_args(Name, Live, Vst), - verify_y_init(Vst), - case return_type(Name, Vst) of - Type when Type =/= exception -> - %% Type is never 'exception' because it has been handled earlier. - Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs,f=init_fregs(),aliases=#{}}} +call(Name, Live, #vst{current=St0}=Vst0) -> + verify_call_args(Name, Live, Vst0), + verify_y_init(Vst0), + case call_return_type(Name, Vst0) of + Type when Type =/= exception -> + %% Type is never 'exception' because it has been handled earlier. + St = St0#st{f=init_fregs(),aliases=#{}}, + Vst = prune_x_regs(0, Vst0#vst{current=St}), + create_term(Type, call, [], {x,0}, Vst) end. %% Tail call. @@ -1006,42 +1050,36 @@ tail_call(Name, Live, Vst0) -> verify_call_args(_, 0, #vst{}) -> ok; verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - verify_local_call(Lbl, Live, Vst); + verify_local_args(Live - 1, Lbl, #{}, Vst); verify_call_args(_, Live, Vst) when is_integer(Live)-> - verify_call_args_1(Live, Vst); + verify_remote_args_1(Live - 1, Vst); verify_call_args(_, Live, _) -> error({bad_number_of_live_regs,Live}). -verify_call_args_1(0, _) -> ok; -verify_call_args_1(N, Vst) -> - X = N - 1, - assert_not_fragile({x,X}, Vst), - verify_call_args_1(X, Vst). +verify_remote_args_1(-1, _) -> + ok; +verify_remote_args_1(X, Vst) -> + assert_not_fragile({x, X}, Vst), + verify_remote_args_1(X - 1, 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_no_ms_aliases(TRegs), - foreach(F, TRegs). - -typed_call_regs(0, _Vst) -> - []; -typed_call_regs(Live0, Vst) -> - Live = Live0 - 1, - R = {x,Live}, - [{R, get_move_term_type(R, Vst)} | typed_call_regs(Live, Vst)]. - -%% Verifies that the same match context isn't present twice. -verify_no_ms_aliases(Regs) -> - CtxIds = [Id || {_, #ms{id=Id}} <- Regs], - UniqueCtxIds = ordsets:from_list(CtxIds), - if - length(UniqueCtxIds) < length(CtxIds) -> - error({multiple_match_contexts, Regs}); - length(UniqueCtxIds) =:= length(CtxIds) -> - ok +verify_local_args(-1, _Lbl, _CtxIds, _Vst) -> + ok; +verify_local_args(X, Lbl, CtxIds, Vst) -> + Reg = {x, X}, + case get_raw_type(Reg, Vst) of + #ms{id=Id}=Type -> + case CtxIds of + #{ Id := Other } -> + error({multiple_match_contexts, [Reg, Other]}); + #{} -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) + end; + {fragile,_} -> + error({fragile_message_reference, Reg}); + Type -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds, Vst) end. %% Verifies that the given argument narrows to what the function expects. @@ -1087,6 +1125,25 @@ allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> deallocate(#vst{current=St}=Vst) -> Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. +trim_stack(From, To, Top, #st{y=Ys0}=St) when From =:= Top -> + Ys = foldl(fun(Y, Acc) -> + gb_trees:delete(Y, Acc) + end, Ys0, seq(To, From - 1)), + %% Note that all aliases and defs are wiped. This is perhaps a bit too + %% conservative, but preserving them won't be easy until type management + %% is refactored. + St#st{aliases=#{},defs=#{},numy=To,y=Ys}; +trim_stack(From, To, Top, St0) -> + #st{y=Ys0} = St0, + + Ys = case gb_trees:lookup(From, Ys0) of + none -> error({invalid_shift,{y,From},{y,To}}); + {value,Type} -> gb_trees:enter(To, Type, Ys0) + end, + + St = St0#st{y=Ys}, + trim_stack(From + 1, To + 1, Top, St). + test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -1173,8 +1230,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). @@ -1229,7 +1286,10 @@ assert_unique_map_keys([]) -> assert_unique_map_keys([_]) -> ok; assert_unique_map_keys([_,_|_]=Ls) -> - Vs = [get_literal(L) || L <- Ls], + Vs = [begin + assert_literal(L), + L + end || L <- Ls], case length(Vs) =:= sets:size(sets:from_list(Vs)) of true -> ok; false -> error(keys_not_unique) @@ -1271,7 +1331,7 @@ bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, - set_type_reg(Ctx, Reg, Vst); + override_type(Ctx, Reg, Vst); _ -> error({illegal_save,SavePoint}) end. @@ -1290,37 +1350,89 @@ bsm_restore(Reg, SavePoint, Vst) -> _ -> error({illegal_restore,SavePoint,range}) end. -select_val_branches(Src, Choices, Vst) -> - Infer = infer_types(Src, Vst), - select_val_branches_1(Choices, Src, Infer, Vst). - -select_val_branches_1([Val,{f,L}|T], Src, Infer, Vst0) -> - Vst1 = set_aliased_type(Val, Src, Infer(Val, Vst0)), - Vst = branch_state(L, Vst1), - select_val_branches_1(T, Src, Infer, Vst); -select_val_branches_1([], _, _, Vst) -> Vst. +select_val_branches(Fail, Src, Choices, Vst0) -> + Vst = svb_1(Choices, Src, Vst0), + kill_state(branch_state(Fail, Vst)). + +svb_1([Val,{f,L}|T], Src, Vst0) -> + Vst = complex_test(L, + fun(BranchVst) -> + update_eq_types(Val, Src, BranchVst) + end, + fun(FailVst) -> + update_ne_types(Val, Src, FailVst) + end, Vst0), + svb_1(T, Src, Vst); +svb_1([], _, Vst) -> + Vst. + +select_arity_branches(Fail, List, Tuple, Vst0) -> + Type = get_durable_term_type(Tuple, Vst0), + Vst = sab_1(List, Tuple, Type, Vst0), + kill_state(branch_state(Fail, Vst)). + +sab_1([Sz,{f,L}|T], Tuple, {tuple,[_],Es}=Type0, Vst0) -> + #vst{current=St0} = Vst0, + Vst1 = update_type(fun meet/2, {tuple,Sz,Es}, Tuple, Vst0), + Vst2 = branch_state(L, Vst1), + Vst = Vst2#vst{current=St0}, + + sab_1(T, Tuple, Type0, Vst); +sab_1([Sz,{f,L}|T], Tuple, {tuple,Sz,_Es}=Type, Vst0) -> + %% The type is already correct. (This test is redundant.) + Vst = branch_state(L, Vst0), + sab_1(T, Tuple, Type, Vst); +sab_1([_,{f,_}|T], Tuple, Type, Vst) -> + %% We already have an established different exact size for the tuple. + %% This label can't possibly be reached. + sab_1(T, Tuple, Type, Vst); +sab_1([], _, _, #vst{}=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],_} -> + {{bif,tuple_size}, [Tuple]} -> fun({integer,Arity}, S) -> - update_type(fun meet/2, {tuple,Arity}, Tuple, S); + update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); (_, S) -> S end; - {bif,'=:=',{f,_},[ArityReg,{integer,_}=Val],_} when ArityReg =/= Src -> + {{bif,'=:='},[ArityReg,{integer,_}=Val]} when ArityReg =/= Src -> fun({atom,true}, S) -> Infer = infer_types(ArityReg, S), Infer(Val, S); (_, S) -> S end; + {{bif,is_atom},[Src]} -> + infer_type_test_bif({atom,[]}, Src); + {{bif,is_boolean},[Src]} -> + infer_type_test_bif(bool, Src); + {{bif,is_binary},[Src]} -> + infer_type_test_bif(binary, Src); + {{bif,is_bitstring},[Src]} -> + infer_type_test_bif(binary, Src); + {{bif,is_float},[Src]} -> + infer_type_test_bif(float, Src); + {{bif,is_integer},[Src]} -> + infer_type_test_bif({integer,{}}, Src); + {{bif,is_list},[Src]} -> + infer_type_test_bif(list, Src); + {{bif,is_map},[Src]} -> + infer_type_test_bif(map, Src); + {{bif,is_number},[Src]} -> + infer_type_test_bif(number, Src); + {{bif,is_tuple},[Src]} -> + infer_type_test_bif({tuple,[0],#{}}, 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. %%% @@ -1329,34 +1441,69 @@ infer_types(Src, Vst) -> assign({y,_}=Src, {y,_}=Dst, Vst) -> %% The stack trimming optimization may generate a move from an initialized %% but unassigned Y register to another Y register. - case get_term_type_1(Src, Vst) of - initialized -> set_type_reg(initialized, Dst, Vst); + case get_raw_type(Src, Vst) of + initialized -> create_tag(initialized, init, [], Dst, Vst); _ -> assign_1(Src, Dst, Vst) end; assign({Kind,_}=Reg, Dst, Vst) when Kind =:= x; Kind =:= y -> assign_1(Reg, Dst, Vst); assign(Literal, Dst, Vst) -> - create_term(get_term_type(Literal, Vst), Dst, Vst). + Type = get_term_type(Literal, Vst), + create_term(Type, move, [Literal], Dst, Vst). + +%% Creates a special tag value that isn't a regular term, such as +%% 'initialized' or 'catchtag' +create_tag(Type, Op, Ss, {y,_}=Dst, Vst) -> + set_type_reg_expr(Type, {Op, Ss}, Dst, Vst); +create_tag(_Type, _Op, _Ss, Dst, _Vst) -> + error({invalid_tag_register, Dst}). + +%% Wipes a special tag, leaving the register initialized but empty. +kill_tag({y,Y}=Reg, #vst{current=#st{y=Ys0}=St0}=Vst) -> + _ = get_tag_type(Reg, Vst), %Assertion. + Ys = gb_trees:update(Y, initialized, Ys0), + Vst#vst{current=St0#st{y=Ys}}. %% Creates a completely new term with the given type. -create_term(Type, Dst, Vst) -> - set_type_reg(Type, Dst, Vst). +create_term(Type, Op, Ss, Dst, Vst) -> + set_type_reg_expr(Type, {Op, Ss}, Dst, Vst). %% Extracts a term from Ss, propagating fragility. -extract_term(Type, Ss, Dst, Vst) -> - extract_term(Type, Ss, Dst, Vst, Vst). +extract_term(Type, Op, Ss, Dst, Vst) -> + extract_term(Type, Op, Ss, Dst, Vst, Vst). %% As extract_term/4, but uses the incoming Vst for fragility in case x-regs %% have been pruned and the sources can no longer be found. -extract_term(Type0, Ss, Dst, Vst, OrigVst) -> +extract_term(Type0, Op, Ss, Dst, Vst, OrigVst) -> Type = propagate_fragility(Type0, Ss, OrigVst), - set_type_reg(Type, Dst, Vst). + set_type_reg_expr(Type, {Op, Ss}, 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). + +%% Overrides the type of Reg. This is ugly but a necessity for certain +%% destructive operations. +override_type(Type, Reg, Vst) -> + %% Once the new type format is in, this should be expressed as: + %% update_type(fun(_, T) -> T end, Type, Reg, Vst). + set_aliased_type(Type, Reg, Vst). %% This is used when linear code finds out more and more information about a %% type, so that the type gets more specialized. @@ -1375,48 +1522,36 @@ 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. assign_1(Src, Dst, Vst0) -> Type = get_move_term_type(Src, Vst0), - Vst = set_type_reg(Type, Dst, Vst0), - case Src of - {Kind,_} when Kind =:= x; Kind =:= y -> - #vst{current=St0} = Vst, - #st{aliases=Aliases0} = St0, - Aliases = Aliases0#{Src=>Dst,Dst=>Src}, - St = St0#st{aliases=Aliases}, - Vst#vst{current=St}; - _ -> - Vst - end. + Def = get_def(Src, Vst0), + + Vst = set_type_reg_expr(Type, Def, Dst, Vst0), + + #vst{current=St0} = Vst, + #st{aliases=Aliases0} = St0, + + Aliases = Aliases0#{Src=>Dst,Dst=>Src}, + + St = St0#st{aliases=Aliases}, + Vst#vst{current=St}. set_aliased_type(Type, Reg, #vst{current=#st{aliases=Aliases}}=Vst0) -> Vst1 = set_type(Type, Reg, Vst0), @@ -1445,7 +1580,9 @@ set_type(Type, {y,_}=Reg, Vst) -> set_type(_, _, #vst{}=Vst) -> Vst. set_type_reg(Type, Src, Dst, Vst) -> - case get_term_type_1(Src, Vst) of + case get_raw_type(Src, Vst) of + uninitialized -> + error({uninitialized_reg, Src}); {fragile,_} -> set_type_reg(make_fragile(Type), Dst, Vst); _ -> @@ -1460,9 +1597,6 @@ set_type_reg_expr(Type, Expr, {x,_}=Reg, Vst) -> set_type_reg_expr(Type, Expr, Reg, Vst) -> set_type_y(Type, Expr, Reg, Vst). -set_type_y(Type, Reg, Vst) -> - set_type_y(Type, none, Reg, Vst). - set_type_x(Type, Expr, {x,X}=Reg, #vst{current=#st{x=Xs0,defs=Defs0}=St0}=Vst) when is_integer(X), 0 =< X -> check_limit(Reg), @@ -1493,7 +1627,7 @@ set_type_y(Type, Expr, {y,Y}=Reg, #vst{current=#st{y=Ys0,defs=Defs0}=St0}=Vst) {value,_} -> gb_trees:update(Y, Type, Ys0) end, - check_try_catch_tags(Type, Y, Ys0), + check_try_catch_tags(Type, Reg, Vst), Defs = Defs0#{Reg=>Expr}, St = kill_aliases(Reg, St0), Vst#vst{current=St#st{y=Ys,defs=Defs}}; @@ -1503,34 +1637,26 @@ set_type_y(Type, _Expr, Reg, #vst{}) -> make_fragile({fragile,_}=Type) -> Type; make_fragile(Type) -> {fragile,Type}. -set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) -> - Ys = gb_trees:update(Y, initialized, Ys0), - Vst#vst{current=St#st{y=Ys}}. +kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> + Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, + {_, Fail} = get_tag_type(Reg, Vst), %Assertion. + kill_tag(Reg, Vst). -check_try_catch_tags(Type, LastY, Ys) -> +check_try_catch_tags(Type, {y,N}=Reg, Vst) -> + %% Every catch or try/catch must use a lower Y register number than any + %% enclosing catch or try/catch. That will ensure that when the stack is + %% scanned when an exception occurs, the innermost try/catch tag is found + %% first. case is_try_catch_tag(Type) of - false -> - ok; true -> - %% Every catch or try/catch must use a lower Y register - %% number than any enclosing catch or try/catch. That will - %% ensure that when the stack is scanned when an - %% exception occurs, the innermost try/catch tag is found - %% first. - Bad = [{{y,Y},Tag} || {Y,Tag} <- gb_trees:to_list(Ys), - Y < LastY, is_try_catch_tag(Tag)], - case Bad of - [] -> - ok; - [_|_] -> - error({bad_try_catch_nesting,{y,LastY},Bad}) - end + case collect_try_catch_tags(N - 1, Vst, []) of + [_|_]=Bad -> error({bad_try_catch_nesting, Reg, Bad}); + [] -> ok + end; + false -> + ok end. -is_try_catch_tag({catchtag,_}) -> true; -is_try_catch_tag({trytag,_}) -> true; -is_try_catch_tag(_) -> false. - is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst); is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst); is_reg_defined(V, #vst{}) -> error({not_a_register, V}). @@ -1551,6 +1677,13 @@ assert_not_fragile(Src, Vst) -> _ -> ok end. +assert_literal(nil) -> ok; +assert_literal({atom,A}) when is_atom(A) -> ok; +assert_literal({float,F}) when is_float(F) -> ok; +assert_literal({integer,I}) when is_integer(I) -> ok; +assert_literal({literal,_L}) -> ok; +assert_literal(T) -> error({literal_required,T}). + assert_not_literal({x,_}) -> ok; assert_not_literal({y,_}) -> ok; assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). @@ -1573,10 +1706,10 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% used by the catch instructions; NOT safe to use in other %% instructions. %% -%% exception Can only be used as a type returned by return_type/2 -%% (which gives the type of the value returned by a BIF). -%% Thus 'exception' is never stored as type descriptor -%% for a register. +%% exception Can only be used as a type returned by +%% call_return_type/2 (which gives the type of the value +%% returned by a call). Thus 'exception' is never stored +%% as type descriptor for a register. %% %% #ms{} A match context for bit syntax matching. We do allow %% it to moved/to from stack, but otherwise it must only @@ -1597,11 +1730,12 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). %% %% list List: [] or [_|_] %% -%% {tuple,[Sz]} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. +%% {tuple,[Sz],Es} Tuple. An element has been accessed using +%% element/2 or setelement/3 so that it is known that +%% the type is a tuple of size at least Sz. Es is a map +%% containing known types by tuple index. %% -%% {tuple,Sz} Tuple. A test_arity instruction has been seen +%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen %% so that it is known that the size is exactly Sz. %% %% {atom,[]} Atom. @@ -1636,6 +1770,10 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}). meet(Same, Same) -> Same; +meet({literal,_}=T1, T2) -> + meet_literal(T1, T2); +meet(T1, {literal,_}=T2) -> + meet_literal(T2, T1); meet(term, Other) -> Other; meet(Other, term) -> @@ -1651,18 +1789,59 @@ meet(T1, T2) -> {list,nil} -> nil; {number,{integer,_}=T} -> T; {number,{float,_}=T} -> T; - {{tuple,Size1},{tuple,Size2}} -> - case {Size1,Size2} of - {[Sz1],[Sz2]} -> - {tuple,[erlang:max(Sz1, Sz2)]}; - {Sz1,[Sz2]} when Sz2 =< Sz1 -> - {tuple,Sz1}; - {_,_} -> + {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> + Es = meet_elements(Es1, Es2), + case {Size1,Size2,Es} of + {_, _, none} -> + none; + {[Sz1],[Sz2],_} -> + Sz = erlang:max(Sz1, Sz2), + assert_tuple_elements(Sz, Es), + {tuple,[Sz],Es}; + {Sz1,[Sz2],_} when Sz2 =< Sz1 -> + assert_tuple_elements(Sz1, Es), + {tuple,Sz1,Es}; + {Sz,Sz,_} -> + assert_tuple_elements(Sz, Es), + {tuple,Sz,Es}; + {_,_,_} -> none end; {_,_} -> none end. +%% Meets types of literals. +meet_literal({literal,_}=Lit, T) -> + meet_literal(T, get_literal_type(Lit)); +meet_literal(T1, T2) -> + %% We're done extracting the types, try merging them again. + meet(T1, T2). + +meet_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + meet_elements_1(Keys, Es1, Es2, #{}). + +meet_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + case meet(Type1, Type2) of + none -> none; + Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +meet_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% No tuple elements may have an index above the known size. +assert_tuple_elements(Limit, Es) -> + true = maps:fold(fun(Index, _T, true) -> + Index =< Limit + end, true, Es). %Assertion. + %% subtract(Type1, Type2) -> Type %% Subtract Type2 from Type2. Example: %% subtract(list, nil) -> cons @@ -1681,12 +1860,12 @@ assert_type(WantedType, Term, Vst) -> assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_}) -> ok; +assert_type(tuple, {tuple,_,_}) -> ok; assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz]}) +assert_type({tuple_element,I}, {tuple,[Sz],_}) when 1 =< I, I =< Sz -> ok; -assert_type({tuple_element,I}, {tuple,Sz}) +assert_type({tuple_element,I}, {tuple,Sz,_}) when is_integer(Sz), 1 =< I, I =< Sz -> ok; assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> @@ -1696,12 +1875,42 @@ assert_type(cons, {literal,[_|_]}) -> assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). +get_element_type(Key, Src, Vst) -> + get_element_type_1(Key, get_durable_term_type(Src, Vst)). + +get_element_type_1(Index, {tuple,Sz,Es}) -> + case Es of + #{ Index := Type } -> Type; + #{} when Index =< Sz -> term; + #{} -> none + end; +get_element_type_1(_Index, _Type) -> + term. + +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, term, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. + get_tuple_size({integer,[]}) -> 0; 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_term_type(Src, ValidatorState) -> Type +%% Get the type of the source Src. The returned type Type will be +%% a standard Erlang type (no catch/try tags or match contexts). + +get_term_type(Src, Vst) -> + case get_move_term_type(Src, Vst) of + #ms{} -> error({match_context,Src}); + Type -> Type + end. %% get_durable_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be @@ -1719,52 +1928,43 @@ get_durable_term_type(Src, Vst) -> %% a standard Erlang type (no catch/try tags). Match contexts are OK. get_move_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_raw_type(Src, Vst) of + initialized -> error({unassigned,Src}); + uninitialized -> error({uninitialized_reg,Src}); + {catchtag,_} -> error({catchtag,Src}); + {trytag,_} -> error({trytag,Src}); tuple_in_progress -> error({tuple_in_progress,Src}); - Type -> Type + Type -> Type end. -%% get_term_type(Src, ValidatorState) -> Type -%% Get the type of the source Src. The returned type Type will be -%% a standard Erlang type (no catch/try tags or match contexts). +%% get_tag_type(Src, ValidatorState) -> Type +%% Return the tag type of a Y register, erroring out if it contains a term. -get_term_type(Src, Vst) -> - case get_move_term_type(Src, Vst) of - #ms{} -> error({match_context,Src}); - Type -> Type - end. +get_tag_type({y,_}=Src, Vst) -> + case get_raw_type(Src, Vst) of + {catchtag, _}=Tag -> Tag; + {trytag, _}=Tag -> Tag; + uninitialized=Tag -> Tag; + initialized=Tag -> Tag; + Other -> error({invalid_tag,Src,Other}) + end; +get_tag_type(Src, _) -> + error({invalid_tag_register,Src}). -%% get_special_y_type(Src, ValidatorState) -> Type -%% Return the type for the Y register without doing any validity checks. - -get_special_y_type({y,_}=Reg, Vst) -> get_term_type_1(Reg, Vst); -get_special_y_type(Src, _) -> error({source_not_y_reg,Src}). - -get_term_type_1(nil=T, _) -> T; -get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; -get_term_type_1({float,F}=T, _) when is_float(F) -> T; -get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; -get_term_type_1({literal,[_|_]}, _) -> cons; -get_term_type_1({literal,Bitstring}, _) when is_bitstring(Bitstring) -> binary; -get_term_type_1({literal,Map}, _) when is_map(Map) -> map; -get_term_type_1({literal,Tuple}, _) when is_tuple(Tuple) -> - {tuple,tuple_size(Tuple)}; -get_term_type_1({literal,_}=T, _) -> T; -get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> +%% get_raw_type(Src, ValidatorState) -> Type +%% Return the type of a register without doing any validity checks. +get_raw_type({x,X}, #vst{current=#st{x=Xs}}) when is_integer(X) -> case gb_trees:lookup(X, Xs) of - {value,Type} -> Type; - none -> error({uninitialized_reg,Reg}) + {value,Type} -> Type; + none -> uninitialized end; -get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> +get_raw_type({y,Y}, #vst{current=#st{y=Ys}}) when is_integer(Y) -> case gb_trees:lookup(Y, Ys) of - none -> error({uninitialized_reg,Reg}); - {value,uninitialized} -> error({uninitialized_reg,Reg}); - {value,Type} -> Type + {value,Type} -> Type; + none -> uninitialized end; -get_term_type_1(Src, _) -> error({bad_source,Src}). +get_raw_type(Src, #vst{}) -> + get_literal_type(Src). get_def(Src, #vst{current=#st{defs=Defs}}) -> case Defs of @@ -1772,28 +1972,29 @@ get_def(Src, #vst{current=#st{defs=Defs}}) -> #{} -> none end. -%% get_literal(Src) -> literal_value(). -get_literal(nil) -> []; -get_literal({atom,A}) when is_atom(A) -> A; -get_literal({float,F}) when is_float(F) -> F; -get_literal({integer,I}) when is_integer(I) -> I; -get_literal({literal,L}) -> L; -get_literal(T) -> error({not_literal,T}). - -branch_arities([Sz,{f,L}|T], Tuple, {tuple,[_]}=Type0, Vst0) when is_integer(Sz) -> - Vst1 = set_aliased_type({tuple,Sz}, Tuple, Vst0), - Vst = branch_state(L, Vst1), - branch_arities(T, Tuple, Type0, Vst); -branch_arities([Sz,{f,L}|T], Tuple, {tuple,Sz}=Type, Vst0) when is_integer(Sz) -> - %% The type is already correct. (This test is redundant.) - Vst = branch_state(L, Vst0), - branch_arities(T, Tuple, Type, Vst); -branch_arities([Sz0,{f,_}|T], Tuple, {tuple,Sz}=Type, Vst) - when is_integer(Sz), Sz0 =/= Sz -> - %% We already have an established different exact size for the tuple. - %% This label can't possibly be reached. - branch_arities(T, Tuple, Type, Vst); -branch_arities([], _, _, #vst{}=Vst) -> Vst. +get_literal_type(nil=T) -> T; +get_literal_type({atom,A}=T) when is_atom(A) -> T; +get_literal_type({float,F}=T) when is_float(F) -> T; +get_literal_type({integer,I}=T) when is_integer(I) -> T; +get_literal_type({literal,[_|_]}) -> cons; +get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary; +get_literal_type({literal,Map}) when is_map(Map) -> map; +get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> value_to_type(Tuple); +get_literal_type({literal,_}) -> term; +get_literal_type(T) -> error({not_literal,T}). + +value_to_type([]) -> nil; +value_to_type(A) when is_atom(A) -> {atom, A}; +value_to_type(F) when is_float(F) -> {float, F}; +value_to_type(I) when is_integer(I) -> {integer, I}; +value_to_type(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = value_to_type(Val), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + {tuple, tuple_size(T), Es}; +value_to_type(L) -> {literal, L}. branch_state(0, #vst{}=Vst) -> %% If the instruction fails, the stack may be scanned @@ -1902,9 +2103,14 @@ join({catchtag,T0},{catchtag,T1}) -> {catchtag,ordsets:from_list(T0++T1)}; join({trytag,T0},{trytag,T1}) -> {trytag,ordsets:from_list(T0++T1)}; -join({tuple,A}, {tuple,B}) -> - {tuple,[min(tuple_sz(A), tuple_sz(B))]}; -join({Type,A}, {Type,B}) +join({tuple,Size,EsA}, {tuple,Size,EsB}) -> + Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), + {tuple, Size, Es}; +join({tuple,A,EsA}, {tuple,B,EsB}) -> + Size = min(tuple_sz(A), tuple_sz(B)), + Es = join_tuple_elements(Size, EsA, EsB), + {tuple, [Size], Es}; +join({Type,A}, {Type,B}) when Type =:= atom; Type =:= integer; Type =:= float -> if A =:= B -> {Type,A}; true -> {Type,[]} @@ -1916,9 +2122,9 @@ join(number, {Type,_}) when Type =:= integer; Type =:= float -> number; join(bool, {atom,A}) -> - merge_bool(A); + join_bool(A); join({atom,A}, bool) -> - merge_bool(A); + join_bool(A); join({atom,_}, {atom,_}) -> {atom,[]}; join(#ms{id=Id1,valid=B1,slots=Slots1}, @@ -1933,19 +2139,34 @@ join(T1, T2) when T1 =/= T2 -> %% a 'term'. join_list(T1, T2). -%% Merges types of literals. Note that the left argument must either be a +join_tuple_elements(Limit, EsA, EsB) -> + Es0 = join_elements(EsA, EsB), + maps:filter(fun(Index, _Type) -> Index =< Limit end, Es0). + +join_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + join_elements_1(Keys, Es1, Es2, #{}). + +join_elements_1([Key | Keys], Es1, Es2, Acc0) -> + Type = case {Es1, Es2} of + {#{ Key := Same }, #{ Key := Same }} -> Same; + {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); + {#{}, #{}} -> term + end, + Acc = set_element_type(Key, Type, Acc0), + join_elements_1(Keys, Es1, Es2, Acc); +join_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% Joins types of literals; note that the left argument must either be a %% literal or exactly equal to the second argument. join_literal(Same, Same) -> Same; -join_literal({literal,[_|_]}, T) -> - join_literal(T, cons); -join_literal({literal,#{}}, T) -> - join_literal(T, map); -join_literal({literal,Tuple}, T) when is_tuple(Tuple) -> - join_literal(T, {tuple, tuple_size(Tuple)}); -join_literal({literal,_}, T) -> - %% Bitstring, fun, or similar. - join_literal(T, term); +join_literal({literal,_}=Lit, T) -> + join_literal(T, get_literal_type(Lit)); join_literal(T1, T2) -> %% We're done extracting the types, try merging them again. join(T1, T2). @@ -1959,14 +2180,14 @@ join_list(_, _) -> %% Not a list, so it must be a term. term. +join_bool([]) -> {atom,[]}; +join_bool(true) -> bool; +join_bool(false) -> bool; +join_bool(_) -> {atom,[]}. + tuple_sz([Sz]) -> Sz; tuple_sz(Sz) -> Sz. -merge_bool([]) -> {atom,[]}; -merge_bool(true) -> bool; -merge_bool(false) -> bool; -merge_bool(_) -> {atom,[]}. - merge_aliases(Al0, Al1) when map_size(Al0) =< map_size(Al1) -> maps:filter(fun(K, V) -> case Al1 of @@ -1977,44 +2198,78 @@ merge_aliases(Al0, Al1) when map_size(Al0) =< map_size(Al1) -> merge_aliases(Al0, Al1) -> merge_aliases(Al1, Al0). -verify_y_init(#vst{current=#st{y=Ys}}) -> - verify_y_init_1(gb_trees:to_list(Ys)). - -verify_y_init_1([]) -> ok; -verify_y_init_1([{Y,uninitialized}|_]) -> - error({uninitialized_reg,{y,Y}}); -verify_y_init_1([{Y,{fragile,_}}|_]) -> - %% Unsafe. This term may be outside any heap belonging - %% to the process and would be corrupted by a GC. - error({fragile_message_reference,{y,Y}}); -verify_y_init_1([{_,_}|Ys]) -> - verify_y_init_1(Ys). - -verify_live(0, #vst{}) -> ok; -verify_live(N, #vst{current=#st{x=Xs}}) -> - verify_live_1(N, Xs). - -verify_live_1(0, _) -> ok; -verify_live_1(N, Xs) when is_integer(N) -> - X = N-1, - case gb_trees:is_defined(X, Xs) of - false -> error({{x,X},not_live}); - true -> verify_live_1(X, Xs) +verify_y_init(#vst{current=#st{numy=NumY,y=Ys}}=Vst) + when is_integer(NumY), NumY > 0 -> + {HighestY, _} = gb_trees:largest(Ys), + true = NumY > HighestY, %Assertion. + verify_y_init_1(NumY - 1, Vst), + ok; +verify_y_init(#vst{current=#st{numy=undecided,y=Ys}}=Vst) -> + case gb_trees:is_empty(Ys) of + true -> + ok; + false -> + {HighestY, _} = gb_trees:largest(Ys), + verify_y_init_1(HighestY, Vst) end; -verify_live_1(N, _) -> error({bad_number_of_live_regs,N}). +verify_y_init(#vst{}) -> + ok. + +verify_y_init_1(-1, _Vst) -> + ok; +verify_y_init_1(Y, Vst) -> + Reg = {y, Y}, + case get_raw_type(Reg, Vst) of + uninitialized -> + error({uninitialized_reg,Reg}); + {fragile, _} -> + %% Unsafe. This term may be outside any heap belonging to the + %% process and would be corrupted by a GC. + error({fragile_message_reference,Reg}); + _ -> + verify_y_init_1(Y - 1, Vst) + end. + +verify_live(0, _Vst) -> + ok; +verify_live(Live, Vst) when is_integer(Live), 0 < Live, Live =< 1023 -> + verify_live_1(Live - 1, Vst); +verify_live(Live, _Vst) -> + error({bad_number_of_live_regs,Live}). -verify_no_ct(#vst{current=#st{numy=none}}) -> ok; +verify_live_1(-1, _) -> + ok; +verify_live_1(X, Vst) when is_integer(X) -> + Reg = {x, X}, + case get_raw_type(Reg, Vst) of + uninitialized -> error({Reg, not_live}); + _ -> verify_live_1(X - 1, Vst) + end. + +verify_no_ct(#vst{current=#st{numy=none}}) -> + ok; verify_no_ct(#vst{current=#st{numy=undecided}}) -> error(unknown_size_of_stackframe); -verify_no_ct(#vst{current=#st{y=Ys}}) -> - case [Y || Y <- gb_trees:to_list(Ys), verify_no_ct_1(Y)] of - [] -> ok; - CT -> error({unfinished_catch_try,CT}) +verify_no_ct(#vst{current=St}=Vst) -> + case collect_try_catch_tags(St#st.numy - 1, Vst, []) of + [_|_]=Bad -> error({unfinished_catch_try,Bad}); + [] -> ok end. -verify_no_ct_1({_, {catchtag, _}}) -> true; -verify_no_ct_1({_, {trytag, _}}) -> true; -verify_no_ct_1({_, _}) -> false. +%% Collects all try/catch tags, walking down from the Nth stack position. +collect_try_catch_tags(-1, _Vst, Acc) -> + Acc; +collect_try_catch_tags(Y, Vst, Acc0) -> + Tag = get_raw_type({y, Y}, Vst), + Acc = case is_try_catch_tag(Tag) of + true -> [{{y, Y}, Tag} | Acc0]; + false -> Acc0 + end, + collect_try_catch_tags(Y - 1, Vst, Acc). + +is_try_catch_tag({catchtag,_}) -> true; +is_try_catch_tag({trytag,_}) -> true; +is_try_catch_tag(_) -> false. eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) -> case Heap0-N of @@ -2043,7 +2298,7 @@ remove_fragility(#vst{current=#st{x=Xs0,y=Ys0}=St0}=Vst) -> propagate_fragility(Type, Ss, Vst) -> F = fun(S) -> - case get_term_type_1(S, Vst) of + case get_raw_type(S, Vst) of {fragile,_} -> true; _ -> false end @@ -2053,72 +2308,114 @@ propagate_fragility(Type, Ss, Vst) -> false -> Type end. -bif_type('-', Src, Vst) -> - arith_type(Src, Vst); -bif_type('+', Src, Vst) -> - arith_type(Src, Vst); -bif_type('*', Src, Vst) -> - arith_type(Src, Vst); -bif_type(abs, [Num], Vst) -> +%%% +%%% Return/argument types of BIFs +%%% + +bif_return_type('-', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('+', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('*', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type(abs, [Num], Vst) -> case get_durable_term_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number + {float,_}=T -> T; + {integer,_}=T -> T; + _ -> number end; -bif_type(float, _, _) -> {float,[]}; -bif_type('/', _, _) -> {float,[]}; +bif_return_type(float, _, _) -> {float,[]}; +bif_return_type('/', _, _) -> {float,[]}; %% Binary operations -bif_type('byte_size', _, _) -> {integer,[]}; -bif_type('bit_size', _, _) -> {integer,[]}; +bif_return_type('byte_size', _, _) -> {integer,[]}; +bif_return_type('bit_size', _, _) -> {integer,[]}; %% Integer operations. -bif_type(ceil, [_], _) -> {integer,[]}; -bif_type('div', [_,_], _) -> {integer,[]}; -bif_type(floor, [_], _) -> {integer,[]}; -bif_type('rem', [_,_], _) -> {integer,[]}; -bif_type(length, [_], _) -> {integer,[]}; -bif_type(size, [_], _) -> {integer,[]}; -bif_type(trunc, [_], _) -> {integer,[]}; -bif_type(round, [_], _) -> {integer,[]}; -bif_type('band', [_,_], _) -> {integer,[]}; -bif_type('bor', [_,_], _) -> {integer,[]}; -bif_type('bxor', [_,_], _) -> {integer,[]}; -bif_type('bnot', [_], _) -> {integer,[]}; -bif_type('bsl', [_,_], _) -> {integer,[]}; -bif_type('bsr', [_,_], _) -> {integer,[]}; +bif_return_type(ceil, [_], _) -> {integer,[]}; +bif_return_type('div', [_,_], _) -> {integer,[]}; +bif_return_type(floor, [_], _) -> {integer,[]}; +bif_return_type('rem', [_,_], _) -> {integer,[]}; +bif_return_type(length, [_], _) -> {integer,[]}; +bif_return_type(size, [_], _) -> {integer,[]}; +bif_return_type(trunc, [_], _) -> {integer,[]}; +bif_return_type(round, [_], _) -> {integer,[]}; +bif_return_type('band', [_,_], _) -> {integer,[]}; +bif_return_type('bor', [_,_], _) -> {integer,[]}; +bif_return_type('bxor', [_,_], _) -> {integer,[]}; +bif_return_type('bnot', [_], _) -> {integer,[]}; +bif_return_type('bsl', [_,_], _) -> {integer,[]}; +bif_return_type('bsr', [_,_], _) -> {integer,[]}; %% Booleans. -bif_type('==', [_,_], _) -> bool; -bif_type('/=', [_,_], _) -> bool; -bif_type('=<', [_,_], _) -> bool; -bif_type('<', [_,_], _) -> bool; -bif_type('>=', [_,_], _) -> bool; -bif_type('>', [_,_], _) -> bool; -bif_type('=:=', [_,_], _) -> bool; -bif_type('=/=', [_,_], _) -> bool; -bif_type('not', [_], _) -> bool; -bif_type('and', [_,_], _) -> bool; -bif_type('or', [_,_], _) -> bool; -bif_type('xor', [_,_], _) -> bool; -bif_type(is_atom, [_], _) -> bool; -bif_type(is_boolean, [_], _) -> bool; -bif_type(is_binary, [_], _) -> bool; -bif_type(is_float, [_], _) -> bool; -bif_type(is_function, [_], _) -> bool; -bif_type(is_integer, [_], _) -> bool; -bif_type(is_list, [_], _) -> bool; -bif_type(is_map, [_], _) -> bool; -bif_type(is_number, [_], _) -> bool; -bif_type(is_pid, [_], _) -> bool; -bif_type(is_port, [_], _) -> bool; -bif_type(is_reference, [_], _) -> bool; -bif_type(is_tuple, [_], _) -> bool; +bif_return_type('==', [_,_], _) -> bool; +bif_return_type('/=', [_,_], _) -> bool; +bif_return_type('=<', [_,_], _) -> bool; +bif_return_type('<', [_,_], _) -> bool; +bif_return_type('>=', [_,_], _) -> bool; +bif_return_type('>', [_,_], _) -> bool; +bif_return_type('=:=', [_,_], _) -> bool; +bif_return_type('=/=', [_,_], _) -> bool; +bif_return_type('not', [_], _) -> bool; +bif_return_type('and', [_,_], _) -> bool; +bif_return_type('or', [_,_], _) -> bool; +bif_return_type('xor', [_,_], _) -> bool; +bif_return_type(is_atom, [_], _) -> bool; +bif_return_type(is_boolean, [_], _) -> bool; +bif_return_type(is_binary, [_], _) -> bool; +bif_return_type(is_float, [_], _) -> bool; +bif_return_type(is_function, [_], _) -> bool; +bif_return_type(is_integer, [_], _) -> bool; +bif_return_type(is_list, [_], _) -> bool; +bif_return_type(is_map, [_], _) -> bool; +bif_return_type(is_number, [_], _) -> bool; +bif_return_type(is_pid, [_], _) -> bool; +bif_return_type(is_port, [_], _) -> bool; +bif_return_type(is_reference, [_], _) -> bool; +bif_return_type(is_tuple, [_], _) -> bool; %% Misc. -bif_type(tuple_size, [_], _) -> {integer,[]}; -bif_type(node, [], _) -> {atom,[]}; -bif_type(node, [_], _) -> {atom,[]}; -bif_type(hd, [_], _) -> term; -bif_type(tl, [_], _) -> term; -bif_type(get, [_], _) -> term; -bif_type(Bif, _, _) when is_atom(Bif) -> term. +bif_return_type(tuple_size, [_], _) -> {integer,[]}; +bif_return_type(node, [], _) -> {atom,[]}; +bif_return_type(node, [_], _) -> {atom,[]}; +bif_return_type(hd, [_], _) -> term; +bif_return_type(tl, [_], _) -> term; +bif_return_type(get, [_], _) -> term; +bif_return_type(Bif, _, _) when is_atom(Bif) -> term. + +%% Generic +bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; +bif_arg_types(map_size, [_]) -> [map]; +bif_arg_types(is_map_key, [_,_]) -> [term, map]; +bif_arg_types(map_get, [_,_]) -> [term, 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]. is_bif_safe('/=', 2) -> true; is_bif_safe('<', 2) -> true; @@ -2147,14 +2444,14 @@ is_bif_safe(self, 0) -> true; is_bif_safe(node, 0) -> true; is_bif_safe(_, _) -> false. -arith_type([A], Vst) -> +arith_return_type([A], Vst) -> %% Unary '+' or '-'. case get_durable_term_type(A, Vst) of {integer,_} -> {integer,[]}; {float,_} -> {float,[]}; _ -> number end; -arith_type([A,B], Vst) -> +arith_return_type([A,B], Vst) -> TypeA = get_durable_term_type(A, Vst), TypeB = get_durable_term_type(B, Vst), case {TypeA, TypeB} of @@ -2163,80 +2460,145 @@ arith_type([A,B], Vst) -> {_,{float,_}} -> {float,[]}; {_,_} -> number end; -arith_type(_, _) -> number. +arith_return_type(_, _) -> number. + +%%% +%%% Return/argument types of calls +%%% -return_type({extfunc,M,F,A}, Vst) -> return_type_1(M, F, A, Vst); -return_type(_, _) -> term. +call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); +call_return_type(_, _) -> term. -return_type_1(erlang, setelement, 3, Vst) -> - Tuple = {x,1}, +call_return_type_1(erlang, setelement, 3, Vst) -> + IndexType = get_term_type({x,0}, Vst), TupleType = - case get_term_type(Tuple, Vst) of - {tuple,_}=TT -> - TT; - {literal,Lit} when is_tuple(Lit) -> - {tuple,tuple_size(Lit)}; - _ -> - {tuple,[0]} - end, - case get_term_type({x,0}, Vst) of - {integer,[]} -> - TupleType; - {integer,I} -> - case meet({tuple,[I]}, TupleType) of - none -> TupleType; - T -> T + case get_term_type({x,1}, Vst) of + {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit); + {tuple,_,_}=TT -> TT; + _ -> {tuple,[0],#{}} + end, + case IndexType of + {integer,I} when is_integer(I) -> + case meet({tuple,[I],#{}}, TupleType) of + {tuple, Sz, Es0} -> + ValueType = get_term_type({x,2}, Vst), + Es = set_element_type(I, ValueType, Es0), + {tuple, Sz, Es}; + none -> + TupleType end; _ -> - TupleType + %% The index could point anywhere, so we must discard all element + %% information. + setelement(3, TupleType, #{}) end; -return_type_1(erlang, '++', 2, Vst) -> +call_return_type_1(erlang, '++', 2, Vst) -> case get_term_type({x,0}, Vst) =:= cons orelse get_term_type({x,1}, Vst) =:= cons of true -> cons; false -> list end; -return_type_1(erlang, '--', 2, _Vst) -> +call_return_type_1(erlang, '--', 2, _Vst) -> list; -return_type_1(erlang, F, A, _) -> - return_type_erl(F, A); -return_type_1(math, F, A, _) -> - return_type_math(F, A); -return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> +call_return_type_1(erlang, F, A, _) -> + erlang_mod_return_type(F, A); +call_return_type_1(lists, F, A, Vst) -> + lists_mod_return_type(F, A, Vst); +call_return_type_1(math, F, A, _) -> + math_mod_return_type(F, A); +call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> term. -return_type_erl(exit, 1) -> exception; -return_type_erl(throw, 1) -> exception; -return_type_erl(error, 1) -> exception; -return_type_erl(error, 2) -> exception; -return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -return_type_math(cos, 1) -> {float,[]}; -return_type_math(cosh, 1) -> {float,[]}; -return_type_math(sin, 1) -> {float,[]}; -return_type_math(sinh, 1) -> {float,[]}; -return_type_math(tan, 1) -> {float,[]}; -return_type_math(tanh, 1) -> {float,[]}; -return_type_math(acos, 1) -> {float,[]}; -return_type_math(acosh, 1) -> {float,[]}; -return_type_math(asin, 1) -> {float,[]}; -return_type_math(asinh, 1) -> {float,[]}; -return_type_math(atan, 1) -> {float,[]}; -return_type_math(atanh, 1) -> {float,[]}; -return_type_math(erf, 1) -> {float,[]}; -return_type_math(erfc, 1) -> {float,[]}; -return_type_math(exp, 1) -> {float,[]}; -return_type_math(log, 1) -> {float,[]}; -return_type_math(log2, 1) -> {float,[]}; -return_type_math(log10, 1) -> {float,[]}; -return_type_math(sqrt, 1) -> {float,[]}; -return_type_math(atan2, 2) -> {float,[]}; -return_type_math(pow, 2) -> {float,[]}; -return_type_math(ceil, 1) -> {float,[]}; -return_type_math(floor, 1) -> {float,[]}; -return_type_math(fmod, 2) -> {float,[]}; -return_type_math(pi, 0) -> {float,[]}; -return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. +erlang_mod_return_type(exit, 1) -> exception; +erlang_mod_return_type(throw, 1) -> exception; +erlang_mod_return_type(error, 1) -> exception; +erlang_mod_return_type(error, 2) -> exception; +erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +math_mod_return_type(cos, 1) -> {float,[]}; +math_mod_return_type(cosh, 1) -> {float,[]}; +math_mod_return_type(sin, 1) -> {float,[]}; +math_mod_return_type(sinh, 1) -> {float,[]}; +math_mod_return_type(tan, 1) -> {float,[]}; +math_mod_return_type(tanh, 1) -> {float,[]}; +math_mod_return_type(acos, 1) -> {float,[]}; +math_mod_return_type(acosh, 1) -> {float,[]}; +math_mod_return_type(asin, 1) -> {float,[]}; +math_mod_return_type(asinh, 1) -> {float,[]}; +math_mod_return_type(atan, 1) -> {float,[]}; +math_mod_return_type(atanh, 1) -> {float,[]}; +math_mod_return_type(erf, 1) -> {float,[]}; +math_mod_return_type(erfc, 1) -> {float,[]}; +math_mod_return_type(exp, 1) -> {float,[]}; +math_mod_return_type(log, 1) -> {float,[]}; +math_mod_return_type(log2, 1) -> {float,[]}; +math_mod_return_type(log10, 1) -> {float,[]}; +math_mod_return_type(sqrt, 1) -> {float,[]}; +math_mod_return_type(atan2, 2) -> {float,[]}; +math_mod_return_type(pow, 2) -> {float,[]}; +math_mod_return_type(ceil, 1) -> {float,[]}; +math_mod_return_type(floor, 1) -> {float,[]}; +math_mod_return_type(fmod, 2) -> {float,[]}; +math_mod_return_type(pi, 0) -> {float,[]}; +math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +lists_mod_return_type(dropwhile, 2, _Vst) -> + list; +lists_mod_return_type(duplicate, 2, _Vst) -> + list; +lists_mod_return_type(filter, 2, _Vst) -> + list; +lists_mod_return_type(flatten, 2, _Vst) -> + list; +lists_mod_return_type(map, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> + ListType = same_length_type({x,2}, Vst), + {tuple,2,#{1=>ListType}}; +lists_mod_return_type(partition, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(reverse, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(seq, 2, _Vst) -> + list; +lists_mod_return_type(seq, 3, _Vst) -> + list; +lists_mod_return_type(sort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(sort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(splitwith, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(takewhile, 2, _Vst) -> + list; +lists_mod_return_type(unzip, 1, Vst) -> + ListType = same_length_type({x,0}, Vst), + two_tuple(ListType, ListType); +lists_mod_return_type(usort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(usort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(zip, 2, _Vst) -> + list; +lists_mod_return_type(zip3, 3, _Vst) -> + list; +lists_mod_return_type(zipwith, 3, _Vst) -> + list; +lists_mod_return_type(zipwith3, 4, _Vst) -> + list; +lists_mod_return_type(_, _, _) -> + term. + +two_tuple(Type1, Type2) -> + {tuple,2,#{1=>Type1,2=>Type2}}. + +same_length_type(Reg, Vst) -> + case get_term_type(Reg, Vst) of + {literal,[_|_]} -> cons; + cons -> cons; + nil -> nil; + _ -> list + end. check_limit({x,X}) when is_integer(X), X < 1023 -> %% Note: x(1023) is reserved for use by the BEAM loader. @@ -2251,6 +2613,6 @@ check_limit(_) -> min(A, B) when is_integer(A), is_integer(B), A < B -> A; min(A, B) when is_integer(A), is_integer(B) -> B. -gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)). +gb_trees_from_list(L) -> gb_trees:from_orddict(sort(L)). error(Error) -> throw(Error). 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/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 43c99be982..7e219da0af 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -961,18 +961,12 @@ fold_lit_args(Call, Module, Name, Args0) -> %% fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) -> eval_is_boolean(Call, Arg, Sub); -fold_non_lit_args(Call, erlang, element, [Arg1,Arg2], Sub) -> - eval_element(Call, Arg1, Arg2, Sub); fold_non_lit_args(Call, erlang, length, [Arg], _) -> eval_length(Call, Arg); fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); -fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) -> - eval_setelement(Call, Arg1, Arg2, Arg3); -fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) -> - eval_is_record(Call, Arg1, Arg2, Arg3, Sub); fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) -> eval_is_function_1(Call, Arg1, Sub); fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) -> @@ -1141,96 +1135,6 @@ eval_append(Call, #c_cons{anno=Anno,hd=H,tl=T}, List) -> eval_append(Call, X, Y) -> Call#c_call{args=[X,Y]}. %Rebuild call arguments. -%% eval_element(Call, Pos, Tuple, Types) -> Val. -%% Evaluates element/2 if the position Pos is a literal and -%% the shape of the tuple Tuple is known. -%% -eval_element(Call, #c_literal{val=Pos}, Tuple, Types) - when is_integer(Pos) -> - case get_type(Tuple, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - if - 1 =< Pos, Pos =< length(Es) -> - El = lists:nth(Pos, Es), - try - cerl:set_ann(pat_to_expr(El), [compiler_generated]) - catch - throw:impossible -> - Call - end; - true -> - %% Index outside tuple or not a tuple. - eval_failure(Call, badarg) - end - end; -eval_element(Call, Pos, Tuple, Sub) -> - case is_int_type(Pos, Sub) =:= no orelse - is_tuple_type(Tuple, Sub) =:= no of - true -> - eval_failure(Call, badarg); - false -> - Call - end. - -%% eval_is_record(Call, Var, Tag, Size, Types) -> Val. -%% Evaluates is_record/3 using type information. -%% -eval_is_record(Call, Term, #c_literal{val=NeededTag}, - #c_literal{val=Size}, Types) -> - case get_type(Term, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - case Es of - [#c_literal{val=Tag}|_] -> - Bool = Tag =:= NeededTag andalso - length(Es) =:= Size, - #c_literal{val=Bool}; - _ -> - #c_literal{val=false} - end - end; -eval_is_record(Call, _, _, _, _) -> Call. - -%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. -%% Evaluates setelement/3 if position Pos is an integer -%% and the shape of the tuple Tuple is known. -%% -eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) - when is_integer(Pos) -> - case cerl:is_data(Tuple) of - false -> - Call; - true -> - Es0 = case cerl:is_c_tuple(Tuple) of - false -> []; - true -> cerl:tuple_es(Tuple) - end, - if - 1 =< Pos, Pos =< length(Es0) -> - Es = eval_setelement_1(Pos, Es0, NewVal), - cerl:update_c_tuple(Tuple, Es); - true -> - eval_failure(Call, badarg) - end - end; -eval_setelement(Call, _, _, _) -> Call. - -eval_setelement_1(1, [_|T], NewVal) -> - [NewVal|T]; -eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_1(Pos-1, T, NewVal)]. - %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with %% a call to erlang:error(Reason). @@ -1290,16 +1194,15 @@ clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) -> end. clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> - Sub2 = update_types(Cexpr, Ps1, Sub1), GSub = case {Cexpr,Ps1,G0} of {_,_,#c_literal{}} -> %% No need for substitution tricks when the guard %% does not contain any variables. - Sub2; + Sub1; {#c_var{name='_'},_,_} -> %% In a 'receive', Cexpr is the variable '_', which represents the %% message being matched. We must NOT do any extra substiutions. - Sub2; + Sub1; {#c_var{},[#c_var{}=Var],_} -> %% The idea here is to optimize expressions such as %% @@ -1321,16 +1224,16 @@ clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> %% case cerl:is_c_fname(Cexpr) of false -> - sub_set_var(Var, Cexpr, Sub2); + sub_set_var(Var, Cexpr, Sub1); true -> %% We must not copy funs, and especially not into guards. - Sub2 + Sub1 end; _ -> - Sub2 + Sub1 end, G1 = guard(G0, GSub), - B1 = body(B0, Ctxt, Sub2), + B1 = body(B0, Ctxt, Sub1), Cl#c_clause{pats=Ps1,guard=G1,body=B1}. %% let_substs(LetVars, LetArg, Sub) -> {[Var],[Val],Sub}. @@ -1414,8 +1317,7 @@ pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) -> {Pat#c_binary{segments=V1},Osub1}; pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) -> {V1,Osub1} = pattern(V0, Isub, Osub0), - {P1,Osub2} = pattern(P0, Isub, Osub1), - Osub = update_types(V1, [P1], Osub2), + {P1,Osub} = pattern(P0, Isub, Osub1), {Pat#c_alias{var=V1,pat=P1},Osub}. map_pair_pattern_list(Ps0, Isub, Osub0) -> @@ -2137,14 +2039,9 @@ case_expand_var(E, #sub{t=Tdb}) -> %% encountered. coerce_to_data(C) -> - case cerl:is_c_alias(C) of - false -> - case cerl:is_data(C) orelse cerl:is_c_var(C) of - true -> C; - false -> throw(impossible) - end; - true -> - coerce_to_data(cerl:alias_pat(C)) + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) end. %% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' @@ -3140,14 +3037,6 @@ is_int_type(Var, Sub) -> C -> yes_no(cerl:is_c_int(C)) end. --spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_tuple_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> maybe; - C -> yes_no(cerl:is_c_tuple(C)) - end. - yes_no(true) -> yes; yes_no(false) -> no. @@ -3209,27 +3098,23 @@ returns_integer(_, _) -> false. %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. --spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). +-spec update_types(cerl:c_var(), [type_info()], sub()) -> sub(). -update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> - Tdb = update_types_1(Expr, Pat, Tdb0), +update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) -> + Tdb = update_types_1(V, Pat, Tdb0), Sub#sub{t=Tdb}. -update_types_1(#c_var{name=V}, Pat, Types) -> - update_types_2(V, Pat, Types); -update_types_1(_, _, Types) -> Types. - -update_types_2(V, [#c_tuple{}=P], Types) -> +update_types_1(V, [#c_tuple{}=P], Types) -> Types#{V=>P}; -update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> +update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> Types#{V=>bool}; -update_types_2(V, [#c_fun{vars=Vars}], Types) -> +update_types_1(V, [#c_fun{vars=Vars}], Types) -> Types#{V=>{'fun',length(Vars)}}; -update_types_2(V, [#c_var{name={_,Arity}}], Types) -> +update_types_1(V, [#c_var{name={_,Arity}}], Types) -> Types#{V=>{'fun',Arity}}; -update_types_2(V, [Type], Types) when is_atom(Type) -> +update_types_1(V, [Type], Types) when is_atom(Type) -> Types#{V=>Type}; -update_types_2(_, _, Types) -> Types. +update_types_1(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, 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. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index f042a5cb51..db8eb7e2e1 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -107,6 +107,8 @@ CORE_MODULES = \ NO_MOD_OPT = $(NO_OPT) +NO_SSA_OPT = $(NO_OPT) + NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl) POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE) @@ -117,6 +119,8 @@ R21_MODULES= $(R21:%=%_r21_SUITE) R21_ERL_FILES= $(R21_MODULES:%=%.erl) NO_MOD_OPT_MODULES= $(NO_MOD_OPT:%=%_no_module_opt_SUITE) NO_MOD_OPT_ERL_FILES= $(NO_MOD_OPT_MODULES:%=%.erl) +NO_SSA_OPT_MODULES= $(NO_SSA_OPT:%=%_no_ssa_opt_SUITE) +NO_SSA_OPT_ERL_FILES= $(NO_SSA_OPT_MODULES:%=%.erl) ERL_FILES= $(MODULES:%=%.erl) CORE_FILES= $(CORE_MODULES:%=%.core) @@ -145,13 +149,16 @@ EBIN = . # Targets # ---------------------------------------------------- -make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ +make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(NO_SSA_OPT_ERL_FILES) \ $(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ > $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt \ +no_ssa_opt +no_recv_opt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +no_share_opt +no_bsm_opt +no_fun_opt \ + +no_ssa_opt +no_recv_opt $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(NO_SSA_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(POST_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +inline $(ERL_COMPILE_FLAGS) \ @@ -180,6 +187,9 @@ docs: %_no_opt_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ +%_no_ssa_opt_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + %_post_opt_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ @@ -205,7 +215,8 @@ release_tests_spec: make_emakefile $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ $(INLINE_ERL_FILES) $(R21_ERL_FILES) \ - $(NO_MOD_OPT_ERL_FILES) "$(RELSYSDIR)" + $(NO_MOD_OPT_ERL_FILES) \ + $(NO_SSA_OPT_ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)" for file in $(ERL_DUMMY_FILES); do \ module=`basename $$file .erl`; \ diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 585d0e7191..2660bf222c 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -159,7 +159,7 @@ merge_undefined(Config) when is_list(Config) -> [{{t,handle_call,2}, {{call_ext,1,{extfunc,erlang,exit,1}}, 10, - {uninitialized_reg,{y,0}}}}] = Errors, + {uninitialized_reg,{y,_}}}}] = Errors, ok. uninit(Config) when is_list(Config) -> @@ -211,16 +211,16 @@ bad_catch_try(Config) when is_list(Config) -> Errors = do_val(bad_catch_try, Config), [{{bad_catch_try,bad_1,1}, {{'catch',{x,0},{f,3}}, - 5,{invalid_store,{x,0},{catchtag,[3]}}}}, + 5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_2,1}, {{catch_end,{x,9}}, - 8,{source_not_y_reg,{x,9}}}}, + 8,{invalid_tag_register,{x,9}}}}, {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, + {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}}, {{bad_catch_try,bad_4,1}, - {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, + {{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{bad_type,term}}}, + {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}}, {{bad_catch_try,bad_6,1}, {{move,{integer,1},{y,1}},7, {invalid_store,{y,1},{integer,1}}}}] = Errors, @@ -539,37 +539,37 @@ receive_stacked(Config) -> [{{receive_stacked,f1,0}, {{loop_rec_end,{f,3}}, 17, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f2,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f3,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f4,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f5,0}, {{loop_rec_end,{f,23}}, 23, - {fragile_message_reference,{y,1}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f6,0}, - {{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}}, + {{gc_bif,byte_size,{f,29},0,[{y,_}],{x,0}}, 12, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f7,0}, {{loop_rec_end,{f,33}}, 20, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f8,0}, {{loop_rec_end,{f,38}}, 20, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,m1,0}, {{loop_rec_end,{f,43}}, 19, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,m2,0}, {{loop_rec_end,{f,48}}, 33, - {fragile_message_reference,{y,0}}}}] = Errors, + {fragile_message_reference,{y,_}}}}] = Errors, %% Compile the original source code as a smoke test. Data = proplists:get_value(data_dir, Config), diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl index 42ba5d5365..423a7666af 100644 --- a/lib/compiler/test/bif_SUITE.erl +++ b/lib/compiler/test/bif_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, - beam_validator/1,trunc_and_friends/1,cover_safe_bifs/1]). + beam_validator/1,trunc_and_friends/1,cover_safe_and_pure_bifs/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -35,7 +35,7 @@ groups() -> [{p,[parallel], [beam_validator, trunc_and_friends, - cover_safe_bifs + cover_safe_and_pure_bifs ]}]. init_per_suite(Config) -> @@ -106,7 +106,7 @@ trunc_template(Func, Bif) -> catch error:badarg -> ok end, ok."). -cover_safe_bifs(Config) -> +cover_safe_and_pure_bifs(Config) -> _ = get(), _ = get_keys(a), _ = group_leader(), @@ -118,5 +118,6 @@ cover_safe_bifs(Config) -> _ = processes(), _ = registered(), _ = term_to_binary(Config), + 42 = list_to_integer("2A", 16), ok. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index dade5d20d5..408af80dd9 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -28,7 +28,7 @@ init_per_group/2,end_per_group/2, app_test/1,appup_test/1, debug_info/4, custom_debug_info/1, custom_compile_info/1, - file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, + file_1/1, forms_2/1, module_mismatch/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, other_output/1, kernel_listing/1, encrypted_abstr/1, strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1, @@ -46,7 +46,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> all_return_type(). all() -> - [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, + [app_test, appup_test, file_1, forms_2, module_mismatch, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, kernel_listing, encrypted_abstr, tuple_calls, strict_record, utf8_atoms, utf8_functions, extra_chunks, @@ -104,6 +104,7 @@ file_1(Config) when is_list(Config) -> compile_and_verify(Simple, Target, []), compile_and_verify(Simple, Target, [native]), compile_and_verify(Simple, Target, [debug_info]), + compile_and_verify(Simple, Target, [no_postopt]), {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage {ok,simple} = compile:file(Simple, [{eprof,beam_z}]), %Coverage @@ -231,17 +232,6 @@ module_mismatch(Config) when is_list(Config) -> ok. -big_file(Config) when is_list(Config) -> - {Big,Target} = get_files(Config, big, "big_file"), - ok = file:set_cwd(filename:dirname(Target)), - compile_and_verify(Big, Target, []), - compile_and_verify(Big, Target, [debug_info]), - compile_and_verify(Big, Target, [no_postopt]), - - %% Cleanup. - ok = file:delete(Target), - ok. - %% Tests that the {outdir, Dir} option works. outdir(Config) when is_list(Config) -> @@ -370,42 +360,37 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> TargetDir = filename:join(PrivDir, listings), ok = file:make_dir(TargetDir), - %% Test all dedicated listing options. - do_listing(Simple, TargetDir, 'S'), - do_listing(Simple, TargetDir, 'E'), - do_listing(Simple, TargetDir, 'P'), - do_listing(Simple, TargetDir, dpp, ".pp"), - do_listing(Simple, TargetDir, dabstr, ".abstr"), - do_listing(Simple, TargetDir, dexp, ".expand"), - do_listing(Simple, TargetDir, dcore, ".core"), - do_listing(Simple, TargetDir, doldinline, ".oldinline"), - do_listing(Simple, TargetDir, dinline, ".inline"), - do_listing(Simple, TargetDir, dcore, ".core"), - do_listing(Simple, TargetDir, dcopt, ".copt"), - do_listing(Simple, TargetDir, dcbsm, ".core_bsm"), - do_listing(Simple, TargetDir, dsetel, ".dsetel"), - do_listing(Simple, TargetDir, dkern, ".kernel"), - do_listing(Simple, TargetDir, dssa, ".ssa"), - do_listing(Simple, TargetDir, dssaopt, ".ssaopt"), - do_listing(Simple, TargetDir, dprecg, ".precodegen"), - do_listing(Simple, TargetDir, dcg, ".codegen"), - do_listing(Simple, TargetDir, dblk, ".block"), - do_listing(Simple, TargetDir, dexcept, ".except"), - do_listing(Simple, TargetDir, djmp, ".jump"), - do_listing(Simple, TargetDir, dclean, ".clean"), - do_listing(Simple, TargetDir, dpeep, ".peep"), - do_listing(Simple, TargetDir, dopt, ".optimize"), - do_listing(Simple, TargetDir, diffable, ".S"), - - %% First clean up. - Listings = filename:join(PrivDir, listings), - lists:foreach(fun(F) -> ok = file:delete(F) end, - filelib:wildcard(filename:join(Listings, "*"))), + List = [{'S',".S"}, + {'E',".E"}, + {'P',".P"}, + {dpp, ".pp"}, + {dabstr, ".abstr"}, + {dexp, ".expand"}, + {dcore, ".core"}, + {doldinline, ".oldinline"}, + {dinline, ".inline"}, + {dcore, ".core"}, + {dcopt, ".copt"}, + {dcbsm, ".core_bsm"}, + {dkern, ".kernel"}, + {dssa, ".ssa"}, + {dssaopt, ".ssaopt"}, + {dprecg, ".precodegen"}, + {dcg, ".codegen"}, + {dblk, ".block"}, + {dexcept, ".except"}, + {djmp, ".jump"}, + {dclean, ".clean"}, + {dpeep, ".peep"}, + {dopt, ".optimize"}, + {diffable, ".S"}], + p_listings(List, Simple, TargetDir), %% Test options that produce a listing file if 'binary' is not given. do_listing(Simple, TargetDir, to_pp, ".P"), do_listing(Simple, TargetDir, to_exp, ".E"), do_listing(Simple, TargetDir, to_core0, ".core"), + Listings = filename:join(PrivDir, listings), ok = file:delete(filename:join(Listings, File ++ ".core")), do_listing(Simple, TargetDir, to_core, ".core"), do_listing(Simple, TargetDir, to_kernel, ".kernel"), @@ -421,24 +406,35 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> listings_big(Config) when is_list(Config) -> {Big,Target} = get_files(Config, big, listings_big), TargetDir = filename:dirname(Target), - do_listing(Big, TargetDir, 'S'), - do_listing(Big, TargetDir, 'E'), - do_listing(Big, TargetDir, 'P'), - do_listing(Big, TargetDir, dkern, ".kernel"), - do_listing(Big, TargetDir, dssa, ".ssa"), - do_listing(Big, TargetDir, dssaopt, ".ssaopt"), - do_listing(Big, TargetDir, dprecg, ".precodegen"), - do_listing(Big, TargetDir, to_dis, ".dis"), - - TargetNoext = filename:rootname(Target, code:objfile_extension()), - {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]), - - %% Cleanup. - ok = file:delete(Target), - lists:foreach(fun(F) -> ok = file:delete(F) end, - filelib:wildcard(filename:join(TargetDir, "*"))), - ok = file:del_dir(TargetDir), - ok. + List = [{'S',".S"}, + {'E',".E"}, + {'P',".P"}, + {dkern, ".kernel"}, + {dssa, ".ssa"}, + {dssaopt, ".ssaopt"}, + {dprecg, ".precodegen"}, + {to_dis, ".dis"}], + p_listings(List, Big, TargetDir). + +p_listings(List, File, BaseDir) -> + Run = fun({Option,Extension}) -> + Uniq = erlang:unique_integer([positive]), + Dir = filename:join(BaseDir, integer_to_list(Uniq)), + ok = file:make_dir(Dir), + try + do_listing(File, Dir, Option, Extension), + ok + catch + Class:Error:Stk -> + io:format("~p:~p\n~p\n", [Class,Error,Stk]), + error + after + _ = [ok = file:delete(F) || + F <- filelib:wildcard(filename:join(Dir, "*"))], + ok = file:del_dir(Dir) + end + end, + test_lib:p_run(Run, List). other_output(Config) when is_list(Config) -> {Simple,_Target} = get_files(Config, simple, "other_output"), @@ -685,9 +681,6 @@ cover(Config) when is_list(Config) -> io:format("~p\n", [compile:options()]), ok. -do_listing(Source, TargetDir, Type) -> - do_listing(Source, TargetDir, Type, "." ++ atom_to_list(Type)). - do_listing(Source, TargetDir, Type, Ext) -> io:format("Source: ~p TargetDir: ~p\n Type: ~p Ext: ~p\n", [Source, TargetDir, Type, Ext]), diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover index 3fd7fc1937..fac0f9947c 100644 --- a/lib/compiler/test/compiler.cover +++ b/lib/compiler/test/compiler.cover @@ -1,5 +1,4 @@ -{incl_app,compiler,details}. - %% -*- erlang -*- +{local_only,compiler,true}. +{incl_app,compiler,details}. {excl_mods,compiler,[core_scan,core_parse]}. - diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index f700059d20..aff1a56c47 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -344,10 +344,8 @@ otp_7223_2({a}) -> 1. coverage(Config) when is_list(Config) -> - Mod = bsdecode, + Mod = attribute, Src = filename:join(proplists:get_value(data_dir, Config), Mod), {ok,Mod,_} = compile:file(Src, [binary,report,{inline,0}, clint,ssalint]), - {ok,Mod,_} = compile:file(Src, [binary,report,{inline,20}, - verbose,clint,ssalint]), ok. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 60ab969929..94bfbb0efe 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -25,7 +25,7 @@ match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1,literal_binary/1, - unary_op/1,eq_types/1]). + unary_op/1,eq_types/1,match_after_return/1]). -include_lib("common_test/include/ct.hrl"). @@ -40,7 +40,8 @@ groups() -> match_in_call,untuplify, shortcut_boolean,letify_guard,selectify,deselectify, underscore,match_map,map_vars_used,coverage, - grab_bag,literal_binary,unary_op,eq_types]}]. + grab_bag,literal_binary,unary_op,eq_types, + match_after_return]}]. init_per_suite(Config) -> @@ -890,5 +891,15 @@ eq_types(A, B) -> Ref22. +match_after_return(Config) when is_list(Config) -> + %% The return type of the following call will never match the 'wont_happen' + %% clauses below, and the beam_ssa_type was clever enough to see that but + %% didn't remove the blocks, so it crashed when trying to extract A. + ok = case mar_test_tuple(erlang:unique_integer()) of + {gurka, never_matches, A} -> {wont_happen, A}; + _ -> ok + end. + +mar_test_tuple(I) -> {gurka, I}. id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index e999c8ffae..a0b415ceaa 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -161,14 +161,13 @@ md5_1(Beam) -> %% Cover some code that handles internal errors. silly_coverage(Config) when is_list(Config) -> - %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel + %% sys_core_fold, sys_core_alias, sys_core_bsm, v3_kernel BadCoreErlang = {c_module,[], name,[],[], [{{c_var,[],{foo,2}},seriously_bad_body}]}, expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end), expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end), expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end), - expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), %% beam_kernel_to_ssa @@ -185,7 +184,6 @@ silly_coverage(Config) when is_list(Config) -> %% beam_ssa_recv %% beam_ssa_share %% beam_ssa_pre_codegen - %% beam_ssa_opt %% beam_ssa_codegen BadSSA = {b_module,#{},a,b,c, [{b_function,#{func_info=>{mod,foo,0}},args,bad_blocks,0}]}, @@ -193,9 +191,15 @@ silly_coverage(Config) when is_list(Config) -> expect_error(fun() -> beam_ssa_recv:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_share:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_pre_codegen:module(BadSSA, []) end), - expect_error(fun() -> beam_ssa_opt:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_codegen:module(BadSSA, []) end), + %% beam_ssa_opt + BadSSABlocks = #{0 => {b_blk,#{},[bad_code],{b_ret,#{},arg}}}, + BadSSAOpt = {b_module,#{},a,[],c, + [{b_function,#{func_info=>{mod,foo,0}},[], + BadSSABlocks,0}]}, + expect_error(fun() -> beam_ssa_opt:module(BadSSAOpt, []) end), + %% beam_ssa_lint, beam_ssa_pp {error,[{_,Errors}]} = beam_ssa_lint:module(bad_ssa_lint_input(), []), _ = [io:put_chars(Mod:format_error(Reason)) || diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 7fb4751b42..39c26c6142 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -50,12 +50,8 @@ smoke_disasm(File) when is_list(File) -> Res = beam_disasm:file(File), {beam_file,_Mod} = {element(1, Res),element(2, Res)}. -%% If we are running cover, we don't want to run test cases that -%% invokes the compiler in parallel, as doing so would probably -%% be slower than running them sequentially. - parallel() -> - case test_server:is_cover() orelse erlang:system_info(schedulers) =:= 1 of + case erlang:system_info(schedulers) =:= 1 of true -> []; false -> [parallel] end. @@ -70,21 +66,24 @@ uniq() -> opt_opts(Mod) -> Comp = Mod:module_info(compile), {options,Opts} = lists:keyfind(options, 1, Comp), - lists:filter(fun(no_copt) -> true; - (no_postopt) -> true; - (no_ssa_opt) -> true; - (no_recv_opt) -> true; - (no_ssa_float) -> true; - (no_stack_trimming) -> true; - (debug_info) -> true; - (inline) -> true; - (no_put_tuple2) -> true; - (no_bsm3) -> true; - (no_bsm_opt) -> true; - (no_module_opt) -> true; - (no_type_opt) -> true; - (_) -> false - end, Opts). + lists:filter(fun + (debug_info) -> true; + (inline) -> true; + (no_bsm3) -> true; + (no_bsm_opt) -> true; + (no_copt) -> true; + (no_fun_opt) -> true; + (no_module_opt) -> true; + (no_postopt) -> true; + (no_put_tuple2) -> true; + (no_recv_opt) -> true; + (no_share_opt) -> true; + (no_ssa_float) -> true; + (no_ssa_opt) -> true; + (no_stack_trimming) -> true; + (no_type_opt) -> true; + (_) -> false + end, Opts). %% Some test suites gets cloned (e.g. to "record_SUITE" to %% "record_no_opt_SUITE"), but the data directory is not cloned. @@ -97,7 +96,8 @@ get_data_dir(Config) -> Data2 = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts), Data3 = re:replace(Data2, "_inline_SUITE", "_SUITE", Opts), Data4 = re:replace(Data3, "_r21_SUITE", "_SUITE", Opts), - re:replace(Data4, "_no_module_opt_SUITE", "_SUITE", Opts). + Data = re:replace(Data4, "_no_module_opt_SUITE", "_SUITE", Opts), + re:replace(Data, "_no_ssa_opt_SUITE", "_SUITE", Opts). is_cloned_mod(Mod) -> is_cloned_mod_1(atom_to_list(Mod)). @@ -105,6 +105,7 @@ is_cloned_mod(Mod) -> %% Test whether Mod is a cloned module. is_cloned_mod_1("_no_opt_SUITE") -> true; +is_cloned_mod_1("_no_ssa_opt_SUITE") -> true; is_cloned_mod_1("_post_opt_SUITE") -> true; is_cloned_mod_1("_inline_SUITE") -> true; is_cloned_mod_1("_21_SUITE") -> true; @@ -117,18 +118,7 @@ is_cloned_mod_1([]) -> false. p_run(Test, List) -> S = erlang:system_info(schedulers), - N = case test_server:is_cover() of - false -> - S + 1; - true -> - %% Cover is running. Using too many processes - %% could slow us down. Measurements on my computer - %% showed that using 4 parallel processes was - %% slightly faster than using 3. Using more than - %% 4 would not buy us much and could actually be - %% slower. - min(S, 4) - end, + N = S + 1, io:format("p_run: ~p parallel processes\n", [N]), p_run_loop(Test, List, N, [], 0, 0). diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index c5d0bf8420..70b7100451 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -240,19 +240,7 @@ guard(Config) when is_list(Config) -> {4,sys_core_fold,nomatch_guard}, {6,sys_core_fold,no_clause_match}, {6,sys_core_fold,nomatch_guard}, - {6,sys_core_fold,{eval_failure,badarg}}, - {8,sys_core_fold,no_clause_match}, - {8,sys_core_fold,nomatch_guard}, - {8,sys_core_fold,{eval_failure,badarg}}, - {9,sys_core_fold,no_clause_match}, - {9,sys_core_fold,nomatch_guard}, - {9,sys_core_fold,{eval_failure,badarg}}, - {10,sys_core_fold,no_clause_match}, - {10,sys_core_fold,nomatch_guard}, - {10,sys_core_fold,{eval_failure,badarg}}, - {11,sys_core_fold,no_clause_match}, - {11,sys_core_fold,nomatch_guard}, - {11,sys_core_fold,{eval_failure,badarg}} + {6,sys_core_fold,{eval_failure,badarg}} ]}}], [] = run(Config, Ts), |