diff options
Diffstat (limited to 'lib/compiler/src')
| -rw-r--r-- | lib/compiler/src/Makefile | 1 | ||||
| -rw-r--r-- | lib/compiler/src/beam_asm.erl | 18 | ||||
| -rw-r--r-- | lib/compiler/src/beam_block.erl | 12 | ||||
| -rw-r--r-- | lib/compiler/src/beam_disasm.erl | 18 | ||||
| -rw-r--r-- | lib/compiler/src/beam_flatten.erl | 11 | ||||
| -rw-r--r-- | lib/compiler/src/beam_jump.erl | 11 | ||||
| -rw-r--r-- | lib/compiler/src/beam_receive.erl | 388 | ||||
| -rw-r--r-- | lib/compiler/src/beam_type.erl | 14 | ||||
| -rw-r--r-- | lib/compiler/src/beam_validator.erl | 5 | ||||
| -rw-r--r-- | lib/compiler/src/cerl_clauses.erl | 25 | ||||
| -rw-r--r-- | lib/compiler/src/cerl_inline.erl | 42 | ||||
| -rw-r--r-- | lib/compiler/src/compile.erl | 13 | ||||
| -rw-r--r-- | lib/compiler/src/compiler.app.src | 11 | ||||
| -rw-r--r-- | lib/compiler/src/genop.tab | 17 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_dsetel.erl | 12 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 27 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_inline.erl | 29 | ||||
| -rw-r--r-- | lib/compiler/src/v3_codegen.erl | 24 | ||||
| -rw-r--r-- | lib/compiler/src/v3_core.erl | 94 | ||||
| -rw-r--r-- | lib/compiler/src/v3_kernel.erl | 161 | ||||
| -rw-r--r-- | lib/compiler/src/v3_kernel_pp.erl | 11 | ||||
| -rw-r--r-- | lib/compiler/src/v3_life.erl | 48 |
22 files changed, 710 insertions, 282 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 70ddd54145..0f6d2f6193 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -58,6 +58,7 @@ MODULES = \ beam_listing \ beam_opcodes \ beam_peep \ + beam_receive \ beam_trim \ beam_type \ beam_utils \ diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 497c4fa07b..115c228b0a 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Assembler for threaded Beam. @@ -23,7 +23,7 @@ -export([module/4]). -export([encode/2]). --import(lists, [map/2,member/2,keymember/3,duplicate/2,filter/2]). +-import(lists, [map/2,member/2,keymember/3,duplicate/2]). -include("beam_opcodes.hrl"). module(Code, Abst, SourceFile, Opts) -> @@ -191,11 +191,7 @@ flatten_exports(Exps) -> flatten_imports(Imps) -> list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)). -build_attributes(Opts, SourceFile, Attr0, Essentials) -> - Attr = filter(fun({type,_}) -> false; - ({spec,_}) -> false; - (_) -> true - end, Attr0), +build_attributes(Opts, SourceFile, Attr, Essentials) -> Misc = case member(slim, Opts) of false -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(), diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index d4a4ddca8a..32703b4dd1 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Partitions assembly instructions into basic blocks and @@ -140,7 +140,6 @@ collect({move,S,D}) -> {set,[D],[S],move}; collect({put_list,S1,S2,D}) -> {set,[D],[S1,S2],put_list}; collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}}; collect({put,S}) -> {set,[],[S],put}; -collect({put_string,L,S,D}) -> {set,[D],[],{put_string,L,S}}; collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}}; collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}}; collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; @@ -204,7 +203,6 @@ alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; alloc_may_pass({set,_,_,{put_tuple,_}}) -> false; alloc_may_pass({set,_,_,put}) -> false; -alloc_may_pass({set,_,_,{put_string,_,_}}) -> false; alloc_may_pass({set,_,_,_}) -> true. combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index c956f2f000..9571f817e3 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %%======================================================================= %% Notes: @@ -1096,6 +1096,14 @@ resolve_inst({on_load,[]},_,_,_) -> on_load; %% +%% R14A. +%% +resolve_inst({recv_mark,[Lbl]},_,_,_) -> + {recv_mark,Lbl}; +resolve_inst({recv_set,[Lbl]},_,_,_) -> + {recv_set,Lbl}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index d9de7e2495..6c7cb849aa 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Converts intermediate assembly code to final format. @@ -57,7 +57,6 @@ norm({set,[D],[S],fconv}) -> {fconv,S,D}; norm({set,[D],[S1,S2],put_list}) -> {put_list,S1,S2,D}; norm({set,[D],[],{put_tuple,A}}) -> {put_tuple,A,D}; norm({set,[],[S],put}) -> {put,S}; -norm({set,[D],[],{put_string,L,S}}) -> {put_string,L,S,D}; norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D}; norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 739928f411..3cab55c4cb 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %%% Purpose : Optimise jumps and remove unreachable code. @@ -452,7 +452,6 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> {'catch',{f,F}} -> F =:= Lbl; {alloc,_,_} -> false; {put_tuple,_} -> false; - {put_string,_,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; _ when is_atom(Info) -> false diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl new file mode 100644 index 0000000000..9ed44ad5d7 --- /dev/null +++ b/lib/compiler/src/beam_receive.erl @@ -0,0 +1,388 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_receive). +-export([module/2]). +-import(lists, [foldl/3,reverse/1,reverse/2]). + +%%% +%%% In code such as: +%%% +%%% Ref = make_ref(), %Or erlang:monitor(process, Pid) +%%% . +%%% . +%%% . +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% we know that none of the messages that exist in the message queue +%%% before the call to make_ref/0 can be matched out in the receive +%%% statement. Therefore we can avoid going through the entire message +%%% queue if we introduce two new instructions (here written as +%%% BIFs in pseudo-Erlang): +%%% +%%% recv_mark(SomeUniqInteger), +%%% Ref = make_ref(), +%%% . +%%% . +%%% . +%%% recv_set(SomeUniqInteger), +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% The recv_mark/1 instruction will save the current position and +%%% SomeUniqInteger in the process context. The recv_set +%%% instruction will verify that SomeUniqInteger is still stored +%%% in the process context. If it is, it will set the current pointer +%%% for the message queue (the next message to be read out) to the +%%% position that was saved by recv_mark/1. +%%% +%%% The remove_message instruction must be modified to invalidate +%%% the information stored by the previous recv_mark/1, in case there +%%% is another receive executed between the calls to recv_mark/1 and +%%% recv_set/1. +%%% +%%% We use a reference to a label (i.e. a position in the loaded code) +%%% as the SomeUniqInteger. +%%% + +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + Fs = [function(F) || F <- Fs0], + Code = {Mod,Exp,Attr,Fs,Lc}, + {ok,Code}. + +%%% +%%% Local functions. +%%% + +function({function,Name,Arity,Entry,Is}) -> + try + D = beam_utils:index_labels(Is), + {function,Name,Arity,Entry,opt(Is, D, [])} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) -> + case creates_new_ref(Name, Arity) of + true -> + %% The call creates a brand new reference. Now + %% search for a receive statement in the same + %% function that will match against the reference. + case opt_recv(Is0, D) of + no -> + opt(Is0, D, [I|Acc]); + {yes,Is,Lbl} -> + opt(Is, D, [I,{recv_mark,{f,Lbl}}|Acc]) + end; + false -> + opt(Is0, D, [I|Acc]) + end; +opt([I|Is], D, Acc) -> + opt(Is, D, [I|Acc]); +opt([], _, Acc) -> + reverse(Acc). + +%% creates_new_ref(Name, Arity) -> true|false. +%% Return 'true' if the BIF Name/Arity will create a new reference. +creates_new_ref(monitor, 2) -> true; +creates_new_ref(make_ref, 0) -> true; +creates_new_ref(_, _) -> false. + +%% opt_recv([Instruction], LabelIndex) -> no|{yes,[Instruction]} +%% Search for a receive statement that will only retrieve messages +%% that contain the newly created reference (which is currently in {x,0}). +opt_recv(Is, D) -> + R = regs_init_x0(), + L = gb_sets:empty(), + opt_recv(Is, D, R, L, []). + +opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) -> + R = regs_kill_not_live(0, R0), + case regs_to_list(R) of + [{y,_}=RefReg] -> + %% We now have the new reference in the Y register RefReg + %% and the current instruction is the beginning of a + %% receive statement. We must now verify that only messages + %% that contain the reference will be matched. + case opt_ref_used(Is, RefReg, Fail, D) of + false -> + no; + true -> + RecvSet = {recv_set,{f,L}}, + {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L} + end; + [] -> + no + end; +opt_recv([I|Is], D, R0, L0, Acc) -> + {R,L} = opt_update_regs(I, R0, L0), + case regs_empty(R) of + true -> + %% The reference is no longer alive. There is no + %% point in continuing the search. + no; + false -> + opt_recv(Is, D, R, L, [I|Acc]) + end. + +opt_update_regs({block,Bl}, R, L) -> + {opt_update_regs_bl(Bl, R),L}; +opt_update_regs({call,_,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({call_ext,_,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({call_fun,_}, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({kill,Y}, R, L) -> + {regs_kill([Y], R),L}; +opt_update_regs(send, R, L) -> + {regs_kill_not_live(0, R),L}; +opt_update_regs({'catch',_,{f,Lbl}}, R, L) -> + {R,gb_sets:add(Lbl, L)}; +opt_update_regs({catch_end,_}, R, L) -> + {R,L}; +opt_update_regs({label,Lbl}, R, L) -> + case gb_sets:is_member(Lbl, L) of + false -> + %% We can't allow arbitrary labels (since the receive + %% could be entered without first creating the reference). + {regs_init(),L}; + true -> + %% A catch label for a previously seen catch instruction is OK. + {R,L} + end; +opt_update_regs({try_end,_}, R, L) -> + {R,L}; +opt_update_regs(_I, _R, L) -> + %% Unrecognized instruction. Abort the search. + {regs_init(),L}. + +opt_update_regs_bl([{set,Ds,_,{alloc,Live,_}}|Is], Regs0) -> + Regs1 = regs_kill_not_live(Live, Regs0), + Regs = regs_kill(Ds, Regs1), + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([{set,[Dst]=Ds,[Src],move}|Is], Regs0) -> + Regs1 = regs_kill(Ds, Regs0), + Regs = case regs_is_member(Src, Regs1) of + false -> Regs1; + true -> regs_add(Dst, Regs1) + end, + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) -> + Regs = regs_kill(Ds, Regs0), + opt_update_regs_bl(Is, Regs); +opt_update_regs_bl([], Regs) -> Regs. + +%% opt_ref_used([Instruction], RefRegister, FailLabel, LabelIndex) -> true|false +%% Return 'true' if it is certain that only messages that contain the same +%% reference as in RefRegister can be matched out. Otherwise return 'false'. +%% +%% Basically, we follow all possible paths through the receive statement. +%% If all paths are safe, we return 'true'. +%% +%% A branch to FailLabel is safe, because it exits the receive statement +%% and no further message may be matched out. +%% +%% If a path hits an comparision between RefRegister and part of the message, +%% that path is safe (any messages that may be matched further down the +%% path is guaranteed to contain the reference). +%% +%% Otherwise, if we hit a 'remove_message' instruction, we give up +%% and return 'false' (the optimization is definitely unsafe). If +%% we hit an unrecognized instruction, we also give up and return +%% 'false' (the optimization may be unsafe). + +opt_ref_used(Is, RefReg, Fail, D) -> + Done = gb_sets:singleton(Fail), + Regs = regs_init_x0(), + try + opt_ref_used_1(Is, RefReg, D, Done, Regs), + true + catch + throw:not_used -> + false + end. + +%% This functions only returns if all paths through the receive +%% statement are safe, and throws an 'not_used' term otherwise. +opt_ref_used_1([{block,Bl}|Is], RefReg, D, Done, Regs0) -> + Regs = opt_ref_used_bl(Bl, Regs0), + opt_ref_used_1(Is, RefReg, D, Done, Regs); +opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefReg, Regs) of + false -> + opt_ref_used_1(Is, RefReg, D, Done, Regs); + true -> + %% The instructions that follow (Is) can only be executed + %% if the message contains the same reference as in RefReg. + Done + end; +opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefReg, Regs) of + false -> + opt_ref_used_at(Fail, RefReg, D, Done, Regs); + true -> + Done + end; +opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs), + opt_ref_used_1(Is, RefReg, D, Done, Regs); +opt_ref_used_1([{select_tuple_arity,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> + Lbls = [F || {f,F} <- List] ++ [Fail], + opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); +opt_ref_used_1([{select_val,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> + Lbls = [F || {f,F} <- List] ++ [Fail], + opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); +opt_ref_used_1([{label,Lbl}|Is], RefReg, D, Done, Regs) -> + case gb_sets:is_member(Lbl, Done) of + true -> Done; + false -> opt_ref_used_1(Is, RefReg, D, Done, Regs) + end; +opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) -> + Done; +opt_ref_used_1([_I|_], _RefReg, _D, _Done, _Regs) -> + %% The optimization may be unsafe. + throw(not_used). + +%% is_ref_msg_comparison(Args, RefReg, RegisterSet) -> true|false. +%% Return 'true' if Args denotes a comparison between the +%% reference and message or part of the message. +is_ref_msg_comparison([R,RefReg], RefReg, Regs) -> + regs_is_member(R, Regs); +is_ref_msg_comparison([RefReg,R], RefReg, Regs) -> + regs_is_member(R, Regs); +is_ref_msg_comparison([_,_], _, _) -> false. + +opt_ref_used_in_all([L|Ls], RefReg, D, Done0, Regs) -> + Done = opt_ref_used_at(L, RefReg, D, Done0, Regs), + opt_ref_used_in_all(Ls, RefReg, D, Done, Regs); +opt_ref_used_in_all([], _, _, Done, _) -> Done. + +opt_ref_used_at(Fail, RefReg, D, Done0, Regs) -> + case gb_sets:is_member(Fail, Done0) of + true -> + Done0; + false -> + Is = beam_utils:code_at(Fail, D), + Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs), + gb_sets:add(Fail, Done) + end. + +opt_ref_used_bl([{set,[],[],remove_message}|_], _) -> + %% We have proved that a message that does not depend on the + %% reference can be matched out. + throw(not_used); +opt_ref_used_bl([{set,Ds,Ss,_}|Is], Regs0) -> + case regs_all_members(Ss, Regs0) of + false -> + %% The destination registers may be assigned values that + %% are not dependent on the message being matched. + Regs = regs_kill(Ds, Regs0), + opt_ref_used_bl(Is, Regs); + true -> + %% All the sources depend on the message directly or + %% indirectly. + Regs = regs_add_list(Ds, Regs0), + opt_ref_used_bl(Is, Regs) + end; +opt_ref_used_bl([], Regs) -> Regs. + +%%% +%%% Functions for keeping track of a set of registers. +%%% + +%% regs_init() -> RegisterSet +%% Return an empty set of registers. + +regs_init() -> + {0,0}. + +%% regs_init_x0() -> RegisterSet +%% Return a set that only contains the {x,0} register. + +regs_init_x0() -> + {1 bsl 0,0}. + +%% regs_empty(Register) -> true|false +%% Test whether the register set is empty. + +regs_empty(R) -> + R =:= {0,0}. + +%% regs_kill_not_live(Live, RegisterSet) -> RegisterSet' +%% Kill all registers indicated not live by Live. + +regs_kill_not_live(Live, {Xregs,Yregs}) -> + {Xregs band ((1 bsl Live)-1),Yregs}. + +%% regs_kill([Register], RegisterSet) -> RegisterSet' +%% Kill all registers mentioned in the list of registers. + +regs_kill([{x,N}|Rs], {Xregs,Yregs}) -> + regs_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs}); +regs_kill([{y,N}|Rs], {Xregs,Yregs}) -> + regs_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))}); +regs_kill([{fr,_}|Rs], Regs) -> + regs_kill(Rs, Regs); +regs_kill([], Regs) -> Regs. + +regs_add_list(List, Regs) -> + foldl(fun(R, A) -> regs_add(R, A) end, Regs, List). + +%% regs_add(Register, RegisterSet) -> RegisterSet' +%% Add a new register to the set of registers. + +regs_add({x,N}, {Xregs,Yregs}) -> + {Xregs bor (1 bsl N),Yregs}; +regs_add({y,N}, {Xregs,Yregs}) -> + {Xregs,Yregs bor (1 bsl N)}. + +%% regs_all_members([Register], RegisterSet) -> true|false +%% Test whether all of the registers are part of the register set. + +regs_all_members([R|Rs], Regs) -> + regs_is_member(R, Regs) andalso regs_all_members(Rs, Regs); +regs_all_members([], _) -> true. + +%% regs_is_member(Register, RegisterSet) -> true|false +%% Test whether Register is part of the register set. + +regs_is_member({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0; +regs_is_member({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0; +regs_is_member(_, _) -> false. + +%% regs_to_list(RegisterSet) -> [Register] +%% Convert the register set to an explicit list of registers. +regs_to_list({Xregs,Yregs}) -> + regs_to_list_1(Xregs, 0, x, regs_to_list_1(Yregs, 0, y, [])). + +regs_to_list_1(0, _, _, Acc) -> + Acc; +regs_to_list_1(Regs, N, Tag, Acc) when (Regs band 1) =:= 1 -> + regs_to_list_1(Regs bsr 1, N+1, Tag, [{Tag,N}|Acc]); +regs_to_list_1(Regs, N, Tag, Acc) -> + regs_to_list_1(Regs bsr 1, N+1, Tag, Acc). diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index ba903a12b6..3729ccb0da 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Type-based optimisations. @@ -183,7 +183,7 @@ simplify_float_1([], Ts, Rs, Acc0) -> {Is,Ts}. opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1, - {set,[{y,_}]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> + {set,[_]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> case beam_utils:is_killed_block(R, Is) of false -> opt_fmoves(Is, [I2,I1|Acc]); true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc]) @@ -253,8 +253,6 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) -> {[],H+1,Fl}; flt_need_heap_2({set,_,_,put}, H, Fl) -> {[],H+1,Fl}; -flt_need_heap_2({set,_,_,{put_string,L,_Str}}, H, Fl) -> - {[],H+2*L,Fl}; %% Then the "neutral" instructions. We just pass them. flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) -> {[],H,Fl}; diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 1fd61831e0..34065cfdce 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -416,6 +416,11 @@ valfun_1({put,Src}, Vst) -> valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) -> Vst = eat_heap(2*Sz, Vst0), set_type_reg(cons, Dst, Vst); +%% Instructions for optimization of selective receives. +valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> + Vst; +valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> + Vst; %% Misc. valfun_1({'%live',Live}, Vst) -> verify_live(Live, Vst), diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 5f111a5e05..99fa8dd9d5 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @doc Utility functions for Core Erlang case/receive clauses. @@ -338,10 +338,19 @@ match(P, E, Bs) -> if E =:= any -> {false, Bs}; true -> - case is_data(E) of - true -> + case type(E) of + literal -> + case is_bitstring(concrete(E)) of + false -> + none; + true -> + {false, Bs} + end; + cons -> + none; + tuple -> none; - false -> + _ -> {false, Bs} end end; diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 191efa3032..6d7eca0113 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Core Erlang inliner. @@ -1429,17 +1429,26 @@ inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) -> {E, S}; true -> %% Create local bindings for the parameters to their - %% respective operand structures from the app-structure, and - %% visit the body in the context saved in the structure. + %% respective operand structures from the app-structure. {Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S), - {E1, S2} = i(fun_body(E), Ctxt, Ren1, Env1, S1), + + %% function_clause exceptions that have been inlined + %% into another function (or even into the same function) + %% will not work properly. The v3_kernel pass will + %% take care of it, but we will need to help it by + %% removing any function_name annotations on match_fail + %% primops that we inline. + E1 = kill_function_name_anns(fun_body(E)), + + %% Visit the body in the context saved in the structure. + {E2, S2} = i(E1, Ctxt, Ren1, Env1, S1), %% Create necessary bindings and/or set flags. - {E2, S3} = make_let_bindings(Rs, E1, S2), + {E3, S3} = make_let_bindings(Rs, E2, S2), %% Lastly, flag the application as inlined, since the inlining %% attempt was not aborted before we reached this point. - {E2, st__set_app_inlined(L, S3)} + {E3, st__set_app_inlined(L, S3)} end. %% For the (possibly renamed) argument variables to an inlined call, @@ -2370,6 +2379,19 @@ kill_id_anns([A | As]) -> kill_id_anns([]) -> []. +kill_function_name_anns(Body) -> + F = fun(P) -> + case type(P) of + primop -> + Ann = get_ann(P), + Ann1 = lists:keydelete(function_name, 1, Ann), + set_ann(P, Ann1); + _ -> + P + end + end, + cerl_trees:map(F, Body). + %% ===================================================================== %% General utilities diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index b853800d73..3f250a6d5a 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -162,13 +162,12 @@ expand_opt(report, Os) -> [report_errors,report_warnings|Os]; expand_opt(return, Os) -> [return_errors,return_warnings|Os]; -expand_opt(r11, Os) -> - [no_stack_trimming,no_binaries,no_constant_pool|Os]; +expand_opt(r12, Os) -> + [no_recv_opt|Os]; +expand_opt(r13, Os) -> + [no_recv_opt|Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; -expand_opt(no_binaries=O, Os) -> - %%Turn off the entire type optimization pass. - [no_topt,O|Os]; expand_opt(no_float_opt, Os) -> %%Turn off the entire type optimization pass. [no_topt|Os]; @@ -590,7 +589,7 @@ core_passes() -> kernel_passes() -> %% Destructive setelement/3 optimization and core lint. - [{unless,no_constant_pool,?pass(core_dsetel_module)}, %Not safe without constant pool. + [?pass(core_dsetel_module), {iff,dsetel,{listing,"dsetel"}}, {iff,clint,?pass(core_lint_module)}, @@ -626,6 +625,8 @@ asm_passes() -> {iff,dclean,{listing,"clean"}}, {unless,no_bsm_opt,{pass,beam_bsm}}, {iff,dbsm,{listing,"bsm"}}, + {unless,no_recv_opt,{pass,beam_receive}}, + {iff,drecv,{listing,"recv"}}, {unless,no_stack_trimming,{pass,beam_trim}}, {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index b0311365c4..4ac879c9a4 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -1,19 +1,19 @@ % This is an -*- erlang -*- file. %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% {application, compiler, @@ -33,6 +33,7 @@ beam_listing, beam_opcodes, beam_peep, + beam_receive, beam_trim, beam_type, beam_utils, diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 6874054495..b57508ea8e 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1998-2010. All Rights Reserved. +# # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in # compliance with the License. You should have received a copy of the # Erlang Public License along with this software. If not, it can be # retrieved online at http://www.erlang.org/. -# +# # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See # the License for the specific language governing rights and limitations # under the License. -# +# # %CopyrightEnd% # BEAM_FORMAT_NUMBER=0 @@ -132,7 +132,7 @@ BEAM_FORMAT_NUMBER=0 # # Building terms. # -68: put_string/3 +68: -put_string/3 69: put_list/3 70: put_tuple/2 71: put/1 @@ -274,3 +274,8 @@ BEAM_FORMAT_NUMBER=0 # R13B03 149: on_load/0 + +# R14A + +150: recv_mark/1 +151: recv_set/1 diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl index c38eab7b42..f6696992b9 100644 --- a/lib/compiler/src/sys_core_dsetel.erl +++ b/lib/compiler/src/sys_core_dsetel.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Using dsetelement to make multiple-field record updates @@ -57,8 +57,6 @@ %% if X1 is used exactly once. %% Thus, we need to track variable usage. %% -%% NOTE: This pass must NOT be used if the no_constant_pool option is used. -%% -module(sys_core_dsetel). diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 068478496b..6202f07479 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Constant folding optimisation for Core @@ -602,15 +602,23 @@ count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). %% a rewritten expression consisting of a sequence of %% the arguments only is returned. -useless_call(effect, #c_call{module=#c_literal{val=Mod}, +useless_call(effect, #c_call{anno=Anno, + module=#c_literal{val=Mod}, name=#c_literal{val=Name}, args=Args}=Call) -> A = length(Args), case erl_bifs:is_safe(Mod, Name, A) of false -> case erl_bifs:is_pure(Mod, Name, A) of - true -> add_warning(Call, result_ignored); - false -> ok + true -> + case member(result_not_wanted, Anno) of + false -> + add_warning(Call, result_ignored); + true -> + ok + end; + false -> + ok end, no; true -> @@ -2806,7 +2814,8 @@ format_error({no_effect,{erlang,F,A}}) -> end, flatten(io_lib:format(Fmt, Args)); format_error(result_ignored) -> - "the result of the expression is ignored"; + "the result of the expression is ignored " + "(suppress the warning by assigning the expression to the _ variable)"; format_error(useless_building) -> "a term is constructed, but never used"; format_error(bin_opt_alias) -> diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index c8d75b80c6..9f93acb666 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Function inlining optimisation for Core. @@ -41,11 +41,9 @@ -module(sys_core_inline). -%%-compile({inline,{match_fail_fun,0}}). - -export([module/2]). --import(lists, [member/2,map/2,foldl/3,mapfoldl/3]). +-import(lists, [member/2,map/2,foldl/3,mapfoldl/3,keydelete/3]). -include("core_parse.hrl"). @@ -178,11 +176,9 @@ weight_func(_Core, Acc) -> Acc + 1. %% function_clause match_fail (if they have one). match_fail_fun() -> - fun (#c_primop{name=#c_literal{val=match_fail}, - args=[#c_tuple{es=[#c_literal{val=function_clause}|As]}]}=P) -> - Fail = #c_tuple{es=[#c_literal{val=case_clause}, - #c_tuple{es=As}]}, - P#c_primop{args=[Fail]}; + fun (#c_primop{anno=Anno0,name=#c_literal{val=match_fail}}=P) -> + Anno = keydelete(function_name, 1, Anno0), + P#c_primop{anno=Anno}; (Other) -> Other end. @@ -201,7 +197,7 @@ kill_id_anns(Body) -> (Expr) -> %% Mark everything as compiler generated to suppress %% bogus warnings. - A = [compiler_generated|core_lib:get_anno(Expr)], + A = compiler_generated(core_lib:get_anno(Expr)), core_lib:set_anno(Expr, A) end, Body). @@ -210,3 +206,8 @@ kill_id_anns_1([{'id',_}|As]) -> kill_id_anns_1([A|As]) -> [A|kill_id_anns_1(As)]; kill_id_anns_1([]) -> []. + +compiler_generated([compiler_generated|_]=Anno) -> + Anno; +compiler_generated(Anno) -> + [compiler_generated|Anno -- [compiler_generated]]. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 83113d1652..948937c438 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Code generator for Beam. @@ -209,7 +209,6 @@ need_heap_1(#l{ke={set,_,Val}}, H) -> {[],H + case Val of {cons,_} -> 2; {tuple,Es} -> 1 + length(Es); - {string,S} -> 2 * length(S); _Other -> 0 end}; need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H) -> @@ -1191,7 +1190,12 @@ trap_bif(_, _, _) -> false. bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) -> [Src] = cg_reg_args([Src0], Bef), - {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}; + case is_register(Src) of + false -> + {[],clear_dead(Bef, Le#l.i, Vdb), St0}; + true -> + {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0} + end; bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) -> [New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef), Index = Index1-1, @@ -1424,8 +1428,6 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); {var,V} -> % Normally removed by kernel optimizer. [{move,fetch_var(V, Int),Ret}]; - {string,Str} = String -> - [{put_string,length(Str),String,Ret}]; Other -> [{move,Other,Ret}] end, @@ -2022,6 +2024,10 @@ fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). on_stack(V, Stk) -> keymember(V, 1, Stk). +is_register({x,_}) -> true; +is_register({yy,_}) -> true; +is_register(_) -> false. + %% put_catch(CatchTag, Stack) -> Stack' %% drop_catch(CatchTag, Stack) -> Stack' %% Special interface for putting and removing catch tags, to ensure that diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index dfe15de4ff..b2f0ac75c7 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -128,6 +128,7 @@ -record(core, {vcount=0 :: non_neg_integer(), %Variable counter fcount=0 :: non_neg_integer(), %Function counter in_guard=false :: boolean(), %In guard or not. + wanted=true :: boolean(), %Result wanted or not. opts :: [compile:option()], %Options. es=[] :: [error()], %Errors. ws=[] :: [warning()], %Warnings. @@ -213,10 +214,7 @@ clause({clause,Lc,H0,G0,B0}, St0) -> catch throw:nomatch -> St = add_warning(Lc, nomatch, St0), - {noclause,St}; %Bad pattern - throw:no_binaries -> - St = add_error(Lc, no_binaries, St0), - {noclause,St} + {noclause,St} %Bad pattern end. clause_arity({clause,_,H0,_,_}) -> length(H0). @@ -496,22 +494,18 @@ expr({tuple,L,Es0}, St0) -> {Es1,Eps,St1} = safe_list(Es0, St0), A = lineno_anno(L, St1), {ann_c_tuple(A, Es1),Eps,St1}; -expr({bin,L,Es0}, #core{opts=Opts}=St0) -> - St1 = case member(no_binaries, Opts) of - false -> St0; - true -> add_error(L, no_binaries, St0) - end, - try expr_bin(Es0, lineno_anno(L, St1), St1) of +expr({bin,L,Es0}, St0) -> + try expr_bin(Es0, lineno_anno(L, St0), St0) of {_,_,_}=Res -> Res catch throw:bad_binary -> - St2 = add_warning(L, bad_binary, St1), - LineAnno = lineno_anno(L, St2), + St = add_warning(L, bad_binary, St0), + LineAnno = lineno_anno(L, St), As = [#c_literal{anno=LineAnno,val=badarg}], {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} module=#c_literal{anno=LineAnno,val=erlang}, name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St2} + args=As},[],St} end; expr({block,_,Es0}, St0) -> %% Inline the block directly. @@ -587,10 +581,14 @@ expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; expr({'fun',L,{clauses,Cs},Id}, St) -> fun_tq(Id, Cs, L, St); -expr({call,L,{remote,_,M,F},As0}, St0) -> +expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), Lanno = lineno_anno(L, St1), - {#icall{anno=#a{anno=Lanno},module=M1,name=F1,args=As1},Aps,St1}; + Anno = case Wanted of + false -> [result_not_wanted|Lanno]; + true -> Lanno + end, + {#icall{anno=#a{anno=Anno},module=M1,name=F1,args=As1},Aps,St1}; expr({call,Lc,{atom,Lf,F},As0}, St0) -> {As1,Aps,St1} = safe_list(As0, St0), Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}}, @@ -603,27 +601,28 @@ expr({call,L,FunExp,As0}, St0) -> expr({match,L,P0,E0}, St0) -> %% First fold matches together to create aliases. {P1,E1} = fold_match(E0, P0), - {E2,Eps,St1} = novars(E1, St0), + St1 = case P1 of + {var,_,'_'} -> St0#core{wanted=false}; + _ -> St0 + end, + {E2,Eps,St2} = novars(E1, St1), + St3 = St2#core{wanted=St0#core.wanted}, P2 = try - pattern(P1, St1) + pattern(P1, St3) catch throw:Thrown -> Thrown end, - {Fpat,St2} = new_var(St1), + {Fpat,St4} = new_var(St3), Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])), - Lanno = lineno_anno(L, St2), + Lanno = lineno_anno(L, St4), case P2 of nomatch -> - St = add_warning(L, nomatch, St2), - {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps,St}; - no_binaries -> - St = add_error(L, no_binaries, St2), + St = add_warning(L, nomatch, St4), {#icase{anno=#a{anno=Lanno}, args=[E2],clauses=[],fc=Fc},Eps,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St2} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} end; expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -1443,15 +1442,10 @@ pattern({cons,L,H,T}, St) -> ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St)); pattern({tuple,L,Ps}, St) -> ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St)); -pattern({bin,L,Ps}, #core{opts=Opts}=St) -> - case member(no_binaries, Opts) of - false -> - %% We don't create a #ibinary record here, since there is - %% no need to hold any used/new annotations in a pattern. - #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)}; - true -> - throw(no_binaries) - end; +pattern({bin,L,Ps}, St) -> + %% We don't create a #ibinary record here, since there is + %% no need to hold any used/new annotations in a pattern. + #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)}; pattern({match,_,P1,P2}, St) -> pat_alias(pattern(P1, St), pattern(P2, St)). @@ -1558,17 +1552,21 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 -> new_vars_1(0, _, St, Vs) -> {Vs,St}. function_clause(Ps, Name) -> - fail_clause(Ps, c_tuple([#c_literal{anno=[{name,Name}], - val=function_clause}|Ps])). -function_clause(Ps, Anno, Name) -> - fail_clause(Ps, ann_c_tuple(Anno, - [#c_literal{anno=[{name,Name}], - val=function_clause}|Ps])). - -fail_clause(Pats, A) -> + function_clause(Ps, [], Name). + +function_clause(Ps, LineAnno, Name) -> + FcAnno = [{function_name,Name}], + 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=[], - body=[#iprimop{anno=#a{},name=#c_literal{val=match_fail},args=[A]}]}. + body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail}, + args=[Arg]}]}. ubody(B, St) -> uexpr(B, [], St). @@ -2116,21 +2114,15 @@ is_simp_bin(Es) -> %%% Handling of warnings. %%% --type err_desc() :: 'bad_binary' | 'no_binaries' | 'nomatch'. +-type err_desc() :: 'bad_binary' | 'nomatch'. -spec format_error(err_desc()) -> nonempty_string(). format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> - "binary construction will fail because of a type mismatch"; -format_error(no_binaries) -> - "bit syntax is not allowed to be used when compatibility with a previous " - "version has been requested". + "binary construction will fail because of a type mismatch". add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 -> St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]}; add_warning(_, _, St) -> St. - -add_error(Line, Term, #core{es=Es,file=[{file,File}]}=St) -> - St#core{es=[{File,[{location(abs_line(Line)),?MODULE,Term}]}|Es]}. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 8568071e57..fbe4d8617e 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Transform Core Erlang to Kernel Erlang @@ -80,7 +80,8 @@ -export([module/2,format_error/1]). --import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,keymember/3]). +-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, + keymember/3,keyfind/3]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -compile({nowarn_deprecated_function, {erlang,hash,2}}). @@ -126,19 +127,28 @@ copy_anno(Kdst, Ksrc) -> -spec module(cerl:c_module(), [compile:option()]) -> {'ok', #k_mdef{}, [warning()]}. -module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) -> - Lit = case member(no_constant_pool, Options) of - true -> no; - false -> dict:new() - end, - St0 = #kern{lit=Lit}, - {Kfs,St} = mapfoldl(fun function/2, St0, Fs), +module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> + Kas = attributes(As), Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), - Kas = map(fun ({#c_literal{val=N},V}) -> - {N,core_lib:literal_value(V)} end, As), + St0 = #kern{lit=dict:new()}, + {Kfs,St} = mapfoldl(fun function/2, St0, Fs), {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. +attributes([{#c_literal{val=Name},Val}|As]) -> + case include_attribute(Name) of + false -> + attributes(As); + true -> + [{Name,core_lib:literal_value(Val)}|attributes(As)] + end; +attributes([]) -> []. + +include_attribute(type) -> false; +include_attribute(spec) -> false; +include_attribute(opaque) -> false; +include_attribute(_) -> true. + function({#c_var{name={F,Arity}=FA},Body}, St0) -> try St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=sets:new()}, @@ -240,11 +250,6 @@ expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> expr(Fun, Sub, St); expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; -expr(#c_literal{anno=A,val=Lit}, Sub, #kern{lit=no}=St) -> - %% No constant pools for compatibility with a previous version. - %% Fully expand the literal. - Core = expand_literal(Lit, A), - expr(Core, Sub, St); expr(#c_literal{}=Lit, Sub, St) -> Core = handle_literal(Lit), expr(Core, Sub, St); @@ -265,9 +270,6 @@ expr(#k_float{}=V, _Sub, St) -> {V,[],St}; expr(#k_atom{}=V, _Sub, St) -> {V,[],St}; -expr(#k_string{}=V, _Sub, St) -> - %% Only for compatibility with a previous version. - {V,[],St}; expr(#c_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. @@ -420,7 +422,7 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> {Call,Ap,St} end; expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) -> - Cargs = translate_match_fail(Cargs0, Sub, St0), + Cargs = translate_match_fail(Cargs0, Sub, A, St0), %% This special case will disappear. {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0), Ar = length(Cargs), @@ -447,32 +449,53 @@ expr(#c_catch{anno=A,body=Cb}, Sub, St0) -> %% Handle internal expressions. expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. -%% Translate a function_clause to case_clause if it has been moved into -%% another function. -translate_match_fail([#c_tuple{es=[#c_literal{anno=A0, - val=function_clause}|As]}]=Args, - Sub, - #kern{ff=FF}) -> - A = case A0 of - [{name,{Func0,Arity0}}] -> - [{name,{get_fsub(Func0, Arity0, Sub),Arity0}}]; - _ -> - A0 - end, - case {A,FF} of - {[{name,Same}],Same} -> +%% Translate a function_clause exception to a case_clause exception if +%% it has been moved into another function. (A function_clause exception +%% will not work correctly if it is moved into another function, or +%% even if it is invoked not from the top level in the correct function.) +translate_match_fail(Args, Sub, Anno, St) -> + case Args of + [#c_tuple{es=[#c_literal{val=function_clause}|As]}] -> + translate_match_fail_1(Anno, Args, 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); + _ -> + Args + end; + _ -> + %% Not a function_clause exception. + Args + end. + +translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) -> + AnnoFunc = case keyfind(function_name, 1, Anno) of + false -> + none; %Force rewrite. + {function_name,{Name,Arity}} -> + {get_fsub(Name, Arity, Sub),Arity} + end, + case {AnnoFunc,FF} of + {Same,Same} -> %% Still in the correct function. Args; - {[{name,{F,_}}],F} -> + {{F,_},F} -> %% Still in the correct function. Args; _ -> - %% Inlining has probably moved the function_clause into another - %% function (where it will not work correctly). - %% Rewrite to a case_clause. + %% Wrong function or no function_name annotation. + %% + %% The inliner has copied the match_fail(function_clause) + %% primop from another function (or from another instance of + %% the current function). match_fail(function_clause) will + %% only work at the top level of the function it was originally + %% defined in, so we will need to rewrite it to a case_clause. [#c_tuple{es=[#c_literal{val=case_clause},#c_tuple{es=As}]}] - end; -translate_match_fail(Args, _, _) -> Args. + end. %% call_type(Module, Function, Arity) -> call | bif | apply | error. %% Classify the call. @@ -980,11 +1003,6 @@ match_var([U|Us], Cs0, Def, St) -> %% according to type, the order is really irrelevant but tries to be %% smart. -match_con(Us, Cs0, Def, #kern{lit=no}=St) -> - %% No constant pool (for compatibility with R11B). - %% We must expand literals. - Cs = [expand_pat_lit_clause(C, true) || C <- Cs0], - match_con_1(Us, Cs, Def, St); match_con(Us, [C], Def, St) -> %% There is only one clause. We can keep literal tuples and %% lists, but we must convert []/integer/float/atom literals @@ -1783,7 +1801,6 @@ lit_vars(#k_int{}) -> []; lit_vars(#k_float{}) -> []; lit_vars(#k_atom{}) -> []; %%lit_vars(#k_char{}) -> []; -lit_vars(#k_string{}) -> []; lit_vars(#k_nil{}) -> []; lit_vars(#k_cons{hd=H,tl=T}) -> union(lit_vars(H), lit_vars(T)); @@ -1845,48 +1862,20 @@ 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}; - _ -> - expand_literal(V, 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} end. -%% expand_literal(Literal, Anno) -> CoreTerm | KernelTerm -%% Fully expand the literal. Atomic terms such as integers are directly -%% translated to the Kernel Erlang format, while complex terms are kept -%% in the Core Erlang format (but the content is recursively processed). - -expand_literal([H|T]=V, A) when is_integer(H), 0 =< H, H =< 255 -> - case is_print_char_list(T) of - false -> - #c_cons{anno=A,hd=#k_int{anno=A,val=H},tl=expand_literal(T, A)}; - true -> - #k_string{anno=A,val=V} - end; -expand_literal([H|T], A) -> - #c_cons{anno=A,hd=expand_literal(H, A),tl=expand_literal(T, A)}; -expand_literal([], A) -> - #k_nil{anno=A}; -expand_literal(V, A) when is_tuple(V) -> - #c_tuple{anno=A,es=expand_literal_list(tuple_to_list(V), A)}; -expand_literal(V, A) when is_integer(V) -> - #k_int{anno=A,val=V}; -expand_literal(V, A) when is_float(V) -> - #k_float{anno=A,val=V}; -expand_literal(V, A) when is_atom(V) -> - #k_atom{anno=A,val=V}. - -expand_literal_list([H|T], A) -> - [expand_literal(H, A)|expand_literal_list(T, A)]; -expand_literal_list([], _) -> []. - -is_print_char_list([H|T]) when is_integer(H), 0 =< H, H =< 255 -> - is_print_char_list(T); -is_print_char_list([]) -> true; -is_print_char_list(_) -> false. - make_list(Es) -> foldr(fun(E, Acc) -> #c_cons{hd=E,tl=Acc} diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index b1ca907d11..a300dd283f 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Kernel Erlang (naive) prettyprinter @@ -80,7 +80,6 @@ format_1(#k_atom{val=A}, _Ctxt) -> core_atom(A); format_1(#k_float{val=F}, _Ctxt) -> float_to_list(F); format_1(#k_int{val=I}, _Ctxt) -> integer_to_list(I); format_1(#k_nil{}, _Ctxt) -> "[]"; -format_1(#k_string{val=S}, _Ctxt) -> io_lib:write_string(S); format_1(#k_var{name=V}, _Ctxt) -> if is_atom(V) -> case atom_to_list(V) of diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 0adeaca8fa..9fda37530b 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Convert annotated kernel expressions to annotated beam format. @@ -66,21 +66,27 @@ functions([], Acc) -> reverse(Acc). %% function(Kfunc) -> Func. function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> - %ok = io:fwrite("life ~w: ~p~n~p~n", [?LINE,{F,Ar},Kb]), - As = var_list(Vs), - Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), - %% Force a top-level match! - B0 = case Kb of - #k_match{} -> Kb; - _ -> - Ka = get_kanno(Kb), - #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, - vars=Vs,body=Kb,ret=[]} - end, - put(guard_refc, 0), - {B1,_,Vdb1} = body(B0, 1, Vdb0), - erase(guard_refc), - {function,F,Ar,As,B1,Vdb1}. + try + As = var_list(Vs), + Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), + %% Force a top-level match! + B0 = case Kb of + #k_match{} -> Kb; + _ -> + Ka = get_kanno(Kb), + #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a}, + vars=Vs,body=Kb,ret=[]} + end, + put(guard_refc, 0), + {B1,_,Vdb1} = body(B0, 1, Vdb0), + erase(guard_refc), + {function,F,Ar,As,B1,Vdb1} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [F,Ar]), + erlang:raise(Class, Error, Stack) + end. %% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. %% Handle a body, need special cases for transforming match_fails. @@ -412,7 +418,6 @@ literal(#k_int{val=I}, _) -> {integer,I}; literal(#k_float{val=F}, _) -> {float,F}; literal(#k_atom{val=N}, _) -> {atom,N}; %%literal(#k_char{val=C}, _) -> {char,C}; -literal(#k_string{val=S}, _) -> {string,S}; literal(#k_nil{}, _) -> nil; literal(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; @@ -437,7 +442,6 @@ literal2(#k_int{val=I}, _) -> {integer,I}; literal2(#k_float{val=F}, _) -> {float,F}; literal2(#k_atom{val=N}, _) -> {atom,N}; %%literal2(#k_char{val=C}, _) -> {char,C}; -literal2(#k_string{val=S}, _) -> {string,S}; literal2(#k_nil{}, _) -> nil; literal2(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]}; |