diff options
Diffstat (limited to 'lib/compiler')
46 files changed, 1025 insertions, 336 deletions
diff --git a/lib/compiler/doc/src/book.xml b/lib/compiler/doc/src/book.xml index fc56a837d5..45b49fe46d 100644 --- a/lib/compiler/doc/src/book.xml +++ b/lib/compiler/doc/src/book.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE book SYSTEM "book.dtd"> <book xmlns:xi="http://www.w3.org/2001/XInclude"> <header titlestyle="normal"> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index ddaae2655d..1459f696a0 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE erlref SYSTEM "erlref.dtd"> <erlref> <header> <copyright> - <year>1996</year><year>2012</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -350,12 +350,18 @@ module.beam: module.erl \ parsed code before the code is checked for errors.</p> </item> - <tag><c>asm</c></tag> + <tag><c>from_asm</c></tag> <item> <p>The input file is expected to be assembler code (default file suffix ".S"). Note that the format of assembler files - is not documented, and may change between releases - this - option is primarily for internal debugging use.</p> + is not documented, and may change between releases.</p> + </item> + + <tag><c>from_core</c></tag> + <item> + <p>The input file is expected to be core code (default + file suffix ".core"). Note that the format of core files + is not documented, and may change between releases.</p> </item> <tag><c>no_strict_record_tests</c></tag> @@ -859,6 +865,10 @@ pi() -> 3.1416. {ErrorLine, Module, ErrorDescriptor} </code> + <p><c>ErrorLine</c> will be the atom <c>none</c> if the error does + not correspond to a specific line (e.g. if the source file does + not exist).</p> + <p>A string describing the error is obtained with the following call:</p> <code> diff --git a/lib/compiler/doc/src/fascicules.xml b/lib/compiler/doc/src/fascicules.xml index 43090b4aed..fadd37eefb 100644 --- a/lib/compiler/doc/src/fascicules.xml +++ b/lib/compiler/doc/src/fascicules.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE fascicules SYSTEM "fascicules.dtd"> <fascicules> diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 94fea84557..cb39b28d3d 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> @@ -31,6 +31,146 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 4.9.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Typo fix ambigous -> ambiguous. Thanks to Leo Correa.</p> + <p> + Own Id: OTP-11455</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Lift 'after' blocks to zeroary functions. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11267</p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 4.9.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Expressions such as <c>'B = is_integer(V), if B and B + -> ok end'</c> would crash the compiler.</p> + <p> + Own Id: OTP-11240</p> + </item> + <item> + <p> + <c>compile:file2/2</c> with the option + <c>report_errors</c> could return ErrorInfo tuples with + only two elements, while the documentation says that the + ErrorInfo tuple always has three elements. Also updated + the documentation to add that the first element may be + '<c>none</c>' if no line number is applicable.</p> + <p> + Own Id: OTP-11304 Aux Id: seq12412 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix matching of floating point middle-endian machines. + Thanks to Johannes Weissl.</p> + <p> + Own Id: OTP-11201</p> + </item> + <item> + <p> + Restrict inlining of local fun references. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11211</p> + </item> + <item> + <p> + Silence a misleading warning with some comprehensions. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11212</p> + </item> + <item> + <p> + Forbid returning a match context in beam_validator. + Thanks to Anthony Ramine.</p> + <p> + Own Id: OTP-11247</p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 4.9.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Compiling functions with complex boolean operations in + guards could be very slow. (Thanks to Magnus Muller for + reporting this issue.)</p> + <p> + Own Id: OTP-10939</p> + </item> + <item> + <p> + Certain guard expressions used in a receive statement + could cause the compiler to crash.</p> + <p> + Own Id: OTP-11119 Aux Id: seq12342 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix optimization of some binary comprehensions. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11005</p> + </item> + <item> + <p> + Use a set to store ref registers in beam_receive. Thanks + to Anthony Ramine.</p> + <p> + Own Id: OTP-11069</p> + </item> + <item> + <p> + Fix renaming of bs_put_string instructions. Thanks to + Anthony Ramine.</p> + <p> + Own Id: OTP-11129</p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 4.9.1</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -45,7 +185,7 @@ <item> <p> Forbid multiple values in Core Erlang sequence arguments. - Thanks to Jos� Valim and Anthony Ramine.</p> + Thanks to José Valim and Anthony Ramine.</p> <p> Own Id: OTP-10818</p> </item> @@ -144,7 +284,7 @@ <p> <c>compile:forms/2</c> will now use a {source,SourceFilePath} to set the source returned by - <c>module_info(compile)</c> (Thanks to Jos� Valim)</p> + <c>module_info(compile)</c> (Thanks to José Valim)</p> <p> Own Id: OTP-10150</p> </item> @@ -256,7 +396,7 @@ <item> <p> Fix typo in `compile' doc: unmatched parenthesis (Thanks - to Ricardo Catalinas Jim�nez)</p> + to Ricardo Catalinas Jiménez)</p> <p> Own Id: OTP-9919</p> </item> @@ -757,7 +897,7 @@ (Thanks to Paul Fisher.)</p> <p>Using filter expressions containing <c>andalso</c> or <c>orelse</c> in a list comprehension could cause a - compiler crash. (Thanks to Martin Engstr�m.)</p> + compiler crash. (Thanks to Martin Engström.)</p> <p> Own Id: OTP-8054</p> </item> diff --git a/lib/compiler/doc/src/notes_history.xml b/lib/compiler/doc/src/notes_history.xml index db0dc2f683..9e8934f416 100644 --- a/lib/compiler/doc/src/notes_history.xml +++ b/lib/compiler/doc/src/notes_history.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> - <year>2006</year><year>2009</year> + <year>2006</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/part_notes.xml b/lib/compiler/doc/src/part_notes.xml index e730e3f7e2..0c1fdd567d 100644 --- a/lib/compiler/doc/src/part_notes.xml +++ b/lib/compiler/doc/src/part_notes.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE part SYSTEM "part.dtd"> <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2004</year><year>2009</year> + <year>2004</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/part_notes_history.xml b/lib/compiler/doc/src/part_notes_history.xml index 12366f0006..a4909f156e 100644 --- a/lib/compiler/doc/src/part_notes_history.xml +++ b/lib/compiler/doc/src/part_notes_history.xml @@ -1,11 +1,11 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE part SYSTEM "part.dtd"> <part> <header> <copyright> <year>2006</year> - <year>2011</year> + <year>2013</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> diff --git a/lib/compiler/doc/src/ref_man.xml b/lib/compiler/doc/src/ref_man.xml index 74fe45aa77..6478ad4b11 100644 --- a/lib/compiler/doc/src/ref_man.xml +++ b/lib/compiler/doc/src/ref_man.xml @@ -1,10 +1,10 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE application SYSTEM "application.dtd"> <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2013</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 1c51226314..c590c5e35b 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2012. All Rights Reserved. +%% Copyright Ericsson AB 2012-2013. 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 @@ -70,8 +70,8 @@ rename_instr({bs_put_utf16=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; rename_instr({bs_put_utf32=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; -%% rename_instr({bs_put_string,_,_}=I) -> -%% {bs_put,{f,0},I,[]}; +rename_instr({bs_put_string,_,_}=I) -> + {bs_put,{f,0},I,[]}; rename_instr({bs_add=I,F,[Src1,Src2,U],Dst}) when is_integer(U) -> {bif,I,F,[Src1,Src2,{integer,U}],Dst}; rename_instr({bs_utf8_size=I,F,Src,Dst}) -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index cf5244e1ce..402fbe2e2e 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -123,15 +123,24 @@ is_last_bool([], _) -> false. collect_block(Is) -> collect_block(Is, []). +collect_block([{allocate,N,R}|Is0], Acc) -> + {Inits,Is} = lists:splitwith(fun ({init,{y,_}}) -> true; + (_) -> false + end, Is0), + collect_block(Is, [{set,[],[],{alloc,R,{nozero,N,0,Inits}}}|Acc]); collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) -> - collect_block(Is, [{set,[],[],{alloc,R,{no_opt,Ns,Nh,[]}}}|Acc]); + collect_block(Is, [{set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}|Acc]); collect_block([I|Is]=Is0, Acc) -> case collect(I) of error -> {reverse(Acc),Is0}; Instr -> collect_block(Is, [Instr|Acc]) end. +collect({allocate,N,R}) -> {set,[],[],{alloc,R,{nozero,N,0,[]}}}; collect({allocate_zero,N,R}) -> {set,[],[],{alloc,R,{zero,N,0,[]}}}; +collect({allocate_heap,Ns,Nh,R}) -> {set,[],[],{alloc,R,{nozero,Ns,Nh,[]}}}; +collect({allocate_heap_zero,Ns,Nh,R}) -> {set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}; +collect({init,D}) -> {set,[D],[],init}; collect({test_heap,N,R}) -> {set,[],[],{alloc,R,{nozero,nostack,N,[]}}}; collect({bif,N,F,As,D}) -> {set,[D],As,{bif,N,F}}; collect({gc_bif,N,F,R,As,D}) -> {set,[D],As,{alloc,R,{gc_bif,N,F}}}; @@ -144,6 +153,10 @@ 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}; collect(remove_message) -> {set,[],[],remove_message}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; +collect(fclearerror) -> {set,[],[],fclearerror}; +collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; +collect({fmove,S,D}) -> {set,[D],[S],fmove}; +collect({fconv,S,D}) -> {set,[D],[S],fconv}; collect(_) -> error. %% embed_lines([Instruction]) -> [Instruction] diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index cf5455dfde..124abd13c1 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -425,6 +425,9 @@ bopt_tree([], Forest, Pre) -> safe_bool_op(N, Ar) -> erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar). +bopt_bool_args([V0,V0], Forest0) -> + {V,Forest} = bopt_bool_arg(V0, Forest0), + {[V,V],Forest}; bopt_bool_args(As, Forest) -> mapfoldl(fun bopt_bool_arg/2, Forest, As). diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index e208ffec1f..9d89e21a4e 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -86,7 +86,7 @@ add_to_work_list(F, {Fs,Used}=Sets) -> false -> {[F|Fs],sets:add_element(F, Used)} end. - + %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. %%% This cleanup will slightly reduce file size and slightly speed up loading. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 25428c0c10..5603a677e8 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -51,6 +51,7 @@ norm_block([], Acc) -> Acc. norm({set,[D],As,{bif,N,F}}) -> {bif,N,F,As,D}; norm({set,[D],As,{alloc,R,{gc_bif,N,F}}}) -> {gc_bif,N,F,R,As,D}; +norm({set,[D],[],init}) -> {init,D}; norm({set,[D],[S],move}) -> {move,S,D}; norm({set,[D],[S],fmove}) -> {fmove,S,D}; norm({set,[D],[S],fconv}) -> {fconv,S,D}; diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index b29a3565e4..d57fb80ac2 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -202,19 +202,19 @@ is_label(_) -> false. move(Is) -> move_1(Is, [], []). -move_1([I|Is], End0, Acc0) -> +move_1([I|Is], Ends, Acc0) -> case is_exit_instruction(I) of false -> - move_1(Is, End0, [I|Acc0]); + move_1(Is, Ends, [I|Acc0]); true -> - case extract_seq(Acc0, [I|End0]) of + case extract_seq(Acc0, [I]) of no -> - move_1(Is, End0, [I|Acc0]); + move_1(Is, Ends, [I|Acc0]); {yes,End,Acc} -> - move_1(Is, End, Acc) + move_1(Is, [End|Ends], Acc) end end; -move_1([], End, Acc) -> reverse(Acc, End). +move_1([], Ends, Acc) -> reverse(Acc, lists:append(reverse(Ends))). extract_seq([{line,_}=Line|Is], Acc) -> extract_seq(Is, [Line|Acc]); diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 3dd5ed182e..97a9188ee7 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -151,20 +151,20 @@ opt_recv(Is, Regs, D) -> 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 + case regs_empty(R) of + false -> + %% We now have the new reference in Y registers %% 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 + case opt_ref_used(Is, R, Fail, D) of false -> no; true -> RecvSet = {recv_set,{f,L}}, {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L} end; - [] -> + true -> no end; opt_recv([I|Is], D, R0, L0, Acc) -> @@ -226,9 +226,9 @@ opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) -> opt_update_regs_bl(Is, Regs); opt_update_regs_bl([], Regs) -> Regs. -%% opt_ref_used([Instruction], RefRegister, FailLabel, LabelIndex) -> true|false +%% opt_ref_used([Instruction], RefRegs, 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'. +%% reference as in RefRegs 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'. @@ -236,7 +236,7 @@ opt_update_regs_bl([], Regs) -> Regs. %% 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, +%% If a path hits an comparision between RefRegs 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). %% @@ -245,11 +245,11 @@ opt_update_regs_bl([], Regs) -> Regs. %% we hit an unrecognized instruction, we also give up and return %% 'false' (the optimization may be unsafe). -opt_ref_used(Is, RefReg, Fail, D) -> +opt_ref_used(Is, RefRegs, Fail, D) -> Done = gb_sets:singleton(Fail), Regs = regs_init_x0(), try - _ = opt_ref_used_1(Is, RefReg, D, Done, Regs), + _ = opt_ref_used_1(Is, RefRegs, D, Done, Regs), true catch throw:not_used -> @@ -258,37 +258,39 @@ opt_ref_used(Is, RefReg, Fail, D) -> %% 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) -> +opt_ref_used_1([{block,Bl}|Is], RefRegs, 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 + opt_ref_used_1(Is, RefRegs, D, Done, Regs); +opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], + RefRegs, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefRegs, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefRegs, Regs) of false -> - opt_ref_used_1(Is, RefReg, D, Done, Regs); + opt_ref_used_1(Is, RefRegs, D, Done, Regs); true -> %% The instructions that follow (Is) can only be executed - %% if the message contains the same reference as in RefReg. + %% if the message contains the same reference as in RefRegs. 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 +opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], + RefRegs, D, Done0, Regs) -> + Done = opt_ref_used_1(Is, RefRegs, D, Done0, Regs), + case is_ref_msg_comparison(Args, RefRegs, Regs) of false -> - opt_ref_used_at(Fail, RefReg, D, Done, Regs); + opt_ref_used_at(Fail, RefRegs, 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,_,_,{f,Fail},List}|_], RefReg, D, Done, Regs) -> +opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefRegs, D, Done0, Regs) -> + Done = opt_ref_used_at(Fail, RefRegs, D, Done0, Regs), + opt_ref_used_1(Is, RefRegs, D, Done, Regs); +opt_ref_used_1([{select,_,_,{f,Fail},List}|_], RefRegs, 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) -> + opt_ref_used_in_all(Lbls, RefRegs, D, Done, Regs); +opt_ref_used_1([{label,Lbl}|Is], RefRegs, D, Done, Regs) -> case gb_sets:is_member(Lbl, Done) of true -> Done; - false -> opt_ref_used_1(Is, RefReg, D, Done, Regs) + false -> opt_ref_used_1(Is, RefRegs, D, Done, Regs) end; opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) -> Done; @@ -296,27 +298,25 @@ 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. +%% is_ref_msg_comparison(Args, RefRegs, 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); +is_ref_msg_comparison([R1,R2], RefRegs, Regs) -> + (regs_is_member(R2, RefRegs) andalso regs_is_member(R1, Regs)) orelse + (regs_is_member(R1, RefRegs) andalso regs_is_member(R2, Regs)). + +opt_ref_used_in_all([L|Ls], RefRegs, D, Done0, Regs) -> + Done = opt_ref_used_at(L, RefRegs, D, Done0, Regs), + opt_ref_used_in_all(Ls, RefRegs, D, Done, Regs); opt_ref_used_in_all([], _, _, Done, _) -> Done. -opt_ref_used_at(Fail, RefReg, D, Done0, Regs) -> +opt_ref_used_at(Fail, RefRegs, 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), + Done = opt_ref_used_1(Is, RefRegs, D, Done0, Regs), gb_sets:add(Fail, Done) end. @@ -408,15 +408,3 @@ regs_all_members([], _) -> true. 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 3b51216a6c..58c0f765ae 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -142,6 +142,12 @@ simplify_float(Is0, Ts0) -> throw:not_possible -> not_possible end. +simplify_float_1([{set,[],[],fclearerror}|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, clearerror(Acc)); +simplify_float_1([{set,[],[],fcheckerror}|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, checkerror(Acc)); +simplify_float_1([{set,[{fr,_}],_,_}=I|Is], Ts, Rs, Acc) -> + simplify_float_1(Is, Ts, Rs, [I|Acc]); simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, Ts0, Rs0, Acc0) -> case tdb_find(A0, Ts0) of @@ -600,7 +606,7 @@ checkerror_1([], OrigIs) -> OrigIs. checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. - + %%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 8af0447f63..36f3200d11 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2013. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -61,7 +61,7 @@ is_killed_block(R, Is) -> %% to determine the kill state across branches. is_killed(R, Is, D) -> - St = #live{bl=fun check_killed_block/2,lbl=D,res=gb_trees:empty()}, + St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; {used,_} -> false; @@ -72,7 +72,7 @@ is_killed(R, Is, D) -> %% Determine whether Reg is killed at label Lbl. is_killed_at(R, Lbl, D) when is_integer(Lbl) -> - St0 = #live{bl=fun check_killed_block/2,lbl=D,res=gb_trees:empty()}, + St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St0) of {killed,_} -> true; {used,_} -> false; @@ -87,7 +87,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> %% across branches. is_not_used(R, Is, D) -> - St = #live{bl=check_used_block_fun(D),lbl=D,res=gb_trees:empty()}, + St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; {used,_} -> false; @@ -102,7 +102,7 @@ is_not_used(R, Is, D) -> %% across branches. is_not_used_at(R, Lbl, D) -> - St = #live{bl=check_used_block_fun(D),lbl=D,res=gb_trees:empty()}, + St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St) of {killed,_} -> true; {used,_} -> false; @@ -246,10 +246,10 @@ combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) -> check_liveness(R, [{set,_,_,_}=I|_], St) -> erlang:error(only_allowed_in_blocks, [R,I,St]); -check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St) -> - case BlockCheck(R, Blk) of - transparent -> check_liveness(R, Is, St); - Other when is_atom(Other) -> {Other,St} +check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) -> + case BlockCheck(R, Blk, St0) of + {transparent,St} -> check_liveness(R, Is, St); + {Other,_}=Res when is_atom(Other) -> Res end; check_liveness(R, [{label,_}|Is], St) -> check_liveness(R, Is, St); @@ -533,6 +533,9 @@ check_liveness_fail(R, Op, Args, Fail, St) -> %% %% (Unknown instructions will cause an exception.) +check_killed_block_fun() -> + fun(R, Is, St) -> {check_killed_block(R, Is),St} end. + check_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) -> if X >= Live -> killed; @@ -563,50 +566,51 @@ check_killed_block(_, []) -> transparent. %% %% (Unknown instructions will cause an exception.) -check_used_block_fun(D) -> - fun(R, Is) -> check_used_block(R, Is, D) end. - -check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], D) -> +check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) -> if - X >= Live -> killed; + X >= Live -> {killed,St}; + true -> check_used_block_1(R, Ss, Ds, Op, Is, St) + end; +check_used_block(R, [{set,Ds,Ss,Op}|Is], St) -> + check_used_block_1(R, Ss, Ds, Op, Is, St); +check_used_block(R, [{'%live',Live}|Is], St) -> + case R of + {x,X} when X >= Live -> {killed,St}; + _ -> check_used_block(R, Is, St) + end; +check_used_block(_, [], St) -> {transparent,St}. + +check_used_block_1(R, Ss, Ds, Op, Is, St0) -> + case member(R, Ss) of true -> - case member(R, Ss) orelse - is_reg_used_at(R, Op, D) of - true -> used; - false -> + {used,St0}; + false -> + case is_reg_used_at(R, Op, St0) of + {true,St} -> + {used,St}; + {false,St} -> case member(R, Ds) of - true -> killed; - false -> check_used_block(R, Is, D) + true -> {killed,St}; + false -> check_used_block(R, Is, St) end end - end; -check_used_block(R, [{set,Ds,Ss,Op}|Is], D) -> - case member(R, Ss) orelse - is_reg_used_at(R, Op, D) of - true -> used; - false -> - case member(R, Ds) of - true -> killed; - false -> check_used_block(R, Is, D) - end - end; -check_used_block(R, [{'%live',Live}|Is], D) -> - case R of - {x,X} when X >= Live -> killed; - _ -> check_used_block(R, Is, D) - end; -check_used_block(_, [], _) -> transparent. + end. -is_reg_used_at(R, {gc_bif,_,{f,Lbl}}, D) -> - is_reg_used_at_1(R, Lbl, D); -is_reg_used_at(R, {bif,_,{f,Lbl}}, D) -> - is_reg_used_at_1(R, Lbl, D); -is_reg_used_at(_, _, _) -> false. +is_reg_used_at(R, {gc_bif,_,{f,Lbl}}, St) -> + is_reg_used_at_1(R, Lbl, St); +is_reg_used_at(R, {bif,_,{f,Lbl}}, St) -> + is_reg_used_at_1(R, Lbl, St); +is_reg_used_at(_, _, St) -> + {false,St}. -is_reg_used_at_1(_, 0, _) -> - false; -is_reg_used_at_1(R, Lbl, D) -> - not is_not_used_at(R, Lbl, D). +is_reg_used_at_1(_, 0, St) -> + {false,St}; +is_reg_used_at_1(R, Lbl, St0) -> + case check_liveness_at(R, Lbl, St0) of + {killed,St} -> {false,St}; + {used,St} -> {true,St}; + {unknown,St} -> {true,St} + end. index_labels_1([{label,Lbl}|Is0], Acc) -> Is = lists:dropwhile(fun({label,_}) -> true; @@ -730,6 +734,8 @@ live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) -> live_opt(Is, 0, D, [I|Acc]); live_opt([timeout=I|Is], _, D, Acc) -> live_opt(Is, 0, D, [I|Acc]); +live_opt([{wait,_}=I|Is], _, D, Acc) -> + live_opt(Is, 0, D, [I|Acc]); %% Transparent instructions - they neither use nor modify x registers. live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> @@ -740,8 +746,6 @@ live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); -live_opt([{wait,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> @@ -755,6 +759,12 @@ live_opt([{allocate,_,Live}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Live), D, [I|Acc]); live_opt([{allocate_heap,_,_,Live}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Live), D, [I|Acc]); +live_opt([{'%',_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{recv_set,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); +live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); live_opt([], _, _, Acc) -> Acc. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index eb72290306..48f5135aca 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -530,7 +530,7 @@ valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> %% Update branched state valfun_3(I, branch_state(Fail, Vst)); valfun_2(_, _) -> - error(ambigous_catch_try_state). + error(ambiguous_catch_try_state). %% Handle the remaining floating point instructions here. %% Floating point. @@ -628,6 +628,7 @@ valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) -> Type = bif_type(Op, Src, Vst), set_type_reg(Type, Dst, Vst); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> + assert_term({x,0}, Vst), kill_state(Vst); valfun_4(return, #vst{current=#st{numy=NumY}}) -> error({stack_frame,NumY}); diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 2e7554c1ff..c6de63c69f 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -52,7 +52,7 @@ clause_pats/1, clause_vars/1, concrete/1, cons_hd/1, cons_tl/1, data_arity/1, data_es/1, data_type/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1, - is_c_atom/1, is_c_cons/1, is_c_fun/1, is_c_int/1, + is_c_atom/1, is_c_cons/1, is_c_fname/1, is_c_int/1, is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1, is_data/1, is_literal/1, is_literal_term/1, let_arg/1, let_body/1, let_vars/1, letrec_body/1, letrec_defs/1, @@ -1578,7 +1578,7 @@ make_let_binding_1(R, E, S) -> %% completely. copy(R, Opnd, E, Ctxt, Env, S) -> - case is_c_var(E) of + case is_c_var(E) andalso not is_c_fname(E) of true -> %% The operand reduces to another variable - get its %% ref-structure and attempt to propagate further. @@ -1628,12 +1628,12 @@ copy_var(R, Ctxt, Env, S) -> end. copy_1(R, Opnd, E, Ctxt, Env, S) -> - %% Fun-expression (lambdas) are a bit special; they are copyable, - %% but should preferably not be duplicated, so they should not be - %% copy propagated except into application contexts, where they can - %% be inlined. - case is_c_fun(E) of - true -> + case type(E) of + 'fun' -> + %% Fun-expression (lambdas) are a bit special; they are copyable, + %% but should preferably not be duplicated, so they should not be + %% copy propagated except into application contexts, where they can + %% be inlined. case Ctxt of #app{} -> %% First test if the operand is "outer-pending"; if @@ -1649,7 +1649,28 @@ copy_1(R, Opnd, E, Ctxt, Env, S) -> _ -> residualize_var(R, S) end; - false -> + var -> + %% Variables at this point only refer to local functions; they are + %% copyable but can't appear in guards, so they should not be + %% copy propagated except into application contexts, where they can + %% be inlined. + case Ctxt of + #app{} -> + %% First test if the operand is "outer-pending"; if + %% so, don't inline. + case st__test_outer_pending(Opnd#opnd.loc, S) of + false -> + R1 = env__get(var_name(E), Opnd#opnd.env), + copy_var(R1, Ctxt, Env, S); + true -> + %% Cyclic reference forced inlining to stop + %% (avoiding infinite unfolding). + residualize_var(R, S) + end; + _ -> + residualize_var(R, S) + end; + _ -> %% We have no other cases to handle here residualize_var(R, S) end. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 497af2b52c..38a733751a 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -41,7 +41,8 @@ -type option() :: atom() | {atom(), term()} | {'d', atom(), term()}. --type err_info() :: {erl_scan:line(), module(), term()}. %% ErrorDescriptor +-type err_info() :: {erl_scan:line() | 'none', + module(), term()}. %% ErrorDescriptor -type errors() :: [{file:filename(), [err_info()]}]. -type warnings() :: [{file:filename(), [err_info()]}]. -type mod_ret() :: {'ok', module()} @@ -416,6 +417,10 @@ pass(from_core) -> pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; pass(asm) -> + %% TODO: remove 'asm' in R18 + io:format("compile:file/2 option 'asm' has been deprecated and will be " + "removed in R18.~n" + "Use 'from_asm' instead.~n"), pass(from_asm); pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; @@ -599,7 +604,8 @@ standard_passes() -> core_passes() -> %% Optimization and transforms of Core Erlang code. - [{delay, + [{iff,clint0,?pass(core_lint_module)}, + {delay, [{unless,no_copt, [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, {iff,doldinline,{listing,"oldinline"}}, @@ -1196,9 +1202,9 @@ abstract_code(#compile{code=Code,options=Opts,ofile=OFile}) -> encrypt_abs_code(Abstr, Key0) -> try - {Mode,RealKey} = generate_key(Key0), + RealKey = generate_key(Key0), case start_crypto() of - ok -> {ok,encrypt(Mode, RealKey, Abstr)}; + ok -> {ok,encrypt(RealKey, Abstr)}; {error,_}=E -> E end catch @@ -1215,19 +1221,19 @@ start_crypto() -> {error,[{none,?MODULE,no_crypto}]} end. -generate_key({Mode,String}) when is_atom(Mode), is_list(String) -> - {Mode,beam_lib:make_crypto_key(Mode, String)}; +generate_key({Type,String}) when is_atom(Type), is_list(String) -> + beam_lib:make_crypto_key(Type, String); generate_key(String) when is_list(String) -> generate_key({des3_cbc,String}). -encrypt(des3_cbc=Mode, {K1,K2,K3, IVec}, Bin0) -> - Bin1 = case byte_size(Bin0) rem 8 of +encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> + Bin1 = case byte_size(Bin0) rem BlockSize of 0 -> Bin0; - N -> list_to_binary([Bin0,random_bytes(8-N)]) + N -> list_to_binary([Bin0,random_bytes(BlockSize-N)]) end, - Bin = crypto:des3_cbc_encrypt(K1, K2, K3, IVec, Bin1), - ModeString = atom_to_list(Mode), - list_to_binary([0,length(ModeString),ModeString,Bin]). + Bin = crypto:block_encrypt(Type, Key, IVec, Bin1), + TypeString = atom_to_list(Type), + list_to_binary([0,length(TypeString),TypeString,Bin]). random_bytes(N) -> {A,B,C} = now(), @@ -1289,10 +1295,10 @@ native_compile_1(St) -> {error,R} -> case IgnoreErrors of true -> - Ws = [{St#compile.ifile,[{?MODULE,{native,R}}]}], + Ws = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> - Es = [{St#compile.ifile,[{?MODULE,{native,R}}]}], + Es = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end catch @@ -1301,7 +1307,7 @@ native_compile_1(St) -> case IgnoreErrors of true -> Ws = [{St#compile.ifile, - [{?MODULE,{native_crash,R,Stk}}]}], + [{none,?MODULE,{native_crash,R,Stk}}]}], {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> erlang:raise(Class, R, Stk) @@ -1348,7 +1354,7 @@ save_binary(#compile{module=Mod,ofile=Outfile, save_binary_1(St); _ -> Es = [{St#compile.ofile, - [{?MODULE,{module_name,Mod,Base}}]}], + [{none,?MODULE,{module_name,Mod,Base}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end end. @@ -1362,20 +1368,20 @@ save_binary_1(St) -> ok -> {ok,St}; {error,RenameError} -> - Es0 = [{Ofile,[{?MODULE,{rename,Tfile,Ofile, - RenameError}}]}], + Es0 = [{Ofile,[{none,?MODULE,{rename,Tfile,Ofile, + RenameError}}]}], Es = case file:delete(Tfile) of ok -> Es0; {error,DeleteError} -> Es0 ++ [{Ofile, - [{?MODULE,{delete_temp,Tfile, - DeleteError}}]}] + [{none,?MODULE,{delete_temp,Tfile, + DeleteError}}]}] end, {error,St#compile{errors=St#compile.errors ++ Es}} end; {error,_Error} -> - Es = [{Tfile,[{compile,write_error}]}], + Es = [{Tfile,[{none,compile,write_error}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. @@ -1418,6 +1424,9 @@ report_warnings(#compile{options=Opts,warnings=Ws0}) -> false -> ok end. +format_message(F, P, [{none,Mod,E}|Es]) -> + M = {none,io_lib:format("~ts: ~s~ts\n", [F,P,Mod:format_error(E)])}, + [M|format_message(F, P, Es)]; format_message(F, P, [{{Line,Column}=Loc,Mod,E}|Es]) -> M = {{F,Loc},io_lib:format("~ts:~w:~w ~s~ts\n", [F,Line,Column,P,Mod:format_error(E)])}, @@ -1427,12 +1436,17 @@ format_message(F, P, [{Line,Mod,E}|Es]) -> [F,Line,P,Mod:format_error(E)])}, [M|format_message(F, P, Es)]; format_message(F, P, [{Mod,E}|Es]) -> + %% Not documented and not expected to be used any more, but + %% keep a while just in case. M = {none,io_lib:format("~ts: ~s~ts\n", [F,P,Mod:format_error(E)])}, [M|format_message(F, P, Es)]; format_message(_, _, []) -> []. %% list_errors(File, ErrorDescriptors) -> ok +list_errors(F, [{none,Mod,E}|Es]) -> + io:fwrite("~ts: ~ts\n", [F,Mod:format_error(E)]), + list_errors(F, Es); list_errors(F, [{{Line,Column},Mod,E}|Es]) -> io:fwrite("~ts:~w:~w: ~ts\n", [F,Line,Column,Mod:format_error(E)]), list_errors(F, Es); @@ -1440,6 +1454,8 @@ list_errors(F, [{Line,Mod,E}|Es]) -> io:fwrite("~ts:~w: ~ts\n", [F,Line,Mod:format_error(E)]), list_errors(F, Es); list_errors(F, [{Mod,E}|Es]) -> + %% Not documented and not expected to be used any more, but + %% keep a while just in case. io:fwrite("~ts: ~ts\n", [F,Mod:format_error(E)]), list_errors(F, Es); list_errors(_F, []) -> ok. @@ -1544,7 +1560,7 @@ restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. - + -spec options() -> 'ok'. options() -> @@ -1581,7 +1597,7 @@ help([_|T]) -> help(_) -> ok. - + %% compile(AbsFileName, Outfilename, Options) %% Compile entry point for erl_compile. @@ -1601,7 +1617,7 @@ compile_beam(File0, _OutFile, Opts) -> compile_asm(File0, _OutFile, Opts) -> File = shorten_filename(File0), - case file(File, [asm|make_erl_options(Opts)]) of + case file(File, [from_asm|make_erl_options(Opts)]) of {ok,_Mod} -> ok; Other -> Other end. diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 1e8983f594..67d37ff1fc 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -68,7 +68,7 @@ | {'undefined_function', fa(), fa()} | {'tail_segment_not_at_end', fa()}. --type error() :: {module(), err_desc()}. +-type error() :: {'none', module(), err_desc()}. -type warning() :: {module(), term()}. %%----------------------------------------------------------------------- @@ -162,7 +162,7 @@ return_status(St) -> %% add_warning(ErrorDescriptor, State) -> State' %% Note that we don't use line numbers here. -add_error(E, St) -> St#lint{errors=[{?MODULE,E}|St#lint.errors]}. +add_error(E, St) -> St#lint{errors=[{none,?MODULE,E}|St#lint.errors]}. %%add_warning(W, St) -> St#lint{warnings=[{none,core_lint,W}|St#lint.warnings]}. diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index 0ca2f57dde..a4fe920258 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -1,8 +1,7 @@ -%% -*- coding: utf-8 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2012. All Rights Reserved. +%% Copyright Ericsson AB 2000-2013. 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 @@ -96,7 +95,7 @@ format_error(Other) -> io_lib:write(Other). string_thing($') -> "atom"; %' stupid emacs string_thing($") -> "string". %" stupid emacs - + %% Re-entrant pre-scanner. %% %% If the input list of characters is insufficient to build a term the @@ -214,7 +213,7 @@ pre_comment(eof, Sofar, Pos) -> pre_error(E, Epos, Pos) -> {error,{Epos,core_scan,E}, Pos}. - + %% scan(CharList, StartPos) %% This takes a list of characters and tries to tokenise them. %% diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 75ac91907a..ebc9b1c85b 100644..100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -23,45 +23,148 @@ BEAM_FORMAT_NUMBER=0 # arity or semantics, the format number above must be bumped. # +## @spec label Lbl +## @doc Specify a module local label. +## Label gives this code address a name (Lbl) and marks the start of +## a basic block. 1: label/1 + +## @spec func_info M F A +## @doc Define a function M:F/A 2: func_info/3 + 3: int_code_end/0 # # Function and BIF calls. # + +## @spec call Arity Label +## @doc Call the function at Label. +## Save the next instruction as the return address in the CP register. 4: call/2 + +## @spec call_last Arity Label Dellocate +## @doc Deallocate and do a tail recursive call to the function at Label. +## Do not update the CP register. +## Before the call deallocate Deallocate words of stack. 5: call_last/3 + +## @spec call_only Arity Label +## @doc Do a tail recursive call to the function at Label. +## Do not update the CP register. 6: call_only/2 +## @spec call_ext Arity Destination +## @doc Call the function of arity Arity pointed to by Destination. +## Save the next instruction as the return address in the CP register. 7: call_ext/2 + +## @spec call_ext_last Arity Destination Deallocate +## @doc Deallocate and do a tail call to function of arity Arity +## pointed to by Destination. +## Do not update the CP register. +## Deallocate Deallocate words from the stack before the call. 8: call_ext_last/3 +## @spec bif0 Bif Reg +## @doc Call the bif Bif and store the result in Reg. 9: bif0/2 + +## @spec bif1 Lbl Bif Arg Reg +## @doc Call the bif Bif with the argument Arg, and store the result in Reg. +## On failure jump to Lbl. 10: bif1/4 + +## @spec bif2 Lbl Bif Arg1 Arg2 Reg +## @doc Call the bif Bif with the arguments Arg1 and Arg2, +## and store the result in Reg. +## On failure jump to Lbl. 11: bif2/5 # # Allocating, deallocating and returning. # + +## @spec allocate StackNeed Live +## @doc Allocate space for StackNeed words on the stack. If a GC is needed +## during allocation there are Live number of live X registers. +## Also save the continuation pointer (CP) on the stack. 12: allocate/2 + +## @spec allocate_heap StackNeed HeapNeed Live +## @doc Allocate space for StackNeed words on the stack and ensure there is +## space for HeapNeed words on the heap. If a GC is needed +## save Live number of X registers. +## Also save the continuation pointer (CP) on the stack. 13: allocate_heap/3 + +## @spec allocate_zero StackNeed Live +## @doc Allocate space for StackNeed words on the stack. If a GC is needed +## during allocation there are Live number of live X registers. +## Clear the new stack words. (By writing NIL.) +## Also save the continuation pointer (CP) on the stack. 14: allocate_zero/2 + +## @spec allocate_heap_zero StackNeed HeapNeed Live +## @doc Allocate space for StackNeed words on the stack and HeapNeed words +## on the heap. If a GC is needed +## during allocation there are Live number of live X registers. +## Clear the new stack words. (By writing NIL.) +## Also save the continuation pointer (CP) on the stack. 15: allocate_heap_zero/3 + +## @spec test_heap HeapNeed Live +## @doc Ensure there is space for HeapNeed words on the heap. If a GC is needed +## save Live number of X registers. 16: test_heap/2 + +## @spec init N +## @doc Clear the Nth stack word. (By writing NIL.) 17: init/1 + +## @spec deallocate N +## @doc Restore the continuation pointer (CP) from the stack and deallocate +## N+1 words from the stack (the + 1 is for the CP). 18: deallocate/1 + +## @spec return +## @doc Return to the address in the continuation pointer (CP). 19: return/0 # # Sending & receiving. # +## @spec send +## @doc Send argument in x(0) as a message to the destination process in x(0). +## The message in x(1) ends up as the result of the send in x(0). 20: send/0 + +## @spec remove_message +## @doc Unlink the current message from the message queue and store a +## pointer to the message in x(0). Remove any timeout. 21: remove_message/0 + +## @spec timeout +## @doc Reset the save point of the mailbox and clear the timeout flag. 22: timeout/0 + +## @spec loop_rec Label Source +## @doc Loop over the message queue, if it is empty jump to Label. 23: loop_rec/2 + +## @spec loop_rec_end Label +## @doc Advance the save pointer to the next message and jump back to Label. 24: loop_rec_end/1 + +## @spec wait Label +## @doc Suspend the processes and set the entry point to the beginning of the +## receive loop at Label. 25: wait/1 + +## @spec wait_timeout Lable Time +## @doc Sets up a timeout of Time milllisecons and saves the address of the +## following instruction as the entry point if the timeout triggers. 26: wait_timeout/2 # @@ -83,36 +186,106 @@ BEAM_FORMAT_NUMBER=0 # # Comparision operators. # + +## @spec is_lt Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is not less than Arg2. 39: is_lt/3 + +## @spec is_ge Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is less than Arg2. 40: is_ge/3 + +## @spec is_eq Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is not (numerically) equal to Arg2. 41: is_eq/3 + +## @spec is_ne Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is (numerically) equal to Arg2. 42: is_ne/3 + +## @spec is_eq_exact Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is not exactly equal to Arg2. 43: is_eq_exact/3 + +## @spec is_ne_exact Lbl Arg1 Arg2 +## @doc Compare two terms and jump to Lbl if Arg1 is exactly equal to Arg2. 44: is_ne_exact/3 # # Type tests. # + +## @spec is_integer Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not an integer. 45: is_integer/2 + +## @spec is_float Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a float. 46: is_float/2 + +## @spec is_number Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a number. 47: is_number/2 + +## @spec is_atom Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not an atom. 48: is_atom/2 + +## @spec is_pid Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a pid. 49: is_pid/2 + +## @spec is_reference Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a reference. 50: is_reference/2 + +## @spec is_port Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a port. 51: is_port/2 + +## @spec is_nil Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not nil. 52: is_nil/2 + +## @spec is_binary Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a binary. 53: is_binary/2 + 54: -is_constant/2 + +## @spec is_list Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a cons or nil. 55: is_list/2 + +## @spec is_nonempty_list Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a cons. 56: is_nonempty_list/2 + +## @spec is_tuple Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a tuple. 57: is_tuple/2 + +## @spec test_arity Lbl Arg1 Arity +## @doc Test the arity of (the tuple in) Arg1 and jump +## to Lbl if it is not equal to Arity. 58: test_arity/3 # # Indexing & jumping. # + +## @spec select_val Arg FailLabel Destinations +## @doc Jump to the destination label corresponding to Arg +## in the Destinations list, if no arity matches, jump to FailLabel. 59: select_val/3 + +## @spec select_tuple_arity Tuple FailLabel Destinations +## @doc Check the arity of the tuple Tuple and jump to the corresponding +## destination label, if no arity matches, jump to FailLabel. 60: select_tuple_arity/3 + +## @spec jump Label +## @doc Jump to Label. 61: jump/1 # @@ -124,9 +297,26 @@ BEAM_FORMAT_NUMBER=0 # # Moving, extracting, modifying. # + +## @spec move Source Destination +## @doc Move the source Source (a literal or a register) to +## the destination register Destination. 64: move/2 + +## @spec get_list Source Head Tail +## @doc Get the head and tail (or car and cdr) parts of a list +## (a cons cell) from Source and put them into the registers +## Head and Tail. 65: get_list/3 + +## @spec get_tuple_element Source Element Destination +## @doc Get element number Element from the tuple in Source and put +## it in the destination register Destination. 66: get_tuple_element/3 + +## @spec set_tuple_element NewElement Tuple Position +## @doc Update the element at postition Position of the tuple Tuple +## with the new element NewElement. 67: set_tuple_element/3 # @@ -147,13 +337,26 @@ BEAM_FORMAT_NUMBER=0 # # 'fun' support. # +## @spec call_fun Arity +## @doc Call a fun of arity Arity. Assume arguments in +## registers x(0) to x(Arity-1) and that the fun is in x(Arity). +## Save the next instruction as the return address in the CP register. 75: call_fun/1 + 76: -make_fun/3 + +## @spec is_function Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a +## function (i.e. fun or closure). 77: is_function/2 # # Late additions to R5. # + +## @spec call_ext_only Arity Label +## Do a tail recursive call to the function at Label. +## Do not update the CP register. 78: call_ext_only/2 # @@ -212,9 +415,14 @@ BEAM_FORMAT_NUMBER=0 111: bs_add/5 112: apply/1 113: apply_last/2 +## @spec is_boolean Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a Boolean. 114: is_boolean/2 # New instructions in R10B-6. +## @spec is_function2 Lbl Arg1 Arity +## @doc Test the type of Arg1 and jump to Lbl if it is not a +## function of arity Arity. 115: is_function2/3 # New bit syntax matching in R11B. @@ -229,7 +437,20 @@ BEAM_FORMAT_NUMBER=0 123: bs_restore2/2 # New GC bifs introduced in R11B. + +## @spec gc_bif1 Lbl Live Bif Arg Reg +## @doc Call the bif Bif with the argument Arg, and store the result in Reg. +## On failure jump to Lbl. +## Do a garbage collection if necessary to allocate space on the heap +## for the result (saving Live number of X registers). 124: gc_bif1/5 + +## @spec gc_bif2 Lbl Live Bif Arg1 Arg2 Reg +## @doc Call the bif Bif with the arguments Arg1 and Arg2, +## and store the result in Reg. +## On failure jump to Lbl. +## Do a garbage collection if necessary to allocate space on the heap +## for the result (saving Live number of X registers). 125: gc_bif2/6 # Experimental new bit_level bifs introduced in R11B. @@ -241,6 +462,8 @@ BEAM_FORMAT_NUMBER=0 128: -put_literal/2 # R11B-5 +## @spec is_bitstr Lbl Arg1 +## @doc Test the type of Arg1 and jump to Lbl if it is not a bit string. 129: is_bitstr/2 # R12B @@ -250,7 +473,12 @@ BEAM_FORMAT_NUMBER=0 133: bs_init_writable/0 134: bs_append/8 135: bs_private_append/6 + +## @spec trim N Remaining +## @doc Reduce the stack usage by N words, +## keeping the CP on the top of the stack. 136: trim/2 + 137: bs_init_bits/6 # R12B-5 @@ -277,8 +505,24 @@ BEAM_FORMAT_NUMBER=0 # R14A +## @spec recv_mark Label +## @doc Save the end of the message queue and the address of +## the label Label so that a recv_set instruction can start +## scanning the inbox from this position. 150: recv_mark/1 + +## @spec recv_set Label +## @doc Check that the saved mark points to Label and set the +## save pointer in the message queue to the last position +## of the message queue saved by the recv_mark instruction. 151: recv_set/1 + +## @spec gc_bif3 Lbl Live Bif Arg1 Arg2 Arg3 Reg +## @doc Call the bif Bif with the arguments Arg1, Arg2 and Arg3, +## and store the result in Reg. +## On failure jump to Lbl. +## Do a garbage collection if necessary to allocate space on the heap +## for the result (saving Live number of X registers). 152: gc_bif3/7 # R15A diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index cda3f7d81e..6b0ae87172 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2342,6 +2342,25 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, Case#c_case{arg=Cexpr,clauses=[Ca,Cb]}; {_,_,_} -> impossible end; +move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, + #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) -> + %% + %% let <Lvars> = do <Seq-arg> + %% <Seq-body> + %% in <Let-body> + %% + %% ==> + %% + %% do <Seq-arg> + %% let <Lvars> = <Seq-body> + %% in <Let-body> + %% + Sarg = body(Sarg0, Sub0), + Sbody1 = body(Sbody0, Sub0), + {Lvs,Sbody,Sub} = let_substs(Lvs0, Sbody1, Sub0), + Lbody = body(Lbody0, Sub), + Seq#c_seq{arg=Sarg,body=Let#c_let{vars=Lvs,arg=core_lib:make_values(Sbody), + body=Lbody}}; move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 7d918a55ed..48d9c16718 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -344,6 +344,8 @@ expr({'receive',Line,Cs0,To0,ToEs0}, St0) -> {{'receive',Line,Cs,To,ToEs},St3}; expr({'fun',Line,Body}, St) -> fun_tq(Line, Body, St); +expr({named_fun,Line,Name,Cs}, St) -> + fun_tq(Line, Cs, St, Name); expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), @@ -475,6 +477,11 @@ fun_tq(Lf, {clauses,Cs0}, St0) -> Index = Uniq = 0, {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. +fun_tq(Line, Cs0, St0, Name) -> + {Cs1,St1} = fun_clauses(Cs0, St0), + {Fname,St2} = new_fun_name(St1, Name), + {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}. + fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), {G,St2} = guard(G0, St1), @@ -485,9 +492,12 @@ fun_clauses([], St) -> {[],St}. %% new_fun_name(State) -> {FunName,State}. -new_fun_name(#expand{func=F,arity=A,fcount=I}=St) -> +new_fun_name(St) -> + new_fun_name(St, 'fun'). + +new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) -> Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) - ++ "-fun-" ++ integer_to_list(I) ++ "-", + ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-", {list_to_atom(Name),St#expand{fcount=I+1}}. %% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 01042cc56f..321cf7af1c 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2012. All Rights Reserved. +%% Copyright Ericsson AB 1999-2013. 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 @@ -92,7 +92,7 @@ -record(icase, {anno=#a{},args,clauses,fc}). -record(icatch, {anno=#a{},body}). -record(iclause, {anno=#a{},pats,pguard=[],guard,body}). --record(ifun, {anno=#a{},id,vars,clauses,fc}). +-record(ifun, {anno=#a{},id,vars,clauses,fc,name=unnamed}). -record(iletrec, {anno=#a{},defs,body}). -record(imatch, {anno=#a{},pat,guard=[],arg,fc}). -record(iprimop, {anno=#a{},name,args}). @@ -553,16 +553,22 @@ expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), {As1,St2} = exprs(As0, St1), - {Evs,Hs0,St3} = try_after(As1, St2), - %% We must kill the id for any funs in the duplicated after body, - %% to avoid getting two local functions having the same name. - Hs = kill_id_anns(Hs0), + {Name,St3} = new_fun_name("after", St2), {V,St4} = new_var(St3), % (must not exist in As1) - %% TODO: this duplicates the 'after'-code; should lift to function. - Lanno = lineno_anno(L, St4), - {#itry{anno=#a{anno=Lanno},args=Es1,vars=[V],body=As1++[V], - evars=Evs,handler=Hs}, - [],St4}; + LA = lineno_anno(L, St4), + Lanno = #a{anno=LA}, + Fc = function_clause([], LA, {Name,0}), + Fun = #ifun{anno=Lanno,id=[],vars=[], + clauses=[#iclause{anno=Lanno,pats=[], + guard=[#c_literal{val=true}], + body=As1}], + fc=Fc}, + App = #iapply{anno=Lanno,op=#c_var{anno=LA,name={Name,0}},args=[]}, + {Evs,Hs,St5} = try_after([App], St4), + Try = #itry{anno=Lanno,args=Es1,vars=[V],body=[App,V],evars=Evs,handler=Hs}, + Letrec = #iletrec{anno=Lanno,defs=[{{Name,0},Fun}], + body=[Try]}, + {Letrec,[],St5}; expr({'try',L,Es,Cs,Ecs,As}, St0) -> %% 'try ... [of ...] [catch ...] after ... end' expr({'try',L,[{'try',L,Es,Cs,Ecs,[]}],[],[],As}, St0); @@ -581,7 +587,11 @@ expr({'fun',L,{function,M,F,A}}, St0) -> name=#c_literal{val=make_fun}, args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> - fun_tq(Id, Cs, L, St); + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,'_',Cs,Id}, St) -> + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,Name,Cs,{Index,Uniq,_Fname}}, St) -> + fun_tq({Index,Uniq,Name}, Cs, L, St, {named, Name}); 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), @@ -836,9 +846,9 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> flags=#c_literal{val=Flags}}, Eps ++ Eps2,St2}. -%% fun_tq(Id, [Clauses], Line, State) -> {Fun,[PreExp],State}. +%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}. -fun_tq({_,_,Name}=Id, Cs0, L, St0) -> +fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), @@ -847,7 +857,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) -> Fc = function_clause(Ps, Anno, {Name,Arity}), Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! - vars=Args,clauses=Cs1,fc=Fc}, + vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, {Fun,[],St3}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. @@ -956,7 +966,8 @@ lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> args=[], clauses=[#iclause{anno=LAnno,pats=[], guard=Gs,body=Lps ++ [Lc]}], - fc=#iclause{anno=LAnno,pats=[],guard=[],body=[Mc]}}, + fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[],guard=[],body=[Mc]}}, [],St2}; false -> {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), @@ -1101,7 +1112,8 @@ bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> clauses=[#iclause{anno=LAnno, pats=[], guard=Gs,body=Bps ++ [Bc]}], - fc=#iclause{anno=LAnno,pats=[],guard=[],body=[AccVar]}}, + fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[],guard=[],body=[AccVar]}}, [],St}; false -> {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), @@ -1133,28 +1145,13 @@ 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) -> +append_tail_segment(Segs, St0) -> {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}. + {Segs++[Tail],Var,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). @@ -1187,9 +1184,9 @@ list_gen_pattern(P0, Line, St) -> bc_initial_size(E, Q, St0) -> try - {ElemSzExpr,ElemSzPre,St1} = bc_elem_size(E, St0), + {ElemSzExpr,ElemSzPre,EVs,St1} = bc_elem_size(E, St0), {V,St2} = new_var(St1), - {GenSzExpr,GenSzPre,St3} = bc_gen_size(Q, St2), + {GenSzExpr,GenSzPre,St3} = bc_gen_size(Q, EVs, St2), case ElemSzExpr of #c_literal{val=ElemSz} when ElemSz rem 8 =:= 0 -> NumBytesExpr = #c_literal{val=ElemSz div 8}, @@ -1214,11 +1211,13 @@ bc_initial_size(E, Q, St0) -> bc_elem_size({bin,_,El}, St0) -> case bc_elem_size_1(El, 0, []) of {Bits,[]} -> - {#c_literal{val=Bits},[],St0}; + {#c_literal{val=Bits},[],[],St0}; {Bits,Vars0} -> [{U,V0}|Pairs] = sort(Vars0), F = bc_elem_size_combine(Pairs, U, [V0], []), - bc_mul_pairs(F, #c_literal{val=Bits}, [], St0) + Vs = [V || {_,#c_var{name=V}} <- Vars0], + {E,Pre,St} = bc_mul_pairs(F, #c_literal{val=Bits}, [], St0), + {E,Pre,Vs,St} end. bc_elem_size_1([{bin_element,_,_,{integer,_,N},Flags}|Es], Bits, Vars) -> @@ -1260,11 +1259,11 @@ bc_add_list_1([H|T], Pre, E, St0) -> bc_add_list_1([], Pre, E, St) -> {E,reverse(Pre),St}. -bc_gen_size(Q, St) -> - bc_gen_size_1(Q, #c_literal{val=1}, [], St). +bc_gen_size(Q, EVs, St) -> + bc_gen_size_1(Q, EVs, #c_literal{val=1}, [], St). -bc_gen_size_1([{generate,L,El,Gen}|Qs], E0, Pre0, St0) -> - bc_verify_non_filtering(El), +bc_gen_size_1([{generate,L,El,Gen}|Qs], EVs, E0, Pre0, St0) -> + bc_verify_non_filtering(El, EVs), case Gen of {var,_,ListVar} -> Lanno = lineno_anno(L, St0), @@ -1275,16 +1274,16 @@ bc_gen_size_1([{generate,L,El,Gen}|Qs], E0, Pre0, St0) -> name=#c_literal{val=length}, args=[#c_var{name=ListVar}]}}, {E,Pre,St} = bc_gen_size_mul(E0, LenVar, [Set|Pre0], St1), - bc_gen_size_1(Qs, E, Pre, St); + bc_gen_size_1(Qs, EVs, E, Pre, St); _ -> %% The only expressions we handle is literal lists. Len = bc_list_length(Gen, 0), {E,Pre,St} = bc_gen_size_mul(E0, #c_literal{val=Len}, Pre0, St0), - bc_gen_size_1(Qs, E, Pre, St) + bc_gen_size_1(Qs, EVs, E, Pre, St) end; -bc_gen_size_1([{b_generate,_,El,Gen}|Qs], E0, Pre0, St0) -> - bc_verify_non_filtering(El), - {MatchSzExpr,Pre1,St1} = bc_elem_size(El, St0), +bc_gen_size_1([{b_generate,_,El,Gen}|Qs], EVs, E0, Pre0, St0) -> + bc_verify_non_filtering(El, EVs), + {MatchSzExpr,Pre1,_,St1} = bc_elem_size(El, St0), Pre2 = reverse(Pre1, Pre0), {ResVar,St2} = new_var(St1), {BitSizeExpr,Pre3,St3} = bc_gen_bit_size(Gen, Pre2, St2), @@ -1292,10 +1291,10 @@ bc_gen_size_1([{b_generate,_,El,Gen}|Qs], E0, Pre0, St0) -> MatchSzExpr)}, Pre4 = [Div|Pre3], {E,Pre,St} = bc_gen_size_mul(E0, ResVar, Pre4, St3), - bc_gen_size_1(Qs, E, Pre, St); -bc_gen_size_1([], E, Pre, St) -> + bc_gen_size_1(Qs, EVs, E, Pre, St); +bc_gen_size_1([], _, E, Pre, St) -> {E,reverse(Pre),St}; -bc_gen_size_1(_, _, _, _) -> +bc_gen_size_1(_, _, _, _, _) -> throw(impossible). bc_gen_bit_size({var,L,V}, Pre0, St0) -> @@ -1312,13 +1311,20 @@ bc_gen_bit_size({bin,_,_}=Bin, Pre, St) -> bc_gen_bit_size(_, _, _) -> throw(impossible). -bc_verify_non_filtering({bin,_,Els}) -> - foreach(fun({bin_element,_,{var,_,_},_,_}) -> ok; +bc_verify_non_filtering({bin,_,Els}, EVs) -> + foreach(fun({bin_element,_,{var,_,V},_,_}) -> + case member(V, EVs) of + true -> throw(impossible); + false -> ok + end; (_) -> throw(impossible) end, Els); -bc_verify_non_filtering({var,_,_}) -> - ok; -bc_verify_non_filtering(_) -> +bc_verify_non_filtering({var,_,V}, EVs) -> + case member(V, EVs) of + true -> throw(impossible); + false -> ok + end; +bc_verify_non_filtering(_, _) -> throw(impossible). bc_list_length({string,_,Str}, Len) -> @@ -1709,13 +1715,18 @@ uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> Used = union(used_in_any(As1), used_in_any(Cs1)), New = new_in_all(Cs1), {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; -uexpr(#ifun{anno=A,id=Id,vars=As,clauses=Cs0,fc=Fc0}, Ks0, St0) -> +uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> Avs = lit_list_vars(As), - Ks1 = union(Avs, Ks0), - {Cs1,St1} = ufun_clauses(Cs0, Ks1, St0), - {Fc1,St2} = ufun_clause(Fc0, Ks1, St1), - Used = subtract(intersection(used_in_any(Cs1), Ks0), Avs), - {#ifun{anno=A#a{us=Used,ns=[]},id=Id,vars=As,clauses=Cs1,fc=Fc1},St2}; + Ks1 = case Name of + unnamed -> Ks0; + {named,FName} -> union(subtract([FName], Avs), Ks0) + end, + Ks2 = union(Avs, Ks1), + {Cs1,St1} = ufun_clauses(Cs0, Ks2, St0), + {Fc1,St2} = ufun_clause(Fc0, Ks2, St1), + Used = subtract(intersection(used_in_any(Cs1), Ks1), Avs), + A1 = A0#a{us=Used,ns=[]}, + {#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2}; uexpr(#iapply{anno=A,op=Op,args=As}, _, St) -> Used = union(lit_vars(Op), lit_list_vars(As)), {#iapply{anno=A#a{us=Used},op=Op,args=As},St}; @@ -1901,7 +1912,7 @@ new_in_all([Le|Les]) -> foldl(fun (L, Ns) -> intersection((get_anno(L))#a.ns, Ns) end, (get_anno(Le))#a.ns, Les); new_in_all([]) -> []. - + %% The AfterVars are the variables which are used afterwards. We need %% this to work out which variables are actually exported and used %% from case/receive. In subblocks/clauses the AfterVars of the block @@ -2010,15 +2021,24 @@ cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) -> cexpr(#icatch{anno=A,body=Les}, _As, St0) -> {Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export! {#c_catch{body=Ces},[],A#a.us,St1}; -cexpr(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> - {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! - {Cfc,St2} = cclause(Lfc, [], St1), - Anno = A#a.anno, - {#c_fun{anno=Id++Anno,vars=Args, - body=#c_case{anno=Anno, - arg=set_anno(core_lib:make_values(Args), Anno), - clauses=Ccs ++ [Cfc]}}, - [],A#a.us,St2}; +cexpr(#ifun{name=unnamed}=Fun, As, St0) -> + cfun(Fun, As, St0); +cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0, + As, St0) -> + case is_element(Name, Us0) of + false -> + cfun(Fun0, As, St0); + true -> + A1 = A0#a{us=del_element(Name, Us0)}, + Fun1 = Fun0#ifun{anno=A1}, + {#c_fun{body=Body}=CFun0,[],Us1,St1} = cfun(Fun1, As, St0), + RecVar = #c_var{name={Name,length(Ps)}}, + Let = #c_let{vars=[#c_var{name=Name}],arg=RecVar,body=Body}, + CFun1 = CFun0#c_fun{body=Let}, + Letrec = #c_letrec{defs=[{RecVar,CFun1}], + body=RecVar}, + {Letrec,[],Us1,St1} + end; cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) -> {#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St}; cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) -> @@ -2045,23 +2065,15 @@ cexpr(Lit, _As, St) -> %%Vs = lit_vars(Lit), {set_anno(Lit, Anno#a.anno),[],Vs,St}. -%% Kill the id annotations for any fun inside the expression. -%% Necessary when duplicating code in try ... after. - -kill_id_anns(#ifun{clauses=Cs0}=Fun) -> - Cs = kill_id_anns(Cs0), - Fun#ifun{clauses=Cs,id=[]}; -kill_id_anns(#a{}=A) -> - %% Optimization: Don't waste time searching for funs inside annotations. - A; -kill_id_anns([H|T]) -> - [kill_id_anns(H)|kill_id_anns(T)]; -kill_id_anns([]) -> []; -kill_id_anns(Tuple) when is_tuple(Tuple) -> - L0 = tuple_to_list(Tuple), - L = kill_id_anns(L0), - list_to_tuple(L); -kill_id_anns(Other) -> Other. +cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> + {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! + {Cfc,St2} = cclause(Lfc, [], St1), + Anno = A#a.anno, + {#c_fun{anno=Id++Anno,vars=Args, + body=#c_case{anno=Anno, + arg=set_anno(core_lib:make_values(Args), Anno), + clauses=Ccs ++ [Cfc]}}, + [],A#a.us,St2}. %% lit_vars(Literal) -> [Var]. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 5f1c108f7c..65f1251099 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -160,8 +160,8 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end. - - + + %% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}. %% Do the main sequence of a body. A body ends in an atomic value or %% values. Must check if vector first so do expr. @@ -834,7 +834,7 @@ last([_|T]) -> last(T). first([_]) -> []; first([H|T]) -> [H|first(T)]. - + %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1428,7 +1428,7 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end end. - + %% ubody_used_vars(Expr, State) -> [UsedVar] %% Return all used variables for the body sequence. Much more %% efficient than using ubody/3 if the body contains nested letrecs. @@ -1875,7 +1875,7 @@ format_error(bad_segment_size) -> add_warning(none, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), - St#kern{ws=[{File,[{?MODULE,Term}]}|Ws]}; + St#kern{ws=[{File,[{none,?MODULE,Term}]}|Ws]}; add_warning(Line, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}. diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 0d00769704..4ffbe07e32 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -21,7 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, t_case/1,t_and_or/1,t_andalso/1,t_orelse/1,inside/1,overlap/1, - combined/1,in_case/1,before_and_inside_if/1]). + combined/1,in_case/1,before_and_inside_if/1, + slow_compilation/1]). -include_lib("test_server/include/test_server.hrl"). @@ -472,6 +473,36 @@ before_and_inside_if_2(XDo1, XDo2, Do3) -> end, {CH1,CH2}. + +-record(state, {stack = []}). + +slow_compilation(_) -> + %% The function slow_compilation_1 used to compile very slowly. + ok = slow_compilation_1({a}, #state{}). + +slow_compilation_1(T1, #state{stack = [T2|_]}) + when element(1, T2) == a, element(1, T1) == b, element(1, T1) == c -> + ok; +slow_compilation_1(T, _) + when element(1, T) == a1; element(1, T) == b1; element(1, T) == c1 -> + ok; +slow_compilation_1(T, _) + when element(1, T) == a2; element(1, T) == b2; element(1, T) == c2 -> + ok; +slow_compilation_1(T, _) when element(1, T) == a -> + ok; +slow_compilation_1(T, _) + when + element(1, T) == a, + (element(1, T) == b) and (element(1, T) == c) -> + ok; +slow_compilation_1(_, T) when element(1, T) == a -> + ok; +slow_compilation_1(_, T) when element(1, T) == b -> + ok; +slow_compilation_1(T, _) when element(1, T) == a -> + ok. + %% Utilities. check(V1, V0) -> diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index bc1a9e2b3b..626f89ba7a 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -28,7 +28,7 @@ overwrite_catchtag/1,overwrite_trytag/1,accessing_tags/1,bad_catch_try/1, cons_guard/1, freg_range/1,freg_uninit/1,freg_state/1, - bin_match/1,bin_aligned/1,bad_dsetel/1, + bin_match/1,bad_bin_match/1,bin_aligned/1,bad_dsetel/1, state_after_fault_in_catch/1,no_exception_in_catch/1, undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1]). @@ -56,7 +56,7 @@ groups() -> unsafe_catch,dead_code,mult_labels, overwrite_catchtag,overwrite_trytag,accessing_tags, bad_catch_try,cons_guard,freg_range,freg_uninit, - freg_state,bin_match,bin_aligned,bad_dsetel, + freg_state,bin_match,bad_bin_match,bin_aligned,bad_dsetel, state_after_fault_in_catch,no_exception_in_catch, undef_label,illegal_instruction,failing_gc_guard_bif]}]. @@ -317,6 +317,11 @@ bin_match(Config) when is_list(Config) -> {{t,x,1},{{bs_restore,1},16,{no_save_point,1}}}] = Errors, ok. +bad_bin_match(Config) when is_list(Config) -> + [{{t,t,1},{return,5,{match_context,{x,0}}}}] = + do_val(bad_bin_match, Config), + ok. + bin_aligned(Config) when is_list(Config) -> Errors = do_val(bin_aligned, Config), ?line diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S b/lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S new file mode 100644 index 0000000000..a60ca1e89a --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S @@ -0,0 +1,15 @@ +{module, bad_bin_match}. %% version = 0 + +{exports, [{t,1}]}. + +{attributes, []}. + +{labels, 3}. + + +{function, t, 1, 2}. + {label,1}. + {func_info,{atom,t},{atom,t},1}. + {label,2}. + {test,bs_start_match2,{f,1},1,[{x,0},0],{x,0}}. + return. diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index d39e340429..4450405695 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2013. 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 @@ -25,7 +25,7 @@ init_per_group/2,end_per_group/2, byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1, - nomatch/1,sizes/1,tail/1]). + nomatch/1,sizes/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ all() -> test_lib:recompile(?MODULE), [byte_aligned, bit_aligned, extended_byte_aligned, extended_bit_aligned, mixed, filters, trim_coverage, - nomatch, sizes, tail]. + nomatch, sizes]. groups() -> []. @@ -282,45 +282,14 @@ sizes(Config) when is_list(Config) -> ?line <<1,2,3,0>> = Fun13(7), ?line <<1,2,3,0,0>> = Fun13(8), + <<0:3>> = cs_default(<< <<0:S>> || S <- [0,1,2] >>), + <<0:3>> = cs_default(<< <<0:S>> || <<S>> <= <<0,1,2>> >>), + ?line {'EXIT',_} = (catch << <<C:4>> || <<C:8>> <= {1,2,3} >>), ?line cs_end(), ok. -tail(Config) when is_list(Config) -> - ?line [] = tail_1(<<0:7>>), - ?line [0] = tail_1(<<0>>), - ?line [0] = tail_1(<<0:12>>), - ?line [0,0] = tail_1(<<0:20>>), - - ?line [] = tail_2(<<0:7>>), - ?line [42] = tail_2(<<0>>), - ?line [] = tail_2(<<0:12>>), - ?line [42,42] = tail_2(<<0,1>>), - - ?line <<>> = tail_3(<<0:7>>), - ?line <<42>> = tail_3(<<0>>), - ?line <<42>> = tail_3(<<0:12>>), - ?line <<42,42>> = tail_3(<<0:20>>), - - ?line [] = tail_4(<<0:15>>), - ?line [7] = tail_4(<<7,8>>), - ?line [9] = tail_4(<<9,17:12>>), - ok. - -tail_1(Bits) -> - [X || <<X:8/integer, _/bits>> <= Bits]. - -tail_2(Bits) -> - [42 || <<_:8/integer, _/bytes>> <= Bits]. - -tail_3(Bits) -> - << <<42>> || <<_:8/integer, _/bits>> <= Bits >>. - -tail_4(Bits) -> - [X || <<X:8/integer, Tail/bits>> <= Bits, bit_size(Tail) >= 8]. - - cs_init() -> erts_debug:set_internal_state(available_internal_state, true), ok. diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index 4ea5235bb6..ce39de2a82 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -319,6 +319,8 @@ in_guard(Config) when is_list(Config) -> ?line 1 = in_guard_1(<<16#74ad:16>>, 16#e95, 5), ?line 2 = in_guard_1(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), ?line 3 = in_guard_1(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + ?line 3 = in_guard_1(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3), + ?line 3 = in_guard_1(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226), ?line nope = in_guard_1(<<1>>, 42, b), ?line nope = in_guard_1(<<1>>, a, b), ?line nope = in_guard_1(<<1,2>>, 1, 1), diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 8e7b7292cc..93b2fb4ea5 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -50,7 +50,7 @@ groups() -> trycatch_4,opt_crash,otp_5404,otp_5436,otp_5481, otp_5553,otp_5632,otp_5714,otp_5872,otp_6121, otp_6121a,otp_6121b,otp_7202,otp_7345,on_load, - string_table,otp_8949_a,otp_8949_a,split_cases, + string_table,otp_8949_a,otp_8949_b,split_cases, beam_utils_liveopt]}]. init_per_suite(Config) -> @@ -278,6 +278,16 @@ try_it(StartNode, Module, Conf) -> ?line ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), ?line test_server:timetrap_cancel(LastDog), + AsmDog = test_server:timetrap(test_server:minutes(10)), + io:format("Compiling (from assembly): ~s\n", [Src]), + {ok,_} = compile:file(Src, [to_asm,{outdir,Out},report|OtherOpts]), + Asm = filename:join(Out, lists:concat([Module, ".S"])), + CompRc3 = compile:file(Asm, [from_asm,{outdir,Out},report|OtherOpts]), + io:format("Result: ~p\n",[CompRc3]), + {ok,_} = CompRc3, + ok = rpc:call(Node, ?MODULE, load_and_call, [Out, Module]), + test_server:timetrap_cancel(AsmDog), + case StartNode of false -> ok; true -> ?line test_server:stop_node(Node) @@ -630,13 +640,13 @@ string_table(Config) when is_list(Config) -> ok. otp_8949_a(Config) when is_list(Config) -> - value = otp_8949_a(), + value = do_otp_8949_a(), ok. -record(cs, {exs,keys = [],flags = 1}). -record(exs, {children = []}). -otp_8949_a() -> +do_otp_8949_a() -> case id([#cs{}]) of [#cs{}=Cs] -> SomeVar = id(value), diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 229e5a98a1..4ec75d015e 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-2013. 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 @@ -139,8 +139,8 @@ forms_2(Config) when is_list(Config) -> module_mismatch(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), ?line File = filename:join(DataDir, "wrong_module_name.erl"), - ?line {error,[{"wrong_module_name.beam", - [{compile,{module_name,arne,"wrong_module_name"}}]}], + {error,[{"wrong_module_name.beam", + [{none,compile,{module_name,arne,"wrong_module_name"}}]}], []} = compile:file(File, [return]), ?line error = compile:file(File, [report]), @@ -492,6 +492,16 @@ encrypted_abstr_1(Simple, Target) -> ?line {error,beam_lib,{key_missing_or_invalid,"simple.beam",abstract_code}} = beam_lib:chunks("simple.beam", [abstract_code]), ?line ok = file:set_cwd(OldCwd), + + %% Test key compatibility by reading a BEAM file produced before + %% the update to the new crypto functions. + install_crypto_key("an old key"), + KeyCompat = filename:join(filename:dirname(Simple), + "key_compatibility"), + {ok,{key_compatibility,[Chunk]}} = beam_lib:chunks(KeyCompat, + [abstract_code]), + {abstract_code,{raw_abstract_v1,_}} = Chunk, + ok. @@ -759,8 +769,8 @@ do_core({M,A}, Outdir) -> error end. -%% Compile to Beam assembly language (.S) and the try to -%% run .S throught the compiler again. +%% Compile to Beam assembly language (.S) and then try to +%% run .S through the compiler again. asm(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(20)), @@ -781,10 +791,10 @@ do_asm(Beam, Outdir) -> try {ok,M,Asm} = compile:forms(A, ['S']), AsmFile = filename:join(Outdir, atom_to_list(M)++".S"), - {ok,Fd} = file:open(AsmFile, [write]), + {ok,Fd} = file:open(AsmFile, [write,{encoding,utf8}]), beam_listing:module(Fd, Asm), ok = file:close(Fd), - case compile:file(AsmFile, [from_asm,no_postopt,binary,report]) of + case compile:file(AsmFile, [from_asm,binary,report]) of {ok,M,_} -> ok = file:delete(AsmFile); Other -> diff --git a/lib/compiler/test/compile_SUITE_data/key_compatibility.beam b/lib/compiler/test/compile_SUITE_data/key_compatibility.beam Binary files differnew file mode 100644 index 0000000000..28329d2423 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/key_compatibility.beam diff --git a/lib/compiler/test/compile_SUITE_data/key_compatibility.erl b/lib/compiler/test/compile_SUITE_data/key_compatibility.erl new file mode 100644 index 0000000000..e2931f1b12 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/key_compatibility.erl @@ -0,0 +1,8 @@ +-module(key_compatibility). +-export([main/0]). + +%% Compile like this: +%% erlc +'{debug_info_key,"an old key"}' key_compatibility.erl + +main() -> + ok. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index abc9ab6a72..a5a4e62a42 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -299,7 +299,7 @@ unused_multiple_values_error(Config) when is_list(Config) -> Opts = [no_copt,clint,return,from_core,{outdir,PrivDir} |test_lib:opt_opts(?MODULE)], {error,[{unused_multiple_values_error, - [{core_lint,{return_mismatch,{hello,1}}}]}], + [{none,core_lint,{return_mismatch,{hello,1}}}]}], []} = c:c(Core, Opts), ok. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 6067ee8e06..e35692efd1 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -21,7 +21,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, - external/1]). + external/1,eep37/1]). %% Internal export. -export([call_me/1]). @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [test1,overwritten_fun,otp_7202,bif_fun,external]. + [test1,overwritten_fun,otp_7202,bif_fun,external,eep37]. groups() -> []. @@ -197,5 +197,14 @@ external(Config) when is_list(Config) -> call_me(I) -> {ok,I}. +eep37(Config) when is_list(Config) -> + F = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end, + Add = fun _(N) -> N + 1 end, + UnusedName = fun BlackAdder(N) -> N + 42 end, + 720 = F(6), + 10 = Add(9), + 50 = UnusedName(8), + ok. + id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 5656d23090..a0a9bb7ddd 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -813,8 +813,16 @@ and_guard(Config) when is_list(Config) -> ?line ok = relprod({'Set',a,b}, {'Set',a,b}), + ok = and_same_var(42), + {'EXIT',{if_clause,_}} = (catch and_same_var(x)), ok. +and_same_var(V) -> + B = is_integer(V), + if + B or B -> ok + end. + relprod(R1, R2) when (erlang:size(R1) =:= 3) and (erlang:element(1,R1) =:= 'Set'), (erlang:size(R2) =:= 3) and (erlang:element(1,R2) =:= 'Set') -> ok. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index d9b92766e4..e5c2d4f73a 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -36,7 +36,7 @@ all() -> groups() -> [{p,test_lib:parallel(), - [attribute,bsdecode,bsdes,barnes2,decode1,smith, + [attribute,bsdecode,bsdes,barnes2,decode1,smith,fname, itracer,pseudoknot,comma_splitter,lists,really_inlined,otp_7223, coverage]}]. @@ -84,6 +84,7 @@ attribute(Config) when is_list(Config) -> ?comp(itracer). ?comp(pseudoknot). ?comp(comma_splitter). +?comp(fname). try_inline(Mod, Config) -> Node = ?config(testing_node, Config), diff --git a/lib/compiler/test/inline_SUITE_data/fname.erl b/lib/compiler/test/inline_SUITE_data/fname.erl new file mode 100644 index 0000000000..7ad4446bf3 --- /dev/null +++ b/lib/compiler/test/inline_SUITE_data/fname.erl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2013. 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(fname). +-export([?MODULE/0]). + +?MODULE() -> + F = fun bar/1, + G = lists:last([(fun (X) when F =:= X -> X end)]), + F = G(F), + ok. + +bar(X) -> + X. diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index b91f2922fb..ec49267ded 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -23,7 +23,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1]). + export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1, + wait/1]). -include_lib("test_server/include/test_server.hrl"). @@ -44,7 +45,7 @@ all() -> groups() -> [{p,test_lib:parallel(), - [recv,coverage,otp_7980,ref_opt,export]}]. + [recv,coverage,otp_7980,ref_opt,export,wait]}]. init_per_suite(Config) -> @@ -188,7 +189,7 @@ ref_opt(Config) when is_list(Config) -> ref_opt_1(Config) -> ?line DataDir = ?config(data_dir, Config), ?line PrivDir = ?config(priv_dir, Config), - ?line Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.erl"])), + Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.{erl,S}"])), ?line test_lib:p_run(fun(Src) -> do_ref_opt(Src, PrivDir) end, Sources), @@ -196,10 +197,15 @@ ref_opt_1(Config) -> do_ref_opt(Source, PrivDir) -> try - {ok,Mod} = c:c(Source, [{outdir,PrivDir}]), + Ext = filename:extension(Source), + {ok,Mod} = compile:file(Source, [report_errors,report_warnings, + {outdir,PrivDir}] ++ + [from_asm || Ext =:= ".S" ]), + Base = filename:rootname(filename:basename(Source), Ext), + code:purge(list_to_atom(Base)), + BeamFile = filename:join(PrivDir, Base), + code:load_abs(BeamFile), ok = Mod:Mod(), - Base = filename:rootname(filename:basename(Source), ".erl"), - BeamFile = filename:join(PrivDir, Base), {beam_file,Mod,_,_,_,Code} = beam_disasm:file(BeamFile), case Base of "no_"++_ -> @@ -247,4 +253,20 @@ export_1(Reference) -> id({build,self()}), Result. +wait(Config) when is_list(Config) -> + self() ! <<42>>, + <<42>> = wait_1(r, 1, 2), + {1,2,3} = wait_1(1, 2, 3), + ok. + +wait_1(r, _, _) -> + receive + B when byte_size(B) > 0 -> + B + end; +%% beam_utils would wrongly assume that wait/1 could fall through +%% to the next clause. +wait_1(A, B, C) -> + {A,B,C}. + id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S new file mode 100644 index 0000000000..fd14228135 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S @@ -0,0 +1,71 @@ +{module, yes_14}. %% version = 0 + +{exports, [{f,2},{module_info,0},{module_info,1},{yes_14,0}]}. + +{attributes, []}. + +{labels, 12}. + + +{function, yes_14, 0, 2}. + {label,1}. + {func_info,{atom,yes_14},{atom,yes_14},0}. + {label,2}. + {move,{atom,ok},{x,0}}. + return. + + +{function, f, 2, 4}. + {label,3}. + {func_info,{atom,yes_14},{atom,f},2}. + {label,4}. + {allocate_heap,2,3,2}. + {move,{x,0},{y,1}}. + {put_tuple,2,{y,0}}. + {put,{atom,data}}. + {put,{x,1}}. + {call_ext,0,{extfunc,erlang,make_ref,0}}. % Ref in [x0] + {test_heap,4,1}. + {put_tuple,3,{x,1}}. + {put,{atom,request}}. + {put,{x,0}}. + {put,{y,0}}. + {move,{x,0},{y,0}}. % Ref in [x0,y0] + {move,{y,1},{x,0}}. % Ref in [y0] + {kill,{y,1}}. + send. + {move,{y,0},{x,0}}. % Ref in [x0,y0] + {move,{x,0},{y,1}}. % Ref in [x0,y0,y1] + {label,5}. + {loop_rec,{f,7},{x,0}}. % Ref in [y0,y1] + {test,is_tuple,{f,6},[{x,0}]}. + {test,test_arity,{f,6},[{x,0},2]}. + {get_tuple_element,{x,0},0,{x,1}}. + {get_tuple_element,{x,0},1,{x,2}}. + {test,is_eq_exact,{f,6},[{x,1},{atom,reply}]}. + {test,is_eq_exact,{f,6},[{x,2},{y,1}]}. + remove_message. + {move,{atom,ok},{x,0}}. + {deallocate,2}. + return. + {label,6}. + {loop_rec_end,{f,5}}. + {label,7}. + {wait,{f,5}}. + + +{function, module_info, 0, 9}. + {label,8}. + {func_info,{atom,yes_14},{atom,module_info},0}. + {label,9}. + {move,{atom,yes_14},{x,0}}. + {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. + + +{function, module_info, 1, 11}. + {label,10}. + {func_info,{atom,yes_14},{atom,module_info},1}. + {label,11}. + {move,{x,0},{x,1}}. + {move,{atom,yes_14},{x,0}}. + {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl index 3f02fba6a6..5070e3e546 100644 --- a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl @@ -24,11 +24,7 @@ do_call(Process, Label, Request, Timeout) -> {'DOWN', Mref, _, _, Reason} -> exit(Reason) after Timeout -> - erlang:demonitor(Mref), - receive - {'DOWN', Mref, _, _, _} -> true - after 0 -> true - end, + erlang:demonitor(Mref, [flush]), exit(timeout) end catch diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index f00bfe663b..810b2b48c9 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -37,7 +37,7 @@ -export([pattern/1,pattern2/1,pattern3/1,pattern4/1, guard/1,bad_arith/1,bool_cases/1,bad_apply/1, - files/1,effect/1,bin_opt_info/1,bin_construction/1]). + files/1,effect/1,bin_opt_info/1,bin_construction/1, comprehensions/1]). % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(2)). @@ -61,7 +61,7 @@ groups() -> [{p,test_lib:parallel(), [pattern,pattern2,pattern3,pattern4,guard, bad_arith,bool_cases,bad_apply,files,effect, - bin_opt_info,bin_construction]}]. + bin_opt_info,bin_construction,comprehensions]}]. init_per_suite(Config) -> Config. @@ -536,6 +536,16 @@ bin_construction(Config) when is_list(Config) -> ok. +comprehensions(Config) when is_list(Config) -> + Ts = [{tautologic_guards, + <<" + f() -> [ true || true ]. + g() -> << <<1>> || true >>. + ">>, + [], []}], + run(Config, Ts), + ok. + %%% %%% End of test cases. %%% diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 90d2bff0ad..cbdf57f177 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 4.9.1 +COMPILER_VSN = 4.9.4 |