diff options
Diffstat (limited to 'lib/compiler/src')
28 files changed, 1003 insertions, 785 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 2032392821..7c4cebdc28 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -159,6 +159,10 @@ $(EBIN)/beam_asm.beam: $(ESRC)/beam_asm.erl $(EGEN)/beam_opcodes.hrl $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $< +# Inlining core_parse is slow and has no benefit. +$(EBIN)/core_parse.beam: $(EGEN)/core_parse.erl + $(V_ERLC) $(subst +inline,,$(ERL_COMPILE_FLAGS)) -o$(EBIN) $< + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- 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 92f09e400c..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, @@ -252,13 +243,6 @@ combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> %% opt([Instruction]) -> [Instruction] %% Optimize the instruction stream inside a basic block. -opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, - {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) -> - %% Get rid of the 'not' if the operation can be inverted. - case inverse_comp_op(Bif) of - none -> [I1,I2|opt(Is)]; - RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] - end; opt([{set,[X],[X],move}|Is]) -> opt(Is); opt([{set,_,_,{line,_}}=Line1, {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, @@ -428,18 +412,6 @@ x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. -%% inverse_comp_op(Op) -> none|RevOp - -inverse_comp_op('=:=') -> '=/='; -inverse_comp_op('=/=') -> '=:='; -inverse_comp_op('==') -> '/='; -inverse_comp_op('/=') -> '=='; -inverse_comp_op('>') -> '=<'; -inverse_comp_op('<') -> '>='; -inverse_comp_op('>=') -> '<'; -inverse_comp_op('=<') -> '>'; -inverse_comp_op(_) -> none. - %%% %%% Evaluation of constant bit fields. %%% diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index a452d30b61..5ed9c16d61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -787,6 +787,9 @@ is_not_used(R, Is, Label, #st{ll=Ll}) -> initialized_regs(Is) -> initialized_regs(Is, ordsets:new()). +initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) -> + Regs = add_init_regs(free_vars_regs(Live), Regs0), + add_init_regs(Dst, Regs); initialized_regs([{set,Dst,Src,_}|Is], Regs) -> initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs))); initialized_regs([{test,_,_,Src}|Is], Regs) -> diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index d54c2a9fde..2a15c1ddf3 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 @@ -542,16 +542,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 +563,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 +615,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 7cd07dc3be..5932d8ce1d 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -98,6 +98,12 @@ move_move_into_block([], Acc) -> reverse(Acc). forward(Is, Lc) -> forward(Is, gb_trees:empty(), Lc, []). +forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) -> + %% move/2 followed by jump/1 is optimized by backward/3. + forward([Move,{jump,{f,L}}|Is], D, Lc, Acc); +forward([{bif,_,_,_,_}=Bif|[{label,L}|_]=Is], D, Lc, Acc) -> + %% bif/4 followed by jump/1 is optimized by backward/3. + forward([Bif,{jump,{f,L}}|Is], D, Lc, Acc); forward([{block,[]}|Is], D, Lc, Acc) -> %% Empty blocks can prevent optimizations. forward(Is, D, Lc, Acc); @@ -124,6 +130,8 @@ forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> _ -> Is0 %Keep move instruction. end, forward(Is, D, Lc, [LblI|Acc]); +forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) -> + forward(Is, D, Lc, Acc); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> forward([I,{block,Bl}|Is], D, Lc, Acc); @@ -234,10 +242,8 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> Fail = shortcut_bs_test(Fail1, Is, D), Sel = {select,select_val,Reg,{f,Fail},List}, backward(Is, D, [Sel|Acc]); -backward([{jump,{f,To0}},{move,Src0,Reg}|Is], D, Acc) -> - To1 = shortcut_select_label(To0, Reg, Src0, D), - {To,Src} = shortcut_boolean_label(To1, Reg, Src0, D), - Move = {move,Src,Reg}, +backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> + To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, case beam_utils:is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); @@ -249,6 +255,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}, @@ -330,16 +346,6 @@ shortcut_label(To0, D) -> shortcut_select_label(To, Reg, Lit, D) -> shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). -shortcut_boolean_label(To0, Reg, {atom,Bool0}=Lit, D) when is_boolean(Bool0) -> - case beam_utils:code_at(To0, D) of - [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> - Bool = {atom,not Bool0}, - {shortcut_select_label(To, Reg, Bool, D),Bool}; - _ -> - {To0,Lit} - end; -shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}. - %% Replace a comparison operator with a test instruction and a jump. %% For example, if we have this code: %% @@ -463,8 +469,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..68dc104dd3 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -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. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index ba71d4efae..52b6464c7f 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], @@ -509,10 +509,7 @@ rem_unused([{label,Lbl}=I|Is0], Used, [Prev|_]=Acc) -> case gb_sets:is_member(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); @@ -533,6 +530,10 @@ initial_labels([{label,Lbl}|Is], Acc) -> initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) -> gb_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 %% (i.e. not with labels in call instructions) referenced by 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_peep.erl b/lib/compiler/src/beam_peep.erl index 97a8c7ba70..5abacc8d5d 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -108,14 +108,14 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> %% has succeeded. peep(Is, gb_sets:empty(), [I|Acc]); true -> - Test = {Op,Ops}, - case gb_sets:is_element(Test, SeenTests0) of + case is_test_redundant(Op, Ops, SeenTests0) of true -> - %% This test has already succeeded and + %% This test or a similar test has already succeeded and %% is therefore redundant. peep(Is, SeenTests0, Acc); false -> %% Remember that we have seen this test. + Test = {Op,Ops}, SeenTests = gb_sets:insert(Test, SeenTests0), peep(Is, SeenTests, [I|Acc]) end @@ -136,6 +136,15 @@ peep([I|Is], _, Acc) -> peep(Is, gb_sets:empty(), [I|Acc]); peep([], _, Acc) -> reverse(Acc). +is_test_redundant(Op, Ops, Seen) -> + gb_sets:is_element({Op,Ops}, Seen) orelse + is_test_redundant_1(Op, Ops, Seen). + +is_test_redundant_1(is_boolean, [R], Seen) -> + gb_sets:is_element({is_eq_exact,[R,{atom,false}]}, Seen) orelse + gb_sets:is_element({is_eq_exact,[R,{atom,true}]}, Seen); +is_test_redundant_1(_, _, _) -> false. + kill_seen(Dst, Seen0) -> gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)). 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..4731b5e78e 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) -> 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.erl b/lib/compiler/src/cerl.erl index 3d4b9ee0c6..ea960abc1a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -138,7 +138,8 @@ ]). -export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, - c_literal/0, c_map/0, c_map_pair/0, c_module/0, c_tuple/0, + c_let/0, c_literal/0, c_map/0, c_map_pair/0, + c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). -include("core_parse.hrl"). @@ -255,7 +256,7 @@ %% @see c_primop/2 %% @see c_receive/1 %% @see c_seq/2 -%% @see c_try/3 +%% @see c_try/5 %% @see c_tuple/1 %% @see c_values/1 %% @see c_var/1 @@ -1455,7 +1456,7 @@ is_proper_list(_) -> %% X4]</code>. %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_length/1 %% @see make_list/2 @@ -1486,7 +1487,7 @@ abstract_list([]) -> %% efficient.</p> %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_elements/1 @@ -1991,7 +1992,7 @@ update_c_fname(Node, Atom, Arity) -> %% %% @see c_fname/2 %% @see c_var/1 -%% @see c_var_name/1 +%% @see var_name/1 -spec is_c_fname(cerl()) -> boolean(). @@ -3669,7 +3670,7 @@ c_try(Expr, Vs, Body, Evs, Handler) -> %% @spec ann_c_try(As::[term()], Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec ann_c_try([term()], cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3682,7 +3683,7 @@ ann_c_try(As, Expr, Vs, Body, Evs, Handler) -> %% @spec update_c_try(Old::cerl(), Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec update_c_try(c_try(), cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3697,7 +3698,7 @@ update_c_try(Node, Expr, Vs, Body, Evs, Handler) -> %% @doc Returns <code>true</code> if <code>Node</code> is an abstract %% try-expression, otherwise <code>false</code>. %% -%% @see c_try/3 +%% @see c_try/5 -spec is_c_try(cerl()) -> boolean(). @@ -3711,7 +3712,7 @@ is_c_try(_) -> %% %% @doc Returns the expression subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_arg(c_try()) -> cerl(). @@ -3724,7 +3725,7 @@ try_arg(Node) -> %% @doc Returns the list of success variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_vars(c_try()) -> [cerl()]. @@ -3736,7 +3737,7 @@ try_vars(Node) -> %% %% @doc Returns the success body subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_body(c_try()) -> cerl(). @@ -3749,7 +3750,7 @@ try_body(Node) -> %% @doc Returns the list of exception variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_evars(c_try()) -> [cerl()]. @@ -3762,7 +3763,7 @@ try_evars(Node) -> %% @doc Returns the exception body subtree of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_handler(c_try()) -> cerl(). @@ -3784,7 +3785,7 @@ try_handler(Node) -> %% @see update_c_catch/2 %% @see is_c_catch/1 %% @see catch_body/1 -%% @see c_try/3 +%% @see c_try/5 -spec c_catch(cerl()) -> c_catch(). 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_trees.erl b/lib/compiler/src/cerl_trees.erl index b93da8e97f..f1bf0e02e7 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -19,7 +19,7 @@ %% @doc Basic functions on Core Erlang abstract syntax trees. %% %% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> +%% href="cerl"><code>cerl</code></a>.</p> %% %% @type cerl() = cerl:cerl() diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index f347438509..22810c910c 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]), + eprof:start_profiling([self()]), + Val = (catch Fun(St)), + eprof:stop_profiling(), + 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 -> @@ -1295,8 +1306,9 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> list_to_binary([0,length(TypeString),TypeString,Bin]). random_bytes(N) -> - {A,B,C} = now(), - _ = random:seed(A, B, C), + _ = random:seed(erlang:time_offset(), + erlang:monotonic_time(), + erlang:unique_integer()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index fbaa7a96fe..2a40c1c379 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -69,5 +69,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-7.0", "crypto-3.3"]}]}. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ea1959d0f8..6f8279f65e 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]). @@ -96,7 +97,7 @@ t=[], %Types in_guard=false}). %In guard or not. --type type_info() :: cerl:cerl() | 'bool'. +-type type_info() :: cerl:cerl() | 'bool' | 'integer'. -type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. -type sub() :: #sub{}. @@ -297,7 +298,8 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> Seq0#c_seq{arg=Arg,body=B1} end end; -expr(#c_let{}=Let, Ctxt, Sub) -> +expr(#c_let{}=Let0, Ctxt, Sub) -> + Let = opt_case_in_let(Let0), case simplify_let(Let, Sub) of impossible -> %% The argument for the let is "simple", i.e. has no @@ -829,16 +831,16 @@ eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> maybe -> Call; no -> #c_literal{val=false} end; -eval_rel_op(Call, '==', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '==', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, Call#c_call{name=Name}; false -> Call end; -eval_rel_op(Call, '/=', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '/=', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, Call#c_call{name=Name}; @@ -847,11 +849,17 @@ eval_rel_op(Call, '/=', Ops, _Sub) -> end; eval_rel_op(Call, _, _, _) -> Call. -is_exact_eq_ok([#c_literal{val=Lit}|_]) -> +is_exact_eq_ok([A,B]=L, Sub) -> + case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of + true -> true; + false -> is_exact_eq_ok_1(L) + end. + +is_exact_eq_ok_1([#c_literal{val=Lit}|_]) -> is_non_numeric(Lit); -is_exact_eq_ok([_|T]) -> - is_exact_eq_ok(T); -is_exact_eq_ok([]) -> false. +is_exact_eq_ok_1([_|T]) -> + is_exact_eq_ok_1(T); +is_exact_eq_ok_1([]) -> false. is_non_numeric([H|T]) -> is_non_numeric(H) andalso is_non_numeric(T); @@ -963,7 +971,7 @@ eval_element(Call, #c_literal{val=Pos}, Tuple, Types) 1 =< Pos, Pos =< length(Es) -> El = lists:nth(Pos, Es), try - pat_to_expr(El) + cerl:set_ann(pat_to_expr(El), [compiler_generated]) catch throw:impossible -> Call @@ -1008,28 +1016,32 @@ eval_is_record(Call, _, _, _, _) -> Call. %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. %% Evaluates setelement/3 if position Pos is an integer -%% the shape of the tuple Tuple is known. +%% and the shape of the tuple Tuple is known. %% -eval_setelement(Call, Pos, Tuple, NewVal) -> - try - eval_setelement_1(Pos, Tuple, NewVal) - catch - error:_ -> - Call - end. - -eval_setelement_1(#c_literal{val=Pos}, #c_tuple{anno=A,es=Es}, NewVal) +eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) when is_integer(Pos) -> - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)); -eval_setelement_1(#c_literal{val=Pos}, #c_literal{anno=A,val=Es0}, NewVal) - when is_integer(Pos) -> - Es = [#c_literal{anno=A,val=E} || E <- tuple_to_list(Es0)], - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)). + case cerl:is_data(Tuple) of + false -> + Call; + true -> + Es0 = case cerl:is_c_tuple(Tuple) of + false -> []; + true -> cerl:tuple_es(Tuple) + end, + if + 1 =< Pos, Pos =< length(Es0) -> + Es = eval_setelement_1(Pos, Es0, NewVal), + cerl:update_c_tuple(Tuple, Es); + true -> + eval_failure(Call, badarg) + end + end; +eval_setelement(Call, _, _, _) -> Call. -eval_setelement_2(1, [_|T], NewVal) -> +eval_setelement_1(1, [_|T], NewVal) -> [NewVal|T]; -eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_2(Pos-1, T, NewVal)]. +eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> + [H|eval_setelement_1(Pos-1, T, NewVal)]. %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with @@ -1613,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; @@ -1955,46 +1966,125 @@ letify(Bs, Body) -> cerl:ann_c_let(Ann, [V], Val, B) end, Body, Bs). -%% opt_case_in_let(LetExpr) -> LetExpr' +%% opt_not_in_let(Let) -> Cerl +%% Try to optimize away a 'not' operator in a 'let'. -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> - opt_case_in_let_0(Vs, Arg, B, Let, Sub). +-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl(). -opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> - case opt_case_in_let_1(V, Arg, Cs) of - impossible -> - case is_simple_case_arg(Arg) andalso - not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of - true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); - false -> - Let +opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) -> + case opt_not_in_let(Vs0, Arg0, Body0) of + {[],#c_values{es=[]},Body} -> + Body; + {Vs,Arg,Body} -> + Let#c_let{vars=Vs,arg=Arg,body=Body} + end; +opt_not_in_let(Let) -> Let. + +%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'} +%% Try to optimize away a 'not' operator in a 'let'. + +-spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) -> + {[cerl:c_var()],cerl:cerl(),cerl:cerl()}. + +opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) -> + case cerl:type(Body0) of + call -> + %% let <V> = Expr in not V ==> + %% let <> = <> in notExpr + case opt_not_in_let_1(V, Body0, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Body} -> + {[],#c_values{es=[]},Body} end; - Expr -> Expr + 'let' -> + %% let <V> = Expr in let <Var> = not V in Body ==> + %% let <Var> = notExpr in Body + %% V must not be used in Body. + LetArg = cerl:let_arg(Body0), + case opt_not_in_let_1(V, LetArg, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Arg} -> + LetBody = cerl:let_body(Body0), + case core_lib:is_var_used(V, LetBody) of + true -> + {Vs0,Arg0,Body0}; + false -> + LetVars = cerl:let_vars(Body0), + {LetVars,Arg,LetBody} + end + end; + _ -> + {Vs0,Arg0,Body0} end; -opt_case_in_let_0(_, _, _, Let, _) -> Let. - -opt_case_in_let_1(V, Arg, Cs) -> - try - opt_case_in_let_2(V, Arg, Cs) - catch - _:_ -> impossible +opt_not_in_let(Vs, Arg, Body) -> + {Vs,Arg,Body}. + +opt_not_in_let_1(V, Call, Body) -> + case Call of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=[#c_var{name=V}]} -> + opt_not_in_let_2(Body); + _ -> + no end. -opt_case_in_let_2(V, Arg0, - [#c_clause{pats=[#c_tuple{es=Es}], - guard=#c_literal{val=true},body=B}|_]) -> +opt_not_in_let_2(#c_case{clauses=Cs0}=Case) -> + Vars = make_vars([], 1), + Body = #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=Vars}, + Cs = [begin + Let = #c_let{vars=Vars,arg=B,body=Body}, + C#c_clause{body=opt_not_in_let(Let)} + end || #c_clause{body=B}=C <- Cs0], + {yes,Case#c_case{clauses=Cs}}; +opt_not_in_let_2(#c_call{}=Call0) -> + invert_call(Call0); +opt_not_in_let_2(_) -> no. + +invert_call(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name0}, + args=[_,_]}=Call) -> + case inverse_rel_op(Name0) of + no -> no; + Name -> {yes,Call#c_call{name=#c_literal{val=Name}}} + end; +invert_call(#c_call{}) -> no. + +%% inverse_rel_op(Op) -> no | RevOp + +inverse_rel_op('=:=') -> '=/='; +inverse_rel_op('=/=') -> '=:='; +inverse_rel_op('==') -> '/='; +inverse_rel_op('/=') -> '=='; +inverse_rel_op('>') -> '=<'; +inverse_rel_op('<') -> '>='; +inverse_rel_op('>=') -> '<'; +inverse_rel_op('=<') -> '>'; +inverse_rel_op(_) -> no. - %% In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end. - %% avoid building tuples, by converting tuples to multiple values. - %% (The optimisation is not done if the built tuple is used or returned.) - true = all(fun (#c_var{}) -> true; - (_) -> false end, Es), %Only variables in tuple - false = core_lib:is_var_used(V, B), %Built tuple must not be used. - Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail. - #c_let{vars=Es,arg=Arg1,body=B}. +%% opt_bool_case_in_let(LetExpr, Sub) -> Core + +opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_1(Vs, Arg, B, Let, Sub). + +opt_case_in_let_1([#c_var{name=V}], Arg, + #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) -> + case is_simple_case_arg(Arg) of + true -> + Case = opt_bool_case(Case0#c_case{arg=Arg}), + case core_lib:is_var_used(V, Case) of + false -> expr(Case, sub_new(Sub)); + true -> Let + end; + false -> + Let + end; +opt_case_in_let_1(_, _, _, Let, _) -> Let. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2036,7 +2126,7 @@ is_bool_expr(#c_clause{body=B}, Sub) -> is_bool_expr(B, Sub); is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> Sub = case is_bool_expr(Arg, Sub0) of - true -> update_types(V, [#c_literal{val=true}], Sub0); + true -> update_types(V, [bool], Sub0); false -> Sub0 end, is_bool_expr(B, Sub); @@ -2122,38 +2212,6 @@ is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> end; is_safe_bool_expr_list([], _, _) -> true. -%% tuple_to_values(Expr, TupleArity) -> Expr' -%% Convert tuples in return position of arity TupleArity to values. -%% Throws an exception for constructs that are not handled. - -tuple_to_values(#c_tuple{es=Es}, Arity) when length(Es) =:= Arity -> - core_lib:make_values(Es); -tuple_to_values(#c_literal{val=Tuple}=Lit, Arity) when tuple_size(Tuple) =:= Arity -> - Es = [Lit#c_literal{val=E} || E <- tuple_to_list(Tuple)], - core_lib:make_values(Es); -tuple_to_values(#c_case{clauses=Cs0}=Case, Arity) -> - Cs1 = [tuple_to_values(E, Arity) || E <- Cs0], - Case#c_case{clauses=Cs1}; -tuple_to_values(#c_seq{body=B0}=Seq, Arity) -> - Seq#c_seq{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_let{body=B0}=Let, Arity) -> - Let#c_let{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_receive{clauses=Cs0,timeout=Timeout,action=A0}=Rec, Arity) -> - Cs = [tuple_to_values(E, Arity) || E <- Cs0], - A = case Timeout of - #c_literal{val=infinity} -> A0; - _ -> tuple_to_values(A0, Arity) - end, - Rec#c_receive{clauses=Cs,action=A}; -tuple_to_values(#c_clause{body=B0}=Clause, Arity) -> - B = tuple_to_values(B0, Arity), - Clause#c_clause{body=B}; -tuple_to_values(Expr, _) -> - case will_fail(Expr) of - true -> Expr; - false -> erlang:error({not_handled,Expr}) - end. - %% simplify_let(Let, Sub) -> Expr | impossible %% If the argument part of an let contains a complex expression, such %% as a let or a sequence, move the original let body into the complex @@ -2180,7 +2238,7 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, Arg = body(Arg0, Sub0), ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}), {OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0), - + OuterBody = body(OuterBody0, ScopeSub), {InnerVs,Sub} = pattern_list(InnerVs0, Sub0), @@ -2258,50 +2316,179 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> will_fail(B). +%% opt_case_in_let(Let) -> Let' +%% Try to avoid building tuples that are immediately matched. +%% A common pattern is: +%% +%% {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end +%% +%% In Core Erlang the pattern would look like this: +%% +%% let <V> = case E of +%% ... -> ... {Val1,Val2} +%% ... +%% end, +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Rewrite this to: +%% +%% let <V1,V2> = case E of +%% ... -> ... <Val1,Val2> +%% ... +%% end, +%% in +%% let <V> = {V1,V2} +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Note that the second 'case' is unchanged. The other optimizations +%% in this module will eliminate the building of the tuple and +%% rewrite the second case to: +%% +%% case <V1,V2> of +%% <A,B> -> ... <use A and B> ... +%% end +%% + +opt_case_in_let(#c_let{vars=Vs,arg=Arg0,body=B}=Let0) -> + case matches_data(Vs, B) of + {yes,TypeSig} -> + case delay_build(Arg0, TypeSig) of + no -> + Let0; + {yes,Vars,Arg,Data} -> + InnerLet = Let0#c_let{arg=Data}, + Let0#c_let{vars=Vars,arg=Arg,body=InnerLet} + end; + no -> + Let0 + end. + +matches_data([#c_var{name=V}], #c_case{arg=#c_var{name=V}, + clauses=[#c_clause{pats=[P]}|_]}) -> + case cerl:is_data(P) of + false -> + no; + true -> + case cerl:data_type(P) of + {atomic,_} -> + no; + Type -> + {yes,{Type,cerl:data_arity(P)}} + end + end; +matches_data(_, _) -> no. + +delay_build(Core, TypeSig) -> + case cerl:is_data(Core) of + true -> no; + false -> delay_build_1(Core, TypeSig) + end. + +delay_build_1(Core0, TypeSig) -> + try delay_build_expr(Core0, TypeSig) of + Core -> + {Type,Arity} = TypeSig, + Vars = make_vars([], Arity), + Data = cerl:ann_make_data([compiler_generated], Type, Vars), + {yes,Vars,Core,Data} + catch + throw:impossible -> + no + end. + +delay_build_cs([#c_clause{body=B0}=C0|Cs], TypeSig) -> + B = delay_build_expr(B0, TypeSig), + C = C0#c_clause{body=B}, + [C|delay_build_cs(Cs, TypeSig)]; +delay_build_cs([], _) -> []. + +delay_build_expr(Core, {Type,Arity}=TypeSig) -> + case cerl:is_data(Core) of + false -> + delay_build_expr_1(Core, TypeSig); + true -> + case {cerl:data_type(Core),cerl:data_arity(Core)} of + {Type,Arity} -> + core_lib:make_values(cerl:data_es(Core)); + {_,_} -> + throw(impossible) + end + end. + +delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + Case#c_case{clauses=Cs}; +delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Let#c_let{body=B}; +delay_build_expr_1(#c_receive{clauses=Cs0, + timeout=Timeout, + action=A0}=Rec, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + A = case Timeout of + #c_literal{val=infinity} -> A0; + _ -> delay_build_expr(A0, TypeSig) + end, + Rec#c_receive{clauses=Cs,action=A}; +delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Seq#c_seq{body=B}; +delay_build_expr_1(Core, _TypeSig) -> + case will_fail(Core) of + true -> Core; + false -> throw(impossible) + end. + %% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm %% Optimize a let construct that does not contain any lets in %% in its argument. -opt_simple_let(#c_let{arg=Arg0}=Let, Ctxt, Sub0) -> - Arg = body(Arg0, value, Sub0), %This is a body +opt_simple_let(Let0, Ctxt, Sub) -> + case opt_not_in_let(Let0) of + #c_let{}=Let -> + opt_simple_let_0(Let, Ctxt, Sub); + Expr -> + expr(Expr, Ctxt, Sub) + end. + +opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) -> + Arg = body(Arg0, value, Sub), %This is a body case will_fail(Arg) of true -> Arg; - false -> opt_simple_let_1(Let, Arg, Ctxt, Sub0) + false -> opt_simple_let_1(Let, Arg, Ctxt, Sub) end. opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. - {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), - BodySub = case {Vs,Args} of - {[V],[A]} -> - case is_bool_expr(A, Sub0) of - true -> - update_types(V, [#c_literal{val=true}], Sub1); - false -> - Sub1 - end; - {_,_} -> Sub1 - end, - B = body(B0, Ctxt, BodySub), - Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1). - -opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) -> + {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), + BodySub = update_let_types(Vs1, Args, Sub1), + B1 = body(B0, Ctxt, BodySub), + Arg1 = core_lib:make_values(Args), + {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1), + opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg,#c_var{name=N2}} -> + {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> case N1 =:= N2 of true -> %% let <Var> = Arg in <Var> ==> Arg - Arg; + Arg1; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar + Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)) end; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {_,Arg,#c_literal{}} -> + {Vs,Arg1,#c_literal{}} -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), E = case Ctxt of effect -> %% Throw away the literal body. @@ -2313,22 +2500,67 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) -> #c_seq{arg=Arg,body=Body} end, expr(E, Ctxt, sub_new_preserve_types(Sub)); - {Vs,Arg,Body} -> + {Vs,Arg1,Body} -> %% If none of the variables are used in the body, we can %% rewrite the let to a sequence: %% let <Var> = Arg in BodyWithoutVar ==> %% seq Arg BodyWithoutVar case is_any_var_used(Vs, Body) of false -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); true -> - Let1 = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - Let2 = opt_case_in_let(Let1, Sub), + Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, + Let2 = opt_bool_case_in_let(Let1, Sub), opt_case_in_let_arg(Let2, Ctxt, Sub) end end. +%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg' +%% Try to suppress false warnings when a variable is not used. +%% For instance, we don't expect a warning for useless building in: +%% +%% R = #r{}, %No warning expected. +%% R#r.f %Optimization would remove the reference to R. +%% +%% To avoid false warnings, we will check whether the variables were +%% referenced in the original unoptimized code. If they were, we will +%% consider the warning false and suppress it. + +maybe_suppress_warnings(Arg, _, _, effect) -> + %% Don't suppress any warnings in effect context. + Arg; +maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> + case should_suppress_warning(Arg) of + true -> + Arg; %Already suppressed. + false -> + case is_any_var_used(Vs, PrevBody) of + true -> + 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) -> @@ -2416,7 +2648,7 @@ move_case_into_arg(_, _) -> %% <> when 'true' -> %% let <Var> = Literal2 in LetBody %% end -%% +%% %% In the worst case, the size of the code could increase. %% In practice, though, substituting the literals into %% LetBody and doing constant folding will decrease the code @@ -2490,6 +2722,7 @@ is_boolean_type(Var, Sub) -> is_int_type(Var, Sub) -> case get_type(Var, Sub) of none -> maybe; + integer -> yes; C -> yes_no(cerl:is_c_int(C)) end. @@ -2504,8 +2737,58 @@ is_tuple_type(Var, Sub) -> yes_no(true) -> yes; yes_no(false) -> no. +%%% +%%% Update type information. +%%% + +update_let_types(Vs, Args, Sub) when is_list(Args) -> + update_let_types_1(Vs, Args, Sub); +update_let_types(_Vs, _Arg, Sub) -> + %% The argument is a complex expression (such as a 'case') + %% that returns multiple values. + Sub. + +update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) -> + Sub = update_types_from_expr(V, A, Sub0), + update_let_types_1(Vs, As, Sub); +update_let_types_1([], [], Sub) -> Sub. + +update_types_from_expr(V, Expr, Sub) -> + Type = extract_type(Expr, Sub), + update_types(V, [Type], Sub). + +extract_type(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name}, + args=Args}=Call, Sub) -> + case returns_integer(Name, Args) of + true -> integer; + false -> extract_type_1(Call, Sub) + end; +extract_type(Expr, Sub) -> + extract_type_1(Expr, Sub). + +extract_type_1(Expr, Sub) -> + case is_bool_expr(Expr, Sub) of + false -> Expr; + true -> bool + end. + +returns_integer(bit_size, [_]) -> true; +returns_integer('bsl', [_,_]) -> true; +returns_integer('bsr', [_,_]) -> true; +returns_integer(byte_size, [_]) -> true; +returns_integer(length, [_]) -> true; +returns_integer('rem', [_,_]) -> true; +returns_integer(size, [_]) -> true; +returns_integer(tuple_size, [_]) -> true; +returns_integer(trunc, [_]) -> true; +returns_integer(_, _) -> false. + %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. + +-spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). + update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> Tdb = update_types_1(Expr, Pat, Tdb0), Sub#sub{t=Tdb}. @@ -2525,6 +2808,8 @@ update_types_2(V, [#c_tuple{}=P], Types) -> orddict:store(V, P, Types); update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> orddict:store(V, bool, Types); +update_types_2(V, [Type], Types) when is_atom(Type) -> + orddict:store(V, Type, Types); update_types_2(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' @@ -2791,7 +3076,7 @@ bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) -> bsm_problem(P, bin_partition) end; bsm_ensure_no_partition_after([], _) -> ok. - + bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); bsm_could_match_binary(#c_cons{}) -> false; bsm_could_match_binary(#c_tuple{}) -> false; @@ -2825,7 +3110,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 -> @@ -2850,7 +3135,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). 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 cbe50b93b0..aa2ebc0f85 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -69,10 +69,8 @@ stk=[], %Stack table res=[]}). %Reserved regs: [{reserved,I,V}] -module({Mod,Exp,Attr,Forms}, Options) -> - put(?MODULE, Options), +module({Mod,Exp,Attr,Forms}, _Options) -> {Fs,St} = functions(Forms, {atom,Mod}), - erase(?MODULE), {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. functions(Forms, AtomMod) -> @@ -123,24 +121,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. @@ -586,7 +575,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), @@ -598,14 +587,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}. @@ -684,22 +708,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. @@ -924,7 +963,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> select_map(Scs, V, Tf, Vf, Bef, St0) -> Reg = fetch_var(V, Bef), {Is,Aft,St1} = - match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> + match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) end, Vf, St0, Scs), {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. @@ -1551,11 +1590,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), @@ -1582,16 +1618,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. %%% @@ -2114,9 +2140,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 3c19a209c0..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 @@ -78,13 +78,11 @@ splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). --import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, +-import(cerl, [ann_c_cons/3,ann_c_tuple/2,c_tuple/1, ann_c_map/3]). -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). @@ -1660,48 +1662,55 @@ pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> %% pat_alias(CorePat, CorePat) -> AliasPat. %% Normalise aliases. Trap bad aliases by throwing 'nomatch'. -pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; -pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; - -%% alias cons -pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) -> - pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T})); -pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> - pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T}), Cons); -pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> - ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2)); - -%% alias tuples -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) -> - Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) -> - Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) -> - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); - -%% alias maps -%% There are no literals in maps patterns (patterns are always abstract) -pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) -> - M#c_map{es=pat_alias_map_pairs(Es1++Es2)}; - -pat_alias(#c_alias{var=V1,pat=P1}, - #c_alias{var=V2,pat=P2}) -> - if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)}; - true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}} +pat_alias(#c_var{name=V1}=P, #c_var{name=V1}) -> P; +pat_alias(#c_var{name=V1}=Var, + #c_alias{var=#c_var{name=V2},pat=Pat}=Alias) -> + if + V1 =:= V2 -> + Alias; + true -> + Alias#c_alias{pat=pat_alias(Var, Pat)} + end; +pat_alias(#c_var{}=P1, P2) -> #c_alias{var=P1,pat=P2}; + +pat_alias(#c_alias{var=#c_var{name=V1}}=Alias, #c_var{name=V1}) -> + Alias; +pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1}, + #c_alias{var=#c_var{name=V2}=Var2,pat=P2}) -> + Pat = pat_alias(P1, P2), + if + V1 =:= V2 -> + #c_alias{var=Var1,pat=Pat}; + true -> + pat_alias(Var1, pat_alias(Var2, Pat)) end; -pat_alias(#c_alias{var=V1,pat=P1}, P2) -> - #c_alias{var=V1,pat=pat_alias(P1, P2)}; -pat_alias(P1, #c_alias{var=V2,pat=P2}) -> - #c_alias{var=V2,pat=pat_alias(P1, P2)}; +pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) -> + #c_alias{var=Var,pat=pat_alias(P1, P2)}; + +pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) -> + M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)}; + +pat_alias(P1, #c_var{}=Var) -> + #c_alias{var=Var,pat=P1}; +pat_alias(P1, #c_alias{pat=P2}=Alias) -> + Alias#c_alias{pat=pat_alias(P1, P2)}; + pat_alias(P1, P2) -> - case {set_anno(P1, []),set_anno(P2, [])} of - {P,P} -> P; + %% Aliases between binaries are not allowed, so the only + %% legal patterns that remain are data patterns. + case cerl:is_data(P1) andalso cerl:is_data(P2) of + false -> throw(nomatch); + true -> ok + end, + Type = cerl:data_type(P1), + case cerl:data_type(P2) of + Type -> ok; _ -> throw(nomatch) - end. + end, + Es1 = cerl:data_es(P1), + Es2 = cerl:data_es(P2), + Es = pat_alias_list(Es1, Es2), + cerl:make_data(Type, Es). %% pat_alias_list([A1], [A2]) -> [A]. @@ -2302,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)]; @@ -2325,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 @@ -2339,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 @@ -2388,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..7dff58582e 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -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 diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index cd4b5fd674..4b1f1c3f71 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=[]}, @@ -270,7 +270,7 @@ match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) -> end, Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts], - #l{ke={select,literal2(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; + #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs], @@ -297,7 +297,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) -> _ -> Ctxt0 end, B = match(Kb, Ls1, I+1, Ctxt, Vdb1), - #l{ke={val_clause,literal2(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. + #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), @@ -350,6 +350,7 @@ atomic_list(Ks) -> [atomic(K) || K <- Ks]. %% literal_list([Klit]) -> [Lit]. literal(#k_var{name=N}, _) -> {var,N}; +literal(#k_literal{val=I}, _) -> {literal,I}; literal(#k_int{val=I}, _) -> {integer,I}; literal(#k_float{val=F}, _) -> {float,F}; literal(#k_atom{val=N}, _) -> {atom,N}; @@ -358,58 +359,29 @@ literal(#k_nil{}, _) -> nil; literal(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; literal(#k_binary{segs=V}, Ctxt) -> - {binary,literal(V, Ctxt)}; + {binary,literal(V, Ctxt)}; +literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> + %% Only occurs in patterns. + {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]}; literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs, [literal(Seg, Ctxt),literal(N, Ctxt)]}; +literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> + %% Only occurs in patterns. + {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int, + [literal(N, Ctxt)]}; literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> - {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) -> + {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)}; literal(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal(K, Ctxt),literal(V, Ctxt)}; -literal(#k_literal{val=V}, _Ctxt) -> - {literal,V}. + {map_pair,literal(K, Ctxt),literal(V, Ctxt)}. literal_list(Ks, Ctxt) -> [literal(K, Ctxt) || K <- Ks]. -literal2(#k_var{name=N}, _) -> {var,N}; -literal2(#k_literal{val=I}, _) -> {literal,I}; -literal2(#k_int{val=I}, _) -> {integer,I}; -literal2(#k_float{val=F}, _) -> {float,F}; -literal2(#k_atom{val=N}, _) -> {atom,N}; -%%literal2(#k_char{val=C}, _) -> {char,C}; -literal2(#k_nil{}, _) -> nil; -literal2(#k_cons{hd=H,tl=T}, Ctxt) -> - {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]}; -literal2(#k_binary{segs=V}, Ctxt) -> - {binary,literal2(V, Ctxt)}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,[literal2(Seg, Ctxt)]}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs, - [literal2(Seg, Ctxt),literal2(N, Ctxt)]}; -literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> - {bin_int,Ctxt,literal2(S, Ctxt),U,Fs,Int, - [literal2(N, Ctxt)]}; -literal2(#k_bin_end{}, Ctxt) -> - {bin_end,Ctxt}; -literal2(#k_tuple{es=Es}, Ctxt) -> - {tuple,literal_list2(Es, Ctxt)}; -literal2(#k_map{op=Op,es=Es}, Ctxt) -> - {map,Op,literal_list2(Es, Ctxt)}; -literal2(#k_map_pair{key=K,val=V}, Ctxt) -> - {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. - -literal_list2(Ks, Ctxt) -> - [literal2(K, Ctxt) || K <- Ks]. - -%% literal_bin(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}) -> -%% {bin_seg,literal(S),U,T,Fs,[literal(Seg),literal(N)]} - %% is_gc_bif(Name, Arity) -> true|false %% Determines whether the BIF Name/Arity might do a GC. @@ -428,79 +400,68 @@ 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) -> + sort([{V,0,0} || {var,V} <- 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. - -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. - -%% Measurements show that it is worthwhile having this special -%% function that updates/inserts several variables at once. - -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)] + error -> vdb_store_new(V, {V,I,I}, Vdb) end; -use_vars_1([V|Vs], [], I) -> - %% New variable. - [{V,I,I}|use_vars_1(Vs, [], I)]; -use_vars_1([], Vdb, _) -> Vdb. +use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I). add_var(V, F, L, Vdb) -> - vdb_store_new(V, F, L, Vdb). + vdb_store_new(V, {V,F,L}, Vdb). 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 |