diff options
Diffstat (limited to 'lib/compiler/src')
41 files changed, 2590 insertions, 1502 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 70ddd54145..56c45d369c 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2010. All Rights Reserved. +# Copyright Ericsson AB 1996-2011. 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 @@ -53,11 +53,14 @@ MODULES = \ beam_dead \ beam_dict \ beam_disasm \ + beam_except \ beam_flatten \ beam_jump \ beam_listing \ beam_opcodes \ beam_peep \ + beam_receive \ + beam_split \ beam_trim \ beam_type \ beam_utils \ @@ -117,7 +120,9 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native endif -ERL_COMPILE_FLAGS += +inline +warn_unused_import -I../../stdlib/include -I$(EGEN) -W +ERL_COMPILE_FLAGS += +inline +warn_unused_import \ + +warnings_as_errors \ + -I../../stdlib/include -I$(EGEN) -W # ---------------------------------------------------- # Targets @@ -158,11 +163,11 @@ $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) "$(RELSYSDIR)/src" $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(EXTRA_FILES) \ - $(YRL_FILE) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(INSTALL_FILES) $(RELSYSDIR)/ebin + $(YRL_FILE) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(INSTALL_DATA) $(INSTALL_FILES) "$(RELSYSDIR)/ebin" release_docs_spec: diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 497c4fa07b..a7c8508321 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Assembler for threaded Beam. @@ -23,7 +23,7 @@ -export([module/4]). -export([encode/2]). --import(lists, [map/2,member/2,keymember/3,duplicate/2,filter/2]). +-import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]). -include("beam_opcodes.hrl"). module(Code, Abst, SourceFile, Opts) -> @@ -31,22 +31,20 @@ module(Code, Abst, SourceFile, Opts) -> assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), + {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), - {Code,Dict1} = assemble_1(Asm, Exp, Dict0, []), - build_file(Code, Attr, Dict1, NumLabels, NumFuncs, Abst, SourceFile, Opts). + {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), + build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts). on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of undefined -> {Fs0,Attr0}; [{Name,0}] -> - Fs = map(fun({function,N,0,Entry,Asm0}) when N =:= Name -> - [{label,_}=L, - {func_info,_,_,_}=Fi, - {label,_}=E|Asm1] = Asm0, - Asm = [L,Fi,E,on_load|Asm1], - {function,N,0,Entry,Asm}; + Fs = map(fun({function,N,0,Entry,Is0}) when N =:= Name -> + Is = insert_on_load_instruction(Is0, Entry), + {function,N,0,Entry,Is}; (F) -> F end, Fs0), @@ -54,6 +52,13 @@ on_load(Fs0, Attr0) -> {Fs,Attr} end. +insert_on_load_instruction(Is0, Entry) -> + {Bef,[{label,Entry}=El|Is]} = + splitwith(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Is0), + Bef ++ [El,on_load|Is]. + assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) -> Dict1 = case member({Name,Arity}, Exp) of true -> @@ -132,14 +137,19 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> LitTab = iolist_to_binary(zlib:compress(LitTab2)), chunk(<<"LitT">>, <<(byte_size(LitTab2)):32>>, LitTab) end, + + %% Create the line chunk. + LineChunk = chunk(<<"Line">>, build_line_table(Dict)), %% Create the attributes and compile info chunks. Essentials0 = [AtomChunk,CodeChunk,StringChunk,ImportChunk, ExpChunk,LambdaChunk,LiteralChunk], - Essentials = [iolist_to_binary(C) || C <- Essentials0], - {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, Essentials), + Essentials1 = [iolist_to_binary(C) || C <- Essentials0], + MD5 = module_md5(Essentials1), + Essentials = finalize_fun_table(Essentials1, MD5), + {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, MD5), AttrChunk = chunk(<<"Attr">>, Attributes), CompileChunk = chunk(<<"CInf">>, Compile), @@ -150,11 +160,32 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> %% Create IFF chunk. Chunks = case member(slim, Opts) of - true -> [Essentials,AttrChunk,AbstChunk]; - false -> [Essentials,LocChunk,AttrChunk,CompileChunk,AbstChunk] + true -> + [Essentials,AttrChunk,AbstChunk]; + false -> + [Essentials,LocChunk,AttrChunk, + CompileChunk,AbstChunk,LineChunk] end, build_form(<<"BEAM">>, Chunks). +%% finalize_fun_table(Essentials, MD5) -> FinalizedEssentials +%% Update the 'old_uniq' field in the entry for each fun in the +%% 'FunT' chunk. We'll use part of the MD5 for the module as a +%% unique value. + +finalize_fun_table(Essentials, MD5) -> + [finalize_fun_table_1(E, MD5) || E <- Essentials]. + +finalize_fun_table_1(<<"FunT",Keep:8/binary,Table0/binary>>, MD5) -> + <<Uniq:27,_:101/bits>> = MD5, + Table = finalize_fun_table_2(Table0, Uniq, <<>>), + <<"FunT",Keep/binary,Table/binary>>; +finalize_fun_table_1(Chunk, _) -> Chunk. + +finalize_fun_table_2(<<Keep:20/binary,0:32,T/binary>>, Uniq, Acc) -> + finalize_fun_table_2(T, Uniq, <<Acc/binary,Keep/binary,Uniq:32>>); +finalize_fun_table_2(<<>>, _, Acc) -> Acc. + %% Build an IFF form. build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) -> @@ -191,11 +222,7 @@ flatten_exports(Exps) -> flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). -build_attributes(Opts, SourceFile, Attr0, Essentials) -> - Attr = filter(fun({type,_}) -> false; - ({spec,_}) -> false; - (_) -> true - end, Attr0), +build_attributes(Opts, SourceFile, Attr, MD5) -> Misc = case member(slim, Opts) of false -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), @@ -203,7 +230,32 @@ build_attributes(Opts, SourceFile, Attr0, Essentials) -> true -> [] end, Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], - {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}. + {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}. + +build_line_table(Dict) -> + {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} = + beam_dict:line_table(Dict), + NumFnames = NumFnames0 - 1, + [_|Fnames1] = Fnames0, + Fnames2 = [unicode:characters_to_binary(F) || F <- Fnames1], + Fnames = << <<(byte_size(F)):16,F/binary>> || F <- Fnames2 >>, + Lines1 = encode_line_items(Lines0, 0), + Lines = iolist_to_binary(Lines1), + Ver = 0, + Bits = 0, + <<Ver:32,Bits:32,NumLineInstrs:32,NumLines:32,NumFnames:32, + Lines/binary,Fnames/binary>>. + +%% encode_line_items([{FnameIndex,Line}], PrevFnameIndex) +%% Encode the line items compactly. Tag the FnameIndex with +%% an 'a' tag (atom) and only include it when it has changed. +%% Tag the line numbers with an 'i' (integer) tag. + +encode_line_items([{F,L}|T], F) -> + [encode(?tag_i, L)|encode_line_items(T, F)]; +encode_line_items([{F,L}|T], _) -> + [encode(?tag_a, F),encode(?tag_i, L)|encode_line_items(T, F)]; +encode_line_items([], _) -> []. %% %% If the attributes contains no 'vsn' attribute, we'll insert one @@ -211,32 +263,30 @@ build_attributes(Opts, SourceFile, Attr0, Essentials) -> %% We'll not change an existing 'vsn' attribute. %% -calc_vsn(Attr, Essentials0) -> +set_vsn_attribute(Attr, MD5) -> case keymember(vsn, 1, Attr) of true -> Attr; false -> - Essentials = filter_essentials(Essentials0), - <<Number:128>> = erlang:md5(Essentials), + <<Number:128>> = MD5, [{vsn,[Number]}|Attr] end. +module_md5(Essentials0) -> + Essentials = filter_essentials(Essentials0), + erlang:md5(Essentials). + %% filter_essentials([Chunk]) -> [Chunk'] %% Filter essentials so that we obtain the same MD5 as code:module_md5/1 and -%% beam_lib:md5/1 would calculate for this module. +%% beam_lib:md5/1 would calculate for this module. Note that at this +%% point, the 'old_uniq' entry for each fun in the 'FunT' chunk is zeroed, +%% so there is no need to go through the 'FunT' chunk. -filter_essentials([<<"FunT",_Sz:4/binary,Entries:4/binary,Table0/binary>>|T]) -> - Table = filter_funtab(Table0, <<0:32>>), - [Entries,Table|filter_essentials(T)]; filter_essentials([<<_Tag:4/binary,Sz:32,Data:Sz/binary,_Padding/binary>>|T]) -> [Data|filter_essentials(T)]; filter_essentials([<<>>|T]) -> filter_essentials(T); filter_essentials([]) -> []. -filter_funtab(<<Important:20/binary,_OldUniq:4/binary,T/binary>>, Zero) -> - [Important,Zero|filter_funtab(T, Zero)]; -filter_funtab(<<>>, _) -> []. - bif_type(fnegate, 1) -> {op,fnegate}; bif_type(fadd, 2) -> {op,fadd}; bif_type(fsub, 2) -> {op,fsub}; @@ -247,6 +297,9 @@ bif_type(_, 2) -> bif2. make_op({'%',_}, Dict) -> {[],Dict}; +make_op({line,Location}, Dict0) -> + {Index,Dict} = beam_dict:line(Location, Dict0), + encode_op(line, [Index], Dict); make_op({bif, Bif, {f,_}, [], Dest}, Dict) -> %% BIFs without arguments cannot fail. encode_op(bif0, [{extfunc, erlang, Bif, 0}, Dest], Dict); @@ -265,7 +318,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) -> Arity = length(Args), BifOp = case Arity of 1 -> gc_bif1; - 2 -> gc_bif2 + 2 -> gc_bif2; + 3 -> gc_bif3 end, encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict); make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) -> @@ -274,8 +328,8 @@ make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail|Ops], Dict); make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail,Op,Live|Ops++[Dst]], Dict); -make_op({make_fun2,{f,Lbl},Index,OldUniq,NumFree}, Dict0) -> - {Fun,Dict} = beam_dict:lambda(Lbl, Index, OldUniq, NumFree, Dict0), +make_op({make_fun2,{f,Lbl},_Index,_OldUniq,NumFree}, Dict0) -> + {Fun,Dict} = beam_dict:lambda(Lbl, NumFree, Dict0), make_op({make_fun2,Fun}, Dict); make_op({kill,Y}, Dict) -> make_op({init,Y}, Dict); diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index d4a4ddca8a..cd568097fa 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Partitions assembly instructions into basic blocks and @@ -36,12 +36,14 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% Collect basic blocks and optimize them. Is2 = blockify(Is1), - Is3 = beam_utils:live_opt(Is2), - Is4 = opt_blocks(Is3), - Is5 = beam_utils:delete_live_annos(Is4), + Is3 = embed_lines(Is2), + Is4 = move_allocates(Is3), + Is5 = beam_utils:live_opt(Is4), + Is6 = opt_blocks(Is5), + Is7 = beam_utils:delete_live_annos(Is6), %% Optimize bit syntax. - {Is,Lc} = bsm_opt(Is5, Lc0), + {Is,Lc} = bsm_opt(Is7, Lc0), %% Done. {{function,Name,Arity,CLabel,Is},Lc} @@ -140,7 +142,6 @@ collect({move,S,D}) -> {set,[D],[S],move}; collect({put_list,S1,S2,D}) -> {set,[D],[S1,S2],put_list}; collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}}; collect({put,S}) -> {set,[],[S],put}; -collect({put_string,L,S,D}) -> {set,[D],[],{put_string,L,S}}; collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}}; collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}}; collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; @@ -148,6 +149,24 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(_) -> error. +%% embed_lines([Instruction]) -> [Instruction] +%% Combine blocks that would be split by line/1 instructions. +%% Also move a line instruction before a block into the block, +%% but leave the line/1 instruction after a block outside. + +embed_lines(Is) -> + embed_lines(reverse(Is), []). + +embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) -> + B = {block,B1++[{set,[],[],Line}]++B2}, + embed_lines([B|T], Acc); +embed_lines([{block,B1},{line,_}=Line|T], Acc) -> + B = {block,[{set,[],[],Line}|B1]}, + embed_lines([B|T], Acc); +embed_lines([I|Is], Acc) -> + embed_lines(Is, [I|Acc]); +embed_lines([], Acc) -> Acc. + opt_blocks([{block,Bl0}|Is]) -> %% The live annotation at the beginning is not useful. [{'%live',_}|Bl] = Bl0, @@ -157,11 +176,7 @@ opt_blocks([I|Is]) -> opt_blocks([]) -> []. opt_block(Is0) -> - %% We explicitly move any allocate instruction upwards before optimising - %% moves, to avoid any potential problems with the calculation of live - %% registers. - Is1 = move_allocates(Is0), - Is = find_fixpoint(fun opt/1, Is1), + Is = find_fixpoint(fun opt/1, Is0), opt_alloc(Is). find_fixpoint(OptFun, Is0) -> @@ -171,11 +186,21 @@ find_fixpoint(OptFun, Is0) -> end. %% move_allocates(Is0) -> Is -%% Move allocates upwards in the instruction stream, in the hope of -%% getting more possibilities for optimizing away moves later. - -move_allocates(Is) -> - move_allocates_1(reverse(Is), []). +%% Move allocate instructions upwards in the instruction stream, in the +%% hope of getting more possibilities for optimizing away moves later. +%% +%% NOTE: Moving allocation instructions is only safe because it is done +%% immediately after code generation so that we KNOW that if {x,X} is +%% initialized, all x registers with lower numbers are also initialized. +%% That assumption may not be true after other optimizations, such as +%% the beam_utils:live_opt/1 optimization. + +move_allocates([{block,Bl0}|Is]) -> + Bl = move_allocates_1(reverse(Bl0), []), + [{block,Bl}|move_allocates(Is)]; +move_allocates([I|Is]) -> + [I|move_allocates(Is)]; +move_allocates([]) -> []. move_allocates_1([{set,[],[],{alloc,_,_}=Alloc}|Is0], Acc0) -> {Is,Acc} = move_allocates_2(Alloc, Is0, Acc0), @@ -202,9 +227,7 @@ move_allocates_2(Alloc, [], Acc) -> alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; -alloc_may_pass({set,_,_,{put_tuple,_}}) -> false; alloc_may_pass({set,_,_,put}) -> false; -alloc_may_pass({set,_,_,{put_string,_,_}}) -> false; alloc_may_pass({set,_,_,_}) -> true. combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> @@ -221,10 +244,12 @@ opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] end; opt([{set,[X],[X],move}|Is]) -> opt(Is); -opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, +opt([{set,_,_,{line,_}}=Line1, + {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, + {set,_,_,{line,_}}=Line2, {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> - opt([I2,I1|Is]); + opt([Line2,I2,Line1,I1|Is]); opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index dcc6ad4c7c..d9ea6f5a70 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose: Optimizes booleans in guards. @@ -631,10 +631,10 @@ fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). live_regs(Regs) -> - foldl(fun ({I,_}, _) -> I; - ([], Max) -> Max end, - -1, Regs)+1. - + foldl(fun ({I,_}, _) -> + I + end, -1, Regs)+1. + %%% %%% Convert a block to Static Single Assignment (SSA) form. @@ -748,8 +748,7 @@ initialized_regs([{bs_context_to_binary,Src}|Is], Regs) -> initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) -> InitRegs = free_vars_regs(Arity), add_init_regs(InitRegs, Regs); -initialized_regs([_|_], Regs) -> Regs; -initialized_regs([], Regs) -> Regs. +initialized_regs([_|_], Regs) -> Regs. add_init_regs([{x,_}=X|T], Regs) -> add_init_regs(T, ordsets:add_element(X, Regs)); diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 2a36fda1ea..1217f7f777 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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]). +-import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2,dropwhile/2]). %%% %%% We optimize bit syntax matching where the tail end of a binary is @@ -376,6 +376,8 @@ btb_reaches_match_2([{func_info,_,_,Arity}=I|_], Regs0, D) -> [] -> D; _ -> {binary_used_in,I} end; +btb_reaches_match_2([{line,_}|Is], Regs, D) -> + btb_reaches_match_1(Is, Regs, D); btb_reaches_match_2([I|_], Regs, _) -> btb_error({btb_context_regs(Regs),I,not_handled}). @@ -580,7 +582,10 @@ btb_index(Fs) -> btb_index_1(Fs, []). btb_index_1([{function,_,_,Entry,Is0}|Fs], Acc0) -> - [{label,_},{func_info,_,_,_},{label,Entry}|Is] = Is0, + [{label,Entry}|Is] = + dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Is0), Acc = btb_index_2(Is, Entry, false, Acc0), btb_index_1(Fs, Acc); btb_index_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). @@ -651,10 +656,8 @@ add_warning(Term, Anno, Ws) -> warning_translate_label(Term, D) when is_tuple(Term) -> case element(1, Term) of {label,F} -> - case gb_trees:lookup(F, D) of - none -> Term; - {value,FA} -> setelement(1, Term, FA) - end; + FA = gb_trees:get(F, D), + setelement(1, Term, FA); _ -> Term end; warning_translate_label(Term, _) -> Term. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 64c93e11f7..a7994ab3b3 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. 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 @@ -23,9 +23,9 @@ -export([module/2]). -export([bs_clean_saves/1]). -export([clean_labels/1]). --import(lists, [map/2,foldl/3,reverse/1]). +-import(lists, [map/2,foldl/3,reverse/1,filter/2]). -module({Mod,Exp,Attr,Fs0,_}, _Opt) -> +module({Mod,Exp,Attr,Fs0,_}, Opts) -> Order = [Lbl || {function,_,_,Lbl,_} <- Fs0], All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end, dict:new(), Fs0), @@ -33,7 +33,8 @@ module({Mod,Exp,Attr,Fs0,_}, _Opt) -> Used = find_all_used(WorkList, All, sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs = bs_fix(Fs2), + Fs3 = bs_fix(Fs2), + Fs = maybe_remove_lines(Fs3, Opts), {ok,{Mod,Exp,Attr,Fs,Lc}}. %% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2. @@ -375,3 +376,20 @@ bs_clean_saves_1([{bs_save2,_,{_,_}=SavePoint}=I|Is], Needed, Acc) -> bs_clean_saves_1([I|Is], Needed, Acc) -> bs_clean_saves_1(Is, Needed, [I|Acc]); bs_clean_saves_1([], _, Acc) -> reverse(Acc). + +%%% +%%% Remove line instructions if requested. +%%% + +maybe_remove_lines(Fs, Opts) -> + case proplists:get_bool(no_line_info, Opts) of + false -> Fs; + true -> remove_lines(Fs) + end. + +remove_lines([{function,N,A,Lbl,Is0}|T]) -> + Is = filter(fun({line,_}) -> false; + (_) -> true + end, Is0), + [{function,N,A,Lbl,Is}|remove_lines(T)]; +remove_lines([]) -> []. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 7b4cd814a2..5f12a98f09 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -131,10 +131,9 @@ -import(lists, [mapfoldl/3,reverse/1]). module({Mod,Exp,Attr,Fs0,_}, _Opts) -> - Fs1 = [split_blocks(F) || F <- Fs0], - {Fs2,Lc1} = beam_clean:clean_labels(Fs1), - {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs2), - %%{Fs,Lc} = {Fs2,Lc1}, + {Fs1,Lc1} = beam_clean:clean_labels(Fs0), + {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs1), + %%{Fs,Lc} = {Fs1,Lc1}, {ok,{Mod,Exp,Attr,Fs,Lc}}. function({function,Name,Arity,CLabel,Is0}, Lc0) -> @@ -144,9 +143,9 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% Initialize label information with the code %% for the func_info label. Without it, a register %% may seem to be live when it is not. - [{label,L},{func_info,_,_,_}=FI|_] = Is1, + [{label,L}|FiIs] = Is1, D0 = beam_utils:empty_label_index(), - D = beam_utils:index_label(L, [FI], D0), + D = beam_utils:index_label(L, FiIs, D0), %% Optimize away dead code. {Is2,Lc} = forward(Is1, Lc0), @@ -160,65 +159,6 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> erlang:raise(Class, Error, Stack) end. -%% We must split the basic block when we encounter instructions with labels, -%% such as catches and BIFs. All labels must be visible outside the blocks. -%% Also remove empty blocks. - -split_blocks({function,Name,Arity,CLabel,Is0}) -> - Is = split_blocks(Is0, []), - {function,Name,Arity,CLabel,Is}. - -split_blocks([{block,[]}|Is], Acc) -> - split_blocks(Is, Acc); -split_blocks([{block,Bl}|Is], Acc0) -> - Acc = split_block(Bl, [], Acc0), - split_blocks(Is, Acc); -split_blocks([I|Is], Acc) -> - split_blocks(Is, [I|Acc]); -split_blocks([], Acc) -> reverse(Acc). - -split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> - %% is_record/3 must be translated by beam_clean; therefore, - %% it must be outside of any block. - 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,{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)]); -split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> - split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); -split_block([I|Is], Bl, Acc) -> - split_block(Is, [I|Bl], Acc); -split_block([], Bl, Acc) -> make_block(Bl, Acc). - -make_block([], Acc) -> Acc; -make_block([{set,[D],Ss,{bif,Op,Fail}}|Bl]=Bl0, Acc) -> - %% If the last instruction in the block is a comparison or boolean operator - %% (such as '=:='), move it out of the block to facilitate further - %% optimizations. - Arity = length(Ss), - case erl_internal:comp_op(Op, Arity) orelse - erl_internal:new_type_test(Op, Arity) orelse - erl_internal:bool_op(Op, Arity) of - false -> - [{block,reverse(Bl0)}|Acc]; - true -> - I = {bif,Op,Fail,Ss,D}, - case Bl =:= [] of - true -> [I|Acc]; - false -> [I,{block,reverse(Bl)}|Acc] - end - end; -make_block([{set,[Dst],[Src],move}|Bl], Acc) -> - %% Make optimization of {move,Src,Dst}, {jump,...} possible. - I = {move,Src,Dst}, - case Bl =:= [] of - true -> [I|Acc]; - false -> [I,{block,reverse(Bl)}|Acc] - end; -make_block(Bl, Acc) -> [{block,reverse(Bl)}|Acc]. - %% 'move' instructions outside of blocks may thwart the jump optimizer. %% Move them back into the block. @@ -246,30 +186,24 @@ forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) -> D = update_value_dict(List, Reg, D0), forward(Is, D, Lc, [I|Acc]); forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Block = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Blk; %Must keep move instruction. - true -> {block,BlkIs} %Safe to remove move instruction. - end; - _ -> Blk %Keep move instruction. + {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction. + _ -> Blk %Must keep move instruction. end, forward([Block|Is], D, Lc, [LblI|Acc]); forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Is = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Is0; %Must keep move instruction. - true -> Is1 %Safe to remove move instruction. - end; - _ -> Is0 %Keep move instruction. - end, + {value,Lit} -> Is1; %Safe to remove move instruction. + _ -> Is0 %Keep move instruction. + end, forward(Is, D, Lc, [LblI|Acc]); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> @@ -281,12 +215,12 @@ forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) -> forward([I|Is], D, Lc, Acc); forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) -> forward([I|Is], D, Lc, Acc); -forward([{test,is_eq_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) -> +forward([{test,is_eq_exact,_,_}=I|Is], D, Lc, Acc) -> case Is of [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]); _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) end; -forward([{test,is_ne_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) -> +forward([{test,is_ne_exact,_,_}=I|Is], D, Lc, Acc) -> case Is of [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]); _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) @@ -299,16 +233,12 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> Key = {Lbl,Reg}, D = case gb_trees:lookup(Key, D0) of none -> gb_trees:insert(Key, Lit, D0); %New. - {value,Lit} -> D0; %Already correct. {value,inconsistent} -> D0; %Inconsistent. {value,_} -> gb_trees:update(Key, inconsistent, D0) end, update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. -is_unreachable_after([I|_]) -> - beam_jump:is_unreachable_after(I). - %%% %%% Scan instructions in reverse execution order and remove dead code. %%% @@ -371,10 +301,10 @@ 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}, backward(Is, D, [I|Acc]); -backward([{test,is_eq_exact=Op,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) -> +backward([{test,is_eq_exact,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), To = shortcut_fail_label(To1, Reg, Val, D), - I = {test,Op,{f,To},Ops}, + I = combine_eqs(To, Ops, D, Acc), backward(Is, D, [I|Acc]); backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), @@ -394,7 +324,10 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> _Code -> To2 end, - I = {test,Op,{f,To},Ops0}, + I = case Op of + is_eq_exact -> combine_eqs(To, Ops0, D, Acc); + _ -> {test,Op,{f,To},Ops0} + end, backward(Is, D, [I|Acc]); backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), @@ -416,7 +349,7 @@ backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> end, I = {test,Op,{f,To},Live,Ops0,Dst}, backward(Is, D, [I|Acc]); -backward([{kill,_}=I|Is], D, [Exit|_]=Acc) -> +backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) -> case beam_jump:is_exit_instruction(Exit) of false -> backward(Is, D, [I|Acc]); true -> backward(Is, D, Acc) @@ -481,7 +414,7 @@ shortcut_fail_label(To0, Reg, Val, D) -> shortcut_boolean_label(To0, Reg, Bool0, D) when is_boolean(Bool0) -> case beam_utils:code_at(To0, D) of - [{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> + [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> Bool = not Bool0, {shortcut_select_label(To, Reg, Bool, D),Bool}; _ -> @@ -519,6 +452,41 @@ bif_to_test(Name, Args, Fail) -> not_possible() -> throw(not_possible). +%% combine_eqs(To, Operands, Acc) -> Instruction. +%% Combine two is_eq_exact instructions or (an is_eq_exact +%% instruction and a select_val instruction) to a select_val +%% instruction if possible. +%% +%% Example: +%% +%% is_eq_exact F1 Reg Lit1 select_val Reg F2 [ Lit1 L1 +%% L1: . Lit2 L2 ] +%% . +%% . ==> +%% . +%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2 +%% L2: .... L2: +%% +combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_]) + when Type =:= atom; Type =:= integer -> + case beam_utils:code_at(To, D) of + [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]}, + {label,L2}|_] when Lit1 =/= Lit2 -> + {select_val,Reg,{f,F2},{list,[Lit1,{f,L1},Lit2,{f,L2}]}}; + [{select_val,Reg,{f,F2},{list,[{Type,_}|_]=List0}}|_] -> + List = remove_from_list(Lit1, List0), + {select_val,Reg,{f,F2},{list,[Lit1,{f,L1}|List]}}; + _Is -> + {test,is_eq_exact,{f,To},Ops} + end; +combine_eqs(To, Ops, _D, _Acc) -> + {test,is_eq_exact,{f,To},Ops}. + +remove_from_list(Lit, [Lit,{f,_}|T]) -> + T; +remove_from_list(Lit, [Val,{f,_}=Fail|T]) -> + [Val,Fail|remove_from_list(Lit, T)]; +remove_from_list(_, []) -> []. %% shortcut_bs_test(TargetLabel, [Instruction], D) -> TargetLabel' %% Try to shortcut the failure label for a bit syntax matching. @@ -564,16 +532,11 @@ count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> %% The save point we are looking for - we are done. Bits; -count_bits_matched([{bs_save2,_,_}|Is], SavePoint, Bits) -> - %% Another save point - keep counting. - count_bits_matched(Is, SavePoint, Bits); count_bits_matched([_|_], _, Bits) -> Bits. shortcut_bs_pos_used(To, Reg, D) -> shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D). -shortcut_bs_pos_used_1([{bs_restore2,Reg,_}|_], Reg, _) -> - false; shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) -> false; shortcut_bs_pos_used_1(Is, Reg, D) -> diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 4ffe8bc606..531968b3c8 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. 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 @@ -22,9 +22,10 @@ -export([new/0,opcode/2,highest_opcode/1, atom/2,local/4,export/4,import/4, - string/2,lambda/5,literal/2, + string/2,lambda/3,literal/2,line/2,fname/2, atom_table/1,local_table/1,export_table/1,import_table/1, - string_table/1,lambda_table/1,literal_table/1]). + string_table/1,lambda_table/1,literal_table/1, + line_table/1]). -type label() :: non_neg_integer(). @@ -33,10 +34,12 @@ exports = [] :: [{label(), arity(), label()}], locals = [] :: [{label(), arity(), label()}], imports = gb_trees:empty() :: gb_tree(), %{{M,F,A},Index} - strings = [] :: [string()], %String pool + strings = <<>> :: binary(), %String pool lambdas = [], %[{...}] literals = dict:new() :: dict(), %Format: {Literal,Number} - next_atom = 1 :: pos_integer(), + fnames = gb_trees:empty() :: gb_tree(), %{Name,Index} + lines = gb_trees:empty() :: gb_tree(), %{{Fname,Line},Index} + num_lines = 0 :: non_neg_integer(), %Number of line instructions next_import = 0 :: non_neg_integer(), string_offset = 0 :: non_neg_integer(), next_literal = 0 :: non_neg_integer(), @@ -66,13 +69,14 @@ highest_opcode(#asm{highest_opcode=Op}) -> Op. %% atom(Atom, Dict) -> {Index,Dict'} -spec atom(atom(), bdict()) -> {pos_integer(), bdict()}. -atom(Atom, #asm{atoms=Atoms0,next_atom=NextIndex}=Dict) when is_atom(Atom) -> +atom(Atom, #asm{atoms=Atoms0}=Dict) when is_atom(Atom) -> case gb_trees:lookup(Atom, Atoms0) of {value,Index} -> {Index,Dict}; none -> + NextIndex = gb_trees:size(Atoms0) + 1, Atoms = gb_trees:insert(Atom, NextIndex, Atoms0), - {NextIndex,Dict#asm{atoms=Atoms,next_atom=NextIndex+1}} + {NextIndex,Dict#asm{atoms=Atoms}} end. %% Remembers an exported function. @@ -119,26 +123,32 @@ import(Mod0, Name0, Arity, #asm{imports=Imp0,next_import=NextIndex}=D0) string(Str, Dict) when is_list(Str) -> #asm{strings=Strings,string_offset=NextOffset} = Dict, - case old_string(Str, Strings) of + StrBin = list_to_binary(Str), + case old_string(StrBin, Strings) of none -> - NewDict = Dict#asm{strings=Strings++Str, - string_offset=NextOffset+length(Str)}, + NewDict = Dict#asm{strings = <<Strings/binary,StrBin/binary>>, + string_offset=NextOffset+byte_size(StrBin)}, {NextOffset,NewDict}; Offset when is_integer(Offset) -> {NextOffset-Offset,Dict} end. -%% Returns the index for a funentry (adding it to the table if necessary). -%% lambda(Lbl, Index, Uniq, NumFree, Dict) -> {Index,Dict'} --spec lambda(label(), non_neg_integer(), integer(), non_neg_integer(), bdict()) -> +%% Returns the index for a fun entry. +%% lambda(Lbl, NumFree, Dict) -> {Index,Dict'} +-spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, Index, OldUniq, NumFree, #asm{lambdas=Lambdas0}=Dict) -> +lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) -> OldIndex = length(Lambdas0), + %% Set Index the same as OldIndex. + Index = OldIndex, + %% Initialize OldUniq to 0. It will be set to an unique value + %% based on the MD5 checksum of the BEAM code for the module. + OldUniq = 0, Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0], {OldIndex,Dict#asm{lambdas=Lambdas}}. -%% Returns the index for a literal (adding it to the atom table if necessary). +%% Returns the index for a literal (adding it to the literal table if necessary). %% literal(Literal, Dict) -> {Index,Dict'} -spec literal(term(), bdict()) -> {non_neg_integer(), bdict()}. @@ -151,18 +161,49 @@ literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) -> {NextIndex,Dict#asm{literals=Tab,next_literal=NextIndex+1}} end. +%% Returns the index for a line instruction (adding information +%% to the location information table). +-spec line(list(), bdict()) -> {non_neg_integer(), bdict()}. + +line([], #asm{num_lines=N}=Dict) -> + %% No location available. Return the special pre-defined + %% index 0. + {0,Dict#asm{num_lines=N+1}}; +line([{location,Name,Line}], #asm{lines=Lines0,num_lines=N}=Dict0) -> + {FnameIndex,Dict1} = fname(Name, Dict0), + case gb_trees:lookup({FnameIndex,Line}, Lines0) of + {value,Index} -> + {Index,Dict1#asm{num_lines=N+1}}; + none -> + Index = gb_trees:size(Lines0) + 1, + Lines = gb_trees:insert({FnameIndex,Line}, Index, Lines0), + Dict = Dict1#asm{lines=Lines,num_lines=N+1}, + {Index,Dict} + end. + +fname(Name, #asm{fnames=Fnames0}=Dict) -> + case gb_trees:lookup(Name, Fnames0) of + {value,Index} -> + {Index,Dict}; + none -> + Index = gb_trees:size(Fnames0), + Fnames = gb_trees:insert(Name, Index, Fnames0), + {Index,Dict#asm{fnames=Fnames}} + end. + %% Returns the atom table. %% atom_table(Dict) -> {LastIndex,[Length,AtomString...]} -spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}. -atom_table(#asm{atoms=Atoms,next_atom=NumAtoms}) -> +atom_table(#asm{atoms=Atoms}) -> + NumAtoms = gb_trees:size(Atoms), Sorted = lists:keysort(2, gb_trees:to_list(Atoms)), Fun = fun({A,_}) -> L = atom_to_list(A), [length(L)|L] end, AtomTab = lists:map(Fun, Sorted), - {NumAtoms-1,AtomTab}. + {NumAtoms,AtomTab}. %% Returns the table of local functions. %% local_table(Dict) -> {NumLocals, [{Function, Arity, Label}...]} @@ -187,7 +228,7 @@ import_table(#asm{imports=Imp,next_import=NumImports}) -> ImpTab = [MFA || {MFA,_} <- Sorted], {NumImports,ImpTab}. --spec string_table(bdict()) -> {non_neg_integer(), [string()]}. +-spec string_table(bdict()) -> {non_neg_integer(), binary()}. string_table(#asm{strings=Strings,string_offset=Size}) -> {Size,Strings}. @@ -217,15 +258,27 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> my_term_to_binary(Term) -> term_to_binary(Term, [{minor_version,1}]). -%% Search for string Str in the string pool Pool. +%% Return the line table. +-spec line_table(bdict()) -> + {non_neg_integer(), %Number of line instructions. + non_neg_integer(),[string()], + non_neg_integer(),[{non_neg_integer(),non_neg_integer()}]}. + +line_table(#asm{fnames=Fnames0,lines=Lines0,num_lines=NumLineInstrs}) -> + NumFnames = gb_trees:size(Fnames0), + Fnames1 = lists:keysort(2, gb_trees:to_list(Fnames0)), + Fnames = [Name || {Name,_} <- Fnames1], + NumLines = gb_trees:size(Lines0), + Lines1 = lists:keysort(2, gb_trees:to_list(Lines0)), + Lines = [L || {L,_} <- Lines1], + {NumLineInstrs,NumFnames,Fnames,NumLines,Lines}. + +%% Search for binary string Str in the binary string pool Pool. %% old_string(Str, Pool) -> none | Index --spec old_string(string(), [string()]) -> 'none' | pos_integer(). - -old_string([C|Str]=Str0, [C|Pool]) -> - case lists:prefix(Str, Pool) of - true -> length(Pool)+1; - false -> old_string(Str0, Pool) - end; -old_string([_|_]=Str, [_|Pool]) -> - old_string(Str, Pool); -old_string([_|_], []) -> none. +-spec old_string(binary(), binary()) -> 'none' | pos_integer(). + +old_string(Str, Pool) -> + case binary:match(Pool, Str) of + nomatch -> none; + {Start,_Length} -> byte_size(Pool) - Start + end. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index c956f2f000..62bdc74cc8 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %%======================================================================= %% Notes: @@ -182,10 +182,14 @@ process_chunks(F) -> Literals = beam_disasm_literals(LiteralBin), Code = beam_disasm_code(CodeBin, Atoms, mk_imports(ImportsList), StrBin, Lambdas, Literals, Module), - Attributes = optional_chunk(F, attributes), + Attributes = + case optional_chunk(F, attributes) of + none -> []; + Atts when is_list(Atts) -> Atts + end, CompInfo = case optional_chunk(F, "CInf") of - none -> none; + none -> []; CompInfoBin when is_binary(CompInfoBin) -> binary_to_term(CompInfoBin) end, @@ -198,13 +202,13 @@ process_chunks(F) -> end. %%----------------------------------------------------------------------- -%% Retrieve an optional chunk or none if the chunk doesn't exist. +%% Retrieve an optional chunk or return 'none' if the chunk doesn't exist. %%----------------------------------------------------------------------- optional_chunk(F, ChunkTag) -> case beam_lib:chunks(F, [ChunkTag]) of {ok,{_Module,[{ChunkTag,Chunk}]}} -> Chunk; - {error,beam_lib,{missing_chunk,_,ChunkTag}} -> none + {error,beam_lib,{missing_chunk,_,_}} -> none end. %%----------------------------------------------------------------------- @@ -296,6 +300,8 @@ get_function_chunks(Code) -> labels_r([], R) -> {R, []}; labels_r([{label,_}=I|Is], R) -> labels_r(Is, [I|R]); +labels_r([{line,_}=I|Is], R) -> + labels_r(Is, [I|R]); labels_r(Is, R) -> {R, Is}. get_funs({[],[]}) -> []; @@ -335,20 +341,17 @@ local_labels(Funs) -> local_labels_1(function__code(F), R) end, [], Funs)). -%% The first clause below attempts to provide some (limited form of) -%% backwards compatibility; it is not needed for .beam files generated -%% by the R8 compiler. The clause should one fine day be taken out. -local_labels_1([{label,_}|[{label,_}|_]=Code], R) -> - local_labels_1(Code, R); -local_labels_1([{label,_},{func_info,{atom,M},{atom,F},A}|Code], R) - when is_atom(M), is_atom(F) -> - local_labels_2(Code, R, M, F, A); -local_labels_1(Code, _) -> - ?exit({'local_labels: no label in code',Code}). +local_labels_1(Code0, R) -> + Code1 = lists:dropwhile(fun({label,_}) -> true; + ({line,_}) -> true; + ({func_info,_,_,_}) -> false + end, Code0), + [{func_info,{atom,M},{atom,F},A}|Code] = Code1, + local_labels_2(Code, R, {M,F,A}). -local_labels_2([{label,[{u,L}]}|Code], R, M, F, A) -> - local_labels_2(Code, [{L,{M,F,A}}|R], M, F, A); -local_labels_2(_, R, _, _, _) -> R. +local_labels_2([{label,[{u,L}]}|Code], R, MFA) -> + local_labels_2(Code, [{L,MFA}|R], MFA); +local_labels_2(_, R, _) -> R. %%----------------------------------------------------------------------- %% Disassembles a single BEAM instruction; most instructions are handled @@ -621,8 +624,7 @@ resolve_names(Fun, Imports, Str, Lbls, Lambdas, Literals, M) -> %% %% New make_fun2/4 instruction added in August 2001 (R8). -%% New put_literal/2 instruction added in Feb 2006 R11B-4. -%% We handle them specially here to avoid adding an argument to +%% We handle it specially here to avoid adding an argument to %% the clause for every instruction. %% @@ -631,8 +633,6 @@ resolve_inst({make_fun2,Args}, _, _, _, Lambdas, _, M) -> {OldIndex,{F,A,_Lbl,_Index,NumFree,OldUniq}} = lists:keyfind(OldIndex, 1, Lambdas), {make_fun2,{M,F,A},OldIndex,OldUniq,NumFree}; -resolve_inst({put_literal,[{u,Index},Dst]},_,_,_,_,Literals,_) -> - {put_literal,{literal,gb_trees:get(Index, Literals)},Dst}; resolve_inst(Instr, Imports, Str, Lbls, _Lambdas, _Literals, _M) -> %% io:format(?MODULE_STRING":resolve_inst ~p.~n", [Instr]), resolve_inst(Instr, Imports, Str, Lbls). @@ -1004,13 +1004,17 @@ resolve_inst({gc_bif2,Args},Imports,_,_) -> [F,Live,Bif,A1,A2,Reg] = resolve_args(Args), {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports), {gc_bif,BifName,F,Live,[A1,A2],Reg}; +%% +%% New instruction in R14, gc_bif with 3 arguments +%% +resolve_inst({gc_bif3,Args},Imports,_,_) -> + [F,Live,Bif,A1,A2,A3,Reg] = resolve_args(Args), + {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports), + {gc_bif,BifName,F,Live,[A1,A2,A3],Reg}; %% %% New instructions for creating non-byte aligned binaries. %% -resolve_inst({bs_bits_to_bytes2,[_Arg2,_Arg3]=Args},_,_,_) -> - [A2,A3] = resolve_args(Args), - {bs_bits_to_bytes2,A2,A3}; resolve_inst({bs_final2,[X,Y]},_,_,_) -> {bs_final2,X,Y}; @@ -1096,6 +1100,20 @@ resolve_inst({on_load,[]},_,_,_) -> on_load; %% +%% R14A. +%% +resolve_inst({recv_mark,[Lbl]},_,_,_) -> + {recv_mark,Lbl}; +resolve_inst({recv_set,[Lbl]},_,_,_) -> + {recv_set,Lbl}; + +%% +%% R15A. +%% +resolve_inst({line,[Index]},_,_,_) -> + {line,resolve_arg(Index)}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl new file mode 100644 index 0000000000..fb1a43cd9e --- /dev/null +++ b/lib/compiler/src/beam_except.erl @@ -0,0 +1,149 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_except). +-export([module/2]). + +%%% Rewrite certain calls to erlang:error/{1,2} to specialized +%%% instructions: +%%% +%%% erlang:error({badmatch,Value}) => badmatch Value +%%% erlang:error({case_clause,Value}) => case_end Value +%%% erlang:error({try_clause,Value}) => try_case_end Value +%%% erlang:error(if_clause) => if_end +%%% erlang:error(function_clause, Args) => jump FuncInfoLabel +%%% + +-import(lists, [reverse/1]). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}) -> + try + Is = function_1(Is0), + {function,Name,Arity,CLabel,Is} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +-record(st, + {lbl, %func_info label + loc %location for func_info + }). + +function_1(Is0) -> + case Is0 of + [{label,Lbl},{line,Loc}|_] -> + St = #st{lbl=Lbl,loc=Loc}, + translate(Is0, St, []); + [{label,_}|_] -> + %% No line numbers. The source must be a .S file. + %% There is no need to do anything. + Is0 + end. + +translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> + translate_1(Ar, I, Is, St, Acc); +translate([{call_ext_only,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> + translate_1(Ar, I, Is, St, Acc); +translate([{call_ext_last,Ar,{extfunc,erlang,error,Ar},_}=I|Is], St, Acc) -> + translate_1(Ar, I, Is, St, Acc); +translate([I|Is], St, Acc) -> + translate(Is, St, [I|Acc]); +translate([], _, Acc) -> + reverse(Acc). + +translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) -> + case dig_out(Ar, Acc1) of + no -> + translate(Is, St, [I|Acc0]); + {yes,function_clause,Acc2} -> + case {Line,St} of + {{line,Loc},#st{lbl=Fi,loc=Loc}} -> + Instr = {jump,{f,Fi}}, + translate(Is, St, [Instr|Acc2]); + {_,_} -> + %% This must be "error(function_clause, Args)" in + %% the Erlang source code. Don't translate. + translate(Is, St, [I|Acc0]) + end; + {yes,Instr,Acc2} -> + translate(Is, St, [Instr,Line|Acc2]) + end. + +dig_out(Ar, [{kill,_}|Is]) -> + dig_out(Ar, Is); +dig_out(1, [{block,Bl0}|Is]) -> + case dig_out_block(reverse(Bl0)) of + no -> no; + {yes,What,[]} -> + {yes,What,Is}; + {yes,What,Bl} -> + {yes,What,[{block,Bl}|Is]} + end; +dig_out(2, [{block,Bl}|Is]) -> + case dig_out_block_fc(Bl) of + no -> no; + {yes,What} -> {yes,What,Is} + end; +dig_out(_, _) -> no. + +dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> + {yes,if_end,[]}; +dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> + translate_exception(Exc, {literal,Value}, Is, 0); +dig_out_block([{set,[{x,0}],[Tuple],move}, + {set,[],[Value],put}, + {set,[],[{atom,Exc}],put}, + {set,[Tuple],[],{put_tuple,2}}|Is]) -> + translate_exception(Exc, Value, Is, 3); +dig_out_block([{set,[],[Value],put}, + {set,[],[{atom,Exc}],put}, + {set,[{x,0}],[],{put_tuple,2}}|Is]) -> + translate_exception(Exc, Value, Is, 3); +dig_out_block(_) -> no. + +translate_exception(badmatch, Val, Is, Words) -> + {yes,{badmatch,Val},fix_block(Is, Words)}; +translate_exception(case_clause, Val, Is, Words) -> + {yes,{case_end,Val},fix_block(Is, Words)}; +translate_exception(try_clause, Val, Is, Words) -> + {yes,{try_case_end,Val},fix_block(Is, Words)}; +translate_exception(_, _, _, _) -> no. + +fix_block(Is, 0) -> + reverse(Is); +fix_block(Is0, Words) -> + [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0), + [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]. + +dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> + dig_out_fc(Bl, Live-1, nil); +dig_out_block_fc(_) -> no. + +dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) -> + dig_out_fc(Is, Reg-1, Dst); +dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) -> + {yes,function_clause}; +dig_out_fc(_, _, _) -> no. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index d9de7e2495..6c7cb849aa 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Converts intermediate assembly code to final format. @@ -57,7 +57,6 @@ norm({set,[D],[S],fconv}) -> {fconv,S,D}; norm({set,[D],[S1,S2],put_list}) -> {put_list,S1,S2,D}; norm({set,[D],[],{put_tuple,A}}) -> {put_tuple,A,D}; norm({set,[],[S],put}) -> {put,S}; -norm({set,[D],[],{put_string,L,S}}) -> {put_string,L,S,D}; norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D}; norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 739928f411..db67d24514 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %%% Purpose : Optimise jumps and remove unreachable code. @@ -169,7 +169,7 @@ share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) -> share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) end; share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> - Is++[I|Acc]; + reverse(Is, [I|Acc]); share_1([I|Is], Dict, Seq, Acc) -> case is_unreachable_after(I) of false -> @@ -206,25 +206,35 @@ is_label(_) -> false. move(Is) -> move_1(Is, [], []). -move_1([I|Is], End, Acc) -> +move_1([I|Is], End0, Acc0) -> case is_exit_instruction(I) of - false -> move_1(Is, End, [I|Acc]); - true -> move_2(I, Is, End, Acc) + false -> + move_1(Is, End0, [I|Acc0]); + true -> + case extract_seq(Acc0, [I|End0]) of + no -> + move_1(Is, End0, [I|Acc0]); + {yes,End,Acc} -> + move_1(Is, End, Acc) + end end; -move_1([], End, Acc) -> - reverse(Acc, reverse(End)). - -move_2(Exit, Is, End, [{block,_},{label,_},{func_info,_,_,_}|_]=Acc) -> - move_1(Is, End, [Exit|Acc]); -move_2(Exit, Is, End, [{block,_}=Blk,{label,_}=Lbl,Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Blk,Lbl|End], More); -move_2(Exit, Is, End, [{bs_context_to_binary,_}=Bs,{label,_}=Lbl, - Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Bs,Lbl|End], More); -move_2(Exit, Is, End, [{label,_}=Lbl,Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Lbl|End], More); -move_2(Exit, Is, End, Acc) -> - move_1(Is, End, [Exit|Acc]). +move_1([], End, Acc) -> reverse(Acc, End). + +extract_seq([{line,_}=Line|Is], Acc) -> + extract_seq(Is, [Line|Acc]); +extract_seq([{block,_}=Bl|Is], Acc) -> + extract_seq_1(Is, [Bl|Acc]); +extract_seq([{label,_}|_]=Is, Acc) -> + extract_seq_1(Is, Acc); +extract_seq(_, _) -> no. + +extract_seq_1([{line,_}=Line|Is], Acc) -> + extract_seq_1(Is, [Line|Acc]); +extract_seq_1([{label,_},{func_info,_,_,_}|_], _) -> + no; +extract_seq_1([{label,_}=Lbl|Is], Acc) -> + {yes,[Lbl|Acc],Is}; +extract_seq_1(_, _) -> no. %%% %%% (3) (4) (5) (6) Jump and unreachable code optimizations. @@ -452,9 +462,9 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> {'catch',{f,F}} -> F =:= Lbl; {alloc,_,_} -> false; {put_tuple,_} -> false; - {put_string,_,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; + {line,_} -> false; _ when is_atom(Info) -> false end. @@ -488,6 +498,8 @@ rem_unused([], _, Acc) -> reverse(Acc). initial_labels(Is) -> initial_labels(Is, []). +initial_labels([{line,_}|Is], Acc) -> + initial_labels(Is, Acc); initial_labels([{label,Lbl}|Is], Acc) -> initial_labels(Is, [Lbl|Acc]); initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) -> diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index be7b14c3dd..50d1f3cdb1 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. 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 @@ -61,7 +61,7 @@ print_op(Stream, Label) when element(1, Label) == label -> print_op(Stream, Op) -> io:format(Stream, " ~p.\n", [Op]). -function(File, {function,Name,Arity,Args,Body,Vdb}) -> +function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> io:nl(File), io:format(File, "function ~p/~p.\n", [Name,Arity]), io:format(File, " ~p.\n", [Args]), diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index d03ac4b1f4..f39fc50b95 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -64,22 +64,7 @@ function({function,Name,Arity,CLabel,Is0}) -> %% InEncoding =:= latin1, OutEncoding =:= unicode; %% InEncoding =:= latin1, OutEncoding =:= utf8 -> %% -%% (2) Code like -%% -%% is_ne_exact Fail Reg Literal1 -%% is_ne_exact Fail Reg Literal2 -%% is_ne_exact Fail Reg Literal3 -%% is_eq_exact UltimateFail Reg Literal4 -%% Fail: .... -%% -%% can be rewritten to -%% -%% select_val Reg UltimateFail [ Literal1 Fail -%% Literal2 Fail -%% Literal3 Fail -%% Literal4 Fail ] -%% -%% (3) A select_val/4 instruction that only verifies that +%% (2) A select_val/4 instruction that only verifies that %% its argument is either 'true' or 'false' can be %% be replaced with an is_boolean/2 instruction. That is: %% @@ -132,7 +117,7 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> false -> %% Remember that we have seen this test. SeenTests = gb_sets:insert(Test, SeenTests0), - make_select_val(I, Is, SeenTests, Acc) + peep(Is, SeenTests, [I|Acc]) end end; peep([{select_val,Src,Fail, @@ -151,33 +136,6 @@ peep([I|Is], _, Acc) -> peep(Is, gb_sets:empty(), [I|Acc]); peep([], _, Acc) -> reverse(Acc). -make_select_val({test,is_ne_exact,{f,Fail},[Val,Lit]}=I0, - Is0, SeenTests, Acc) -> - try - Type = case Lit of - {atom,_} -> atom; - {integer,_} -> integer; - _ -> throw(impossible) - end, - {I,Is} = make_select_val_1(Is0, Fail, Val, Type, [Lit,{f,Fail}]), - peep([I|Is], SeenTests, Acc) - catch - impossible -> - peep(Is0, SeenTests, [I0|Acc]) - end; -make_select_val(I, Is, SeenTests, Acc) -> - peep(Is, SeenTests, [I|Acc]). - -make_select_val_1([{test,is_ne_exact,{f,Fail},[Val,{Type,_}=Lit]}|Is], - Fail, Val, Type, Acc) -> - make_select_val_1(Is, Fail, Val, Type, [Lit,{f,Fail}|Acc]); -make_select_val_1([{test,is_eq_exact,{f,UltimateFail},[Val,{Type,_}=Lit]} | - [{label,Fail}|_]=Is], Fail, Val, Type, Acc) -> - Choices = [Lit,{f,Fail}|Acc], - I = {select_val,Val,{f,UltimateFail},{list,Choices}}, - {I,Is}; -make_select_val_1(_Is, _Fail, _Val, _Type, _Acc) -> throw(impossible). - kill_seen(Dst, Seen0) -> gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)). @@ -187,5 +145,3 @@ kill_seen_1([{_,Ops}=Test|T], Dst) -> false -> [Test|kill_seen_1(T, Dst)] end; kill_seen_1([], _) -> []. - - diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl new file mode 100644 index 0000000000..bd1f44f66b --- /dev/null +++ b/lib/compiler/src/beam_receive.erl @@ -0,0 +1,390 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_receive). +-export([module/2]). +-import(lists, [foldl/3,reverse/1,reverse/2]). + +%%% +%%% In code such as: +%%% +%%% Ref = make_ref(), %Or erlang:monitor(process, Pid) +%%% . +%%% . +%%% . +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% we know that none of the messages that exist in the message queue +%%% before the call to make_ref/0 can be matched out in the receive +%%% statement. Therefore we can avoid going through the entire message +%%% queue if we introduce two new instructions (here written as +%%% BIFs in pseudo-Erlang): +%%% +%%% recv_mark(SomeUniqInteger), +%%% Ref = make_ref(), +%%% . +%%% . +%%% . +%%% recv_set(SomeUniqInteger), +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% The recv_mark/1 instruction will save the current position and +%%% SomeUniqInteger in the process context. The recv_set +%%% instruction will verify that SomeUniqInteger is still stored +%%% in the process context. If it is, it will set the current pointer +%%% for the message queue (the next message to be read out) to the +%%% position that was saved by recv_mark/1. +%%% +%%% The remove_message instruction must be modified to invalidate +%%% the information stored by the previous recv_mark/1, in case there +%%% is another receive executed between the calls to recv_mark/1 and +%%% recv_set/1. +%%% +%%% We use a reference to a label (i.e. a position in the loaded code) +%%% as the SomeUniqInteger. +%%% + +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + Fs = [function(F) || F <- Fs0], + Code = {Mod,Exp,Attr,Fs,Lc}, + {ok,Code}. + +%%% +%%% Local functions. +%%% + +function({function,Name,Arity,Entry,Is}) -> + try + D = beam_utils:index_labels(Is), + {function,Name,Arity,Entry,opt(Is, D, [])} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) -> + case creates_new_ref(Name, Arity) of + true -> + %% The call creates a brand new reference. Now + %% search for a receive statement in the same + %% function that will match against the reference. + case opt_recv(Is0, D) of + no -> + opt(Is0, D, [I|Acc]); + {yes,Is,Lbl} -> + opt(Is, D, [I,{recv_mark,{f,Lbl}}|Acc]) + end; + false -> + opt(Is0, D, [I|Acc]) + end; +opt([I|Is], D, Acc) -> + opt(Is, D, [I|Acc]); +opt([], _, Acc) -> + reverse(Acc). + +%% creates_new_ref(Name, Arity) -> true|false. +%% Return 'true' if the BIF Name/Arity will create a new reference. +creates_new_ref(monitor, 2) -> true; +creates_new_ref(make_ref, 0) -> true; +creates_new_ref(_, _) -> false. + +%% opt_recv([Instruction], LabelIndex) -> no|{yes,[Instruction]} +%% Search for a receive statement that will only retrieve messages +%% that contain the newly created reference (which is currently in {x,0}). +opt_recv(Is, D) -> + R = regs_init_x0(), + L = gb_sets:empty(), + opt_recv(Is, D, R, L, []). + +opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) -> + R = regs_kill_not_live(0, R0), + case regs_to_list(R) of + [{y,_}=RefReg] -> + %% We now have the new reference in the Y register RefReg + %% and the current instruction is the beginning of a + %% receive statement. We must now verify that only messages + %% that contain the reference will be matched. + case opt_ref_used(Is, RefReg, Fail, D) of + false -> + no; + true -> + RecvSet = {recv_set,{f,L}}, + {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L} + end; + [] -> + no + end; +opt_recv([I|Is], D, R0, L0, Acc) -> + {R,L} = opt_update_regs(I, R0, L0), + case regs_empty(R) of + true -> + %% The reference is no longer alive. There is no + %% point in continuing the search. + no; + false -> + opt_recv(Is, D, R, L, [I|Acc]) + end. + +opt_update_regs({block,Bl}, R, L) -> + {opt_update_regs_bl(Bl, R),L}; +opt_update_regs({call,_,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({call_ext,_,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({call_fun,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({kill,Y}, R, L) -> + {regs_kill([Y], R),L}; +opt_update_regs(send, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({'catch',_,{f,Lbl}}, R, L) -> + {R,gb_sets:add(Lbl, L)}; +opt_update_regs({catch_end,_}, R, L) -> + {R,L}; +opt_update_regs({label,Lbl}, R, L) -> + case gb_sets:is_member(Lbl, L) of + false -> + %% We can't allow arbitrary labels (since the receive + %% could be entered without first creating the reference). + {regs_init(),L}; + true -> + %% A catch label for a previously seen catch instruction is OK. + {R,L} + end; +opt_update_regs({try_end,_}, R, L) -> + {R,L}; +opt_update_regs({line,_}, R, L) -> + {R,L}; +opt_update_regs(_I, _R, L) -> + %% Unrecognized instruction. Abort the search. + {regs_init(),L}. + +opt_update_regs_bl([{set,Ds,_,{alloc,Live,_}}|Is], Regs0) -> + Regs1 = regs_kill_not_live(Live, Regs0), + Regs = regs_kill(Ds, Regs1), + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([{set,[Dst]=Ds,[Src],move}|Is], Regs0) -> + Regs1 = regs_kill(Ds, Regs0), + Regs = case regs_is_member(Src, Regs1) of + false -> Regs1; + true -> regs_add(Dst, Regs1) + end, + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) -> + Regs = regs_kill(Ds, Regs0), + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([], Regs) -> Regs. + +%% opt_ref_used([Instruction], RefRegister, FailLabel, LabelIndex) -> true|false +%% Return 'true' if it is certain that only messages that contain the same +%% reference as in RefRegister can be matched out. Otherwise return 'false'. +%% +%% Basically, we follow all possible paths through the receive statement. +%% If all paths are safe, we return 'true'. +%% +%% A branch to FailLabel is safe, because it exits the receive statement +%% and no further message may be matched out. +%% +%% If a path hits an comparision between RefRegister and part of the message, +%% that path is safe (any messages that may be matched further down the +%% path is guaranteed to contain the reference). +%% +%% Otherwise, if we hit a 'remove_message' instruction, we give up +%% and return 'false' (the optimization is definitely unsafe). If +%% we hit an unrecognized instruction, we also give up and return +%% 'false' (the optimization may be unsafe). + +opt_ref_used(Is, RefReg, Fail, D) -> + Done = gb_sets:singleton(Fail), + Regs = regs_init_x0(), + try + opt_ref_used_1(Is, RefReg, D, Done, Regs), + true + catch + throw:not_used -> + false + end. + +%% This functions only returns if all paths through the receive +%% statement are safe, and throws an 'not_used' term otherwise. +opt_ref_used_1([{block,Bl}|Is], RefReg, D, Done, Regs0) -> + Regs = opt_ref_used_bl(Bl, Regs0), + opt_ref_used_1(Is, RefReg, D, Done, Regs); +opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefReg, Regs) of + false -> + opt_ref_used_1(Is, RefReg, D, Done, Regs); + true -> + %% The instructions that follow (Is) can only be executed + %% if the message contains the same reference as in RefReg. + Done + end; +opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefReg, Regs) of + false -> + opt_ref_used_at(Fail, RefReg, D, Done, Regs); + true -> + Done + end; +opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs), + opt_ref_used_1(Is, RefReg, D, Done, Regs); +opt_ref_used_1([{select_tuple_arity,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> + Lbls = [F || {f,F} <- List] ++ [Fail], + opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); +opt_ref_used_1([{select_val,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> + Lbls = [F || {f,F} <- List] ++ [Fail], + opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); +opt_ref_used_1([{label,Lbl}|Is], RefReg, D, Done, Regs) -> + case gb_sets:is_member(Lbl, Done) of + true -> Done; + false -> opt_ref_used_1(Is, RefReg, D, Done, Regs) + end; +opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) -> + Done; +opt_ref_used_1([_I|_], _RefReg, _D, _Done, _Regs) -> + %% The optimization may be unsafe. + throw(not_used). + +%% is_ref_msg_comparison(Args, RefReg, RegisterSet) -> true|false. +%% Return 'true' if Args denotes a comparison between the +%% reference and message or part of the message. +is_ref_msg_comparison([R,RefReg], RefReg, Regs) -> + regs_is_member(R, Regs); +is_ref_msg_comparison([RefReg,R], RefReg, Regs) -> + regs_is_member(R, Regs); +is_ref_msg_comparison([_,_], _, _) -> false. + +opt_ref_used_in_all([L|Ls], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(L, RefReg, D, Done0, Regs), + opt_ref_used_in_all(Ls, RefReg, D, Done, Regs); +opt_ref_used_in_all([], _, _, Done, _) -> Done. + +opt_ref_used_at(Fail, RefReg, D, Done0, Regs) -> + case gb_sets:is_member(Fail, Done0) of + true -> + Done0; + false -> + Is = beam_utils:code_at(Fail, D), + Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs), + gb_sets:add(Fail, Done) + end. + +opt_ref_used_bl([{set,[],[],remove_message}|_], _) -> + %% We have proved that a message that does not depend on the + %% reference can be matched out. + throw(not_used); +opt_ref_used_bl([{set,Ds,Ss,_}|Is], Regs0) -> + case regs_all_members(Ss, Regs0) of + false -> + %% The destination registers may be assigned values that + %% are not dependent on the message being matched. + Regs = regs_kill(Ds, Regs0), + opt_ref_used_bl(Is, Regs); + true -> + %% All the sources depend on the message directly or + %% indirectly. + Regs = regs_add_list(Ds, Regs0), + opt_ref_used_bl(Is, Regs) + end; +opt_ref_used_bl([], Regs) -> Regs. + +%%% +%%% Functions for keeping track of a set of registers. +%%% + +%% regs_init() -> RegisterSet +%% Return an empty set of registers. + +regs_init() -> + {0,0}. + +%% regs_init_x0() -> RegisterSet +%% Return a set that only contains the {x,0} register. + +regs_init_x0() -> + {1 bsl 0,0}. + +%% regs_empty(Register) -> true|false +%% Test whether the register set is empty. + +regs_empty(R) -> + R =:= {0,0}. + +%% regs_kill_not_live(Live, RegisterSet) -> RegisterSet' +%% Kill all registers indicated not live by Live. + +regs_kill_not_live(Live, {Xregs,Yregs}) -> + {Xregs band ((1 bsl Live)-1),Yregs}. + +%% regs_kill([Register], RegisterSet) -> RegisterSet' +%% Kill all registers mentioned in the list of registers. + +regs_kill([{x,N}|Rs], {Xregs,Yregs}) -> + regs_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs}); +regs_kill([{y,N}|Rs], {Xregs,Yregs}) -> + regs_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))}); +regs_kill([{fr,_}|Rs], Regs) -> + regs_kill(Rs, Regs); +regs_kill([], Regs) -> Regs. + +regs_add_list(List, Regs) -> + foldl(fun(R, A) -> regs_add(R, A) end, Regs, List). + +%% regs_add(Register, RegisterSet) -> RegisterSet' +%% Add a new register to the set of registers. + +regs_add({x,N}, {Xregs,Yregs}) -> + {Xregs bor (1 bsl N),Yregs}; +regs_add({y,N}, {Xregs,Yregs}) -> + {Xregs,Yregs bor (1 bsl N)}. + +%% regs_all_members([Register], RegisterSet) -> true|false +%% Test whether all of the registers are part of the register set. + +regs_all_members([R|Rs], Regs) -> + regs_is_member(R, Regs) andalso regs_all_members(Rs, Regs); +regs_all_members([], _) -> true. + +%% regs_is_member(Register, RegisterSet) -> true|false +%% Test whether Register is part of the register set. + +regs_is_member({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0; +regs_is_member({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0; +regs_is_member(_, _) -> false. + +%% regs_to_list(RegisterSet) -> [Register] +%% Convert the register set to an explicit list of registers. +regs_to_list({Xregs,Yregs}) -> + regs_to_list_1(Xregs, 0, x, regs_to_list_1(Yregs, 0, y, [])). + +regs_to_list_1(0, _, _, Acc) -> + Acc; +regs_to_list_1(Regs, N, Tag, Acc) when (Regs band 1) =:= 1 -> + regs_to_list_1(Regs bsr 1, N+1, Tag, [{Tag,N}|Acc]); +regs_to_list_1(Regs, N, Tag, Acc) -> + regs_to_list_1(Regs bsr 1, N+1, Tag, Acc). diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl new file mode 100644 index 0000000000..cacaaebffe --- /dev/null +++ b/lib/compiler/src/beam_split.erl @@ -0,0 +1,85 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_split). +-export([module/2]). + +-import(lists, [reverse/1]). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + Fs = [split_blocks(F) || F <- Fs0], + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +%% We must split the basic block when we encounter instructions with labels, +%% such as catches and BIFs. All labels must be visible outside the blocks. + +split_blocks({function,Name,Arity,CLabel,Is0}) -> + Is = split_blocks(Is0, []), + {function,Name,Arity,CLabel,Is}. + +split_blocks([{block,Bl}|Is], Acc0) -> + Acc = split_block(Bl, [], Acc0), + split_blocks(Is, Acc); +split_blocks([I|Is], Acc) -> + split_blocks(Is, [I|Acc]); +split_blocks([], Acc) -> reverse(Acc). + +split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> + %% is_record/3 must be translated by beam_clean; therefore, + %% it must be outside of any block. + 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,{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)]); +split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> + split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); +split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> + split_block(Is, [], [Line|make_block(Bl, Acc)]); +split_block([I|Is], Bl, Acc) -> + split_block(Is, [I|Bl], Acc); +split_block([], Bl, Acc) -> make_block(Bl, Acc). + +make_block([], Acc) -> Acc; +make_block([{set,[D],Ss,{bif,Op,Fail}}|Bl]=Bl0, Acc) -> + %% If the last instruction in the block is a comparison or boolean operator + %% (such as '=:='), move it out of the block to facilitate further + %% optimizations. + Arity = length(Ss), + case erl_internal:comp_op(Op, Arity) orelse + erl_internal:new_type_test(Op, Arity) orelse + erl_internal:bool_op(Op, Arity) of + false -> + [{block,reverse(Bl0)}|Acc]; + true -> + I = {bif,Op,Fail,Ss,D}, + case Bl =:= [] of + true -> [I|Acc]; + false -> [I,{block,reverse(Bl)}|Acc] + end + end; +make_block([{set,[Dst],[Src],move}|Bl], Acc) -> + %% Make optimization of {move,Src,Dst}, {jump,...} possible. + I = {move,Src,Dst}, + case Bl =:= [] of + true -> [I|Acc]; + false -> [I,{block,reverse(Bl)}|Acc] + end; +make_block(Bl, Acc) -> [{block,reverse(Bl)}|Acc]. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 790aba0a9a..5f4fa3b1f8 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. 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 @@ -222,7 +222,9 @@ remap([{call_last,Ar,Name,N}|Is], Map, Acc) -> reverse(Acc, [I|Is]); remap([{call_ext_last,Ar,Name,N}|Is], Map, Acc) -> I = {call_ext_last,Ar,Name,Map({frame_size,N})}, - reverse(Acc, [I|Is]). + reverse(Acc, [I|Is]); +remap([{line,_}=I|Is], Map, Acc) -> + remap(Is, Map, [I|Acc]). remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> Ds = [Map(D) || D <- Ds0], @@ -230,14 +232,15 @@ remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> remap_block(Is, Map, [{set,Ds,Ss,Info}|Acc]); remap_block([], _, Acc) -> reverse(Acc). -safe_labels([{label,L},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> +safe_labels([{label,L},{line,_},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); -safe_labels([{label,L},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> +safe_labels([{label,L},{line,_},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); -safe_labels([{label,L},if_end|Is], Acc) -> +safe_labels([{label,L},{line,_},if_end|Is], Acc) -> safe_labels(Is, [L|Acc]); safe_labels([{label,L}, {block,[{set,[{x,0}],[{Tag,_}],move}]}, + {line,_}, {call_ext,1,{extfunc,erlang,error,1}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); safe_labels([_|Is], Acc) -> @@ -321,6 +324,8 @@ frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size([{deallocate,N}|_], _) -> N; frame_size([{call_last,_,_,N}|_], _) -> N; frame_size([{call_ext_last,_,_,N}|_], _) -> N; +frame_size([{line,_}|Is], Safe) -> + frame_size(Is, Safe); frame_size([_|_], _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index ba903a12b6..d307d192b2 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Type-based optimisations. @@ -29,10 +29,17 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> {ok,{Mod,Exp,Attr,Fs,Lc}}. function({function,Name,Arity,CLabel,Asm0}) -> - Asm1 = beam_utils:live_opt(Asm0), - Asm2 = opt(Asm1, [], tdb_new()), - Asm = beam_utils:delete_live_annos(Asm2), - {function,Name,Arity,CLabel,Asm}. + try + Asm1 = beam_utils:live_opt(Asm0), + Asm2 = opt(Asm1, [], tdb_new()), + Asm = beam_utils:delete_live_annos(Asm2), + {function,Name,Arity,CLabel,Asm} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. %% opt([Instruction], Accumulator, TypeDb) -> {[Instruction'],TypeDb'} %% Keep track of type information; try to simplify. @@ -76,9 +83,6 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A end, Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); -simplify_basic_1([{set,[_],[_],{bif,_,{f,0}}}=I|Is], Ts0, Acc) -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]); simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> case tdb_find(TupleReg, Ts0) of {tuple,_,[Contents]} -> @@ -118,7 +122,6 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0 Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; - simplify_basic_1([I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); @@ -172,6 +175,8 @@ simplify_float_1([{set,[D0],[A,B],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts0, simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> Acc = flush_all(Rs0, Is0, 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]=Is0, Ts0, Rs0, Acc0) -> Ts = update(I, Ts0), {Rs,Acc} = flush(Rs0, Is0, Acc0), @@ -183,7 +188,7 @@ simplify_float_1([], Ts, Rs, Acc0) -> {Is,Ts}. opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1, - {set,[{y,_}]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> + {set,[_]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> case beam_utils:is_killed_block(R, Is) of false -> opt_fmoves(Is, [I2,I1|Acc]); true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc]) @@ -253,8 +258,6 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) -> {[],H+1,Fl}; flt_need_heap_2({set,_,_,put}, H, Fl) -> {[],H+1,Fl}; -flt_need_heap_2({set,_,_,{put_string,L,_Str}}, H, Fl) -> - {[],H+2*L,Fl}; %% Then the "neutral" instructions. We just pass them. flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) -> {[],H,Fl}; @@ -406,6 +409,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> 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); +update({line,_}, Ts) -> Ts; %% The instruction is unknown. Kill all information. update(_I, _Ts) -> tdb_new(). diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index ac249e6672..194f089ba1 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Common utilities used by several optimization passes. @@ -26,7 +26,7 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). --import(lists, [member/2,sort/1,reverse/1]). +-import(lists, [member/2,sort/1,reverse/1,splitwith/2]). -record(live, {bl, %Block check fun. @@ -195,10 +195,14 @@ is_pure_test({test,Op,_,Ops}) -> %% Also insert {'%live',Live} annotations at the beginning %% and end of each block. %% -live_opt([{label,Fail}=I1, - {func_info,_,_,Live}=I2|Is]) -> +live_opt(Is0) -> + {[{label,Fail}|_]=Bef,[Fi|Is]} = + splitwith(fun({func_info,_,_,_}) -> false; + (_) -> true + end, Is0), + {func_info,_,_,Live} = Fi, D = gb_trees:insert(Fail, live_call(Live), gb_trees:empty()), - [I1,I2|live_opt(reverse(Is), 0, D, [])]. + Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. %% delete_live_annos([Instruction]) -> [Instruction]. @@ -407,16 +411,23 @@ check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) -> Other -> Other end; -check_liveness(R, [{gc_bif,Op,{f,Fail},_,Ss,D}|Is], St0) -> - case check_liveness_fail(R, Op, Ss, Fail, St0) of - {killed,St} = Killed -> - case member(R, Ss) of - true -> {used,St}; - false when R =:= D -> Killed; - false -> check_liveness(R, Is, St) - end; - Other -> - Other +check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) -> + case R of + {x,X} when X >= Live -> + {killed,St0}; + {x,_} -> + {used,St0}; + _ -> + case check_liveness_fail(R, Op, Ss, Fail, St0) of + {killed,St}=Killed -> + case member(R, Ss) of + true -> {used,St}; + false when R =:= D -> Killed; + false -> check_liveness(R, Is, St) + end; + Other -> + Other + end end; check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) -> case member(R, Ss) of @@ -424,12 +435,6 @@ check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) -> false when R =:= D -> {killed,St}; false -> check_liveness(R, Is, St) end; -check_liveness(R, [{bs_bits_to_bytes2,Src,Dst}|Is], St) -> - case R of - Src -> {used,St}; - Dst -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; check_liveness(R, [{bs_put_binary,{f,0},Sz,_,_,Src}|Is], St) -> case member(R, [Sz,Src]) of true -> {used,St}; @@ -469,8 +474,15 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> end; check_liveness(R, [{try_end,Y}|Is], St) -> case R of - Y -> {killed,St}; - _ -> check_liveness(R, Is, St) + Y -> + {killed,St}; + {y,_} -> + %% y registers will be used if an exception occurs and + %% control transfers to the label given in the previous + %% try/2 instruction. + {used,St}; + _ -> + check_liveness(R, Is, St) end; check_liveness(R, [{catch_end,Y}|Is], St) -> case R of @@ -488,13 +500,18 @@ check_liveness(R, [{bs_context_to_binary,S}|Is], St) -> S -> {used,St}; _ -> check_liveness(R, Is, St) end; -check_liveness(R, [{loop_rec,{f,_},{x,0}}|Is], St) -> +check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) -> case R of - {x,_} -> {killed,St}; - _ -> check_liveness(R, Is, St) + {x,_} -> + {killed,St}; + _ -> + %% y register. Rarely happens. Be very conversative. + {unknown,St} end; 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, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> @@ -724,6 +741,9 @@ live_opt([{badmatch,Src}=I|Is], _, D, Acc) -> live_opt([{case_end,Src}=I|Is], _, D, Acc) -> Regs = x_live([Src], 0), live_opt(Is, Regs, D, [I|Acc]); +live_opt([{try_case_end,Src}=I|Is], _, D, Acc) -> + Regs = x_live([Src], 0), + live_opt(Is, Regs, D, [I|Acc]); live_opt([if_end=I|Is], _, D, Acc) -> Regs = 0, live_opt(Is, Regs, D, [I|Acc]); @@ -785,8 +805,6 @@ live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{kill,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_case_end,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> @@ -795,6 +813,8 @@ live_opt([{wait,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{line,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been %% started from a .S file using the 'asm' option. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 1fd61831e0..9f0bca9dd5 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. 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 @@ -18,6 +18,10 @@ -module(beam_validator). +-compile({no_auto_import,[min/2]}). + +%% Avoid warning for local function error/1 clashing with autoimported BIF. +-compile({no_auto_import,[error/1]}). -export([file/1, files/1]). %% Interface for compiler. @@ -162,12 +166,17 @@ validate(Module, Fs) -> Ft = index_bs_start_match(Fs, []), validate_0(Module, Fs, Ft). -index_bs_start_match([{function,_,_,Entry,Code}|Fs], Acc0) -> +index_bs_start_match([{function,_,_,Entry,Code0}|Fs], Acc0) -> + Code = dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Code0), case Code of - [_,_,{label,Entry}|Is] -> + [{label,Entry}|Is] -> Acc = index_bs_start_match_1(Is, Entry, Acc0), index_bs_start_match(Fs, Acc); _ -> + %% Something serious is wrong. Ignore it for now. + %% It will be detected and diagnosed later. index_bs_start_match(Fs, Acc0) end; index_bs_start_match([], Acc) -> @@ -288,6 +297,8 @@ labels(Is) -> labels_1([{label,L}|Is], R) -> labels_1(Is, [L|R]); +labels_1([{line,_}|Is], R) -> + labels_1(Is, R); labels_1(Is, R) -> {lists:reverse(R),Is}. @@ -416,6 +427,11 @@ valfun_1({put,Src}, Vst) -> valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) -> Vst = eat_heap(2*Sz, Vst0), set_type_reg(cons, Dst, Vst); +%% Instructions for optimization of selective receives. +valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> + Vst; +valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> + Vst; %% Misc. valfun_1({'%live',Live}, Vst) -> verify_live(Live, Vst), @@ -424,6 +440,8 @@ valfun_1(remove_message, Vst) -> Vst; valfun_1({'%',_}, Vst) -> Vst; +valfun_1({line,_}, Vst) -> + Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> case return_type(Func, Vst) of @@ -652,10 +670,20 @@ valfun_4({get_tuple_element,Src,I,Dst}, Vst) -> valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> %% If source and destination registers are the same, match state %% is OK as input. - _ = get_move_term_type(Ctx, Vst0), + CtxType = get_move_term_type(Ctx, Vst0), verify_live(Live, Vst0), Vst1 = prune_x_regs(Live, Vst0), - Vst = branch_state(Fail, Vst1), + BranchVst = case CtxType of + {match_context,_,_} -> + %% The failure branch will never be taken when Ctx + %% is a match context. Therefore, the type for Ctx + %% at the failure label must not be match_context + %% (or we could reject legal code). + set_type_reg(term, Ctx, Vst1); + _ -> + Vst1 + end, + Vst = branch_state(Fail, BranchVst), set_type_reg(bsm_match_state(NeedSlots), Ctx, Vst); valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) -> assert_term(Src, Vst0), @@ -752,21 +780,30 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_bits_to_bytes2,Src,Dst}, Vst) -> - assert_term(Src, Vst), - set_type_reg({integer,[]}, Dst, Vst); valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) -> assert_term(Src, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_init2,{f,Fail},_,Heap,Live,_,Dst}, Vst0) -> +valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + if + is_integer(Sz) -> + ok; + true -> + assert_term(Sz, Vst0) + end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst3 = prune_x_regs(Live, Vst2), Vst = bs_zero_bits(Vst3), set_type_reg(binary, Dst, Vst); -valfun_4({bs_init_bits,{f,Fail},_,Heap,Live,_,Dst}, Vst0) -> +valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + if + is_integer(Sz) -> + ok; + true -> + assert_term(Sz, Vst0) + end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst3 = prune_x_regs(Live, Vst2), @@ -864,6 +901,8 @@ val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; +val_dsetel({line,_}, Vst) -> + Vst; val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; val_dsetel(_, Vst) -> Vst. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 74fc0878cf..4b74d60e9f 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% ===================================================================== @@ -122,6 +122,9 @@ bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1, bitstr_flags/1]). +-export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0, + c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). + %% %% needed by the include file below -- do not move %% @@ -970,7 +973,7 @@ atom_name(Node) -> %% TODO: replace the use of the unofficial 'write_string/2'. --spec atom_lit(cerl()) -> string(). +-spec atom_lit(cerl()) -> nonempty_string(). atom_lit(Node) -> io_lib:write_string(atom_name(Node), $'). %' stupid Emacs. @@ -1076,7 +1079,7 @@ char_val(Node) -> %% %% @see c_char/1 --spec char_lit(c_literal()) -> string(). +-spec char_lit(c_literal()) -> nonempty_string(). char_lit(Node) -> io_lib:write_char(char_val(Node)). @@ -1175,7 +1178,7 @@ string_val(Node) -> %% %% @see c_string/1 --spec string_lit(c_literal()) -> string(). +-spec string_lit(c_literal()) -> nonempty_string(). string_lit(Node) -> io_lib:write_string(string_val(Node)). diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 5f111a5e05..99fa8dd9d5 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @doc Utility functions for Core Erlang case/receive clauses. @@ -338,10 +338,19 @@ match(P, E, Bs) -> if E =:= any -> {false, Bs}; true -> - case is_data(E) of - true -> + case type(E) of + literal -> + case is_bitstring(concrete(E)) of + false -> + none; + true -> + {false, Bs} + end; + cons -> + none; + tuple -> none; - false -> + _ -> {false, Bs} end end; diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 191efa3032..2e7554c1ff 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Core Erlang inliner. @@ -65,7 +65,6 @@ try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1, type/1, values_es/1, var_name/1]). --import(erlang, [max/2]). -import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]). %% @@ -201,9 +200,9 @@ start(Reply, Tree, Ctxt, Opts) -> false -> ok end, - Size = max(1, proplists:get_value(inline_size, Opts)), - Effort = max(1, proplists:get_value(inline_effort, Opts)), - Unroll = max(1, proplists:get_value(inline_unroll, Opts)), + Size = erlang:max(1, proplists:get_value(inline_size, Opts)), + Effort = erlang:max(1, proplists:get_value(inline_effort, Opts)), + Unroll = erlang:max(1, proplists:get_value(inline_unroll, Opts)), case proplists:get_bool(verbose, Opts) of true -> io:fwrite("Inlining: inline_size=~w inline_effort=~w\n", @@ -1263,8 +1262,9 @@ i_receive_1(E, Cs, T, B, S) -> i_module(E, Ctxt, Ren, Env, S) -> %% Cf. `i_letrec'. Note that we pass a dummy constant value for the %% "body" parameter. + Exps = i_module_exports(E), {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(), - module_exports(E), Ctxt, Ren, Env, S), + Exps, Ctxt, Ren, Env, S), %% Sanity check: case Es of [] -> @@ -1277,6 +1277,27 @@ i_module(E, Ctxt, Ren, Env, S) -> E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es), {E1, count_size(weight(module), S1)}. +i_module_exports(E) -> + %% If a function is named in an `on_load' attribute, we will + %% pretend that it is exported to ensure that it will not be removed. + Exps = module_exports(E), + Attrs = module_attrs(E), + case i_module_on_load(Attrs) of + none -> + Exps; + [{_,_}=FA] -> + ordsets:add_element(c_var(FA), Exps) + end. + +i_module_on_load([{Key,Val}|T]) -> + case concrete(Key) of + on_load -> + concrete(Val); + _ -> + i_module_on_load(T) + end; +i_module_on_load([]) -> none. + %% Binary-syntax expressions are too complicated to do anything %% interesting with here - that is beyond the scope of this program; %% also, their construction could have side effects, so even in effect @@ -1429,17 +1450,26 @@ inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) -> {E, S}; true -> %% Create local bindings for the parameters to their - %% respective operand structures from the app-structure, and - %% visit the body in the context saved in the structure. + %% respective operand structures from the app-structure. {Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S), - {E1, S2} = i(fun_body(E), Ctxt, Ren1, Env1, S1), + + %% function_clause exceptions that have been inlined + %% into another function (or even into the same function) + %% will not work properly. The v3_kernel pass will + %% take care of it, but we will need to help it by + %% removing any function_name annotations on match_fail + %% primops that we inline. + E1 = kill_function_name_anns(fun_body(E)), + + %% Visit the body in the context saved in the structure. + {E2, S2} = i(E1, Ctxt, Ren1, Env1, S1), %% Create necessary bindings and/or set flags. - {E2, S3} = make_let_bindings(Rs, E1, S2), + {E3, S3} = make_let_bindings(Rs, E2, S2), %% Lastly, flag the application as inlined, since the inlining %% attempt was not aborted before we reached this point. - {E2, st__set_app_inlined(L, S3)} + {E3, st__set_app_inlined(L, S3)} end. %% For the (possibly renamed) argument variables to an inlined call, @@ -2370,6 +2400,19 @@ kill_id_anns([A | As]) -> kill_id_anns([]) -> []. +kill_function_name_anns(Body) -> + F = fun(P) -> + case type(P) of + primop -> + Ann = get_ann(P), + Ann1 = lists:keydelete(function_name, 1, Ann), + set_ann(P, Ann1); + _ -> + P + end + end, + cerl_trees:map(F, Body). + %% ===================================================================== %% General utilities diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 7a2057713e..1e3755025f 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @doc Basic functions on Core Erlang abstract syntax trees. @@ -73,14 +73,12 @@ depth(T) -> [] -> 0; Gs -> - 1 + lists:foldl(fun (G, A) -> max(depth_1(G), A) end, 0, Gs) + 1 + lists:foldl(fun (G, A) -> erlang:max(depth_1(G), A) end, 0, Gs) end. depth_1(Ts) -> - lists:foldl(fun (T, A) -> max(depth(T), A) end, 0, Ts). + lists:foldl(fun (T, A) -> erlang:max(depth(T), A) end, 0, Ts). -max(X, Y) when X > Y -> X; -max(_, Y) -> Y. %% @spec size(Tree::cerl()) -> integer() diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index b853800d73..fbaacc08da 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -29,6 +29,8 @@ %% Erlc interface. -export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]). +-export_type([option/0]). + -include("erl_compile.hrl"). -include("core_parse.hrl"). @@ -39,8 +41,7 @@ -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. --type line() :: integer(). --type err_info() :: {line(), module(), term()}. %% ErrorDescriptor +-type err_info() :: erl_scan:error_info(). %% ErrorDescriptor -type errors() :: [{file:filename(), [err_info()]}]. -type warnings() :: [{file:filename(), [err_info()]}]. -type mod_ret() :: {'ok', module()} @@ -68,7 +69,7 @@ file(File) -> file(File, ?DEFAULT_OPTIONS). --spec file(module() | file:filename(), [option()]) -> comp_ret(). +-spec file(module() | file:filename(), [option()] | option()) -> comp_ret(). file(File, Opts) when is_list(Opts) -> do_compile({file,File}, Opts++env_default_opts()); @@ -86,6 +87,8 @@ forms(Forms, Opt) when is_atom(Opt) -> %% would have generated a Beam file, false otherwise (if only a binary or a %% listing file would have been generated). +-spec output_generated([option()]) -> boolean(). + output_generated(Opts) -> noenv_output_generated(Opts++env_default_opts()). @@ -94,6 +97,8 @@ output_generated(Opts) -> %% for default options. %% +-spec noenv_file(module() | file:filename(), [option()] | option()) -> comp_ret(). + noenv_file(File, Opts) when is_list(Opts) -> do_compile({file,File}, Opts); noenv_file(File, Opt) -> @@ -104,16 +109,20 @@ noenv_forms(Forms, Opts) when is_list(Opts) -> noenv_forms(Forms, Opt) when is_atom(Opt) -> noenv_forms(Forms, [Opt|?DEFAULT_OPTIONS]). +-spec noenv_output_generated([option()]) -> boolean(). + noenv_output_generated(Opts) -> - any(fun ({save_binary,_F}) -> true; + {_,Passes} = passes(file, expand_opts(Opts)), + any(fun ({save_binary,_T,_F}) -> true; (_Other) -> false - end, passes(file, expand_opts(Opts))). + end, Passes). %% %% Local functions %% -define(pass(P), {P,fun P/1}). +-define(pass(P,T), {P,fun T/1,fun P/1}). env_default_opts() -> Key = "ERL_COMPILER_OPTIONS", @@ -137,10 +146,17 @@ env_default_opts() -> do_compile(Input, Opts0) -> Opts = expand_opts(Opts0), - Self = self(), - Serv = spawn_link(fun() -> internal(Self, Input, Opts) end), + {Pid,Ref} = + spawn_monitor(fun() -> + exit(try + internal(Input, Opts) + catch + error:Reason -> + {error,Reason} + end) + end), receive - {Serv,Rep} -> Rep + {'DOWN',Ref,process,Pid,Rep} -> Rep end. expand_opts(Opts0) -> @@ -162,13 +178,14 @@ expand_opt(report, Os) -> [report_errors,report_warnings|Os]; expand_opt(return, Os) -> [return_errors,return_warnings|Os]; -expand_opt(r11, Os) -> - [no_stack_trimming,no_binaries,no_constant_pool|Os]; +expand_opt(r12, Os) -> + [no_recv_opt,no_line_info|Os]; +expand_opt(r13, Os) -> + [no_recv_opt,no_line_info|Os]; +expand_opt(r14, Os) -> + [no_line_info|Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; -expand_opt(no_binaries=O, Os) -> - %%Turn off the entire type optimization pass. - [no_topt,O|Os]; expand_opt(no_float_opt, Os) -> %%Turn off the entire type optimization pass. [no_topt|Os]; @@ -199,6 +216,9 @@ format_error(write_error) -> format_error({rename,From,To,Error}) -> io_lib:format("failed to rename ~s to ~s: ~s", [From,To,file:format_error(Error)]); +format_error({delete,File,Error}) -> + io_lib:format("failed to delete file ~s: ~s", + [File,file:format_error(Error)]); format_error({delete_temp,File,Error}) -> io_lib:format("failed to delete temporary file ~s: ~s", [File,file:format_error(Error)]); @@ -215,45 +235,30 @@ format_error({module_name,Mod,Filename}) -> [Mod,Filename]). %% The compile state record. --record(compile, {filename="", - dir="", - base="", - ifile="", - ofile="", +-record(compile, {filename="" :: file:filename(), + dir="" :: file:filename(), + base="" :: file:filename(), + ifile="" :: file:filename(), + ofile="" :: file:filename(), module=[], code=[], core_code=[], abstract_code=[], %Abstract code for debugger. - options=[], + options=[] :: [option()], %Options for compilation + mod_options=[] :: [option()], %Options for module_info errors=[], warnings=[]}). -internal(Master, Input, Opts) -> - Master ! {self(), try internal(Input, Opts) - catch error:Reason -> {error, Reason} - end}. - -internal({forms,Forms}, Opts) -> - Ps = passes(forms, Opts), - internal_comp(Ps, "", "", #compile{code=Forms,options=Opts}); +internal({forms,Forms}, Opts0) -> + {_,Ps} = passes(forms, Opts0), + Source = proplists:get_value(source, Opts0, ""), + Opts1 = proplists:delete(source, Opts0), + Compile = #compile{code=Forms,options=Opts1,mod_options=Opts1}, + internal_comp(Ps, Source, "", Compile); internal({file,File}, Opts) -> - Ps = passes(file, Opts), - Compile = #compile{options=Opts}, - case member(from_core, Opts) of - true -> internal_comp(Ps, File, ".core", Compile); - false -> - case member(from_beam, Opts) of - true -> - internal_comp(Ps, File, ".beam", Compile); - false -> - case member(from_asm, Opts) orelse member(asm, Opts) of - true -> - internal_comp(Ps, File, ".S", Compile); - false -> - internal_comp(Ps, File, ".erl", Compile) - end - end - end. + {Ext,Ps} = passes(file, Opts), + Compile = #compile{options=Opts,mod_options=Opts}, + internal_comp(Ps, File, Ext, Compile). internal_comp(Passes, File, Suffix, St0) -> Dir = filename:dirname(File), @@ -295,15 +300,6 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> end; fold_comp([], _Run, St) -> {ok,St}. -os_process_size() -> - case os:type() of - {unix, sunos} -> - Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"), - list_to_integer(lib:nonl(Size)); - _ -> - 0 - end. - run_tc({Name,Fun}, St) -> Before0 = statistics(runtime), Val = (catch Fun(St)), @@ -312,13 +308,12 @@ run_tc({Name,Fun}, St) -> {After_c, _} = After0, Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), - Sz = lists:flatten(io_lib:format("~.1f MB", [os_process_size()/1024])), - io:format(" ~-30s: ~10.2f s ~12s ~10s\n", - [Name,(After_c-Before_c) / 1000,Mem,Sz]), + io:format(" ~-30s: ~10.2f s ~12s\n", + [Name,(After_c-Before_c) / 1000,Mem]), Val. comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> - case member(warnings_as_errors, Opts) andalso length(Warn0) > 0 of + case werror(St) of true -> case member(report_warnings, Opts) of true -> @@ -353,6 +348,11 @@ comp_ret_err(#compile{warnings=Warn0,errors=Err0,options=Opts}=St) -> false -> error end. +not_werror(St) -> not werror(St). + +werror(#compile{options=Opts,warnings=Ws}) -> + Ws =/= [] andalso member(warnings_as_errors, Opts). + %% messages_per_file([{File,[Message]}]) -> [{File,[Message]}] messages_per_file(Ms) -> T = lists:sort([{File,M} || {File,Messages} <- Ms, M <- Messages]), @@ -363,7 +363,17 @@ messages_per_file(Ms) -> (_) -> false end, A) end, T, PrioMs), - Prio = lists:sort(fun({_,{L1,_,_}}, {_,{L2,_,_}}) -> L1 =< L2 end, + Prio = lists:sort(fun({_,{As1,_,_}}, {_,{As2,_,_}}) -> + {location, Loc1} = + erl_scan:attributes_info(As1, location), + {location, Loc2} = + erl_scan:attributes_info(As2, location), + case {Loc1, Loc2} of + {{L1, _}, L2} when is_integer(L2) -> L1 < L2; + {L1, {L2, _}} when is_integer(L1) -> L1 =< L2; + {_, _} -> Loc1 =< Loc2 + end + end, lists:append(Prio0)), flatmap(fun mpf/1, [Prio, Rest]). @@ -371,42 +381,52 @@ mpf(Ms) -> [{File,[M || {F,M} <- Ms, F =:= File]} || File <- lists:usort([F || {F,_} <- Ms])]. -%% passes(form|file, [Option]) -> [{Name,PassFun}] -%% Figure out which passes that need to be run. - -passes(forms, Opts) -> - case member(from_core, Opts) of - true -> - select_passes(core_passes(), Opts); - false -> - select_passes(standard_passes(), Opts) +%% passes(forms|file, [Option]) -> {Extension,[{Name,PassFun}]} +%% Figure out the extension of the input file and which passes +%% that need to be run. + +passes(Type, Opts) -> + {Ext,Passes0} = passes_1(Opts), + Passes1 = case Type of + file -> Passes0; + forms -> tl(Passes0) + end, + Passes = select_passes(Passes1, Opts), + + %% If the last pass saves the resulting binary to a file, + %% insert a first pass to remove the file (unless the + %% source file is a BEAM file). + {Ext,case last(Passes) of + {save_binary,_TestFun,_Fun} -> + case Passes of + [{read_beam_file,_}|_] -> + %% The BEAM is both input and output. + %% Don't remove it. + Passes; + _ -> + [?pass(remove_file)|Passes] + end; + _ -> + Passes + end}. + +passes_1([Opt|Opts]) -> + case pass(Opt) of + {_,_}=Res -> Res; + none -> passes_1(Opts) end; -passes(file, Opts) -> - case member(from_beam, Opts) of - true -> - Ps = [?pass(read_beam_file)|binary_passes()], - select_passes(Ps, Opts); - false -> - Ps = case member(from_asm, Opts) orelse member(asm, Opts) of - true -> - [?pass(beam_consult_asm)|asm_passes()]; - false -> - case member(from_core, Opts) of - true -> - [?pass(parse_core)|core_passes()]; - false -> - [?pass(parse_module)|standard_passes()] - end - end, - Fs = select_passes(Ps, Opts), - - %% If the last pass saves the resulting binary to a file, - %% insert a first pass to remove the file. - case last(Fs) of - {save_binary,_Fun} -> [?pass(remove_file)|Fs]; - _Other -> Fs - end - end. +passes_1([]) -> + {".erl",[?pass(parse_module)|standard_passes()]}. + +pass(from_core) -> + {".core",[?pass(parse_core)|core_passes()]}; +pass(from_asm) -> + {".S",[?pass(beam_consult_asm)|asm_passes()]}; +pass(asm) -> + pass(from_asm); +pass(from_beam) -> + {".beam",[?pass(read_beam_file)|binary_passes()]}; +pass(_) -> none. %% select_passes([Command], Opts) -> [{Name,Function}] %% Interpret the lists of commands to return a pure list of passes. @@ -439,6 +459,8 @@ passes(file, Opts) -> %% file will be Ext. (Ext should not contain %% a period.) No more passes will be run. %% +%% done End compilation at this point. +%% %% {done,Ext} End compilation at this point. Produce a listing %% as with {listing,Ext}, unless 'binary' is %% specified, in which case the current @@ -472,6 +494,8 @@ select_passes([{src_listing,Ext}|_], _Opts) -> [{listing,fun (St) -> src_listing(Ext, St) end}]; select_passes([{listing,Ext}|_], _Opts) -> [{listing,fun (St) -> listing(Ext, St) end}]; +select_passes([done|_], _Opts) -> + []; select_passes([{done,Ext}|_], Opts) -> select_passes([{unless,binary,{listing,Ext}}], Opts); select_passes([{iff,Flag,Pass}|Ps], Opts) -> @@ -554,6 +578,13 @@ select_list_passes_1([], _, Acc) -> standard_passes() -> [?pass(transform_module), + + {iff,makedep,[ + ?pass(makedep), + {unless,binary,?pass(makedep_output)} + ]}, + {iff,makedep,done}, + {iff,'dpp',{listing,"pp"}}, ?pass(lint_module), {iff,'P',{src_listing,"P"}}, @@ -590,7 +621,7 @@ core_passes() -> kernel_passes() -> %% Destructive setelement/3 optimization and core lint. - [{unless,no_constant_pool,?pass(core_dsetel_module)}, %Not safe without constant pool. + [?pass(core_dsetel_module), {iff,dsetel,{listing,"dsetel"}}, {iff,clint,?pass(core_lint_module)}, @@ -612,11 +643,15 @@ asm_passes() -> [{unless,no_postopt, [{pass,beam_block}, {iff,dblk,{listing,"block"}}, + {unless,no_except,{pass,beam_except}}, + {iff,dexcept,{listing,"except"}}, {unless,no_bopt,{pass,beam_bool}}, {iff,dbool,{listing,"bool"}}, {unless,no_topt,{pass,beam_type}}, {iff,dtype,{listing,"type"}}, - {pass,beam_dead}, %Must always run since it splits blocks. + {pass,beam_split}, + {iff,dsplit,{listing,"split"}}, + {unless,no_dead,{pass,beam_dead}}, {iff,ddead,{listing,"dead"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, @@ -626,6 +661,8 @@ asm_passes() -> {iff,dclean,{listing,"clean"}}, {unless,no_bsm_opt,{pass,beam_bsm}}, {iff,dbsm,{listing,"bsm"}}, + {unless,no_recv_opt,{pass,beam_receive}}, + {iff,drecv,{listing,"recv"}}, {unless,no_stack_trimming,{pass,beam_trim}}, {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, @@ -646,7 +683,7 @@ asm_passes() -> binary_passes() -> [{native_compile,fun test_native/1,fun native_compile/1}, - {unless,binary,?pass(save_binary)}]. + {unless,binary,?pass(save_binary,not_werror)}]. %%% %%% Compiler passes. @@ -746,7 +783,8 @@ parse_module(St) -> Opts = St#compile.options, Cwd = ".", IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)], - R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)), + AtPos = initial_position(Opts), + R = epp:parse_file(St#compile.ifile, AtPos, IncludePath, pre_defs(Opts)), case R of {ok,Forms} -> {ok,St#compile{code=Forms}}; @@ -826,6 +864,10 @@ foldl_transform(St, [T|Ts]) -> {'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; @@ -835,7 +877,6 @@ get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts]. core_transforms(St) -> %% The options field holds the complete list of options at this - Ts = get_core_transforms(St#compile.options), foldl_core_transforms(St, Ts). @@ -900,6 +941,184 @@ core_lint_module(St) -> errors=St#compile.errors ++ Es}} end. +makedep(#compile{code=Code,options=Opts}=St) -> + Ifile = St#compile.ifile, + Ofile = St#compile.ofile, + + %% Get the target of the Makefile rule. + Target0 = + case proplists:get_value(makedep_target, Opts) of + undefined -> + %% The target is derived from the output filename: possibly + %% remove the current working directory to obtain a relative + %% path. + shorten_filename(Ofile); + T -> + %% The caller specified one. + T + end, + + %% Quote the target is the called asked for this. + Target1 = case proplists:get_value(makedep_quote_target, Opts) of + true -> + %% For now, only "$" is replaced by "$$". + Fun = fun + ($$) -> "$$"; + (C) -> C + end, + map(Fun, Target0); + _ -> + Target0 + end, + Target = Target1 ++ ":", + + %% List the dependencies (includes) for this target. + {MainRule,PhonyRules} = makedep_add_headers( + Ifile, % The input file name. + Code, % The parsed source. + [], % The list of dependencies already added. + length(Target), % The current line length. + Target, % The target. + "", % Phony targets. + Opts), + + %% Prepare the content of the Makefile. For instance: + %% hello.erl: hello.hrl common.hrl + %% + %% Or if phony targets are enabled: + %% hello.erl: hello.hrl common.hrl + %% + %% hello.hrl: + %% + %% common.hrl: + Makefile = case proplists:get_value(makedep_phony, Opts) of + true -> MainRule ++ PhonyRules; + _ -> MainRule + end, + {ok,St#compile{code=iolist_to_binary([Makefile,"\n"])}}. + +makedep_add_headers(Ifile, [{attribute,_,file,{File,_}}|Rest], + Included, LineLen, MainTarget, Phony, Opts) -> + %% The header "File" exists, add it to the dependencies. + {Included1,LineLen1,MainTarget1,Phony1} = + makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File), + makedep_add_headers(Ifile, Rest, Included1, LineLen1, + MainTarget1, Phony1, Opts); +makedep_add_headers(Ifile, [{error,{_,epp,{include,file,File}}}|Rest], + Included, LineLen, MainTarget, Phony, Opts) -> + %% The header "File" doesn't exist, do we add it to the dependencies? + case proplists:get_value(makedep_add_missing, Opts) of + true -> + {Included1,LineLen1,MainTarget1,Phony1} = + makedep_add_header(Ifile, Included, LineLen, MainTarget, + Phony, File), + makedep_add_headers(Ifile, Rest, Included1, LineLen1, + MainTarget1, Phony1, Opts); + _ -> + makedep_add_headers(Ifile, Rest, Included, LineLen, + MainTarget, Phony, Opts) + end; +makedep_add_headers(Ifile, [_|Rest], Included, LineLen, + MainTarget, Phony, Opts) -> + makedep_add_headers(Ifile, Rest, Included, + LineLen, MainTarget, Phony, Opts); +makedep_add_headers(_Ifile, [], _Included, _LineLen, + MainTarget, Phony, _Opts) -> + {MainTarget,Phony}. + +makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File) -> + case member(File, Included) of + true -> + %% This file was already listed in the dependencies, skip it. + {Included,LineLen,MainTarget,Phony}; + false -> + Included1 = [File|Included], + + %% Remove "./" in front of the dependency filename. + File1 = case File of + "./" ++ File0 -> File0; + _ -> File + end, + + %% Prepare the phony target name. + Phony1 = case File of + Ifile -> Phony; + _ -> Phony ++ "\n\n" ++ File1 ++ ":" + end, + + %% Add the file to the dependencies. Lines longer than 76 columns + %% are splitted. + if + LineLen + 1 + length(File1) > 76 -> + LineLen1 = 2 + length(File1), + MainTarget1 = MainTarget ++ " \\\n " ++ File1, + {Included1,LineLen1,MainTarget1,Phony1}; + true -> + LineLen1 = LineLen + 1 + length(File1), + MainTarget1 = MainTarget ++ " " ++ File1, + {Included1,LineLen1,MainTarget1,Phony1} + end + end. + +makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) -> + %% Write this Makefile (Code) to the selected output. + %% If no output is specified, the default is to write to a file named after + %% the output file. + Output0 = case proplists:get_value(makedep_output, Opts) of + undefined -> + %% Prepare the default filename. + outfile(filename:basename(Ofile, ".beam"), "Pbeam", Opts); + O -> + O + end, + + %% If the caller specified an io_device(), there's nothing to do. If he + %% specified a filename, we must create it. Furthermore, this created file + %% must be closed before returning. + Ret = case Output0 of + _ when is_list(Output0) -> + case file:delete(Output0) of + Ret2 when Ret2 =:= ok; Ret2 =:= {error,enoent} -> + case file:open(Output0, [write]) of + {ok,IODev} -> + {ok,IODev,true}; + {error,Reason2} -> + {error,open,Reason2} + end; + {error,Reason1} -> + {error,delete,Reason1} + end; + _ -> + {ok,Output0,false} + end, + + case Ret of + {ok,Output1,CloseOutput} -> + try + %% Write the Makefile. + io:fwrite(Output1, "~s", [Code]), + %% Close the file if relevant. + if + CloseOutput -> file:close(Output1); + true -> ok + end, + {ok,St} + catch + exit:_ -> + %% Couldn't write to output Makefile. + Err = {St#compile.ifile,[{none,?MODULE,write_error}]}, + {error,St#compile{errors=St#compile.errors++[Err]}} + end; + {error,open,Reason} -> + %% Couldn't open output Makefile. + Err = {St#compile.ifile,[{none,?MODULE,{open,Reason}}]}, + {error,St#compile{errors=St#compile.errors++[Err]}}; + {error,delete,Reason} -> + %% Couldn't open output Makefile. + Err = {St#compile.ifile,[{none,?MODULE,{delete,Output0,Reason}}]}, + {error,St#compile{errors=St#compile.errors++[Err]}} + end. + %% expand_module(State) -> State' %% Do the common preprocessing of the input forms. @@ -909,13 +1128,8 @@ expand_module(#compile{code=Code,options=Opts0}=St0) -> {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}. core_module(#compile{code=Code0,options=Opts}=St) -> - case v3_core:module(Code0, Opts) of - {ok,Code,Ws} -> - {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}; - {error,Es,Ws} -> - {error,St#compile{warnings=St#compile.warnings ++ Ws, - errors=St#compile.errors ++ Es}} - end. + {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), @@ -1037,12 +1251,13 @@ beam_unused_labels(#compile{code=Code0}=St) -> Code = beam_jump:module_labels(Code0), {ok,St#compile{code=Code}}. -beam_asm(#compile{ifile=File,code=Code0,abstract_code=Abst,options=Opts0}=St) -> +beam_asm(#compile{ifile=File,code=Code0, + abstract_code=Abst,mod_options=Opts0}=St) -> Source = filename:absname(File), Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'}; (Other) -> Other end, Opts0), - Opts2 = [O || O <- Opts1, is_informative_option(O)], + Opts2 = [O || O <- Opts1, effects_code_generation(O)], case beam_asm:module(Code0, Abst, Source, Opts2) of {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}} end. @@ -1112,15 +1327,23 @@ embed_native_code(St, {Architecture,NativeCode}) -> {ok, BeamPlusNative} = beam_lib:build_module(Chunks), St#compile{code=BeamPlusNative}. -%% Returns true if the option is informative and therefore should be included -%% in the option list of the compiled module. - -is_informative_option(beam) -> false; -is_informative_option(report_warnings) -> false; -is_informative_option(report_errors) -> false; -is_informative_option(binary) -> false; -is_informative_option(verbose) -> false; -is_informative_option(_) -> true. +%% effects_code_generation(Option) -> true|false. +%% Determine whether the option could have any effect on the +%% generated code in the BEAM file (as opposed to how +%% errors will be reported). + +effects_code_generation(Option) -> + case Option of + beam -> false; + report_warnings -> false; + report_errors -> false; + return_errors-> false; + return_warnings-> false; + binary -> false; + verbose -> false; + {cwd,_} -> false; + _ -> true + end. save_binary(#compile{code=none}=St) -> {ok,St}; save_binary(#compile{module=Mod,ofile=Outfile, @@ -1184,38 +1407,44 @@ write_binary(Name, Bin, St) -> %% report_errors(State) -> ok %% report_warnings(State) -> ok -report_errors(St) -> - case member(report_errors, St#compile.options) of +report_errors(#compile{options=Opts,errors=Errors}) -> + case member(report_errors, Opts) of true -> foreach(fun ({{F,_L},Eds}) -> list_errors(F, Eds); ({F,Eds}) -> list_errors(F, Eds) end, - St#compile.errors); + Errors); false -> ok end. report_warnings(#compile{options=Opts,warnings=Ws0}) -> - case member(report_warnings, Opts) of + Werror = member(warnings_as_errors, Opts), + P = case Werror of + true -> ""; + false -> "Warning: " + end, + ReportWerror = Werror andalso member(report_errors, Opts), + case member(report_warnings, Opts) orelse ReportWerror of true -> - Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, Eds); - ({F,Eds}) -> format_message(F, Eds) end, + Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, P, Eds); + ({F,Eds}) -> format_message(F, P, Eds) end, Ws0), Ws = lists:sort(Ws1), foreach(fun({_,Str}) -> io:put_chars(Str) end, Ws); false -> ok end. -format_message(F, [{{Line,Column}=Loc,Mod,E}|Es]) -> - M = {{F,Loc},io_lib:format("~s:~w:~w Warning: ~s\n", - [F,Line,Column,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(F, [{Line,Mod,E}|Es]) -> - M = {{F,{Line,0}},io_lib:format("~s:~w: Warning: ~s\n", - [F,Line,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(F, [{Mod,E}|Es]) -> - M = {none,io_lib:format("~s: Warning: ~s\n", [F,Mod:format_error(E)])}, - [M|format_message(F, Es)]; -format_message(_, []) -> []. +format_message(F, P, [{{Line,Column}=Loc,Mod,E}|Es]) -> + M = {{F,Loc},io_lib:format("~s:~w:~w: ~s~s\n", + [F,Line,Column,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; +format_message(F, P, [{Line,Mod,E}|Es]) -> + M = {{F,{Line,0}},io_lib:format("~s:~w: ~s~s\n", + [F,Line,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; +format_message(F, P, [{Mod,E}|Es]) -> + M = {none,io_lib:format("~s: ~s~s\n", [F,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; +format_message(_, _, []) -> []. %% list_errors(File, ErrorDescriptors) -> ok @@ -1241,6 +1470,8 @@ iofile(File) when is_atom(File) -> iofile(File) -> {filename:dirname(File), filename:basename(File, ".erl")}. +erlfile(".", Base, Suffix) -> + Base ++ Suffix; erlfile(Dir, Base, Suffix) -> filename:join(Dir, Base ++ Suffix). @@ -1259,6 +1490,12 @@ objfile(Base, St) -> tmpfile(Ofile) -> reverse([$#|tl(reverse(Ofile))]). +initial_position(Opts) -> + case lists:member(column, Opts) of + true -> {1, 1}; + false -> 1 + end. + %% pre_defs(Options) %% inc_paths(Options) %% Extract the predefined macros and include paths from the option list. @@ -1313,6 +1550,8 @@ restore_expand_module([{attribute,Line,opaque,[Type]}|Fs]) -> [{attribute,Line,opaque,Type}|restore_expand_module(Fs)]; restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) -> [{attribute,Line,spec,Arg}|restore_expand_module(Fs)]; +restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) -> + [{attribute,Line,callback,Arg}|restore_expand_module(Fs)]; restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index b0311365c4..1133882728 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -1,19 +1,19 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% {application, compiler, @@ -28,11 +28,14 @@ beam_dead, beam_dict, beam_disasm, + beam_except, beam_flatten, beam_jump, beam_listing, beam_opcodes, beam_peep, + beam_receive, + beam_split, beam_trim, beam_type, beam_utils, diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index b633f568c9..b513a8965c 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2010. 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 @@ -65,7 +65,8 @@ | {'return_mismatch', fa()} | {'undefined_function', fa()} | {'duplicate_var', cerl:var_name(), fa()} | {'unbound_var', cerl:var_name(), fa()} - | {'undefined_function', fa(), fa()}. + | {'undefined_function', fa(), fa()} + | {'tail_segment_not_at_end', fa()}. -type error() :: {module(), err_desc()}. -type warning() :: {module(), term()}. @@ -116,7 +117,9 @@ format_error({duplicate_var,N,{F,A}}) -> format_error({unbound_var,N,{F,A}}) -> io_lib:format("unbound variable ~s in ~w/~w", [N,F,A]); format_error({undefined_function,{F1,A1},{F2,A2}}) -> - io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]). + io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]); +format_error({tail_segment_not_at_end,{F,A}}) -> + io_lib:format("binary tail segment not at end in ~w/~w", [F,A]). -type ret() :: {'ok', [{module(), [warning(),...]}]} | {'error', [{module(), [error(),...]}], @@ -450,7 +453,8 @@ pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) -> pattern_list([H,T], Def, Ps, St); pattern(#c_tuple{es=Es}, Def, Ps, St) -> pattern_list(Es, Def, Ps, St); -pattern(#c_binary{segments=Ss}, Def, Ps, St) -> +pattern(#c_binary{segments=Ss}, Def, Ps, St0) -> + St = pat_bin_tail_check(Ss, St0), pat_bin(Ss, Def, Ps, St); pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) -> {Vvs,St1} = variable(V, Ps, St0), @@ -482,6 +486,19 @@ pat_segment(#c_bitstr{val=V,size=S,type=T}, Def0, Ps0, St0) -> pat_segment(_, Def, Ps, St) -> {Ps,Def,add_error({not_bs_pattern,St#lint.func}, St)}. +%% pat_bin_tail_check([Elem], State) -> State. +%% There must be at most one tail segment (a size-less segment of +%% type binary) and it must occur at the end. + +pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}], St) -> + %% Size-less field is OK at the end of the list of segments. + St; +pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}|_], St) -> + add_error({tail_segment_not_at_end,St#lint.func}, St); +pat_bin_tail_check([_|Ss], St) -> + pat_bin_tail_check(Ss, St); +pat_bin_tail_check([], St) -> St. + %% pat_bit_expr(SizePat, Type, Defined, State) -> State. %% Check the Size pattern, this is an input! Because of optimizations, %% we must allow any kind of constant and literal here. diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index e87bb276de..9ad2378d00 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose: Information about the Erlang built-in functions. @@ -65,12 +65,13 @@ is_pure(erlang, 'xor', 2) -> true; is_pure(erlang, abs, 1) -> true; is_pure(erlang, atom_to_binary, 2) -> true; is_pure(erlang, atom_to_list, 1) -> true; +is_pure(erlang, binary_part, 2) -> true; +is_pure(erlang, binary_part, 3) -> true; is_pure(erlang, binary_to_atom, 2) -> true; is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; is_pure(erlang, byte_size, 1) -> true; -is_pure(erlang, concat_binary, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; @@ -135,6 +136,7 @@ is_pure(math, sinh, 1) -> true; is_pure(math, sqrt, 1) -> true; is_pure(math, tan, 1) -> true; is_pure(math, tanh, 1) -> true; +is_pure(math, pi, 0) -> true; is_pure(_, _, _) -> false. diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 6874054495..75ac91907a 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1998-2011. All Rights Reserved. +# # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in # compliance with the License. You should have received a copy of the # Erlang Public License along with this software. If not, it can be # retrieved online at http://www.erlang.org/. -# +# # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See # the License for the specific language governing rights and limitations # under the License. -# +# # %CopyrightEnd% # BEAM_FORMAT_NUMBER=0 @@ -132,7 +132,7 @@ BEAM_FORMAT_NUMBER=0 # # Building terms. # -68: put_string/3 +68: -put_string/3 69: put_list/3 70: put_tuple/2 71: put/1 @@ -208,7 +208,7 @@ BEAM_FORMAT_NUMBER=0 # New instructions in R10B. 109: bs_init2/6 -110: bs_bits_to_bytes/3 +110: -bs_bits_to_bytes/3 111: bs_add/5 112: apply/1 113: apply_last/2 @@ -274,3 +274,13 @@ BEAM_FORMAT_NUMBER=0 # R13B03 149: on_load/0 + +# R14A + +150: recv_mark/1 +151: recv_set/1 +152: gc_bif3/7 + +# R15A + +153: line/1 diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 9b73e08ad8..31a1f8b0b7 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% @author Richard Carlsson <[email protected]> @@ -32,7 +32,7 @@ get/2, is_defined/2, is_empty/1, keys/1, lookup/2, new_key/1, new_key/2, new_keys/2, new_keys/3, size/1, to_list/1]). --import(erlang, [max/2]). +-export_type([environment/0]). -ifdef(DEBUG). -export([test/1, test_custom/1, test_custom/2]). @@ -586,7 +586,7 @@ new_key(N, R, _T, F, Env) -> new_key(generate(N, R1), R1, 0, F, Env). start_range(Env) -> - max(env_size(Env) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE). + erlang:max(env_size(Env) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE). %% The previous key might or might not be used to compute the next key %% to be tried. It is currently not used. diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index c38eab7b42..f6696992b9 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Using dsetelement to make multiple-field record updates @@ -57,8 +57,6 @@ %% if X1 is used exactly once. %% Thus, we need to track variable usage. %% -%% NOTE: This pass must NOT be used if the no_constant_pool option is used. -%% -module(sys_core_dsetel). diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 068478496b..18fba7962b 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Constant folding optimisation for Core @@ -150,14 +150,26 @@ guard(Expr, Sub) -> opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) -> Body = opt_guard_try(Body0), case {Arg,Body} of - {#c_call{},#c_literal{val=false}} -> - %% We have sequence consisting of a call (evaluted - %% for a possible exception only), followed by 'false'. - %% Since the sequence is inside a try block that will + {#c_call{module=#c_literal{val=Mod}, + name=#c_literal{val=Name}, + args=Args},#c_literal{val=false}} -> + %% We have sequence consisting of a call (evaluated + %% for a possible exception and/or side effect only), + %% followed by 'false'. + %% Since the sequence is inside a try block that will %% default to 'false' if any exception occurs, not %% evalutating the call will not change the behaviour - %% of the guard. - Body; + %% provided that the call has no side effects. + case erl_bifs:is_pure(Mod, Name, length(Args)) of + false -> + %% Not a pure BIF (meaning that this is not + %% a guard and that we must keep the call). + Seq#c_seq{body=Body}; + true -> + %% The BIF has no side effects, so it can + %% be safely removed. + Body + end; {_,_} -> Seq#c_seq{body=Body} end; @@ -460,7 +472,8 @@ eval_binary(#c_binary{anno=Anno,segments=Ss}=Bin) -> Bin; throw:{badarg,Warning} -> add_warning(Bin, Warning), - #c_call{module=#c_literal{val=erlang}, + #c_call{anno=Anno, + module=#c_literal{val=erlang}, name=#c_literal{val=error}, args=[#c_literal{val=badarg}]} end. @@ -602,15 +615,23 @@ count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). %% a rewritten expression consisting of a sequence of %% the arguments only is returned. -useless_call(effect, #c_call{module=#c_literal{val=Mod}, +useless_call(effect, #c_call{anno=Anno, + module=#c_literal{val=Mod}, name=#c_literal{val=Name}, args=Args}=Call) -> A = length(Args), case erl_bifs:is_safe(Mod, Name, A) of false -> case erl_bifs:is_pure(Mod, Name, A) of - true -> add_warning(Call, result_ignored); - false -> ok + true -> + case member(result_not_wanted, Anno) of + false -> + add_warning(Call, result_ignored); + true -> + ok + end; + false -> + ok end, no; true -> @@ -650,36 +671,34 @@ call_0(Call, M, N, As0, Sub) -> %% We inline some very common higher order list operations. %% We use the same evaluation order as the library function. -call_1(_Call, lists, all, [Arg1,Arg2], Sub) -> +call_1(#c_call{anno=Anno}, lists, all, [Arg1,Arg2], Sub) -> Loop = #c_var{name={'lists^all',1}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_apply{op=Loop, args=[Xs]}}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=#c_literal{val=false}}, CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err1]}}, + body=match_fail(Anno, Err1)}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_case{arg=#c_apply{op=F, args=[X]}, + body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=#c_literal{val=true}}, Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err2]}}, + body=match_fail(Anno, Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, Sub); -call_1(_Call, lists, any, [Arg1,Arg2], Sub) -> +call_1(#c_call{anno=Anno}, lists, any, [Arg1,Arg2], Sub) -> Loop = #c_var{name={'lists^any',1}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, @@ -688,72 +707,71 @@ call_1(_Call, lists, any, [Arg1,Arg2], Sub) -> CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, body=#c_literal{val=true}}, CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, - body=#c_apply{op=Loop, args=[Xs]}}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err1]}}, + body=match_fail(Anno, Err1)}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_case{arg=#c_apply{op=F, args=[X]}, + body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=#c_literal{val=false}}, Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err2]}}, + body=match_fail(Anno, Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, Sub); -call_1(_Call, lists, foreach, [Arg1,Arg2], Sub) -> +call_1(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2], Sub) -> Loop = #c_var{name={'lists^foreach',1}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_seq{arg=#c_apply{op=F, args=[X]}, - body=#c_apply{op=Loop, args=[Xs]}}}, + body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=#c_literal{val=ok}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, Sub); -call_1(_Call, lists, map, [Arg1,Arg2], Sub) -> +call_1(#c_call{anno=Anno}, lists, map, [Arg1,Arg2], Sub) -> Loop = #c_var{name={'lists^map',1}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, H = #c_var{name='H'}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_let{vars=[H], arg=#c_apply{op=F, args=[X]}, + body=#c_let{vars=[H], arg=#c_apply{anno=Anno, + op=F, + args=[X]}, body=#c_cons{hd=H, - tl=#c_apply{op=Loop, + tl=#c_apply{anno=Anno, + op=Loop, args=[Xs]}}}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=#c_literal{val=[]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, Sub); -call_1(_Call, lists, flatmap, [Arg1,Arg2], Sub) -> +call_1(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2], Sub) -> Loop = #c_var{name={'lists^flatmap',1}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, @@ -761,26 +779,27 @@ call_1(_Call, lists, flatmap, [Arg1,Arg2], Sub) -> H = #c_var{name='H'}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_let{vars=[H], - arg=#c_apply{op=F, args=[X]}, - body=#c_call{module=#c_literal{val=erlang}, + arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_call{anno=Anno, + module=#c_literal{val=erlang}, name=#c_literal{val='++'}, args=[H, - #c_apply{op=Loop, + #c_apply{anno=Anno, + op=Loop, args=[Xs]}]}}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=#c_literal{val=[]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, Sub); -call_1(_Call, lists, filter, [Arg1,Arg2], Sub) -> +call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) -> Loop = #c_var{name={'lists^filter',1}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, @@ -792,72 +811,75 @@ call_1(_Call, lists, filter, [Arg1,Arg2], Sub) -> CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=Xs}, CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err1]}}, + body=match_fail(Anno, Err1)}, Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_let{vars=[B], - arg=#c_apply{op=F, args=[X]}, + arg=#c_apply{anno=Anno, op=F, args=[X]}, body=#c_let{vars=[Xs], - arg=#c_apply{op=Loop, + arg=#c_apply{anno=Anno, + op=Loop, args=[Xs]}, body=Case}}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=#c_literal{val=[]}}, Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err2]}}, + body=match_fail(Anno, Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, Sub); -call_1(_Call, lists, foldl, [Arg1,Arg2,Arg3], Sub) -> +call_1(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3], Sub) -> Loop = #c_var{name={'lists^foldl',2}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, A = #c_var{name='A'}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_apply{op=Loop, - args=[Xs, #c_apply{op=F, args=[X, A]}]}}, + body=#c_apply{anno=Anno, + op=Loop, + args=[Xs, #c_apply{anno=Anno, + op=F, + args=[X, A]}]}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=A}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L, A]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}, Sub); -call_1(_Call, lists, foldr, [Arg1,Arg2,Arg3], Sub) -> +call_1(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3], Sub) -> Loop = #c_var{name={'lists^foldr',2}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, A = #c_var{name='A'}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_apply{op=F, args=[X, #c_apply{op=Loop, - args=[Xs, A]}]}}, + body=#c_apply{anno=Anno, + op=F, + args=[X, #c_apply{anno=Anno, + op=Loop, + args=[Xs, A]}]}}, C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=A}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{op=Loop, args=[L, A]}}}, + body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}, Sub); -call_1(_Call, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> +call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> Loop = #c_var{name={'lists^mapfoldl',2}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, @@ -868,15 +890,16 @@ call_1(_Call, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, #c_case{arg=A, clauses=[C1, C2]} end, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=Match(#c_apply{op=F, args=[X, Avar]}, + body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, #c_tuple{es=[X, Avar]}, %%% Tuple passing version - Match(#c_apply{op=Loop, args=[Xs, Avar]}, + Match(#c_apply{anno=Anno, + op=Loop, + args=[Xs, Avar]}, #c_tuple{es=[Xs, Avar]}, #c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]}) %%% Multiple-value version @@ -894,22 +917,23 @@ call_1(_Call, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, body=#c_letrec{defs=[{Loop,Fun}], %%% Tuple passing version - body=#c_apply{op=Loop, args=[L, Avar]}}}, + body=#c_apply{anno=Anno, + op=Loop, + args=[L, Avar]}}}, %%% Multiple-value version %%% body=#c_let{vars=[Xs, A], %%% arg=#c_apply{op=Loop, %%% args=[L, A]}, %%% body=#c_tuple{es=[Xs, A]}}}}, Sub); -call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> +call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> Loop = #c_var{name={'lists^mapfoldr',2}}, F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, @@ -920,15 +944,16 @@ call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, #c_case{arg=A, clauses=[C1, C2]} end, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, %%% Tuple passing version - body=Match(#c_apply{op=Loop, args=[Xs, Avar]}, + body=Match(#c_apply{anno=Anno, + op=Loop, + args=[Xs, Avar]}, #c_tuple{es=[Xs, Avar]}, - Match(#c_apply{op=F, args=[X, Avar]}, + Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, #c_tuple{es=[X, Avar]}, #c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]})) %%% Multiple-value version @@ -947,15 +972,16 @@ call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]}, C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=#c_primop{name=#c_literal{val='match_fail'}, - args=[Err]}}, + body=match_fail(Anno, Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, L = #c_var{name='L'}, expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, body=#c_letrec{defs=[{Loop,Fun}], %%% Tuple passing version - body=#c_apply{op=Loop, args=[L, Avar]}}}, + body=#c_apply{anno=Anno, + op=Loop, + args=[L, Avar]}}}, %%% Multiple-value version %%% body=#c_let{vars=[Xs, A], %%% arg=#c_apply{op=Loop, @@ -965,6 +991,11 @@ call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> call_1(#c_call{module=M, name=N}=Call, _, _, As, Sub) -> call_0(Call, M, N, As, Sub). +match_fail(Anno, Arg) -> + #c_primop{anno=Anno, + name=#c_literal{val='match_fail'}, + args=[Arg]}. + %% fold_call(Call, Mod, Name, Args, Sub) -> Expr. %% Try to safely evaluate the call. Just try to evaluate arguments, %% do the call and convert return values to literals. If this @@ -1030,6 +1061,8 @@ fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) -> eval_setelement(Call, Arg1, Arg2, Arg3); +fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) -> + eval_is_record(Call, Arg1, Arg2, Arg3, Sub); fold_non_lit_args(Call, erlang, N, Args, Sub) -> NumArgs = length(Args), case erl_internal:comp_op(N, NumArgs) of @@ -1186,19 +1219,22 @@ eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer true -> eval_failure(Call, badarg) end; -%% eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) -%% when is_integer(Pos) -> -%% case orddict:find(V, Types#sub.t) of -%% {ok,#c_tuple{es=Elements}} -> -%% if -%% 1 =< Pos, Pos =< length(Elements) -> -%% lists:nth(Pos, Elements); -%% true -> -%% eval_failure(Call, badarg) -%% end; -%% error -> -%% Call -%% end; +eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) + when is_integer(Pos) -> + case orddict:find(V, Types#sub.t) of + {ok,#c_tuple{es=Elements}} -> + if + 1 =< Pos, Pos =< length(Elements) -> + case lists:nth(Pos, Elements) of + #c_alias{var=Alias} -> Alias; + Res -> Res + end; + true -> + eval_failure(Call, badarg) + end; + error -> + Call + end; eval_element(Call, Pos, Tuple, _Types) -> case is_not_integer(Pos) orelse is_not_tuple(Tuple) of true -> @@ -1207,6 +1243,20 @@ eval_element(Call, Pos, Tuple, _Types) -> Call end. +%% eval_is_record(Call, Var, Tag, Size, Types) -> Val. +%% Evaluates is_record/3 using type information. +%% +eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit, + #c_literal{val=Size}, Types) -> + case orddict:find(V, Types#sub.t) of + {ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} -> + Lit#c_literal{val=Tag =:= NeededTag andalso + length(Es) =:= Size}; + _ -> + Call + end; +eval_is_record(Call, _, _, _, _) -> Call. + %% is_not_integer(Core) -> true | false. %% Returns true if Core is definitely not an integer. @@ -1253,9 +1303,9 @@ eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 -> %% eval_failure(Call, Reason) -> add_warning(Call, {eval_failure,Reason}), - #c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=error}, - args=[#c_literal{val=Reason}]}. + Call#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=error}, + args=[#c_literal{val=Reason}]}. %% simplify_apply(Call0, Mod, Func, Args) -> Call %% Simplify an apply/3 to a call if the number of arguments @@ -1709,35 +1759,26 @@ opt_bool_clauses([_|_], _, _) -> %% end. NewVar -> %% erlang:error(badarg) %% end. -%% -%% We add the extra match-all clause at the end only if Expr is -%% not guaranteed to evaluate to a boolean. opt_bool_not(#c_case{arg=Arg,clauses=Cs0}=Case0) -> case Arg of - #c_call{module=#c_literal{val=erlang}, + #c_call{anno=Anno,module=#c_literal{val=erlang}, name=#c_literal{val='not'}, args=[Expr]} -> - Cs = opt_bool_not(Expr, Cs0), + Cs = [opt_bool_not_invert(C) || C <- Cs0] ++ + [#c_clause{anno=[compiler_generated], + pats=[#c_var{name=cor_variable}], + guard=#c_literal{val=true}, + body=#c_call{anno=Anno, + module=#c_literal{val=erlang}, + name=#c_literal{val=error}, + args=[#c_literal{val=badarg}]}}], Case = Case0#c_case{arg=Expr,clauses=Cs}, opt_bool_not(Case); _ -> opt_bool_case_redundant(Case0) end. -opt_bool_not(Expr, Cs) -> - Tail = case is_bool_expr(Expr) of - false -> - [#c_clause{anno=[compiler_generated], - pats=[#c_var{name=cor_variable}], - guard=#c_literal{val=true}, - body=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=error}, - args=[#c_literal{val=badarg}]}}]; - true -> [] - end, - [opt_bool_not_invert(C) || C <- Cs] ++ Tail. - opt_bool_not_invert(#c_clause{pats=[#c_literal{val=Bool}]}=C) -> C#c_clause{pats=[#c_literal{val=not Bool}]}. @@ -1930,13 +1971,25 @@ case_tuple_pat([#c_tuple{es=Ps}], Arity) when length(Ps) =:= Arity -> case_tuple_pat([#c_literal{val=T}], Arity) when tuple_size(T) =:= Arity -> Ps = [#c_literal{val=E} || E <- tuple_to_list(T)], {ok,Ps,[]}; -case_tuple_pat([#c_var{anno=A}=V], Arity) -> - Vars = make_vars(A, 1, Arity), - {ok,Vars,[{V,#c_tuple{es=Vars}}]}; +case_tuple_pat([#c_var{anno=Anno0}=V], Arity) -> + Vars = make_vars(Anno0, 1, Arity), + + %% If the entire case statement is evaluated in an effect + %% context (e.g. "case {A,B} of ... end, ok"), there will + %% be a warning that a term is constructed but never used. + %% To avoid that warning, we must annotate the tuple as + %% compiler generated. + + Anno = [compiler_generated|Anno0], + {ok,Vars,[{V,#c_tuple{anno=Anno,es=Vars}}]}; case_tuple_pat([#c_alias{var=V,pat=P}], Arity) -> case case_tuple_pat([P], Arity) of - {ok,Ps,Avs} -> {ok,Ps,[{V,#c_tuple{es=unalias_pat_list(Ps)}}|Avs]}; - error -> error + {ok,Ps,Avs} -> + Anno0 = core_lib:get_anno(P), + Anno = [compiler_generated|Anno0], + {ok,Ps,[{V,#c_tuple{anno=Anno,es=unalias_pat_list(Ps)}}|Avs]}; + error -> + error end; case_tuple_pat(_, _) -> error. @@ -2014,32 +2067,7 @@ opt_case_in_let_2(V, Arg0, (_) -> 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_case_in_let_2(_, Arg, Cs) -> - %% simplify_bool_case(Case0) -> Case - %% Remove unecessary cases like - %% - %% case BoolExpr of - %% true -> true; - %% false -> false; - %% .... - %% end - %% - %% where BoolExpr is an expression that can only return true - %% or false (or throw an exception). - - true = is_bool_case(Cs) andalso is_bool_expr(Arg), - Arg. - -is_bool_case([A,B|_]) -> - (is_bool_clause(true, A) andalso is_bool_clause(false, B)) - orelse (is_bool_clause(false, A) andalso is_bool_clause(true, B)). - -is_bool_clause(Bool, #c_clause{pats=[#c_literal{val=Bool}], - guard=#c_literal{val=true}, - body=#c_literal{val=Bool}}) -> - true; -is_bool_clause(_, _) -> false. + #c_let{vars=Es,arg=Arg1,body=B}. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2561,14 +2589,14 @@ bsm_maybe_ctx_to_binary(V, B) -> body=B} end. -previous_ctx_to_binary(V, #c_seq{arg=#c_primop{name=Name,args=As}}) -> - case {Name,As} of - {#c_literal{val=bs_context_to_binary},[#c_var{name=V}]} -> +previous_ctx_to_binary(V, Core) -> + case Core of + #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, + args=[#c_var{name=V}]}} -> true; - {_,_} -> + _ -> false - end; -previous_ctx_to_binary(_, _) -> false. + end. %% bsm_leftmost(Cs) -> none | ArgumentNumber %% Find the leftmost argument that does binary matching. Return @@ -2590,9 +2618,9 @@ bsm_leftmost_2([_|Ps], Cs, N, Pos) -> bsm_leftmost_2([], Cs, _, Pos) -> bsm_leftmost_1(Cs, Pos). -%% bsm_notempty(Cs, Pos) -> true|false +%% bsm_nonempty(Cs, Pos) -> true|false %% Check if at least one of the clauses matches a non-empty -%% binary in the given argumet position. +%% binary in the given argument position. %% bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) -> case nth(Pos, Ps) of @@ -2653,7 +2681,7 @@ bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) -> %% %% But if the clauses can't be freely rearranged, as in %% - %% b(Var, <<>>) -> ... + %% b(Var, <<X>>) -> ... %% b(1, 2) -> ... %% %% we do have a problem. @@ -2713,22 +2741,20 @@ add_bin_opt_info(Core, Term) -> end. add_warning(Core, Term) -> - Anno = core_lib:get_anno(Core), - case lists:member(compiler_generated, Anno) of - true -> ok; + case is_compiler_generated(Core) of + true -> + ok; false -> - case get_line(Anno) of - Line when Line >= 0 -> %Must be positive. - File = get_file(Anno), - Key = {?MODULE,warnings}, - case get(Key) of - [{File,[{Line,?MODULE,Term}]}|_] -> - ok; %We already have + Anno = core_lib:get_anno(Core), + Line = get_line(Anno), + File = get_file(Anno), + Key = {?MODULE,warnings}, + case get(Key) of + [{File,[{Line,?MODULE,Term}]}|_] -> + ok; %We already have %an identical warning. - Ws -> - put(Key, [{File,[{Line,?MODULE,Term}]}|Ws]) - end; - _ -> ok %Compiler-generated code. + Ws -> + put(Key, [{File,[{Line,?MODULE,Term}]}|Ws]) end end. @@ -2742,14 +2768,7 @@ get_file([]) -> "no_file". % should not happen is_compiler_generated(Core) -> Anno = core_lib:get_anno(Core), - case lists:member(compiler_generated, Anno) of - true -> true; - false -> - case get_line(Anno) of - Line when Line >= 0 -> false; - _ -> true - end - end. + member(compiler_generated, Anno). get_warnings() -> ordsets:from_list((erase({?MODULE,warnings}))). @@ -2806,7 +2825,8 @@ format_error({no_effect,{erlang,F,A}}) -> end, flatten(io_lib:format(Fmt, Args)); format_error(result_ignored) -> - "the result of the expression is ignored"; + "the result of the expression is ignored " + "(suppress the warning by assigning the expression to the _ variable)"; 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 c8d75b80c6..9f93acb666 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Function inlining optimisation for Core. @@ -41,11 +41,9 @@ -module(sys_core_inline). -%%-compile({inline,{match_fail_fun,0}}). - -export([module/2]). --import(lists, [member/2,map/2,foldl/3,mapfoldl/3]). +-import(lists, [member/2,map/2,foldl/3,mapfoldl/3,keydelete/3]). -include("core_parse.hrl"). @@ -178,11 +176,9 @@ weight_func(_Core, Acc) -> Acc + 1. %% function_clause match_fail (if they have one). match_fail_fun() -> - fun (#c_primop{name=#c_literal{val=match_fail}, - args=[#c_tuple{es=[#c_literal{val=function_clause}|As]}]}=P) -> - Fail = #c_tuple{es=[#c_literal{val=case_clause}, - #c_tuple{es=As}]}, - P#c_primop{args=[Fail]}; + fun (#c_primop{anno=Anno0,name=#c_literal{val=match_fail}}=P) -> + Anno = keydelete(function_name, 1, Anno0), + P#c_primop{anno=Anno}; (Other) -> Other end. @@ -201,7 +197,7 @@ kill_id_anns(Body) -> (Expr) -> %% Mark everything as compiler generated to suppress %% bogus warnings. - A = [compiler_generated|core_lib:get_anno(Expr)], + A = compiler_generated(core_lib:get_anno(Expr)), core_lib:set_anno(Expr, A) end, Body). @@ -210,3 +206,8 @@ kill_id_anns_1([{'id',_}|As]) -> kill_id_anns_1([A|As]) -> [A|kill_id_anns_1(As)]; kill_id_anns_1([]) -> []. + +compiler_generated([compiler_generated|_]=Anno) -> + Anno; +compiler_generated(Anno) -> + [compiler_generated|Anno -- [compiler_generated]]. diff --git a/lib/compiler/src/sys_expand_pmod.erl b/lib/compiler/src/sys_expand_pmod.erl index 4fee26f2a6..da644b4f0b 100644 --- a/lib/compiler/src/sys_expand_pmod.erl +++ b/lib/compiler/src/sys_expand_pmod.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. 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 @@ -317,6 +317,8 @@ expr({'try',Line,Es0,Scs0,Ccs0,As0},St) -> Ccs1 = icr_clauses(Ccs0,St), As1 = exprs(As0,St), {'try',Line,Es1,Scs1,Ccs1,As1}; +expr({'fun',_,{function,_,_,_}}=ExtFun,_St) -> + ExtFun; expr({'fun',Line,Body,Info},St) -> case Body of {clauses,Cs0} -> diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index f80d03dfac..6cea783090 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-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. 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 @@ -31,8 +31,6 @@ -import(ordsets, [from_list/1,add_element/2,union/2]). -import(lists, [member/2,foldl/3,foldr/3]). --compile({nowarn_deprecated_function, {erlang,hash,2}}). - -include("../include/erl_bits.hrl"). -record(expand, {module=[], %Module name @@ -43,12 +41,12 @@ mod_imports, %Module Imports compile=[], %Compile flags attributes=[], %Attributes - defined=[], %Defined functions + callbacks=[], %Callbacks + defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function fcount=0, %Local fun count - fun_index=0, %Global index for funs bitdefault, bittypes }). @@ -85,7 +83,7 @@ module(Fs0, Opts0) -> {Efs,St2} = expand_pmod(Tfs, St1), %% Get the correct list of exported functions. Exports = case member(export_all, St2#expand.compile) of - true -> St2#expand.defined; + true -> gb_sets:to_list(St2#expand.defined); false -> St2#expand.exports end, %% Generate all functions from stored info. @@ -108,10 +106,11 @@ expand_pmod(Fs0, St0) -> true -> Ps0 end, + Def = gb_sets:to_list(St0#expand.defined), {Fs1,Xs,Ds} = sys_expand_pmod:forms(Fs0, Ps, St0#expand.exports, - St0#expand.defined), - St1 = St0#expand{exports=Xs, defined=Ds}, + Def), + St1 = St0#expand{exports=Xs,defined=gb_sets:from_list(Ds)}, {Fs2,St2} = add_instance(Ps, Fs1, St1), {Fs3,St3} = ensure_new(Base, Ps0, Fs2, St2), {Fs3,St3#expand{attributes = [{abstract, 0, [true]} @@ -120,7 +119,7 @@ expand_pmod(Fs0, St0) -> get_base(As) -> case lists:keyfind(extends, 1, As) of - {extends,[Base]} when is_atom(Base) -> + {extends,_,[Base]} when is_atom(Base) -> Base; _ -> [] @@ -161,7 +160,7 @@ add_func(Name, Args, Body, Fs, St) -> F = {function,0,Name,A,[{clause,0,Args,[],Body}]}, NA = {Name,A}, {[F|Fs],St#expand{exports=add_element(NA, St#expand.exports), - defined=add_element(NA, St#expand.defined)}}. + defined=gb_sets:add_element(NA, St#expand.defined)}}. %% define_function(Form, State) -> State. %% Add function to defined if form is a function. @@ -170,12 +169,43 @@ define_functions(Forms, #expand{defined=Predef}=St) -> Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc]; (_, Acc) -> Acc end, Predef, Forms), - St#expand{defined=ordsets:from_list(Fs)}. + St#expand{defined=gb_sets:from_list(Fs)}. -module_attrs(St) -> - {[{attribute,Line,Name,Val} || {Name,Line,Val} <- St#expand.attributes],St}. +module_attrs(#expand{attributes=Attributes}=St) -> + Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], + Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], + {Attrs,St#expand{callbacks=Callbacks}}. module_predef_funcs(St) -> + {Mpf1,St1}=module_predef_func_beh_info(St), + {Mpf2,St2}=module_predef_funcs_mod_info(St1), + {Mpf1++Mpf2,St2}. + +module_predef_func_beh_info(#expand{callbacks=[]}=St) -> + {[], St}; +module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, + exports=Exports}=St) -> + PreDef=[{behaviour_info,1}], + PreExp=PreDef, + {[gen_beh_info(Callbacks)], + St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), + exports=union(from_list(PreExp), Exports)}}. + +gen_beh_info(Callbacks) -> + List = make_list(Callbacks), + {function,0,behaviour_info,1, + [{clause,0,[{atom,0,callbacks}],[], + [List]}]}. + +make_list([]) -> {nil,0}; +make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_list(Rest)}. + +module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, {[{function,0,module_info,0, @@ -186,7 +216,8 @@ module_predef_funcs(St) -> [{clause,0,[{var,0,'X'}],[], [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, [{atom,0,St#expand.module},{var,0,'X'}]}]}]}], - St#expand{defined=union(from_list(PreDef), St#expand.defined), + St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), + St#expand.defined), exports=union(from_list(PreExp), St#expand.exports)}}. %% forms(Forms, State) -> @@ -223,10 +254,8 @@ attribute(export, Es, _L, St) -> St#expand{exports=union(from_list(Es), St#expand.exports)}; attribute(import, Is, _L, St) -> import(Is, St); -attribute(compile, C, _L, St) when is_list(C) -> - St#expand{compile=St#expand.compile ++ C}; -attribute(compile, C, _L, St) -> - St#expand{compile=St#expand.compile ++ [C]}; +attribute(compile, _C, _L, St) -> + St; attribute(Name, Val, Line, St) when is_list(Val) -> St#expand{attributes=St#expand.attributes ++ [{Name,Line,Val}]}; attribute(Name, Val, Line, St) -> @@ -403,16 +432,21 @@ expr({'fun',Line,Body}, St) -> expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), - case erl_internal:bif(N, Ar) of - true -> - {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}; - false -> - case imported(N, Ar, St1) of - {yes,Mod} -> - {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1}; - no -> - {{call,Line,Atom,As},St1} - end + case defined(N,Ar,St1) of + true -> + {{call,Line,Atom,As},St1}; + _ -> + case imported(N, Ar, St1) of + {yes,Mod} -> + {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1}; + no -> + case erl_internal:bif(N, Ar) of + true -> + {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}; + false -> %% This should have been handled by erl_lint + {{call,Line,Atom,As},St1} + end + end end; expr({call,Line,{record_field,_,_,_}=M,As0}, St0) -> expr({call,Line,expand_package(M, St0),As0}, St0); @@ -503,32 +537,34 @@ lc_tq(_Line, [], St0) -> %% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an %% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the %% name of a BIF (erl_lint has checked that it is not an import). -%% Process the body sequence directly to get the new and used variables. %% "Implicit" funs {'fun', Line, {function, F, A}} are not changed. fun_tq(Lf, {function,F,A}=Function, St0) -> - {As,St1} = new_vars(A, Lf, St0), - Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], case erl_internal:bif(F, A) of true -> + {As,St1} = new_vars(A, Lf, St0), + Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}], fun_tq(Lf, {clauses,Cs}, St1); false -> - Index = St0#expand.fun_index, - Uniq = erlang:hash(Cs, (1 bsl 27)-1), - {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,Function,{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}} + {Fname,St1} = new_fun_name(St0), + Index = Uniq = 0, + {{'fun',Lf,Function,{Index,Uniq,Fname}},St1} end; -fun_tq(L, {function,M,F,A}, St) -> - {{call,L,{remote,L,{atom,L,erlang},{atom,L,make_fun}}, - [{atom,L,M},{atom,L,F},{integer,L,A}]},St}; +fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) -> + %% This is the old format for external funs, generated by a pre-R15 + %% compiler. That means that a tool, such as the debugger or xref, + %% directly invoked this module with the abstract code from a + %% pre-R15 BEAM file. Be helpful, and translate it to the new format. + fun_tq(L, {function,{atom,L,M},{atom,L,F},{integer,L,A}}, St); +fun_tq(Lf, {function,_,_,_}=ExtFun, St) -> + {{'fun',Lf,ExtFun},St}; fun_tq(Lf, {clauses,Cs0}, St0) -> - Uniq = erlang:hash(Cs0, (1 bsl 27)-1), {Cs1,St1} = fun_clauses(Cs0, St0), - Index = St1#expand.fun_index, {Fname,St2} = new_fun_name(St1), - {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}}, - St2#expand{fun_index=Index+1}}. + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, + {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), @@ -685,3 +721,6 @@ imported(F, A, St) -> {ok,Mod} -> {yes,Mod}; error -> no end. + +defined(F, A, St) -> + gb_sets:is_element({F,A}, St#expand.defined). diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 83113d1652..be15495672 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Code generator for Beam. @@ -53,7 +53,6 @@ %% Main codegen structure. -record(cg, {lcount=1, %Label counter - finfo, %Function info label bfail, %Fail label for BIFs break, %Break label recv, %Receive label @@ -79,9 +78,10 @@ module({Mod,Exp,Attr,Forms}, Options) -> functions(Forms, AtomMod) -> mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms). -function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) -> +function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) -> try - {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, {Name,Arity}, St0), + {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, + {Name,Arity}, Anno, St0), Func = {function,Name,Arity,EntryLabel,Asm}, {Func,St} catch @@ -93,7 +93,7 @@ function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) -> %% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State} -cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) -> +cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> {Fi,St1} = new_label(St0), %FuncInfo label {Fl,St2} = local_func_label(NameArity, St1), @@ -125,11 +125,10 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) -> stk=[]}, 0, Vdb), {B,_Aft,St} = cg_list(Les, 0, Vdb, Bef, St3#cg{bfail=0, - finfo=Fi, ultimate_failure=UltimateMatchFail, is_top_block=true}), {Name,Arity} = NameArity, - Asm = [{label,Fi},{func_info,AtomMod,{atom,Name},Arity}, + Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, {label,Fl}|B++[{label,UltimateMatchFail},if_end]], {Asm,Fl,St}. @@ -146,8 +145,6 @@ cg({match,M,Rs}, Le, Vdb, Bef, St) -> match_cg(M, Rs, Le, Vdb, Bef, St); cg({guard_match,M,Rs}, Le, Vdb, Bef, St) -> guard_match_cg(M, Rs, Le, Vdb, Bef, St); -cg({match_fail,F}, Le, Vdb, Bef, St) -> - match_fail_cg(F, Le, Vdb, Bef, St); cg({call,Func,As,Rs}, Le, Vdb, Bef, St) -> call_cg(Func, As, Rs, Le, Vdb, Bef, St); cg({enter,Func,As}, Le, Vdb, Bef, St) -> @@ -209,7 +206,6 @@ need_heap_1(#l{ke={set,_,Val}}, H) -> {[],H + case Val of {cons,_} -> 2; {tuple,Es} -> 1 + length(Es); - {string,S} -> 2 * length(S); _Other -> 0 end}; need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H) -> @@ -236,7 +232,7 @@ match_cg(M, Rs, Le, Vdb, Bef, St0) -> I = Le#l.i, {Sis,Int0} = adjust_stack(Bef, I, I+1, Vdb), {B,St1} = new_label(St0), - {Mis,Int1,St2} = match_cg(M, St0#cg.ultimate_failure, + {Mis,Int1,St2} = match_cg(M, St1#cg.ultimate_failure, Int0, St1#cg{break=B}), %% Put return values in registers. Reg = load_vars(Rs, Int1#sr.reg), @@ -294,39 +290,6 @@ match_cg({block,Es}, Le, _Fail, Bef, St) -> Int = clear_dead(Bef, Le#l.i, Le#l.vdb), block_cg(Es, Le, Int, St). -%% match_fail_cg(FailReason, Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% Generate code for the match_fail "call". N.B. there is no generic -%% case for when the fail value has been created elsewhere. - -match_fail_cg({function_clause,As}, Le, Vdb, Bef, St) -> - %% Must have the args in {x,0}, {x,1},... - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - {Sis ++ [{jump,{f,St#cg.finfo}}], - Int#sr{reg=clear_regs(Int#sr.reg)},St}; -match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Term, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{badmatch,R}], - Int#sr{reg=clear_regs(Int0#sr.reg)},St}; -match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Reason, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[{case_end,R}], - Int#sr{reg=clear_regs(Bef#sr.reg)},St}; -match_fail_cg(if_clause, Le, Vdb, Bef, St) -> - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St}; -match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Reason, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{try_case_end,R}], - Int#sr{reg=clear_regs(Int0#sr.reg)},St}. - %% bsm_rename_ctx([Clause], Var) -> [Clause] %% We know from an annotation that the register for a binary can %% be reused for the match context because the two are not truly @@ -1048,7 +1011,7 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) -> %% Build complete code and final stack/register state. Arity = length(As), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [{call_fun,Arity}],Aft, + {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft, need_stack_frame(St0)}; call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) when element(1, Mod) =:= var; @@ -1058,11 +1021,10 @@ call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) Reg = load_vars(Rs, clear_regs(Int#sr.reg)), %% Build complete code and final stack/register state. Arity = length(As), - Call = {apply,Arity}, St = need_stack_frame(St0), %%{Call,St1} = build_call(Func, Arity, St0), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [Call],Aft,St}; + {Sis ++ Frees ++ [line(Le),{apply,Arity}],Aft,St}; call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> case St0 of #cg{bfail=Fail} when Fail =/= 0 -> @@ -1092,7 +1054,7 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> Arity = length(As), {Call,St1} = build_call(Func, Arity, St0), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ Call,Aft,St1} + {Sis ++ Frees ++ [line(Le)|Call],Aft,St1} end. build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> @@ -1119,7 +1081,7 @@ enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) -> {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), - {Sis ++ [{call_fun,Arity},return], + {Sis ++ [line(Le),{call_fun,Arity},return], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), need_stack_frame(St0)}; enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) @@ -1128,9 +1090,8 @@ enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), - Call = {apply_only,Arity}, St = need_stack_frame(St0), - {Sis ++ [Call], + {Sis ++ [line(Le),{apply_only,Arity}], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St}; enter_cg(Func, As, Le, Vdb, Bef, St0) -> @@ -1138,7 +1099,8 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) -> %% Build complete code and final stack/register state. Arity = length(As), {Call,St1} = build_enter(Func, Arity, St0), - {Sis ++ Call, + Line = enter_line(Func, Arity, Le), + {Sis ++ Line ++ Call, clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St1}. @@ -1154,6 +1116,23 @@ build_enter(Name, Arity, St0) when is_atom(Name) -> {Lbl,St1} = local_func_label(Name, Arity, St0), {[{call_only,Arity,{f,Lbl}}],St1}. +enter_line({remote,{atom,Mod},{atom,Name}}, Arity, Le) -> + case erl_bifs:is_safe(Mod, Name, Arity) of + false -> + %% Tail-recursive call, possibly to a BIF. + %% We'll need a line instruction in case the + %% BIF call fails. + [line(Le)]; + true -> + %% Call to a safe BIF. Since it cannot fail, + %% we don't need any line instruction here. + [] + end; +enter_line(_, _, _) -> + %% Tail-recursive call to a local function. A line + %% instruction will not be useful. + []. + %% local_func_label(Name, Arity, State) -> {Label,State'} %% local_func_label({Name,Arity}, State) -> {Label,State'} %% Get the function entry label for a local function. @@ -1191,7 +1170,12 @@ trap_bif(_, _, _) -> false. bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) -> [Src] = cg_reg_args([Src0], Bef), - {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}; + case is_register(Src) of + false -> + {[],clear_dead(Bef, Le#l.i, Vdb), St0}; + true -> + {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0} + end; bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> [New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef), Index = Index1-1, @@ -1222,9 +1206,10 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% Currently, we are somewhat pessimistic in %% that we save any variable that will be live after this BIF call. + MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), {Sis,Int0} = case St0#cg.in_catch andalso St0#cg.bfail =:= 0 andalso - not erl_bifs:is_safe(erlang, Bif, length(As)) of + MayFail of true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); false -> {[],Bef} end, @@ -1233,7 +1218,14 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> Int = Int1#sr{reg=Reg}, Dst = fetch_reg(V, Reg), BifFail = {f,St0#cg.bfail}, - {Sis++[{bif,Bif,BifFail,Ars,Dst}], + %% We need a line instructions for BIFs that may fail in a body. + Line = case BifFail of + {f,0} when MayFail -> + [line(Le)]; + _ -> + [] + end, + {Sis++Line++[{bif,Bif,BifFail,Ars,Dst}], clear_dead(Int, Le#l.i, Vdb), St0}. @@ -1262,7 +1254,11 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> Int = Int1#sr{reg=Reg}, Dst = fetch_reg(V, Reg), BifFail = {f,St0#cg.bfail}, - {Sis++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], + Line = case BifFail of + {f,0} -> [line(Le)]; + {f,_} -> [] + end, + {Sis++Line++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], clear_dead(Int, Le#l.i, Vdb), St0}. %% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, @@ -1280,7 +1276,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> {Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5), Int2 = sr_merge(Raft, Taft), %Merge stack/registers Reg = load_vars(Rs, Int2#sr.reg), - {Sis ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], + {Sis ++ [line(Le)] ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb), St6#cg{break=St0#cg.break,recv=St0#cg.recv}}. @@ -1424,25 +1420,10 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); {var,V} -> % Normally removed by kernel optimizer. [{move,fetch_var(V, Int),Ret}]; - {string,Str} = String -> - [{put_string,length(Str),String,Ret}]; Other -> [{move,Other,Ret}] end, - {Ais,clear_dead(Int, Le#l.i, Vdb),St}; -set_cg([], {binary,Segs}, Le, Vdb, Bef, St) -> - Fail = {f,St#cg.bfail}, - Target = find_scratch_reg(Bef#sr.reg), - Temp = find_scratch_reg(put_reg(Target, Bef#sr.reg)), - PutCode = cg_bin_put(Segs, Fail, Bef), - MaxRegs = max_reg(Bef#sr.reg), - Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), - Aft = clear_dead(Bef, Le#l.i, Vdb), - {Code,Aft,St}; -set_cg([], _, Le, Vdb, Bef, St) -> - %% This should have been stripped by compiler, just cleanup. - {[],clear_dead(Bef, Le#l.i, Vdb), St}. - + {Ais,clear_dead(Int, Le#l.i, Vdb),St}. %%% %%% Code generation for constructing binaries. @@ -1461,12 +1442,13 @@ cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], {bs_append,Fail,Target,0,MaxRegs,U,Src,BinFlags,Target} end] ++ PutCode, cg_bin_opt(Code); -cg_binary(PutCode, Target, Temp, Fail, MaxRegs, _Anno) -> +cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Anno) -> + Line = line(Anno), Live = cg_live(Target, MaxRegs), {InitOp,SzCode} = cg_binary_size(PutCode, Target, Temp, Fail, Live), - Code = SzCode ++ [{InitOp,Fail,Target,0,MaxRegs, - {field_flags,[]},Target}|PutCode], + Code = [Line|SzCode] ++ [{InitOp,Fail,Target,0,MaxRegs, + {field_flags,[]},Target}|PutCode], cg_bin_opt(Code). cg_live({x,X}, MaxRegs) when X =:= MaxRegs -> MaxRegs+1; @@ -1521,7 +1503,9 @@ cg_binary_size_1([], Bits, Acc) -> [{1,_}|_] -> {bs_init_bits,cg_binary_bytes_to_bits(Sizes, [])}; [{8,_}|_] -> - {bs_init2,[E || {8,E} <- Sizes]} + {bs_init2,[E || {8,E} <- Sizes]}; + [] -> + {bs_init_bits,[]} end. cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) -> @@ -2022,6 +2006,10 @@ fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). on_stack(V, Stk) -> keymember(V, 1, Stk). +is_register({x,_}) -> true; +is_register({yy,_}) -> true; +is_register(_) -> false. + %% put_catch(CatchTag, Stack) -> Stack' %% drop_catch(CatchTag, Stack) -> Stack' %% Special interface for putting and removing catch tags, to ensure that @@ -2044,6 +2032,38 @@ drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)]. new_label(#cg{lcount=Next}=St) -> {Next,St#cg{lcount=Next+1}}. +%% line(Le) -> {line,[] | {location,File,Line}} +%% Create a line instruction, containing information about +%% the current filename and line number. A line information +%% instruction should be placed before any operation that could +%% cause an exception. + +line(#l{a=Anno}) -> + line(Anno); +line([Line,{file,Name}]) when is_integer(Line) -> + line_1(Name, Line); +line([_|_]=A) -> + {Name,Line} = find_loc(A, no_file, 0), + line_1(Name, Line); +line([]) -> + {line,[]}. + +line_1(no_file, _) -> + {line,[]}; +line_1(_, 0) -> + %% Missing line number or line number 0. + {line,[]}; +line_1(Name, Line) -> + {line,[{location,Name,Line}]}. + +find_loc([Line|T], File, _) when is_integer(Line) -> + find_loc(T, File, Line); +find_loc([{file,File}|T], _, Line) -> + find_loc(T, File, Line); +find_loc([_|T], File, Line) -> + find_loc(T, File, Line); +find_loc([], File, Line) -> {File,Line}. + flatmapfoldl(F, Accu0, [Hd|Tail]) -> {R,Accu1} = F(Hd, Accu0), {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index dfe15de4ff..242196c593 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -122,14 +122,13 @@ | iclause() | ifun() | iletrec() | imatch() | iprimop() | iprotect() | ireceive1() | ireceive2() | iset() | itry(). --type error() :: {file:filename(), [{integer(), module(), term()}]}. -type warning() :: {file:filename(), [{integer(), module(), term()}]}. -record(core, {vcount=0 :: non_neg_integer(), %Variable counter fcount=0 :: non_neg_integer(), %Function counter in_guard=false :: boolean(), %In guard or not. + wanted=true :: boolean(), %Result wanted or not. opts :: [compile:option()], %Options. - es=[] :: [error()], %Errors. ws=[] :: [warning()], %Warnings. file=[{file,""}]}). %File @@ -140,53 +139,48 @@ | {attribute, integer(), attribute(), _}. -spec module({module(), [fa()], [form()]}, [compile:option()]) -> - {'ok',cerl:c_module(),[warning()]} | {'error',[error()],[warning()]}. + {'ok',cerl:c_module(),[warning()]}. module({Mod,Exp,Forms}, Opts) -> Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp), - {Kfs0,As0,Es,Ws,_File} = foldl(fun (F, Acc) -> - form(F, Acc, Opts) - end, {[],[],[],[],[]}, Forms), + {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) -> + form(F, Acc, Opts) + end, {[],[],[],[]}, Forms), Kfs = reverse(Kfs0), As = reverse(As0), - case Es of - [] -> - {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}; - _ -> - {error,Es,Ws} - end. + {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}. -form({function,_,_,_,_}=F0, {Fs,As,Es0,Ws0,File}, Opts) -> - {F,Es,Ws} = function(F0, Es0, Ws0, File, Opts), - {[F|Fs],As,Es,Ws,File}; -form({attribute,_,file,{File,_Line}}, {Fs,As,Es,Ws,_}, _Opts) -> - {Fs,As,Es,Ws,File}; -form({attribute,_,_,_}=F, {Fs,As,Es,Ws,File}, _Opts) -> - {Fs,[attribute(F)|As],Es,Ws,File}. +form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) -> + {F,Ws} = function(F0, Ws0, File, Opts), + {[F|Fs],As,Ws,File}; +form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> + {Fs,As,Ws,File}; +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]}}. -function({function,_,Name,Arity,Cs0}, Es0, Ws0, File, Opts) -> +function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> %%ok = io:fwrite("~p - ", [{Name,Arity}]), - St0 = #core{vcount=0,opts=Opts,es=Es0,ws=Ws0,file=[{file,File}]}, + St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), %%ok = io:fwrite("1", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), {B1,St2} = ubody(B0, St1), %%ok = io:fwrite("2", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), - {B2,#core{es=Es,ws=Ws}} = cbody(B1, St2), + {B2,#core{ws=Ws}} = cbody(B1, St2), %%ok = io:fwrite("3~n", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B2]), - {{#c_var{name={Name,Arity}},B2},Es,Ws}. + {{#c_var{name={Name,Arity}},B2},Ws}. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), {Args,St1} = new_vars(Anno, Arity, St0), {Cs1,St2} = clauses(Cs0, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, {Name,Arity}), + Fc = function_clause(Ps, Anno, {Name,Arity}), {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. %% clause(Clause, State) -> {Cclause,State} | noclause. @@ -213,10 +207,7 @@ clause({clause,Lc,H0,G0,B0}, St0) -> catch throw:nomatch -> St = add_warning(Lc, nomatch, St0), - {noclause,St}; %Bad pattern - throw:no_binaries -> - St = add_error(Lc, no_binaries, St0), - {noclause,St} + {noclause,St} %Bad pattern end. clause_arity({clause,_,H0,_,_}) -> length(H0). @@ -496,22 +487,18 @@ expr({tuple,L,Es0}, St0) -> {Es1,Eps,St1} = safe_list(Es0, St0), A = lineno_anno(L, St1), {ann_c_tuple(A, Es1),Eps,St1}; -expr({bin,L,Es0}, #core{opts=Opts}=St0) -> - St1 = case member(no_binaries, Opts) of - false -> St0; - true -> add_error(L, no_binaries, St0) - end, - try expr_bin(Es0, lineno_anno(L, St1), St1) of +expr({bin,L,Es0}, St0) -> + try expr_bin(Es0, lineno_anno(L, St0), St0) of {_,_,_}=Res -> Res catch throw:bad_binary -> - St2 = add_warning(L, bad_binary, St1), - LineAnno = lineno_anno(L, St2), + St = add_warning(L, bad_binary, 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},[],St2} + args=As},[],St} end; expr({block,_,Es0}, St0) -> %% Inline the block directly. @@ -520,15 +507,15 @@ expr({block,_,Es0}, St0) -> {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> {Cs1,St1} = clauses(Cs0, St0), - Fc = fail_clause([], #c_literal{val=if_clause}), Lanno = lineno_anno(L, St1), + Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), {Cs1,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), - Lanno = lineno_anno(L, St3), + Lanno = lineno_anno(L, St2), + Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; expr({'receive',L,Cs0}, St0) -> {Cs1,St1} = clauses(Cs0, St0), @@ -554,9 +541,10 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {V,St2} = new_var(St1), %This name should be arbitrary {Cs1,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=try_clause},Fpat])), + Lanno = lineno_anno(L, St4), + Fc = fail_clause([Fpat], Lanno, + c_tuple([#c_literal{val=try_clause},Fpat])), {Evs,Hs,St5} = try_exception(Ecs, St4), - Lanno = lineno_anno(L, St1), {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, @@ -585,12 +573,23 @@ expr({'catch',L,E0}, St0) -> expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> Lanno = lineno_anno(L, St), {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; +expr({'fun',L,{function,M,F,A}}, St0) -> + {As,Aps,St1} = safe_list([M,F,A], St0), + Lanno = lineno_anno(L, St1), + {#icall{anno=#a{anno=Lanno}, + module=#c_literal{val=erlang}, + name=#c_literal{val=make_fun}, + args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> fun_tq(Id, Cs, L, St); -expr({call,L,{remote,_,M,F},As0}, St0) -> +expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), Lanno = lineno_anno(L, St1), - {#icall{anno=#a{anno=Lanno},module=M1,name=F1,args=As1},Aps,St1}; + Anno = case Wanted of + false -> [result_not_wanted|Lanno]; + true -> Lanno + end, + {#icall{anno=#a{anno=Anno},module=M1,name=F1,args=As1},Aps,St1}; expr({call,Lc,{atom,Lf,F},As0}, St0) -> {As1,Aps,St1} = safe_list(As0, St0), Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}}, @@ -603,27 +602,28 @@ expr({call,L,FunExp,As0}, St0) -> expr({match,L,P0,E0}, St0) -> %% First fold matches together to create aliases. {P1,E1} = fold_match(E0, P0), - {E2,Eps,St1} = novars(E1, St0), + St1 = case P1 of + {var,_,'_'} -> St0#core{wanted=false}; + _ -> St0 + end, + {E2,Eps,St2} = novars(E1, St1), + St3 = St2#core{wanted=St0#core.wanted}, P2 = try - pattern(P1, St1) + pattern(P1, St3) catch throw:Thrown -> Thrown end, - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])), - Lanno = lineno_anno(L, St2), + {Fpat,St4} = new_var(St3), + Lanno = lineno_anno(L, St4), + Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> - St = add_warning(L, nomatch, St2), - {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps,St}; - no_binaries -> - St = add_error(L, no_binaries, St2), + St = add_warning(L, nomatch, St4), {#icase{anno=#a{anno=Lanno}, args=[E2],clauses=[],fc=Fc},Eps,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St2} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} end; expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -836,8 +836,9 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) -> {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, {Name,Arity}), - Fun = #ifun{anno=#a{anno=lineno_anno(L, St3)}, + Anno = lineno_anno(L, St3), + Fc = function_clause(Ps, Anno, {Name,Arity}), + Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc}, {Fun,[],St3}. @@ -900,25 +901,22 @@ lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) -> lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), {Name,St1} = new_fun_name("blc", St0), - {Tname,St2} = new_var_name(St1), - LA = lineno_anno(Line, St2), + LA = lineno_anno(Line, St1), LAnno = #a{anno=LA}, - HeadBinPattern = pattern(P,St2), - #c_binary{segments=Ps} = HeadBinPattern, - {EPs,St3} = emasculate_segments(Ps,St2), - Tail = #c_var{anno=LA,name=Tname}, - TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all}, - unit=#c_literal{val=1}, - type=#c_literal{val=binary}, - flags=#c_literal{val=[big,unsigned]}}, - Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]}, - EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]}, + HeadBinPattern = pattern(P, St1), + #c_binary{segments=Ps0} = HeadBinPattern, + {Ps,Tail,St2} = append_tail_segment(Ps0, St1), + {EPs,St3} = emasculate_segments(Ps, St2), + Pattern = HeadBinPattern#c_binary{segments=Ps}, + EPattern = HeadBinPattern#c_binary{segments=EPs}, {Arg,St4} = new_var(St3), {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! + Tname = Tail#c_var.name, {Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5), {Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6), {Gc,Gps,St10} = safe(G, St7), %Will be a function argument! Fc = function_clause([Arg], LA, {Name,1}), + {TailSegList,_,St} = append_tail_segment([], St10), Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]}, pats=[Pattern], guard=Guardc, @@ -930,17 +928,17 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> op=#c_var{anno=LA,name={Name,1}}, args=[Tail]}]}, #iclause{anno=LAnno, - pats=[#c_binary{anno=LA, segments=[TailSegment]}],guard=[], + pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[], body=[Mc]}], Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}], body=Gps ++ [#iapply{anno=LAnno, op=#c_var{anno=LA,name={Name,1}}, args=[Gc]}]}, - [],St10}; + [],St}; lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> %% Special case sequences guard tests. - LA = lineno_anno(Line, St0), + LA = lineno_anno(element(2, Fil0), St0), LAnno = #a{anno=LA}, case is_guard_test(Fil0) of true -> @@ -956,7 +954,8 @@ lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> false -> {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), + Fc = fail_clause([Fpat], LA, + c_tuple([#c_literal{val=case_clause},Fpat])), %% Do a novars little optimisation here. {Filc,Fps,St3} = novars(Fil0, St2), {#icase{anno=LAnno, @@ -1045,26 +1044,24 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), {Name,St1} = new_fun_name("lbc", St0), LA = lineno_anno(Line, St1), - {[Tail,AccVar],St2} = new_vars(LA, 2, St1), + {AccVar,St2} = new_var(LA, St1), LAnno = #a{anno=LA}, HeadBinPattern = pattern(P, St2), - #c_binary{segments=Ps} = HeadBinPattern, - {EPs,St3} = emasculate_segments(Ps, St2), - TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all}, - unit=#c_literal{val=1}, - type=#c_literal{val=binary}, - flags=#c_literal{val=[big,unsigned]}}, - Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]}, - EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]}, - {Arg,St4} = new_var(St3), + #c_binary{segments=Ps0} = HeadBinPattern, + {Ps,Tail,St3} = append_tail_segment(Ps0, St2), + {EPs,St4} = emasculate_segments(Ps, St3), + Pattern = HeadBinPattern#c_binary{segments=Ps}, + EPattern = HeadBinPattern#c_binary{segments=EPs}, + {Arg,St5} = new_var(St4), NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, {var,Lg,AccVar#c_var.name}]}, - {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! - {Bc,Bps,St6} = bc_tq1(Line, E, Qs1, AccVar, St5), - {Nc,Nps,St7} = expr(NewMore, St6), - {Gc,Gps,St8} = safe(G, St7), %Will be a function argument! + {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! + {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6), + {Nc,Nps,St8} = expr(NewMore, St7), + {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! Fc = function_clause([Arg,AccVar], LA, {Name,2}), Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc], + {TailSegList,_,St} = append_tail_segment([], St9), Cs = [#iclause{anno=LAnno, pats=[Pattern,AccVar], guard=Guardc, @@ -1074,7 +1071,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> guard=[], body=Nps ++ [Nc]}, #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=[TailSegment]},AccVar], + pats=[#c_binary{anno=LA,segments=TailSegList},AccVar], guard=[], body=[AccVar]}], Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, @@ -1082,10 +1079,10 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> body=Gps ++ [#iapply{anno=LAnno, op=#c_var{anno=LA,name={Name,2}}, args=[Gc,AccExpr]}]}, - [],St8}; + [],St}; bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> %% Special case sequences guard tests. - LA = lineno_anno(Line, St0), + LA = lineno_anno(element(2, Fil0), St0), LAnno = #a{anno=LA}, case is_guard_test(Fil0) of true -> @@ -1102,7 +1099,8 @@ bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> false -> {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), + Fc = fail_clause([Fpat], LA, + c_tuple([#c_literal{val=case_clause},Fpat])), %% Do a novars little optimisation here. {Filc,Fps,St} = novars(Fil0, St2), {#icase{anno=LAnno, @@ -1128,6 +1126,29 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> %%Anno = Anno0#a{anno=[compiler_generated|A]}, {set_anno(E, Anno),Pre,St}. +append_tail_segment(Segs, St) -> + app_tail_seg(Segs, St, []). + +app_tail_seg([#c_bitstr{val=Var0,size=#c_literal{val=all}}=Seg0]=L, + St0, Acc) -> + case Var0 of + #c_var{name='_'} -> + {Var,St} = new_var(St0), + Seg = Seg0#c_bitstr{val=Var}, + {reverse(Acc, [Seg]),Var,St}; + #c_var{} -> + {reverse(Acc, L),Var0,St0} + end; +app_tail_seg([H|T], St, Acc) -> + app_tail_seg(T, St, [H|Acc]); +app_tail_seg([], St0, Acc) -> + {Var,St} = new_var(St0), + Tail = #c_bitstr{val=Var,size=#c_literal{val=all}, + unit=#c_literal{val=1}, + type=#c_literal{val=binary}, + flags=#c_literal{val=[unsigned,big]}}, + {reverse(Acc, [Tail]),Var,St}. + emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). @@ -1443,15 +1464,10 @@ pattern({cons,L,H,T}, St) -> ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St)); pattern({tuple,L,Ps}, St) -> ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St)); -pattern({bin,L,Ps}, #core{opts=Opts}=St) -> - case member(no_binaries, Opts) of - false -> - %% We don't create a #ibinary record here, since there is - %% no need to hold any used/new annotations in a pattern. - #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)}; - true -> - throw(no_binaries) - end; +pattern({bin,L,Ps}, St) -> + %% We don't create a #ibinary record here, since there is + %% no need to hold any used/new annotations in a pattern. + #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)}; pattern({match,_,P1,P2}, St) -> pat_alias(pattern(P1, St), pattern(P2, St)). @@ -1557,18 +1573,16 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 -> new_vars_1(N-1, Anno, St1, [V|Vs]); new_vars_1(0, _, St, Vs) -> {Vs,St}. -function_clause(Ps, Name) -> - fail_clause(Ps, c_tuple([#c_literal{anno=[{name,Name}], - val=function_clause}|Ps])). -function_clause(Ps, Anno, Name) -> - fail_clause(Ps, ann_c_tuple(Anno, - [#c_literal{anno=[{name,Name}], - val=function_clause}|Ps])). +function_clause(Ps, LineAnno, Name) -> + FcAnno = [{function_name,Name}|LineAnno], + fail_clause(Ps, FcAnno, + ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])). -fail_clause(Pats, A) -> +fail_clause(Pats, Anno, Arg) -> #iclause{anno=#a{anno=[compiler_generated]}, pats=Pats,guard=[], - body=[#iprimop{anno=#a{},name=#c_literal{val=match_fail},args=[A]}]}. + body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail}, + args=[Arg]}]}. ubody(B, St) -> uexpr(B, [], St). @@ -1811,7 +1825,21 @@ upattern_list([], _, St) -> {[],[],[],[],St}. %% upat_bin([Pat], [KnownVar], State) -> %% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. upat_bin(Es0, Ks, St0) -> - upat_bin(Es0, Ks, [], St0). + {Es1,Pg,Pv,Pu0,St1} = upat_bin(Es0, Ks, [], St0), + + %% In a clause such as <<Sz:8,V:Sz>> in a function head, Sz will both + %% be new and used; a situation that is not handled properly by + %% uclause/4. (Basically, since Sz occurs in two sets that are + %% subtracted from each other, Sz will not be added to the list of + %% known variables and will seem to be new the next time it is + %% used in a match.) + %% Since the variable Sz really is new (it does not use a + %% value bound prior to the binary matching), Sz should only be + %% included in the set of new variables. Thus we should take it + %% out of the set of used variables. + + Pu1 = subtract(Pu0, intersection(Pv, Pu0)), + {Es1,Pg,Pv,Pu1,St1}. %% upat_bin([Pat], [KnownVar], [LocalVar], State) -> %% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. @@ -1823,35 +1851,36 @@ upat_bin([], _, _, St) -> {[],[],[],[],St}. %% upat_element(Segment, [KnownVar], [LocalVar], State) -> -%% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State} -upat_element(#c_bitstr{val=H0,size=Sz}=Seg, Ks, Bs, St0) -> - {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0), - Bs1 = case H0 of - #c_var{name=Hname} -> - case H1 of +%% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State} +upat_element(#c_bitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) -> + {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0), + Bs1 = case H0 of #c_var{name=Hname} -> - Bs; - #c_var{name=Other} -> - [{Hname, Other}|Bs] - end; - _ -> - Bs - end, - {Sz1, Us} = case Sz of - #c_var{name=Vname} -> - rename_bitstr_size(Vname, Bs); - _Other -> {Sz, []} - end, - {Seg#c_bitstr{val=H1, size=Sz1},Hg,Hv,Us,Bs1,St1}. - -rename_bitstr_size(V, [{V, N}|_]) -> - New = #c_var{name=N}, - {New, [N]}; + case H1 of + #c_var{name=Hname} -> + Bs0; + #c_var{name=Other} -> + [{Hname,Other}|Bs0] + end; + _ -> + Bs0 + end, + {Sz1,Us} = case Sz0 of + #c_var{name=Vname} -> + rename_bitstr_size(Vname, Bs0); + _Other -> + {Sz0,[]} + end, + {Seg#c_bitstr{val=H1,size=Sz1},Hg,Hv,Us,Bs1,St1}. + +rename_bitstr_size(V, [{V,N}|_]) -> + New = #c_var{name=N}, + {New,[N]}; rename_bitstr_size(V, [_|Rest]) -> - rename_bitstr_size(V, Rest); + rename_bitstr_size(V, Rest); rename_bitstr_size(V, []) -> - Old = #c_var{name=V}, - {Old, [V]}. + Old = #c_var{name=V}, + {Old,[V]}. used_in_any(Les) -> foldl(fun (Le, Ns) -> union((get_anno(Le))#a.us, Ns) end, @@ -2056,7 +2085,12 @@ bitstr_vars(Segs, Vs) -> lineno_anno(L, St) -> {line, Line} = erl_parse:get_attribute(L, line), - [Line] ++ St#core.file. + if + Line < 0 -> + [-Line] ++ St#core.file ++ [compiler_generated]; + true -> + [Line] ++ St#core.file + end. get_ianno(Ce) -> case get_anno(Ce) of @@ -2098,39 +2132,25 @@ is_simple(#c_literal{}) -> true; is_simple(#c_cons{hd=H,tl=T}) -> is_simple(H) andalso is_simple(T); is_simple(#c_tuple{es=Es}) -> is_simple_list(Es); -is_simple(#c_binary{segments=Es}) -> is_simp_bin(Es); is_simple(_) -> false. -spec is_simple_list([cerl:cerl()]) -> boolean(). is_simple_list(Es) -> lists:all(fun is_simple/1, Es). --spec is_simp_bin([cerl:cerl()]) -> boolean(). - -is_simp_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_simple(E) andalso is_simple(S) - end, Es). - %%% %%% Handling of warnings. %%% --type err_desc() :: 'bad_binary' | 'no_binaries' | 'nomatch'. +-type err_desc() :: 'bad_binary' | 'nomatch'. -spec format_error(err_desc()) -> nonempty_string(). format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> - "binary construction will fail because of a type mismatch"; -format_error(no_binaries) -> - "bit syntax is not allowed to be used when compatibility with a previous " - "version has been requested". + "binary 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_error(Line, Term, #core{es=Es,file=[{file,File}]}=St) -> - St#core{es=[{File,[{location(abs_line(Line)),?MODULE,Term}]}|Es]}. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 8568071e57..c4e7b45aac 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Transform Core Erlang to Kernel Erlang @@ -80,16 +80,14 @@ -export([module/2,format_error/1]). --import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,keymember/3]). +-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, + keymember/3,keyfind/3]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). - --compile({nowarn_deprecated_function, {erlang,hash,2}}). +-import(cerl, [c_tuple/1]). -include("core_parse.hrl"). -include("v3_kernel.hrl"). --define(EXPENSIVE_BINARY_LIMIT, 256). - %% These are not defined in v3_kernel.hrl. get_kanno(Kthing) -> element(2, Kthing). set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). @@ -120,25 +118,34 @@ copy_anno(Kdst, Ksrc) -> funs=[], %Fun functions free=[], %Free variables ws=[] :: [warning()], %Warnings. - lit, %Constant pool for literals. guard_refc=0}). %> 0 means in guard -spec module(cerl:c_module(), [compile:option()]) -> {'ok', #k_mdef{}, [warning()]}. -module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) -> - Lit = case member(no_constant_pool, Options) of - true -> no; - false -> dict:new() - end, - St0 = #kern{lit=Lit}, - {Kfs,St} = mapfoldl(fun function/2, St0, Fs), +module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> + Kas = attributes(As), Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), - Kas = map(fun ({#c_literal{val=N},V}) -> - {N,core_lib:literal_value(V)} end, As), + St0 = #kern{}, + {Kfs,St} = mapfoldl(fun function/2, St0, Fs), {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. +attributes([{#c_literal{val=Name},Val}|As]) -> + case include_attribute(Name) of + false -> + attributes(As); + true -> + [{Name,core_lib:literal_value(Val)}|attributes(As)] + end; +attributes([]) -> []. + +include_attribute(type) -> false; +include_attribute(spec) -> false; +include_attribute(opaque) -> false; +include_attribute(export_type) -> false; +include_attribute(_) -> true. + function({#c_var{name={F,Arity}=FA},Body}, St0) -> try St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=sets:new()}, @@ -236,38 +243,24 @@ expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> %% instead of one for each occurrence as done now. Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || V <- integers(1, Arity)], - Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{op=Fname,args=Vs}}, + Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, expr(Fun, Sub, St); expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; -expr(#c_literal{anno=A,val=Lit}, Sub, #kern{lit=no}=St) -> - %% No constant pools for compatibility with a previous version. - %% Fully expand the literal. - Core = expand_literal(Lit, A), - expr(Core, Sub, St); -expr(#c_literal{}=Lit, Sub, St) -> - Core = handle_literal(Lit), - expr(Core, Sub, St); -expr(#k_literal{val=Val0}=Klit, _Sub, #kern{lit=Literals0}=St) -> - %% Share identical literals to save some space and time during compilation. - case dict:find(Val0, Literals0) of - {ok,Val} -> - {Klit#k_literal{val=Val},[],St}; - error -> - Literals = dict:store(Val0, Val0, Literals0), - {Klit,[],St#kern{lit=Literals}} - end; -expr(#k_nil{}=V, _Sub, St) -> - {V,[],St}; -expr(#k_int{}=V, _Sub, St) -> - {V,[],St}; -expr(#k_float{}=V, _Sub, St) -> - {V,[],St}; -expr(#k_atom{}=V, _Sub, St) -> - {V,[],St}; -expr(#k_string{}=V, _Sub, St) -> - %% Only for compatibility with a previous version. - {V,[],St}; +expr(#c_literal{anno=A,val=V}, _Sub, St) -> + Klit = case V of + [] -> + #k_nil{anno=A}; + V when is_integer(V) -> + #k_int{anno=A,val=V}; + V when is_float(V) -> + #k_float{anno=A,val=V}; + V when is_atom(V) -> + #k_atom{anno=A,val=V}; + _ -> + #k_literal{anno=A,val=V} + end, + {Klit,[],St}; expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> %% Do cons in two steps, first the expressions left to right, then %% any remaining literals right to left. @@ -288,7 +281,7 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> Erl = #c_literal{val=erlang}, Name = #c_literal{val=error}, Args = [#c_literal{val=badarg}], - Error = #c_call{module=Erl,name=Name,args=Args}, + Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, expr(Error, Sub, St0) end; expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) -> @@ -420,11 +413,12 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> {Call,Ap,St} end; expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) -> - Cargs = translate_match_fail(Cargs0, Sub, St0), - %% This special case will disappear. + Cargs = translate_match_fail(Cargs0, Sub, A, St0), {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0), Ar = length(Cargs), - Call = #k_call{anno=A,op=#k_internal{name=match_fail,arity=Ar},args=Kargs}, + Call = #k_call{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=error}, + arity=Ar},args=Kargs}, {Call,Ap,St}; expr(#c_primop{anno=A,name=#c_literal{val=N},args=Cargs}, Sub, St0) -> {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), @@ -447,32 +441,56 @@ expr(#c_catch{anno=A,body=Cb}, Sub, St0) -> %% Handle internal expressions. expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. -%% Translate a function_clause to case_clause if it has been moved into -%% another function. -translate_match_fail([#c_tuple{es=[#c_literal{anno=A0, - val=function_clause}|As]}]=Args, - Sub, - #kern{ff=FF}) -> - A = case A0 of - [{name,{Func0,Arity0}}] -> - [{name,{get_fsub(Func0, Arity0, Sub),Arity0}}]; - _ -> - A0 - end, - case {A,FF} of - {[{name,Same}],Same} -> +%% Translate a function_clause exception to a case_clause exception if +%% it has been moved into another function. (A function_clause exception +%% will not work correctly if it is moved into another function, or +%% even if it is invoked not from the top level in the correct function.) +translate_match_fail(Args, Sub, Anno, St) -> + case Args of + [#c_tuple{es=[#c_literal{val=function_clause}|As]}] -> + translate_match_fail_1(Anno, As, Sub, St); + [#c_literal{val=Tuple}] when is_tuple(Tuple) -> + %% The inliner may have created a literal out of + %% the original #c_tuple{}. + case tuple_to_list(Tuple) of + [function_clause|As0] -> + As = [#c_literal{val=E} || E <- As0], + translate_match_fail_1(Anno, As, Sub, St); + _ -> + Args + end; + _ -> + %% Not a function_clause exception. + Args + end. + +translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> + AnnoFunc = case keyfind(function_name, 1, Anno) of + false -> + none; %Force rewrite. + {function_name,{Name,Arity}} -> + {get_fsub(Name, Arity, Sub),Arity} + end, + case {AnnoFunc,FF} of + {Same,Same} -> %% Still in the correct function. - Args; - {[{name,{F,_}}],F} -> + translate_fc(As); + {{F,_},F} -> %% Still in the correct function. - Args; + translate_fc(As); _ -> - %% Inlining has probably moved the function_clause into another - %% function (where it will not work correctly). - %% Rewrite to a case_clause. - [#c_tuple{es=[#c_literal{val=case_clause},#c_tuple{es=As}]}] - end; -translate_match_fail(Args, _, _) -> Args. + %% Wrong function or no function_name annotation. + %% + %% The inliner has copied the match_fail(function_clause) + %% primop from another function (or from another instance of + %% the current function). match_fail(function_clause) will + %% only work at the top level of the function it was originally + %% defined in, so we will need to rewrite it to a case_clause. + [c_tuple([#c_literal{val=case_clause},c_tuple(As)])] + end. + +translate_fc(Args) -> + [#c_literal{val=function_clause},make_list(Args)]. %% call_type(Module, Function, Arity) -> call | bif | apply | error. %% Classify the call. @@ -583,7 +601,6 @@ is_atomic(#k_int{}) -> true; is_atomic(#k_float{}) -> true; is_atomic(#k_atom{}) -> true; %%is_atomic(#k_char{}) -> true; %No characters -%%is_atomic(#k_string{}) -> true; is_atomic(#k_nil{}) -> true; is_atomic(#k_var{}) -> true; is_atomic(_) -> false. @@ -892,9 +909,8 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) -> true -> %% The true clause body becomes the default. {Kb,Pb,St1} = body(B, Osub, St0), - Line = get_line(A), - St2 = maybe_add_warning(Cs0, Line, St1), - St = maybe_add_warning(Def0, Line, St2), + St2 = maybe_add_warning(Cs0, A, St1), + St = maybe_add_warning(Def0, A, St2), {[],pre_seq(Pb, Kb),St}; false -> {Kg,St1} = guard(G, Osub, St0), @@ -905,15 +921,18 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) -> end; match_guard_1([], Def, St) -> {[],Def,St}. -maybe_add_warning([C|_], Line, St) -> - maybe_add_warning(C, Line, St); -maybe_add_warning([], _Line, St) -> St; -maybe_add_warning(fail, _Line, St) -> St; -maybe_add_warning(Ke, MatchLine, St) -> - case get_kanno(Ke) of - [compiler_generated|_] -> St; - Anno -> +maybe_add_warning([C|_], MatchAnno, St) -> + maybe_add_warning(C, MatchAnno, St); +maybe_add_warning([], _MatchAnno, St) -> St; +maybe_add_warning(fail, _MatchAnno, St) -> St; +maybe_add_warning(Ke, MatchAnno, St) -> + case is_compiler_generated(Ke) of + true -> + St; + false -> + Anno = get_kanno(Ke), Line = get_line(Anno), + MatchLine = get_line(MatchAnno), Warn = case MatchLine of none -> nomatch_shadow; _ -> {nomatch_shadow,MatchLine} @@ -980,11 +999,6 @@ match_var([U|Us], Cs0, Def, St) -> %% according to type, the order is really irrelevant but tries to be %% smart. -match_con(Us, Cs0, Def, #kern{lit=no}=St) -> - %% No constant pool (for compatibility with R11B). - %% We must expand literals. - Cs = [expand_pat_lit_clause(C, true) || C <- Cs0], - match_con_1(Us, Cs, Def, St); match_con(Us, [C], Def, St) -> %% There is only one clause. We can keep literal tuples and %% lists, but we must convert []/integer/float/atom literals @@ -1100,7 +1114,6 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, select_assert_match_possible(Bits, Val, Fl), P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N}, - select_assert_match_possible(Bits, Val, Fl), case member(native, Fl) of true -> throw(not_possible); false -> ok @@ -1148,9 +1161,7 @@ select_bin_int_1(_, _, _, _) -> throw(not_possible). select_assert_match_possible(Sz, Val, Fs) -> EmptyBindings = erl_eval:new_bindings(), - MatchFun = fun({integer,_,_}, NewV, Bs) when NewV =:= Val -> - {match,Bs} - end, + MatchFun = match_fun(Val), EvalFun = fun({integer,_,S}, B) -> {value,S,B} end, Expr = [{bin_element,0,{integer,0,Val},{integer,0,Sz},[{unit,1}|Fs]}], {value,Bin,EmptyBindings} = eval_bits:expr_grp(Expr, EmptyBindings, EvalFun), @@ -1165,6 +1176,11 @@ select_assert_match_possible(Sz, Val, Fs) -> throw(not_possible) end. +match_fun(Val) -> + fun(match, {{integer,_,_},NewV,Bs}) when NewV =:= Val -> + {match,Bs} + end. + select_utf8(Val0) -> try Bin = <<Val0/utf8>>, @@ -1239,8 +1255,6 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) -> sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) -> BinSeg#k_bin_seg{size=Kvar#k_var{name=get_vsub(Name, Sub)}}; -sub_size_var(#k_bin_int{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) -> - BinSeg#k_bin_int{size=Kvar#k_var{name=get_vsub(Name, Sub)}}; sub_size_var(K, _) -> K. get_con([C|_]) -> arg_arg(clause_arg(C)). %Get the constructor @@ -1358,7 +1372,6 @@ arg_con(Arg) -> #k_tuple{} -> k_tuple; #k_binary{} -> k_binary; #k_bin_end{} -> k_bin_end; - #k_bin_int{} -> k_bin_int; #k_bin_seg{} -> k_bin_seg; #k_var{} -> k_var end. @@ -1369,15 +1382,9 @@ arg_val(Arg) -> #k_int{val=I} -> I; #k_float{val=F} -> F; #k_atom{val=A} -> A; - #k_nil{} -> 0; - #k_cons{} -> 2; #k_tuple{es=Es} -> length(Es); #k_bin_seg{size=S,unit=U,type=T,flags=Fs} -> - {set_kanno(S, []),U,T,Fs}; - #k_bin_int{} -> - 0; - #k_bin_end{} -> 0; - #k_binary{} -> 0 + {set_kanno(S, []),U,T,Fs} end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1407,14 +1414,12 @@ ubody(#ivalues{anno=A,args=As}, return, St) -> {#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) -> Au = lit_list_vars(As), - if St#kern.guard_refc > 0 -> + case is_in_guard(St) of + true -> {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; - true -> + false -> {#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St} end; -ubody(#ivalues{anno=A,args=As}, {guard_break,_Vbs}, St) -> - Au = lit_list_vars(As), - {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; ubody(E, return, St0) -> %% Enterable expressions need no trailing return. case is_enter_expr(E) of @@ -1431,12 +1436,7 @@ ubody(E, {break,_Rs} = Break, St0) -> false -> {Ea,Pa,St1} = force_atomic(E, St0), ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1) - end; -ubody(E, {guard_break,_Rs} = GuardBreak, St0) -> - %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), - %% Exiting expressions need no trailing break. - {Ea,Pa,St1} = force_atomic(E, St0), - ubody(pre_seq(Pa, #ivalues{args=[Ea]}), GuardBreak, St1). + end. iletrec_funs(#iletrec{defs=Fs}, St0) -> %% Use union of all free variables. @@ -1474,7 +1474,6 @@ iletrec_funs_gen(Fs, FreeVs, St) -> %% is_exit_expr(Kexpr) -> boolean(). %% Test whether Kexpr always exits and never returns. -is_exit_expr(#k_call{op=#k_internal{name=match_fail,arity=1}}) -> true; is_exit_expr(#k_receive_next{}) -> true; is_exit_expr(_) -> false. @@ -1489,64 +1488,21 @@ is_enter_expr(#k_receive{}) -> true; is_enter_expr(#k_receive_next{}) -> true; is_enter_expr(_) -> false. -%% uguard(Expr, State) -> {Expr,[UsedVar],State}. -%% Tag the guard sequence with its used variables. - -uguard(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, St0) -> - {B1,Bu,St1} = uguard(B0, St0), - {Try#k_try{anno=#k{us=Bu,ns=[],a=A},arg=B1},Bu,St1}; -uguard(T, St) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,T]), - uguard_test(T, St). - -%% uguard_test(Expr, State) -> {Test,[UsedVar],State}. -%% At this stage tests are just expressions which don't return any -%% values. - -uguard_test(T, St) -> uguard_expr(T, [], St). +%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. +%% Tag an expression with its used variables. +%% Break = return | {break,[RetVar]}. -uguard_expr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Rs, St0) -> - Ns = lit_list_vars(Vs), - {E1,Eu,St1} = uguard_expr(E0, Vs, St0), - {B1,Bu,St2} = uguard_expr(B0, Rs, St1), - Used = union(Eu, subtract(Bu, Ns)), - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; -uguard_expr(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, Rs, St0) -> - {B1,Bu,St1} = uguard_expr(B0, Rs, St0), - {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},arg=B1,ret=Rs}, - Bu,St1}; -uguard_expr(#k_test{anno=A,op=Op,args=As}=Test, Rs, St) -> +uexpr(#k_test{anno=A,op=Op,args=As}=Test, {break,Rs}, St) -> [] = Rs, %Sanity check Used = union(op_vars(Op), lit_list_vars(As)), {Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}}, Used,St}; -uguard_expr(#k_bif{anno=A,op=Op,args=As}=Bif, Rs, St) -> - Used = union(op_vars(Op), lit_list_vars(As)), - {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, - Used,St}; -uguard_expr(#ivalues{anno=A,args=As}, Rs, St) -> - Sets = foldr2(fun (V, Arg, Rhs) -> - #iset{anno=A,vars=[V],arg=Arg,body=Rhs} - end, #k_atom{val=true}, Rs, As), - uguard_expr(Sets, [], St); -uguard_expr(#k_match{anno=A,vars=Vs,body=B0}, Rs, St0) -> - %% Experimental support for andalso/orelse in guards. - Br = {guard_break,Rs}, - {B1,Bu,St1} = umatch(B0, Br, St0), - {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1}; -uguard_expr(Lit, Rs, St) -> - %% Transform literals to puts here. - Used = lit_vars(Lit), - {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St}. - -%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. -%% Tag an expression with its used variables. -%% Break = return | {break,[RetVar]}. - +uexpr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, {break,_}=Br, St0) -> + Ns = lit_list_vars(Vs), + {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), + {B1,Bu,St2} = uexpr(B0, Br, St1), + Used = union(Eu, subtract(Bu, Ns)), + {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) -> Free = get_free(F, Ar, St), As1 = As0 ++ Free, %Add free variables LAST! @@ -1578,10 +1534,11 @@ uexpr(#k_match{anno=A,vars=Vs0,body=B0}, Br, St0) -> Vs = handle_reuse_annos(Vs0, St0), Rs = break_rets(Br), {B1,Bu,St1} = umatch(B0, Br, St0), - if St0#kern.guard_refc > 0 -> + case is_in_guard(St1) of + true -> {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, vars=Vs,body=B1,ret=Rs},Bu,St1}; - true -> + false -> {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, vars=Vs,body=B1,ret=Rs},Bu,St1} end; @@ -1598,24 +1555,27 @@ uexpr(#k_receive_accept{anno=A}, _, St) -> {#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St}; uexpr(#k_receive_next{anno=A}, _, St) -> {#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St}; -uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, - {break,Rs0}, St0) -> - {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here - {A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here! - {B1,Bu,St3} = ubody(B0, {break,Rs0}, St2), - {H1,Hu,St4} = ubody(H0, {break,Rs0}, St3), - %% Guarantee ONE return variable. - NumNew = if - Rs0 =:= [] -> 1; - true -> 0 - end, - {Ns,St5} = new_vars(NumNew, St4), - Rs1 = Rs0 ++ Ns, - Used = union([Au,subtract(Bu, lit_list_vars(Vs)), - subtract(Hu, lit_list_vars(Evs))]), - {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A}, - arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1}, - Used,St5}; +uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}=Try, + {break,Rs0}=Br, St0) -> + case is_in_guard(St0) of + true -> + {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion. + #k_atom{val=false} = H0, %Assertion. + {A1,Bu,St1} = uexpr(A0, Br, St0), + {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, + arg=A1,ret=Rs0},Bu,St1}; + false -> + {Avs,St1} = new_vars(length(Vs), St0), + {A1,Au,St2} = ubody(A0, {break,Avs}, St1), + {B1,Bu,St3} = ubody(B0, Br, St2), + {H1,Hu,St4} = ubody(H0, Br, St3), + {Rs1,St5} = ensure_return_vars(Rs0, St4), + Used = union([Au,subtract(Bu, lit_list_vars(Vs)), + subtract(Hu, lit_list_vars(Evs))]), + {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A}, + arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1}, + Used,St5} + end; uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, return, St0) -> {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here @@ -1636,37 +1596,38 @@ uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) -> {Ns,St3} = new_vars(1 - length(Rs0), St2), Rs1 = Rs0 ++ Ns, {#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3}; -uexpr(#ifun{anno=A,vars=Vs,body=B0}=IFun, {break,Rs}, St0) -> +uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> {B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function Ns = lit_list_vars(Vs), Free = subtract(Bu, Ns), %Free variables in fun Fvs = make_vars(Free), Arity = length(Vs) + length(Free), - {{Index,Uniq,Fname}, St3} = + {Fname,St} = case lists:keyfind(id, 1, A) of - {id,Id} -> - {Id, St1}; + {id,{_,_,Fname0}} -> + {Fname0,St1}; false -> - %% No id annotation. Must invent one. - I = St1#kern.fcount, - U = erlang:hash(IFun, (1 bsl 27)-1), - {N, St2} = new_fun_name(St1), - {{I,U,N}, St2} + %% No id annotation. Must invent a fun name. + new_fun_name(St1) end, Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity, vars=Vs ++ Fvs,body=B1}, + %% Set dummy values for Index and Uniq -- the real values will + %% be assigned by beam_asm. + Index = Uniq = 0, {#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A}, op=#k_internal{name=make_fun,arity=length(Free)+3}, args=[#k_atom{val=Fname},#k_int{val=Arity}, #k_int{val=Index},#k_int{val=Uniq}|Fvs], ret=Rs}, - Free,add_local_function(Fun, St3)}; -uexpr(Lit, {break,Rs}, St) -> + Free,add_local_function(Fun, St)}; +uexpr(Lit, {break,Rs0}, St0) -> %% Transform literals to puts here. %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), Used = lit_vars(Lit), + {Rs,St1} = ensure_return_vars(Rs0, St0), {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St}. + arg=Lit,ret=Rs},Used,St1}. add_local_function(_, #kern{funs=ignore}=St) -> St; add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}. @@ -1723,6 +1684,11 @@ bif_returns(#k_internal{name=N,arity=Ar}, Rs, St0) -> {Ns,St1} = new_vars(bif_vals(N, Ar) - length(Rs), St0), {Rs ++ Ns,St1}. +%% ensure_return_vars([Ret], State) -> {[Ret],State}. + +ensure_return_vars([], St) -> new_vars(1, St); +ensure_return_vars([_]=Rs, St) -> {Rs,St}. + %% umatch(Match, Break, State) -> {Match,[UsedVar],State}. %% Tag a match expression with its used variables. @@ -1755,7 +1721,8 @@ umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) -> {#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1}; umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) -> %%ok = io:fwrite("~w: ~p~n", [?LINE,G0]), - {G1,Gu,St1} = uguard(G0, St0#kern{guard_refc=St0#kern.guard_refc+1}), + {G1,Gu,St1} = uexpr(G0, {break,[]}, + St0#kern{guard_refc=St0#kern.guard_refc+1}), %%ok = io:fwrite("~w: ~p~n", [?LINE,G1]), {B1,Bu,St2} = umatch(B0, Br, St1#kern{guard_refc=St1#kern.guard_refc-1}), Used = union(Gu, Bu), @@ -1783,7 +1750,6 @@ lit_vars(#k_int{}) -> []; lit_vars(#k_float{}) -> []; lit_vars(#k_atom{}) -> []; %%lit_vars(#k_char{}) -> []; -lit_vars(#k_string{}) -> []; lit_vars(#k_nil{}) -> []; lit_vars(#k_cons{hd=H,tl=T}) -> union(lit_vars(H), lit_vars(T)); @@ -1804,7 +1770,6 @@ lit_list_vars(Ps) -> pat_vars(#k_var{name=N}) -> {[],[N]}; %%pat_vars(#k_char{}) -> {[],[]}; -%%pat_vars(#k_string{}) -> {[],[]}; pat_vars(#k_literal{}) -> {[],[]}; pat_vars(#k_int{}) -> {[],[]}; pat_vars(#k_float{}) -> {[],[]}; @@ -1831,62 +1796,6 @@ pat_list_vars(Ps) -> {union(Used0, Used),union(New0, New)} end, {[],[]}, Ps). -%% handle_literal(Literal, Anno) -> Kernel -%% Examine the literal. Complex (heap-based) literals such as lists, -%% tuples, and binaries should be kept as literals and put into the constant pool. -%% -%% (If necessary, this function could be extended to go through the literal -%% and convert huge binary literals to bit syntax expressions. We don't do that -%% because v3_core does not produce huge binary literals, and the optimizations in -%% sys_core_fold don't do much optimizations of binaries. IF THAT CHANGE IS MADE, -%% ALSO CHANGE sys_core_dsetel.) - -handle_literal(#c_literal{anno=A,val=V}) -> - case V of - [_|_] -> - #k_literal{anno=A,val=V}; - V when is_tuple(V) -> - #k_literal{anno=A,val=V}; - V when is_bitstring(V) -> - #k_literal{anno=A,val=V}; - _ -> - expand_literal(V, A) - end. - -%% expand_literal(Literal, Anno) -> CoreTerm | KernelTerm -%% Fully expand the literal. Atomic terms such as integers are directly -%% translated to the Kernel Erlang format, while complex terms are kept -%% in the Core Erlang format (but the content is recursively processed). - -expand_literal([H|T]=V, A) when is_integer(H), 0 =< H, H =< 255 -> - case is_print_char_list(T) of - false -> - #c_cons{anno=A,hd=#k_int{anno=A,val=H},tl=expand_literal(T, A)}; - true -> - #k_string{anno=A,val=V} - end; -expand_literal([H|T], A) -> - #c_cons{anno=A,hd=expand_literal(H, A),tl=expand_literal(T, A)}; -expand_literal([], A) -> - #k_nil{anno=A}; -expand_literal(V, A) when is_tuple(V) -> - #c_tuple{anno=A,es=expand_literal_list(tuple_to_list(V), A)}; -expand_literal(V, A) when is_integer(V) -> - #k_int{anno=A,val=V}; -expand_literal(V, A) when is_float(V) -> - #k_float{anno=A,val=V}; -expand_literal(V, A) when is_atom(V) -> - #k_atom{anno=A,val=V}. - -expand_literal_list([H|T], A) -> - [expand_literal(H, A)|expand_literal_list(T, A)]; -expand_literal_list([], _) -> []. - -is_print_char_list([H|T]) when is_integer(H), 0 =< H, H =< 255 -> - is_print_char_list(T); -is_print_char_list([]) -> true; -is_print_char_list(_) -> false. - make_list(Es) -> foldr(fun(E, Acc) -> #c_cons{hd=E,tl=Acc} @@ -1898,6 +1807,11 @@ integers(N, M) when N =< M -> [N|integers(N + 1, M)]; integers(_, _) -> []. +%% is_in_guard(State) -> true|false. + +is_in_guard(#kern{guard_refc=Refc}) -> + Refc > 0. + %%% %%% Handling of errors and warnings. %%% @@ -1918,7 +1832,10 @@ format_error(bad_call) -> add_warning(none, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), St#kern{ws=[{File,[{?MODULE,Term}]}|Ws]}; -add_warning(Line, Term, Anno, #kern{ws=Ws}=St) when Line >= 0 -> +add_warning(Line, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), - St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}; -add_warning(_, _, _, St) -> St. + St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}. + +is_compiler_generated(Ke) -> + Anno = get_kanno(Ke), + member(compiler_generated, Anno). diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index 37f2fdcf7e..fb8baf398b 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -35,7 +35,6 @@ -record(k_int, {anno=[],val}). -record(k_float, {anno=[],val}). -record(k_atom, {anno=[],val}). --record(k_string, {anno=[],val}). -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index b1ca907d11..e363a5387a 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -1,29 +1,31 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Kernel Erlang (naive) prettyprinter -module(v3_kernel_pp). --include("v3_kernel.hrl"). - -export([format/1]). +%%-define(INCLUDE_ANNOTATIONS, 1). + +-include("v3_kernel.hrl"). + %% These are "internal" structures in sys_kernel which are here for %% debugging purposes. -record(iset, {anno=[],vars,arg,body}). @@ -50,28 +52,33 @@ format(Node) -> format(Node, #ctxt{}). format(Node, Ctxt) -> case canno(Node) of -%% [] -> -%% format_1(Node, Ctxt); -%% [L,{file,_}] when is_integer(L) -> -%% format_1(Node, Ctxt); -%% #k{a=Anno}=K when Anno =/= [] -> -%% format(setelement(2, Node, K#k{a=[]}), Ctxt); -%% List -> -%% format_anno(List, Ctxt, fun (Ctxt1) -> -%% format_1(Node, Ctxt1) -%% end); - _ -> - format_1(Node, Ctxt) + [] -> + format_1(Node, Ctxt); + [L,{file,_}] when is_integer(L) -> + format_1(Node, Ctxt); + #k{a=Anno}=K when Anno =/= [] -> + format(setelement(2, Node, K#k{a=[]}), Ctxt); + List -> + format_anno(List, Ctxt, fun (Ctxt1) -> + format_1(Node, Ctxt1) + end) end. -%% format_anno(Anno, Ctxt0, ObjFun) -> -%% Ctxt1 = ctxt_bump_indent(Ctxt0, 1), -%% ["( ", -%% ObjFun(Ctxt0), -%% nl_indent(Ctxt1), -%% "-| ",io_lib:write(Anno), -%% " )"]. - + +-ifndef(INCLUDE_ANNOTATIONS). +%% Don't include annotations (for readability). +format_anno(_Anno, Ctxt, ObjFun) -> + ObjFun(Ctxt). +-else. +%% Include annotations (for debugging of annotations). +format_anno(Anno, Ctxt0, ObjFun) -> + Ctxt1 = ctxt_bump_indent(Ctxt0, 1), + ["( ", + ObjFun(Ctxt0), + nl_indent(Ctxt1), + "-| ",io_lib:write(Anno), + " )"]. +-endif. %% format_1(Kexpr, Context) -> string(). @@ -80,7 +87,6 @@ format_1(#k_atom{val=A}, _Ctxt) -> core_atom(A); format_1(#k_float{val=F}, _Ctxt) -> float_to_list(F); format_1(#k_int{val=I}, _Ctxt) -> integer_to_list(I); format_1(#k_nil{}, _Ctxt) -> "[]"; -format_1(#k_string{val=S}, _Ctxt) -> io_lib:write_string(S); format_1(#k_var{name=V}, _Ctxt) -> if is_atom(V) -> case atom_to_list(V) of @@ -108,6 +114,8 @@ format_1(#k_bin_int{size=Sz,unit=U,flags=Fs,val=Val,next=Next}, Ctxt) -> [format_bin_seg_1(S, Ctxt), format_bin_seg(Next, ctxt_bump_indent(Ctxt, 2))]; format_1(#k_bin_end{}, _Ctxt) -> "#<>#"; +format_1(#k_literal{val=Term}, _Ctxt) -> + io_lib:format("~p", [Term]); format_1(#k_local{name=N,arity=A}, Ctxt) -> "local " ++ format_fa_pair({N,A}, Ctxt); format_1(#k_remote{mod=M,name=N,arity=A}, _Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 0adeaca8fa..2cc3493570 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Convert annotated kernel expressions to annotated beam format. @@ -65,37 +65,32 @@ functions([], Acc) -> reverse(Acc). %% function(Kfunc) -> Func. -function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> - %ok = io:fwrite("life ~w: ~p~n~p~n", [?LINE,{F,Ar},Kb]), - As = var_list(Vs), - Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), - %% Force a top-level match! - B0 = case Kb of - #k_match{} -> Kb; - _ -> - Ka = get_kanno(Kb), - #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, - vars=Vs,body=Kb,ret=[]} - end, - put(guard_refc, 0), - {B1,_,Vdb1} = body(B0, 1, Vdb0), - erase(guard_refc), - {function,F,Ar,As,B1,Vdb1}. +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), + %% Force a top-level match! + B0 = case Kb of + #k_match{} -> Kb; + _ -> + Ka = get_kanno(Kb), + #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, + vars=Vs,body=Kb,ret=[]} + end, + put(guard_refc, 0), + {B1,_,Vdb1} = body(B0, 1, Vdb0), + erase(guard_refc), + {function,F,Ar,As,B1,Vdb1,Anno} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [F,Ar]), + erlang:raise(Class, Error, Stack) + end. %% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. -%% Handle a body, need special cases for transforming match_fails. -%% We KNOW that they only occur last in a body. - -body(#k_seq{arg=#k_put{anno=Pa,arg=Arg,ret=[R]}, - body=#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1}, - args=[R]}}, - I, Vdb0) -> - Vdb1 = use_vars(Pa#k.us, I, Vdb0), %All used here - {[match_fail(Arg, I, Pa#k.a ++ Ea#k.a)],I,Vdb1}; -body(#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1},args=[Arg]}, - I, Vdb0) -> - Vdb1 = use_vars(Ea#k.us, I, Vdb0), - {[match_fail(Arg, I, Ea#k.a)],I,Vdb1}; +%% Handle a body. + body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), A = get_kanno(Ke), @@ -117,53 +112,14 @@ guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X}, %% Lock variables that are alive before try and used afterwards. %% Don't lock variables that are only used inside the try expression. Pdb0 = vdb_sub(I, I+1, Vdb), - {T,MaxI,Pdb1} = guard_body(Ts, I+1, Pdb0), + {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values - #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}; -guard(#k_seq{}=G, I, Vdb0) -> - {Es,_,Vdb1} = guard_body(G, I, Vdb0), - #l{ke={block,Es},i=I,vdb=Vdb1,a=[]}; -guard(G, I, Vdb) -> guard_expr(G, I, Vdb). - -%% guard_body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. - -guard_body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - {Es,MaxI,Vdb2} = guard_body(Kb, I+1, Vdb1), - E = guard_expr(Ke, I, Vdb2), - {[E|Es],MaxI,Vdb2}; -guard_body(Ke, I, Vdb0) -> - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - E = guard_expr(Ke, I, Vdb1), - {[E],I,Vdb1}. - -%% guard_expr(Call, I, Vdb) -> Expr - -guard_expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a}; -guard_expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - Name = bif_op(Op), - Ar = length(As), - case is_gc_bif(Name, Ar) of - false -> - #l{ke={bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; - true -> - #l{ke={gc_bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a} - end; -guard_expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) -> - #l{ke={set,var_list(Rs),literal(Arg, [])},i=I,a=A#k.a}; -guard_expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Support for andalso/orelse in guards. - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, [], Mdb), - #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -guard_expr(G, I, Vdb) -> guard(G, I, Vdb). + #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}. %% expr(Kexpr, I, Vdb) -> Expr. +expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) -> + #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a}; expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) -> @@ -181,25 +137,11 @@ expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> Mdb = vdb_sub(I, I+1, Vdb), M = match(Kb, A#k.us, I+1, [], Mdb), #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% 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)), - 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)), - #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=[]}, - var_list(Rs)}, - i=I,vdb=Tdb1,a=A#k.a}; +expr(#k_try{}=Try, I, Vdb) -> + case is_in_guard() of + false -> body_try(Try, I, Vdb); + true -> guard(Try, I, Vdb) + end; expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> %% Lock variables that are alive before the catch and used afterwards. %% Don't lock variables that are only used inside the try. @@ -248,6 +190,27 @@ expr(#k_guard_break{anno=A,args=As}, I, Vdb) -> expr(#k_return{anno=A,args=As}, I, _Vdb) -> #l{ke={return,atomic_list(As)},i=I,a=A#k.a}. +body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, + I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the try. + Tdb0 = vdb_sub(I, I+1, Vdb), + %% This is the tricky bit. Lock variables in Arg that are used in + %% 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)), + 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)), + #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=[]}, + var_list(Rs)}, + i=I,vdb=Tdb1,a=A#k.a}. + %% call_op(Op) -> Op. %% bif_op(Op) -> Op. %% test_op(Op) -> Op. @@ -347,27 +310,6 @@ guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1), a=A#k.a}. -%% match_fail(FailValue, I, Anno) -> Expr. -%% Generate the correct match_fail instruction. N.B. there is no -%% generic case for when the fail value has been created elsewhere. - -match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) -> - match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A); -match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) -> - match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A); -match_fail(#k_literal{anno=Anno,val=Atom}, I, A) when is_atom(Atom) -> - match_fail(#k_atom{anno=Anno,val=Atom}, I, A); -match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) -> - #l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) -> - #l{ke={match_fail,{badmatch,literal(Val, [])}},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=case_clause},Val]}, I, A) -> - #l{ke={match_fail,{case_clause,literal(Val, [])}},i=I,a=A}; -match_fail(#k_atom{val=if_clause}, I, A) -> - #l{ke={match_fail,if_clause},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=try_clause},Val]}, I, A) -> - #l{ke={match_fail,{try_clause,literal(Val, [])}},i=I,a=A}. - %% type(Ktype) -> Type. type(k_literal) -> literal; @@ -399,7 +341,6 @@ atomic(#k_int{val=I}) -> {integer,I}; atomic(#k_float{val=F}) -> {float,F}; atomic(#k_atom{val=N}) -> {atom,N}; %%atomic(#k_char{val=C}) -> {char,C}; -%%atomic(#k_string{val=S}) -> {string,S}; atomic(#k_nil{}) -> nil. atomic_list(Ks) -> [atomic(K) || K <- Ks]. @@ -412,7 +353,6 @@ literal(#k_int{val=I}, _) -> {integer,I}; literal(#k_float{val=F}, _) -> {float,F}; literal(#k_atom{val=N}, _) -> {atom,N}; %%literal(#k_char{val=C}, _) -> {char,C}; -literal(#k_string{val=S}, _) -> {string,S}; literal(#k_nil{}, _) -> nil; literal(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; @@ -437,7 +377,6 @@ 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_string{val=S}, _) -> {string,S}; literal2(#k_nil{}, _) -> nil; literal2(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]}; @@ -563,3 +502,7 @@ vdb_sub(Min, Max, Vdb) -> true -> Vd end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ]. +%% is_in_guard() -> true|false. + +is_in_guard() -> + get(guard_refc) > 0. |