aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/Makefile1
-rw-r--r--lib/compiler/src/beam_asm.erl21
-rw-r--r--lib/compiler/src/beam_block.erl48
-rw-r--r--lib/compiler/src/beam_bool.erl21
-rw-r--r--lib/compiler/src/beam_dead.erl58
-rw-r--r--lib/compiler/src/beam_dict.erl30
-rw-r--r--lib/compiler/src/beam_disasm.erl33
-rw-r--r--lib/compiler/src/beam_flatten.erl11
-rw-r--r--lib/compiler/src/beam_jump.erl11
-rw-r--r--lib/compiler/src/beam_peep.erl58
-rw-r--r--lib/compiler/src/beam_receive.erl388
-rw-r--r--lib/compiler/src/beam_type.erl18
-rw-r--r--lib/compiler/src/beam_utils.erl52
-rw-r--r--lib/compiler/src/beam_validator.erl12
-rw-r--r--lib/compiler/src/cerl.erl19
-rw-r--r--lib/compiler/src/cerl_clauses.erl25
-rw-r--r--lib/compiler/src/cerl_inline.erl49
-rw-r--r--lib/compiler/src/cerl_trees.erl16
-rw-r--r--lib/compiler/src/compile.erl74
-rw-r--r--lib/compiler/src/compiler.app.src11
-rw-r--r--lib/compiler/src/core_lint.erl25
-rw-r--r--lib/compiler/src/erl_bifs.erl12
-rw-r--r--lib/compiler/src/genop.tab20
-rw-r--r--lib/compiler/src/rec_env.erl14
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl12
-rw-r--r--lib/compiler/src/sys_core_fold.erl72
-rw-r--r--lib/compiler/src/sys_core_inline.erl29
-rw-r--r--lib/compiler/src/sys_pre_expand.erl28
-rw-r--r--lib/compiler/src/v3_codegen.erl28
-rw-r--r--lib/compiler/src/v3_core.erl219
-rw-r--r--lib/compiler/src/v3_kernel.erl161
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl11
-rw-r--r--lib/compiler/src/v3_life.erl50
33 files changed, 1055 insertions, 582 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..89d64834cf 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(),
@@ -265,7 +261,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) ->
Arity = length(Args),
BifOp = case Arity of
1 -> gc_bif1;
- 2 -> gc_bif2
+ 2 -> gc_bif2;
+ 3 -> gc_bif3
end,
encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict);
make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index d4a4ddca8a..c45874597a 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
@@ -36,12 +36,13 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% Collect basic blocks and optimize them.
Is2 = blockify(Is1),
- Is3 = beam_utils:live_opt(Is2),
- Is4 = opt_blocks(Is3),
- Is5 = beam_utils:delete_live_annos(Is4),
+ Is3 = move_allocates(Is2),
+ Is4 = beam_utils:live_opt(Is3),
+ Is5 = opt_blocks(Is4),
+ Is6 = beam_utils:delete_live_annos(Is5),
%% Optimize bit syntax.
- {Is,Lc} = bsm_opt(Is5, Lc0),
+ {Is,Lc} = bsm_opt(Is6, Lc0),
%% Done.
{{function,Name,Arity,CLabel,Is},Lc}
@@ -140,7 +141,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};
@@ -157,11 +157,7 @@ opt_blocks([I|Is]) ->
opt_blocks([]) -> [].
opt_block(Is0) ->
- %% We explicitly move any allocate instruction upwards before optimising
- %% moves, to avoid any potential problems with the calculation of live
- %% registers.
- Is1 = move_allocates(Is0),
- Is = find_fixpoint(fun opt/1, Is1),
+ Is = find_fixpoint(fun opt/1, Is0),
opt_alloc(Is).
find_fixpoint(OptFun, Is0) ->
@@ -171,11 +167,21 @@ find_fixpoint(OptFun, Is0) ->
end.
%% move_allocates(Is0) -> Is
-%% Move allocates upwards in the instruction stream, in the hope of
-%% getting more possibilities for optimizing away moves later.
-
-move_allocates(Is) ->
- move_allocates_1(reverse(Is), []).
+%% Move allocate instructions upwards in the instruction stream, in the
+%% hope of getting more possibilities for optimizing away moves later.
+%%
+%% NOTE: Moving allocation instructions is only safe because it is done
+%% immediately after code generation so that we KNOW that if {x,X} is
+%% initialized, all x registers with lower numbers are also initialized.
+%% That assumption may not be true after other optimizations, such as
+%% the beam_utils:live_opt/1 optimization.
+
+move_allocates([{block,Bl0}|Is]) ->
+ Bl = move_allocates_1(reverse(Bl0), []),
+ [{block,Bl}|move_allocates(Is)];
+move_allocates([I|Is]) ->
+ [I|move_allocates(Is)];
+move_allocates([]) -> [].
move_allocates_1([{set,[],[],{alloc,_,_}=Alloc}|Is0], Acc0) ->
{Is,Acc} = move_allocates_2(Alloc, Is0, Acc0),
@@ -202,9 +208,7 @@ move_allocates_2(Alloc, [], Acc) ->
alloc_may_pass({set,_,_,{alloc,_,_}}) -> false;
alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false;
alloc_may_pass({set,_,_,put_list}) -> false;
-alloc_may_pass({set,_,_,{put_tuple,_}}) -> false;
alloc_may_pass({set,_,_,put}) -> false;
-alloc_may_pass({set,_,_,{put_string,_,_}}) -> false;
alloc_may_pass({set,_,_,_}) -> true.
combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) ->
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index dcc6ad4c7c..d9ea6f5a70 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose: Optimizes booleans in guards.
@@ -631,10 +631,10 @@ fetch_reg(V, [{I,V}|_]) -> {x,I};
fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs).
live_regs(Regs) ->
- foldl(fun ({I,_}, _) -> I;
- ([], Max) -> Max end,
- -1, Regs)+1.
-
+ foldl(fun ({I,_}, _) ->
+ I
+ end, -1, Regs)+1.
+
%%%
%%% Convert a block to Static Single Assignment (SSA) form.
@@ -748,8 +748,7 @@ initialized_regs([{bs_context_to_binary,Src}|Is], Regs) ->
initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) ->
InitRegs = free_vars_regs(Arity),
add_init_regs(InitRegs, Regs);
-initialized_regs([_|_], Regs) -> Regs;
-initialized_regs([], Regs) -> Regs.
+initialized_regs([_|_], Regs) -> Regs.
add_init_regs([{x,_}=X|T], Regs) ->
add_init_regs(T, ordsets:add_element(X, Regs));
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 7b4cd814a2..bb93110176 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2002-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%
%%
@@ -281,12 +281,12 @@ forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) ->
forward([I|Is], D, Lc, Acc);
forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) ->
forward([I|Is], D, Lc, Acc);
-forward([{test,is_eq_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) ->
+forward([{test,is_eq_exact,_,_}=I|Is], D, Lc, Acc) ->
case Is of
[{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
_ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
end;
-forward([{test,is_ne_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) ->
+forward([{test,is_ne_exact,_,_}=I|Is], D, Lc, Acc) ->
case Is of
[{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
_ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
@@ -371,10 +371,10 @@ backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
To = shortcut_bs_start_match(To0, Src, D),
I = {test,bs_start_match2,{f,To},Live,Info,Dst},
backward(Is, D, [I|Acc]);
-backward([{test,is_eq_exact=Op,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) ->
+backward([{test,is_eq_exact,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
To = shortcut_fail_label(To1, Reg, Val, D),
- I = {test,Op,{f,To},Ops},
+ I = combine_eqs(To, Ops, D, Acc),
backward(Is, D, [I|Acc]);
backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
@@ -394,7 +394,10 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
_Code ->
To2
end,
- I = {test,Op,{f,To},Ops0},
+ I = case Op of
+ is_eq_exact -> combine_eqs(To, Ops0, D, Acc);
+ _ -> {test,Op,{f,To},Ops0}
+ end,
backward(Is, D, [I|Acc]);
backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
@@ -519,6 +522,41 @@ bif_to_test(Name, Args, Fail) ->
not_possible() -> throw(not_possible).
+%% combine_eqs(To, Operands, Acc) -> Instruction.
+%% Combine two is_eq_exact instructions or (an is_eq_exact
+%% instruction and a select_val instruction) to a select_val
+%% instruction if possible.
+%%
+%% Example:
+%%
+%% is_eq_exact F1 Reg Lit1 select_val Reg F2 [ Lit1 L1
+%% L1: . Lit2 L2 ]
+%% .
+%% . ==>
+%% .
+%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2
+%% L2: .... L2:
+%%
+combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_])
+ when Type =:= atom; Type =:= integer ->
+ case beam_utils:code_at(To, D) of
+ [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]},
+ {label,L2}|_] when Lit1 =/= Lit2 ->
+ {select_val,Reg,{f,F2},{list,[Lit1,{f,L1},Lit2,{f,L2}]}};
+ [{select_val,Reg,{f,F2},{list,[{Type,_}|_]=List0}}|_] ->
+ List = remove_from_list(Lit1, List0),
+ {select_val,Reg,{f,F2},{list,[Lit1,{f,L1}|List]}};
+ _Is ->
+ {test,is_eq_exact,{f,To},Ops}
+ end;
+combine_eqs(To, Ops, _D, _Acc) ->
+ {test,is_eq_exact,{f,To},Ops}.
+
+remove_from_list(Lit, [Lit,{f,_}|T]) ->
+ T;
+remove_from_list(Lit, [Val,{f,_}=Fail|T]) ->
+ [Val,Fail|remove_from_list(Lit, T)];
+remove_from_list(_, []) -> [].
%% shortcut_bs_test(TargetLabel, [Instruction], D) -> TargetLabel'
%% Try to shortcut the failure label for a bit syntax matching.
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index 4ffe8bc606..a1f994dfbd 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -33,7 +33,7 @@
exports = [] :: [{label(), arity(), label()}],
locals = [] :: [{label(), arity(), label()}],
imports = gb_trees:empty() :: gb_tree(), %{{M,F,A},Index}
- strings = [] :: [string()], %String pool
+ strings = <<>> :: binary(), %String pool
lambdas = [], %[{...}]
literals = dict:new() :: dict(), %Format: {Literal,Number}
next_atom = 1 :: pos_integer(),
@@ -119,10 +119,11 @@ import(Mod0, Name0, Arity, #asm{imports=Imp0,next_import=NextIndex}=D0)
string(Str, Dict) when is_list(Str) ->
#asm{strings=Strings,string_offset=NextOffset} = Dict,
- case old_string(Str, Strings) of
+ StrBin = list_to_binary(Str),
+ case old_string(StrBin, Strings) of
none ->
- NewDict = Dict#asm{strings=Strings++Str,
- string_offset=NextOffset+length(Str)},
+ NewDict = Dict#asm{strings = <<Strings/binary,StrBin/binary>>,
+ string_offset=NextOffset+byte_size(StrBin)},
{NextOffset,NewDict};
Offset when is_integer(Offset) ->
{NextOffset-Offset,Dict}
@@ -187,7 +188,7 @@ import_table(#asm{imports=Imp,next_import=NumImports}) ->
ImpTab = [MFA || {MFA,_} <- Sorted],
{NumImports,ImpTab}.
--spec string_table(bdict()) -> {non_neg_integer(), [string()]}.
+-spec string_table(bdict()) -> {non_neg_integer(), binary()}.
string_table(#asm{strings=Strings,string_offset=Size}) ->
{Size,Strings}.
@@ -217,15 +218,12 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) ->
my_term_to_binary(Term) ->
term_to_binary(Term, [{minor_version,1}]).
-%% Search for string Str in the string pool Pool.
+%% Search for binary string Str in the binary string pool Pool.
%% old_string(Str, Pool) -> none | Index
--spec old_string(string(), [string()]) -> 'none' | pos_integer().
-
-old_string([C|Str]=Str0, [C|Pool]) ->
- case lists:prefix(Str, Pool) of
- true -> length(Pool)+1;
- false -> old_string(Str0, Pool)
- end;
-old_string([_|_]=Str, [_|Pool]) ->
- old_string(Str, Pool);
-old_string([_|_], []) -> none.
+-spec old_string(binary(), binary()) -> 'none' | pos_integer().
+
+old_string(Str, Pool) ->
+ case binary:match(Pool, Str) of
+ nomatch -> none;
+ {Start,_Length} -> byte_size(Pool) - Start
+ end.
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index c956f2f000..017ca129b0 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:
@@ -621,8 +621,7 @@ resolve_names(Fun, Imports, Str, Lbls, Lambdas, Literals, M) ->
%%
%% New make_fun2/4 instruction added in August 2001 (R8).
-%% New put_literal/2 instruction added in Feb 2006 R11B-4.
-%% We handle them specially here to avoid adding an argument to
+%% We handle it specially here to avoid adding an argument to
%% the clause for every instruction.
%%
@@ -631,8 +630,6 @@ resolve_inst({make_fun2,Args}, _, _, _, Lambdas, _, M) ->
{OldIndex,{F,A,_Lbl,_Index,NumFree,OldUniq}} =
lists:keyfind(OldIndex, 1, Lambdas),
{make_fun2,{M,F,A},OldIndex,OldUniq,NumFree};
-resolve_inst({put_literal,[{u,Index},Dst]},_,_,_,_,Literals,_) ->
- {put_literal,{literal,gb_trees:get(Index, Literals)},Dst};
resolve_inst(Instr, Imports, Str, Lbls, _Lambdas, _Literals, _M) ->
%% io:format(?MODULE_STRING":resolve_inst ~p.~n", [Instr]),
resolve_inst(Instr, Imports, Str, Lbls).
@@ -1004,13 +1001,17 @@ resolve_inst({gc_bif2,Args},Imports,_,_) ->
[F,Live,Bif,A1,A2,Reg] = resolve_args(Args),
{extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports),
{gc_bif,BifName,F,Live,[A1,A2],Reg};
+%%
+%% New instruction in R14, gc_bif with 3 arguments
+%%
+resolve_inst({gc_bif3,Args},Imports,_,_) ->
+ [F,Live,Bif,A1,A2,A3,Reg] = resolve_args(Args),
+ {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports),
+ {gc_bif,BifName,F,Live,[A1,A2,A3],Reg};
%%
%% New instructions for creating non-byte aligned binaries.
%%
-resolve_inst({bs_bits_to_bytes2,[_Arg2,_Arg3]=Args},_,_,_) ->
- [A2,A3] = resolve_args(Args),
- {bs_bits_to_bytes2,A2,A3};
resolve_inst({bs_final2,[X,Y]},_,_,_) ->
{bs_final2,X,Y};
@@ -1096,6 +1097,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_peep.erl b/lib/compiler/src/beam_peep.erl
index d03ac4b1f4..f39fc50b95 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
@@ -64,22 +64,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
%% InEncoding =:= latin1, OutEncoding =:= unicode;
%% InEncoding =:= latin1, OutEncoding =:= utf8 ->
%%
-%% (2) Code like
-%%
-%% is_ne_exact Fail Reg Literal1
-%% is_ne_exact Fail Reg Literal2
-%% is_ne_exact Fail Reg Literal3
-%% is_eq_exact UltimateFail Reg Literal4
-%% Fail: ....
-%%
-%% can be rewritten to
-%%
-%% select_val Reg UltimateFail [ Literal1 Fail
-%% Literal2 Fail
-%% Literal3 Fail
-%% Literal4 Fail ]
-%%
-%% (3) A select_val/4 instruction that only verifies that
+%% (2) A select_val/4 instruction that only verifies that
%% its argument is either 'true' or 'false' can be
%% be replaced with an is_boolean/2 instruction. That is:
%%
@@ -132,7 +117,7 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
false ->
%% Remember that we have seen this test.
SeenTests = gb_sets:insert(Test, SeenTests0),
- make_select_val(I, Is, SeenTests, Acc)
+ peep(Is, SeenTests, [I|Acc])
end
end;
peep([{select_val,Src,Fail,
@@ -151,33 +136,6 @@ peep([I|Is], _, Acc) ->
peep(Is, gb_sets:empty(), [I|Acc]);
peep([], _, Acc) -> reverse(Acc).
-make_select_val({test,is_ne_exact,{f,Fail},[Val,Lit]}=I0,
- Is0, SeenTests, Acc) ->
- try
- Type = case Lit of
- {atom,_} -> atom;
- {integer,_} -> integer;
- _ -> throw(impossible)
- end,
- {I,Is} = make_select_val_1(Is0, Fail, Val, Type, [Lit,{f,Fail}]),
- peep([I|Is], SeenTests, Acc)
- catch
- impossible ->
- peep(Is0, SeenTests, [I0|Acc])
- end;
-make_select_val(I, Is, SeenTests, Acc) ->
- peep(Is, SeenTests, [I|Acc]).
-
-make_select_val_1([{test,is_ne_exact,{f,Fail},[Val,{Type,_}=Lit]}|Is],
- Fail, Val, Type, Acc) ->
- make_select_val_1(Is, Fail, Val, Type, [Lit,{f,Fail}|Acc]);
-make_select_val_1([{test,is_eq_exact,{f,UltimateFail},[Val,{Type,_}=Lit]} |
- [{label,Fail}|_]=Is], Fail, Val, Type, Acc) ->
- Choices = [Lit,{f,Fail}|Acc],
- I = {select_val,Val,{f,UltimateFail},{list,Choices}},
- {I,Is};
-make_select_val_1(_Is, _Fail, _Val, _Type, _Acc) -> throw(impossible).
-
kill_seen(Dst, Seen0) ->
gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)).
@@ -187,5 +145,3 @@ kill_seen_1([{_,Ops}=Test|T], Dst) ->
false -> [Test|kill_seen_1(T, Dst)]
end;
kill_seen_1([], _) -> [].
-
-
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
new file mode 100644
index 0000000000..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..f83f73b224 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.
@@ -76,9 +76,6 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A
end,
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc]);
-simplify_basic_1([{set,[_],[_],{bif,_,{f,0}}}=I|Is], Ts0, Acc) ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc]);
simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) ->
case tdb_find(TupleReg, Ts0) of
{tuple,_,[Contents]} ->
@@ -118,7 +115,6 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc])
end;
-
simplify_basic_1([I|Is], Ts0, Acc) ->
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc]);
@@ -183,7 +179,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 +249,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_utils.erl b/lib/compiler/src/beam_utils.erl
index ac249e6672..45cdf8a659 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2007-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 : Common utilities used by several optimization passes.
@@ -407,16 +407,23 @@ check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) ->
Other ->
Other
end;
-check_liveness(R, [{gc_bif,Op,{f,Fail},_,Ss,D}|Is], St0) ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St} = Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
+check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) ->
+ case R of
+ {x,X} when X >= Live ->
+ {killed,St0};
+ {x,_} ->
+ {used,St0};
+ _ ->
+ case check_liveness_fail(R, Op, Ss, Fail, St0) of
+ {killed,St}=Killed ->
+ case member(R, Ss) of
+ true -> {used,St};
+ false when R =:= D -> Killed;
+ false -> check_liveness(R, Is, St)
+ end;
+ Other ->
+ Other
+ end
end;
check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) ->
case member(R, Ss) of
@@ -424,12 +431,6 @@ check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) ->
false when R =:= D -> {killed,St};
false -> check_liveness(R, Is, St)
end;
-check_liveness(R, [{bs_bits_to_bytes2,Src,Dst}|Is], St) ->
- case R of
- Src -> {used,St};
- Dst -> {killed,St};
- _ -> check_liveness(R, Is, St)
- end;
check_liveness(R, [{bs_put_binary,{f,0},Sz,_,_,Src}|Is], St) ->
case member(R, [Sz,Src]) of
true -> {used,St};
@@ -488,10 +489,13 @@ check_liveness(R, [{bs_context_to_binary,S}|Is], St) ->
S -> {used,St};
_ -> check_liveness(R, Is, St)
end;
-check_liveness(R, [{loop_rec,{f,_},{x,0}}|Is], St) ->
+check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) ->
case R of
- {x,_} -> {killed,St};
- _ -> check_liveness(R, Is, St)
+ {x,_} ->
+ {killed,St};
+ _ ->
+ %% y register. Rarely happens. Be very conversative.
+ {unknown,St}
end;
check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) ->
check_liveness_at(R, Fail, St);
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 1fd61831e0..fb267b35b6 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -18,6 +18,10 @@
-module(beam_validator).
+-compile({no_auto_import,[min/2]}).
+
+%% Avoid warning for local function error/1 clashing with autoimported BIF.
+-compile({no_auto_import,[error/1]}).
-export([file/1, files/1]).
%% Interface for compiler.
@@ -416,6 +420,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),
@@ -752,9 +761,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) ->
valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) ->
assert_term(A, Vst),
set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
-valfun_4({bs_bits_to_bytes2,Src,Dst}, Vst) ->
- assert_term(Src, Vst),
- set_type_reg({integer,[]}, Dst, Vst);
valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) ->
assert_term(Src, Vst),
set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 74fc0878cf..4b74d60e9f 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%% =====================================================================
@@ -122,6 +122,9 @@
bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1,
bitstr_flags/1]).
+-export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0,
+ c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]).
+
%%
%% needed by the include file below -- do not move
%%
@@ -970,7 +973,7 @@ atom_name(Node) ->
%% TODO: replace the use of the unofficial 'write_string/2'.
--spec atom_lit(cerl()) -> string().
+-spec atom_lit(cerl()) -> nonempty_string().
atom_lit(Node) ->
io_lib:write_string(atom_name(Node), $'). %' stupid Emacs.
@@ -1076,7 +1079,7 @@ char_val(Node) ->
%%
%% @see c_char/1
--spec char_lit(c_literal()) -> string().
+-spec char_lit(c_literal()) -> nonempty_string().
char_lit(Node) ->
io_lib:write_char(char_val(Node)).
@@ -1175,7 +1178,7 @@ string_val(Node) ->
%%
%% @see c_string/1
--spec string_lit(c_literal()) -> string().
+-spec string_lit(c_literal()) -> nonempty_string().
string_lit(Node) ->
io_lib:write_string(string_val(Node)).
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 5f111a5e05..99fa8dd9d5 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%% @doc Utility functions for Core Erlang case/receive clauses.
@@ -338,10 +338,19 @@ match(P, E, Bs) ->
if E =:= any ->
{false, Bs};
true ->
- case is_data(E) of
- true ->
+ case type(E) of
+ literal ->
+ case is_bitstring(concrete(E)) of
+ false ->
+ none;
+ true ->
+ {false, Bs}
+ end;
+ cons ->
+ none;
+ tuple ->
none;
- false ->
+ _ ->
{false, Bs}
end
end;
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 191efa3032..c15103999f 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.
@@ -65,7 +65,6 @@
try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1,
type/1, values_es/1, var_name/1]).
--import(erlang, [max/2]).
-import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]).
%%
@@ -201,9 +200,9 @@ start(Reply, Tree, Ctxt, Opts) ->
false ->
ok
end,
- Size = max(1, proplists:get_value(inline_size, Opts)),
- Effort = max(1, proplists:get_value(inline_effort, Opts)),
- Unroll = max(1, proplists:get_value(inline_unroll, Opts)),
+ Size = erlang:max(1, proplists:get_value(inline_size, Opts)),
+ Effort = erlang:max(1, proplists:get_value(inline_effort, Opts)),
+ Unroll = erlang:max(1, proplists:get_value(inline_unroll, Opts)),
case proplists:get_bool(verbose, Opts) of
true ->
io:fwrite("Inlining: inline_size=~w inline_effort=~w\n",
@@ -1429,17 +1428,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 +2378,19 @@ kill_id_anns([A | As]) ->
kill_id_anns([]) ->
[].
+kill_function_name_anns(Body) ->
+ F = fun(P) ->
+ case type(P) of
+ primop ->
+ Ann = get_ann(P),
+ Ann1 = lists:keydelete(function_name, 1, Ann),
+ set_ann(P, Ann1);
+ _ ->
+ P
+ end
+ end,
+ cerl_trees:map(F, Body).
+
%% =====================================================================
%% General utilities
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 7a2057713e..1e3755025f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%% @doc Basic functions on Core Erlang abstract syntax trees.
@@ -73,14 +73,12 @@ depth(T) ->
[] ->
0;
Gs ->
- 1 + lists:foldl(fun (G, A) -> max(depth_1(G), A) end, 0, Gs)
+ 1 + lists:foldl(fun (G, A) -> erlang:max(depth_1(G), A) end, 0, Gs)
end.
depth_1(Ts) ->
- lists:foldl(fun (T, A) -> max(depth(T), A) end, 0, Ts).
+ lists:foldl(fun (T, A) -> erlang:max(depth(T), A) end, 0, Ts).
-max(X, Y) when X > Y -> X;
-max(_, Y) -> Y.
%% @spec size(Tree::cerl()) -> integer()
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index b853800d73..26da3ecad2 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -29,6 +29,8 @@
%% Erlc interface.
-export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]).
+-export_type([option/0]).
+
-include("erl_compile.hrl").
-include("core_parse.hrl").
@@ -39,8 +41,7 @@
-type option() :: atom() | {atom(), term()} | {'d', atom(), term()}.
--type line() :: integer().
--type err_info() :: {line(), module(), term()}. %% ErrorDescriptor
+-type err_info() :: {erl_scan:line(), module(), term()}. %% ErrorDescriptor
-type errors() :: [{file:filename(), [err_info()]}].
-type warnings() :: [{file:filename(), [err_info()]}].
-type mod_ret() :: {'ok', module()}
@@ -68,7 +69,7 @@
file(File) -> file(File, ?DEFAULT_OPTIONS).
--spec file(module() | file:filename(), [option()]) -> comp_ret().
+-spec file(module() | file:filename(), [option()] | option()) -> comp_ret().
file(File, Opts) when is_list(Opts) ->
do_compile({file,File}, Opts++env_default_opts());
@@ -86,6 +87,8 @@ forms(Forms, Opt) when is_atom(Opt) ->
%% would have generated a Beam file, false otherwise (if only a binary or a
%% listing file would have been generated).
+-spec output_generated([option()]) -> boolean().
+
output_generated(Opts) ->
noenv_output_generated(Opts++env_default_opts()).
@@ -94,6 +97,8 @@ output_generated(Opts) ->
%% for default options.
%%
+-spec noenv_file(module() | file:filename(), [option()] | option()) -> comp_ret().
+
noenv_file(File, Opts) when is_list(Opts) ->
do_compile({file,File}, Opts);
noenv_file(File, Opt) ->
@@ -104,6 +109,8 @@ noenv_forms(Forms, Opts) when is_list(Opts) ->
noenv_forms(Forms, Opt) when is_atom(Opt) ->
noenv_forms(Forms, [Opt|?DEFAULT_OPTIONS]).
+-spec noenv_output_generated([option()]) -> boolean().
+
noenv_output_generated(Opts) ->
any(fun ({save_binary,_F}) -> true;
(_Other) -> false
@@ -162,13 +169,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];
@@ -215,16 +221,16 @@ format_error({module_name,Mod,Filename}) ->
[Mod,Filename]).
%% The compile state record.
--record(compile, {filename="",
- dir="",
- base="",
- ifile="",
- ofile="",
+-record(compile, {filename="" :: file:filename(),
+ dir="" :: file:filename(),
+ base="" :: file:filename(),
+ ifile="" :: file:filename(),
+ ofile="" :: file:filename(),
module=[],
code=[],
core_code=[],
abstract_code=[], %Abstract code for debugger.
- options=[],
+ options=[] :: [option()],
errors=[],
warnings=[]}).
@@ -295,15 +301,6 @@ fold_comp([{Name,Pass}|Ps], Run, St0) ->
end;
fold_comp([], _Run, St) -> {ok,St}.
-os_process_size() ->
- case os:type() of
- {unix, sunos} ->
- Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"),
- list_to_integer(lib:nonl(Size));
- _ ->
- 0
- end.
-
run_tc({Name,Fun}, St) ->
Before0 = statistics(runtime),
Val = (catch Fun(St)),
@@ -312,9 +309,8 @@ run_tc({Name,Fun}, St) ->
{After_c, _} = After0,
Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize),
Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])),
- Sz = lists:flatten(io_lib:format("~.1f MB", [os_process_size()/1024])),
- io:format(" ~-30s: ~10.2f s ~12s ~10s\n",
- [Name,(After_c-Before_c) / 1000,Mem,Sz]),
+ io:format(" ~-30s: ~10.2f s ~12s\n",
+ [Name,(After_c-Before_c) / 1000,Mem]),
Val.
comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) ->
@@ -371,7 +367,7 @@ mpf(Ms) ->
[{File,[M || {F,M} <- Ms, F =:= File]} ||
File <- lists:usort([F || {F,_} <- Ms])].
-%% passes(form|file, [Option]) -> [{Name,PassFun}]
+%% passes(forms|file, [Option]) -> [{Name,PassFun}]
%% Figure out which passes that need to be run.
passes(forms, Opts) ->
@@ -590,7 +586,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 +622,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}]},
@@ -826,6 +824,10 @@ foldl_transform(St, [T|Ts]) ->
{'EXIT',R} ->
Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}};
+ {warning, Forms, Ws} ->
+ foldl_transform(
+ St#compile{code=Forms,
+ warnings=St#compile.warnings ++ Ws}, Ts);
Forms ->
foldl_transform(St#compile{code=Forms}, Ts)
end;
@@ -835,7 +837,6 @@ get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts].
core_transforms(St) ->
%% The options field holds the complete list of options at this
-
Ts = get_core_transforms(St#compile.options),
foldl_core_transforms(St, Ts).
@@ -909,13 +910,8 @@ expand_module(#compile{code=Code,options=Opts0}=St0) ->
{ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}.
core_module(#compile{code=Code0,options=Opts}=St) ->
- case v3_core:module(Code0, Opts) of
- {ok,Code,Ws} ->
- {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}};
- {error,Es,Ws} ->
- {error,St#compile{warnings=St#compile.warnings ++ Ws,
- errors=St#compile.errors ++ Es}}
- end.
+ {ok,Code,Ws} = v3_core:module(Code0, Opts),
+ {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}.
core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) ->
{ok,Code,Ws} = sys_core_fold:module(Code0, Opts),
@@ -1184,12 +1180,12 @@ write_binary(Name, Bin, St) ->
%% report_errors(State) -> ok
%% report_warnings(State) -> ok
-report_errors(St) ->
- case member(report_errors, St#compile.options) of
+report_errors(#compile{options=Opts,errors=Errors}) ->
+ case member(report_errors, Opts) of
true ->
foreach(fun ({{F,_L},Eds}) -> list_errors(F, Eds);
({F,Eds}) -> list_errors(F, Eds) end,
- St#compile.errors);
+ Errors);
false -> ok
end.
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/core_lint.erl b/lib/compiler/src/core_lint.erl
index b633f568c9..b513a8965c 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -65,7 +65,8 @@
| {'return_mismatch', fa()} | {'undefined_function', fa()}
| {'duplicate_var', cerl:var_name(), fa()}
| {'unbound_var', cerl:var_name(), fa()}
- | {'undefined_function', fa(), fa()}.
+ | {'undefined_function', fa(), fa()}
+ | {'tail_segment_not_at_end', fa()}.
-type error() :: {module(), err_desc()}.
-type warning() :: {module(), term()}.
@@ -116,7 +117,9 @@ format_error({duplicate_var,N,{F,A}}) ->
format_error({unbound_var,N,{F,A}}) ->
io_lib:format("unbound variable ~s in ~w/~w", [N,F,A]);
format_error({undefined_function,{F1,A1},{F2,A2}}) ->
- io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]).
+ io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]);
+format_error({tail_segment_not_at_end,{F,A}}) ->
+ io_lib:format("binary tail segment not at end in ~w/~w", [F,A]).
-type ret() :: {'ok', [{module(), [warning(),...]}]}
| {'error', [{module(), [error(),...]}],
@@ -450,7 +453,8 @@ pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) ->
pattern_list([H,T], Def, Ps, St);
pattern(#c_tuple{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
-pattern(#c_binary{segments=Ss}, Def, Ps, St) ->
+pattern(#c_binary{segments=Ss}, Def, Ps, St0) ->
+ St = pat_bin_tail_check(Ss, St0),
pat_bin(Ss, Def, Ps, St);
pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) ->
{Vvs,St1} = variable(V, Ps, St0),
@@ -482,6 +486,19 @@ pat_segment(#c_bitstr{val=V,size=S,type=T}, Def0, Ps0, St0) ->
pat_segment(_, Def, Ps, St) ->
{Ps,Def,add_error({not_bs_pattern,St#lint.func}, St)}.
+%% pat_bin_tail_check([Elem], State) -> State.
+%% There must be at most one tail segment (a size-less segment of
+%% type binary) and it must occur at the end.
+
+pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}], St) ->
+ %% Size-less field is OK at the end of the list of segments.
+ St;
+pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}|_], St) ->
+ add_error({tail_segment_not_at_end,St#lint.func}, St);
+pat_bin_tail_check([_|Ss], St) ->
+ pat_bin_tail_check(Ss, St);
+pat_bin_tail_check([], St) -> St.
+
%% pat_bit_expr(SizePat, Type, Defined, State) -> State.
%% Check the Size pattern, this is an input! Because of optimizations,
%% we must allow any kind of constant and literal here.
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index e87bb276de..f8128702dd 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-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: Information about the Erlang built-in functions.
@@ -65,6 +65,8 @@ is_pure(erlang, 'xor', 2) -> true;
is_pure(erlang, abs, 1) -> true;
is_pure(erlang, atom_to_binary, 2) -> true;
is_pure(erlang, atom_to_list, 1) -> true;
+is_pure(erlang, binary_part, 2) -> true;
+is_pure(erlang, binary_part, 3) -> true;
is_pure(erlang, binary_to_atom, 2) -> true;
is_pure(erlang, binary_to_list, 1) -> true;
is_pure(erlang, binary_to_list, 3) -> true;
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 6874054495..63527bda8f 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
@@ -208,7 +208,7 @@ BEAM_FORMAT_NUMBER=0
# New instructions in R10B.
109: bs_init2/6
-110: bs_bits_to_bytes/3
+110: -bs_bits_to_bytes/3
111: bs_add/5
112: apply/1
113: apply_last/2
@@ -274,3 +274,9 @@ BEAM_FORMAT_NUMBER=0
# R13B03
149: on_load/0
+
+# R14A
+
+150: recv_mark/1
+151: recv_set/1
+152: gc_bif3/7
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index 9b73e08ad8..31a1f8b0b7 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% @author Richard Carlsson <[email protected]>
@@ -32,7 +32,7 @@
get/2, is_defined/2, is_empty/1, keys/1, lookup/2, new_key/1,
new_key/2, new_keys/2, new_keys/3, size/1, to_list/1]).
--import(erlang, [max/2]).
+-export_type([environment/0]).
-ifdef(DEBUG).
-export([test/1, test_custom/1, test_custom/2]).
@@ -586,7 +586,7 @@ new_key(N, R, _T, F, Env) ->
new_key(generate(N, R1), R1, 0, F, Env).
start_range(Env) ->
- max(env_size(Env) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE).
+ erlang:max(env_size(Env) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE).
%% The previous key might or might not be used to compute the next key
%% to be tried. It is currently not used.
diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
index c38eab7b42..f6696992b9 100644
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ b/lib/compiler/src/sys_core_dsetel.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Using dsetelement to make multiple-field record updates
@@ -57,8 +57,6 @@
%% if X1 is used exactly once.
%% Thus, we need to track variable usage.
%%
-%% NOTE: This pass must NOT be used if the no_constant_pool option is used.
-%%
-module(sys_core_dsetel).
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 068478496b..96015fbe58 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 ->
@@ -1030,6 +1038,8 @@ fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) ->
eval_append(Call, Arg1, Arg2);
fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) ->
eval_setelement(Call, Arg1, Arg2, Arg3);
+fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) ->
+ eval_is_record(Call, Arg1, Arg2, Arg3, Sub);
fold_non_lit_args(Call, erlang, N, Args, Sub) ->
NumArgs = length(Args),
case erl_internal:comp_op(N, NumArgs) of
@@ -1186,19 +1196,22 @@ eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer
true ->
eval_failure(Call, badarg)
end;
-%% eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
-%% when is_integer(Pos) ->
-%% case orddict:find(V, Types#sub.t) of
-%% {ok,#c_tuple{es=Elements}} ->
-%% if
-%% 1 =< Pos, Pos =< length(Elements) ->
-%% lists:nth(Pos, Elements);
-%% true ->
-%% eval_failure(Call, badarg)
-%% end;
-%% error ->
-%% Call
-%% end;
+eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
+ when is_integer(Pos) ->
+ case orddict:find(V, Types#sub.t) of
+ {ok,#c_tuple{es=Elements}} ->
+ if
+ 1 =< Pos, Pos =< length(Elements) ->
+ case lists:nth(Pos, Elements) of
+ #c_alias{var=Alias} -> Alias;
+ Res -> Res
+ end;
+ true ->
+ eval_failure(Call, badarg)
+ end;
+ error ->
+ Call
+ end;
eval_element(Call, Pos, Tuple, _Types) ->
case is_not_integer(Pos) orelse is_not_tuple(Tuple) of
true ->
@@ -1207,6 +1220,20 @@ eval_element(Call, Pos, Tuple, _Types) ->
Call
end.
+%% eval_is_record(Call, Var, Tag, Size, Types) -> Val.
+%% Evaluates is_record/3 using type information.
+%%
+eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit,
+ #c_literal{val=Size}, Types) ->
+ case orddict:find(V, Types#sub.t) of
+ {ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} ->
+ Lit#c_literal{val=Tag =:= NeededTag andalso
+ length(Es) =:= Size};
+ _ ->
+ Call
+ end;
+eval_is_record(Call, _, _, _, _) -> Call.
+
%% is_not_integer(Core) -> true | false.
%% Returns true if Core is definitely not an integer.
@@ -2806,7 +2833,8 @@ format_error({no_effect,{erlang,F,A}}) ->
end,
flatten(io_lib:format(Fmt, Args));
format_error(result_ignored) ->
- "the result of the expression is ignored";
+ "the result of the expression is ignored "
+ "(suppress the warning by assigning the expression to the _ variable)";
format_error(useless_building) ->
"a term is constructed, but never used";
format_error(bin_opt_alias) ->
diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl
index c8d75b80c6..9f93acb666 100644
--- a/lib/compiler/src/sys_core_inline.erl
+++ b/lib/compiler/src/sys_core_inline.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Function inlining optimisation for Core.
@@ -41,11 +41,9 @@
-module(sys_core_inline).
-%%-compile({inline,{match_fail_fun,0}}).
-
-export([module/2]).
--import(lists, [member/2,map/2,foldl/3,mapfoldl/3]).
+-import(lists, [member/2,map/2,foldl/3,mapfoldl/3,keydelete/3]).
-include("core_parse.hrl").
@@ -178,11 +176,9 @@ weight_func(_Core, Acc) -> Acc + 1.
%% function_clause match_fail (if they have one).
match_fail_fun() ->
- fun (#c_primop{name=#c_literal{val=match_fail},
- args=[#c_tuple{es=[#c_literal{val=function_clause}|As]}]}=P) ->
- Fail = #c_tuple{es=[#c_literal{val=case_clause},
- #c_tuple{es=As}]},
- P#c_primop{args=[Fail]};
+ fun (#c_primop{anno=Anno0,name=#c_literal{val=match_fail}}=P) ->
+ Anno = keydelete(function_name, 1, Anno0),
+ P#c_primop{anno=Anno};
(Other) -> Other
end.
@@ -201,7 +197,7 @@ kill_id_anns(Body) ->
(Expr) ->
%% Mark everything as compiler generated to suppress
%% bogus warnings.
- A = [compiler_generated|core_lib:get_anno(Expr)],
+ A = compiler_generated(core_lib:get_anno(Expr)),
core_lib:set_anno(Expr, A)
end, Body).
@@ -210,3 +206,8 @@ kill_id_anns_1([{'id',_}|As]) ->
kill_id_anns_1([A|As]) ->
[A|kill_id_anns_1(As)];
kill_id_anns_1([]) -> [].
+
+compiler_generated([compiler_generated|_]=Anno) ->
+ Anno;
+compiler_generated(Anno) ->
+ [compiler_generated|Anno -- [compiler_generated]].
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index f80d03dfac..480954adac 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -403,16 +403,21 @@ expr({'fun',Line,Body}, St) ->
expr({call,Line,{atom,La,N}=Atom,As0}, St0) ->
{As,St1} = expr_list(As0, St0),
Ar = length(As),
- case erl_internal:bif(N, Ar) of
- true ->
- {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1};
- false ->
- case imported(N, Ar, St1) of
- {yes,Mod} ->
- {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
- no ->
- {{call,Line,Atom,As},St1}
- end
+ case defined(N,Ar,St1) of
+ true ->
+ {{call,Line,Atom,As},St1};
+ _ ->
+ case imported(N, Ar, St1) of
+ {yes,Mod} ->
+ {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
+ no ->
+ case erl_internal:bif(N, Ar) of
+ true ->
+ {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1};
+ false -> %% This should have been handled by erl_lint
+ {{call,Line,Atom,As},St1}
+ end
+ end
end;
expr({call,Line,{record_field,_,_,_}=M,As0}, St0) ->
expr({call,Line,expand_package(M, St0),As0}, St0);
@@ -685,3 +690,6 @@ imported(F, A, St) ->
{ok,Mod} -> {yes,Mod};
error -> no
end.
+
+defined(F, A, St) ->
+ ordsets:is_element({F,A}, St#expand.defined).
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 83113d1652..77da6c8d00 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,
@@ -1521,7 +1523,9 @@ cg_binary_size_1([], Bits, Acc) ->
[{1,_}|_] ->
{bs_init_bits,cg_binary_bytes_to_bits(Sizes, [])};
[{8,_}|_] ->
- {bs_init2,[E || {8,E} <- Sizes]}
+ {bs_init2,[E || {8,E} <- Sizes]};
+ [] ->
+ {bs_init_bits,[]}
end.
cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) ->
@@ -2022,6 +2026,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..2da24b2908 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -122,14 +122,13 @@
| iclause() | ifun() | iletrec() | imatch() | iprimop()
| iprotect() | ireceive1() | ireceive2() | iset() | itry().
--type error() :: {file:filename(), [{integer(), module(), term()}]}.
-type warning() :: {file:filename(), [{integer(), module(), term()}]}.
-record(core, {vcount=0 :: non_neg_integer(), %Variable counter
fcount=0 :: non_neg_integer(), %Function counter
in_guard=false :: boolean(), %In guard or not.
+ wanted=true :: boolean(), %Result wanted or not.
opts :: [compile:option()], %Options.
- es=[] :: [error()], %Errors.
ws=[] :: [warning()], %Warnings.
file=[{file,""}]}). %File
@@ -140,46 +139,41 @@
| {attribute, integer(), attribute(), _}.
-spec module({module(), [fa()], [form()]}, [compile:option()]) ->
- {'ok',cerl:c_module(),[warning()]} | {'error',[error()],[warning()]}.
+ {'ok',cerl:c_module(),[warning()]}.
module({Mod,Exp,Forms}, Opts) ->
Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp),
- {Kfs0,As0,Es,Ws,_File} = foldl(fun (F, Acc) ->
- form(F, Acc, Opts)
- end, {[],[],[],[],[]}, Forms),
+ {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) ->
+ form(F, Acc, Opts)
+ end, {[],[],[],[]}, Forms),
Kfs = reverse(Kfs0),
As = reverse(As0),
- case Es of
- [] ->
- {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws};
- _ ->
- {error,Es,Ws}
- end.
+ {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}.
-form({function,_,_,_,_}=F0, {Fs,As,Es0,Ws0,File}, Opts) ->
- {F,Es,Ws} = function(F0, Es0, Ws0, File, Opts),
- {[F|Fs],As,Es,Ws,File};
-form({attribute,_,file,{File,_Line}}, {Fs,As,Es,Ws,_}, _Opts) ->
- {Fs,As,Es,Ws,File};
-form({attribute,_,_,_}=F, {Fs,As,Es,Ws,File}, _Opts) ->
- {Fs,[attribute(F)|As],Es,Ws,File}.
+form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) ->
+ {F,Ws} = function(F0, Ws0, File, Opts),
+ {[F|Fs],As,Ws,File};
+form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) ->
+ {Fs,As,Ws,File};
+form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
+ {Fs,[attribute(F)|As],Ws,File}.
attribute({attribute,Line,Name,Val}) ->
{#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}.
-function({function,_,Name,Arity,Cs0}, Es0, Ws0, File, Opts) ->
+function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
%%ok = io:fwrite("~p - ", [{Name,Arity}]),
- St0 = #core{vcount=0,opts=Opts,es=Es0,ws=Ws0,file=[{file,File}]},
+ St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
%%ok = io:fwrite("1", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B0]),
{B1,St2} = ubody(B0, St1),
%%ok = io:fwrite("2", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B1]),
- {B2,#core{es=Es,ws=Ws}} = cbody(B1, St2),
+ {B2,#core{ws=Ws}} = cbody(B1, St2),
%%ok = io:fwrite("3~n", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B2]),
- {{#c_var{name={Name,Arity}},B2},Es,Ws}.
+ {{#c_var{name={Name,Arity}},B2},Ws}.
body(Cs0, Name, Arity, St0) ->
Anno = lineno_anno(element(2, hd(Cs0)), St0),
@@ -213,10 +207,7 @@ clause({clause,Lc,H0,G0,B0}, St0) ->
catch
throw:nomatch ->
St = add_warning(Lc, nomatch, St0),
- {noclause,St}; %Bad pattern
- throw:no_binaries ->
- St = add_error(Lc, no_binaries, St0),
- {noclause,St}
+ {noclause,St} %Bad pattern
end.
clause_arity({clause,_,H0,_,_}) -> length(H0).
@@ -496,22 +487,18 @@ expr({tuple,L,Es0}, St0) ->
{Es1,Eps,St1} = safe_list(Es0, St0),
A = lineno_anno(L, St1),
{ann_c_tuple(A, Es1),Eps,St1};
-expr({bin,L,Es0}, #core{opts=Opts}=St0) ->
- St1 = case member(no_binaries, Opts) of
- false -> St0;
- true -> add_error(L, no_binaries, St0)
- end,
- try expr_bin(Es0, lineno_anno(L, St1), St1) of
+expr({bin,L,Es0}, St0) ->
+ try expr_bin(Es0, lineno_anno(L, St0), St0) of
{_,_,_}=Res -> Res
catch
throw:bad_binary ->
- St2 = add_warning(L, bad_binary, St1),
- LineAnno = lineno_anno(L, St2),
+ St = add_warning(L, bad_binary, St0),
+ LineAnno = lineno_anno(L, St),
As = [#c_literal{anno=LineAnno,val=badarg}],
{#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=error},
- args=As},[],St2}
+ args=As},[],St}
end;
expr({block,_,Es0}, St0) ->
%% Inline the block directly.
@@ -587,10 +574,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 +594,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.
@@ -900,25 +892,22 @@ lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("blc", St0),
- {Tname,St2} = new_var_name(St1),
- LA = lineno_anno(Line, St2),
+ LA = lineno_anno(Line, St1),
LAnno = #a{anno=LA},
- HeadBinPattern = pattern(P,St2),
- #c_binary{segments=Ps} = HeadBinPattern,
- {EPs,St3} = emasculate_segments(Ps,St2),
- Tail = #c_var{anno=LA,name=Tname},
- TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all},
- unit=#c_literal{val=1},
- type=#c_literal{val=binary},
- flags=#c_literal{val=[big,unsigned]}},
- Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]},
- EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]},
+ HeadBinPattern = pattern(P, St1),
+ #c_binary{segments=Ps0} = HeadBinPattern,
+ {Ps,Tail,St2} = append_tail_segment(Ps0, St1),
+ {EPs,St3} = emasculate_segments(Ps, St2),
+ Pattern = HeadBinPattern#c_binary{segments=Ps},
+ EPattern = HeadBinPattern#c_binary{segments=EPs},
{Arg,St4} = new_var(St3),
{Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
+ Tname = Tail#c_var.name,
{Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5),
{Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
{Gc,Gps,St10} = safe(G, St7), %Will be a function argument!
Fc = function_clause([Arg], LA, {Name,1}),
+ {TailSegList,_,St} = append_tail_segment([], St10),
Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[Pattern],
guard=Guardc,
@@ -930,14 +919,14 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
op=#c_var{anno=LA,name={Name,1}},
args=[Tail]}]},
#iclause{anno=LAnno,
- pats=[#c_binary{anno=LA, segments=[TailSegment]}],guard=[],
+ pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[],
body=[Mc]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Gc]}]},
- [],St10};
+ [],St};
lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(Line, St0),
@@ -1045,26 +1034,24 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("lbc", St0),
LA = lineno_anno(Line, St1),
- {[Tail,AccVar],St2} = new_vars(LA, 2, St1),
+ {AccVar,St2} = new_var(LA, St1),
LAnno = #a{anno=LA},
HeadBinPattern = pattern(P, St2),
- #c_binary{segments=Ps} = HeadBinPattern,
- {EPs,St3} = emasculate_segments(Ps, St2),
- TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all},
- unit=#c_literal{val=1},
- type=#c_literal{val=binary},
- flags=#c_literal{val=[big,unsigned]}},
- Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]},
- EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]},
- {Arg,St4} = new_var(St3),
+ #c_binary{segments=Ps0} = HeadBinPattern,
+ {Ps,Tail,St3} = append_tail_segment(Ps0, St2),
+ {EPs,St4} = emasculate_segments(Ps, St3),
+ Pattern = HeadBinPattern#c_binary{segments=Ps},
+ EPattern = HeadBinPattern#c_binary{segments=EPs},
+ {Arg,St5} = new_var(St4),
NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
{var,Lg,AccVar#c_var.name}]},
- {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
- {Bc,Bps,St6} = bc_tq1(Line, E, Qs1, AccVar, St5),
- {Nc,Nps,St7} = expr(NewMore, St6),
- {Gc,Gps,St8} = safe(G, St7), %Will be a function argument!
+ {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
+ {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6),
+ {Nc,Nps,St8} = expr(NewMore, St7),
+ {Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
Fc = function_clause([Arg,AccVar], LA, {Name,2}),
Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc],
+ {TailSegList,_,St} = append_tail_segment([], St9),
Cs = [#iclause{anno=LAnno,
pats=[Pattern,AccVar],
guard=Guardc,
@@ -1074,7 +1061,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
guard=[],
body=Nps ++ [Nc]},
#iclause{anno=LAnno,
- pats=[#c_binary{anno=LA,segments=[TailSegment]},AccVar],
+ pats=[#c_binary{anno=LA,segments=TailSegList},AccVar],
guard=[],
body=[AccVar]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
@@ -1082,7 +1069,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,2}},
args=[Gc,AccExpr]}]},
- [],St8};
+ [],St};
bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(Line, St0),
@@ -1128,6 +1115,29 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
%%Anno = Anno0#a{anno=[compiler_generated|A]},
{set_anno(E, Anno),Pre,St}.
+append_tail_segment(Segs, St) ->
+ app_tail_seg(Segs, St, []).
+
+app_tail_seg([#c_bitstr{val=Var0,size=#c_literal{val=all}}=Seg0]=L,
+ St0, Acc) ->
+ case Var0 of
+ #c_var{name='_'} ->
+ {Var,St} = new_var(St0),
+ Seg = Seg0#c_bitstr{val=Var},
+ {reverse(Acc, [Seg]),Var,St};
+ #c_var{} ->
+ {reverse(Acc, L),Var0,St0}
+ end;
+app_tail_seg([H|T], St, Acc) ->
+ app_tail_seg(T, St, [H|Acc]);
+app_tail_seg([], St0, Acc) ->
+ {Var,St} = new_var(St0),
+ Tail = #c_bitstr{val=Var,size=#c_literal{val=all},
+ unit=#c_literal{val=1},
+ type=#c_literal{val=binary},
+ flags=#c_literal{val=[unsigned,big]}},
+ {reverse(Acc, [Tail]),Var,St}.
+
emasculate_segments(Segs, St) ->
emasculate_segments(Segs, St, []).
@@ -1443,15 +1453,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 +1563,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).
@@ -2098,39 +2107,25 @@ is_simple(#c_literal{}) -> true;
is_simple(#c_cons{hd=H,tl=T}) ->
is_simple(H) andalso is_simple(T);
is_simple(#c_tuple{es=Es}) -> is_simple_list(Es);
-is_simple(#c_binary{segments=Es}) -> is_simp_bin(Es);
is_simple(_) -> false.
-spec is_simple_list([cerl:cerl()]) -> boolean().
is_simple_list(Es) -> lists:all(fun is_simple/1, Es).
--spec is_simp_bin([cerl:cerl()]) -> boolean().
-
-is_simp_bin(Es) ->
- lists:all(fun (#c_bitstr{val=E,size=S}) ->
- is_simple(E) andalso is_simple(S)
- end, Es).
-
%%%
%%% Handling of warnings.
%%%
--type err_desc() :: 'bad_binary' | 'no_binaries' | 'nomatch'.
+-type err_desc() :: 'bad_binary' | 'nomatch'.
-spec format_error(err_desc()) -> nonempty_string().
format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
- "binary construction will fail because of a type mismatch";
-format_error(no_binaries) ->
- "bit syntax is not allowed to be used when compatibility with a previous "
- "version has been requested".
+ "binary construction will fail because of a type mismatch".
add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 ->
St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]};
add_warning(_, _, St) -> St.
-
-add_error(Line, Term, #core{es=Es,file=[{file,File}]}=St) ->
- St#core{es=[{File,[{location(abs_line(Line)),?MODULE,Term}]}|Es]}.
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 8568071e57..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..a7a4d4dc91 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.
@@ -355,8 +361,6 @@ match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) ->
match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A);
match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) ->
match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A);
-match_fail(#k_literal{anno=Anno,val=Atom}, I, A) when is_atom(Atom) ->
- match_fail(#k_atom{anno=Anno,val=Atom}, I, A);
match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) ->
#l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A};
match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) ->
@@ -412,7 +416,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 +440,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)]};