diff options
Diffstat (limited to 'lib/compiler/src')
51 files changed, 556 insertions, 276 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index f75beaba20..518c89d044 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index f0f2ee08c2..91e6d80da3 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012-2013. All Rights Reserved. +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 95be471de3..f6ca7a0afb 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -225,10 +225,12 @@ flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). build_attributes(Opts, SourceFile, Attr, MD5) -> + Misc0 = case SourceFile of + [] -> []; + [_|_] -> [{source,SourceFile}] + end, Misc = case member(slim, Opts) of - false -> - {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), - [{time,{Y,Mo,D,H,Mi,S}},{source,SourceFile}]; + false -> Misc0; true -> [] end, Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 10dbaf462c..a8cfdffdf3 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -58,6 +58,13 @@ blockify(Is) -> blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) -> %% Useless instruction sequence. blockify(Is, Acc); +blockify([{get_map_elements,F,S,{list,Gets}}|Is0], Acc) -> + %% A get_map_elements instruction is only safe at the beginning of + %% a block because of the failure label. + {Ss,Ds} = beam_utils:split_even(Gets), + I = {set,Ds,[S|Ss],{get_map_elements,F}}, + {Block,Is} = collect_block(Is0, [I]), + blockify(Is, [{block,Block}|Acc]); blockify([I|Is0]=IsAll, Acc) -> case collect(I) of error -> blockify(Is0, [I|Acc]); @@ -81,7 +88,9 @@ collect_block([I|Is]=Is0, Acc) -> case collect(I) of error -> {reverse(Acc),Is0}; Instr -> collect_block(Is, [Instr|Acc]) - end. + end; +collect_block([], Acc) -> + {reverse(Acc),[]}. collect({allocate,N,R}) -> {set,[],[],{alloc,R,{nozero,N,0,[]}}}; collect({allocate_zero,N,R}) -> {set,[],[],{alloc,R,{zero,N,0,[]}}}; @@ -101,9 +110,6 @@ collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; collect(remove_message) -> {set,[],[],remove_message}; collect({put_map,F,Op,S,D,R,{list,Puts}}) -> {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; -collect({get_map_elements,F,S,{list,Gets}}) -> - {Ss,Ds} = beam_utils:split_even(Gets), - {set,Ds,[S|Ss],{get_map_elements,F}}; collect({'catch'=Op,R,L}) -> {set,[R],[],{try_catch,Op,L}}; collect({'try'=Op,R,L}) -> diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index efd935f666..99e4ccb1e9 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -238,9 +238,9 @@ extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]) -> end; extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}. -extend_block_1([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> +extend_block_1([{set,[{x,_}],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> extend_block_1(Is, Fail, [I|Acc]); -extend_block_1([{set,[_],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) -> +extend_block_1([{set,[{x,_}],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) -> case safe_bool_op(Bif, length(As)) of false -> {Acc,reverse(Is0)}; true -> extend_block_1(Is, Fail, [I|Acc]) @@ -311,6 +311,8 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); +dst_regs([{protected,_,Bl,_}|Is], Acc) -> + dst_regs(Bl, dst_regs(Is, Acc)); dst_regs([_|Is], Acc) -> dst_regs(Is, Acc); dst_regs([], Acc) -> ordsets:from_list(Acc). diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl index 55fa7ce10c..2aed98d4e7 100644 --- a/lib/compiler/src/beam_bs.erl +++ b/lib/compiler/src/beam_bs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 62356928ae..286307a4be 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index d9108c383d..10805a3c36 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 11129c39bc..dd42add433 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 654fb47dbd..9565ab74c4 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2014. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 84a94f09e3..5badcce696 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl index 30e3f22665..e18214644f 100644 --- a/lib/compiler/src/beam_disasm.hrl +++ b/lib/compiler/src/beam_disasm.hrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index e33655281f..cb3a6b79de 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2013. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 13c243b155..36369bd0b4 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 3b6eb19fe8..359248c6af 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index fd5c0a042b..ce566373bb 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 0c1abfe6a0..c8bef31824 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -83,6 +83,9 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> %% Kill all remembered tests that depend on the destination register. SeenTests = kill_seen(Dst, SeenTests0), peep(Is, SeenTests, [I|Acc]); +peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) -> + %% Sometimes beam_jump has missed this optimization. + peep(Is, gb_sets:empty(), [I|Acc]); peep([{select,Op,R,F,Vls0}|Is], _, Acc) -> case prune_redundant_values(Vls0, F) of [] -> diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 7276537949..c593184746 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2013. All Rights Reserved. +%% Copyright Ericsson AB 2010-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl index 41586a7bf2..6a7c033ec6 100644 --- a/lib/compiler/src/beam_reorder.erl +++ b/lib/compiler/src/beam_reorder.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -87,6 +87,15 @@ reorder_1([{test,_,_,_}=I, %% instruction between the test instruction and the select %% instruction. reorder_1(Is, D, [S,I|Acc]); +reorder_1([{test,_,{f,_},[Src|_]}=I|Is], D, + [{get_tuple_element,Src,_,_}|_]=Acc) -> + %% We want to avoid code that can confuse beam_validator such as: + %% is_tuple Fail Src + %% test_arity Fail Src Arity + %% is_map Fail Src + %% get_tuple_element Src Pos Dst + %% Therefore, don't reorder the instructions in such cases. + reorder_1(Is, D, [I|Acc]); reorder_1([{test,_,{f,L},Ss}=I|Is0], D0, [{get_tuple_element,_,_,El}=G|Acc0]=Acc) -> case member(El, Ss) of diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index bb1c0e23a9..c83c686953 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,6 +47,8 @@ split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]); split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]); +split_block([{set,[R],As,{bif,raise,{f,_}=Fail}}|Is], Bl, Acc) -> + split_block(Is, [], [{bif,raise,Fail,As,R}|make_block(Bl, Acc)]); split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 509e013b62..a8dc6805bc 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 4b45c28623..acaf3ede66 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -513,12 +513,23 @@ update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> false -> tdb_kill_xregs(Ts) end; update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> - Op = case tdb_find({x,1}, Ts0) of - error -> kill; - Info -> Info - end, - Ts1 = tdb_kill_xregs(Ts0), - tdb_update([{{x,0},Op}], Ts1); + Ts = tdb_kill_xregs(Ts0), + case tdb_find({x,1}, Ts0) of + {tuple,Sz,_}=T0 -> + T = case tdb_find({x,0}, Ts0) of + {integer,{I,I}} when I > 1 -> + %% First element is not changed. The result + %% will have the same type. + T0; + _ -> + %% Position is 1 or unknown. May change the + %% first element of the tuple. + {tuple,Sz,[]} + end, + tdb_update([{{x,0},T}], Ts); + _ -> + Ts + end; update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); @@ -748,7 +759,7 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% %%% {tuple,Size,First} means that the corresponding register contains a %%% tuple with *at least* Size elements. An tuple with unknown -%%% size is represented as {tuple,0}. First is either [] (meaning that +%%% size is represented as {tuple,0,[]}. First is either [] (meaning that %%% the tuple's first element is unknown) or [FirstElement] (the contents %%% of the first element). %%% @@ -785,21 +796,45 @@ tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y -> error -> orddict:erase(D, Ts); Type -> orddict:store(D, Type, Ts) end; -tdb_copy(Literal, D, Ts) -> orddict:store(D, Literal, Ts). +tdb_copy(Literal, D, Ts) -> + Type = case Literal of + {atom,_} -> Literal; + {float,_} -> float; + {integer,Int} -> {integer,{Int,Int}}; + {literal,[_|_]} -> nonempty_list; + {literal,#{}} -> map; + {literal,Tuple} when tuple_size(Tuple) >= 1 -> + Lit = tag_literal(element(1, Tuple)), + {tuple,tuple_size(Tuple),[Lit]}; + _ -> term + end, + if + Type =:= term -> + orddict:erase(D, Ts); + true -> + verify_type(Type), + orddict:store(D, Type, Ts) + end. + +tag_literal(A) when is_atom(A) -> {atom,A}; +tag_literal(F) when is_float(F) -> {float,F}; +tag_literal(I) when is_integer(I) -> {integer,I}; +tag_literal([]) -> nil; +tag_literal(Lit) -> {literal,Lit}. %% tdb_update([UpdateOp], Db) -> NewDb %% UpdateOp = {Register,kill}|{Register,NewInfo} %% Updates a type database. If a 'kill' operation is given, the type %% information for that register will be removed from the database. %% A kill operation takes precedence over other operations for the same -%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5}}] means that the +%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the %% the existing type information, if any, will be discarded, and the -%% the '{tuple,5}' information ignored. +%% the '{tuple,5,[]}' information ignored. %% %% If NewInfo information is given and there exists information about %% the register, the old and new type information will be merged. -%% For instance, {tuple,5} and {tuple,10} will be merged to produce -%% {tuple,10}. +%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce +%% {tuple,10,_}. tdb_update(Uis0, Ts0) -> Uis1 = filter(fun ({{x,_},_Op}) -> true; @@ -810,7 +845,8 @@ tdb_update(Uis0, Ts0) -> tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K -> tdb_update1(remove_key(Key, Ops), Db); -tdb_update1([{Key,_New}=New|Ops], [{K,_Old}|_]=Db) when Key < K -> +tdb_update1([{Key,Type}=New|Ops], [{K,_Old}|_]=Db) when Key < K -> + verify_type(Type), [New|tdb_update1(Ops, Db)]; tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) -> tdb_update1(remove_key(Key, Ops), Db); @@ -820,7 +856,8 @@ tdb_update1([{_,_}|_]=Ops, [Old|Db]) -> [Old|tdb_update1(Ops, Db)]; tdb_update1([{Key,kill}|Ops], []) -> tdb_update1(remove_key(Key, Ops), []); -tdb_update1([{_,_}=New|Ops], []) -> +tdb_update1([{_,Type}=New|Ops], []) -> + verify_type(Type), [New|tdb_update1(Ops, [])]; tdb_update1([], Db) -> Db. @@ -855,6 +892,7 @@ merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type({atom,_}) -> ok; verify_type(boolean) -> ok; verify_type(integer) -> ok; verify_type({integer,{Min,Max}}) diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 68d6105cfa..47703b4aa3 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -25,9 +25,8 @@ is_not_used/3,is_not_used_at/3, empty_label_index/0,index_label/3,index_labels/1, code_at/2,bif_to_test/3,is_pure_test/1, - live_opt/1,delete_live_annos/1,combine_heap_needs/2]). - --export([join_even/2,split_even/1]). + live_opt/1,delete_live_annos/1,combine_heap_needs/2, + join_even/2,split_even/1]). -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). @@ -67,8 +66,7 @@ is_killed(R, Is, D) -> St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; - {used,_} -> false; - {unknown,_} -> false + {used,_} -> false end. %% is_killed_at(Reg, Lbl, State) -> true|false @@ -78,8 +76,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of {killed,_} -> true; - {used,_} -> false; - {unknown,_} -> false + {used,_} -> false end. %% is_not_used(Register, [Instruction], State) -> true|false @@ -93,8 +90,7 @@ is_not_used(R, Is, D) -> St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; - {used,_} -> false; - {unknown,_} -> false + {used,_} -> false end. %% is_not_used(Register, [Instruction], State) -> true|false @@ -108,8 +104,7 @@ is_not_used_at(R, Lbl, D) -> St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St) of {killed,_} -> true; - {used,_} -> false; - {unknown,_} -> false + {used,_} -> false end. %% index_labels(FunctionIs) -> State @@ -137,10 +132,7 @@ index_label(Lbl, Is0, Acc) -> %% Retrieve the code at the given label. code_at(L, Ll) -> - case gb_trees:lookup(L, Ll) of - {value,Code} -> Code; - none -> none - end. + gb_trees:get(L, Ll). %% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]} %% Convert a BIF to a test. Fail if not possible. @@ -164,10 +156,10 @@ bif_to_test('=<', [A,B], Fail) -> {test,is_ge,Fail,[B,A]}; bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]}; bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops}; bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops}; -bif_to_test('==', [A,[]], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops}; bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops}; -bif_to_test('=:=', [A,[]], Fail) -> {test,is_nil,Fail,[A]}; +bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]}; bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops}; bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops}; bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. @@ -235,21 +227,28 @@ combine_heap_needs(Words, {alloc,Alloc}) when is_integer(Words) -> combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> H1+H2. +%% split_even/1 +%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} + +split_even(Rs) -> split_even(Rs, [], []). + +%% join_even/1 +%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6] + +join_even([], []) -> []; +join_even([S|Ss], [D|Ds]) -> [S,D|join_even(Ss, Ds)]. + %%% %%% Local functions. %%% -%% check_liveness(Reg, [Instruction], {State,BlockCheckFun}) -> -%% {killed | used | unknown,UpdateState} -%% Finds out how Reg is used in the instruction sequence. Returns one of: -%% killed - Reg is assigned a new value or killed by an allocation instruction -%% used - Reg is used (or possibly referenced by an allocation instruction) -%% unknown - not possible to determine (perhaps because of an instruction -%% that we don't recognize) +%% check_liveness(Reg, [Instruction], #live{}) -> +%% {killed | used, #live{}} +%% Find out whether Reg is used or killed in instruction sequence. +%% 'killed' means that Reg is assigned a new value or killed by an +%% allocation instruction. 'used' means that Reg is used in some way. -check_liveness(R, [{set,_,_,_}=I|_], St) -> - erlang:error(only_allowed_in_blocks, [R,I,St]); check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) -> case BlockCheck(R, Blk, St0) of {transparent,St} -> check_liveness(R, Is, St); @@ -461,8 +460,9 @@ check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) -> {x,_} -> {killed,St}; _ -> - %% y register. Rarely happens. Be very conversative. - {unknown,St} + %% y register. Rarely happens. Be very conversative and + %% assume it's used. + {used,St} end; check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> check_liveness_at(R, Fail, St); @@ -484,6 +484,18 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> Other end end; +check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) -> + case R of + Src -> + {used,St0}; + {x,X} when X < Live -> + {used,St0}; + {x,_} -> + {killed,St0}; + {y,_} -> + %% Conservatively mark it as used. + {used,St0} + end; check_liveness(R, [{test_heap,N,Live}|Is], St) -> I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, check_liveness(R, [I|Is], St); @@ -494,12 +506,8 @@ check_liveness(R, [{get_list,S,D1,D2}|Is], St) -> I = {block,[{set,[D1,D2],[S],get_list}]}, check_liveness(R, [I|Is], St); check_liveness(_R, Is, St) when is_list(Is) -> -%% case Is of -%% [I|_] -> -%% io:format("~p ~p\n", [_R,I]); -%% _ -> ok -%% end, - {unknown,St}. + %% Not implemented. Conservatively assume that the register is used. + {used,St}. check_liveness_everywhere(R, [{f,Lbl}|T], St0) -> case check_liveness_at(R, Lbl, St0) of @@ -518,7 +526,7 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> none -> {Res,St} = case gb_trees:lookup(Lbl, Ll) of {value,Is} -> check_liveness(R, Is, St0); - none -> {unknown,St0} + none -> {used,St0} end, {Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}} end. @@ -570,9 +578,9 @@ check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> false -> check_killed_block(R, Is) end end; -check_killed_block(R, [{'%live',Live,_}|Is]) -> +check_killed_block(R, [{'%live',_,Regs}|Is]) -> case R of - {x,X} when X >= Live -> killed; + {x,X} when (Regs bsr X) band 1 =:= 0 -> killed; _ -> check_killed_block(R, Is) end; check_killed_block(_, []) -> transparent. @@ -583,8 +591,10 @@ check_killed_block(_, []) -> transparent. %% killed - Reg is assigned a new value or killed by an allocation instruction %% transparent - Reg is neither used nor killed %% used - Reg is explicitly used by an instruction -%% -%% (Unknown instructions will cause an exception.) +%% +%% '%live' annotations are not allowed. +%% +%% (Unknown instructions will cause an exception.) check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) -> if @@ -593,11 +603,6 @@ check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) -> end; check_used_block(R, [{set,Ds,Ss,Op}|Is], St) -> check_used_block_1(R, Ss, Ds, Op, Is, St); -check_used_block(R, [{'%live',Live,_}|Is], St) -> - case R of - {x,X} when X >= Live -> {killed,St}; - _ -> check_used_block(R, Is, St) - end; check_used_block(_, [], St) -> {transparent,St}. check_used_block_1(R, Ss, Ds, Op, Is, St0) -> @@ -628,8 +633,7 @@ is_reg_used_at_1(_, 0, St) -> is_reg_used_at_1(R, Lbl, St0) -> case check_liveness_at(R, Lbl, St0) of {killed,St} -> {false,St}; - {used,St} -> {true,St}; - {unknown,St} -> {true,St} + {used,St} -> {true,St} end. index_labels_1([{label,Lbl}|Is0], Acc) -> @@ -745,11 +749,6 @@ live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) -> Regs1 = x_live([Src], Regs0), Regs = live_join_labels([Fail|List], D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{'try',_,_}=I|Is], Regs, D, Acc) -> - %% If an exeption happens, all x registers will be killed. - %% Therefore, we should only base liveness of the code inside - %% the try. - live_opt(Is, Regs, D, [I|Acc]); live_opt([{try_case,_}=I|Is], _, D, Acc) -> live_opt(Is, live_call(1), D, [I|Acc]); live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) -> @@ -849,14 +848,7 @@ x_live([], Regs) -> Regs. is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. -%% split_even/1 -%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} -split_even(Rs) -> split_even(Rs,[],[]). -split_even([],Ss,Ds) -> {reverse(Ss),reverse(Ds)}; -split_even([S,D|Rs],Ss,Ds) -> - split_even(Rs,[S|Ss],[D|Ds]). - -%% join_even/1 -%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6] -join_even([],[]) -> []; -join_even([S|Ss],[D|Ds]) -> [S,D|join_even(Ss,Ds)]. +split_even([], Ss, Ds) -> + {reverse(Ss),reverse(Ds)}; +split_even([S,D|Rs], Ss, Ds) -> + split_even(Rs, [S|Ss], [D|Ds]). diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index fd38fc0095..faff9940ec 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -509,6 +509,9 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0), Vst = set_type(TupleType, Tuple, Vst1), set_type_reg(term, Dst, Vst); +valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> + validate_src(Src, Vst), + kill_state(Vst); valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> validate_src(Src, Vst0), Vst = branch_state(Fail, Vst0), @@ -1162,12 +1165,17 @@ assert_type(WantedType, Term, Vst) -> assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; assert_type(tuple, {tuple,_}) -> ok; +assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; assert_type({tuple_element,I}, {tuple,[Sz]}) when 1 =< I, I =< Sz -> ok; assert_type({tuple_element,I}, {tuple,Sz}) when is_integer(Sz), 1 =< I, I =< Sz -> ok; +assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> + ok; +assert_type(cons, {literal,[_|_]}) -> + ok; assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). @@ -1546,8 +1554,12 @@ return_type_1(erlang, setelement, 3, Vst) -> Tuple = {x,1}, TupleType = case get_term_type(Tuple, Vst) of - {tuple,_}=TT -> TT; - _ -> {tuple,[0]} + {tuple,_}=TT -> + TT; + {literal,Lit} when is_tuple(Lit) -> + {tuple,tuple_size(Lit)}; + _ -> + {tuple,[0]} end, case get_term_type({x,0}, Vst) of {integer,[]} -> TupleType; diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 8381578b68..6c7f8543c2 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,6 +24,8 @@ -export([module/2]). +-import(lists, [dropwhile/2]). + module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. @@ -51,6 +53,16 @@ undo_renames([{call,A,F},return|Is]) -> [{call_only,A,F}|undo_renames(Is)]; undo_renames([{call_ext,A,F},return|Is]) -> [{call_ext_only,A,F}|undo_renames(Is)]; +undo_renames([{bif,raise,_,_,_}=I|Is0]) -> + %% A minor optimization. Done here because: + %% (1) beam_jump may move or share 'raise' instructions, and that + %% may confuse beam_validator. + %% (2) beam_trim cannot do its optimization if the 'deallocate' + %% instruction after 'raise' has been removed. + Is = dropwhile(fun({label,_}) -> false; + (_) -> true + end, Is0), + [I|undo_renames(Is)]; undo_renames([I|Is]) -> [undo_rename(I)|undo_renames(Is)]; undo_renames([]) -> []. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index e7a2b8177a..61abae344c 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -126,6 +126,7 @@ %% keep map exports here for now c_map_pattern/1, is_c_map/1, + is_c_map_pattern/1, map_es/1, map_arg/1, update_c_map/3, @@ -134,7 +135,7 @@ ann_c_map_pattern/2, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, - c_map_pair/2, + c_map_pair/2, c_map_pair_exact/2, ann_c_map_pair/4 ]). @@ -1636,6 +1637,11 @@ is_c_map_empty(#c_map{ es=[] }) -> true; is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; is_c_map_empty(_) -> false. +-spec is_c_map_pattern(c_map()) -> boolean(). + +is_c_map_pattern(#c_map{is_pat=IsPat}) -> + IsPat. + -spec ann_c_map([term()], [c_map_pair()]) -> c_map() | c_literal(). ann_c_map(As, Es) -> @@ -1688,6 +1694,11 @@ map_pair_op(#c_map_pair{op=Op}) -> Op. c_map_pair(Key,Val) -> #c_map_pair{op=#c_literal{val=assoc},key=Key,val=Val}. +-spec c_map_pair_exact(cerl(), cerl()) -> c_map_pair(). + +c_map_pair_exact(Key,Val) -> + #c_map_pair{op=#c_literal{val=exact},key=Key,val=Val}. + -spec ann_c_map_pair([term()], cerl(), cerl(), cerl()) -> c_map_pair(). @@ -1944,7 +1955,7 @@ is_c_var(_) -> false. -%% @spec c_fname(Name::atom(), Arity::integer()) -> cerl() +%% @spec c_fname(Name::atom(), Arity::arity()) -> cerl() %% @equiv c_var({Name, Arity}) %% @see fname_id/1 %% @see fname_arity/1 @@ -1952,18 +1963,18 @@ is_c_var(_) -> %% @see ann_c_fname/3 %% @see update_c_fname/3 --spec c_fname(atom(), non_neg_integer()) -> c_var(). +-spec c_fname(atom(), arity()) -> c_var(). c_fname(Atom, Arity) -> c_var({Atom, Arity}). -%% @spec ann_c_fname(As::[term()], Name::atom(), Arity::integer()) -> +%% @spec ann_c_fname(As::[term()], Name::atom(), Arity::arity()) -> %% cerl() %% @equiv ann_c_var(As, {Atom, Arity}) %% @see c_fname/2 --spec ann_c_fname([term()], atom(), non_neg_integer()) -> c_var(). +-spec ann_c_fname([term()], atom(), arity()) -> c_var(). ann_c_fname(As, Atom, Arity) -> ann_c_var(As, {Atom, Arity}). @@ -1981,13 +1992,13 @@ update_c_fname(#c_var{name = {_, Arity}, anno = As}, Atom) -> #c_var{name = {Atom, Arity}, anno = As}. -%% @spec update_c_fname(Old::cerl(), Name::atom(), Arity::integer()) -> +%% @spec update_c_fname(Old::cerl(), Name::atom(), Arity::arity()) -> %% cerl() %% @equiv update_c_var(Old, {Atom, Arity}) %% @see update_c_fname/2 %% @see c_fname/2 --spec update_c_fname(c_var(), atom(), integer()) -> c_var(). +-spec update_c_fname(c_var(), atom(), arity()) -> c_var(). update_c_fname(Node, Atom, Arity) -> update_c_var(Node, {Atom, Arity}). @@ -2036,14 +2047,14 @@ fname_id(#c_var{name={A,_}}) -> A. -%% @spec fname_arity(cerl()) -> byte() +%% @spec fname_arity(cerl()) -> arity() %% %% @doc Returns the arity part of an abstract function name variable. %% %% @see fname_id/1 %% @see c_fname/2 --spec fname_arity(c_var()) -> byte(). +-spec fname_arity(c_var()) -> arity(). fname_arity(#c_var{name={_,N}}) -> N. @@ -2489,7 +2500,7 @@ fun_body(Node) -> Node#c_fun.body. -%% @spec fun_arity(Node::cerl()) -> integer() +%% @spec fun_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of parameter subtrees of an abstract %% fun-expression. @@ -2500,7 +2511,7 @@ fun_body(Node) -> %% @see c_fun/2 %% @see fun_vars/1 --spec fun_arity(c_fun()) -> non_neg_integer(). +-spec fun_arity(c_fun()) -> arity(). fun_arity(Node) -> length(fun_vars(Node)). @@ -3407,7 +3418,7 @@ apply_args(Node) -> Node#c_apply.args. -%% @spec apply_arity(Node::cerl()) -> integer() +%% @spec apply_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of argument subtrees of an abstract %% function application. @@ -3419,7 +3430,7 @@ apply_args(Node) -> %% @see c_apply/2 %% @see apply_args/1 --spec apply_arity(c_apply()) -> non_neg_integer(). +-spec apply_arity(c_apply()) -> arity(). apply_arity(Node) -> length(apply_args(Node)). @@ -3525,7 +3536,7 @@ call_args(Node) -> Node#c_call.args. -%% @spec call_arity(Node::cerl()) -> integer() +%% @spec call_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of argument subtrees of an abstract %% inter-module call. @@ -3537,7 +3548,7 @@ call_args(Node) -> %% @see c_call/3 %% @see call_args/1 --spec call_arity(c_call()) -> non_neg_integer(). +-spec call_arity(c_call()) -> arity(). call_arity(Node) -> length(call_args(Node)). @@ -3629,7 +3640,7 @@ primop_args(Node) -> Node#c_primop.args. -%% @spec primop_arity(Node::cerl()) -> integer() +%% @spec primop_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of argument subtrees of an abstract %% primitive operation call. @@ -3641,7 +3652,7 @@ primop_args(Node) -> %% @see c_primop/2 %% @see primop_args/1 --spec primop_arity(c_primop()) -> non_neg_integer(). +-spec primop_arity(c_primop()) -> arity(). primop_arity(Node) -> length(primop_args(Node)). diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 4d2f1ebd1b..805095e30c 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index cbcacf9e8e..2a8cf2e758 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index b86be95cab..b3decbec1f 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -61,6 +61,7 @@ map_arg/1, map_es/1, ann_c_map/3, update_c_map/3, + is_c_map_pattern/1, ann_c_map_pattern/2, map_pair_key/1,map_pair_val/1,map_pair_op/1, ann_c_map_pair/4, update_c_map_pair/4 @@ -752,10 +753,17 @@ label(T, N, Env) -> {As, N2} = label_ann(T, N1), {ann_c_tuple_skel(As, Ts), N2}; map -> - {M, N1} = label(map_arg(T), N, Env), - {Ts, N2} = label_list(map_es(T), N1, Env), - {As, N3} = label_ann(T, N2), - {ann_c_map(As, M, Ts), N3}; + case is_c_map_pattern(T) of + false -> + {M, N1} = label(map_arg(T), N, Env), + {Ts, N2} = label_list(map_es(T), N1, Env), + {As, N3} = label_ann(T, N2), + {ann_c_map(As, M, Ts), N3}; + true -> + {Ts, N1} = label_list(map_es(T), N, Env), + {As, N2} = label_ann(T, N1), + {ann_c_map_pattern(As, Ts), N2} + end; map_pair -> {Op, N1} = label(map_pair_op(T), N, Env), {Key, N2} = label(map_pair_key(T), N1, Env), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 46917905de..149086152a 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1317,7 +1317,7 @@ generate_key(String) when is_list(String) -> encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> Bin1 = case byte_size(Bin0) rem BlockSize of 0 -> Bin0; - N -> list_to_binary([Bin0,crypto:rand_bytes(BlockSize-N)]) + N -> list_to_binary([Bin0,crypto:strong_rand_bytes(BlockSize-N)]) end, Bin = crypto:block_encrypt(Type, Key, IVec, Bin1), TypeString = atom_to_list(Type), @@ -1328,7 +1328,7 @@ save_core_code(St) -> beam_asm(#compile{ifile=File,code=Code0, abstract_code=Abst,mod_options=Opts0}=St) -> - Source = filename:absname(File), + Source = paranoid_absname(File), Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'}; (Other) -> Other end, Opts0), @@ -1337,6 +1337,16 @@ beam_asm(#compile{ifile=File,code=Code0, {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}} end. +paranoid_absname(""=File) -> + File; +paranoid_absname(File) -> + case file:get_cwd() of + {ok,Cwd} -> + filename:absname(File, Cwd); + _ -> + File + end. + test_native(#compile{options=Opts}) -> %% This test is done late, in case some other option has turned off native. %% 'native' given on the command line can be overridden by @@ -1681,6 +1691,7 @@ help(_) -> %% Compile entry point for erl_compile. compile(File0, _OutFile, Options) -> + pre_load(), File = shorten_filename(File0), case file(File, make_erl_options(Options)) of {ok,_Mod} -> ok; @@ -1745,3 +1756,47 @@ make_erl_options(Opts) -> end, Options ++ [report_errors, {cwd, Cwd}, {outdir, Outdir}| [{i, Dir} || Dir <- Includes]] ++ Specific. + +pre_load() -> + L = [beam_a, + beam_asm, + beam_block, + beam_bool, + beam_bs, + beam_bsm, + beam_clean, + beam_dead, + beam_dict, + beam_except, + beam_flatten, + beam_jump, + beam_opcodes, + beam_peep, + beam_receive, + beam_reorder, + beam_split, + beam_trim, + beam_type, + beam_utils, + beam_validator, + beam_z, + cerl, + cerl_clauses, + cerl_sets, + cerl_trees, + core_lib, + epp, + erl_bifs, + erl_expand_records, + erl_lint, + erl_parse, + erl_scan, + sys_core_dsetel, + sys_core_fold, + sys_pre_expand, + v3_codegen, + v3_core, + v3_kernel, + v3_life], + _ = code:ensure_modules_loaded(L), + ok. diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index a2b2a1d277..1fd7800e85 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/compiler.appup.src b/lib/compiler/src/compiler.appup.src index 3ada2e933f..e9db37e203 100644 --- a/lib/compiler/src/compiler.appup.src +++ b/lib/compiler/src/compiler.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014. All Rights Reserved. +%% Copyright Ericsson AB 2014-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 839c736ff2..c1806272bd 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index ecf6cc9956..83a6f0179c 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index 59cfc97ebd..8028aa99bb 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -1,7 +1,7 @@ %% -*-Erlang-*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,12 +47,14 @@ receive_expr timeout try_expr sequence catch_expr variable clause clause_pattern -map_expr map_pairs map_pair map_pair_assoc map_pair_exact +map_expr anno_map_expr map_pairs anno_map_pair map_pair map_pair_assoc map_pair_exact map_pattern map_pair_patterns map_pair_pattern -annotation anno_fun anno_expression anno_expressions +annotation anno_atom anno_fun anno_expression anno_expressions anno_variable anno_variables anno_pattern anno_patterns anno_function_name +anno_literal +anno_segment anno_segment_pattern anno_clause anno_clauses. Terminals @@ -90,7 +92,7 @@ module_definition -> module_definition -> '(' 'module' atom module_export module_attribute module_defs 'end' '-|' annotation ')' : - #c_module{anno='$9',name=tok_val('$3'),exports='$4', + #c_module{anno='$9',name=#c_literal{val=tok_val('$3')},exports='$4', attrs='$5',defs='$6'}. module_export -> '[' ']' : []. @@ -99,7 +101,7 @@ module_export -> '[' exported_names ']' : '$2'. exported_names -> exported_name ',' exported_names : ['$1' | '$3']. exported_names -> exported_name : ['$1']. -exported_name -> function_name : '$1'. +exported_name -> anno_function_name : '$1'. module_attribute -> 'attributes' '[' ']' : []. module_attribute -> 'attributes' '[' attribute_list ']' : '$3'. @@ -107,8 +109,16 @@ module_attribute -> 'attributes' '[' attribute_list ']' : '$3'. attribute_list -> attribute ',' attribute_list : ['$1' | '$3']. attribute_list -> attribute : ['$1']. -attribute -> atom '=' literal : - {#c_literal{val=tok_val('$1')},'$3'}. +attribute -> anno_atom '=' anno_literal : + {'$1','$3'}. + +anno_atom -> atom : + cerl:c_atom(tok_val('$1')). +anno_atom -> '(' atom '-|' annotation ')' : + cerl:ann_c_atom('$4', tok_val('$2')). + +anno_literal -> literal : '$1'. +anno_literal -> '(' literal '-|' annotation ')' : cerl:set_ann('$2', '$4'). module_defs -> function_definitions : '$1'. @@ -186,7 +196,9 @@ tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2'). map_pattern -> '~' '{' '}' '~' : c_map_pattern([]). map_pattern -> '~' '{' map_pair_patterns '}' '~' : - c_map_pattern(lists:sort('$3')). + c_map_pattern('$3'). +map_pattern -> '~' '{' map_pair_patterns '|' anno_map_expr '}' '~' : + ann_c_map_pattern('$5', '$3'). map_pair_patterns -> map_pair_pattern : ['$1']. map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3']. @@ -194,6 +206,9 @@ map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3']. map_pair_pattern -> anno_expression ':=' anno_pattern : #c_map_pair{op=#c_literal{val=exact}, key='$1',val='$3'}. +map_pair_pattern -> '(' anno_expression ':=' anno_pattern '-|' annotation ')' : + #c_map_pair{anno='$6',op=#c_literal{val=exact}, + key='$2',val='$4'}. cons_pattern -> '[' anno_pattern tail_pattern : c_cons('$2', '$3'). @@ -206,8 +221,12 @@ tail_pattern -> ',' anno_pattern tail_pattern : binary_pattern -> '#' '{' '}' '#' : #c_binary{segments=[]}. binary_pattern -> '#' '{' segment_patterns '}' '#' : #c_binary{segments='$3'}. -segment_patterns -> segment_pattern ',' segment_patterns : ['$1' | '$3']. -segment_patterns -> segment_pattern : ['$1']. +segment_patterns -> anno_segment_pattern ',' segment_patterns : ['$1' | '$3']. +segment_patterns -> anno_segment_pattern : ['$1']. + +anno_segment_pattern -> segment_pattern : '$1'. +anno_segment_pattern -> '(' segment_pattern '-|' annotation ')' : + cerl:set_ann('$2', '$4'). segment_pattern -> '#' '<' anno_pattern '>' '(' anno_expressions ')': case '$6' of @@ -289,11 +308,17 @@ tuple -> '{' anno_expressions '}' : c_tuple('$2'). map_expr -> '~' '{' '}' '~' : c_map([]). map_expr -> '~' '{' map_pairs '}' '~' : c_map('$3'). -map_expr -> '~' '{' map_pairs '|' variable '}' '~' : ann_c_map([], '$5', '$3'). -map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : ann_c_map([], '$5', '$3'). +map_expr -> '~' '{' map_pairs '|' anno_variable '}' '~' : ann_c_map([], '$5', '$3'). +map_expr -> '~' '{' map_pairs '|' anno_map_expr '}' '~' : ann_c_map([], '$5', '$3'). -map_pairs -> map_pair : ['$1']. -map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. +anno_map_expr -> map_expr : '$1'. +anno_map_expr -> '(' map_expr '-|' annotation ')' : cerl:set_ann('$2', '$4'). + +map_pairs -> anno_map_pair : ['$1']. +map_pairs -> anno_map_pair ',' map_pairs : ['$1' | '$3']. + +anno_map_pair -> map_pair : '$1'. +anno_map_pair -> '(' map_pair '-|' annotation ')' : cerl:set_ann('$2', '$4'). map_pair -> map_pair_assoc : '$1'. map_pair -> map_pair_exact : '$1'. @@ -312,8 +337,11 @@ tail -> ',' anno_expression tail : c_cons('$2', '$3'). binary -> '#' '{' '}' '#' : #c_literal{val = <<>>}. binary -> '#' '{' segments '}' '#' : make_binary('$3'). -segments -> segment ',' segments : ['$1' | '$3']. -segments -> segment : ['$1']. +segments -> anno_segment ',' segments : ['$1' | '$3']. +segments -> anno_segment : ['$1']. + +anno_segment -> segment : '$1'. +anno_segment -> '(' segment '-|' annotation ')' : cerl:set_ann('$2', '$4'). segment -> '#' '<' anno_expression '>' '(' anno_expressions ')': case '$6' of @@ -413,7 +441,8 @@ Erlang code. -include("core_parse.hrl"). --import(cerl, [ann_c_map/3,c_cons/2,c_map/1,c_map_pattern/1,c_tuple/1]). +-import(cerl, [ann_c_map/3,ann_c_map_pattern/2,c_cons/2,c_map/1, + c_map_pattern/1,c_tuple/1]). tok_val(T) -> element(3, T). tok_line(T) -> element(2, T). diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index c2a6a81d5e..67209d06be 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,7 +21,7 @@ -module(core_pp). --export([format/1]). +-export([format/1,format_all/1]). -include("core_parse.hrl"). @@ -33,25 +33,35 @@ %% Prettyprint-formats (naively) an abstract Core Erlang syntax %% tree. --record(ctxt, {class = term :: 'clause' | 'def' | 'expr' | 'term', - indent = 0 :: integer(), +-record(ctxt, {indent = 0 :: integer(), item_indent = 2 :: integer(), body_indent = 4 :: integer(), - tab_width = 8 :: non_neg_integer(), - line = 0 :: integer()}). + line = 0 :: integer(), + clean = true :: boolean()}). + +-define(TAB_WIDTH, 8). -spec format(cerl:cerl()) -> iolist(). format(Node) -> format(Node, #ctxt{}). -maybe_anno(Node, Fun, Ctxt) -> +-spec format_all(cerl:cerl()) -> iolist(). + +format_all(Node) -> + format(Node, #ctxt{clean=false}). + +maybe_anno(Node, Fun, #ctxt{clean=false}=Ctxt) -> As = cerl:get_ann(Node), - case get_line(As) of + maybe_anno(Node, Fun, Ctxt, As); +maybe_anno(Node, Fun, #ctxt{clean=true}=Ctxt) -> + As0 = cerl:get_ann(Node), + case get_line(As0) of none -> - maybe_anno(Node, Fun, Ctxt, As); + maybe_anno(Node, Fun, Ctxt, As0); Line -> - if Line > Ctxt#ctxt.line -> + As = strip_line(As0), + if Line > Ctxt#ctxt.line -> [io_lib:format("%% Line ~w",[Line]), nl_indent(Ctxt), maybe_anno(Node, Fun, Ctxt#ctxt{line = Line}, As) @@ -61,22 +71,22 @@ maybe_anno(Node, Fun, Ctxt) -> end end. -maybe_anno(Node, Fun, Ctxt, As) -> - case strip_line(As) of - [] -> - Fun(Node, Ctxt); - List -> - Ctxt1 = add_indent(Ctxt, 2), - Ctxt2 = add_indent(Ctxt1, 3), - ["( ", - Fun(Node, Ctxt1), - nl_indent(Ctxt1), - "-| ",format_anno(List, Ctxt2)," )" - ] - end. +maybe_anno(Node, Fun, Ctxt, []) -> + Fun(Node, Ctxt); +maybe_anno(Node, Fun, Ctxt, List) -> + Ctxt1 = add_indent(Ctxt, 2), + Ctxt2 = add_indent(Ctxt1, 3), + ["( ", + Fun(Node, Ctxt1), + nl_indent(Ctxt1), + "-| ",format_anno(List, Ctxt2)," )" + ]. format_anno([_|_]=List, Ctxt) -> [$[,format_anno_list(List, Ctxt),$]]; +format_anno({file,Name}, _Ctxt) -> + %% Optimization: Reduces file size considerably. + io_lib:format("{'file',~p}", [Name]); format_anno(Tuple, Ctxt) when is_tuple(Tuple) -> [${,format_anno_list(tuple_to_list(Tuple), Ctxt),$}]; format_anno(Val, Ctxt) when is_atom(Val) -> @@ -121,14 +131,11 @@ format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) -> format_1(#c_binary{anno=A,segments=Segs}, Ctxt); format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) -> Pairs = maps:to_list(M), - Op = case Ctxt of - #ctxt{ class = clause } -> exact; - _ -> assoc - end, - Cpairs = [#c_map_pair{op=#c_literal{val=Op}, + Op = #c_literal{val=assoc}, + Cpairs = [#c_map_pair{op=Op, key=#c_literal{val=K}, val=#c_literal{val=V}} || {K,V} <- Pairs], - format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); + format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); format_1(#c_var{name={I,A}}, _) -> [core_atom(I),$/,integer_to_list(A)]; format_1(#c_var{name=V}, _) -> @@ -172,7 +179,8 @@ format_1(#c_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), $} ]; -format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 -> +format_1(#c_map{arg=#c_literal{anno=[],val=M},es=Es}, Ctxt) + when is_map(M), map_size(M) =:= 0 -> ["~{", format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), "}~" @@ -195,9 +203,16 @@ format_1(#c_values{es=Es}, Ctxt) -> format_1(#c_alias{var=V,pat=P}, Ctxt) -> Txt = [format(V, Ctxt)|" = "], [Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))]; -format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> - Vs = [cerl:set_ann(V, []) || V <- Vs0], - case is_simple_term(A) of +format_1(#c_let{anno=Anno0,vars=Vs0,arg=A0,body=B}, #ctxt{clean=Clean}=Ctxt) -> + {Vs,A,Anno} = case Clean of + false -> + {Vs0,A0,Anno0}; + true -> + {[cerl:set_ann(V, []) || V <- Vs0], + cerl:set_ann(A0, []), + []} + end, + case is_simple_term(A) andalso Anno =:= [] of false -> Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), ["let ", @@ -214,7 +229,7 @@ format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> ["let ", format_values(Vs, add_indent(Ctxt, 4)), " = ", - format(cerl:set_ann(A, []), Ctxt1), + format(A, Ctxt1), nl_indent(Ctxt), "in " | format(B, add_indent(Ctxt, 4)) @@ -321,35 +336,30 @@ format_1(#c_module{name=N,exports=Es,attrs=As,defs=Ds}, Ctxt) -> [Mod," [", format_vseq(Es, "", ",", - add_indent(set_class(Ctxt, term), width(Mod, Ctxt)+2), + add_indent(Ctxt, width(Mod, Ctxt)+2), fun format/2), "]", nl_indent(Ctxt), " attributes [", format_vseq(As, "", ",", - add_indent(set_class(Ctxt, def), 16), + add_indent(Ctxt, 16), fun format_def/2), "]", nl_indent(Ctxt), format_funcs(Ds, Ctxt), nl_indent(Ctxt) | "end" - ]; -format_1(Type, _) -> - ["** Unsupported type: ", - io_lib:write(Type) - | " **" ]. format_funcs(Fs, Ctxt) -> format_vseq(Fs, "", "", - set_class(Ctxt, def), + Ctxt, fun format_def/2). format_def({N,V}, Ctxt0) -> - Ctxt1 = add_indent(set_class(Ctxt0, expr), Ctxt0#ctxt.body_indent), + Ctxt1 = add_indent(Ctxt0, Ctxt0#ctxt.body_indent), [format(N, Ctxt0), " =", nl_indent(Ctxt1) @@ -362,7 +372,10 @@ format_values(Vs, Ctxt) -> format_hseq(Vs, ",", add_indent(Ctxt, 1), fun format/2), $>]. -format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) -> +format_bitstr(Node, Ctxt) -> + maybe_anno(Node, fun do_format_bitstr/2, Ctxt). + +do_format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) -> Vs = [S, U, T, Fs], Ctxt1 = add_indent(Ctxt0, 2), Val = format(V, Ctxt1), @@ -370,8 +383,7 @@ format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) -> ["#<", Val, ">(", format_hseq(Vs,",", Ctxt2, fun format/2), $)]. format_clauses(Cs, Ctxt) -> - format_vseq(Cs, "", "", set_class(Ctxt, clause), - fun format_clause/2). + format_vseq(Cs, "", "", Ctxt, fun format_clause/2). format_clause(Node, Ctxt) -> maybe_anno(Node, fun format_clause_1/2, Ctxt). @@ -383,15 +395,13 @@ format_clause_1(#c_clause{pats=Ps,guard=G,body=B}, Ctxt) -> case is_trivial_guard(G) of true -> [" when ", - format_guard(G, add_indent(set_class(Ctxt, expr), - width(Ptxt, Ctxt) + 6))]; + format_guard(G, add_indent(Ctxt, width(Ptxt, Ctxt) + 6))]; false -> [nl_indent(Ctxt2), "when ", format_guard(G, add_indent(Ctxt2, 2))] end++ " ->", - nl_indent(Ctxt2) - | format(B, set_class(Ctxt2, expr)) + nl_indent(Ctxt2) | format(B, Ctxt2) ]. is_trivial_guard(#c_literal{val=Val}) when is_atom(Val) -> true; @@ -445,50 +455,53 @@ format_list_tail(Tail, Ctxt) -> format_map_pair(Op, K, V, Ctxt0) -> Ctxt1 = add_indent(Ctxt0, 1), - Txt = format(K, set_class(Ctxt1, expr)), + Txt = format(K, Ctxt1), Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)), [Txt,Op,format(V, Ctxt2)]. -indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). - -indent(N, _) when N =< 0 -> ""; -indent(N, Ctxt) -> - T = Ctxt#ctxt.tab_width, - string:chars($\t, N div T, string:chars($\s, N rem T)). +indent(#ctxt{indent=N}) -> + if + N =< 0 -> + ""; + true -> + string:chars($\t, N div ?TAB_WIDTH, spaces(N rem ?TAB_WIDTH)) + end. nl_indent(Ctxt) -> [$\n|indent(Ctxt)]. +spaces(0) -> ""; +spaces(1) -> " "; +spaces(2) -> " "; +spaces(3) -> " "; +spaces(4) -> " "; +spaces(5) -> " "; +spaces(6) -> " "; +spaces(7) -> " ". +%% Undo indentation done by nl_indent/1. unindent(T, Ctxt) -> - unindent(T, Ctxt#ctxt.indent, Ctxt, []). + unindent(T, Ctxt#ctxt.indent, []). -unindent(T, N, _, C) when N =< 0 -> +unindent(T, N, C) when N =< 0 -> [T|C]; -unindent([$\s|T], N, Ctxt, C) -> - unindent(T, N - 1, Ctxt, C); -unindent([$\t|T], N, Ctxt, C) -> - Tab = Ctxt#ctxt.tab_width, +unindent([$\s|T], N, C) -> + unindent(T, N - 1, C); +unindent([$\t|T], N, C) -> + Tab = ?TAB_WIDTH, if N >= Tab -> - unindent(T, N - Tab, Ctxt, C); + unindent(T, N - Tab, C); true -> - unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C) + unindent([spaces(Tab - N)|T], 0, C) end; -unindent([L|T], N, Ctxt, C) when is_list(L) -> - unindent(L, N, Ctxt, [T|C]); -unindent([H|T], _, _, C) -> - [H|[T|C]]; -unindent([], N, Ctxt, [H|T]) -> - unindent(H, N, Ctxt, T); -unindent([], _, _, []) -> []. +unindent([L|T], N, C) when is_list(L) -> + unindent(L, N, [T|C]). width(Txt, Ctxt) -> - try width(Txt, 0, Ctxt, []) - catch error:_ -> exit({bad_text,Txt}) - end. + width(Txt, 0, Ctxt, []). width([$\t|T], A, Ctxt, C) -> - width(T, A + Ctxt#ctxt.tab_width, Ctxt, C); + width(T, A + ?TAB_WIDTH, Ctxt, C); width([$\n|T], _, Ctxt, C) -> width(unindent([T|C], Ctxt), Ctxt); width([H|T], A, Ctxt, C) when is_list(H) -> @@ -502,14 +515,9 @@ width([], A, _, []) -> A. add_indent(Ctxt, Dx) -> Ctxt#ctxt{indent = Ctxt#ctxt.indent + Dx}. -set_class(Ctxt, Class) -> - Ctxt#ctxt{class = Class}. - core_atom(A) -> io_lib:write_string(atom_to_list(A), $'). -is_simple_term(#c_values{es=Es}) -> - length(Es) < 3 andalso lists:all(fun is_simple_term/1, Es); is_simple_term(#c_tuple{es=Es}) -> length(Es) < 4 andalso lists:all(fun is_simple_term/1, Es); is_simple_term(#c_var{}) -> true; diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 5e85bba2bd..11b52f6c5f 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index c00f5eab70..6b2d781a76 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 3a877f2403..dcbdeb32e6 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2011. All Rights Reserved. +# Copyright Ericsson AB 1998-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 5a4a870769..936c5f6106 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2014. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -603,7 +603,8 @@ generate(_N, Range) -> %% same BEAM code. case rand:export_seed() of undefined -> - rand:seed(exsplus, {1,42,2053}); + _ = rand:seed(exsplus, {1,42,2053}), + ok; _ -> ok end, diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index c6cfdbae7e..bd3eeae238 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index ab67c8164b..dbc27db377 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -374,10 +374,21 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> T1 = expr(T0, value, Sub), A1 = body(A0, Ctxt, Sub), Recv#c_receive{clauses=Cs1,timeout=T1,action=A1}; -expr(#c_apply{op=Op0,args=As0}=App, _, Sub) -> +expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) -> Op1 = expr(Op0, value, Sub), As1 = expr_list(As0, value, Sub), - App#c_apply{op=Op1,args=As1}; + case Op1 of + #c_var{} -> + App#c_apply{op=Op1,args=As1}; + _ -> + add_warning(App, invalid_call), + Err = #c_call{anno=Anno, + module=#c_literal{val=erlang}, + name=#c_literal{val=error}, + args=[#c_tuple{es=[#c_literal{val='badfun'}, + Op1]}]}, + make_effect_seq(As1++[Err], Sub) + end; expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) -> M1 = expr(M0, value, Sub), N1 = expr(N0, value, Sub), @@ -3395,6 +3406,8 @@ format_error({no_effect,{erlang,F,A}}) -> format_error(result_ignored) -> "the result of the expression is ignored " "(suppress the warning by assigning the expression to the _ variable)"; +format_error(invalid_call) -> + "invalid function call"; format_error(useless_building) -> "a term is constructed, but never used"; format_error(bin_opt_alias) -> diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index 838dda68c6..8c1f69d5de 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/sys_pre_attributes.erl b/lib/compiler/src/sys_pre_attributes.erl index f0cb630205..bc93c85989 100644 --- a/lib/compiler/src/sys_pre_attributes.erl +++ b/lib/compiler/src/sys_pre_attributes.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 6f1912c616..f531056591 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 68c9f964d8..a3b0236134 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -681,9 +681,36 @@ expr({match,L,P0,E0}, St0) -> Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> - St = add_warning(L, nomatch, St5), - {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St}; + %% The pattern will not match. We must take care here to + %% bind all variables that the pattern would have bound + %% so that subsequent expressions do not refer to unbound + %% variables. + %% + %% As an example, this code: + %% + %% [X] = {Y} = E, + %% X + Y. + %% + %% will be rewritten to: + %% + %% error({badmatch,E}), + %% case E of + %% {[X],{Y}} -> + %% X + Y; + %% Other -> + %% error({badmatch,Other}) + %% end. + %% + St6 = add_warning(L, nomatch, St5), + {Expr,Eps3,St7} = safe(E1, St6), + SanPat0 = sanitize(P1), + {SanPat,Eps4,St} = pattern(SanPat0, St7), + Badmatch = c_tuple([#c_literal{val=badmatch},Expr]), + Fail = #iprimop{anno=#a{anno=Lanno}, + name=#c_literal{val=match_fail}, + args=[Badmatch]}, + Eps = Eps3 ++ Eps4 ++ [Fail], + {#imatch{anno=#a{anno=Lanno},pat=SanPat,arg=Expr,fc=Fc},Eps,St}; Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} end; @@ -725,6 +752,32 @@ expr({op,L,Op,L0,R0}, St0) -> module=#c_literal{anno=LineAnno,val=erlang}, name=#c_literal{anno=LineAnno,val=Op},args=As},Aps,St1}. + +%% sanitize(Pat) -> SanitizedPattern +%% Rewrite Pat so that it will be accepted by pattern/2 and will +%% bind the same variables as the original pattern. +%% +%% Here is an example of a pattern that would cause a pattern/2 +%% to generate a 'nomatch' exception: +%% +%% #{k:=X,k:=Y} = [Z] +%% +%% The sanitized pattern will look like: +%% +%% {{X,Y},[Z]} + +sanitize({match,L,P1,P2}) -> + {tuple,L,[sanitize(P1),sanitize(P2)]}; +sanitize({cons,L,H,T}) -> + {cons,L,sanitize(H),sanitize(T)}; +sanitize({tuple,L,Ps0}) -> + Ps = [sanitize(P) || P <- Ps0], + {tuple,L,Ps}; +sanitize({map,L,Ps0}) -> + Ps = [sanitize(V) || {map_field_exact,_,_,V} <- Ps0], + {tuple,L,Ps}; +sanitize(P) -> P. + make_bool_switch(L, E, V, T, F, #core{in_guard=true}) -> make_bool_switch_guard(L, E, V, T, F); make_bool_switch(L, E, V, T, F, #core{}) -> @@ -784,7 +837,7 @@ badmap_term(_Map, #core{in_guard=true}) -> %% 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]}. + c_tuple([#c_literal{val=badmap},Map]). map_build_pairs(Map, Es0, Ann, St0) -> {Es,Pre,St1} = map_build_pairs_1(Es0, St0), @@ -1080,13 +1133,39 @@ bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5); bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> - {E,Pre,St} = expr({bin,Bl,[{bin_element,Bl, - {var,Bl,AccVar#c_var.name}, - {atom,Bl,all}, - [binary,{unit,1}]}|Elements]}, St0), + bc_tq_build(Bl, [], AccVar, Elements, St0); +bc_tq1(Line, E0, [], AccVar, St0) -> + BsFlags = [binary,{unit,1}], + BsSize = {atom,Line,all}, + {E1,Pre0,St1} = safe(E0, St0), + case E1 of + #c_var{name=VarName} -> + Var = {var,Line,VarName}, + Els = [{bin_element,Line,Var,BsSize,BsFlags}], + bc_tq_build(Line, Pre0, AccVar, Els, St1); + #c_literal{val=Val} when is_bitstring(Val) -> + Bits = bit_size(Val), + <<Int0:Bits>> = Val, + Int = {integer,Line,Int0}, + Sz = {integer,Line,Bits}, + Els = [{bin_element,Line,Int,Sz,[integer,{unit,1},big]}], + bc_tq_build(Line, Pre0, AccVar, Els, St1); + _ -> + %% Any other safe (cons, tuple, literal) is not a + %% bitstring. Force the evaluation to fail (and + %% generate a warning). + Els = [{bin_element,Line,{atom,Line,bad_value},BsSize,BsFlags}], + bc_tq_build(Line, Pre0, AccVar, Els, St1) + end. + +bc_tq_build(Line, Pre0, #c_var{name=AccVar}, Elements0, St0) -> + Elements = [{bin_element,Line,{var,Line,AccVar},{atom,Line,all}, + [binary,{unit,1}]}|Elements0], + {E,Pre,St} = expr({bin,Line,Elements}, St0), #a{anno=A} = Anno0 = get_anno(E), Anno = Anno0#a{anno=[compiler_generated,single_use|A]}, - {set_anno(E, Anno),Pre,St}. + {set_anno(E, Anno),Pre0++Pre,St}. + %% filter_tq(Line, Expr, Filter, Mc, State, [Qualifier], TqFun) -> %% {Case,[PreExpr],State}. @@ -1307,7 +1386,9 @@ bc_elem_size({bin,_,El}, St0) -> Vs = [V || {_,#c_var{name=V}} <- Vars0], {E,Pre,St} = bc_mul_pairs(F, #c_literal{val=Bits}, [], St0), {E,Pre,Vs,St} - end. + end; +bc_elem_size(_, _) -> + throw(impossible). bc_elem_size_1([{bin_element,_,_,{integer,_,N},Flags}|Es], Bits, Vars) -> {unit,U} = keyfind(unit, 1, Flags), diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 4446d5ff1d..402e3c4912 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -147,6 +147,7 @@ include_attribute(callback) -> false; include_attribute(opaque) -> false; include_attribute(export_type) -> false; include_attribute(record) -> false; +include_attribute(optional_callbacks) -> false; include_attribute(_) -> true. function({#c_var{name={F,Arity}=FA},Body}, St0) -> @@ -401,7 +402,7 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> Call = #c_call{anno=A, module=#c_literal{val=erlang}, name=#c_literal{val=apply}, - args=[M0,F0,make_list(Cargs)]}, + args=[M0,F0,cerl:make_list(Cargs)]}, expr(Call, Sub, St1); _ -> {[M1,F1|Kargs],Ap,St} = atomic_list([M0,F0|Cargs], Sub, St1), @@ -496,7 +497,7 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> end. translate_fc(Args) -> - [#c_literal{val=function_clause},make_list(Args)]. + [#c_literal{val=function_clause},cerl:make_list(Args)]. expr_map(A,Var0,Ces,Sub,St0) -> {Var,Mps,St1} = expr(Var0, Sub, St0), @@ -1988,11 +1989,6 @@ pat_list_vars(Ps) -> {union(Used0, Used),union(New0, New)} end, {[],[]}, Ps). -make_list(Es) -> - foldr(fun(E, Acc) -> - #c_cons{hd=E,tl=Acc} - end, #c_literal{val=[]}, Es). - %% List of integers in interval [N,M]. Empty list if N > M. integers(N, M) when N =< M -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index 03b2eae006..5216a1a620 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index 03b034ae98..0b90f0a1e0 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index fa057ae211..1452b78d1d 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/compiler/src/v3_life.hrl b/lib/compiler/src/v3_life.hrl index 29a08f8c72..9d03a86ccd 100644 --- a/lib/compiler/src/v3_life.hrl +++ b/lib/compiler/src/v3_life.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. |