diff options
Diffstat (limited to 'lib/compiler/src')
30 files changed, 1096 insertions, 718 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 1238d113e1..958d3501c7 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2011. All Rights Reserved. +# Copyright Ericsson AB 1996-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 @@ -53,12 +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 \ @@ -161,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 89d64834cf..a7c8508321 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.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 @@ -23,7 +23,7 @@ -export([module/4]). -export([encode/2]). --import(lists, [map/2,member/2,keymember/3,duplicate/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,7 +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, Attr, Essentials) -> +build_attributes(Opts, SourceFile, Attr, MD5) -> Misc = case member(slim, Opts) of false -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), @@ -199,7 +230,32 @@ build_attributes(Opts, SourceFile, Attr, 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 @@ -207,32 +263,30 @@ build_attributes(Opts, SourceFile, Attr, 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}; @@ -243,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); @@ -271,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 c45874597a..cd568097fa 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. 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 @@ -36,13 +36,14 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% Collect basic blocks and optimize them. Is2 = blockify(Is1), - Is3 = move_allocates(Is2), - Is4 = beam_utils:live_opt(Is3), - Is5 = opt_blocks(Is4), - Is6 = beam_utils:delete_live_annos(Is5), + 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(Is6, Lc0), + {Is,Lc} = bsm_opt(Is7, Lc0), %% Done. {{function,Name,Arity,CLabel,Is},Lc} @@ -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, @@ -225,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_bsm.erl b/lib/compiler/src/beam_bsm.erl index 415864b8e9..1217f7f777 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -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)). 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 1365f3d20a..5f12a98f09 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -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,62 +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. - -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([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. @@ -406,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) @@ -471,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}; _ -> diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index c50ed28aa9..531968b3c8 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -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(). @@ -36,6 +37,9 @@ strings = <<>> :: binary(), %String pool lambdas = [], %[{...}] literals = dict:new() :: dict(), %Format: {Literal,Number} + 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(), @@ -129,13 +133,18 @@ string(Str, Dict) when is_list(Str) -> {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}}. @@ -152,6 +161,36 @@ 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(),...]]}. @@ -219,6 +258,21 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> my_term_to_binary(Term) -> term_to_binary(Term, [{minor_version,1}]). +%% 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(binary(), binary()) -> 'none' | pos_integer(). diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 5c4d8e12b5..62bdc74cc8 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. 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 @@ -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,7 +202,7 @@ 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) -> @@ -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 @@ -1105,6 +1108,12 @@ 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_jump.erl b/lib/compiler/src/beam_jump.erl index 3cab55c4cb..db67d24514 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. 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 @@ -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. @@ -454,6 +464,7 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; + {line,_} -> false; _ when is_atom(Info) -> false end. @@ -487,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_receive.erl b/lib/compiler/src/beam_receive.erl index 9ed44ad5d7..bd1f44f66b 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% 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 @@ -175,6 +175,8 @@ opt_update_regs({label,Lbl}, 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}. 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 f83f73b224..7392f99fb6 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.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 @@ -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. @@ -168,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), @@ -400,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 45cdf8a659..194f089ba1 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. 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 @@ -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]. @@ -470,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 @@ -499,6 +510,8 @@ check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], 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|_] -> @@ -728,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]); @@ -789,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) -> @@ -799,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 fb267b35b6..29758b8fb4 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-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 @@ -166,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) -> @@ -292,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}. @@ -433,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 @@ -661,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), @@ -764,15 +783,27 @@ valfun_4({bs_utf16_size,{f,Fail},A,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), @@ -870,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_inline.erl b/lib/compiler/src/cerl_inline.erl index c15103999f..2e7554c1ff 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. 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 @@ -1262,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 [] -> @@ -1276,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 diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index e46c667e47..0a368df5d6 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -146,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) -> @@ -172,9 +179,11 @@ expand_opt(report, Os) -> expand_opt(return, Os) -> [return_errors,return_warnings|Os]; expand_opt(r12, Os) -> - [no_recv_opt|Os]; + [no_recv_opt,no_line_info|Os]; expand_opt(r13, Os) -> - [no_recv_opt|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_float_opt, Os) -> @@ -235,21 +244,20 @@ format_error({module_name,Mod,Filename}) -> code=[], core_code=[], abstract_code=[], %Abstract code for debugger. - options=[] :: [option()], + 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) -> {Ext,Ps} = passes(file, Opts), - Compile = #compile{options=Opts}, + Compile = #compile{options=Opts,mod_options=Opts}, internal_comp(Ps, File, Ext, Compile). internal_comp(Passes, File, Suffix, St0) -> @@ -625,11 +633,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"}}, @@ -1228,12 +1240,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. @@ -1303,15 +1316,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, @@ -1438,6 +1459,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). @@ -1510,6 +1533,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 4ac879c9a4..1133882728 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -1,7 +1,7 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. 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 @@ -28,12 +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/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index f8128702dd..9ad2378d00 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. 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 @@ -72,7 +72,6 @@ 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; @@ -137,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 63527bda8f..75ac91907a 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1998-2010. 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 @@ -280,3 +280,7 @@ BEAM_FORMAT_NUMBER=0 150: recv_mark/1 151: recv_set/1 152: gc_bif3/7 + +# R15A + +153: line/1 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 6ea67741fa..18fba7962b 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. 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 @@ -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; @@ -1747,36 +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{anno=Anno,module=#c_literal{val=erlang}, name=#c_literal{val='not'}, args=[Expr]} -> - Cs = opt_bool_not(Anno, 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(Anno, 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{anno=Anno, - 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}]}. @@ -2065,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 @@ -2612,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 @@ -2641,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 @@ -2704,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. @@ -2764,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. @@ -2793,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}))). 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 249bd7a8e7..97d3ff626c 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-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-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 @@ -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) -> @@ -506,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), @@ -690,4 +723,4 @@ imported(F, A, St) -> end. defined(F, A, St) -> - ordsets:is_element({F,A}, St#expand.defined). + 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 55e3c58d2a..812e85553f 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. 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 @@ -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) -> @@ -293,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 @@ -406,6 +370,7 @@ bsm_rename_ctx(#l{ke={test,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L; +bsm_rename_ctx(#l{ke={call,_,_,_}}=L, _, _, _) -> L; bsm_rename_ctx(#l{ke={block,_}}=L, Old, _, false) -> %% This block is not inside a protected. The match context variable cannot %% possibly be live inside the block. @@ -1047,7 +1012,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; @@ -1057,11 +1022,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 -> @@ -1091,7 +1055,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) -> @@ -1118,7 +1082,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) @@ -1127,9 +1091,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) -> @@ -1137,7 +1100,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}. @@ -1153,6 +1117,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. @@ -1226,9 +1207,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, @@ -1237,7 +1219,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}. @@ -1266,7 +1255,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, @@ -1284,7 +1277,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}}. @@ -1431,20 +1424,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> 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. @@ -1463,12 +1443,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; @@ -2052,6 +2033,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 87bb5bec25..01042cc56f 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. 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 @@ -180,7 +180,7 @@ body(Cs0, Name, Arity, 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. @@ -507,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), @@ -541,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}, @@ -572,6 +573,13 @@ 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}, #core{wanted=Wanted}=St0) -> @@ -607,8 +615,8 @@ expr({match,L,P0,E0}, St0) -> Thrown end, {Fpat,St4} = new_var(St3), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])), 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, St4), @@ -815,6 +823,13 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> {_,_} -> throw(bad_binary) end, + case Size1 of + #c_var{} -> ok; + #c_literal{val=Sz} when is_integer(Sz), Sz >= 0 -> ok; + #c_literal{val=undefined} -> ok; + #c_literal{val=all} -> ok; + _ -> throw(bad_binary) + end, {#c_bitstr{val=E1,size=Size1, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, @@ -828,8 +843,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}. @@ -929,7 +945,7 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> [],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 -> @@ -945,7 +961,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, @@ -1072,7 +1089,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> [],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 -> @@ -1089,7 +1106,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, @@ -1562,17 +1580,11 @@ 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) -> - function_clause(Ps, [], Name). - function_clause(Ps, LineAnno, Name) -> - FcAnno = [{function_name,Name}], + FcAnno = [{function_name,Name}|LineAnno], fail_clause(Ps, FcAnno, ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])). -fail_clause(Pats, Arg) -> - fail_clause(Pats, [], Arg). - fail_clause(Pats, Anno, Arg) -> #iclause{anno=#a{anno=[compiler_generated]}, pats=Pats,guard=[], @@ -2080,7 +2092,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 diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 3b33a08cf7..b184987625 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.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 @@ -83,14 +83,11 @@ -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). @@ -121,7 +118,6 @@ 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()]) -> @@ -130,7 +126,7 @@ copy_anno(Kdst, Ksrc) -> 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), - St0 = #kern{lit=dict:new()}, + 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)}. @@ -247,30 +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{}=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(#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,11 +278,12 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> {#k_binary{anno=A,segs=Kv},Ep,St1} catch throw:bad_element_size -> + St1 = add_warning(get_line(A), bad_segment_size, A, 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}, - expr(Error, Sub, St0) + Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, + expr(Error, Sub, St1) end; expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) -> FA = case OldFF of @@ -424,10 +415,11 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> end; expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) -> Cargs = translate_match_fail(Cargs0, Sub, A, St0), - %% This special case will disappear. {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), @@ -457,14 +449,14 @@ expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. translate_match_fail(Args, Sub, Anno, St) -> case Args of [#c_tuple{es=[#c_literal{val=function_clause}|As]}] -> - translate_match_fail_1(Anno, Args, As, Sub, St); + 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, Args, As, Sub, St); + translate_match_fail_1(Anno, As, Sub, St); _ -> Args end; @@ -473,7 +465,7 @@ translate_match_fail(Args, Sub, Anno, St) -> Args end. -translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) -> +translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> AnnoFunc = case keyfind(function_name, 1, Anno) of false -> none; %Force rewrite. @@ -483,10 +475,10 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) -> case {AnnoFunc,FF} of {Same,Same} -> %% Still in the correct function. - Args; + translate_fc(As); {{F,_},F} -> %% Still in the correct function. - Args; + translate_fc(As); _ -> %% Wrong function or no function_name annotation. %% @@ -495,9 +487,12 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) -> %% 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{es=[#c_literal{val=case_clause},#c_tuple{es=As}]}] + [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. call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) -> @@ -607,7 +602,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. @@ -916,9 +910,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), @@ -929,15 +922,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} @@ -1119,7 +1115,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 @@ -1167,9 +1162,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), @@ -1184,6 +1177,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>>, @@ -1258,8 +1256,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 @@ -1377,7 +1373,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. @@ -1388,15 +1383,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] @@ -1426,14 +1415,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 @@ -1450,12 +1437,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. @@ -1493,7 +1475,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. @@ -1508,64 +1489,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! @@ -1597,10 +1535,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; @@ -1617,24 +1556,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 @@ -1655,37 +1597,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]}. @@ -1742,6 +1685,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. @@ -1774,7 +1722,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), @@ -1822,7 +1771,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{}) -> {[],[]}; @@ -1849,34 +1797,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}; - [] -> - #k_nil{anno=A}; - V when is_tuple(V) -> - #k_literal{anno=A,val=V}; - V when is_bitstring(V) -> - #k_literal{anno=A,val=V}; - 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} - end. - make_list(Es) -> foldr(fun(E, Acc) -> #c_cons{hd=E,tl=Acc} @@ -1888,6 +1808,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. %%% @@ -1903,12 +1828,17 @@ format_error({nomatch_shadow,Line}) -> format_error(nomatch_shadow) -> "this clause cannot match because a previous clause always matches"; format_error(bad_call) -> - "invalid module and/or function name; this call will always fail". + "invalid module and/or function name; this call will always fail"; +format_error(bad_segment_size) -> + "binary construction will fail because of a type mismatch". 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_life.erl b/lib/compiler/src/v3_life.erl index a7a4d4dc91..2cc3493570 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.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 @@ -65,7 +65,7 @@ functions([], Acc) -> reverse(Acc). %% function(Kfunc) -> Func. -function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> +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), @@ -80,7 +80,7 @@ function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> put(guard_refc, 0), {B1,_,Vdb1} = body(B0, 1, Vdb0), erase(guard_refc), - {function,F,Ar,As,B1,Vdb1} + {function,F,Ar,As,B1,Vdb1,Anno} catch Class:Error -> Stack = erlang:get_stacktrace(), @@ -89,19 +89,8 @@ function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> 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), @@ -123,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) -> @@ -187,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. @@ -254,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. @@ -353,25 +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_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; @@ -403,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]. @@ -565,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. |