diff options
Diffstat (limited to 'lib/compiler/src')
25 files changed, 888 insertions, 689 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 7c4cebdc28..78efc8dff0 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -70,6 +70,7 @@ MODULES = \ cerl \ cerl_clauses \ cerl_inline \ + cerl_sets \ cerl_trees \ compile \ core_lib \ diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index dd7e03dd28..410f598665 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -91,6 +91,10 @@ 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,Op,F,[Ctx,Bits,{string,Str}]}) -> + %% When compiling from a .S file. + <<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_asm.erl b/lib/compiler/src/beam_asm.erl index f8cf178d2e..73694b96ce 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -132,10 +132,10 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> LiteralChunk = case beam_dict:literal_table(Dict) of {0,[]} -> []; {NumLiterals,LitTab0} -> - LitTab1 = iolist_to_binary(LitTab0), - LitTab2 = <<NumLiterals:32,LitTab1/binary>>, - LitTab = iolist_to_binary(zlib:compress(LitTab2)), - chunk(<<"LitT">>, <<(byte_size(LitTab2)):32>>, LitTab) + LitTab1 = [<<NumLiterals:32>>,LitTab0], + LitTab = zlib:compress(LitTab1), + chunk(<<"LitT">>, <<(iolist_size(LitTab1)):32>>, + LitTab) end, %% Create the line chunk. @@ -431,45 +431,35 @@ encode_alloc_list_1([], Dict, Acc) -> {iolist_to_binary(Acc),Dict}. encode(Tag, N) when N < 0 -> - encode1(Tag, negative_to_bytes(N, [])); + encode1(Tag, negative_to_bytes(N)); encode(Tag, N) when N < 16 -> (N bsl 4) bor Tag; encode(Tag, N) when N < 16#800 -> [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff]; encode(Tag, N) -> - encode1(Tag, to_bytes(N, [])). + encode1(Tag, to_bytes(N)). encode1(Tag, Bytes) -> - case length(Bytes) of + case iolist_size(Bytes) of Num when 2 =< Num, Num =< 8 -> [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes]; Num when 8 < Num -> [2#11111000 bor Tag, encode(?tag_u, Num-9)| Bytes] end. - -to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - 0 -> - to_bytes_1(N0, Acc); - N -> - to_bytes(N, binary_to_list(<<N0:Bits>>) ++ Acc) - end. - -to_bytes_1(0, [B|_]=Done) when B < 128 -> Done; -to_bytes_1(N, Acc) -> to_bytes(N bsr 8, [N band 16#ff|Acc]). - -negative_to_bytes(N0, Acc) -> - Bits = 3*128, - case N0 bsr Bits of - -1 -> - negative_to_bytes_1(N0, Acc); - N -> - negative_to_bytes_1(N, binary_to_list(<<N0:Bits>>) ++ Acc) +to_bytes(N) -> + Bin = binary:encode_unsigned(N), + case Bin of + <<0:1,_/bits>> -> Bin; + <<1:1,_/bits>> -> [0,Bin] end. -negative_to_bytes_1(-1, [B1,_B2|_]=Done) when B1 > 127 -> - Done; -negative_to_bytes_1(N, Acc) -> - negative_to_bytes_1(N bsr 8, [N band 16#ff|Acc]). +negative_to_bytes(N) when N >= -16#8000 -> + <<N:16>>; +negative_to_bytes(N) -> + Bytes = byte_size(binary:encode_unsigned(-N)), + Bin = <<N:Bytes/unit:8>>, + case Bin of + <<0:1,_/bits>> -> [16#ff,Bin]; + <<1:1,_/bits>> -> Bin + end. diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 5216f39296..e2639e9cac 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -61,15 +61,6 @@ blockify(Is) -> blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) -> %% Useless instruction sequence. blockify(Is, Acc); - -%% New bit syntax matching. -blockify([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is], Acc) -> - blockify([I|Is], Acc); -blockify([{bs_save2,R,Point}=I,{test,is_eq_exact,_,_}=Test, - {bs_restore2,R,Point}|Is], Acc) -> - blockify([I,Test|Is], Acc); - -%% Do other peep-hole optimizations. blockify([{test,is_atom,{f,Fail},[Reg]}=I| [{select,select_val,Reg,{f,Fail}, [{atom,false},{f,_}=BrFalse, diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index d54c2a9fde..ee3e88959d 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -20,7 +20,7 @@ -module(beam_bsm). -export([module/2,format_error/1]). --import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2,dropwhile/2]). +-import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2]). %%% %%% We optimize bit syntax matching where the tail end of a binary is @@ -242,6 +242,12 @@ btb_reaches_match_2([{bif,_,{f,F},Ss,Dst}=I|Is], Regs0, D0) -> Regs = btb_kill([Dst], Regs0), D = btb_follow_branch(F, Regs, D0), btb_reaches_match_1(Is, Regs, D); +btb_reaches_match_2([{get_map_elements,{f,F},Src,{list,Ls}}=I|Is], Regs0, D0) -> + {Ss,Ds} = beam_utils:split_even(Ls), + btb_ensure_not_used([Src|Ss], I, Regs0), + Regs = btb_kill(Ds, Regs0), + D = btb_follow_branch(F, Regs, D0), + btb_reaches_match_1(Is, Regs, D); btb_reaches_match_2([{test,bs_start_match2,{f,F},Live,[Ctx,_],Ctx}=I|Is], Regs0, D0) -> CtxRegs = btb_context_regs(Regs0), @@ -542,16 +548,13 @@ btb_context_regs_1(Regs, N, Tag, Acc) -> %% a binary. MustSave is true if the function may pass the match %% context to the bs_context_to_binary instruction (in which case %% the current position in the binary must have saved into the -%% start position using "bs_save_2 Ctx start". +%% start position using "bs_save_2 Ctx start"). btb_index(Fs) -> btb_index_1(Fs, []). btb_index_1([{function,_,_,Entry,Is0}|Fs], Acc0) -> - [{label,Entry}|Is] = - dropwhile(fun({label,L}) when L =:= Entry -> false; - (_) -> true - end, Is0), + Is = drop_to_label(Is0, Entry), Acc = btb_index_2(Is, Entry, false, Acc0), btb_index_1(Fs, Acc); btb_index_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). @@ -566,6 +569,9 @@ btb_index_2(Is0, Entry, _, Acc) -> throw:none -> Acc end. +drop_to_label([{label,L}|Is], L) -> Is; +drop_to_label([_|Is], L) -> drop_to_label(Is, L). + btb_index_find_start_match([{test,_,{f,F},_},{bs_context_to_binary,_}|Is]) -> btb_index_find_label(Is, F); btb_index_find_start_match(_) -> @@ -615,7 +621,7 @@ collect_warnings_instr([_|Is], D, Acc) -> collect_warnings_instr([], _, Acc) -> Acc. add_warning(Term, Anno, Ws) -> - Line = abs(get_line(Anno)), + Line = get_line(Anno), File = get_file(Anno), [{File,[{Line,?MODULE,Term}]}|Ws]. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index b68b8702e0..1d26993103 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -184,14 +184,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace(Fs, Dict, [{function,Name,Arity,Entry,Asm}|Acc]); function_replace([], _, Acc) -> Acc. -replace([{test,bs_match_string=Op,{f,Lbl},[Ctx,Bin0]}|Is], Acc, D) -> - Bits = bit_size(Bin0), - Bin = case Bits rem 8 of - 0 -> Bin0; - Rem -> <<Bin0/bitstring,0:(8-Rem)>> - end, - I = {test,Op,{f,label(Lbl, D)},[Ctx,Bits,{string,binary_to_list(Bin)}]}, - replace(Is, [I|Acc], D); replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D); replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) -> diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index f4515ba2a7..bbe607cf19 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -96,7 +96,7 @@ move_move_into_block([], Acc) -> reverse(Acc). %%% forward(Is, Lc) -> - forward(Is, gb_trees:empty(), Lc, []). + forward(Is, #{}, Lc, []). forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) -> %% move/2 followed by jump/1 is optimized by backward/3. @@ -115,19 +115,20 @@ forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, %% cannot be reached in any other way than through the select_val/3 %% instruction (i.e. there can be no fallthrough to such label and %% it cannot be referenced by, for example, a jump/1 instruction). - Block = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction. - _ -> Blk %Must keep move instruction. - end, + Key = {Lbl,Dst}, + Block = case D of + #{Key := Lit} -> {block,BlkIs}; %Safe to remove move instruction. + _ -> Blk %Must keep move instruction. + end, forward([Block|Is], D, Lc, [LblI|Acc]); forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> %% Assumption: The target labels in a select_val/3 instruction %% cannot be reached in any other way than through the select_val/3 %% instruction (i.e. there can be no fallthrough to such label and %% it cannot be referenced by, for example, a jump/1 instruction). - Is = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> Is1; %Safe to remove move instruction. - _ -> Is0 %Keep move instruction. + Is = case maps:find({Lbl,Dst}, D) of + {ok,Lit} -> Is1; %Safe to remove move instruction. + _ -> Is0 %Keep move instruction. end, forward(Is, D, Lc, [LblI|Acc]); forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) -> @@ -156,11 +157,11 @@ forward([], _, Lc, Acc) -> {Acc,Lc}. update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> Key = {Lbl,Reg}, - D = case gb_trees:lookup(Key, D0) of - none -> gb_trees:insert(Key, Lit, D0); %New. - {value,inconsistent} -> D0; %Inconsistent. - {value,_} -> gb_trees:update(Key, inconsistent, D0) - end, + D = case D0 of + #{Key := inconsistent} -> D0; + #{Key := _} -> D0#{Key := inconsistent}; + _ -> D0#{Key => Lit} + end, update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. @@ -255,6 +256,16 @@ backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) -> catch throw:not_possible -> backward(Is0, D, [J|Acc]) end; +backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D, + [{test,bs_match_string,F,[Ctxt,Bs]}, + {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) -> + case beam_utils:is_killed(Ctxt, Acc0, D) of + true -> + Eq = {test,is_eq_exact,F,[R,{literal,Bs}]}, + backward(Is, D, [Eq|Acc0]); + false -> + backward(Is, D, [I|Acc]) + end; backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> To = shortcut_bs_start_match(To0, Src, D), I = {test,bs_start_match2,{f,To},Live,Info,Dst}, @@ -459,8 +470,8 @@ count_bits_matched([{test,_,_,_,[_,Sz,U,{field_flags,_}],_}|Is], SavePoint, Bits {integer,N} -> count_bits_matched(Is, SavePoint, Bits+N*U); _ -> count_bits_matched(Is, SavePoint, Bits) end; -count_bits_matched([{test,bs_match_string,_,[_,Bits,_]}|Is], SavePoint, Bits0) -> - count_bits_matched(Is, SavePoint, Bits0+Bits); +count_bits_matched([{test,bs_match_string,_,[_,Bs]}|Is], SavePoint, Bits) -> + count_bits_matched(Is, SavePoint, Bits+bit_size(Bs)); count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> count_bits_matched(Is, SavePoint, Bits); count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index ea51673fa3..b1aa98278e 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -31,22 +31,22 @@ -type index() :: non_neg_integer(). --type atom_tab() :: gb_trees:tree(atom(), index()). +-type atom_tab() :: #{atom() => index()}. -type import_tab() :: gb_trees:tree(mfa(), index()). --type fname_tab() :: gb_trees:tree(Name :: term(), index()). --type line_tab() :: gb_trees:tree({Fname :: index(), Line :: term()}, index()). +-type fname_tab() :: #{Name :: term() => index()}. +-type line_tab() :: #{{Fname :: index(), Line :: term()} => index()}. -type literal_tab() :: dict:dict(Literal :: term(), index()). -record(asm, - {atoms = gb_trees:empty() :: atom_tab(), + {atoms = #{} :: atom_tab(), exports = [] :: [{label(), arity(), label()}], locals = [] :: [{label(), arity(), label()}], imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool lambdas = [], %[{...}] literals = dict:new() :: literal_tab(), - fnames = gb_trees:empty() :: fname_tab(), - lines = gb_trees:empty() :: line_tab(), + fnames = #{} :: fname_tab(), + lines = #{} :: line_tab(), num_lines = 0 :: non_neg_integer(), %Number of line instructions next_import = 0 :: non_neg_integer(), string_offset = 0 :: non_neg_integer(), @@ -65,7 +65,7 @@ new() -> %% Remember the highest opcode. -spec opcode(non_neg_integer(), bdict()) -> bdict(). -opcode(Op, Dict) when Dict#asm.highest_opcode > Op -> Dict; +opcode(Op, Dict) when Dict#asm.highest_opcode >= Op -> Dict; opcode(Op, Dict) -> Dict#asm{highest_opcode=Op}. %% Returns the highest opcode encountered. @@ -77,14 +77,12 @@ highest_opcode(#asm{highest_opcode=Op}) -> Op. %% atom(Atom, Dict) -> {Index,Dict'} -spec atom(atom(), bdict()) -> {pos_integer(), bdict()}. -atom(Atom, #asm{atoms=Atoms0}=Dict) when is_atom(Atom) -> - case gb_trees:lookup(Atom, Atoms0) of - {value,Index} -> - {Index,Dict}; - none -> - NextIndex = gb_trees:size(Atoms0) + 1, - Atoms = gb_trees:insert(Atom, NextIndex, Atoms0), - {NextIndex,Dict#asm{atoms=Atoms}} +atom(Atom, #asm{atoms=Atoms}=Dict) when is_atom(Atom) -> + case Atoms of + #{ Atom := Index} -> {Index,Dict}; + _ -> + NextIndex = maps:size(Atoms) + 1, + {NextIndex,Dict#asm{atoms=Atoms#{Atom=>NextIndex}}} end. %% Remembers an exported function. @@ -177,26 +175,22 @@ line([], #asm{num_lines=N}=Dict) -> %% No location available. Return the special pre-defined %% index 0. {0,Dict#asm{num_lines=N+1}}; -line([{location,Name,Line}], #asm{lines=Lines0,num_lines=N}=Dict0) -> +line([{location,Name,Line}], #asm{lines=Lines,num_lines=N}=Dict0) -> {FnameIndex,Dict1} = fname(Name, Dict0), - case gb_trees:lookup({FnameIndex,Line}, Lines0) of - {value,Index} -> - {Index,Dict1#asm{num_lines=N+1}}; - none -> - Index = gb_trees:size(Lines0) + 1, - Lines = gb_trees:insert({FnameIndex,Line}, Index, Lines0), - Dict = Dict1#asm{lines=Lines,num_lines=N+1}, - {Index,Dict} + Key = {FnameIndex,Line}, + case Lines of + #{Key := Index} -> {Index,Dict1#asm{num_lines=N+1}}; + _ -> + Index = maps:size(Lines) + 1, + {Index, Dict1#asm{lines=Lines#{Key=>Index},num_lines=N+1}} end. -fname(Name, #asm{fnames=Fnames0}=Dict) -> - case gb_trees:lookup(Name, Fnames0) of - {value,Index} -> - {Index,Dict}; - none -> - Index = gb_trees:size(Fnames0), - Fnames = gb_trees:insert(Name, Index, Fnames0), - {Index,Dict#asm{fnames=Fnames}} +fname(Name, #asm{fnames=Fnames}=Dict) -> + case Fnames of + #{Name := Index} -> {Index,Dict}; + _ -> + Index = maps:size(Fnames), + {Index,Dict#asm{fnames=Fnames#{Name=>Index}}} end. %% Returns the atom table. @@ -204,14 +198,12 @@ fname(Name, #asm{fnames=Fnames0}=Dict) -> -spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}. atom_table(#asm{atoms=Atoms}) -> - NumAtoms = gb_trees:size(Atoms), - Sorted = lists:keysort(2, gb_trees:to_list(Atoms)), - Fun = fun({A,_}) -> - L = atom_to_list(A), - [length(L)|L] - end, - AtomTab = lists:map(Fun, Sorted), - {NumAtoms,AtomTab}. + NumAtoms = maps:size(Atoms), + Sorted = lists:keysort(2, maps:to_list(Atoms)), + {NumAtoms,[begin + L = atom_to_list(A), + [length(L)|L] + end || {A,_} <- Sorted]}. %% Returns the table of local functions. %% local_table(Dict) -> {NumLocals, [{Function, Arity, Label}...]} @@ -273,11 +265,11 @@ my_term_to_binary(Term) -> non_neg_integer(),[{non_neg_integer(),non_neg_integer()}]}. line_table(#asm{fnames=Fnames0,lines=Lines0,num_lines=NumLineInstrs}) -> - NumFnames = gb_trees:size(Fnames0), - Fnames1 = lists:keysort(2, gb_trees:to_list(Fnames0)), + NumFnames = maps:size(Fnames0), + Fnames1 = lists:keysort(2, maps:to_list(Fnames0)), Fnames = [Name || {Name,_} <- Fnames1], - NumLines = gb_trees:size(Lines0), - Lines1 = lists:keysort(2, gb_trees:to_list(Lines0)), + NumLines = maps:size(Lines0), + Lines1 = lists:keysort(2, maps:to_list(Lines0)), Lines = [L || {L,_} <- Lines1], {NumLineInstrs,NumFnames,Fnames,NumLines,Lines}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index ba71d4efae..80b2998ddc 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -127,7 +127,7 @@ %%% on the program state. %%% --import(lists, [reverse/1,reverse/2,foldl/3,dropwhile/2]). +-import(lists, [reverse/1,reverse/2,foldl/3]). module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], @@ -152,14 +152,14 @@ function({function,Name,Arity,CLabel,Asm0}) -> share(Is0) -> %% We will get more sharing if we never fall through to a label. Is = eliminate_fallthroughs(Is0, []), - share_1(Is, dict:new(), [], []). + share_1(Is, #{}, [], []). share_1([{label,_}=Lbl|Is], Dict, [], Acc) -> share_1(Is, Dict, [], [Lbl|Acc]); share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) -> - case dict:find(Seq, Dict0) of + case maps:find(Seq, Dict0) of error -> - Dict = dict:store(Seq, L, Dict0), + Dict = maps:put(Seq, L, Dict0), share_1(Is, Dict, [], [Lbl|Seq ++ Acc]); {ok,Label} -> share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) @@ -188,7 +188,7 @@ clean_non_sharable(Dict) -> %% a sequence inside the 'try' block is a sequence that ends %% with an instruction that causes an exception. Any sequence %% that causes an exception must contain a line/1 instruction. - dict:filter(fun(K, _V) -> sharable_with_try(K) end, Dict). + maps:filter(fun(K, _V) -> sharable_with_try(K) end, Dict). sharable_with_try([{line,_}|_]) -> %% This sequence may cause an exception and may potentially @@ -268,13 +268,13 @@ extract_seq_1(_, _) -> no. -record(st, {fc, %Label for function class errors. entry, %Entry label (must not be moved). mlbl, %Moved labels. - labels %Set of referenced labels. + labels :: cerl_sets:set() %Set of referenced labels. }). opt([{label,Fc}|_]=Is0, CLabel) -> Lbls = initial_labels(Is0), find_fixpoint(fun(Is) -> - St = #st{fc=Fc,entry=CLabel,mlbl=dict:new(), + St = #st{fc=Fc,entry=CLabel,mlbl=#{}, labels=Lbls}, opt(Is, [], St) end, Is0). @@ -320,11 +320,11 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) -> opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) -> skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> - case dict:find(Lbl, Mlbl) of + case maps:find(Lbl, Mlbl) of {ok,Lbls} -> %% Essential to remove the list of labels from the dictionary, %% since we will rescan the inserted labels. We MUST rescan. - St = St0#st{mlbl=dict:erase(Lbl, Mlbl)}, + St = St0#st{mlbl=maps:remove(Lbl, Mlbl)}, insert_labels([Lbl|Lbls], Is, Acc, St); error -> opt(Is, [I|Acc], St0) end; @@ -339,7 +339,7 @@ opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) -> St = case Lbls of [] -> St0; [_|_] -> - Mlbl = dict:append_list(L, Lbls, Mlbl0), + Mlbl = maps_append_list(L, Lbls, Mlbl0), St0#st{mlbl=Mlbl} end, skip_unreachable(Is, [I|Acc], label_used(Lbl, St)); @@ -363,14 +363,20 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) -> end; opt([], Acc, #st{fc=Fc,mlbl=Mlbl}) -> Code = reverse(Acc), - case dict:find(Fc, Mlbl) of + case maps:find(Fc, Mlbl) of {ok,Lbls} -> insert_fc_labels(Lbls, Mlbl, Code); error -> Code end. +maps_append_list(K,Vs,M) -> + case M of + #{K:=Vs0} -> M#{K:=Vs0++Vs}; % same order as dict + _ -> M#{K => Vs} + end. + insert_fc_labels([L|Ls], Mlbl, Acc0) -> Acc = [{label,L}|Acc0], - case dict:find(L, Mlbl) of + case maps:find(L, Mlbl) of error -> insert_fc_labels(Ls, Mlbl, Acc); {ok,Lbls} -> @@ -434,7 +440,7 @@ skip_unreachable([], Acc, St) -> %% Add one or more label to the set of used labels. -label_used({f,L}, St) -> St#st{labels=gb_sets:add(L, St#st.labels)}; +label_used({f,L}, St) -> St#st{labels=cerl_sets:add_element(L,St#st.labels)}; label_used([H|T], St0) -> label_used(T, label_used(H, St0)); label_used([], St) -> St; label_used(_Other, St) -> St. @@ -442,7 +448,7 @@ label_used(_Other, St) -> St. %% Test if label is used. is_label_used(L, St) -> - gb_sets:is_member(L, St#st.labels). + cerl_sets:is_element(L, St#st.labels). %% is_unreachable_after(Instruction) -> boolean() %% Test whether the code after Instruction is unreachable. @@ -472,14 +478,14 @@ is_exit_instruction(_) -> false. %% (including inside blocks). is_label_used_in(Lbl, Is) -> - is_label_used_in_1(Is, Lbl, gb_sets:empty()). + is_label_used_in_1(Is, Lbl, cerl_sets:new()). is_label_used_in_1([{block,Block}|Is], Lbl, Empty) -> lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block) orelse is_label_used_in_1(Is, Lbl, Empty); is_label_used_in_1([I|Is], Lbl, Empty) -> Used = ulbl(I, Empty), - gb_sets:is_member(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty); + cerl_sets:is_element(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty); is_label_used_in_1([], _, _) -> false. is_label_used_in_block({set,_,_,Info}, Lbl) -> @@ -506,13 +512,10 @@ remove_unused_labels(Is) -> rem_unused(Is, Used, []). rem_unused([{label,Lbl}=I|Is0], Used, [Prev|_]=Acc) -> - case gb_sets:is_member(Lbl, Used) of + case cerl_sets:is_element(Lbl, Used) of false -> Is = case is_unreachable_after(Prev) of - true -> - dropwhile(fun({label,_}) -> false; - (_) -> true - end, Is0); + true -> drop_upto_label(Is0); false -> Is0 end, rem_unused(Is, Used, Acc); @@ -531,7 +534,11 @@ initial_labels([{line,_}|Is], Acc) -> initial_labels([{label,Lbl}|Is], Acc) -> initial_labels(Is, [Lbl|Acc]); initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) -> - gb_sets:from_list([Lbl|Acc]). + cerl_sets:from_list([Lbl|Acc]). + +drop_upto_label([{label,_}|_]=Is) -> Is; +drop_upto_label([_|Is]) -> drop_upto_label(Is); +drop_upto_label([]) -> []. %% ulbl(Instruction, UsedGbSet) -> UsedGbSet' %% Update the gb_set UsedGbSet with any function-local labels @@ -575,10 +582,10 @@ ulbl({get_map_elements,Lbl,_Src,_List}, Used) -> ulbl(_, Used) -> Used. mark_used({f,0}, Used) -> Used; -mark_used({f,L}, Used) -> gb_sets:add(L, Used). +mark_used({f,L}, Used) -> cerl_sets:add_element(L, Used). mark_used_list([{f,L}|T], Used) -> - mark_used_list(T, gb_sets:add(L, Used)); + mark_used_list(T, cerl_sets:add_element(L, Used)); mark_used_list([_|T], Used) -> mark_used_list(T, Used); mark_used_list([], Used) -> Used. diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 50d1f3cdb1..726bb7f5eb 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -46,8 +46,8 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> fun ({function,Name,Arity,Entry,Asm}) -> io:format(Stream, "\n\n{function, ~w, ~w, ~w}.\n", [Name, Arity, Entry]), - foreach(fun(Op) -> print_op(Stream, Op) end, Asm) end, - Code); + io:put_chars(Stream, format_asm(Asm)) + end, Code); module(Stream, {Mod,Exp,Inter}) -> %% Other kinds of intermediate formats. io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]), @@ -56,10 +56,11 @@ module(Stream, [_|_]=Fs) -> %% Form-based abstract format. foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). -print_op(Stream, Label) when element(1, Label) == label -> - io:format(Stream, " ~p.\n", [Label]); -print_op(Stream, Op) -> - io:format(Stream, " ~p.\n", [Op]). +format_asm([{label,L}|Is]) -> + [" {label,",integer_to_list(L),"}.\n"|format_asm(Is)]; +format_asm([I|Is]) -> + [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)]; +format_asm([]) -> []. function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> io:nl(File), diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index fad9c42584..8181e555a1 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -172,6 +172,10 @@ remap([{bif,Name,Fail,Ss,D}|Is], Map, Acc) -> remap([{gc_bif,Name,Fail,Live,Ss,D}|Is], Map, Acc) -> I = {gc_bif,Name,Fail,Live,[Map(S) || S <- Ss],Map(D)}, remap(Is, Map, [I|Acc]); +remap([{get_map_elements,Fail,M,{list,L0}}|Is], Map, Acc) -> + L = [Map(E) || E <- L0], + I = {get_map_elements,Fail,Map(M),{list,L}}, + remap(Is, Map, [I|Acc]); remap([{bs_init,Fail,Info,Live,Ss0,Dst0}|Is], Map, Acc) -> Ss = [Map(Src) || Src <- Ss0], Dst = Map(Dst0), @@ -275,6 +279,8 @@ frame_size([{kill,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{get_map_elements,{f,L},_,_}|Is], Safe) -> + frame_size_branch(L, Is, Safe); frame_size([{deallocate,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 26c933481a..7ab548152e 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -149,9 +149,10 @@ simplify_basic_1([], Ts, Acc) -> %% simplify_float(Is0, Ts0) -> {Is1,Ts} = simplify_float_1(Is0, Ts0, [], []), - Is2 = flt_need_heap(Is1), + Is2 = opt_fmoves(Is1, []), + Is3 = flt_need_heap(Is2), try - {flt_liveness(Is2),Ts} + {flt_liveness(Is3),Ts} catch throw:not_possible -> not_possible end. @@ -202,14 +203,15 @@ simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> simplify_float_1(Is, Ts, Rs, [I|Acc]); +simplify_float_1([I|Is], Ts0, [], Acc) -> + Ts = update(I, Ts0), + simplify_float_1(Is, Ts, [], [I|Acc]); simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) -> Ts = update(I, Ts0), {Rs,Acc} = flush(Rs0, Is0, Acc0), simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]); -simplify_float_1([], Ts, Rs, Acc0) -> - Acc = checkerror(Acc0), - Is0 = reverse(flush_all(Rs, [], Acc)), - Is = opt_fmoves(Is0, []), +simplify_float_1([], Ts, [], Acc) -> + Is = reverse(Acc), {Is,Ts}. coerce_to_float({integer,I}=Int) -> @@ -552,10 +554,10 @@ flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) -> Acc = flush_all(Rs, Is0, Acc0), {[],Acc}; flush(Rs0, [{set,Ds,Ss,_Op}|_], Acc0) -> - Save = gb_sets:from_list(Ss), + Save = cerl_sets:from_list(Ss), Acc = save_regs(Rs0, Save, Acc0), Rs1 = foldl(fun(S, A) -> mark(S, A, clean) end, Rs0, Ss), - Kill = gb_sets:from_list(Ds), + Kill = cerl_sets:from_list(Ds), Rs = kill_regs(Rs1, Kill), {Rs,Acc}; flush(Rs0, Is, Acc0) -> @@ -578,7 +580,7 @@ save_regs(Rs, Save, Acc) -> foldl(fun(R, A) -> save_reg(R, Save, A) end, Acc, Rs). save_reg({I,V,dirty}, Save, Acc) -> - case gb_sets:is_member(V, Save) of + case cerl_sets:is_element(V, Save) of true -> [{set,[V],[{fr,I}],fmove}|checkerror(Acc)]; false -> Acc end; @@ -588,7 +590,7 @@ kill_regs(Rs, Kill) -> [kill_reg(R, Kill) || R <- Rs]. kill_reg({_,V,_}=R, Kill) -> - case gb_sets:is_member(V, Kill) of + case cerl_sets:is_element(V, Kill) of true -> free; false -> R end; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 7704690f86..b82bcd0e95 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -128,8 +128,7 @@ empty_label_index() -> %% Add an index for a label. index_label(Lbl, Is0, Acc) -> - Is = lists:dropwhile(fun({label,_}) -> true; - (_) -> false end, Is0), + Is = drop_labels(Is0), gb_trees:enter(Lbl, Is, Acc). @@ -344,14 +343,10 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> false -> check_liveness(R, Is, St); true -> - %% We must make sure we don't check beyond this instruction - %% or we will fall through into random unrelated code and - %% get stuck in a loop. - %% - %% We don't want to overwrite a 'catch', so consider this - %% register in use. - %% - {used,St} + %% We must make sure we don't check beyond this + %% instruction or we will fall through into random + %% unrelated code and get stuck in a loop. + {killed,St} end end; check_liveness(R, [{call_fun,Live}|Is], St) -> @@ -472,6 +467,22 @@ check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> check_liveness_at(R, Fail, St); check_liveness(R, [{line,_}|Is], St) -> check_liveness(R, Is, St); +check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> + {Ss,Ds} = split_even(L), + case member(R, [S|Ss]) of + true -> + {used,St0}; + false -> + case check_liveness_at(R, Fail, St0) of + {killed,St}=Killed -> + case member(R, Ds) of + true -> Killed; + false -> check_liveness(R, Is, St) + end; + Other -> + Other + end + end; check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> @@ -612,13 +623,15 @@ is_reg_used_at_1(R, Lbl, St0) -> end. index_labels_1([{label,Lbl}|Is0], Acc) -> - Is = lists:dropwhile(fun({label,_}) -> true; - (_) -> false end, Is0), + Is = drop_labels(Is0), index_labels_1(Is0, [{Lbl,Is}|Acc]); index_labels_1([_|Is], Acc) -> index_labels_1(Is, Acc); index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). +drop_labels([{label,_}|Is]) -> drop_labels(Is); +drop_labels(Is) -> Is. + %% Help functions for combine_heap_needs. combine_alloc_lists(Al1, Al2) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 4d4536b79c..780826b126 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -28,7 +28,7 @@ -include("beam_disasm.hrl"). --import(lists, [reverse/1,foldl/3,foreach/2,member/2,dropwhile/2]). +-import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]). -define(MAXREG, 1024). @@ -153,7 +153,6 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> hf=0, %Available heap size for floats. fls=undefined, %Floating point state. ct=[], %List of hot catch/try labels - bits=undefined, %Number of bits in bit syntax binary. setelem=false %Previous instruction was setelement/3. }). @@ -411,37 +410,33 @@ valfun_1({'try',Dst,{f,Fail}}, Vst0) -> Vst = #vst{current=#st{ct=Fails}=St} = set_type_y({trytag,[Fail]}, Dst, Vst0), Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +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_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), + Vst = #vst{current=St} = set_catch_end(Reg, Vst0), Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; Type -> error({bad_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> case get_special_y_type(Reg, Vst0) of {trytag,Fail} -> Vst = case Fail of [FailLabel] -> branch_state(FailLabel, Vst0); _ -> Vst0 end, - set_type_reg(initialized_ct, Reg, - Vst#vst{current=St#st{ct=Fails,fls=undefined}}); + St = St0#st{ct=Fails,fls=undefined}, + set_catch_end(Reg, Vst#vst{current=St}); Type -> error({bad_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> +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_type_y(initialized_ct, Reg, - Vst0#vst{current=St0#st{ct=Fails}}), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), %XXX - Vst#vst{current=St#st{x=Xs,fls=undefined}}; + 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}}; Type -> error({bad_type,Type}) end; @@ -667,7 +662,7 @@ valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst)); valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> assert_type(map, Src, Vst), - assert_strict_literal_termorder(List), + assert_unique_map_keys(List), branch_state(Lbl, Vst); valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> Vst = branch_state(Lbl, Vst0), @@ -700,8 +695,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -713,8 +707,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -722,43 +715,35 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bin, Vst0), Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), - Vst3 = prune_x_regs(Live, Vst2), - Vst = bs_zero_bits(Vst3), + Vst = prune_x_regs(Live, Vst2), set_type_reg(binary, Dst, Vst); valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> assert_term(Bits, Vst0), assert_term(Bin, Vst0), - Vst1 = branch_state(Fail, Vst0), - Vst = bs_zero_bits(Vst1), + Vst = branch_state(Fail, Vst0), set_type_reg(binary, Dst, Vst); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; -valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}=I, Vst0) -> - assert_term(Sz, Vst0), - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> + assert_term(Sz, Vst), + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf8,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf16,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); -valfun_4({bs_put_utf32,{f,Fail},_,Src}=I, Vst0) -> - assert_term(Src, Vst0), - Vst = bs_align_check(I, Vst0), +valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> + assert_term(Src, Vst), branch_state(Fail, Vst); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -774,7 +759,7 @@ verify_get_map(Fail, Src, List, Vst0) -> assert_type(map, Src, Vst0), Vst1 = branch_state(Fail, Vst0), Keys = extract_map_keys(List), - assert_strict_literal_termorder(Keys), + assert_unique_map_keys(Keys), verify_get_map_pair(List,Vst0,Vst1). extract_map_keys([Key,_Val|T]) -> @@ -794,6 +779,8 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> 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), set_type_reg(map, Dst, Vst). %% @@ -1007,29 +994,23 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}). %% A single item list may be either a list or a register. %% -%% A list with more than item must contain literals in -%% ascending term order. +%% A list with more than item must contain unique literals. %% %% An empty list is not allowed. -assert_strict_literal_termorder([]) -> +assert_unique_map_keys([]) -> %% There is no reason to use the get_map_elements and %% has_map_fields instructions with empty lists. error(empty_field_list); -assert_strict_literal_termorder([_]) -> +assert_unique_map_keys([_]) -> ok; -assert_strict_literal_termorder([_,_|_]=Ls) -> +assert_unique_map_keys([_,_|_]=Ls) -> Vs = [get_literal(L) || L <- Ls], - case check_strict_value_termorder(Vs) of - true -> ok; - false -> error(not_strict_order) + case length(Vs) =:= sets:size(sets:from_list(Vs)) of + true -> ok; + false -> error(keys_not_unique) end. -check_strict_value_termorder([V1|[V2|_]=Vs]) -> - erts_internal:cmp_term(V1, V2) < 0 andalso - check_strict_value_termorder(Vs); -check_strict_value_termorder([_]) -> true. - %%% %%% New binary matching instructions. %%% @@ -1075,56 +1056,8 @@ bsm_restore(Reg, SavePoint, Vst) -> end; _ -> error({illegal_restore,SavePoint,range}) end. - %%% -%%% Validation of alignment in the bit syntax. (Currently, construction only.) -%%% -%%% We make sure that the aligned flag is only set when we can be sure of the -%%% aligment. -%%% - -bs_zero_bits(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{bits=0}}. - -bs_align_check({bs_put_utf8,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf16,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({bs_put_utf32,_,Flags,_}, #vst{current=#st{}=St}=Vst) -> - bs_verify_flags(Flags, St), - Vst; -bs_align_check({_,_,Sz,U,Flags,_}, #vst{current=#st{bits=Bits}=St}=Vst) -> - bs_verify_flags(Flags, St), - bs_update_bits(Bits, Sz, U, St, Vst). - -bs_update_bits(undefined, _, _, _, Vst) -> Vst; -bs_update_bits(Bits0, {integer,Sz}, U, St, Vst) -> - Bits = Bits0 + U*Sz, - Vst#vst{current=St#st{bits=Bits}}; -bs_update_bits(_, {atom,all}, _, _, Vst) -> - %% A binary will not change the alignment. - Vst; -bs_update_bits(_, _, U, _, Vst) when U rem 8 =:= 0 -> - %% Units of 8, 16, and so on will not change the aligment. - Vst; -bs_update_bits(_, _, _, St, Vst) -> - %% We can no longer be sure about aligment. - Vst#vst{current=St#st{bits=undefined}}. - -bs_verify_flags({field_flags,Fl}, #st{bits=Bits}) -> - case bs_is_aligned(Fl) of - false -> ok; - true when is_integer(Bits), Bits rem 8 =:= 0 -> ok; - true -> error({aligned_flag_set,{bits,Bits}}) - end. - -bs_is_aligned(Fl) when is_integer(Fl) -> Fl band 1 =:= 1; -bs_is_aligned(Fl) when is_list(Fl) -> member(aligned, Fl). - -%%% %%% Keeping track of types. %%% @@ -1139,35 +1072,26 @@ set_type_reg(Type, {x,X}, #vst{current=#st{x=Xs}=St}=Vst) set_type_reg(Type, Reg, Vst) -> set_type_y(Type, Reg, Vst). -set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0,numy=NumY}=St}=Vst) +set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst) when is_integer(Y), 0 =< Y -> limit_check(Y), - case {Y,NumY} of - {_,none} -> - error({no_stack_frame,Reg}); - {_,_} when Y > NumY -> - error({y_reg_out_of_range,Reg,NumY}); - {_,_} -> - Ys = if Type =:= initialized_ct -> - gb_trees:enter(Y, initialized, Ys0); - true -> - case gb_trees:lookup(Y, Ys0) of - none -> - gb_trees:insert(Y, Type, Ys0); - {value,uinitialized} -> - gb_trees:insert(Y, Type, Ys0); - {value,{catchtag,_}=Tag} -> - error(Tag); - {value,{trytag,_}=Tag} -> - error(Tag); - {value,_} -> - gb_trees:update(Y, Type, Ys0) - end - end, - Vst#vst{current=St#st{y=Ys}} - end; + Ys = case gb_trees:lookup(Y, Ys0) of + none -> + error({invalid_store,Reg,Type}); + {value,{catchtag,_}=Tag} -> + error(Tag); + {value,{trytag,_}=Tag} -> + error(Tag); + {value,_} -> + gb_trees:update(Y, Type, Ys0) + end, + Vst#vst{current=St#st{y=Ys}}; set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,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}}. + assert_term(Src, Vst) -> get_term_type(Src, Vst), ok. @@ -1366,13 +1290,13 @@ merge_states(L, St, Branched) when L =/= 0 -> {value,OtherSt} -> merge_states_1(St, OtherSt) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}=St, +merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}, #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> NumY = merge_stk(NumY0, NumY1), Xs = merge_regs(Xs0, Xs1), Ys = merge_y_regs(Ys0, Ys1), Ct = merge_ct(Ct0, Ct1), - St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. + #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1402,20 +1326,24 @@ merge_regs_1([], [_|_]) -> []; merge_regs_1([_|_], []) -> []. merge_y_regs(Rs0, Rs1) -> - Rs = merge_y_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)), - gb_trees_from_list(Rs). + case {gb_trees:size(Rs0),gb_trees:size(Rs1)} of + {Sz0,Sz1} when Sz0 < Sz1 -> + merge_y_regs_1(Sz0-1, Rs1, Rs0); + {_,Sz1} -> + merge_y_regs_1(Sz1-1, Rs0, Rs1) + end. -merge_y_regs_1([Same|Rs1], [Same|Rs2]) -> - [Same|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> - [{R1,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> - [{R2,uninitialized}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_y_regs_1(Rs1, Rs2)]; -merge_y_regs_1([], []) -> []; -merge_y_regs_1([], [_|_]=Rs) -> Rs; -merge_y_regs_1([_|_]=Rs, []) -> Rs. +merge_y_regs_1(Y, S, Regs0) when Y >= 0 -> + Type0 = gb_trees:get(Y, Regs0), + case gb_trees:get(Y, S) of + Type0 -> + merge_y_regs_1(Y-1, S, Regs0); + Type1 -> + Type = merge_types(Type0, Type1), + Regs = gb_trees:update(Y, Type, Regs0), + merge_y_regs_1(Y-1, S, Regs) + end; +merge_y_regs_1(_, _, Regs) -> Regs. %% merge_types(Type1, Type2) -> Type %% Return the most specific type possible. @@ -1634,8 +1562,6 @@ return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> return_type_erl(exit, 1) -> exception; return_type_erl(throw, 1) -> exception; -return_type_erl(fault, 1) -> exception; -return_type_erl(fault, 2) -> 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. diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 0c7bef9183..47e786034d 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -74,6 +74,13 @@ undo_rename({bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}) -> {I,F,Sz,Extra,Live,U,Src,Flags,Dst}; undo_rename({bs_init,_,bs_init_writable=I,_,_,_}) -> I; +undo_rename({test,bs_match_string=Op,F,[Ctx,Bin0]}) -> + Bits = bit_size(Bin0), + Bin = case Bits rem 8 of + 0 -> Bin0; + Rem -> <<Bin0/bitstring,0:(8-Rem)>> + end, + {test,Op,F,[Ctx,Bits,{string,binary_to_list(Bin)}]}; undo_rename({put_map,Fail,assoc,S,D,R,L}) -> {put_map_assoc,Fail,S,D,R,L}; undo_rename({put_map,Fail,exact,S,D,R,L}) -> diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index f8489a800b..02cdb966ce 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -445,15 +445,14 @@ i_var_1(R, Opnd, Ctxt, Env, S) -> residualize_var(R, S); false -> S1 = st__mark_inner_pending(L, S), - case catch {ok, visit(Opnd, S1)} of - {ok, {E, S2}} -> + try visit(Opnd, S1) of + {E, S2} -> %% Note that we pass the current environment and %% context to `copy', but not the current renaming. S3 = st__clear_inner_pending(L, S2), - copy(R, Opnd, E, Ctxt, Env, S3); - {'EXIT', X} -> - exit(X); - X -> + copy(R, Opnd, E, Ctxt, Env, S3) + catch + throw:X -> %% If we use destructive update for the %% `inner-pending' flag, we must make sure to clear %% it also if we make a nonlocal return. @@ -1128,8 +1127,8 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> %% Note that we extract the results of argument expessions here; the %% expressions could still be sequences with side effects. Vs = [concrete(result(A)) || A <- As], - case catch {ok, apply(atom_val(M), atom_val(F), Vs)} of - {ok, V} -> + try apply(atom_val(M), atom_val(F), Vs) of + V -> %% Evaluation completed normally - try to turn the result %% back into a syntax tree (representing a literal). case is_literal_term(V) of @@ -1142,8 +1141,9 @@ i_call_3(M, F, As, E, Ctxt, Env, S) -> false -> %% The result could not be represented as a literal. i_call_4(M, F, As, E, Ctxt, Env, S) - end; - _ -> + end + catch + error:_ -> %% The evaluation attempt did not complete normally. i_call_4(M, F, As, E, Ctxt, Env, S) end. @@ -1736,12 +1736,11 @@ copy_1(R, Opnd, E, Ctxt, Env, S) -> copy_inline(R, Opnd, E, Ctxt, Env, S) -> S1 = st__mark_outer_pending(Opnd#opnd.loc, S), - case catch {ok, copy_inline_1(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> - {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)}; - {'EXIT', X} -> - exit(X); - X -> + try copy_inline_1(R, E, Ctxt, Env, S1) of + {E1, S2} -> + {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)} + catch + throw:X -> %% If we use destructive update for the `outer-pending' %% flag, we must make sure to clear it upon a nonlocal %% return. @@ -1758,19 +1757,16 @@ copy_inline_1(R, E, Ctxt, Env, S) -> copy_inline_2(R, E, Ctxt, Env, S); false -> S1 = new_active_effort(get_effort_limit(S), S), - case catch {ok, copy_inline_2(R, E, Ctxt, Env, S1)} of - {ok, {E1, S2}} -> + try copy_inline_2(R, E, Ctxt, Env, S1) of + {E1, S2} -> %% Revert to the old effort counter. - {E1, revert_effort(S, S2)}; - {counter_exceeded, effort, _} -> + {E1, revert_effort(S, S2)} + catch + throw:{counter_exceeded, effort, _} -> %% Aborted this inlining attempt because too much %% effort was spent. Residualize the variable and %% revert to the previous state. - residualize_var(R, S); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S) end end. @@ -1796,11 +1792,12 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% close to zero at this point. (This is an extension to the %% original algorithm.) S1 = new_active_size(Limit + apply_size(length(Ctxt#app.opnds)), S), - case catch {ok, inline(E, Ctxt, ren__identity(), Env, S1)} of - {ok, {E1, S2}} -> + try inline(E, Ctxt, ren__identity(), Env, S1) of + {E1, S2} -> %% Revert to the old size counter. - {E1, revert_size(S, S2)}; - {counter_exceeded, size, S2} -> + {E1, revert_size(S, S2)} + catch + throw:{counter_exceeded, size, S2} -> %% Aborted this inlining attempt because it got too big. %% Residualize the variable and revert to the old size %% counter. (It is important that we do not also revert the @@ -1813,11 +1810,7 @@ copy_inline_2(R, E, Ctxt, Env, S) -> %% must make sure to clear the flags of any nested %% app-contexts upon aborting; see `inline' for details. S4 = reset_nested_apps(Ctxt, S3), % for effect - residualize_var(R, S4); - {'EXIT', X} -> - exit(X); - X -> - throw(X) + residualize_var(R, S4) end. reset_nested_apps(#app{ctxt = Ctxt, loc = L}, S) -> diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl new file mode 100644 index 0000000000..4df78dc432 --- /dev/null +++ b/lib/compiler/src/cerl_sets.erl @@ -0,0 +1,206 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(cerl_sets). + +%% Standard interface. +-export([new/0,is_set/1,size/1,to_list/1,from_list/1]). +-export([is_element/2,add_element/2,del_element/2]). +-export([union/2,union/1,intersection/2,intersection/1]). +-export([is_disjoint/2]). +-export([subtract/2,is_subset/2]). +-export([fold/3,filter/2]). + +-export_type([set/0, set/1]). + +%%------------------------------------------------------------------------------ + +-type set() :: set(_). +-opaque set(Element) :: #{Element => 'ok'}. + +%%------------------------------------------------------------------------------ + +%% new() -> Set +-spec new() -> set(). + +new() -> #{}. + +%% is_set(Set) -> boolean(). +%% Return 'true' if Set is a set of elements, else 'false'. +-spec is_set(Set) -> boolean() when + Set :: term(). + +is_set(S) when is_map(S) -> true; +is_set(_) -> false. + +%% size(Set) -> int(). +%% Return the number of elements in Set. +-spec size(Set) -> non_neg_integer() when + Set :: set(). + +size(S) -> maps:size(S). + +%% to_list(Set) -> [Elem]. +%% Return the elements in Set as a list. +-spec to_list(Set) -> List when + Set :: set(Element), + List :: [Element]. + +to_list(S) -> maps:keys(S). + +%% from_list([Elem]) -> Set. +%% Build a set from the elements in List. +-spec from_list(List) -> Set when + List :: [Element], + Set :: set(Element). +from_list(Ls) -> maps:from_list([{K,ok}||K<-Ls]). + +%% is_element(Element, Set) -> boolean(). +%% Return 'true' if Element is an element of Set, else 'false'. +-spec is_element(Element, Set) -> boolean() when + Set :: set(Element). + +is_element(E,S) -> + case S of + #{E := _} -> true; + _ -> false + end. + +%% add_element(Element, Set) -> Set. +%% Return Set with Element inserted in it. +-spec add_element(Element, Set1) -> Set2 when + Set1 :: set(Element), + Set2 :: set(Element). + +add_element(E,S) -> S#{E=>ok}. + +-spec del_element(Element, Set1) -> Set2 when + Set1 :: set(Element), + Set2 :: set(Element). + +%% del_element(Element, Set) -> Set. +%% Return Set but with Element removed. +del_element(E,S) -> maps:remove(E,S). + +%% union(Set1, Set2) -> Set +%% Return the union of Set1 and Set2. +-spec union(Set1, Set2) -> Set3 when + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). + +union(S1,S2) -> maps:merge(S1,S2). + +%% union([Set]) -> Set +%% Return the union of the list of sets. +-spec union(SetList) -> Set when + SetList :: [set(Element)], + Set :: set(Element). + +union([S1,S2|Ss]) -> + union1(union(S1, S2), Ss); +union([S]) -> S; +union([]) -> new(). + +union1(S1, [S2|Ss]) -> + union1(union(S1, S2), Ss); +union1(S1, []) -> S1. + +%% intersection(Set1, Set2) -> Set. +%% Return the intersection of Set1 and Set2. +-spec intersection(Set1, Set2) -> Set3 when + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). + +intersection(S1, S2) -> + filter(fun (E) -> is_element(E, S1) end, S2). + +%% intersection([Set]) -> Set. +%% Return the intersection of the list of sets. +-spec intersection(SetList) -> Set when + SetList :: [set(Element),...], + Set :: set(Element). + +intersection([S1,S2|Ss]) -> + intersection1(intersection(S1, S2), Ss); +intersection([S]) -> S. + +intersection1(S1, [S2|Ss]) -> + intersection1(intersection(S1, S2), Ss); +intersection1(S1, []) -> S1. + +%% is_disjoint(Set1, Set2) -> boolean(). +%% Check whether Set1 and Set2 are disjoint. +-spec is_disjoint(Set1, Set2) -> boolean() when + Set1 :: set(Element), + Set2 :: set(Element). + +is_disjoint(S1, S2) when map_size(S1) < map_size(S2) -> + fold(fun (_, false) -> false; + (E, true) -> not is_element(E, S2) + end, true, S1); +is_disjoint(S1, S2) -> + fold(fun (_, false) -> false; + (E, true) -> not is_element(E, S1) + end, true, S2). + +%% subtract(Set1, Set2) -> Set. +%% Return all and only the elements of Set1 which are not also in +%% Set2. +-spec subtract(Set1, Set2) -> Set3 when + Set1 :: set(Element), + Set2 :: set(Element), + Set3 :: set(Element). + +subtract(S1, S2) -> + filter(fun (E) -> not is_element(E, S2) end, S1). + +%% is_subset(Set1, Set2) -> boolean(). +%% Return 'true' when every element of Set1 is also a member of +%% Set2, else 'false'. +-spec is_subset(Set1, Set2) -> boolean() when + Set1 :: set(Element), + Set2 :: set(Element). + +is_subset(S1, S2) -> + fold(fun (E, Sub) -> Sub andalso is_element(E, S2) end, true, S1). + +%% fold(Fun, Accumulator, Set) -> Accumulator. +%% Fold function Fun over all elements in Set and return Accumulator. +-spec fold(Function, Acc0, Set) -> Acc1 when + Function :: fun((Element, AccIn) -> AccOut), + Set :: set(Element), + Acc0 :: Acc, + Acc1 :: Acc, + AccIn :: Acc, + AccOut :: Acc. + +fold(F, Init, D) -> + lists:foldl(fun(E,Acc) -> F(E,Acc) end,Init,maps:keys(D)). + +%% filter(Fun, Set) -> Set. +%% Filter Set with Fun. +-spec filter(Pred, Set1) -> Set2 when + Pred :: fun((Element) -> boolean()), + Set1 :: set(Element), + Set2 :: set(Element). + +filter(F, D) -> + maps:from_list(lists:filter(fun({K,_}) -> F(K) end, maps:to_list(D))). diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index c45c9a1a29..0158cf64db 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -41,7 +41,7 @@ -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. --type err_info() :: {erl_scan:line() | 'none', +-type err_info() :: {erl_anno:line() | 'none', module(), term()}. %% ErrorDescriptor -type errors() :: [{file:filename(), [err_info()]}]. -type warnings() :: [{file:filename(), [err_info()]}]. @@ -132,7 +132,8 @@ env_default_opts() -> Str when is_list(Str) -> case erl_scan:string(Str) of {ok,Tokens,_} -> - case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of + Dot = {dot, erl_anno:new(1)}, + case erl_parse:parse_term(Tokens ++ [Dot]) of {ok,List} when is_list(List) -> List; {ok,Term} -> [Term]; {error,_Reason} -> @@ -285,11 +286,20 @@ internal_comp(Passes, File, Suffix, St0) -> St1 = St0#compile{filename=File, dir=Dir, base=Base, ifile=erlfile(Dir, Base, Suffix), ofile=objfile(Base, St0)}, - Run = case member(time, St1#compile.options) of - true -> - io:format("Compiling ~tp\n", [File]), - fun run_tc/2; - false -> fun({_Name,Fun}, St) -> catch Fun(St) end + Opts = St1#compile.options, + Run0 = case member(time, Opts) of + true -> + io:format("Compiling ~tp\n", [File]), + fun run_tc/2; + false -> fun({_Name,Fun}, St) -> catch Fun(St) end + end, + Run = case keyfind(eprof, 1, Opts) of + {eprof,EprofPass} -> + fun(P, St) -> + run_eprof(P, EprofPass, St) + end; + false -> + Run0 end, case fold_comp(Passes, Run, St1) of {ok,St2} -> comp_ret_ok(St2); @@ -320,17 +330,26 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> fold_comp([], _Run, St) -> {ok,St}. run_tc({Name,Fun}, St) -> - Before0 = statistics(runtime), + T1 = erlang:monotonic_time(), Val = (catch Fun(St)), - After0 = statistics(runtime), - {Before_c, _} = Before0, - {After_c, _} = After0, + T2 = erlang:monotonic_time(), + Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds), Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), - io:format(" ~-30s: ~10.2f s ~12s\n", - [Name,(After_c-Before_c) / 1000,Mem]), + io:format(" ~-30s: ~10.3f s ~12s\n", + [Name,Elapsed/1000,Mem]), Val. +run_eprof({Name,Fun}, Name, St) -> + io:format("~p: Running eprof\n", [Name]), + c:appcall(tools, eprof, start_profiling, [[self()]]), + Val = (catch Fun(St)), + c:appcall(tools, eprof, stop_profiling, []), + c:appcall(tools, eprof, analyze, []), + Val; +run_eprof({_,Fun}, _, St) -> + catch Fun(St). + comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> case werror(St) of true -> @@ -606,7 +625,7 @@ standard_passes() -> {iff,'to_exp',{done,"E"}}, %% Conversion to Core Erlang. - ?pass(core_module), + {pass,v3_core}, {iff,'dcore',{listing,"core"}}, {iff,'to_core0',{done,"core"}} | core_passes()]. @@ -618,7 +637,7 @@ core_passes() -> [{unless,no_copt, [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, {iff,doldinline,{listing,"oldinline"}}, - ?pass(core_fold_module), + {pass,sys_core_fold}, {iff,dcorefold,{listing,"corefold"}}, {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, {iff,dinline,{listing,"inline"}}, @@ -631,14 +650,14 @@ core_passes() -> kernel_passes() -> %% Destructive setelement/3 optimization and core lint. - [?pass(core_dsetel_module), + [{pass,sys_core_dsetel}, {iff,dsetel,{listing,"dsetel"}}, {iff,clint,?pass(core_lint_module)}, {iff,core,?pass(save_core_code)}, %% Kernel Erlang and code generation. - ?pass(kernel_module), + {pass,v3_kernel}, {iff,dkern,{listing,"kernel"}}, {iff,'to_kernel',{done,"kernel"}}, {pass,v3_life}, @@ -901,28 +920,35 @@ transform_module(#compile{options=Opt,code=Code0}=St0) -> foldl_transform(St, [T|Ts]) -> Name = "transform " ++ atom_to_list(T), - Fun = fun(S) -> T:parse_transform(S#compile.code, S#compile.options) end, - Run = case member(time, St#compile.options) of - true -> fun run_tc/2; - false -> fun({_Name,F}, S) -> catch F(S) end - end, - case Run({Name, Fun}, St) of - {error,Es,Ws} -> - {error,St#compile{warnings=St#compile.warnings ++ Ws, - errors=St#compile.errors ++ Es}}; - {'EXIT',{undef,_}} -> - Es = [{St#compile.ifile,[{none,compile, - {undef_parse_transform,T}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - {'EXIT',R} -> - Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}], - {error,St#compile{errors=St#compile.errors ++ Es}}; - {warning, Forms, Ws} -> - foldl_transform( - St#compile{code=Forms, - warnings=St#compile.warnings ++ Ws}, Ts); - Forms -> - foldl_transform(St#compile{code=Forms}, Ts) + case code:ensure_loaded(T) =:= {module,T} andalso + erlang:function_exported(T, parse_transform, 2) of + true -> + Fun = fun(S) -> + T:parse_transform(S#compile.code, S#compile.options) + end, + Run = case member(time, St#compile.options) of + true -> fun run_tc/2; + false -> fun({_Name,F}, S) -> catch F(S) end + end, + case Run({Name, Fun}, St) of + {error,Es,Ws} -> + {error,St#compile{warnings=St#compile.warnings ++ Ws, + errors=St#compile.errors ++ Es}}; + {'EXIT',R} -> + Es = [{St#compile.ifile,[{none,compile, + {parse_transform,T,R}}]}], + {error,St#compile{errors=St#compile.errors ++ Es}}; + {warning, Forms, Ws} -> + foldl_transform( + St#compile{code=Forms, + warnings=St#compile.warnings ++ Ws}, Ts); + Forms -> + foldl_transform(St#compile{code=Forms}, Ts) + end; + false -> + Es = [{St#compile.ifile,[{none,compile, + {undef_parse_transform,T}}]}], + {error,St#compile{errors=St#compile.errors ++ Es}} end; foldl_transform(St, []) -> {ok,St}. @@ -1176,14 +1202,6 @@ expand_module(#compile{code=Code,options=Opts0}=St0) -> Opts = expand_opts(Opts1), {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}. -core_module(#compile{code=Code0,options=Opts}=St) -> - {ok,Code,Ws} = v3_core:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}. - -core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) -> - {ok,Code,Ws} = sys_core_fold:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=Warns ++ Ws}}. - core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) -> %% Inlining may produce code that generates spurious warnings. %% Ignore all warnings. @@ -1219,14 +1237,6 @@ core_inline_module(#compile{code=Code0,options=Opts}=St) -> Code = cerl_inline:core_transform(Code0, Opts), {ok,St#compile{code=Code}}. -core_dsetel_module(#compile{code=Code0,options=Opts}=St) -> - {ok,Code} = sys_core_dsetel:module(Code0, Opts), - {ok,St#compile{code=Code}}. - -kernel_module(#compile{code=Code0,options=Opts}=St) -> - {ok,Code,Ws} = v3_kernel:module(Code0, Opts), - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}. - save_abstract_code(#compile{ifile=File}=St) -> case abstract_code(St) of {ok,Code} -> @@ -1235,7 +1245,8 @@ save_abstract_code(#compile{ifile=File}=St) -> {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}} end. -abstract_code(#compile{code=Code,options=Opts,ofile=OFile}) -> +abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) -> + Code = erl_parse:anno_to_term(Code0), Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]), case member(encrypt_debug_info, Opts) of true -> diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 2a40c1c379..0bfd998301 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -45,6 +45,7 @@ cerl, cerl_clauses, cerl_inline, + cerl_sets, cerl_trees, compile, core_scan, @@ -69,5 +70,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-7.0", - "crypto-3.3"]}]}. + {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-7.0", + "crypto-3.6"]}]}. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 0d020578f5..102a6951e8 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -70,7 +70,8 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, - reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]). + reverse/1,reverse/2,member/2,nth/2,flatten/1, + unzip/1,keyfind/3]). -import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]). @@ -91,10 +92,10 @@ -endif. %% Variable value info. --record(sub, {v=[], %Variable substitutions - s=[], %Variables in scope - t=[], %Types - in_guard=false}). %In guard or not. +-record(sub, {v=[], %Variable substitutions + s=cerl_sets:new() :: cerl_sets:set(), %Variables in scope + t=#{} :: map(), %Types + in_guard=false}). %In guard or not. -type type_info() :: cerl:cerl() | 'bool' | 'integer'. -type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. @@ -1122,7 +1123,7 @@ let_substs(Vs0, As0, Sub0) -> {Vs2,As1,Ss} = let_substs_1(Vs1, As0, Sub1), Sub2 = sub_add_scope([V || #c_var{name=V} <- Vs2], Sub1), {Vs2,As1, - foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub2, Ss)}. + foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub2, Ss)}. let_substs_1(Vs, #c_values{es=As}, Sub) -> let_subst_list(Vs, As, Sub); @@ -1241,10 +1242,10 @@ is_subst(_) -> false. %% to force renaming if variables in the scope occurs as pattern %% variables. -sub_new() -> #sub{v=orddict:new(),s=gb_trees:empty(),t=[]}. +sub_new() -> #sub{v=orddict:new(),s=cerl_sets:new(),t=#{}}. sub_new(#sub{}=Sub) -> - Sub#sub{v=orddict:new(),t=[]}. + Sub#sub{v=orddict:new(),t=#{}}. sub_new_preserve_types(#sub{}=Sub) -> Sub#sub{v=orddict:new()}. @@ -1261,16 +1262,16 @@ sub_set_var(#c_var{name=V}, Val, Sub) -> sub_set_name(V, Val, #sub{v=S,s=Scope,t=Tdb0}=Sub) -> Tdb1 = kill_types(V, Tdb0), Tdb = copy_type(V, Val, Tdb1), - Sub#sub{v=orddict:store(V, Val, S),s=gb_sets:add(V, Scope),t=Tdb}. + Sub#sub{v=orddict:store(V, Val, S),s=cerl_sets:add_element(V, Scope),t=Tdb}. sub_del_var(#c_var{name=V}, #sub{v=S,s=Scope,t=Tdb}=Sub) -> %% Profiling shows that for programs with many record operations, %% sub_del_var/2 is a bottleneck. Since the scope contains all %% variables that are live, we know that V cannot be present in S %% if it is not in the scope. - case gb_sets:is_member(V, Scope) of + case cerl_sets:is_element(V, Scope) of false -> - Sub#sub{s=gb_sets:insert(V, Scope)}; + Sub#sub{s=cerl_sets:add_element(V, Scope)}; true -> Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)} end. @@ -1281,12 +1282,12 @@ sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) -> sub_add_scope(Vs, #sub{s=Scope0}=Sub) -> Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) -> - gb_sets:add(V, S) + cerl_sets:add_element(V, S) end, Scope0, Vs), Sub#sub{s=Scope}. sub_subst_scope(#sub{v=S0,s=Scope}=Sub) -> - S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0, + S = [{-1,#c_var{name=Sv}} || Sv <- cerl_sets:to_list(Scope)]++S0, Sub#sub{v=S}. sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) -> @@ -1294,7 +1295,7 @@ sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) -> %% became the new bottleneck. Since the scope contains all %% live variables, a variable V can only be the target for %% a substitution if it is in the scope. - gb_sets:is_member(V, Scope) andalso v_is_value(V, S). + cerl_sets:is_element(V, Scope) andalso v_is_value(V, S). v_is_value(Var, [{_,#c_var{name=Var}}|_]) -> true; v_is_value(Var, [_|T]) -> v_is_value(Var, T); @@ -1624,12 +1625,11 @@ eval_case(Case, _) -> Case. eval_case_warn(#c_primop{anno=Anno, name=#c_literal{val=match_fail}, - args=[#c_literal{val=Reason}]}=Core) - when is_atom(Reason) -> - case member(eval_failure, Anno) of + args=[_]}=Core) -> + case keyfind(eval_failure, 1, Anno) of false -> ok; - true -> + {eval_failure,Reason} -> %% Example: M = not_map, M#{k:=v} add_warning(Core, {eval_failure,Reason}) end; @@ -1760,8 +1760,9 @@ case_opt_compiler_generated(Core) -> %% return Expr0 unchanged. %% case_expand_var(E, #sub{t=Tdb}) -> - case orddict:find(cerl:var_name(E), Tdb) of - {ok,T0} -> + Key = cerl:var_name(E), + case Tdb of + #{Key:=T0} -> case cerl:is_c_tuple(T0) of false -> E; @@ -1785,7 +1786,7 @@ case_expand_var(E, #sub{t=Tdb}) -> E end end; - error -> + _ -> E end. @@ -2147,7 +2148,7 @@ is_bool_expr_list([], _) -> true. %% functions, or is_record/2). %% is_safe_bool_expr(Core, Sub) -> - is_safe_bool_expr_1(Core, Sub, gb_sets:empty()). + is_safe_bool_expr_1(Core, Sub, cerl_sets:new()). is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_record}, @@ -2193,7 +2194,7 @@ is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) -> true -> case {is_safe_bool_expr_1(Arg, Sub, BoolVars),Vars} of {true,[#c_var{name=V}]} -> - is_safe_bool_expr_1(B, Sub, gb_sets:add(V, BoolVars)); + is_safe_bool_expr_1(B, Sub, cerl_sets:add_element(V, BoolVars)); {false,_} -> is_safe_bool_expr_1(B, Sub, BoolVars) end; @@ -2202,7 +2203,7 @@ is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) -> is_safe_bool_expr_1(#c_literal{val=Val}, _Sub, _) -> is_boolean(Val); is_safe_bool_expr_1(#c_var{name=V}, _Sub, BoolVars) -> - gb_sets:is_element(V, BoolVars); + cerl_sets:is_element(V, BoolVars); is_safe_bool_expr_1(_, _, _) -> false. is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> @@ -2236,7 +2237,7 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, %% in <InnerBody> %% Arg = body(Arg0, Sub0), - ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}), + ScopeSub0 = sub_subst_scope(Sub0#sub{t=#{}}), {OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0), OuterBody = body(OuterBody0, ScopeSub), @@ -2275,15 +2276,15 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, CaVars0 = Ca0#c_clause.pats, G0 = Ca0#c_clause.guard, B0 = Ca0#c_clause.body, - ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}), + ScopeSub0 = sub_subst_scope(Sub0#sub{t=#{}}), {CaVars,ScopeSub} = pattern_list(CaVars0, ScopeSub0), G = guard(G0, ScopeSub), B1 = body(B0, ScopeSub), {Lvs,B2,Sub1} = let_substs(Lvs0, B1, Sub0), - Sub2 = Sub1#sub{s=gb_sets:union(ScopeSub#sub.s, - Sub1#sub.s)}, + Sub2 = Sub1#sub{s=cerl_sets:union(ScopeSub#sub.s, + Sub1#sub.s)}, Lbody = body(Lbody0, Sub2), B = Let#c_let{vars=Lvs,arg=core_lib:make_values(B2),body=Lbody}, @@ -2532,18 +2533,35 @@ maybe_suppress_warnings(Arg, _, _, effect) -> %% Don't suppress any warnings in effect context. Arg; maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> - case suppress_warning(Arg) of + case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. false -> case is_any_var_used(Vs, PrevBody) of true -> - cerl:set_ann(Arg, [compiler_generated]); + suppress_warning([Arg]); false -> Arg end end. +%% Suppress warnings for a Core Erlang expression whose value will +%% be ignored. +suppress_warning([H|T]) -> + case cerl:is_literal(H) of + true -> + suppress_warning(T); + false -> + case cerl:is_data(H) of + true -> + suppress_warning(cerl:data_es(H) ++ T); + false -> + Arg = cerl:set_ann(H, [compiler_generated]), + cerl:c_seq(Arg, suppress_warning(T)) + end + end; +suppress_warning([]) -> void(). + move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, body=InnerArg0}=Outer, clauses=InnerClauses}=Inner, Sub) -> @@ -2557,7 +2575,7 @@ move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, %% let <OuterVars> = <OuterArg> %% in case <InnerArg> of <InnerClauses> end %% - ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + ScopeSub0 = sub_subst_scope(Sub#sub{t=#{}}), {OuterVars,ScopeSub} = pattern_list(OuterVars0, ScopeSub0), InnerArg = body(InnerArg0, ScopeSub), Outer#c_let{vars=OuterVars,arg=OuterArg, @@ -2586,7 +2604,7 @@ move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, %% <OuterCb> %% end %% - ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + ScopeSub0 = sub_subst_scope(Sub#sub{t=#{}}), {OuterPats,ScopeSub} = pattern_list(OuterPats0, ScopeSub0), OuterGuard = guard(OuterGuard0, ScopeSub), InnerArg = body(InnerArg0, ScopeSub), @@ -2671,9 +2689,9 @@ is_any_var_used([], _) -> false. -spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'. get_type(#c_var{name=V}, #sub{t=Tdb}) -> - case orddict:find(V, Tdb) of - {ok,Type} -> Type; - error -> none + case Tdb of + #{V:=Type} -> Type; + _ -> none end; get_type(C, _) -> case cerl:type(C) of @@ -2788,35 +2806,38 @@ update_types_1(#c_var{name=V,anno=Anno}, Pat, Types) -> update_types_1(_, _, Types) -> Types. update_types_2(V, [#c_tuple{}=P], Types) -> - orddict:store(V, P, Types); + Types#{V=>P}; update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> - orddict:store(V, bool, Types); + Types#{V=>bool}; update_types_2(V, [Type], Types) when is_atom(Type) -> - orddict:store(V, Type, Types); + Types#{V=>Type}; update_types_2(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, %% either in the key or in the value. -kill_types(V, [{V,_}|Tdb]) -> - kill_types(V, Tdb); -kill_types(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) -> +kill_types(V, Tdb) -> + maps:from_list(kill_types2(V,maps:to_list(Tdb))). + +kill_types2(V, [{V,_}|Tdb]) -> + kill_types2(V, Tdb); +kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) -> case core_lib:is_var_used(V, Tuple) of - false -> [Entry|kill_types(V, Tdb)]; - true -> kill_types(V, Tdb) + false -> [Entry|kill_types2(V, Tdb)]; + true -> kill_types2(V, Tdb) end; -kill_types(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) -> - [Entry|kill_types(V, Tdb)]; -kill_types(_, []) -> []. +kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) -> + [Entry|kill_types2(V, Tdb)]; +kill_types2(_, []) -> []. %% copy_type(DestVar, SrcVar, Tdb) -> Tdb' %% If the SrcVar has a type, assign it to DestVar. %% copy_type(V, #c_var{name=Src}, Tdb) -> - case orddict:find(Src, Tdb) of - {ok,Type} -> orddict:store(V, Type, Tdb); - error -> Tdb + case Tdb of + #{Src:=Type} -> Tdb#{V=>Type}; + _ -> Tdb end; copy_type(_, _, Tdb) -> Tdb. @@ -3093,7 +3114,7 @@ add_bin_opt_info(Core, Term) -> end. add_warning(Core, Term) -> - case suppress_warning(Core) of + case should_suppress_warning(Core) of true -> ok; false -> @@ -3118,7 +3139,7 @@ get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen -suppress_warning(Core) -> +should_suppress_warning(Core) -> is_compiler_generated(Core) orelse is_result_unwanted(Core). @@ -3220,12 +3241,12 @@ format_error(bin_var_used_in_guard) -> verify_scope(E, #sub{s=Scope}) -> Free0 = cerl_trees:free_variables(E), Free = [V || V <- Free0, not is_tuple(V)], %Ignore function names. - case ordsets:is_subset(Free, gb_sets:to_list(Scope)) of + case ordsets:is_subset(Free, cerl_sets:to_list(Scope)) of true -> true; false -> io:format("~p\n", [E]), io:format("~p\n", [Free]), - io:format("~p\n", [gb_sets:to_list(Scope)]), + io:format("~p\n", [cerl_sets:to_list(Scope)]), false end. -endif. diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index f99307c865..4c4628d580 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,6 @@ -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports - compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks optional_callbacks=[] :: [fa()], %Optional callbacks @@ -46,9 +45,7 @@ vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function - fcount=0, %Local fun count - bitdefault, - bittypes + fcount=0 %Local fun count }). %% module(Forms, CompileOptions) @@ -69,15 +66,12 @@ module(Fs0, Opts0) -> %% Build initial expand record. St0 = #expand{exports=PreExp, - compile=Opts, - defined=PreExp, - bitdefault = erl_bits:system_bitdefault(), - bittypes = erl_bits:system_bittypes() + defined=PreExp }, %% Expand the functions. {Tfs,St1} = forms(Fs, define_functions(Fs, St0)), %% Get the correct list of exported functions. - Exports = case member(export_all, St1#expand.compile) of + Exports = case member(export_all, Opts) of true -> gb_sets:to_list(St1#expand.defined); false -> St1#expand.exports end, @@ -85,7 +79,7 @@ module(Fs0, Opts0) -> {Ats,St3} = module_attrs(St1#expand{exports = Exports}), {Mfs,St4} = module_predef_funcs(St3), {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs, - St4#expand.compile}. + Opts}. compiler_options(Forms) -> lists:flatten([C || {attribute,_,compile,C} <- Forms]). @@ -121,7 +115,8 @@ is_fa_list(_) -> false. module_predef_funcs(St) -> {Mpf1,St1}=module_predef_func_beh_info(St), {Mpf2,St2}=module_predef_funcs_mod_info(St1), - {Mpf1++Mpf2,St2}. + Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2], + {Mpf,St2}. module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 7eec9dd62b..c9b1a45cfc 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -43,7 +43,7 @@ -export([module/2]). -import(lists, [member/2,keymember/3,keysort/2,keydelete/3, - append/1,map/2,flatmap/2,filter/2,foldl/3,foldr/3,mapfoldl/3, + append/1,flatmap/2,filter/2,foldl/3,foldr/3,mapfoldl/3, sort/1,reverse/1,reverse/2]). -import(v3_life, [vdb_find/2]). @@ -57,8 +57,7 @@ break, %Break label recv, %Receive label is_top_block, %Boolean: top block or not - functable=gb_trees:empty(), %Gb tree of local functions: - % {{Name,Arity},Label} + functable=#{}, %Map of local functions: {Name,Arity}=>Label in_catch=false, %Inside a catch or not. need_frame, %Need a stack frame. ultimate_failure %Label for ultimate match failure. @@ -121,24 +120,15 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> put_reg(V, Reg) end, [], Hvs), stk=[]}, 0, Vdb), - {B0,_Aft,St} = cg_list(Les, 0, Vdb, Bef, + {B,_Aft,St} = cg_list(Les, 0, Vdb, Bef, St3#cg{bfail=0, ultimate_failure=UltimateMatchFail, is_top_block=true}), - B = fix_bs_match_strings(B0), {Name,Arity} = NameArity, Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, {label,Fl}|B++[{label,UltimateMatchFail},if_end]], {Asm,Fl,St}. -fix_bs_match_strings([{test,bs_match_string,F,[Ctx,BinList]}|Is]) - when is_list(BinList) -> - I = {test,bs_match_string,F,[Ctx,list_to_bitstring(BinList)]}, - [I|fix_bs_match_strings(Is)]; -fix_bs_match_strings([I|Is]) -> - [I|fix_bs_match_strings(Is)]; -fix_bs_match_strings([]) -> []. - %% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. %% Generate code for a kexpr. %% Split function into two steps for clarity, not efficiency. @@ -584,7 +574,7 @@ top_level_block(Keis, Bef, MaxRegs, _St) -> (return) -> [{deallocate,FrameSz},return]; (Tuple) when is_tuple(Tuple) -> - [turn_yregs(tuple_size(Tuple), Tuple, MaxY)]; + [turn_yregs(Tuple, MaxY)]; (Other) -> [Other] end, Keis), @@ -596,14 +586,49 @@ top_level_block(Keis, Bef, MaxRegs, _St) -> %% catches work. The code generation algorithm gives a lower register %% number to the outer catch, which is wrong. -turn_yregs(0, Tp, _) -> Tp; -turn_yregs(El, Tp, MaxY) -> - turn_yregs(El-1,setelement(El,Tp,turn_yreg(element(El,Tp),MaxY)),MaxY). - -turn_yreg({yy,YY},MaxY) -> {y,MaxY-YY}; -turn_yreg({list,Ls},MaxY) -> {list, turn_yreg(Ls,MaxY)}; -turn_yreg(Ts,MaxY) when is_list(Ts) -> [turn_yreg(T,MaxY)||T<-Ts]; -turn_yreg(Other,_MaxY) -> Other. +turn_yregs({call,_,_}=I, _MaxY) -> I; +turn_yregs({call_ext,_,_}=I, _MaxY) -> I; +turn_yregs({jump,_}=I, _MaxY) -> I; +turn_yregs({label,_}=I, _MaxY) -> I; +turn_yregs({line,_}=I, _MaxY) -> I; +turn_yregs({test_heap,_,_}=I, _MaxY) -> I; +turn_yregs({bif,Op,F,A,B}, MaxY) -> + {bif,Op,F,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({gc_bif,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> + {gc_bif,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({get_tuple_element,S,N,D}, MaxY) -> + {get_tuple_element,turn_yreg(S, MaxY),N,turn_yreg(D, MaxY)}; +turn_yregs({put_tuple,Arity,D}, MaxY) -> + {put_tuple,Arity,turn_yreg(D, MaxY)}; +turn_yregs({select_val,R,F,L}, MaxY) -> + {select_val,turn_yreg(R, MaxY),F,L}; +turn_yregs({test,Op,F,L}, MaxY) -> + {test,Op,F,turn_yreg(L, MaxY)}; +turn_yregs({test,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> + {test,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({Op,A}, MaxY) -> + {Op,turn_yreg(A, MaxY)}; +turn_yregs({Op,A,B}, MaxY) -> + {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; +turn_yregs({Op,A,B,C}, MaxY) -> + {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY),turn_yreg(C, MaxY)}; +turn_yregs(Tuple, MaxY) -> + turn_yregs(tuple_size(Tuple), Tuple, MaxY). + +turn_yregs(1, Tp, _) -> + Tp; +turn_yregs(N, Tp, MaxY) -> + E = turn_yreg(element(N, Tp), MaxY), + turn_yregs(N-1, setelement(N, Tp, E), MaxY). + +turn_yreg({yy,YY}, MaxY) -> + {y,MaxY-YY}; +turn_yreg({list,Ls},MaxY) -> + {list,turn_yreg(Ls, MaxY)}; +turn_yreg([_|_]=Ts, MaxY) -> + [turn_yreg(T, MaxY) || T <- Ts]; +turn_yreg(Other, _MaxY) -> + Other. %% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) -> %% {Is,StackReg,State}. @@ -647,9 +672,7 @@ select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,select_type_test(Type),{f,Tf},[R]}, {test,is_eq_exact,{f,Vf},[R,{Type,Val}]}|Sis]; select_val_cg(Type, R, Vls0, Tf, Vf, Sis) -> - Vls1 = map(fun ({f,_Lbl} = F) -> F; - (Value) -> {Type,Value} - end, Vls0), + Vls1 = [case Value of {f,_Lbl} -> Value; _ -> {Type,Value} end || Value <- Vls0], [{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis]. select_type_test(integer) -> is_integer; @@ -682,22 +705,37 @@ select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) -> select_binary(#l{ke={val_clause,{binary,{var,V}},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) -> Int0 = clear_dead(Bef#sr{reg=Bef#sr.reg}, I, Vdb), - {Bis,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), CtxReg = fetch_var(V, Int0), Live = max_reg(Bef#sr.reg), - {[{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg}, - {bs_save2,CtxReg,{V,V}}|Bis], - Aft,St1}; + Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg}, + {bs_save2,CtxReg,{V,V}}|Bis0], + Bis = finish_select_binary(Bis1), + {Bis,Aft,St1}; select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) -> Regs = put_reg(Ivar, Bef#sr.reg), Int0 = clear_dead(Bef#sr{reg=Regs}, I, Vdb), - {Bis,Aft,St1} = match_cg(B, Vf, Int0, St0), + {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0), CtxReg = fetch_var(Ivar, Int0), Live = max_reg(Bef#sr.reg), - {[{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg}, - {bs_save2,CtxReg,{Ivar,Ivar}}|Bis], - Aft,St1}. + Bis1 = [{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg}, + {bs_save2,CtxReg,{Ivar,Ivar}}|Bis0], + Bis = finish_select_binary(Bis1), + {Bis,Aft,St1}. + +finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) -> + [I|finish_select_binary(Is)]; +finish_select_binary([{bs_save2,R,Point}=I,{test,is_eq_exact,_,_}=Test, + {bs_restore2,R,Point}|Is]) -> + [I,Test|finish_select_binary(Is)]; +finish_select_binary([{test,bs_match_string,F,[Ctx,BinList]}|Is]) + when is_list(BinList) -> + I = {test,bs_match_string,F,[Ctx,list_to_bitstring(BinList)]}, + [I|finish_select_binary(Is)]; +finish_select_binary([I|Is]) -> + [I|finish_select_binary(Is)]; +finish_select_binary([]) -> []. %% New instructions for selection of binary segments. @@ -1039,7 +1077,7 @@ protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) -> St2#cg{bfail=Pfail}), %%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]), %% Set return values to false. - Mis = map(fun ({var,V}) -> {move,{atom,false},fetch_var(V, Aft)} end, Rs), + Mis = [{move,{atom,false},fetch_var(V,Aft)}||{var,V} <- Rs], {Tis ++ [{jump,{f,Psucc}}, {label,Pfail}] ++ Mis ++ [{label,Psucc}], Aft,St3#cg{bfail=St0#cg.bfail}}. @@ -1222,13 +1260,12 @@ enter_line(_, _, _) -> local_func_label(Name, Arity, St) -> local_func_label({Name,Arity}, St). -local_func_label(Key, #cg{functable=Tab}=St0) -> - case gb_trees:lookup(Key, Tab) of - {value,Label} -> - {Label,St0}; - none -> +local_func_label(Key, #cg{functable=Map}=St0) -> + case Map of + #{Key := Label} -> {Label,St0}; + _ -> {Label,St} = new_label(St0), - {Label,St#cg{functable=gb_trees:insert(Key, Label, Tab)}} + {Label,St#cg{functable=Map#{Key => Label}}} end. %% need_stack_frame(State) -> State' @@ -1549,11 +1586,8 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), - %% The instruction needs to store keys in term sorted order - %% All keys has to be unique here - Pairs = map_pair_strip_and_termsort(Es), - %% fetch registers for values to be put into the map + Pairs = [{K,V} || {_,K,V} <- Es], List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), Live = max_reg(Bef#sr.reg), @@ -1580,16 +1614,6 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. -map_pair_strip_and_termsort(Es) -> - %% format in - %% [{map_pair,K,V}] - %% where K is for example {integer, 1} and we want to sort on 1. - Ls = [{K,V}||{_,K,V}<-Es], - lists:sort(fun ({{_,A},_}, {{_,B},_}) -> erts_internal:cmp_term(A,B) =< 0; - ({nil,_}, {{_,B},_}) -> [] =< B; - ({{_,A},_}, {nil,_}) -> A =< [] - end, Ls). - %%% %%% Code generation for constructing binaries. %%% @@ -1964,25 +1988,28 @@ clear_dead(Sr, Until, Vdb) -> stk=clear_dead_stk(Sr#sr.stk, Until, Vdb)}. clear_dead_reg(Sr, Until, Vdb) -> - Reg = map(fun ({_I,V} = IV) -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> IV; - _ -> free %Remove anything else - end; - ({reserved,_I,_V} = Reserved) -> Reserved; - (free) -> free - end, Sr#sr.reg), + Reg = [case R of + {_I,V} = IV -> + case vdb_find(V, Vdb) of + {V,_,L} when L > Until -> IV; + _ -> free %Remove anything else + end; + {reserved,_I,_V} = Reserved -> Reserved; + free -> free + end || R <- Sr#sr.reg], reserve(Sr#sr.res, Reg, Sr#sr.stk). clear_dead_stk(Stk, Until, Vdb) -> - map(fun ({V} = T) -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> T; - _ -> dead %Remove anything else - end; - (free) -> free; - (dead) -> dead - end, Stk). + [case S of + {V} = T -> + case vdb_find(V, Vdb) of + {V,_,L} when L > Until -> T; + _ -> dead %Remove anything else + end; + free -> free; + dead -> dead + end || S <- Stk]. + %% sr_merge(Sr1, Sr2) -> Sr. %% Merge two stack/register states keeping the longest of both stack @@ -2112,9 +2139,11 @@ put_stack(Val, [free|Stk]) -> [{Val}|Stk]; put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)]. put_stack_carefully(Val, Stk0) -> - case catch put_stack_carefully1(Val, Stk0) of - error -> error; - Stk1 when is_list(Stk1) -> Stk1 + try + put_stack_carefully1(Val, Stk0) + catch + throw:error -> + error end. put_stack_carefully1(_, []) -> throw(error); diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index c954d21e59..ecaecb0ff6 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -83,8 +83,6 @@ -include("core_parse.hrl"). --define(REC_OFFSET, 100000000). % Also in erl_expand_records. - %% Internal core expressions and help functions. %% N.B. annotations fields in place as normal Core expressions. @@ -170,8 +168,10 @@ form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> {Fs,[attribute(F)|As],Ws,File}. -attribute({attribute,Line,Name,Val}) -> - {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. +attribute(Attribute) -> + Fun = fun(A) -> [erl_anno:location(A)] end, + {attribute,Line,Name,Val} = erl_parse:map_anno(Fun, Attribute), + {#c_literal{val=Name, anno=Line}, #c_literal{val=Val, anno=Line}}. %% function_dump(module_info,_,_,_) -> ok; %% function_dump(Name,Arity,Format,Terms) -> @@ -538,19 +538,8 @@ expr({tuple,L,Es0}, St0) -> {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> map_build_pairs(#c_literal{val=#{}}, Es0, full_anno(L, St0), St0); -expr({map,L,M0,Es0}, St0) -> - try expr_map(M0,Es0,lineno_anno(L, St0),St0) of - {_,_,_}=Res -> Res - catch - throw:{bad_map,Warning} -> - St = add_warning(L, Warning, St0), - LineAnno = lineno_anno(L, St), - As = [#c_literal{anno=LineAnno,val=badarg}], - {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} - module=#c_literal{anno=LineAnno,val=erlang}, - name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St} - end; +expr({map,L,M,Es}, St) -> + expr_map(M, Es, L, St); expr({bin,L,Es0}, St0) -> try expr_bin(Es0, full_anno(L, St0), St0) of {_,_,_}=Res -> Res @@ -740,7 +729,7 @@ make_bool_switch(L, E, V, T, F, #core{}) -> make_bool_switch_body(L, E, V, T, F). make_bool_switch_body(L, E, V, T, F) -> - NegL = neg_line(abs_line(L)), + NegL = no_compiler_warning(L), Error = {tuple,NegL,[{atom,NegL,badarg},V]}, {'case',NegL,E, [{clause,NegL,[{atom,NegL,true}],[],[T]}, @@ -751,18 +740,21 @@ make_bool_switch_body(L, E, V, T, F) -> make_bool_switch_guard(_, E, _, {atom,_,true}, {atom,_,false}) -> E; make_bool_switch_guard(L, E, V, T, F) -> - NegL = neg_line(abs_line(L)), + NegL = no_compiler_warning(L), {'case',NegL,E, [{clause,NegL,[{atom,NegL,true}],[],[T]}, {clause,NegL,[{atom,NegL,false}],[],[F]}, {clause,NegL,[V],[],[V]} ]}. -expr_map(M0, Es0, A, St0) -> +expr_map(M0, Es0, L, St0) -> {M1,Eps0,St1} = safe(M0, St0), + Badmap = badmap_term(M1, St1), + A = lineno_anno(L, St1), + Fc = fail_clause([], [{eval_failure,badmap}|A], Badmap), case is_valid_map_src(M1) of true -> - {M2,Eps1,St2} = map_build_pairs(M1, Es0, A, St1), + {M2,Eps1,St2} = map_build_pairs(M1, Es0, full_anno(L, St1), St1), M3 = case Es0 of [] -> M1; [_|_] -> M2 @@ -775,13 +767,23 @@ expr_map(M0, Es0, A, St0) -> name=#c_literal{anno=A,val=is_map}, args=[M1]}], body=[M3]}], - Fc = fail_clause([], [eval_failure|A], #c_literal{val=badarg}), Eps = Eps0 ++ Eps1, {#icase{anno=#a{anno=A},args=[],clauses=Cs,fc=Fc},Eps,St2}; false -> - throw({bad_map,bad_map}) + %% Not a map source. The update will always fail. + St2 = add_warning(L, badmap, St1), + #iclause{body=[Fail]} = Fc, + {Fail,Eps0,St2} end. +badmap_term(_Map, #core{in_guard=true}) -> + %% The code generator cannot handle complex error reasons + %% in guards. But the exact error reason does not matter anyway + %% since it is not user-visible. + #c_literal{val=badmap}; +badmap_term(Map, #core{in_guard=false}) -> + #c_tuple{es=[#c_literal{val=badmap},Map]}. + map_build_pairs(Map, Es0, Ann, St0) -> {Es,Pre,St1} = map_build_pairs_1(Es0, St0), {ann_c_map(Ann, Map, Es),Pre,St1}. @@ -867,10 +869,10 @@ constant_bin_1(Es) -> ({float,_,F}, B) -> {value,F,B}; ({atom,_,undefined}, B) -> {value,undefined,B} end, - case catch eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of + try eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of {value,Bin,EmptyBindings} -> - Bin; - _ -> + Bin + catch error:_ -> error end. @@ -917,7 +919,7 @@ verify_suitable_fields([]) -> ok. %% (We don't need an exact result for this purpose.) count_bits(Int) -> - count_bits_1(abs_line(Int), 64). + count_bits_1(abs(Int), 64). count_bits_1(0, Bits) -> Bits; count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). @@ -2309,22 +2311,15 @@ bitstr_vars(Segs, Vs) -> lit_vars(V, lit_vars(S, Vs0)) end, Vs, Segs). -record_anno(L, St) when L >= ?REC_OFFSET -> - case member(dialyzer, St#core.opts) of - true -> - [record | lineno_anno(L - ?REC_OFFSET, St)]; - false -> - full_anno(L, St) - end; -record_anno(L, St) when L < -?REC_OFFSET -> - case member(dialyzer, St#core.opts) of +record_anno(L, St) -> + case + erl_anno:record(L) andalso member(dialyzer, St#core.opts) + of true -> - [record | lineno_anno(L + ?REC_OFFSET, St)]; + [record | lineno_anno(L, St)]; false -> full_anno(L, St) - end; -record_anno(L, St) -> - full_anno(L, St). + end. full_anno(L, #core{wanted=false}=St) -> [result_not_wanted|lineno_anno(L, St)]; @@ -2332,13 +2327,10 @@ full_anno(L, #core{wanted=true}=St) -> lineno_anno(L, St). lineno_anno(L, St) -> - {line, Line} = erl_parse:get_attribute(L, line), - if - Line < 0 -> - [-Line] ++ St#core.file ++ [compiler_generated]; - true -> - [Line] ++ St#core.file - end. + Line = erl_anno:line(L), + Generated = erl_anno:generated(L), + CompilerGenerated = [compiler_generated || Generated], + [Line] ++ St#core.file ++ CompilerGenerated. get_lineno_anno(Ce) -> case get_anno(Ce) of @@ -2346,15 +2338,8 @@ get_lineno_anno(Ce) -> A when is_list(A) -> A end. -location(L) -> - {location,Location} = erl_parse:get_attribute(L, location), - Location. - -abs_line(L) -> - erl_parse:set_line(L, fun(Line) -> abs(Line) end). - -neg_line(L) -> - erl_parse:set_line(L, fun(Line) -> -abs(Line) end). +no_compiler_warning(Anno) -> + erl_anno:set_generated(true, Anno). %% %% The following three functions are used both with cerl:cerl() and with i()'s @@ -2395,9 +2380,13 @@ format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> "binary construction will fail because of a type mismatch"; -format_error(bad_map) -> +format_error(badmap) -> "map construction will fail because of a type mismatch". -add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 -> - St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]}; -add_warning(_, _, St) -> St. +add_warning(Anno, Term, #core{ws=Ws,file=[{file,File}]}=St) -> + case erl_anno:generated(Anno) of + false -> + St#core{ws=[{File,[{erl_anno:location(Anno),?MODULE,Term}]}|Ws]}; + true -> + St + end. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 0ac1aaf158..c21b2a1505 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -114,7 +114,7 @@ copy_anno(Kdst, Ksrc) -> ff, %Current function vcount=0, %Variable counter fcount=0, %Fun counter - ds=[], %Defined variables + ds=cerl_sets:new() :: cerl_sets:set(), %Defined variables funs=[], %Fun functions free=[], %Free variables ws=[] :: [warning()], %Warnings. @@ -148,7 +148,7 @@ include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> try - St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=sets:new()}, + St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=cerl_sets:new()}, {#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1), {B1,_,St3} = ubody(B0, return, St2), %%B1 = B0, St3 = St2, %Null second pass @@ -715,15 +715,15 @@ force_variable(Ke, St0) -> %% handling. pattern(#c_var{anno=A,name=V}, _Isub, Osub, St0) -> - case sets:is_element(V, St0#kern.ds) of + case cerl_sets:is_element(V, St0#kern.ds) of true -> {New,St1} = new_var_name(St0), {#k_var{anno=A,name=New}, set_vsub(V, New, Osub), - St1#kern{ds=sets:add_element(New, St1#kern.ds)}}; + St1#kern{ds=cerl_sets:add_element(New, St1#kern.ds)}}; false -> {#k_var{anno=A,name=V},Osub, - St0#kern{ds=sets:add_element(V, St0#kern.ds)}} + St0#kern{ds=cerl_sets:add_element(V, St0#kern.ds)}} end; pattern(#c_literal{anno=A,val=Val}, _Isub, Osub, St) -> {#k_literal{anno=A,val=Val},Osub,St}; @@ -836,12 +836,23 @@ get_vsub(V, Vsub) -> set_vsub(V, S, Vsub) -> orddict:store(V, S, Vsub). -subst_vsub(V, S, Vsub0) -> - %% Fold chained substitutions. - Vsub1 = orddict:map(fun (_, V1) when V1 =:= V -> S; - (_, V1) -> V1 - end, Vsub0), - orddict:store(V, S, Vsub1). +subst_vsub(Key, New, [{K,Key}|Dict]) -> + %% Fold chained substitution. + [{K,New}|subst_vsub(Key, New, Dict)]; +subst_vsub(Key, New, [{K,_}|_]=Dict) when Key < K -> + %% Insert the new substitution here, and continue + %% look for chained substitutions. + [{Key,New}|subst_vsub_1(Key, New, Dict)]; +subst_vsub(Key, New, [{K,_}=E|Dict]) when Key > K -> + [E|subst_vsub(Key, New, Dict)]; +subst_vsub(Key, New, []) -> [{Key,New}]. + +subst_vsub_1(V, S, [{K,V}|Dict]) -> + %% Fold chained substitution. + [{K,S}|subst_vsub_1(V, S, Dict)]; +subst_vsub_1(V, S, [E|Dict]) -> + [E|subst_vsub_1(V, S, Dict)]; +subst_vsub_1(_, _, []) -> []. get_fsub(F, A, Fsub) -> case orddict:find({F,A}, Fsub) of @@ -886,7 +897,7 @@ new_vars(0, St, Vs) -> {Vs,St}. make_vars(Vs) -> [ #k_var{name=V} || V <- Vs ]. add_var_def(V, St) -> - St#kern{ds=sets:add_element(V#k_var.name, St#kern.ds)}. + St#kern{ds=cerl_sets:add_element(V#k_var.name, St#kern.ds)}. %%add_vars_def(Vs, St) -> %% Ds = foldl(fun (#k_var{name=V}, Ds) -> add_element(V, Ds) end, diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 75bd188479..ee0565efb6 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -45,7 +45,7 @@ -export([vdb_find/2]). --import(lists, [member/2,map/2,foldl/3,reverse/1,sort/1]). +-import(lists, [member/2,map/2,reverse/1,sort/1]). -import(ordsets, [add_element/2,intersection/2,union/2]). -include("v3_kernel.hrl"). @@ -68,7 +68,7 @@ functions([], Acc) -> reverse(Acc). function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> try As = var_list(Vs), - Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), + Vdb0 = init_vars(As), %% Force a top-level match! B0 = case Kb of #k_match{} -> Kb; @@ -94,14 +94,14 @@ function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1), E = expr(Ke, I, Vdb2), {[E|Es],MaxI,Vdb2}; body(Ke, I, Vdb0) -> %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), + Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0), E = expr(Ke, I, Vdb1), {[E],I,Vdb1}. @@ -150,12 +150,12 @@ expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) - %% the body and handler. Add try tag 'variable'. Ab = get_kanno(Kb), Ah = get_kanno(Kh), - Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), Tdb2 = vdb_sub(I, I+2, Tdb1), Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, 1000000, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), #l{ke={try_enter,#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}}, @@ -171,7 +171,7 @@ expr(#k_receive{anno=A,var=V,body=Kb,timeout=T,action=Ka,ret=Rs}, I, Vdb) -> %% Work out imported variables which need to be locked. Rdb = vdb_sub(I, I+1, Vdb), M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, [], - new_var(V#k_var.name, I, Rdb)), + new_vars([V#k_var.name], I, Rdb)), {Tes,_,Adb} = body(Ka, I+1, Rdb), #l{ke={receive_loop,atomic(T),variable(V),M, #l{ke=Tes,i=I+1,vdb=Adb,a=[]},var_list(Rs)}, @@ -199,12 +199,12 @@ body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, %% the body and handler. Add try tag 'variable'. Ab = get_kanno(Kb), Ah = get_kanno(Kh), - Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)), + Tdb1 = use_vars(union(Ab#k.us, Ah#k.us), I+3, Tdb0), Tdb2 = vdb_sub(I, I+2, Tdb1), Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)), #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}, @@ -400,79 +400,78 @@ is_gc_bif(Bif, Arity) -> erl_internal:new_type_test(Bif, Arity) orelse erl_internal:comp_op(Bif, Arity)). -%% new_var(VarName, I, Vdb) -> Vdb. +%% Keep track of life time for variables. +%% +%% init_vars([{var,VarName}]) -> Vdb. %% new_vars([VarName], I, Vdb) -> Vdb. -%% use_var(VarName, I, Vdb) -> Vdb. %% use_vars([VarName], I, Vdb) -> Vdb. %% add_var(VarName, F, L, Vdb) -> Vdb. +%% +%% The list of variable names for new_vars/3 and use_vars/3 +%% must be sorted. -new_var(V, I, Vdb) -> - vdb_store_new(V, I, I, Vdb). +init_vars(Vs) -> + vdb_new(Vs). -new_vars(Vs, I, Vdb0) -> - foldl(fun (V, Vdb) -> new_var(V, I, Vdb) end, Vdb0, Vs). +new_vars([], _, Vdb) -> Vdb; +new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb); +new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). -use_var(V, I, Vdb) -> +use_vars([], _, Vdb) -> + Vdb; +use_vars([V], I, Vdb) -> case vdb_find(V, Vdb) of - {V,F,L} when I > L -> vdb_update(V, F, I, Vdb); + {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb); {V,_,_} -> Vdb; - error -> vdb_store_new(V, I, I, Vdb) - end. + error -> vdb_store_new(V, {V,I,I}, Vdb) + end; +use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). -use_vars([], _, Vdb) -> Vdb; -use_vars([V], I, Vdb) -> use_var(V, I, Vdb); -use_vars(Vs, I, Vdb) -> - Res = use_vars_1(sort(Vs), Vdb, I), - %% The following line can be used as an assertion. - %% Res = foldl(fun (V, Vdb) -> use_var(V, I, Vdb) end, Vdb, Vs), - Res. +add_var(V, F, L, Vdb) -> + vdb_store_new(V, {V,F,L}, Vdb). -%% Measurements show that it is worthwhile having this special -%% function that updates/inserts several variables at once. +%% is_in_guard() -> true|false. -use_vars_1([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> - [Vd|use_vars_1(Vs, Vdb, I)]; -use_vars_1([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> - %% New variable. - [{V,I,I}|use_vars_1(Vs, Vdb, I)]; -use_vars_1([V|Vs], [{_,F,L}=Vd|Vdb], I) -> - %% Existing variable. - if - I > L ->[{V,F,I}|use_vars_1(Vs, Vdb, I)]; - true -> [Vd|use_vars_1(Vs, Vdb, I)] - end; -use_vars_1([V|Vs], [], I) -> - %% New variable. - [{V,I,I}|use_vars_1(Vs, [], I)]; -use_vars_1([], Vdb, _) -> Vdb. +is_in_guard() -> + get(guard_refc) > 0. -add_var(V, F, L, Vdb) -> - vdb_store_new(V, F, L, Vdb). +%% vdb + +vdb_new(Vs) -> + sort([{V,0,0} || {var,V} <- Vs]). vdb_find(V, Vdb) -> - %% Performance note: Profiling shows that this function accounts for - %% a lot of the execution time when huge constant terms are built. - %% Using the BIF lists:keyfind/3 is a lot faster than the - %% original Erlang version. case lists:keyfind(V, 1, Vdb) of false -> error; Vd -> Vd end. -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V < V1 -> error; -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V == V1 -> Vd; -%vdb_find(V, [{V1,F,L}=Vd|Vdb]) when V > V1 -> vdb_find(V, Vdb); -%vdb_find(V, []) -> error. +vdb_update(V, Update, [{V,_,_}|Vdb]) -> + [Update|Vdb]; +vdb_update(V, Update, [Vd|Vdb]) -> + [Vd|vdb_update(V, Update, Vdb)]. -vdb_update(V, F, L, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_update(V, F, L, Vdb)]; -vdb_update(V, F, L, [{V1,_,_}|Vdb]) when V == V1 -> - [{V,F,L}|Vdb]. +vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 -> + [Vd|vdb_store_new(V, New, Vdb)]; +vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 -> + [New|Vdb]; +vdb_store_new(_, New, []) -> [New]. -vdb_store_new(V, F, L, [{V1,_,_}=Vd|Vdb]) when V > V1 -> - [Vd|vdb_store_new(V, F, L, Vdb)]; -vdb_store_new(V, F, L, [{V1,_,_}|_]=Vdb) when V < V1 -> [{V,F,L}|Vdb]; -vdb_store_new(V, F, L, []) -> [{V,F,L}]. +vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 -> + [Vd|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, Vdb, I)]; +vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) -> + %% Existing variable. + if + I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)]; + true -> [Vd|vdb_update_vars(Vs, Vdb, I)] + end; +vdb_update_vars([V|Vs], [], I) -> + %% New variable. + [{V,I,I}|vdb_update_vars(Vs, [], I)]; +vdb_update_vars([], Vdb, _) -> Vdb. %% vdb_sub(Min, Max, Vdb) -> Vdb. %% Extract variables which are used before and after Min. Lock @@ -482,8 +481,3 @@ vdb_sub(Min, Max, Vdb) -> [ if L >= Max -> {V,F,locked}; true -> Vd end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ]. - -%% is_in_guard() -> true|false. - -is_in_guard() -> - get(guard_refc) > 0. |