aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/doc/src/Makefile16
-rw-r--r--lib/compiler/doc/src/compile.xml21
-rw-r--r--lib/compiler/doc/src/make.dep19
-rw-r--r--lib/compiler/doc/src/notes.xml246
-rw-r--r--lib/compiler/src/Makefile12
-rw-r--r--lib/compiler/src/beam_asm.erl115
-rw-r--r--lib/compiler/src/beam_block.erl37
-rw-r--r--lib/compiler/src/beam_bsm.erl9
-rw-r--r--lib/compiler/src/beam_clean.erl26
-rw-r--r--lib/compiler/src/beam_dead.erl71
-rw-r--r--lib/compiler/src/beam_dict.erl66
-rw-r--r--lib/compiler/src/beam_disasm.erl43
-rw-r--r--lib/compiler/src/beam_except.erl149
-rw-r--r--lib/compiler/src/beam_jump.erl51
-rw-r--r--lib/compiler/src/beam_listing.erl4
-rw-r--r--lib/compiler/src/beam_receive.erl4
-rw-r--r--lib/compiler/src/beam_split.erl85
-rw-r--r--lib/compiler/src/beam_trim.erl15
-rw-r--r--lib/compiler/src/beam_type.erl20
-rw-r--r--lib/compiler/src/beam_utils.erl34
-rw-r--r--lib/compiler/src/beam_validator.erl47
-rw-r--r--lib/compiler/src/cerl_inline.erl26
-rw-r--r--lib/compiler/src/compile.erl81
-rw-r--r--lib/compiler/src/compiler.app.src4
-rw-r--r--lib/compiler/src/erl_bifs.erl4
-rw-r--r--lib/compiler/src/genop.tab6
-rw-r--r--lib/compiler/src/sys_core_fold.erl132
-rw-r--r--lib/compiler/src/sys_expand_pmod.erl4
-rw-r--r--lib/compiler/src/sys_pre_expand.erl93
-rw-r--r--lib/compiler/src/v3_codegen.erl155
-rw-r--r--lib/compiler/src/v3_core.erl61
-rw-r--r--lib/compiler/src/v3_kernel.erl320
-rw-r--r--lib/compiler/src/v3_kernel.hrl3
-rw-r--r--lib/compiler/src/v3_life.erl137
-rw-r--r--lib/compiler/test/Makefile13
-rw-r--r--lib/compiler/test/beam_disasm_SUITE.erl4
-rw-r--r--lib/compiler/test/beam_expect_SUITE.erl67
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl27
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl6
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl30
-rw-r--r--lib/compiler/test/bs_utf_SUITE.erl21
-rw-r--r--lib/compiler/test/compilation_SUITE.erl51
-rw-r--r--lib/compiler/test/compilation_SUITE_data/on_load_inline.erl23
-rw-r--r--lib/compiler/test/compile_SUITE.erl116
-rw-r--r--lib/compiler/test/compile_SUITE_data/attributes.erl23
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple-phony.mk3
-rw-r--r--lib/compiler/test/compiler.cover2
-rw-r--r--lib/compiler/test/core_SUITE.erl37
-rw-r--r--lib/compiler/test/core_SUITE_data/eval_is_boolean.core22
-rw-r--r--lib/compiler/test/core_SUITE_data/make_effect_seq.core51
-rw-r--r--lib/compiler/test/core_SUITE_data/nomatch_shadow.core28
-rw-r--r--lib/compiler/test/core_SUITE_data/reversed_annos.core49
-rw-r--r--lib/compiler/test/core_SUITE_data/seq_in_guard.core66
-rw-r--r--lib/compiler/test/core_SUITE_data/unsafe_case.core25
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl35
-rw-r--r--lib/compiler/test/error_SUITE.erl2
-rw-r--r--lib/compiler/test/fun_SUITE.erl52
-rw-r--r--lib/compiler/test/guard_SUITE.erl29
-rw-r--r--lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S8
-rw-r--r--lib/compiler/test/inline_SUITE.erl6
-rw-r--r--lib/compiler/test/inline_SUITE_data/comma_splitter.erl18
-rw-r--r--lib/compiler/test/lc_SUITE.erl4
-rw-r--r--lib/compiler/test/misc_SUITE.erl35
-rw-r--r--lib/compiler/test/parteval_SUITE.erl66
-rw-r--r--lib/compiler/test/parteval_SUITE_data/t1.erl140
-rw-r--r--lib/compiler/test/pmod_SUITE.erl5
-rw-r--r--lib/compiler/test/pmod_SUITE_data/pmod_basic.erl6
-rw-r--r--lib/compiler/test/test_lib.erl9
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl36
-rw-r--r--lib/compiler/vsn.mk2
70 files changed, 2149 insertions, 1084 deletions
diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile
index ee41a7074f..13a73a5d31 100644
--- a/lib/compiler/doc/src/Makefile
+++ b/lib/compiler/doc/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+# Copyright Ericsson AB 1997-2012. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -99,14 +99,14 @@ clean clean_docs:
include $(ERL_TOP)/make/otp_release_targets.mk
release_docs_spec: docs
- $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf
- $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf
- $(INSTALL_DIR) $(RELSYSDIR)/doc/html
+ $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
+ $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
+ $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
$(INSTALL_DATA) $(HTMLDIR)/* \
- $(RELSYSDIR)/doc/html
- $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR)
- $(INSTALL_DIR) $(RELEASE_PATH)/man/man3
- $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3
+ "$(RELSYSDIR)/doc/html"
+ $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
+ $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
+ $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
release_spec:
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index 830c89ae84..27d750f929 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2011</year>
+ <year>1996</year><year>2012</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -294,6 +294,12 @@ module.beam: module.erl \
describing what it is doing.</p>
</item>
+ <tag><c>{source,FileName}</c></tag>
+ <item>
+ <p>Sets the value of the source, as returned by
+ <c>module_info(compile)</c>.</p>
+ </item>
+
<tag><c>{outdir,Dir}</c></tag>
<item>
<p>Sets a new directory for the object code. The current
@@ -310,7 +316,7 @@ module.beam: module.erl \
<item>
<p>Add <c>Dir</c> to the list of directories to be searched
when including a file. When encountering an
- <c>-include</c> or <c>-include_dir</c> directive,
+ <c>-include</c> or <c>-include_lib</c> directive,
the compiler searches for header files in the following
directories:</p>
<list type="ordered">
@@ -333,7 +339,8 @@ module.beam: module.erl \
<tag><c>{d,Macro,Value}</c></tag>
<item>
<p>Defines a macro <c>Macro</c> to have the value
- <c>Value</c>. The default is <c>true</c>).</p>
+ <c>Value</c>. <c>Macro</c> is of type atom, and <c>Value</c> can be any term.
+ The default <c>Value</c> is <c>true</c>.</p>
</item>
<tag><c>{parse_transform,Module}</c></tag>
@@ -395,6 +402,14 @@ module.beam: module.erl \
<code>-compile({no_auto_import,[error/1]}).</code>
</item>
+ <tag><c>no_line_info</c></tag>
+
+ <item>
+ <p>Omit line number information in order to produce a slightly
+ smaller output file.
+ </p>
+ </item>
+
</taglist>
<p>If warnings are turned on (the <c>report_warnings</c> option
diff --git a/lib/compiler/doc/src/make.dep b/lib/compiler/doc/src/make.dep
deleted file mode 100644
index f5c097afad..0000000000
--- a/lib/compiler/doc/src/make.dep
+++ /dev/null
@@ -1,19 +0,0 @@
-# ----------------------------------------------------
-# >>>> Do not edit this file <<<<
-# This file was automaticly generated by
-# /home/otp/bin/docdepend
-# ----------------------------------------------------
-
-
-# ----------------------------------------------------
-# TeX files that the DVI file depend on
-# ----------------------------------------------------
-
-book.dvi: book.tex compile.tex ref_man.tex
-
-# ----------------------------------------------------
-# Source inlined when transforming from source to LaTeX
-# ----------------------------------------------------
-
-book.tex: ref_man.xml
-
diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml
index 740cbcf8eb..6d51074d4a 100644
--- a/lib/compiler/doc/src/notes.xml
+++ b/lib/compiler/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2004</year><year>2011</year>
+ <year>2004</year><year>2012</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -31,6 +31,250 @@
<p>This document describes the changes made to the Compiler
application.</p>
+<section><title>Compiler 4.8.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Modules with very many functions would compile very
+ slowly.</p>
+ <p>
+ Own Id: OTP-10123</p>
+ </item>
+ <item>
+ <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>
+ <p>
+ Own Id: OTP-10150</p>
+ </item>
+ <item>
+ <p>
+ A process which had enabled trap_exit would receive EXIT
+ messages after calling the compiler. (Thanks to Jeremy
+ Heater.)</p>
+ <p>
+ Own Id: OTP-10171</p>
+ </item>
+ <item>
+ <p>
+ Fix messages ordering with column numbers</p>
+ <p>
+ Own Id: OTP-10183</p>
+ </item>
+ <item>
+ <p>
+ sys_pre_expand: Fix BASE never being set</p>
+ <p>
+ Commit a612e99fb5aaa934fe5a8591db0f083d7fa0b20a turned
+ module attributes from 2-tuples to 3-tuples but forgot to
+ update get_base/1, breaking BASE for parametric modules.</p>
+ <p>
+ Own Id: OTP-10184</p>
+ </item>
+ <item>
+ <p>
+ The compiler will now issue a warning if literal tuple
+ funs are used. For example, {erlang,is_tuple}(X) will now
+ generate a warning.</p>
+ <p>
+ Own Id: OTP-10185</p>
+ </item>
+ <item>
+ <p>
+ The compiler will now warn for illegal sizes for segments
+ in binary construction. For example,
+ &lt;&lt;X:(2.5)&gt;&gt; will now cause the compiler to
+ issue a warning.</p>
+ <p>
+ Own Id: OTP-10197</p>
+ </item>
+ <item>
+ <p>
+ Fix the erlc -MP flag</p>
+ <p>
+ Because of a copy-and-paste error in erlc.c, the -MP flag
+ had the same effect as -MG. As a workaround, you had to
+ pass +makedep_phony to enable the MP option. This patch
+ makes -MP work as intended.</p>
+ <p>
+ Own Id: OTP-10211</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 4.8.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ In rare circumstance, the compiler could crash when
+ compiling a case statement. (Thanks to Hakan Mattsson.)</p>
+ <p>
+ Own Id: OTP-9842</p>
+ </item>
+ <item>
+ <p>Calling a guard test (such as is_list/1) from the
+ top-level in a guard, would cause a compiler crash if
+ there was a local definition with the same name.
+ Corrected to reject the program with an error
+ message.</p>
+ <p>
+ Own Id: OTP-9866</p>
+ </item>
+ <item>
+ <p>Using <c>get/1</c> in a <c>try</c> block could in some
+ cases cause an internal compiler error. (Thanks to Eric
+ Merritt.)</p>
+ <p>
+ Own Id: OTP-9867</p>
+ </item>
+ <item>
+ <p>
+ An unexported on_load function would not get run if the
+ module was compiled with the <c>inline</c> option.
+ (Thanks to Yiannis Tsiouris.)</p>
+ <p>
+ Own Id: OTP-9910</p>
+ </item>
+ <item>
+ <p>
+ Fixed a discrepancy in compile_info</p>
+ <p>
+ The BEAM disassembler used the atom 'none' to signify the
+ absence of a compile_info chunk in a .beam file. This
+ clashed with the type declaration of the compile_info
+ field of a #beam_file{} record as containing a list. Now
+ [] signifies the absence of this chunk. This simplifies
+ the code and avoids a dialyzer warning.</p>
+ <p>
+ Own Id: OTP-9917</p>
+ </item>
+ <item>
+ <p>
+ Fix typo in `compile' doc: unmatched parenthesis (Thanks
+ to Ricardo Catalinas Jim�nez)</p>
+ <p>
+ Own Id: OTP-9919</p>
+ </item>
+ <item>
+ <p>In a <c>try</c>...<c>catch</c> statement that always
+ returned <c>false</c>, the compiler would remove calls to
+ BIFs that could not cause an exception (such as
+ <c>put/2</c>). Example of such code: <c>try put(K, V),
+ false catch _:_ -&gt; false end.</c></p>
+ <p>
+ Own Id: OTP-9982</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 4.8</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Add '-callback' attributes in stdlib's behaviours</p>
+ <p>
+ Replace the behaviour_info(callbacks) export in stdlib's
+ behaviours with -callback' attributes for all the
+ callbacks. Update the documentation with information on
+ the callback attribute Automatically generate
+ 'behaviour_info' function from '-callback' attributes</p>
+ <p>
+ 'behaviour_info(callbacks)' is a special function that is
+ defined in a module which describes a behaviour and
+ returns a list of its callbacks.</p>
+ <p>
+ This function is now automatically generated using the
+ '-callback' specs. An error is returned by lint if user
+ defines both '-callback' attributes and the
+ behaviour_info/1 function. If no type info is needed for
+ a callback use a generic spec for it. Add '-callback'
+ attribute to language syntax</p>
+ <p>
+ Behaviours may define specs for their callbacks using the
+ familiar spec syntax, replacing the '-spec' keyword with
+ '-callback'. Simple lint checks are performed to ensure
+ that no callbacks are defined twice and all types
+ referred are declared.</p>
+ <p>
+ These attributes can be then used by tools to provide
+ documentation to the behaviour or find discrepancies in
+ the callback definitions in the callback module.</p>
+ <p>
+ Add callback specs into 'application' module in kernel
+ Add callback specs to tftp module following internet
+ documentation Add callback specs to inets_service module
+ following possibly deprecated comments</p>
+ <p>
+ Own Id: OTP-9621</p>
+ </item>
+ <item>
+ <p>
+ The calculation of the 'uniq' value for a fun (see
+ <c>erlang:fun_info/1</c>) was too weak and has been
+ strengthened. It used to be based on the only the code
+ for the fun body, but it is now based on the MD5 of the
+ BEAM code for the module.</p>
+ <p>
+ Own Id: OTP-9667</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>Variables are now now allowed in '<c>fun M:F/A</c>' as
+ suggested by Richard O'Keefe in EEP-23.</p>
+ <p>The representation of '<c>fun M:F/A</c>' in the
+ abstract format has been changed in an incompatible way.
+ Tools that directly read or manipulate the abstract
+ format (such as parse transforms) may need to be updated.
+ The compiler can handle both the new and the old format
+ (i.e. extracting the abstract format from a pre-R15 BEAM
+ file and compiling it using compile:forms/1,2 will work).
+ The <c>syntax_tools</c> application can also handle both
+ formats.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-9643</p>
+ </item>
+ <item>
+ <p>
+ <c>filename:find_src/1,2</c> will now work on stripped
+ BEAM files (reported by Per Hedeland). The HiPE compiler
+ will also work on stripped BEAM files. The BEAM compiler
+ will no longer include compilation options given in the
+ source code itself in <c>M:module_info(compile)</c>
+ (because those options will be applied anyway if the
+ module is re-compiled).</p>
+ <p>
+ Own Id: OTP-9752</p>
+ </item>
+ <item>
+ <p>Inlining binary matching could cause an internal
+ compiler error. (Thanks to Rene Kijewski for reporting
+ this bug.)</p>
+ <p>
+ Own Id: OTP-9770</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Compiler 4.7.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 1238d113e1..958d3501c7 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2011. All Rights Reserved.
+# Copyright Ericsson AB 1996-2012. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -53,12 +53,14 @@ MODULES = \
beam_dead \
beam_dict \
beam_disasm \
+ beam_except \
beam_flatten \
beam_jump \
beam_listing \
beam_opcodes \
beam_peep \
beam_receive \
+ beam_split \
beam_trim \
beam_type \
beam_utils \
@@ -161,11 +163,11 @@ $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl
include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: opt
- $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DIR) "$(RELSYSDIR)/src"
$(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(EXTRA_FILES) \
- $(YRL_FILE) $(RELSYSDIR)/src
- $(INSTALL_DIR) $(RELSYSDIR)/ebin
- $(INSTALL_DATA) $(INSTALL_FILES) $(RELSYSDIR)/ebin
+ $(YRL_FILE) "$(RELSYSDIR)/src"
+ $(INSTALL_DIR) "$(RELSYSDIR)/ebin"
+ $(INSTALL_DATA) $(INSTALL_FILES) "$(RELSYSDIR)/ebin"
release_docs_spec:
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index 89d64834cf..a7c8508321 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -23,7 +23,7 @@
-export([module/4]).
-export([encode/2]).
--import(lists, [map/2,member/2,keymember/3,duplicate/2]).
+-import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]).
-include("beam_opcodes.hrl").
module(Code, Abst, SourceFile, Opts) ->
@@ -31,22 +31,20 @@ module(Code, Abst, SourceFile, Opts) ->
assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
{1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
+ {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
NumFuncs = length(Asm0),
{Asm,Attr} = on_load(Asm0, Attr0),
- {Code,Dict1} = assemble_1(Asm, Exp, Dict0, []),
- build_file(Code, Attr, Dict1, NumLabels, NumFuncs, Abst, SourceFile, Opts).
+ {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
+ build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts).
on_load(Fs0, Attr0) ->
case proplists:get_value(on_load, Attr0) of
undefined ->
{Fs0,Attr0};
[{Name,0}] ->
- Fs = map(fun({function,N,0,Entry,Asm0}) when N =:= Name ->
- [{label,_}=L,
- {func_info,_,_,_}=Fi,
- {label,_}=E|Asm1] = Asm0,
- Asm = [L,Fi,E,on_load|Asm1],
- {function,N,0,Entry,Asm};
+ Fs = map(fun({function,N,0,Entry,Is0}) when N =:= Name ->
+ Is = insert_on_load_instruction(Is0, Entry),
+ {function,N,0,Entry,Is};
(F) ->
F
end, Fs0),
@@ -54,6 +52,13 @@ on_load(Fs0, Attr0) ->
{Fs,Attr}
end.
+insert_on_load_instruction(Is0, Entry) ->
+ {Bef,[{label,Entry}=El|Is]} =
+ splitwith(fun({label,L}) when L =:= Entry -> false;
+ (_) -> true
+ end, Is0),
+ Bef ++ [El,on_load|Is].
+
assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) ->
Dict1 = case member({Name,Arity}, Exp) of
true ->
@@ -132,14 +137,19 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
LitTab = iolist_to_binary(zlib:compress(LitTab2)),
chunk(<<"LitT">>, <<(byte_size(LitTab2)):32>>, LitTab)
end,
+
+ %% Create the line chunk.
+ LineChunk = chunk(<<"Line">>, build_line_table(Dict)),
%% Create the attributes and compile info chunks.
Essentials0 = [AtomChunk,CodeChunk,StringChunk,ImportChunk,
ExpChunk,LambdaChunk,LiteralChunk],
- Essentials = [iolist_to_binary(C) || C <- Essentials0],
- {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, Essentials),
+ Essentials1 = [iolist_to_binary(C) || C <- Essentials0],
+ MD5 = module_md5(Essentials1),
+ Essentials = finalize_fun_table(Essentials1, MD5),
+ {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, MD5),
AttrChunk = chunk(<<"Attr">>, Attributes),
CompileChunk = chunk(<<"CInf">>, Compile),
@@ -150,11 +160,32 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
%% Create IFF chunk.
Chunks = case member(slim, Opts) of
- true -> [Essentials,AttrChunk,AbstChunk];
- false -> [Essentials,LocChunk,AttrChunk,CompileChunk,AbstChunk]
+ true ->
+ [Essentials,AttrChunk,AbstChunk];
+ false ->
+ [Essentials,LocChunk,AttrChunk,
+ CompileChunk,AbstChunk,LineChunk]
end,
build_form(<<"BEAM">>, Chunks).
+%% finalize_fun_table(Essentials, MD5) -> FinalizedEssentials
+%% Update the 'old_uniq' field in the entry for each fun in the
+%% 'FunT' chunk. We'll use part of the MD5 for the module as a
+%% unique value.
+
+finalize_fun_table(Essentials, MD5) ->
+ [finalize_fun_table_1(E, MD5) || E <- Essentials].
+
+finalize_fun_table_1(<<"FunT",Keep:8/binary,Table0/binary>>, MD5) ->
+ <<Uniq:27,_:101/bits>> = MD5,
+ Table = finalize_fun_table_2(Table0, Uniq, <<>>),
+ <<"FunT",Keep/binary,Table/binary>>;
+finalize_fun_table_1(Chunk, _) -> Chunk.
+
+finalize_fun_table_2(<<Keep:20/binary,0:32,T/binary>>, Uniq, Acc) ->
+ finalize_fun_table_2(T, Uniq, <<Acc/binary,Keep/binary,Uniq:32>>);
+finalize_fun_table_2(<<>>, _, Acc) -> Acc.
+
%% Build an IFF form.
build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) ->
@@ -191,7 +222,7 @@ flatten_exports(Exps) ->
flatten_imports(Imps) ->
list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)).
-build_attributes(Opts, SourceFile, Attr, Essentials) ->
+build_attributes(Opts, SourceFile, Attr, MD5) ->
Misc = case member(slim, Opts) of
false ->
{{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(),
@@ -199,7 +230,32 @@ build_attributes(Opts, SourceFile, Attr, Essentials) ->
true -> []
end,
Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc],
- {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}.
+ {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}.
+
+build_line_table(Dict) ->
+ {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} =
+ beam_dict:line_table(Dict),
+ NumFnames = NumFnames0 - 1,
+ [_|Fnames1] = Fnames0,
+ Fnames2 = [unicode:characters_to_binary(F) || F <- Fnames1],
+ Fnames = << <<(byte_size(F)):16,F/binary>> || F <- Fnames2 >>,
+ Lines1 = encode_line_items(Lines0, 0),
+ Lines = iolist_to_binary(Lines1),
+ Ver = 0,
+ Bits = 0,
+ <<Ver:32,Bits:32,NumLineInstrs:32,NumLines:32,NumFnames:32,
+ Lines/binary,Fnames/binary>>.
+
+%% encode_line_items([{FnameIndex,Line}], PrevFnameIndex)
+%% Encode the line items compactly. Tag the FnameIndex with
+%% an 'a' tag (atom) and only include it when it has changed.
+%% Tag the line numbers with an 'i' (integer) tag.
+
+encode_line_items([{F,L}|T], F) ->
+ [encode(?tag_i, L)|encode_line_items(T, F)];
+encode_line_items([{F,L}|T], _) ->
+ [encode(?tag_a, F),encode(?tag_i, L)|encode_line_items(T, F)];
+encode_line_items([], _) -> [].
%%
%% If the attributes contains no 'vsn' attribute, we'll insert one
@@ -207,32 +263,30 @@ build_attributes(Opts, SourceFile, Attr, Essentials) ->
%% We'll not change an existing 'vsn' attribute.
%%
-calc_vsn(Attr, Essentials0) ->
+set_vsn_attribute(Attr, MD5) ->
case keymember(vsn, 1, Attr) of
true -> Attr;
false ->
- Essentials = filter_essentials(Essentials0),
- <<Number:128>> = erlang:md5(Essentials),
+ <<Number:128>> = MD5,
[{vsn,[Number]}|Attr]
end.
+module_md5(Essentials0) ->
+ Essentials = filter_essentials(Essentials0),
+ erlang:md5(Essentials).
+
%% filter_essentials([Chunk]) -> [Chunk']
%% Filter essentials so that we obtain the same MD5 as code:module_md5/1 and
-%% beam_lib:md5/1 would calculate for this module.
+%% beam_lib:md5/1 would calculate for this module. Note that at this
+%% point, the 'old_uniq' entry for each fun in the 'FunT' chunk is zeroed,
+%% so there is no need to go through the 'FunT' chunk.
-filter_essentials([<<"FunT",_Sz:4/binary,Entries:4/binary,Table0/binary>>|T]) ->
- Table = filter_funtab(Table0, <<0:32>>),
- [Entries,Table|filter_essentials(T)];
filter_essentials([<<_Tag:4/binary,Sz:32,Data:Sz/binary,_Padding/binary>>|T]) ->
[Data|filter_essentials(T)];
filter_essentials([<<>>|T]) ->
filter_essentials(T);
filter_essentials([]) -> [].
-filter_funtab(<<Important:20/binary,_OldUniq:4/binary,T/binary>>, Zero) ->
- [Important,Zero|filter_funtab(T, Zero)];
-filter_funtab(<<>>, _) -> [].
-
bif_type(fnegate, 1) -> {op,fnegate};
bif_type(fadd, 2) -> {op,fadd};
bif_type(fsub, 2) -> {op,fsub};
@@ -243,6 +297,9 @@ bif_type(_, 2) -> bif2.
make_op({'%',_}, Dict) ->
{[],Dict};
+make_op({line,Location}, Dict0) ->
+ {Index,Dict} = beam_dict:line(Location, Dict0),
+ encode_op(line, [Index], Dict);
make_op({bif, Bif, {f,_}, [], Dest}, Dict) ->
%% BIFs without arguments cannot fail.
encode_op(bif0, [{extfunc, erlang, Bif, 0}, Dest], Dict);
@@ -271,8 +328,8 @@ make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) ->
encode_op(Cond, [Fail|Ops], Dict);
make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) ->
encode_op(Cond, [Fail,Op,Live|Ops++[Dst]], Dict);
-make_op({make_fun2,{f,Lbl},Index,OldUniq,NumFree}, Dict0) ->
- {Fun,Dict} = beam_dict:lambda(Lbl, Index, OldUniq, NumFree, Dict0),
+make_op({make_fun2,{f,Lbl},_Index,_OldUniq,NumFree}, Dict0) ->
+ {Fun,Dict} = beam_dict:lambda(Lbl, NumFree, Dict0),
make_op({make_fun2,Fun}, Dict);
make_op({kill,Y}, Dict) ->
make_op({init,Y}, Dict);
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index c45874597a..cd568097fa 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -36,13 +36,14 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% Collect basic blocks and optimize them.
Is2 = blockify(Is1),
- Is3 = move_allocates(Is2),
- Is4 = beam_utils:live_opt(Is3),
- Is5 = opt_blocks(Is4),
- Is6 = beam_utils:delete_live_annos(Is5),
+ Is3 = embed_lines(Is2),
+ Is4 = move_allocates(Is3),
+ Is5 = beam_utils:live_opt(Is4),
+ Is6 = opt_blocks(Is5),
+ Is7 = beam_utils:delete_live_annos(Is6),
%% Optimize bit syntax.
- {Is,Lc} = bsm_opt(Is6, Lc0),
+ {Is,Lc} = bsm_opt(Is7, Lc0),
%% Done.
{{function,Name,Arity,CLabel,Is},Lc}
@@ -148,6 +149,24 @@ collect(remove_message) -> {set,[],[],remove_message};
collect({'catch',R,L}) -> {set,[R],[],{'catch',L}};
collect(_) -> error.
+%% embed_lines([Instruction]) -> [Instruction]
+%% Combine blocks that would be split by line/1 instructions.
+%% Also move a line instruction before a block into the block,
+%% but leave the line/1 instruction after a block outside.
+
+embed_lines(Is) ->
+ embed_lines(reverse(Is), []).
+
+embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) ->
+ B = {block,B1++[{set,[],[],Line}]++B2},
+ embed_lines([B|T], Acc);
+embed_lines([{block,B1},{line,_}=Line|T], Acc) ->
+ B = {block,[{set,[],[],Line}|B1]},
+ embed_lines([B|T], Acc);
+embed_lines([I|Is], Acc) ->
+ embed_lines(Is, [I|Acc]);
+embed_lines([], Acc) -> Acc.
+
opt_blocks([{block,Bl0}|Is]) ->
%% The live annotation at the beginning is not useful.
[{'%live',_}|Bl] = Bl0,
@@ -225,10 +244,12 @@ opt([{set,[Dst],As,{bif,Bif,Fail}}=I1,
RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)]
end;
opt([{set,[X],[X],move}|Is]) -> opt(Is);
-opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1,
+opt([{set,_,_,{line,_}}=Line1,
+ {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1,
+ {set,_,_,{line,_}}=Line2,
{set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is])
when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg ->
- opt([I2,I1|Is]);
+ opt([Line2,I2,Line1,I1|Is]);
opt([{set,Ds0,Ss,Op}|Is0]) ->
{Ds,Is} = opt_moves(Ds0, Is0),
[{set,Ds,Ss,Op}|opt(Is)];
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index 415864b8e9..1217f7f777 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -20,7 +20,7 @@
-module(beam_bsm).
-export([module/2,format_error/1]).
--import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2]).
+-import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2,dropwhile/2]).
%%%
%%% We optimize bit syntax matching where the tail end of a binary is
@@ -376,6 +376,8 @@ btb_reaches_match_2([{func_info,_,_,Arity}=I|_], Regs0, D) ->
[] -> D;
_ -> {binary_used_in,I}
end;
+btb_reaches_match_2([{line,_}|Is], Regs, D) ->
+ btb_reaches_match_1(Is, Regs, D);
btb_reaches_match_2([I|_], Regs, _) ->
btb_error({btb_context_regs(Regs),I,not_handled}).
@@ -580,7 +582,10 @@ btb_index(Fs) ->
btb_index_1(Fs, []).
btb_index_1([{function,_,_,Entry,Is0}|Fs], Acc0) ->
- [{label,_},{func_info,_,_,_},{label,Entry}|Is] = Is0,
+ [{label,Entry}|Is] =
+ dropwhile(fun({label,L}) when L =:= Entry -> false;
+ (_) -> true
+ end, Is0),
Acc = btb_index_2(Is, Entry, false, Acc0),
btb_index_1(Fs, Acc);
btb_index_1([], Acc) -> gb_trees:from_orddict(sort(Acc)).
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 64c93e11f7..a7994ab3b3 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -23,9 +23,9 @@
-export([module/2]).
-export([bs_clean_saves/1]).
-export([clean_labels/1]).
--import(lists, [map/2,foldl/3,reverse/1]).
+-import(lists, [map/2,foldl/3,reverse/1,filter/2]).
-module({Mod,Exp,Attr,Fs0,_}, _Opt) ->
+module({Mod,Exp,Attr,Fs0,_}, Opts) ->
Order = [Lbl || {function,_,_,Lbl,_} <- Fs0],
All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end,
dict:new(), Fs0),
@@ -33,7 +33,8 @@ module({Mod,Exp,Attr,Fs0,_}, _Opt) ->
Used = find_all_used(WorkList, All, sets:from_list(WorkList)),
Fs1 = remove_unused(Order, Used, All),
{Fs2,Lc} = clean_labels(Fs1),
- Fs = bs_fix(Fs2),
+ Fs3 = bs_fix(Fs2),
+ Fs = maybe_remove_lines(Fs3, Opts),
{ok,{Mod,Exp,Attr,Fs,Lc}}.
%% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2.
@@ -375,3 +376,20 @@ bs_clean_saves_1([{bs_save2,_,{_,_}=SavePoint}=I|Is], Needed, Acc) ->
bs_clean_saves_1([I|Is], Needed, Acc) ->
bs_clean_saves_1(Is, Needed, [I|Acc]);
bs_clean_saves_1([], _, Acc) -> reverse(Acc).
+
+%%%
+%%% Remove line instructions if requested.
+%%%
+
+maybe_remove_lines(Fs, Opts) ->
+ case proplists:get_bool(no_line_info, Opts) of
+ false -> Fs;
+ true -> remove_lines(Fs)
+ end.
+
+remove_lines([{function,N,A,Lbl,Is0}|T]) ->
+ Is = filter(fun({line,_}) -> false;
+ (_) -> true
+ end, Is0),
+ [{function,N,A,Lbl,Is}|remove_lines(T)];
+remove_lines([]) -> [].
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 1365f3d20a..5f12a98f09 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -131,10 +131,9 @@
-import(lists, [mapfoldl/3,reverse/1]).
module({Mod,Exp,Attr,Fs0,_}, _Opts) ->
- Fs1 = [split_blocks(F) || F <- Fs0],
- {Fs2,Lc1} = beam_clean:clean_labels(Fs1),
- {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs2),
- %%{Fs,Lc} = {Fs2,Lc1},
+ {Fs1,Lc1} = beam_clean:clean_labels(Fs0),
+ {Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs1),
+ %%{Fs,Lc} = {Fs1,Lc1},
{ok,{Mod,Exp,Attr,Fs,Lc}}.
function({function,Name,Arity,CLabel,Is0}, Lc0) ->
@@ -144,9 +143,9 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% Initialize label information with the code
%% for the func_info label. Without it, a register
%% may seem to be live when it is not.
- [{label,L},{func_info,_,_,_}=FI|_] = Is1,
+ [{label,L}|FiIs] = Is1,
D0 = beam_utils:empty_label_index(),
- D = beam_utils:index_label(L, [FI], D0),
+ D = beam_utils:index_label(L, FiIs, D0),
%% Optimize away dead code.
{Is2,Lc} = forward(Is1, Lc0),
@@ -160,62 +159,6 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
erlang:raise(Class, Error, Stack)
end.
-%% We must split the basic block when we encounter instructions with labels,
-%% such as catches and BIFs. All labels must be visible outside the blocks.
-
-split_blocks({function,Name,Arity,CLabel,Is0}) ->
- Is = split_blocks(Is0, []),
- {function,Name,Arity,CLabel,Is}.
-
-split_blocks([{block,Bl}|Is], Acc0) ->
- Acc = split_block(Bl, [], Acc0),
- split_blocks(Is, Acc);
-split_blocks([I|Is], Acc) ->
- split_blocks(Is, [I|Acc]);
-split_blocks([], Acc) -> reverse(Acc).
-
-split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) ->
- %% is_record/3 must be translated by beam_clean; therefore,
- %% it must be outside of any block.
- split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]);
-split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 ->
- split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]);
-split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc)
- when Lbl =/= 0 ->
- split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]);
-split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) ->
- split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]);
-split_block([I|Is], Bl, Acc) ->
- split_block(Is, [I|Bl], Acc);
-split_block([], Bl, Acc) -> make_block(Bl, Acc).
-
-make_block([], Acc) -> Acc;
-make_block([{set,[D],Ss,{bif,Op,Fail}}|Bl]=Bl0, Acc) ->
- %% If the last instruction in the block is a comparison or boolean operator
- %% (such as '=:='), move it out of the block to facilitate further
- %% optimizations.
- Arity = length(Ss),
- case erl_internal:comp_op(Op, Arity) orelse
- erl_internal:new_type_test(Op, Arity) orelse
- erl_internal:bool_op(Op, Arity) of
- false ->
- [{block,reverse(Bl0)}|Acc];
- true ->
- I = {bif,Op,Fail,Ss,D},
- case Bl =:= [] of
- true -> [I|Acc];
- false -> [I,{block,reverse(Bl)}|Acc]
- end
- end;
-make_block([{set,[Dst],[Src],move}|Bl], Acc) ->
- %% Make optimization of {move,Src,Dst}, {jump,...} possible.
- I = {move,Src,Dst},
- case Bl =:= [] of
- true -> [I|Acc];
- false -> [I,{block,reverse(Bl)}|Acc]
- end;
-make_block(Bl, Acc) -> [{block,reverse(Bl)}|Acc].
-
%% 'move' instructions outside of blocks may thwart the jump optimizer.
%% Move them back into the block.
@@ -406,7 +349,7 @@ backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) ->
end,
I = {test,Op,{f,To},Live,Ops0,Dst},
backward(Is, D, [I|Acc]);
-backward([{kill,_}=I|Is], D, [Exit|_]=Acc) ->
+backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) ->
case beam_jump:is_exit_instruction(Exit) of
false -> backward(Is, D, [I|Acc]);
true -> backward(Is, D, Acc)
@@ -471,7 +414,7 @@ shortcut_fail_label(To0, Reg, Val, D) ->
shortcut_boolean_label(To0, Reg, Bool0, D) when is_boolean(Bool0) ->
case beam_utils:code_at(To0, D) of
- [{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] ->
+ [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] ->
Bool = not Bool0,
{shortcut_select_label(To, Reg, Bool, D),Bool};
_ ->
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index c50ed28aa9..531968b3c8 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -22,9 +22,10 @@
-export([new/0,opcode/2,highest_opcode/1,
atom/2,local/4,export/4,import/4,
- string/2,lambda/5,literal/2,
+ string/2,lambda/3,literal/2,line/2,fname/2,
atom_table/1,local_table/1,export_table/1,import_table/1,
- string_table/1,lambda_table/1,literal_table/1]).
+ string_table/1,lambda_table/1,literal_table/1,
+ line_table/1]).
-type label() :: non_neg_integer().
@@ -36,6 +37,9 @@
strings = <<>> :: binary(), %String pool
lambdas = [], %[{...}]
literals = dict:new() :: dict(), %Format: {Literal,Number}
+ fnames = gb_trees:empty() :: gb_tree(), %{Name,Index}
+ lines = gb_trees:empty() :: gb_tree(), %{{Fname,Line},Index}
+ num_lines = 0 :: non_neg_integer(), %Number of line instructions
next_import = 0 :: non_neg_integer(),
string_offset = 0 :: non_neg_integer(),
next_literal = 0 :: non_neg_integer(),
@@ -129,13 +133,18 @@ string(Str, Dict) when is_list(Str) ->
{NextOffset-Offset,Dict}
end.
-%% Returns the index for a funentry (adding it to the table if necessary).
-%% lambda(Lbl, Index, Uniq, NumFree, Dict) -> {Index,Dict'}
--spec lambda(label(), non_neg_integer(), integer(), non_neg_integer(), bdict()) ->
+%% Returns the index for a fun entry.
+%% lambda(Lbl, NumFree, Dict) -> {Index,Dict'}
+-spec lambda(label(), non_neg_integer(), bdict()) ->
{non_neg_integer(), bdict()}.
-lambda(Lbl, Index, OldUniq, NumFree, #asm{lambdas=Lambdas0}=Dict) ->
+lambda(Lbl, NumFree, #asm{lambdas=Lambdas0}=Dict) ->
OldIndex = length(Lambdas0),
+ %% Set Index the same as OldIndex.
+ Index = OldIndex,
+ %% Initialize OldUniq to 0. It will be set to an unique value
+ %% based on the MD5 checksum of the BEAM code for the module.
+ OldUniq = 0,
Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0],
{OldIndex,Dict#asm{lambdas=Lambdas}}.
@@ -152,6 +161,36 @@ literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) ->
{NextIndex,Dict#asm{literals=Tab,next_literal=NextIndex+1}}
end.
+%% Returns the index for a line instruction (adding information
+%% to the location information table).
+-spec line(list(), bdict()) -> {non_neg_integer(), bdict()}.
+
+line([], #asm{num_lines=N}=Dict) ->
+ %% No location available. Return the special pre-defined
+ %% index 0.
+ {0,Dict#asm{num_lines=N+1}};
+line([{location,Name,Line}], #asm{lines=Lines0,num_lines=N}=Dict0) ->
+ {FnameIndex,Dict1} = fname(Name, Dict0),
+ case gb_trees:lookup({FnameIndex,Line}, Lines0) of
+ {value,Index} ->
+ {Index,Dict1#asm{num_lines=N+1}};
+ none ->
+ Index = gb_trees:size(Lines0) + 1,
+ Lines = gb_trees:insert({FnameIndex,Line}, Index, Lines0),
+ Dict = Dict1#asm{lines=Lines,num_lines=N+1},
+ {Index,Dict}
+ end.
+
+fname(Name, #asm{fnames=Fnames0}=Dict) ->
+ case gb_trees:lookup(Name, Fnames0) of
+ {value,Index} ->
+ {Index,Dict};
+ none ->
+ Index = gb_trees:size(Fnames0),
+ Fnames = gb_trees:insert(Name, Index, Fnames0),
+ {Index,Dict#asm{fnames=Fnames}}
+ end.
+
%% Returns the atom table.
%% atom_table(Dict) -> {LastIndex,[Length,AtomString...]}
-spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}.
@@ -219,6 +258,21 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) ->
my_term_to_binary(Term) ->
term_to_binary(Term, [{minor_version,1}]).
+%% Return the line table.
+-spec line_table(bdict()) ->
+ {non_neg_integer(), %Number of line instructions.
+ non_neg_integer(),[string()],
+ non_neg_integer(),[{non_neg_integer(),non_neg_integer()}]}.
+
+line_table(#asm{fnames=Fnames0,lines=Lines0,num_lines=NumLineInstrs}) ->
+ NumFnames = gb_trees:size(Fnames0),
+ Fnames1 = lists:keysort(2, gb_trees:to_list(Fnames0)),
+ Fnames = [Name || {Name,_} <- Fnames1],
+ NumLines = gb_trees:size(Lines0),
+ Lines1 = lists:keysort(2, gb_trees:to_list(Lines0)),
+ Lines = [L || {L,_} <- Lines1],
+ {NumLineInstrs,NumFnames,Fnames,NumLines,Lines}.
+
%% Search for binary string Str in the binary string pool Pool.
%% old_string(Str, Pool) -> none | Index
-spec old_string(binary(), binary()) -> 'none' | pos_integer().
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 5c4d8e12b5..62bdc74cc8 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -182,10 +182,14 @@ process_chunks(F) ->
Literals = beam_disasm_literals(LiteralBin),
Code = beam_disasm_code(CodeBin, Atoms, mk_imports(ImportsList),
StrBin, Lambdas, Literals, Module),
- Attributes = optional_chunk(F, attributes),
+ Attributes =
+ case optional_chunk(F, attributes) of
+ none -> [];
+ Atts when is_list(Atts) -> Atts
+ end,
CompInfo =
case optional_chunk(F, "CInf") of
- none -> none;
+ none -> [];
CompInfoBin when is_binary(CompInfoBin) ->
binary_to_term(CompInfoBin)
end,
@@ -198,7 +202,7 @@ process_chunks(F) ->
end.
%%-----------------------------------------------------------------------
-%% Retrieve an optional chunk or none if the chunk doesn't exist.
+%% Retrieve an optional chunk or return 'none' if the chunk doesn't exist.
%%-----------------------------------------------------------------------
optional_chunk(F, ChunkTag) ->
@@ -296,6 +300,8 @@ get_function_chunks(Code) ->
labels_r([], R) -> {R, []};
labels_r([{label,_}=I|Is], R) ->
labels_r(Is, [I|R]);
+labels_r([{line,_}=I|Is], R) ->
+ labels_r(Is, [I|R]);
labels_r(Is, R) -> {R, Is}.
get_funs({[],[]}) -> [];
@@ -335,20 +341,17 @@ local_labels(Funs) ->
local_labels_1(function__code(F), R)
end, [], Funs)).
-%% The first clause below attempts to provide some (limited form of)
-%% backwards compatibility; it is not needed for .beam files generated
-%% by the R8 compiler. The clause should one fine day be taken out.
-local_labels_1([{label,_}|[{label,_}|_]=Code], R) ->
- local_labels_1(Code, R);
-local_labels_1([{label,_},{func_info,{atom,M},{atom,F},A}|Code], R)
- when is_atom(M), is_atom(F) ->
- local_labels_2(Code, R, M, F, A);
-local_labels_1(Code, _) ->
- ?exit({'local_labels: no label in code',Code}).
+local_labels_1(Code0, R) ->
+ Code1 = lists:dropwhile(fun({label,_}) -> true;
+ ({line,_}) -> true;
+ ({func_info,_,_,_}) -> false
+ end, Code0),
+ [{func_info,{atom,M},{atom,F},A}|Code] = Code1,
+ local_labels_2(Code, R, {M,F,A}).
-local_labels_2([{label,[{u,L}]}|Code], R, M, F, A) ->
- local_labels_2(Code, [{L,{M,F,A}}|R], M, F, A);
-local_labels_2(_, R, _, _, _) -> R.
+local_labels_2([{label,[{u,L}]}|Code], R, MFA) ->
+ local_labels_2(Code, [{L,MFA}|R], MFA);
+local_labels_2(_, R, _) -> R.
%%-----------------------------------------------------------------------
%% Disassembles a single BEAM instruction; most instructions are handled
@@ -1105,6 +1108,12 @@ resolve_inst({recv_set,[Lbl]},_,_,_) ->
{recv_set,Lbl};
%%
+%% R15A.
+%%
+resolve_inst({line,[Index]},_,_,_) ->
+ {line,resolve_arg(Index)};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
new file mode 100644
index 0000000000..fb1a43cd9e
--- /dev/null
+++ b/lib/compiler/src/beam_except.erl
@@ -0,0 +1,149 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(beam_except).
+-export([module/2]).
+
+%%% Rewrite certain calls to erlang:error/{1,2} to specialized
+%%% instructions:
+%%%
+%%% erlang:error({badmatch,Value}) => badmatch Value
+%%% erlang:error({case_clause,Value}) => case_end Value
+%%% erlang:error({try_clause,Value}) => try_case_end Value
+%%% erlang:error(if_clause) => if_end
+%%% erlang:error(function_clause, Args) => jump FuncInfoLabel
+%%%
+
+-import(lists, [reverse/1]).
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
+ Fs = [function(F) || F <- Fs0],
+ {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+function({function,Name,Arity,CLabel,Is0}) ->
+ try
+ Is = function_1(Is0),
+ {function,Name,Arity,CLabel,Is}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+-record(st,
+ {lbl, %func_info label
+ loc %location for func_info
+ }).
+
+function_1(Is0) ->
+ case Is0 of
+ [{label,Lbl},{line,Loc}|_] ->
+ St = #st{lbl=Lbl,loc=Loc},
+ translate(Is0, St, []);
+ [{label,_}|_] ->
+ %% No line numbers. The source must be a .S file.
+ %% There is no need to do anything.
+ Is0
+ end.
+
+translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) ->
+ translate_1(Ar, I, Is, St, Acc);
+translate([{call_ext_only,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) ->
+ translate_1(Ar, I, Is, St, Acc);
+translate([{call_ext_last,Ar,{extfunc,erlang,error,Ar},_}=I|Is], St, Acc) ->
+ translate_1(Ar, I, Is, St, Acc);
+translate([I|Is], St, Acc) ->
+ translate(Is, St, [I|Acc]);
+translate([], _, Acc) ->
+ reverse(Acc).
+
+translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) ->
+ case dig_out(Ar, Acc1) of
+ no ->
+ translate(Is, St, [I|Acc0]);
+ {yes,function_clause,Acc2} ->
+ case {Line,St} of
+ {{line,Loc},#st{lbl=Fi,loc=Loc}} ->
+ Instr = {jump,{f,Fi}},
+ translate(Is, St, [Instr|Acc2]);
+ {_,_} ->
+ %% This must be "error(function_clause, Args)" in
+ %% the Erlang source code. Don't translate.
+ translate(Is, St, [I|Acc0])
+ end;
+ {yes,Instr,Acc2} ->
+ translate(Is, St, [Instr,Line|Acc2])
+ end.
+
+dig_out(Ar, [{kill,_}|Is]) ->
+ dig_out(Ar, Is);
+dig_out(1, [{block,Bl0}|Is]) ->
+ case dig_out_block(reverse(Bl0)) of
+ no -> no;
+ {yes,What,[]} ->
+ {yes,What,Is};
+ {yes,What,Bl} ->
+ {yes,What,[{block,Bl}|Is]}
+ end;
+dig_out(2, [{block,Bl}|Is]) ->
+ case dig_out_block_fc(Bl) of
+ no -> no;
+ {yes,What} -> {yes,What,Is}
+ end;
+dig_out(_, _) -> no.
+
+dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) ->
+ {yes,if_end,[]};
+dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) ->
+ translate_exception(Exc, {literal,Value}, Is, 0);
+dig_out_block([{set,[{x,0}],[Tuple],move},
+ {set,[],[Value],put},
+ {set,[],[{atom,Exc}],put},
+ {set,[Tuple],[],{put_tuple,2}}|Is]) ->
+ translate_exception(Exc, Value, Is, 3);
+dig_out_block([{set,[],[Value],put},
+ {set,[],[{atom,Exc}],put},
+ {set,[{x,0}],[],{put_tuple,2}}|Is]) ->
+ translate_exception(Exc, Value, Is, 3);
+dig_out_block(_) -> no.
+
+translate_exception(badmatch, Val, Is, Words) ->
+ {yes,{badmatch,Val},fix_block(Is, Words)};
+translate_exception(case_clause, Val, Is, Words) ->
+ {yes,{case_end,Val},fix_block(Is, Words)};
+translate_exception(try_clause, Val, Is, Words) ->
+ {yes,{try_case_end,Val},fix_block(Is, Words)};
+translate_exception(_, _, _, _) -> no.
+
+fix_block(Is, 0) ->
+ reverse(Is);
+fix_block(Is0, Words) ->
+ [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0),
+ [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is].
+
+dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) ->
+ dig_out_fc(Bl, Live-1, nil);
+dig_out_block_fc(_) -> no.
+
+dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) ->
+ dig_out_fc(Is, Reg-1, Dst);
+dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) ->
+ {yes,function_clause};
+dig_out_fc(_, _, _) -> no.
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 3cab55c4cb..db67d24514 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -169,7 +169,7 @@ share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) ->
share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc])
end;
share_1([{func_info,_,_,_}=I|Is], _, [], Acc) ->
- Is++[I|Acc];
+ reverse(Is, [I|Acc]);
share_1([I|Is], Dict, Seq, Acc) ->
case is_unreachable_after(I) of
false ->
@@ -206,25 +206,35 @@ is_label(_) -> false.
move(Is) ->
move_1(Is, [], []).
-move_1([I|Is], End, Acc) ->
+move_1([I|Is], End0, Acc0) ->
case is_exit_instruction(I) of
- false -> move_1(Is, End, [I|Acc]);
- true -> move_2(I, Is, End, Acc)
+ false ->
+ move_1(Is, End0, [I|Acc0]);
+ true ->
+ case extract_seq(Acc0, [I|End0]) of
+ no ->
+ move_1(Is, End0, [I|Acc0]);
+ {yes,End,Acc} ->
+ move_1(Is, End, Acc)
+ end
end;
-move_1([], End, Acc) ->
- reverse(Acc, reverse(End)).
-
-move_2(Exit, Is, End, [{block,_},{label,_},{func_info,_,_,_}|_]=Acc) ->
- move_1(Is, End, [Exit|Acc]);
-move_2(Exit, Is, End, [{block,_}=Blk,{label,_}=Lbl,Unreachable|More]) ->
- move_1([Unreachable|Is], [Exit,Blk,Lbl|End], More);
-move_2(Exit, Is, End, [{bs_context_to_binary,_}=Bs,{label,_}=Lbl,
- Unreachable|More]) ->
- move_1([Unreachable|Is], [Exit,Bs,Lbl|End], More);
-move_2(Exit, Is, End, [{label,_}=Lbl,Unreachable|More]) ->
- move_1([Unreachable|Is], [Exit,Lbl|End], More);
-move_2(Exit, Is, End, Acc) ->
- move_1(Is, End, [Exit|Acc]).
+move_1([], End, Acc) -> reverse(Acc, End).
+
+extract_seq([{line,_}=Line|Is], Acc) ->
+ extract_seq(Is, [Line|Acc]);
+extract_seq([{block,_}=Bl|Is], Acc) ->
+ extract_seq_1(Is, [Bl|Acc]);
+extract_seq([{label,_}|_]=Is, Acc) ->
+ extract_seq_1(Is, Acc);
+extract_seq(_, _) -> no.
+
+extract_seq_1([{line,_}=Line|Is], Acc) ->
+ extract_seq_1(Is, [Line|Acc]);
+extract_seq_1([{label,_},{func_info,_,_,_}|_], _) ->
+ no;
+extract_seq_1([{label,_}=Lbl|Is], Acc) ->
+ {yes,[Lbl|Acc],Is};
+extract_seq_1(_, _) -> no.
%%%
%%% (3) (4) (5) (6) Jump and unreachable code optimizations.
@@ -454,6 +464,7 @@ is_label_used_in_2({set,_,_,Info}, Lbl) ->
{put_tuple,_} -> false;
{get_tuple_element,_} -> false;
{set_tuple_element,_} -> false;
+ {line,_} -> false;
_ when is_atom(Info) -> false
end.
@@ -487,6 +498,8 @@ rem_unused([], _, Acc) -> reverse(Acc).
initial_labels(Is) ->
initial_labels(Is, []).
+initial_labels([{line,_}|Is], Acc) ->
+ initial_labels(Is, Acc);
initial_labels([{label,Lbl}|Is], Acc) ->
initial_labels(Is, [Lbl|Acc]);
initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) ->
diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl
index be7b14c3dd..50d1f3cdb1 100644
--- a/lib/compiler/src/beam_listing.erl
+++ b/lib/compiler/src/beam_listing.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -61,7 +61,7 @@ print_op(Stream, Label) when element(1, Label) == label ->
print_op(Stream, Op) ->
io:format(Stream, " ~p.\n", [Op]).
-function(File, {function,Name,Arity,Args,Body,Vdb}) ->
+function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) ->
io:nl(File),
io:format(File, "function ~p/~p.\n", [Name,Arity]),
io:format(File, " ~p.\n", [Args]),
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
index 9ed44ad5d7..bd1f44f66b 100644
--- a/lib/compiler/src/beam_receive.erl
+++ b/lib/compiler/src/beam_receive.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -175,6 +175,8 @@ opt_update_regs({label,Lbl}, R, L) ->
end;
opt_update_regs({try_end,_}, R, L) ->
{R,L};
+opt_update_regs({line,_}, R, L) ->
+ {R,L};
opt_update_regs(_I, _R, L) ->
%% Unrecognized instruction. Abort the search.
{regs_init(),L}.
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
new file mode 100644
index 0000000000..cacaaebffe
--- /dev/null
+++ b/lib/compiler/src/beam_split.erl
@@ -0,0 +1,85 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(beam_split).
+-export([module/2]).
+
+-import(lists, [reverse/1]).
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
+ Fs = [split_blocks(F) || F <- Fs0],
+ {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+%% We must split the basic block when we encounter instructions with labels,
+%% such as catches and BIFs. All labels must be visible outside the blocks.
+
+split_blocks({function,Name,Arity,CLabel,Is0}) ->
+ Is = split_blocks(Is0, []),
+ {function,Name,Arity,CLabel,Is}.
+
+split_blocks([{block,Bl}|Is], Acc0) ->
+ Acc = split_block(Bl, [], Acc0),
+ split_blocks(Is, Acc);
+split_blocks([I|Is], Acc) ->
+ split_blocks(Is, [I|Acc]);
+split_blocks([], Acc) -> reverse(Acc).
+
+split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) ->
+ %% is_record/3 must be translated by beam_clean; therefore,
+ %% it must be outside of any block.
+ split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]);
+split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 ->
+ split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]);
+split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc)
+ when Lbl =/= 0 ->
+ split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]);
+split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) ->
+ split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]);
+split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) ->
+ split_block(Is, [], [Line|make_block(Bl, Acc)]);
+split_block([I|Is], Bl, Acc) ->
+ split_block(Is, [I|Bl], Acc);
+split_block([], Bl, Acc) -> make_block(Bl, Acc).
+
+make_block([], Acc) -> Acc;
+make_block([{set,[D],Ss,{bif,Op,Fail}}|Bl]=Bl0, Acc) ->
+ %% If the last instruction in the block is a comparison or boolean operator
+ %% (such as '=:='), move it out of the block to facilitate further
+ %% optimizations.
+ Arity = length(Ss),
+ case erl_internal:comp_op(Op, Arity) orelse
+ erl_internal:new_type_test(Op, Arity) orelse
+ erl_internal:bool_op(Op, Arity) of
+ false ->
+ [{block,reverse(Bl0)}|Acc];
+ true ->
+ I = {bif,Op,Fail,Ss,D},
+ case Bl =:= [] of
+ true -> [I|Acc];
+ false -> [I,{block,reverse(Bl)}|Acc]
+ end
+ end;
+make_block([{set,[Dst],[Src],move}|Bl], Acc) ->
+ %% Make optimization of {move,Src,Dst}, {jump,...} possible.
+ I = {move,Src,Dst},
+ case Bl =:= [] of
+ true -> [I|Acc];
+ false -> [I,{block,reverse(Bl)}|Acc]
+ end;
+make_block(Bl, Acc) -> [{block,reverse(Bl)}|Acc].
diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl
index 790aba0a9a..5f4fa3b1f8 100644
--- a/lib/compiler/src/beam_trim.erl
+++ b/lib/compiler/src/beam_trim.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -222,7 +222,9 @@ remap([{call_last,Ar,Name,N}|Is], Map, Acc) ->
reverse(Acc, [I|Is]);
remap([{call_ext_last,Ar,Name,N}|Is], Map, Acc) ->
I = {call_ext_last,Ar,Name,Map({frame_size,N})},
- reverse(Acc, [I|Is]).
+ reverse(Acc, [I|Is]);
+remap([{line,_}=I|Is], Map, Acc) ->
+ remap(Is, Map, [I|Acc]).
remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) ->
Ds = [Map(D) || D <- Ds0],
@@ -230,14 +232,15 @@ remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) ->
remap_block(Is, Map, [{set,Ds,Ss,Info}|Acc]);
remap_block([], _, Acc) -> reverse(Acc).
-safe_labels([{label,L},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y ->
+safe_labels([{label,L},{line,_},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y ->
safe_labels(Is, [L|Acc]);
-safe_labels([{label,L},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y ->
+safe_labels([{label,L},{line,_},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y ->
safe_labels(Is, [L|Acc]);
-safe_labels([{label,L},if_end|Is], Acc) ->
+safe_labels([{label,L},{line,_},if_end|Is], Acc) ->
safe_labels(Is, [L|Acc]);
safe_labels([{label,L},
{block,[{set,[{x,0}],[{Tag,_}],move}]},
+ {line,_},
{call_ext,1,{extfunc,erlang,error,1}}|Is], Acc) when Tag =/= y ->
safe_labels(Is, [L|Acc]);
safe_labels([_|Is], Acc) ->
@@ -321,6 +324,8 @@ frame_size([{make_fun2,_,_,_,_}|Is], Safe) ->
frame_size([{deallocate,N}|_], _) -> N;
frame_size([{call_last,_,_,N}|_], _) -> N;
frame_size([{call_ext_last,_,_,N}|_], _) -> N;
+frame_size([{line,_}|Is], Safe) ->
+ frame_size(Is, Safe);
frame_size([_|_], _) -> throw(not_possible).
frame_size_branch(0, Is, Safe) ->
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index f83f73b224..7392f99fb6 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -29,10 +29,17 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
{ok,{Mod,Exp,Attr,Fs,Lc}}.
function({function,Name,Arity,CLabel,Asm0}) ->
- Asm1 = beam_utils:live_opt(Asm0),
- Asm2 = opt(Asm1, [], tdb_new()),
- Asm = beam_utils:delete_live_annos(Asm2),
- {function,Name,Arity,CLabel,Asm}.
+ try
+ Asm1 = beam_utils:live_opt(Asm0),
+ Asm2 = opt(Asm1, [], tdb_new()),
+ Asm = beam_utils:delete_live_annos(Asm2),
+ {function,Name,Arity,CLabel,Asm}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
%% opt([Instruction], Accumulator, TypeDb) -> {[Instruction'],TypeDb'}
%% Keep track of type information; try to simplify.
@@ -168,6 +175,8 @@ simplify_float_1([{set,[D0],[A,B],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Ts0,
simplify_float_1([{set,_,_,{'catch',_}}=I|Is]=Is0, _Ts, Rs0, Acc0) ->
Acc = flush_all(Rs0, Is0, Acc0),
simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]);
+simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) ->
+ simplify_float_1(Is, Ts, Rs, [I|Acc]);
simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) ->
Ts = update(I, Ts0),
{Rs,Acc} = flush(Rs0, Is0, Acc0),
@@ -400,6 +409,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts);
+update({line,_}, Ts) -> Ts;
%% The instruction is unknown. Kill all information.
update(_I, _Ts) -> tdb_new().
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 45cdf8a659..194f089ba1 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -26,7 +26,7 @@
code_at/2,bif_to_test/3,is_pure_test/1,
live_opt/1,delete_live_annos/1,combine_heap_needs/2]).
--import(lists, [member/2,sort/1,reverse/1]).
+-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
-record(live,
{bl, %Block check fun.
@@ -195,10 +195,14 @@ is_pure_test({test,Op,_,Ops}) ->
%% Also insert {'%live',Live} annotations at the beginning
%% and end of each block.
%%
-live_opt([{label,Fail}=I1,
- {func_info,_,_,Live}=I2|Is]) ->
+live_opt(Is0) ->
+ {[{label,Fail}|_]=Bef,[Fi|Is]} =
+ splitwith(fun({func_info,_,_,_}) -> false;
+ (_) -> true
+ end, Is0),
+ {func_info,_,_,Live} = Fi,
D = gb_trees:insert(Fail, live_call(Live), gb_trees:empty()),
- [I1,I2|live_opt(reverse(Is), 0, D, [])].
+ Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])].
%% delete_live_annos([Instruction]) -> [Instruction].
@@ -470,8 +474,15 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) ->
end;
check_liveness(R, [{try_end,Y}|Is], St) ->
case R of
- Y -> {killed,St};
- _ -> check_liveness(R, Is, St)
+ Y ->
+ {killed,St};
+ {y,_} ->
+ %% y registers will be used if an exception occurs and
+ %% control transfers to the label given in the previous
+ %% try/2 instruction.
+ {used,St};
+ _ ->
+ check_liveness(R, Is, St)
end;
check_liveness(R, [{catch_end,Y}|Is], St) ->
case R of
@@ -499,6 +510,8 @@ check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) ->
end;
check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) ->
check_liveness_at(R, Fail, St);
+check_liveness(R, [{line,_}|Is], St) ->
+ check_liveness(R, Is, St);
check_liveness(_R, Is, St) when is_list(Is) ->
%% case Is of
%% [I|_] ->
@@ -728,6 +741,9 @@ live_opt([{badmatch,Src}=I|Is], _, D, Acc) ->
live_opt([{case_end,Src}=I|Is], _, D, Acc) ->
Regs = x_live([Src], 0),
live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{try_case_end,Src}=I|Is], _, D, Acc) ->
+ Regs = x_live([Src], 0),
+ live_opt(Is, Regs, D, [I|Acc]);
live_opt([if_end=I|Is], _, D, Acc) ->
Regs = 0,
live_opt(Is, Regs, D, [I|Acc]);
@@ -789,8 +805,6 @@ live_opt([{deallocate,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{kill,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{try_case_end,_}=I|Is], Regs, D, Acc) ->
- live_opt(Is, Regs, D, [I|Acc]);
live_opt([{try_end,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) ->
@@ -799,6 +813,8 @@ live_opt([{wait,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x ->
live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{line,_}=I|Is], Regs, D, Acc) ->
+ live_opt(Is, Regs, D, [I|Acc]);
%% The following instructions can occur if the "compilation" has been
%% started from a .S file using the 'asm' option.
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index fb267b35b6..29758b8fb4 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -166,12 +166,17 @@ validate(Module, Fs) ->
Ft = index_bs_start_match(Fs, []),
validate_0(Module, Fs, Ft).
-index_bs_start_match([{function,_,_,Entry,Code}|Fs], Acc0) ->
+index_bs_start_match([{function,_,_,Entry,Code0}|Fs], Acc0) ->
+ Code = dropwhile(fun({label,L}) when L =:= Entry -> false;
+ (_) -> true
+ end, Code0),
case Code of
- [_,_,{label,Entry}|Is] ->
+ [{label,Entry}|Is] ->
Acc = index_bs_start_match_1(Is, Entry, Acc0),
index_bs_start_match(Fs, Acc);
_ ->
+ %% Something serious is wrong. Ignore it for now.
+ %% It will be detected and diagnosed later.
index_bs_start_match(Fs, Acc0)
end;
index_bs_start_match([], Acc) ->
@@ -292,6 +297,8 @@ labels(Is) ->
labels_1([{label,L}|Is], R) ->
labels_1(Is, [L|R]);
+labels_1([{line,_}|Is], R) ->
+ labels_1(Is, R);
labels_1(Is, R) ->
{lists:reverse(R),Is}.
@@ -433,6 +440,8 @@ valfun_1(remove_message, Vst) ->
Vst;
valfun_1({'%',_}, Vst) ->
Vst;
+valfun_1({line,_}, Vst) ->
+ Vst;
%% Exception generating calls
valfun_1({call_ext,Live,Func}=I, Vst) ->
case return_type(Func, Vst) of
@@ -661,10 +670,20 @@ valfun_4({get_tuple_element,Src,I,Dst}, Vst) ->
valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
%% If source and destination registers are the same, match state
%% is OK as input.
- _ = get_move_term_type(Ctx, Vst0),
+ CtxType = get_move_term_type(Ctx, Vst0),
verify_live(Live, Vst0),
Vst1 = prune_x_regs(Live, Vst0),
- Vst = branch_state(Fail, Vst1),
+ BranchVst = case CtxType of
+ {match_context,_,_} ->
+ %% The failure branch will never be taken when Ctx
+ %% is a match context. Therefore, the type for Ctx
+ %% at the failure label must not be match_context
+ %% (or we could reject legal code).
+ set_type_reg(term, Ctx, Vst1);
+ _ ->
+ Vst1
+ end,
+ Vst = branch_state(Fail, BranchVst),
set_type_reg(bsm_match_state(NeedSlots), Ctx, Vst);
valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) ->
assert_term(Src, Vst0),
@@ -764,15 +783,27 @@ valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) ->
valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) ->
assert_term(Src, Vst),
set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
-valfun_4({bs_init2,{f,Fail},_,Heap,Live,_,Dst}, Vst0) ->
+valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
+ if
+ is_integer(Sz) ->
+ ok;
+ true ->
+ assert_term(Sz, Vst0)
+ end,
Vst1 = heap_alloc(Heap, Vst0),
Vst2 = branch_state(Fail, Vst1),
Vst3 = prune_x_regs(Live, Vst2),
Vst = bs_zero_bits(Vst3),
set_type_reg(binary, Dst, Vst);
-valfun_4({bs_init_bits,{f,Fail},_,Heap,Live,_,Dst}, Vst0) ->
+valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
+ if
+ is_integer(Sz) ->
+ ok;
+ true ->
+ assert_term(Sz, Vst0)
+ end,
Vst1 = heap_alloc(Heap, Vst0),
Vst2 = branch_state(Fail, Vst1),
Vst3 = prune_x_regs(Live, Vst2),
@@ -870,6 +901,8 @@ val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) ->
error(illegal_context_for_set_tuple_element);
val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) ->
Vst;
+val_dsetel({line,_}, Vst) ->
+ Vst;
val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) ->
Vst#vst{current=St#st{setelem=false}};
val_dsetel(_, Vst) -> Vst.
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index c15103999f..2e7554c1ff 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -1262,8 +1262,9 @@ i_receive_1(E, Cs, T, B, S) ->
i_module(E, Ctxt, Ren, Env, S) ->
%% Cf. `i_letrec'. Note that we pass a dummy constant value for the
%% "body" parameter.
+ Exps = i_module_exports(E),
{Es, _, Xs1, S1} = i_letrec(module_defs(E), void(),
- module_exports(E), Ctxt, Ren, Env, S),
+ Exps, Ctxt, Ren, Env, S),
%% Sanity check:
case Es of
[] ->
@@ -1276,6 +1277,27 @@ i_module(E, Ctxt, Ren, Env, S) ->
E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es),
{E1, count_size(weight(module), S1)}.
+i_module_exports(E) ->
+ %% If a function is named in an `on_load' attribute, we will
+ %% pretend that it is exported to ensure that it will not be removed.
+ Exps = module_exports(E),
+ Attrs = module_attrs(E),
+ case i_module_on_load(Attrs) of
+ none ->
+ Exps;
+ [{_,_}=FA] ->
+ ordsets:add_element(c_var(FA), Exps)
+ end.
+
+i_module_on_load([{Key,Val}|T]) ->
+ case concrete(Key) of
+ on_load ->
+ concrete(Val);
+ _ ->
+ i_module_on_load(T)
+ end;
+i_module_on_load([]) -> none.
+
%% Binary-syntax expressions are too complicated to do anything
%% interesting with here - that is beyond the scope of this program;
%% also, their construction could have side effects, so even in effect
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index e46c667e47..0a368df5d6 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -146,10 +146,17 @@ env_default_opts() ->
do_compile(Input, Opts0) ->
Opts = expand_opts(Opts0),
- Self = self(),
- Serv = spawn_link(fun() -> internal(Self, Input, Opts) end),
+ {Pid,Ref} =
+ spawn_monitor(fun() ->
+ exit(try
+ internal(Input, Opts)
+ catch
+ error:Reason ->
+ {error,Reason}
+ end)
+ end),
receive
- {Serv,Rep} -> Rep
+ {'DOWN',Ref,process,Pid,Rep} -> Rep
end.
expand_opts(Opts0) ->
@@ -172,9 +179,11 @@ expand_opt(report, Os) ->
expand_opt(return, Os) ->
[return_errors,return_warnings|Os];
expand_opt(r12, Os) ->
- [no_recv_opt|Os];
+ [no_recv_opt,no_line_info|Os];
expand_opt(r13, Os) ->
- [no_recv_opt|Os];
+ [no_recv_opt,no_line_info|Os];
+expand_opt(r14, Os) ->
+ [no_line_info|Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_float_opt, Os) ->
@@ -235,21 +244,20 @@ format_error({module_name,Mod,Filename}) ->
code=[],
core_code=[],
abstract_code=[], %Abstract code for debugger.
- options=[] :: [option()],
+ options=[] :: [option()], %Options for compilation
+ mod_options=[] :: [option()], %Options for module_info
errors=[],
warnings=[]}).
-internal(Master, Input, Opts) ->
- Master ! {self(), try internal(Input, Opts)
- catch error:Reason -> {error, Reason}
- end}.
-
-internal({forms,Forms}, Opts) ->
- {_,Ps} = passes(forms, Opts),
- internal_comp(Ps, "", "", #compile{code=Forms,options=Opts});
+internal({forms,Forms}, Opts0) ->
+ {_,Ps} = passes(forms, Opts0),
+ Source = proplists:get_value(source, Opts0, ""),
+ Opts1 = proplists:delete(source, Opts0),
+ Compile = #compile{code=Forms,options=Opts1,mod_options=Opts1},
+ internal_comp(Ps, Source, "", Compile);
internal({file,File}, Opts) ->
{Ext,Ps} = passes(file, Opts),
- Compile = #compile{options=Opts},
+ Compile = #compile{options=Opts,mod_options=Opts},
internal_comp(Ps, File, Ext, Compile).
internal_comp(Passes, File, Suffix, St0) ->
@@ -625,11 +633,15 @@ asm_passes() ->
[{unless,no_postopt,
[{pass,beam_block},
{iff,dblk,{listing,"block"}},
+ {unless,no_except,{pass,beam_except}},
+ {iff,dexcept,{listing,"except"}},
{unless,no_bopt,{pass,beam_bool}},
{iff,dbool,{listing,"bool"}},
{unless,no_topt,{pass,beam_type}},
{iff,dtype,{listing,"type"}},
- {pass,beam_dead}, %Must always run since it splits blocks.
+ {pass,beam_split},
+ {iff,dsplit,{listing,"split"}},
+ {unless,no_dead,{pass,beam_dead}},
{iff,ddead,{listing,"dead"}},
{unless,no_jopt,{pass,beam_jump}},
{iff,djmp,{listing,"jump"}},
@@ -1228,12 +1240,13 @@ beam_unused_labels(#compile{code=Code0}=St) ->
Code = beam_jump:module_labels(Code0),
{ok,St#compile{code=Code}}.
-beam_asm(#compile{ifile=File,code=Code0,abstract_code=Abst,options=Opts0}=St) ->
+beam_asm(#compile{ifile=File,code=Code0,
+ abstract_code=Abst,mod_options=Opts0}=St) ->
Source = filename:absname(File),
Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'};
(Other) -> Other
end, Opts0),
- Opts2 = [O || O <- Opts1, is_informative_option(O)],
+ Opts2 = [O || O <- Opts1, effects_code_generation(O)],
case beam_asm:module(Code0, Abst, Source, Opts2) of
{ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}}
end.
@@ -1303,15 +1316,23 @@ embed_native_code(St, {Architecture,NativeCode}) ->
{ok, BeamPlusNative} = beam_lib:build_module(Chunks),
St#compile{code=BeamPlusNative}.
-%% Returns true if the option is informative and therefore should be included
-%% in the option list of the compiled module.
-
-is_informative_option(beam) -> false;
-is_informative_option(report_warnings) -> false;
-is_informative_option(report_errors) -> false;
-is_informative_option(binary) -> false;
-is_informative_option(verbose) -> false;
-is_informative_option(_) -> true.
+%% effects_code_generation(Option) -> true|false.
+%% Determine whether the option could have any effect on the
+%% generated code in the BEAM file (as opposed to how
+%% errors will be reported).
+
+effects_code_generation(Option) ->
+ case Option of
+ beam -> false;
+ report_warnings -> false;
+ report_errors -> false;
+ return_errors-> false;
+ return_warnings-> false;
+ binary -> false;
+ verbose -> false;
+ {cwd,_} -> false;
+ _ -> true
+ end.
save_binary(#compile{code=none}=St) -> {ok,St};
save_binary(#compile{module=Mod,ofile=Outfile,
@@ -1438,6 +1459,8 @@ iofile(File) when is_atom(File) ->
iofile(File) ->
{filename:dirname(File), filename:basename(File, ".erl")}.
+erlfile(".", Base, Suffix) ->
+ Base ++ Suffix;
erlfile(Dir, Base, Suffix) ->
filename:join(Dir, Base ++ Suffix).
@@ -1510,6 +1533,8 @@ restore_expand_module([{attribute,Line,opaque,[Type]}|Fs]) ->
[{attribute,Line,opaque,Type}|restore_expand_module(Fs)];
restore_expand_module([{attribute,Line,spec,[Arg]}|Fs]) ->
[{attribute,Line,spec,Arg}|restore_expand_module(Fs)];
+restore_expand_module([{attribute,Line,callback,[Arg]}|Fs]) ->
+ [{attribute,Line,callback,Arg}|restore_expand_module(Fs)];
restore_expand_module([F|Fs]) ->
[F|restore_expand_module(Fs)];
restore_expand_module([]) -> [].
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 4ac879c9a4..1133882728 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -1,7 +1,7 @@
% This is an -*- erlang -*- file.
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -28,12 +28,14 @@
beam_dead,
beam_dict,
beam_disasm,
+ beam_except,
beam_flatten,
beam_jump,
beam_listing,
beam_opcodes,
beam_peep,
beam_receive,
+ beam_split,
beam_trim,
beam_type,
beam_utils,
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index f8128702dd..9ad2378d00 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -72,7 +72,6 @@ is_pure(erlang, binary_to_list, 1) -> true;
is_pure(erlang, binary_to_list, 3) -> true;
is_pure(erlang, bit_size, 1) -> true;
is_pure(erlang, byte_size, 1) -> true;
-is_pure(erlang, concat_binary, 1) -> true;
is_pure(erlang, element, 2) -> true;
is_pure(erlang, float, 1) -> true;
is_pure(erlang, float_to_list, 1) -> true;
@@ -137,6 +136,7 @@ is_pure(math, sinh, 1) -> true;
is_pure(math, sqrt, 1) -> true;
is_pure(math, tan, 1) -> true;
is_pure(math, tanh, 1) -> true;
+is_pure(math, pi, 0) -> true;
is_pure(_, _, _) -> false.
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 63527bda8f..75ac91907a 100644
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1998-2010. All Rights Reserved.
+# Copyright Ericsson AB 1998-2011. All Rights Reserved.
#
# The contents of this file are subject to the Erlang Public License,
# Version 1.1, (the "License"); you may not use this file except in
@@ -280,3 +280,7 @@ BEAM_FORMAT_NUMBER=0
150: recv_mark/1
151: recv_set/1
152: gc_bif3/7
+
+# R15A
+
+153: line/1
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 6ea67741fa..18fba7962b 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -150,14 +150,26 @@ guard(Expr, Sub) ->
opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) ->
Body = opt_guard_try(Body0),
case {Arg,Body} of
- {#c_call{},#c_literal{val=false}} ->
- %% We have sequence consisting of a call (evaluted
- %% for a possible exception only), followed by 'false'.
- %% Since the sequence is inside a try block that will
+ {#c_call{module=#c_literal{val=Mod},
+ name=#c_literal{val=Name},
+ args=Args},#c_literal{val=false}} ->
+ %% We have sequence consisting of a call (evaluated
+ %% for a possible exception and/or side effect only),
+ %% followed by 'false'.
+ %% Since the sequence is inside a try block that will
%% default to 'false' if any exception occurs, not
%% evalutating the call will not change the behaviour
- %% of the guard.
- Body;
+ %% provided that the call has no side effects.
+ case erl_bifs:is_pure(Mod, Name, length(Args)) of
+ false ->
+ %% Not a pure BIF (meaning that this is not
+ %% a guard and that we must keep the call).
+ Seq#c_seq{body=Body};
+ true ->
+ %% The BIF has no side effects, so it can
+ %% be safely removed.
+ Body
+ end;
{_,_} ->
Seq#c_seq{body=Body}
end;
@@ -1747,36 +1759,26 @@ opt_bool_clauses([_|_], _, _) ->
%% end. NewVar ->
%% erlang:error(badarg)
%% end.
-%%
-%% We add the extra match-all clause at the end only if Expr is
-%% not guaranteed to evaluate to a boolean.
opt_bool_not(#c_case{arg=Arg,clauses=Cs0}=Case0) ->
case Arg of
#c_call{anno=Anno,module=#c_literal{val=erlang},
name=#c_literal{val='not'},
args=[Expr]} ->
- Cs = opt_bool_not(Anno, Expr, Cs0),
+ Cs = [opt_bool_not_invert(C) || C <- Cs0] ++
+ [#c_clause{anno=[compiler_generated],
+ pats=[#c_var{name=cor_variable}],
+ guard=#c_literal{val=true},
+ body=#c_call{anno=Anno,
+ module=#c_literal{val=erlang},
+ name=#c_literal{val=error},
+ args=[#c_literal{val=badarg}]}}],
Case = Case0#c_case{arg=Expr,clauses=Cs},
opt_bool_not(Case);
_ ->
opt_bool_case_redundant(Case0)
end.
-opt_bool_not(Anno, Expr, Cs) ->
- Tail = case is_bool_expr(Expr) of
- false ->
- [#c_clause{anno=[compiler_generated],
- pats=[#c_var{name=cor_variable}],
- guard=#c_literal{val=true},
- body=#c_call{anno=Anno,
- module=#c_literal{val=erlang},
- name=#c_literal{val=error},
- args=[#c_literal{val=badarg}]}}];
- true -> []
- end,
- [opt_bool_not_invert(C) || C <- Cs] ++ Tail.
-
opt_bool_not_invert(#c_clause{pats=[#c_literal{val=Bool}]}=C) ->
C#c_clause{pats=[#c_literal{val=not Bool}]}.
@@ -2065,32 +2067,7 @@ opt_case_in_let_2(V, Arg0,
(_) -> false end, Es), %Only variables in tuple
false = core_lib:is_var_used(V, B), %Built tuple must not be used.
Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail.
- #c_let{vars=Es,arg=Arg1,body=B};
-opt_case_in_let_2(_, Arg, Cs) ->
- %% simplify_bool_case(Case0) -> Case
- %% Remove unecessary cases like
- %%
- %% case BoolExpr of
- %% true -> true;
- %% false -> false;
- %% ....
- %% end
- %%
- %% where BoolExpr is an expression that can only return true
- %% or false (or throw an exception).
-
- true = is_bool_case(Cs) andalso is_bool_expr(Arg),
- Arg.
-
-is_bool_case([A,B|_]) ->
- (is_bool_clause(true, A) andalso is_bool_clause(false, B))
- orelse (is_bool_clause(false, A) andalso is_bool_clause(true, B)).
-
-is_bool_clause(Bool, #c_clause{pats=[#c_literal{val=Bool}],
- guard=#c_literal{val=true},
- body=#c_literal{val=Bool}}) ->
- true;
-is_bool_clause(_, _) -> false.
+ #c_let{vars=Es,arg=Arg1,body=B}.
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
@@ -2612,14 +2589,14 @@ bsm_maybe_ctx_to_binary(V, B) ->
body=B}
end.
-previous_ctx_to_binary(V, #c_seq{arg=#c_primop{name=Name,args=As}}) ->
- case {Name,As} of
- {#c_literal{val=bs_context_to_binary},[#c_var{name=V}]} ->
+previous_ctx_to_binary(V, Core) ->
+ case Core of
+ #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]}} ->
true;
- {_,_} ->
+ _ ->
false
- end;
-previous_ctx_to_binary(_, _) -> false.
+ end.
%% bsm_leftmost(Cs) -> none | ArgumentNumber
%% Find the leftmost argument that does binary matching. Return
@@ -2641,9 +2618,9 @@ bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
bsm_leftmost_2([], Cs, _, Pos) ->
bsm_leftmost_1(Cs, Pos).
-%% bsm_notempty(Cs, Pos) -> true|false
+%% bsm_nonempty(Cs, Pos) -> true|false
%% Check if at least one of the clauses matches a non-empty
-%% binary in the given argumet position.
+%% binary in the given argument position.
%%
bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
case nth(Pos, Ps) of
@@ -2704,7 +2681,7 @@ bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
%%
%% But if the clauses can't be freely rearranged, as in
%%
- %% b(Var, <<>>) -> ...
+ %% b(Var, <<X>>) -> ...
%% b(1, 2) -> ...
%%
%% we do have a problem.
@@ -2764,22 +2741,20 @@ add_bin_opt_info(Core, Term) ->
end.
add_warning(Core, Term) ->
- Anno = core_lib:get_anno(Core),
- case lists:member(compiler_generated, Anno) of
- true -> ok;
+ case is_compiler_generated(Core) of
+ true ->
+ ok;
false ->
- case get_line(Anno) of
- Line when Line >= 0 -> %Must be positive.
- File = get_file(Anno),
- Key = {?MODULE,warnings},
- case get(Key) of
- [{File,[{Line,?MODULE,Term}]}|_] ->
- ok; %We already have
+ Anno = core_lib:get_anno(Core),
+ Line = get_line(Anno),
+ File = get_file(Anno),
+ Key = {?MODULE,warnings},
+ case get(Key) of
+ [{File,[{Line,?MODULE,Term}]}|_] ->
+ ok; %We already have
%an identical warning.
- Ws ->
- put(Key, [{File,[{Line,?MODULE,Term}]}|Ws])
- end;
- _ -> ok %Compiler-generated code.
+ Ws ->
+ put(Key, [{File,[{Line,?MODULE,Term}]}|Ws])
end
end.
@@ -2793,14 +2768,7 @@ get_file([]) -> "no_file". % should not happen
is_compiler_generated(Core) ->
Anno = core_lib:get_anno(Core),
- case lists:member(compiler_generated, Anno) of
- true -> true;
- false ->
- case get_line(Anno) of
- Line when Line >= 0 -> false;
- _ -> true
- end
- end.
+ member(compiler_generated, Anno).
get_warnings() ->
ordsets:from_list((erase({?MODULE,warnings}))).
diff --git a/lib/compiler/src/sys_expand_pmod.erl b/lib/compiler/src/sys_expand_pmod.erl
index 4fee26f2a6..da644b4f0b 100644
--- a/lib/compiler/src/sys_expand_pmod.erl
+++ b/lib/compiler/src/sys_expand_pmod.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -317,6 +317,8 @@ expr({'try',Line,Es0,Scs0,Ccs0,As0},St) ->
Ccs1 = icr_clauses(Ccs0,St),
As1 = exprs(As0,St),
{'try',Line,Es1,Scs1,Ccs1,As1};
+expr({'fun',_,{function,_,_,_}}=ExtFun,_St) ->
+ ExtFun;
expr({'fun',Line,Body,Info},St) ->
case Body of
{clauses,Cs0} ->
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 249bd7a8e7..97d3ff626c 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -31,8 +31,6 @@
-import(ordsets, [from_list/1,add_element/2,union/2]).
-import(lists, [member/2,foldl/3,foldr/3]).
--compile({nowarn_deprecated_function, {erlang,hash,2}}).
-
-include("../include/erl_bits.hrl").
-record(expand, {module=[], %Module name
@@ -43,12 +41,12 @@
mod_imports, %Module Imports
compile=[], %Compile flags
attributes=[], %Attributes
- defined=[], %Defined functions
+ callbacks=[], %Callbacks
+ defined, %Defined functions (gb_set)
vcount=0, %Variable counter
func=[], %Current function
arity=[], %Arity for current function
fcount=0, %Local fun count
- fun_index=0, %Global index for funs
bitdefault,
bittypes
}).
@@ -85,7 +83,7 @@ module(Fs0, Opts0) ->
{Efs,St2} = expand_pmod(Tfs, St1),
%% Get the correct list of exported functions.
Exports = case member(export_all, St2#expand.compile) of
- true -> St2#expand.defined;
+ true -> gb_sets:to_list(St2#expand.defined);
false -> St2#expand.exports
end,
%% Generate all functions from stored info.
@@ -108,10 +106,11 @@ expand_pmod(Fs0, St0) ->
true ->
Ps0
end,
+ Def = gb_sets:to_list(St0#expand.defined),
{Fs1,Xs,Ds} = sys_expand_pmod:forms(Fs0, Ps,
St0#expand.exports,
- St0#expand.defined),
- St1 = St0#expand{exports=Xs, defined=Ds},
+ Def),
+ St1 = St0#expand{exports=Xs,defined=gb_sets:from_list(Ds)},
{Fs2,St2} = add_instance(Ps, Fs1, St1),
{Fs3,St3} = ensure_new(Base, Ps0, Fs2, St2),
{Fs3,St3#expand{attributes = [{abstract, 0, [true]}
@@ -120,7 +119,7 @@ expand_pmod(Fs0, St0) ->
get_base(As) ->
case lists:keyfind(extends, 1, As) of
- {extends,[Base]} when is_atom(Base) ->
+ {extends,_,[Base]} when is_atom(Base) ->
Base;
_ ->
[]
@@ -161,7 +160,7 @@ add_func(Name, Args, Body, Fs, St) ->
F = {function,0,Name,A,[{clause,0,Args,[],Body}]},
NA = {Name,A},
{[F|Fs],St#expand{exports=add_element(NA, St#expand.exports),
- defined=add_element(NA, St#expand.defined)}}.
+ defined=gb_sets:add_element(NA, St#expand.defined)}}.
%% define_function(Form, State) -> State.
%% Add function to defined if form is a function.
@@ -170,12 +169,43 @@ define_functions(Forms, #expand{defined=Predef}=St) ->
Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc];
(_, Acc) -> Acc
end, Predef, Forms),
- St#expand{defined=ordsets:from_list(Fs)}.
+ St#expand{defined=gb_sets:from_list(Fs)}.
-module_attrs(St) ->
- {[{attribute,Line,Name,Val} || {Name,Line,Val} <- St#expand.attributes],St}.
+module_attrs(#expand{attributes=Attributes}=St) ->
+ Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
+ Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
+ {Attrs,St#expand{callbacks=Callbacks}}.
module_predef_funcs(St) ->
+ {Mpf1,St1}=module_predef_func_beh_info(St),
+ {Mpf2,St2}=module_predef_funcs_mod_info(St1),
+ {Mpf1++Mpf2,St2}.
+
+module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
+ {[], St};
+module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined,
+ exports=Exports}=St) ->
+ PreDef=[{behaviour_info,1}],
+ PreExp=PreDef,
+ {[gen_beh_info(Callbacks)],
+ St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
+ exports=union(from_list(PreExp), Exports)}}.
+
+gen_beh_info(Callbacks) ->
+ List = make_list(Callbacks),
+ {function,0,behaviour_info,1,
+ [{clause,0,[{atom,0,callbacks}],[],
+ [List]}]}.
+
+make_list([]) -> {nil,0};
+make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
+ {cons,0,
+ {tuple,0,
+ [{atom,0,Name},
+ {integer,0,Arity}]},
+ make_list(Rest)}.
+
+module_predef_funcs_mod_info(St) ->
PreDef = [{module_info,0},{module_info,1}],
PreExp = PreDef,
{[{function,0,module_info,0,
@@ -186,7 +216,8 @@ module_predef_funcs(St) ->
[{clause,0,[{var,0,'X'}],[],
[{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
[{atom,0,St#expand.module},{var,0,'X'}]}]}]}],
- St#expand{defined=union(from_list(PreDef), St#expand.defined),
+ St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef),
+ St#expand.defined),
exports=union(from_list(PreExp), St#expand.exports)}}.
%% forms(Forms, State) ->
@@ -506,32 +537,34 @@ lc_tq(_Line, [], St0) ->
%% Transform an "explicit" fun {'fun', Line, {clauses, Cs}} into an
%% extended form {'fun', Line, {clauses, Cs}, Info}, unless it is the
%% name of a BIF (erl_lint has checked that it is not an import).
-%% Process the body sequence directly to get the new and used variables.
%% "Implicit" funs {'fun', Line, {function, F, A}} are not changed.
fun_tq(Lf, {function,F,A}=Function, St0) ->
- {As,St1} = new_vars(A, Lf, St0),
- Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}],
case erl_internal:bif(F, A) of
true ->
+ {As,St1} = new_vars(A, Lf, St0),
+ Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}],
fun_tq(Lf, {clauses,Cs}, St1);
false ->
- Index = St0#expand.fun_index,
- Uniq = erlang:hash(Cs, (1 bsl 27)-1),
- {Fname,St2} = new_fun_name(St1),
- {{'fun',Lf,Function,{Index,Uniq,Fname}},
- St2#expand{fun_index=Index+1}}
+ {Fname,St1} = new_fun_name(St0),
+ Index = Uniq = 0,
+ {{'fun',Lf,Function,{Index,Uniq,Fname}},St1}
end;
-fun_tq(L, {function,M,F,A}, St) ->
- {{call,L,{remote,L,{atom,L,erlang},{atom,L,make_fun}},
- [{atom,L,M},{atom,L,F},{integer,L,A}]},St};
+fun_tq(L, {function,M,F,A}, St) when is_atom(M), is_atom(F), is_integer(A) ->
+ %% This is the old format for external funs, generated by a pre-R15
+ %% compiler. That means that a tool, such as the debugger or xref,
+ %% directly invoked this module with the abstract code from a
+ %% pre-R15 BEAM file. Be helpful, and translate it to the new format.
+ fun_tq(L, {function,{atom,L,M},{atom,L,F},{integer,L,A}}, St);
+fun_tq(Lf, {function,_,_,_}=ExtFun, St) ->
+ {{'fun',Lf,ExtFun},St};
fun_tq(Lf, {clauses,Cs0}, St0) ->
- Uniq = erlang:hash(Cs0, (1 bsl 27)-1),
{Cs1,St1} = fun_clauses(Cs0, St0),
- Index = St1#expand.fun_index,
{Fname,St2} = new_fun_name(St1),
- {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},
- St2#expand{fun_index=Index+1}}.
+ %% Set dummy values for Index and Uniq -- the real values will
+ %% be assigned by beam_asm.
+ Index = Uniq = 0,
+ {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}.
fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) ->
{H,St1} = head(H0, St0),
@@ -690,4 +723,4 @@ imported(F, A, St) ->
end.
defined(F, A, St) ->
- ordsets:is_element({F,A}, St#expand.defined).
+ gb_sets:is_element({F,A}, St#expand.defined).
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 55e3c58d2a..812e85553f 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -53,7 +53,6 @@
%% Main codegen structure.
-record(cg, {lcount=1, %Label counter
- finfo, %Function info label
bfail, %Fail label for BIFs
break, %Break label
recv, %Receive label
@@ -79,9 +78,10 @@ module({Mod,Exp,Attr,Forms}, Options) ->
functions(Forms, AtomMod) ->
mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms).
-function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) ->
+function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) ->
try
- {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, {Name,Arity}, St0),
+ {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod,
+ {Name,Arity}, Anno, St0),
Func = {function,Name,Arity,EntryLabel,Asm},
{Func,St}
catch
@@ -93,7 +93,7 @@ function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) ->
%% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State}
-cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) ->
+cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
{Fi,St1} = new_label(St0), %FuncInfo label
{Fl,St2} = local_func_label(NameArity, St1),
@@ -125,11 +125,10 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) ->
stk=[]}, 0, Vdb),
{B,_Aft,St} = cg_list(Les, 0, Vdb, Bef,
St3#cg{bfail=0,
- finfo=Fi,
ultimate_failure=UltimateMatchFail,
is_top_block=true}),
{Name,Arity} = NameArity,
- Asm = [{label,Fi},{func_info,AtomMod,{atom,Name},Arity},
+ Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity},
{label,Fl}|B++[{label,UltimateMatchFail},if_end]],
{Asm,Fl,St}.
@@ -146,8 +145,6 @@ cg({match,M,Rs}, Le, Vdb, Bef, St) ->
match_cg(M, Rs, Le, Vdb, Bef, St);
cg({guard_match,M,Rs}, Le, Vdb, Bef, St) ->
guard_match_cg(M, Rs, Le, Vdb, Bef, St);
-cg({match_fail,F}, Le, Vdb, Bef, St) ->
- match_fail_cg(F, Le, Vdb, Bef, St);
cg({call,Func,As,Rs}, Le, Vdb, Bef, St) ->
call_cg(Func, As, Rs, Le, Vdb, Bef, St);
cg({enter,Func,As}, Le, Vdb, Bef, St) ->
@@ -293,39 +290,6 @@ match_cg({block,Es}, Le, _Fail, Bef, St) ->
Int = clear_dead(Bef, Le#l.i, Le#l.vdb),
block_cg(Es, Le, Int, St).
-%% match_fail_cg(FailReason, Le, Vdb, StackReg, State) ->
-%% {[Ainstr],StackReg,State}.
-%% Generate code for the match_fail "call". N.B. there is no generic
-%% case for when the fail value has been created elsewhere.
-
-match_fail_cg({function_clause,As}, Le, Vdb, Bef, St) ->
- %% Must have the args in {x,0}, {x,1},...
- {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
- {Sis ++ [{jump,{f,St#cg.finfo}}],
- Int#sr{reg=clear_regs(Int#sr.reg)},St};
-match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) ->
- R = cg_reg_arg(Term, Bef),
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis ++ [{badmatch,R}],
- Int#sr{reg=clear_regs(Int0#sr.reg)},St};
-match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) ->
- R = cg_reg_arg(Reason, Bef),
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis++[{case_end,R}],
- Int#sr{reg=clear_regs(Bef#sr.reg)},St};
-match_fail_cg(if_clause, Le, Vdb, Bef, St) ->
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis++[if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St};
-match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) ->
- R = cg_reg_arg(Reason, Bef),
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis ++ [{try_case_end,R}],
- Int#sr{reg=clear_regs(Int0#sr.reg)},St}.
-
%% bsm_rename_ctx([Clause], Var) -> [Clause]
%% We know from an annotation that the register for a binary can
%% be reused for the match context because the two are not truly
@@ -406,6 +370,7 @@ bsm_rename_ctx(#l{ke={test,_,_}}=L, _, _, _) -> L;
bsm_rename_ctx(#l{ke={bif,_,_,_}}=L, _, _, _) -> L;
bsm_rename_ctx(#l{ke={gc_bif,_,_,_}}=L, _, _, _) -> L;
bsm_rename_ctx(#l{ke={set,_,_}}=L, _, _, _) -> L;
+bsm_rename_ctx(#l{ke={call,_,_,_}}=L, _, _, _) -> L;
bsm_rename_ctx(#l{ke={block,_}}=L, Old, _, false) ->
%% This block is not inside a protected. The match context variable cannot
%% possibly be live inside the block.
@@ -1047,7 +1012,7 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) ->
%% Build complete code and final stack/register state.
Arity = length(As),
{Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
- {Sis ++ Frees ++ [{call_fun,Arity}],Aft,
+ {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft,
need_stack_frame(St0)};
call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0)
when element(1, Mod) =:= var;
@@ -1057,11 +1022,10 @@ call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0)
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
%% Build complete code and final stack/register state.
Arity = length(As),
- Call = {apply,Arity},
St = need_stack_frame(St0),
%%{Call,St1} = build_call(Func, Arity, St0),
{Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
- {Sis ++ Frees ++ [Call],Aft,St};
+ {Sis ++ Frees ++ [line(Le),{apply,Arity}],Aft,St};
call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
case St0 of
#cg{bfail=Fail} when Fail =/= 0 ->
@@ -1091,7 +1055,7 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
Arity = length(As),
{Call,St1} = build_call(Func, Arity, St0),
{Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
- {Sis ++ Frees ++ Call,Aft,St1}
+ {Sis ++ Frees ++ [line(Le)|Call],Aft,St1}
end.
build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) ->
@@ -1118,7 +1082,7 @@ enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) ->
{Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb),
%% Build complete code and final stack/register state.
Arity = length(As),
- {Sis ++ [{call_fun,Arity},return],
+ {Sis ++ [line(Le),{call_fun,Arity},return],
clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
need_stack_frame(St0)};
enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0)
@@ -1127,9 +1091,8 @@ enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0)
{Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb),
%% Build complete code and final stack/register state.
Arity = length(As),
- Call = {apply_only,Arity},
St = need_stack_frame(St0),
- {Sis ++ [Call],
+ {Sis ++ [line(Le),{apply_only,Arity}],
clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
St};
enter_cg(Func, As, Le, Vdb, Bef, St0) ->
@@ -1137,7 +1100,8 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) ->
%% Build complete code and final stack/register state.
Arity = length(As),
{Call,St1} = build_enter(Func, Arity, St0),
- {Sis ++ Call,
+ Line = enter_line(Func, Arity, Le),
+ {Sis ++ Line ++ Call,
clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
St1}.
@@ -1153,6 +1117,23 @@ build_enter(Name, Arity, St0) when is_atom(Name) ->
{Lbl,St1} = local_func_label(Name, Arity, St0),
{[{call_only,Arity,{f,Lbl}}],St1}.
+enter_line({remote,{atom,Mod},{atom,Name}}, Arity, Le) ->
+ case erl_bifs:is_safe(Mod, Name, Arity) of
+ false ->
+ %% Tail-recursive call, possibly to a BIF.
+ %% We'll need a line instruction in case the
+ %% BIF call fails.
+ [line(Le)];
+ true ->
+ %% Call to a safe BIF. Since it cannot fail,
+ %% we don't need any line instruction here.
+ []
+ end;
+enter_line(_, _, _) ->
+ %% Tail-recursive call to a local function. A line
+ %% instruction will not be useful.
+ [].
+
%% local_func_label(Name, Arity, State) -> {Label,State'}
%% local_func_label({Name,Arity}, State) -> {Label,State'}
%% Get the function entry label for a local function.
@@ -1226,9 +1207,10 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
%% Currently, we are somewhat pessimistic in
%% that we save any variable that will be live after this BIF call.
+ MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)),
{Sis,Int0} = case St0#cg.in_catch andalso
St0#cg.bfail =:= 0 andalso
- not erl_bifs:is_safe(erlang, Bif, length(As)) of
+ MayFail of
true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb);
false -> {[],Bef}
end,
@@ -1237,7 +1219,14 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
Int = Int1#sr{reg=Reg},
Dst = fetch_reg(V, Reg),
BifFail = {f,St0#cg.bfail},
- {Sis++[{bif,Bif,BifFail,Ars,Dst}],
+ %% We need a line instructions for BIFs that may fail in a body.
+ Line = case BifFail of
+ {f,0} when MayFail ->
+ [line(Le)];
+ _ ->
+ []
+ end,
+ {Sis++Line++[{bif,Bif,BifFail,Ars,Dst}],
clear_dead(Int, Le#l.i, Vdb), St0}.
@@ -1266,7 +1255,11 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
Int = Int1#sr{reg=Reg},
Dst = fetch_reg(V, Reg),
BifFail = {f,St0#cg.bfail},
- {Sis++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}],
+ Line = case BifFail of
+ {f,0} -> [line(Le)];
+ {f,_} -> []
+ end,
+ {Sis++Line++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}],
clear_dead(Int, Le#l.i, Vdb), St0}.
%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs,
@@ -1284,7 +1277,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) ->
{Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5),
Int2 = sr_merge(Raft, Taft), %Merge stack/registers
Reg = load_vars(Rs, Int2#sr.reg),
- {Sis ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}],
+ {Sis ++ [line(Le)] ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}],
clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb),
St6#cg{break=St0#cg.break,recv=St0#cg.recv}}.
@@ -1431,20 +1424,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
Other ->
[{move,Other,Ret}]
end,
- {Ais,clear_dead(Int, Le#l.i, Vdb),St};
-set_cg([], {binary,Segs}, Le, Vdb, Bef, St) ->
- Fail = {f,St#cg.bfail},
- Target = find_scratch_reg(Bef#sr.reg),
- Temp = find_scratch_reg(put_reg(Target, Bef#sr.reg)),
- PutCode = cg_bin_put(Segs, Fail, Bef),
- MaxRegs = max_reg(Bef#sr.reg),
- Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a),
- Aft = clear_dead(Bef, Le#l.i, Vdb),
- {Code,Aft,St};
-set_cg([], _, Le, Vdb, Bef, St) ->
- %% This should have been stripped by compiler, just cleanup.
- {[],clear_dead(Bef, Le#l.i, Vdb), St}.
-
+ {Ais,clear_dead(Int, Le#l.i, Vdb),St}.
%%%
%%% Code generation for constructing binaries.
@@ -1463,12 +1443,13 @@ cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode],
{bs_append,Fail,Target,0,MaxRegs,U,Src,BinFlags,Target}
end] ++ PutCode,
cg_bin_opt(Code);
-cg_binary(PutCode, Target, Temp, Fail, MaxRegs, _Anno) ->
+cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Anno) ->
+ Line = line(Anno),
Live = cg_live(Target, MaxRegs),
{InitOp,SzCode} = cg_binary_size(PutCode, Target, Temp, Fail, Live),
- Code = SzCode ++ [{InitOp,Fail,Target,0,MaxRegs,
- {field_flags,[]},Target}|PutCode],
+ Code = [Line|SzCode] ++ [{InitOp,Fail,Target,0,MaxRegs,
+ {field_flags,[]},Target}|PutCode],
cg_bin_opt(Code).
cg_live({x,X}, MaxRegs) when X =:= MaxRegs -> MaxRegs+1;
@@ -2052,6 +2033,38 @@ drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)].
new_label(#cg{lcount=Next}=St) ->
{Next,St#cg{lcount=Next+1}}.
+%% line(Le) -> {line,[] | {location,File,Line}}
+%% Create a line instruction, containing information about
+%% the current filename and line number. A line information
+%% instruction should be placed before any operation that could
+%% cause an exception.
+
+line(#l{a=Anno}) ->
+ line(Anno);
+line([Line,{file,Name}]) when is_integer(Line) ->
+ line_1(Name, Line);
+line([_|_]=A) ->
+ {Name,Line} = find_loc(A, no_file, 0),
+ line_1(Name, Line);
+line([]) ->
+ {line,[]}.
+
+line_1(no_file, _) ->
+ {line,[]};
+line_1(_, 0) ->
+ %% Missing line number or line number 0.
+ {line,[]};
+line_1(Name, Line) ->
+ {line,[{location,Name,Line}]}.
+
+find_loc([Line|T], File, _) when is_integer(Line) ->
+ find_loc(T, File, Line);
+find_loc([{file,File}|T], _, Line) ->
+ find_loc(T, File, Line);
+find_loc([_|T], File, Line) ->
+ find_loc(T, File, Line);
+find_loc([], File, Line) -> {File,Line}.
+
flatmapfoldl(F, Accu0, [Hd|Tail]) ->
{R,Accu1} = F(Hd, Accu0),
{Rs,Accu2} = flatmapfoldl(F, Accu1, Tail),
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 87bb5bec25..01042cc56f 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -180,7 +180,7 @@ body(Cs0, Name, Arity, St0) ->
{Args,St1} = new_vars(Anno, Arity, St0),
{Cs1,St2} = clauses(Cs0, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
- Fc = function_clause(Ps, {Name,Arity}),
+ Fc = function_clause(Ps, Anno, {Name,Arity}),
{#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}.
%% clause(Clause, State) -> {Cclause,State} | noclause.
@@ -507,15 +507,15 @@ expr({block,_,Es0}, St0) ->
{E1,Es1 ++ Eps,St2};
expr({'if',L,Cs0}, St0) ->
{Cs1,St1} = clauses(Cs0, St0),
- Fc = fail_clause([], #c_literal{val=if_clause}),
Lanno = lineno_anno(L, St1),
+ Fc = fail_clause([], Lanno, #c_literal{val=if_clause}),
{#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1};
expr({'case',L,E0,Cs0}, St0) ->
{E1,Eps,St1} = novars(E0, St0),
{Cs1,St2} = clauses(Cs0, St1),
{Fpat,St3} = new_var(St2),
- Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])),
- Lanno = lineno_anno(L, St3),
+ Lanno = lineno_anno(L, St2),
+ Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])),
{#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3};
expr({'receive',L,Cs0}, St0) ->
{Cs1,St1} = clauses(Cs0, St0),
@@ -541,9 +541,10 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
{V,St2} = new_var(St1), %This name should be arbitrary
{Cs1,St3} = clauses(Cs0, St2),
{Fpat,St4} = new_var(St3),
- Fc = fail_clause([Fpat], c_tuple([#c_literal{val=try_clause},Fpat])),
+ Lanno = lineno_anno(L, St4),
+ Fc = fail_clause([Fpat], Lanno,
+ c_tuple([#c_literal{val=try_clause},Fpat])),
{Evs,Hs,St5} = try_exception(Ecs, St4),
- Lanno = lineno_anno(L, St1),
{#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1,
vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}],
evars=Evs,handler=Hs},
@@ -572,6 +573,13 @@ expr({'catch',L,E0}, St0) ->
expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) ->
Lanno = lineno_anno(L, St),
{#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St};
+expr({'fun',L,{function,M,F,A}}, St0) ->
+ {As,Aps,St1} = safe_list([M,F,A], St0),
+ Lanno = lineno_anno(L, St1),
+ {#icall{anno=#a{anno=Lanno},
+ module=#c_literal{val=erlang},
+ name=#c_literal{val=make_fun},
+ args=As},Aps,St1};
expr({'fun',L,{clauses,Cs},Id}, St) ->
fun_tq(Id, Cs, L, St);
expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) ->
@@ -607,8 +615,8 @@ expr({match,L,P0,E0}, St0) ->
Thrown
end,
{Fpat,St4} = new_var(St3),
- Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])),
Lanno = lineno_anno(L, St4),
+ Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])),
case P2 of
nomatch ->
St = add_warning(L, nomatch, St4),
@@ -815,6 +823,13 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
{_,_} ->
throw(bad_binary)
end,
+ case Size1 of
+ #c_var{} -> ok;
+ #c_literal{val=Sz} when is_integer(Sz), Sz >= 0 -> ok;
+ #c_literal{val=undefined} -> ok;
+ #c_literal{val=all} -> ok;
+ _ -> throw(bad_binary)
+ end,
{#c_bitstr{val=E1,size=Size1,
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
@@ -828,8 +843,9 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) ->
{Cs1,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
- Fc = function_clause(Ps, {Name,Arity}),
- Fun = #ifun{anno=#a{anno=lineno_anno(L, St3)},
+ Anno = lineno_anno(L, St3),
+ Fc = function_clause(Ps, Anno, {Name,Arity}),
+ Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
vars=Args,clauses=Cs1,fc=Fc},
{Fun,[],St3}.
@@ -929,7 +945,7 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
[],St};
lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
%% Special case sequences guard tests.
- LA = lineno_anno(Line, St0),
+ LA = lineno_anno(element(2, Fil0), St0),
LAnno = #a{anno=LA},
case is_guard_test(Fil0) of
true ->
@@ -945,7 +961,8 @@ lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
false ->
{Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0),
{Fpat,St2} = new_var(St1),
- Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])),
+ Fc = fail_clause([Fpat], LA,
+ c_tuple([#c_literal{val=case_clause},Fpat])),
%% Do a novars little optimisation here.
{Filc,Fps,St3} = novars(Fil0, St2),
{#icase{anno=LAnno,
@@ -1072,7 +1089,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
[],St};
bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
%% Special case sequences guard tests.
- LA = lineno_anno(Line, St0),
+ LA = lineno_anno(element(2, Fil0), St0),
LAnno = #a{anno=LA},
case is_guard_test(Fil0) of
true ->
@@ -1089,7 +1106,8 @@ bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
false ->
{Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0),
{Fpat,St2} = new_var(St1),
- Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])),
+ Fc = fail_clause([Fpat], LA,
+ c_tuple([#c_literal{val=case_clause},Fpat])),
%% Do a novars little optimisation here.
{Filc,Fps,St} = novars(Fil0, St2),
{#icase{anno=LAnno,
@@ -1562,17 +1580,11 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 ->
new_vars_1(N-1, Anno, St1, [V|Vs]);
new_vars_1(0, _, St, Vs) -> {Vs,St}.
-function_clause(Ps, Name) ->
- function_clause(Ps, [], Name).
-
function_clause(Ps, LineAnno, Name) ->
- FcAnno = [{function_name,Name}],
+ FcAnno = [{function_name,Name}|LineAnno],
fail_clause(Ps, FcAnno,
ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])).
-fail_clause(Pats, Arg) ->
- fail_clause(Pats, [], Arg).
-
fail_clause(Pats, Anno, Arg) ->
#iclause{anno=#a{anno=[compiler_generated]},
pats=Pats,guard=[],
@@ -2080,7 +2092,12 @@ bitstr_vars(Segs, Vs) ->
lineno_anno(L, St) ->
{line, Line} = erl_parse:get_attribute(L, line),
- [Line] ++ St#core.file.
+ if
+ Line < 0 ->
+ [-Line] ++ St#core.file ++ [compiler_generated];
+ true ->
+ [Line] ++ St#core.file
+ end.
get_ianno(Ce) ->
case get_anno(Ce) of
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 3b33a08cf7..b184987625 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -83,14 +83,11 @@
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
keymember/3,keyfind/3]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
-
--compile({nowarn_deprecated_function, {erlang,hash,2}}).
+-import(cerl, [c_tuple/1]).
-include("core_parse.hrl").
-include("v3_kernel.hrl").
--define(EXPENSIVE_BINARY_LIMIT, 256).
-
%% These are not defined in v3_kernel.hrl.
get_kanno(Kthing) -> element(2, Kthing).
set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
@@ -121,7 +118,6 @@ copy_anno(Kdst, Ksrc) ->
funs=[], %Fun functions
free=[], %Free variables
ws=[] :: [warning()], %Warnings.
- lit, %Constant pool for literals.
guard_refc=0}). %> 0 means in guard
-spec module(cerl:c_module(), [compile:option()]) ->
@@ -130,7 +126,7 @@ copy_anno(Kdst, Ksrc) ->
module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
Kas = attributes(As),
Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
- St0 = #kern{lit=dict:new()},
+ St0 = #kern{},
{Kfs,St} = mapfoldl(fun function/2, St0, Fs),
{ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
@@ -247,30 +243,24 @@ expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) ->
%% instead of one for each occurrence as done now.
Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} ||
V <- integers(1, Arity)],
- Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{op=Fname,args=Vs}},
+ Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
expr(Fun, Sub, St);
expr(#c_var{anno=A,name=V}, Sub, St) ->
{#k_var{anno=A,name=get_vsub(V, Sub)},[],St};
-expr(#c_literal{}=Lit, Sub, St) ->
- Core = handle_literal(Lit),
- expr(Core, Sub, St);
-expr(#k_literal{val=Val0}=Klit, _Sub, #kern{lit=Literals0}=St) ->
- %% Share identical literals to save some space and time during compilation.
- case dict:find(Val0, Literals0) of
- {ok,Val} ->
- {Klit#k_literal{val=Val},[],St};
- error ->
- Literals = dict:store(Val0, Val0, Literals0),
- {Klit,[],St#kern{lit=Literals}}
- end;
-expr(#k_nil{}=V, _Sub, St) ->
- {V,[],St};
-expr(#k_int{}=V, _Sub, St) ->
- {V,[],St};
-expr(#k_float{}=V, _Sub, St) ->
- {V,[],St};
-expr(#k_atom{}=V, _Sub, St) ->
- {V,[],St};
+expr(#c_literal{anno=A,val=V}, _Sub, St) ->
+ Klit = case V of
+ [] ->
+ #k_nil{anno=A};
+ V when is_integer(V) ->
+ #k_int{anno=A,val=V};
+ V when is_float(V) ->
+ #k_float{anno=A,val=V};
+ V when is_atom(V) ->
+ #k_atom{anno=A,val=V};
+ _ ->
+ #k_literal{anno=A,val=V}
+ end,
+ {Klit,[],St};
expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
%% Do cons in two steps, first the expressions left to right, then
%% any remaining literals right to left.
@@ -288,11 +278,12 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
{#k_binary{anno=A,segs=Kv},Ep,St1}
catch
throw:bad_element_size ->
+ St1 = add_warning(get_line(A), bad_segment_size, A, St0),
Erl = #c_literal{val=erlang},
Name = #c_literal{val=error},
Args = [#c_literal{val=badarg}],
- Error = #c_call{module=Erl,name=Name,args=Args},
- expr(Error, Sub, St0)
+ Error = #c_call{anno=A,module=Erl,name=Name,args=Args},
+ expr(Error, Sub, St1)
end;
expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) ->
FA = case OldFF of
@@ -424,10 +415,11 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) ->
end;
expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) ->
Cargs = translate_match_fail(Cargs0, Sub, A, St0),
- %% This special case will disappear.
{Kargs,Ap,St} = atomic_list(Cargs, Sub, St0),
Ar = length(Cargs),
- Call = #k_call{anno=A,op=#k_internal{name=match_fail,arity=Ar},args=Kargs},
+ Call = #k_call{anno=A,op=#k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=error},
+ arity=Ar},args=Kargs},
{Call,Ap,St};
expr(#c_primop{anno=A,name=#c_literal{val=N},args=Cargs}, Sub, St0) ->
{Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0),
@@ -457,14 +449,14 @@ expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}.
translate_match_fail(Args, Sub, Anno, St) ->
case Args of
[#c_tuple{es=[#c_literal{val=function_clause}|As]}] ->
- translate_match_fail_1(Anno, Args, As, Sub, St);
+ translate_match_fail_1(Anno, As, Sub, St);
[#c_literal{val=Tuple}] when is_tuple(Tuple) ->
%% The inliner may have created a literal out of
%% the original #c_tuple{}.
case tuple_to_list(Tuple) of
[function_clause|As0] ->
As = [#c_literal{val=E} || E <- As0],
- translate_match_fail_1(Anno, Args, As, Sub, St);
+ translate_match_fail_1(Anno, As, Sub, St);
_ ->
Args
end;
@@ -473,7 +465,7 @@ translate_match_fail(Args, Sub, Anno, St) ->
Args
end.
-translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
+translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
AnnoFunc = case keyfind(function_name, 1, Anno) of
false ->
none; %Force rewrite.
@@ -483,10 +475,10 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
case {AnnoFunc,FF} of
{Same,Same} ->
%% Still in the correct function.
- Args;
+ translate_fc(As);
{{F,_},F} ->
%% Still in the correct function.
- Args;
+ translate_fc(As);
_ ->
%% Wrong function or no function_name annotation.
%%
@@ -495,9 +487,12 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
%% the current function). match_fail(function_clause) will
%% only work at the top level of the function it was originally
%% defined in, so we will need to rewrite it to a case_clause.
- [#c_tuple{es=[#c_literal{val=case_clause},#c_tuple{es=As}]}]
+ [c_tuple([#c_literal{val=case_clause},c_tuple(As)])]
end.
+translate_fc(Args) ->
+ [#c_literal{val=function_clause},make_list(Args)].
+
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
%% Classify the call.
call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) ->
@@ -607,7 +602,6 @@ is_atomic(#k_int{}) -> true;
is_atomic(#k_float{}) -> true;
is_atomic(#k_atom{}) -> true;
%%is_atomic(#k_char{}) -> true; %No characters
-%%is_atomic(#k_string{}) -> true;
is_atomic(#k_nil{}) -> true;
is_atomic(#k_var{}) -> true;
is_atomic(_) -> false.
@@ -916,9 +910,8 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) ->
true ->
%% The true clause body becomes the default.
{Kb,Pb,St1} = body(B, Osub, St0),
- Line = get_line(A),
- St2 = maybe_add_warning(Cs0, Line, St1),
- St = maybe_add_warning(Def0, Line, St2),
+ St2 = maybe_add_warning(Cs0, A, St1),
+ St = maybe_add_warning(Def0, A, St2),
{[],pre_seq(Pb, Kb),St};
false ->
{Kg,St1} = guard(G, Osub, St0),
@@ -929,15 +922,18 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) ->
end;
match_guard_1([], Def, St) -> {[],Def,St}.
-maybe_add_warning([C|_], Line, St) ->
- maybe_add_warning(C, Line, St);
-maybe_add_warning([], _Line, St) -> St;
-maybe_add_warning(fail, _Line, St) -> St;
-maybe_add_warning(Ke, MatchLine, St) ->
- case get_kanno(Ke) of
- [compiler_generated|_] -> St;
- Anno ->
+maybe_add_warning([C|_], MatchAnno, St) ->
+ maybe_add_warning(C, MatchAnno, St);
+maybe_add_warning([], _MatchAnno, St) -> St;
+maybe_add_warning(fail, _MatchAnno, St) -> St;
+maybe_add_warning(Ke, MatchAnno, St) ->
+ case is_compiler_generated(Ke) of
+ true ->
+ St;
+ false ->
+ Anno = get_kanno(Ke),
Line = get_line(Anno),
+ MatchLine = get_line(MatchAnno),
Warn = case MatchLine of
none -> nomatch_shadow;
_ -> {nomatch_shadow,MatchLine}
@@ -1119,7 +1115,6 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
end,
select_assert_match_possible(Bits, Val, Fl),
P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N},
- select_assert_match_possible(Bits, Val, Fl),
case member(native, Fl) of
true -> throw(not_possible);
false -> ok
@@ -1167,9 +1162,7 @@ select_bin_int_1(_, _, _, _) -> throw(not_possible).
select_assert_match_possible(Sz, Val, Fs) ->
EmptyBindings = erl_eval:new_bindings(),
- MatchFun = fun({integer,_,_}, NewV, Bs) when NewV =:= Val ->
- {match,Bs}
- end,
+ MatchFun = match_fun(Val),
EvalFun = fun({integer,_,S}, B) -> {value,S,B} end,
Expr = [{bin_element,0,{integer,0,Val},{integer,0,Sz},[{unit,1}|Fs]}],
{value,Bin,EmptyBindings} = eval_bits:expr_grp(Expr, EmptyBindings, EvalFun),
@@ -1184,6 +1177,11 @@ select_assert_match_possible(Sz, Val, Fs) ->
throw(not_possible)
end.
+match_fun(Val) ->
+ fun(match, {{integer,_,_},NewV,Bs}) when NewV =:= Val ->
+ {match,Bs}
+ end.
+
select_utf8(Val0) ->
try
Bin = <<Val0/utf8>>,
@@ -1258,8 +1256,6 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) ->
sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) ->
BinSeg#k_bin_seg{size=Kvar#k_var{name=get_vsub(Name, Sub)}};
-sub_size_var(#k_bin_int{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) ->
- BinSeg#k_bin_int{size=Kvar#k_var{name=get_vsub(Name, Sub)}};
sub_size_var(K, _) -> K.
get_con([C|_]) -> arg_arg(clause_arg(C)). %Get the constructor
@@ -1377,7 +1373,6 @@ arg_con(Arg) ->
#k_tuple{} -> k_tuple;
#k_binary{} -> k_binary;
#k_bin_end{} -> k_bin_end;
- #k_bin_int{} -> k_bin_int;
#k_bin_seg{} -> k_bin_seg;
#k_var{} -> k_var
end.
@@ -1388,15 +1383,9 @@ arg_val(Arg) ->
#k_int{val=I} -> I;
#k_float{val=F} -> F;
#k_atom{val=A} -> A;
- #k_nil{} -> 0;
- #k_cons{} -> 2;
#k_tuple{es=Es} -> length(Es);
#k_bin_seg{size=S,unit=U,type=T,flags=Fs} ->
- {set_kanno(S, []),U,T,Fs};
- #k_bin_int{} ->
- 0;
- #k_bin_end{} -> 0;
- #k_binary{} -> 0
+ {set_kanno(S, []),U,T,Fs}
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1426,14 +1415,12 @@ ubody(#ivalues{anno=A,args=As}, return, St) ->
{#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St};
ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) ->
Au = lit_list_vars(As),
- if St#kern.guard_refc > 0 ->
+ case is_in_guard(St) of
+ true ->
{#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St};
- true ->
+ false ->
{#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}
end;
-ubody(#ivalues{anno=A,args=As}, {guard_break,_Vbs}, St) ->
- Au = lit_list_vars(As),
- {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St};
ubody(E, return, St0) ->
%% Enterable expressions need no trailing return.
case is_enter_expr(E) of
@@ -1450,12 +1437,7 @@ ubody(E, {break,_Rs} = Break, St0) ->
false ->
{Ea,Pa,St1} = force_atomic(E, St0),
ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1)
- end;
-ubody(E, {guard_break,_Rs} = GuardBreak, St0) ->
- %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]),
- %% Exiting expressions need no trailing break.
- {Ea,Pa,St1} = force_atomic(E, St0),
- ubody(pre_seq(Pa, #ivalues{args=[Ea]}), GuardBreak, St1).
+ end.
iletrec_funs(#iletrec{defs=Fs}, St0) ->
%% Use union of all free variables.
@@ -1493,7 +1475,6 @@ iletrec_funs_gen(Fs, FreeVs, St) ->
%% is_exit_expr(Kexpr) -> boolean().
%% Test whether Kexpr always exits and never returns.
-is_exit_expr(#k_call{op=#k_internal{name=match_fail,arity=1}}) -> true;
is_exit_expr(#k_receive_next{}) -> true;
is_exit_expr(_) -> false.
@@ -1508,64 +1489,21 @@ is_enter_expr(#k_receive{}) -> true;
is_enter_expr(#k_receive_next{}) -> true;
is_enter_expr(_) -> false.
-%% uguard(Expr, State) -> {Expr,[UsedVar],State}.
-%% Tag the guard sequence with its used variables.
-
-uguard(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X},
- handler=#k_atom{val=false}}=Try, St0) ->
- {B1,Bu,St1} = uguard(B0, St0),
- {Try#k_try{anno=#k{us=Bu,ns=[],a=A},arg=B1},Bu,St1};
-uguard(T, St) ->
- %%ok = io:fwrite("~w: ~p~n", [?LINE,T]),
- uguard_test(T, St).
-
-%% uguard_test(Expr, State) -> {Test,[UsedVar],State}.
-%% At this stage tests are just expressions which don't return any
-%% values.
-
-uguard_test(T, St) -> uguard_expr(T, [], St).
+%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}.
+%% Tag an expression with its used variables.
+%% Break = return | {break,[RetVar]}.
-uguard_expr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Rs, St0) ->
- Ns = lit_list_vars(Vs),
- {E1,Eu,St1} = uguard_expr(E0, Vs, St0),
- {B1,Bu,St2} = uguard_expr(B0, Rs, St1),
- Used = union(Eu, subtract(Bu, Ns)),
- {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2};
-uguard_expr(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X},
- handler=#k_atom{val=false}}=Try, Rs, St0) ->
- {B1,Bu,St1} = uguard_expr(B0, Rs, St0),
- {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},arg=B1,ret=Rs},
- Bu,St1};
-uguard_expr(#k_test{anno=A,op=Op,args=As}=Test, Rs, St) ->
+uexpr(#k_test{anno=A,op=Op,args=As}=Test, {break,Rs}, St) ->
[] = Rs, %Sanity check
Used = union(op_vars(Op), lit_list_vars(As)),
{Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}},
Used,St};
-uguard_expr(#k_bif{anno=A,op=Op,args=As}=Bif, Rs, St) ->
- Used = union(op_vars(Op), lit_list_vars(As)),
- {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs},
- Used,St};
-uguard_expr(#ivalues{anno=A,args=As}, Rs, St) ->
- Sets = foldr2(fun (V, Arg, Rhs) ->
- #iset{anno=A,vars=[V],arg=Arg,body=Rhs}
- end, #k_atom{val=true}, Rs, As),
- uguard_expr(Sets, [], St);
-uguard_expr(#k_match{anno=A,vars=Vs,body=B0}, Rs, St0) ->
- %% Experimental support for andalso/orelse in guards.
- Br = {guard_break,Rs},
- {B1,Bu,St1} = umatch(B0, Br, St0),
- {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},
- vars=Vs,body=B1,ret=Rs},Bu,St1};
-uguard_expr(Lit, Rs, St) ->
- %% Transform literals to puts here.
- Used = lit_vars(Lit),
- {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)},
- arg=Lit,ret=Rs},Used,St}.
-
-%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}.
-%% Tag an expression with its used variables.
-%% Break = return | {break,[RetVar]}.
-
+uexpr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, {break,_}=Br, St0) ->
+ Ns = lit_list_vars(Vs),
+ {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0),
+ {B1,Bu,St2} = uexpr(B0, Br, St1),
+ Used = union(Eu, subtract(Bu, Ns)),
+ {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2};
uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) ->
Free = get_free(F, Ar, St),
As1 = As0 ++ Free, %Add free variables LAST!
@@ -1597,10 +1535,11 @@ uexpr(#k_match{anno=A,vars=Vs0,body=B0}, Br, St0) ->
Vs = handle_reuse_annos(Vs0, St0),
Rs = break_rets(Br),
{B1,Bu,St1} = umatch(B0, Br, St0),
- if St0#kern.guard_refc > 0 ->
+ case is_in_guard(St1) of
+ true ->
{#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},
vars=Vs,body=B1,ret=Rs},Bu,St1};
- true ->
+ false ->
{#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},
vars=Vs,body=B1,ret=Rs},Bu,St1}
end;
@@ -1617,24 +1556,27 @@ uexpr(#k_receive_accept{anno=A}, _, St) ->
{#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St};
uexpr(#k_receive_next{anno=A}, _, St) ->
{#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St};
-uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
- {break,Rs0}, St0) ->
- {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here
- {A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here!
- {B1,Bu,St3} = ubody(B0, {break,Rs0}, St2),
- {H1,Hu,St4} = ubody(H0, {break,Rs0}, St3),
- %% Guarantee ONE return variable.
- NumNew = if
- Rs0 =:= [] -> 1;
- true -> 0
- end,
- {Ns,St5} = new_vars(NumNew, St4),
- Rs1 = Rs0 ++ Ns,
- Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
- subtract(Hu, lit_list_vars(Evs))]),
- {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A},
- arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1},
- Used,St5};
+uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}=Try,
+ {break,Rs0}=Br, St0) ->
+ case is_in_guard(St0) of
+ true ->
+ {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion.
+ #k_atom{val=false} = H0, %Assertion.
+ {A1,Bu,St1} = uexpr(A0, Br, St0),
+ {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A},
+ arg=A1,ret=Rs0},Bu,St1};
+ false ->
+ {Avs,St1} = new_vars(length(Vs), St0),
+ {A1,Au,St2} = ubody(A0, {break,Avs}, St1),
+ {B1,Bu,St3} = ubody(B0, Br, St2),
+ {H1,Hu,St4} = ubody(H0, Br, St3),
+ {Rs1,St5} = ensure_return_vars(Rs0, St4),
+ Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
+ subtract(Hu, lit_list_vars(Evs))]),
+ {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A},
+ arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1},
+ Used,St5}
+ end;
uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
return, St0) ->
{Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here
@@ -1655,37 +1597,38 @@ uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) ->
{Ns,St3} = new_vars(1 - length(Rs0), St2),
Rs1 = Rs0 ++ Ns,
{#k_catch{anno=#k{us=Bu,ns=lit_list_vars(Rs1),a=A},body=B1,ret=Rs1},Bu,St3};
-uexpr(#ifun{anno=A,vars=Vs,body=B0}=IFun, {break,Rs}, St0) ->
+uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) ->
{B1,Bu,St1} = ubody(B0, return, St0), %Return out of new function
Ns = lit_list_vars(Vs),
Free = subtract(Bu, Ns), %Free variables in fun
Fvs = make_vars(Free),
Arity = length(Vs) + length(Free),
- {{Index,Uniq,Fname}, St3} =
+ {Fname,St} =
case lists:keyfind(id, 1, A) of
- {id,Id} ->
- {Id, St1};
+ {id,{_,_,Fname0}} ->
+ {Fname0,St1};
false ->
- %% No id annotation. Must invent one.
- I = St1#kern.fcount,
- U = erlang:hash(IFun, (1 bsl 27)-1),
- {N, St2} = new_fun_name(St1),
- {{I,U,N}, St2}
+ %% No id annotation. Must invent a fun name.
+ new_fun_name(St1)
end,
Fun = #k_fdef{anno=#k{us=[],ns=[],a=A},func=Fname,arity=Arity,
vars=Vs ++ Fvs,body=B1},
+ %% Set dummy values for Index and Uniq -- the real values will
+ %% be assigned by beam_asm.
+ Index = Uniq = 0,
{#k_bif{anno=#k{us=Free,ns=lit_list_vars(Rs),a=A},
op=#k_internal{name=make_fun,arity=length(Free)+3},
args=[#k_atom{val=Fname},#k_int{val=Arity},
#k_int{val=Index},#k_int{val=Uniq}|Fvs],
ret=Rs},
- Free,add_local_function(Fun, St3)};
-uexpr(Lit, {break,Rs}, St) ->
+ Free,add_local_function(Fun, St)};
+uexpr(Lit, {break,Rs0}, St0) ->
%% Transform literals to puts here.
%%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]),
Used = lit_vars(Lit),
+ {Rs,St1} = ensure_return_vars(Rs0, St0),
{#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)},
- arg=Lit,ret=Rs},Used,St}.
+ arg=Lit,ret=Rs},Used,St1}.
add_local_function(_, #kern{funs=ignore}=St) -> St;
add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}.
@@ -1742,6 +1685,11 @@ bif_returns(#k_internal{name=N,arity=Ar}, Rs, St0) ->
{Ns,St1} = new_vars(bif_vals(N, Ar) - length(Rs), St0),
{Rs ++ Ns,St1}.
+%% ensure_return_vars([Ret], State) -> {[Ret],State}.
+
+ensure_return_vars([], St) -> new_vars(1, St);
+ensure_return_vars([_]=Rs, St) -> {Rs,St}.
+
%% umatch(Match, Break, State) -> {Match,[UsedVar],State}.
%% Tag a match expression with its used variables.
@@ -1774,7 +1722,8 @@ umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) ->
{#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1};
umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) ->
%%ok = io:fwrite("~w: ~p~n", [?LINE,G0]),
- {G1,Gu,St1} = uguard(G0, St0#kern{guard_refc=St0#kern.guard_refc+1}),
+ {G1,Gu,St1} = uexpr(G0, {break,[]},
+ St0#kern{guard_refc=St0#kern.guard_refc+1}),
%%ok = io:fwrite("~w: ~p~n", [?LINE,G1]),
{B1,Bu,St2} = umatch(B0, Br, St1#kern{guard_refc=St1#kern.guard_refc-1}),
Used = union(Gu, Bu),
@@ -1822,7 +1771,6 @@ lit_list_vars(Ps) ->
pat_vars(#k_var{name=N}) -> {[],[N]};
%%pat_vars(#k_char{}) -> {[],[]};
-%%pat_vars(#k_string{}) -> {[],[]};
pat_vars(#k_literal{}) -> {[],[]};
pat_vars(#k_int{}) -> {[],[]};
pat_vars(#k_float{}) -> {[],[]};
@@ -1849,34 +1797,6 @@ pat_list_vars(Ps) ->
{union(Used0, Used),union(New0, New)} end,
{[],[]}, Ps).
-%% handle_literal(Literal, Anno) -> Kernel
-%% Examine the literal. Complex (heap-based) literals such as lists,
-%% tuples, and binaries should be kept as literals and put into the constant pool.
-%%
-%% (If necessary, this function could be extended to go through the literal
-%% and convert huge binary literals to bit syntax expressions. We don't do that
-%% because v3_core does not produce huge binary literals, and the optimizations in
-%% sys_core_fold don't do much optimizations of binaries. IF THAT CHANGE IS MADE,
-%% ALSO CHANGE sys_core_dsetel.)
-
-handle_literal(#c_literal{anno=A,val=V}) ->
- case V of
- [_|_] ->
- #k_literal{anno=A,val=V};
- [] ->
- #k_nil{anno=A};
- V when is_tuple(V) ->
- #k_literal{anno=A,val=V};
- V when is_bitstring(V) ->
- #k_literal{anno=A,val=V};
- V when is_integer(V) ->
- #k_int{anno=A,val=V};
- V when is_float(V) ->
- #k_float{anno=A,val=V};
- V when is_atom(V) ->
- #k_atom{anno=A,val=V}
- end.
-
make_list(Es) ->
foldr(fun(E, Acc) ->
#c_cons{hd=E,tl=Acc}
@@ -1888,6 +1808,11 @@ integers(N, M) when N =< M ->
[N|integers(N + 1, M)];
integers(_, _) -> [].
+%% is_in_guard(State) -> true|false.
+
+is_in_guard(#kern{guard_refc=Refc}) ->
+ Refc > 0.
+
%%%
%%% Handling of errors and warnings.
%%%
@@ -1903,12 +1828,17 @@ format_error({nomatch_shadow,Line}) ->
format_error(nomatch_shadow) ->
"this clause cannot match because a previous clause always matches";
format_error(bad_call) ->
- "invalid module and/or function name; this call will always fail".
+ "invalid module and/or function name; this call will always fail";
+format_error(bad_segment_size) ->
+ "binary construction will fail because of a type mismatch".
add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),
St#kern{ws=[{File,[{?MODULE,Term}]}|Ws]};
-add_warning(Line, Term, Anno, #kern{ws=Ws}=St) when Line >= 0 ->
+add_warning(Line, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),
- St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]};
-add_warning(_, _, _, St) -> St.
+ St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}.
+
+is_compiler_generated(Ke) ->
+ Anno = get_kanno(Ke),
+ member(compiler_generated, Anno).
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index 37f2fdcf7e..fb8baf398b 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -35,7 +35,6 @@
-record(k_int, {anno=[],val}).
-record(k_float, {anno=[],val}).
-record(k_atom, {anno=[],val}).
--record(k_string, {anno=[],val}).
-record(k_nil, {anno=[]}).
-record(k_tuple, {anno=[],es}).
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index a7a4d4dc91..2cc3493570 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -65,7 +65,7 @@ functions([], Acc) -> reverse(Acc).
%% function(Kfunc) -> Func.
-function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) ->
+function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) ->
try
As = var_list(Vs),
Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As),
@@ -80,7 +80,7 @@ function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) ->
put(guard_refc, 0),
{B1,_,Vdb1} = body(B0, 1, Vdb0),
erase(guard_refc),
- {function,F,Ar,As,B1,Vdb1}
+ {function,F,Ar,As,B1,Vdb1,Anno}
catch
Class:Error ->
Stack = erlang:get_stacktrace(),
@@ -89,19 +89,8 @@ function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) ->
end.
%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
-%% Handle a body, need special cases for transforming match_fails.
-%% We KNOW that they only occur last in a body.
-
-body(#k_seq{arg=#k_put{anno=Pa,arg=Arg,ret=[R]},
- body=#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1},
- args=[R]}},
- I, Vdb0) ->
- Vdb1 = use_vars(Pa#k.us, I, Vdb0), %All used here
- {[match_fail(Arg, I, Pa#k.a ++ Ea#k.a)],I,Vdb1};
-body(#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1},args=[Arg]},
- I, Vdb0) ->
- Vdb1 = use_vars(Ea#k.us, I, Vdb0),
- {[match_fail(Arg, I, Ea#k.a)],I,Vdb1};
+%% Handle a body.
+
body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) ->
%%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
A = get_kanno(Ke),
@@ -123,53 +112,14 @@ guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X},
%% Lock variables that are alive before try and used afterwards.
%% Don't lock variables that are only used inside the try expression.
Pdb0 = vdb_sub(I, I+1, Vdb),
- {T,MaxI,Pdb1} = guard_body(Ts, I+1, Pdb0),
+ {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0),
Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values
- #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2};
-guard(#k_seq{}=G, I, Vdb0) ->
- {Es,_,Vdb1} = guard_body(G, I, Vdb0),
- #l{ke={block,Es},i=I,vdb=Vdb1,a=[]};
-guard(G, I, Vdb) -> guard_expr(G, I, Vdb).
-
-%% guard_body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
-
-guard_body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) ->
- A = get_kanno(Ke),
- Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)),
- {Es,MaxI,Vdb2} = guard_body(Kb, I+1, Vdb1),
- E = guard_expr(Ke, I, Vdb2),
- {[E|Es],MaxI,Vdb2};
-guard_body(Ke, I, Vdb0) ->
- A = get_kanno(Ke),
- Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)),
- E = guard_expr(Ke, I, Vdb1),
- {[E],I,Vdb1}.
-
-%% guard_expr(Call, I, Vdb) -> Expr
-
-guard_expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) ->
- #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a};
-guard_expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) ->
- Name = bif_op(Op),
- Ar = length(As),
- case is_gc_bif(Name, Ar) of
- false ->
- #l{ke={bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a};
- true ->
- #l{ke={gc_bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a}
- end;
-guard_expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) ->
- #l{ke={set,var_list(Rs),literal(Arg, [])},i=I,a=A#k.a};
-guard_expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
- %% Support for andalso/orelse in guards.
- %% Work out imported variables which need to be locked.
- Mdb = vdb_sub(I, I+1, Vdb),
- M = match(Kb, A#k.us, I+1, [], Mdb),
- #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
-guard_expr(G, I, Vdb) -> guard(G, I, Vdb).
+ #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}.
%% expr(Kexpr, I, Vdb) -> Expr.
+expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) ->
+ #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a};
expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) ->
#l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a};
expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) ->
@@ -187,25 +137,11 @@ expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
Mdb = vdb_sub(I, I+1, Vdb),
M = match(Kb, A#k.us, I+1, [], Mdb),
#l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
-expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, I, Vdb) ->
- %% Lock variables that are alive before the catch and used afterwards.
- %% Don't lock variables that are only used inside the try.
- Tdb0 = vdb_sub(I, I+1, Vdb),
- %% This is the tricky bit. Lock variables in Arg that are used in
- %% the body and handler. Add try tag 'variable'.
- Ab = get_kanno(Kb),
- Ah = get_kanno(Kh),
- Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)),
- Tdb2 = vdb_sub(I, I+2, Tdb1),
- Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
- {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)),
- {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)),
- {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)),
- #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]},
- var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]},
- var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]},
- var_list(Rs)},
- i=I,vdb=Tdb1,a=A#k.a};
+expr(#k_try{}=Try, I, Vdb) ->
+ case is_in_guard() of
+ false -> body_try(Try, I, Vdb);
+ true -> guard(Try, I, Vdb)
+ end;
expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) ->
%% Lock variables that are alive before the catch and used afterwards.
%% Don't lock variables that are only used inside the try.
@@ -254,6 +190,27 @@ expr(#k_guard_break{anno=A,args=As}, I, Vdb) ->
expr(#k_return{anno=A,args=As}, I, _Vdb) ->
#l{ke={return,atomic_list(As)},i=I,a=A#k.a}.
+body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs},
+ I, Vdb) ->
+ %% Lock variables that are alive before the catch and used afterwards.
+ %% Don't lock variables that are only used inside the try.
+ Tdb0 = vdb_sub(I, I+1, Vdb),
+ %% This is the tricky bit. Lock variables in Arg that are used in
+ %% the body and handler. Add try tag 'variable'.
+ Ab = get_kanno(Kb),
+ Ah = get_kanno(Kh),
+ Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)),
+ Tdb2 = vdb_sub(I, I+2, Tdb1),
+ Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
+ {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)),
+ {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)),
+ {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)),
+ #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]},
+ var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]},
+ var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]},
+ var_list(Rs)},
+ i=I,vdb=Tdb1,a=A#k.a}.
+
%% call_op(Op) -> Op.
%% bif_op(Op) -> Op.
%% test_op(Op) -> Op.
@@ -353,25 +310,6 @@ guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),
a=A#k.a}.
-%% match_fail(FailValue, I, Anno) -> Expr.
-%% Generate the correct match_fail instruction. N.B. there is no
-%% generic case for when the fail value has been created elsewhere.
-
-match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) ->
- match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A);
-match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) ->
- match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A);
-match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) ->
- #l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A};
-match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) ->
- #l{ke={match_fail,{badmatch,literal(Val, [])}},i=I,a=A};
-match_fail(#k_tuple{es=[#k_atom{val=case_clause},Val]}, I, A) ->
- #l{ke={match_fail,{case_clause,literal(Val, [])}},i=I,a=A};
-match_fail(#k_atom{val=if_clause}, I, A) ->
- #l{ke={match_fail,if_clause},i=I,a=A};
-match_fail(#k_tuple{es=[#k_atom{val=try_clause},Val]}, I, A) ->
- #l{ke={match_fail,{try_clause,literal(Val, [])}},i=I,a=A}.
-
%% type(Ktype) -> Type.
type(k_literal) -> literal;
@@ -403,7 +341,6 @@ atomic(#k_int{val=I}) -> {integer,I};
atomic(#k_float{val=F}) -> {float,F};
atomic(#k_atom{val=N}) -> {atom,N};
%%atomic(#k_char{val=C}) -> {char,C};
-%%atomic(#k_string{val=S}) -> {string,S};
atomic(#k_nil{}) -> nil.
atomic_list(Ks) -> [atomic(K) || K <- Ks].
@@ -565,3 +502,7 @@ vdb_sub(Min, Max, Vdb) ->
true -> Vd
end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ].
+%% is_in_guard() -> true|false.
+
+is_in_guard() ->
+ get(guard_refc) > 0.
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index b90adaf917..e047166ade 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -10,6 +10,7 @@ MODULES= \
apply_SUITE \
beam_validator_SUITE \
beam_disasm_SUITE \
+ beam_expect_SUITE \
bs_bincomp_SUITE \
bs_bit_binaries_SUITE \
bs_construct_SUITE \
@@ -29,7 +30,6 @@ MODULES= \
misc_SUITE \
num_bif_SUITE \
pmod_SUITE \
- parteval_SUITE \
receive_SUITE \
record_SUITE \
trycatch_SUITE \
@@ -39,6 +39,7 @@ MODULES= \
NO_OPT= \
andor \
apply \
+ beam_expect \
bs_construct \
bs_match \
bs_utf \
@@ -153,12 +154,12 @@ include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: opt
release_tests_spec: make_emakefile
- $(INSTALL_DIR) $(RELSYSDIR)
+ $(INSTALL_DIR) "$(RELSYSDIR)"
$(INSTALL_DATA) compiler.spec compiler.cover \
- $(EMAKEFILE) $(ERL_FILES) $(CORE_FILES) $(RELSYSDIR)
+ $(EMAKEFILE) $(ERL_FILES) $(CORE_FILES) "$(RELSYSDIR)"
$(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \
- $(INLINE_ERL_FILES) $(RELSYSDIR)
- chmod -R u+w $(RELSYSDIR)
- @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
+ $(INLINE_ERL_FILES) "$(RELSYSDIR)"
+ chmod -R u+w "$(RELSYSDIR)"
+ @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
release_docs_spec:
diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl
index 44574ae64a..62afc80ca6 100644
--- a/lib/compiler/test/beam_disasm_SUITE.erl
+++ b/lib/compiler/test/beam_disasm_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -60,6 +60,6 @@ stripped(Config) when is_list(Config) ->
?line true = is_list(Attr),
?line true = is_list(CompileInfo),
?line {ok, {tmp, _}} = beam_lib:strip(BeamName),
- ?line {beam_file, tmp, _, none, none, [_|_]} =
+ ?line {beam_file, tmp, _, [], [], [_|_]} =
beam_disasm:file(BeamName),
ok.
diff --git a/lib/compiler/test/beam_expect_SUITE.erl b/lib/compiler/test/beam_expect_SUITE.erl
new file mode 100644
index 0000000000..6f216eac4f
--- /dev/null
+++ b/lib/compiler/test/beam_expect_SUITE.erl
@@ -0,0 +1,67 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(beam_expect_SUITE).
+
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ coverage/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+coverage(_) ->
+ File = {file,"fake.erl"},
+ ok = fc(a),
+ {'EXIT',{function_clause,
+ [{?MODULE,fc,[[x]],[File,{line,2}]}|_]}} =
+ (catch fc([x])),
+ {'EXIT',{function_clause,
+ [{?MODULE,fc,[y],[File,{line,2}]}|_]}} =
+ (catch fc(y)),
+ {'EXIT',{function_clause,
+ [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} =
+ (catch fc([a,b,c])),
+
+ {'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} =
+ (catch erlang:error(a, b, c)),
+ ok.
+
+-file("fake.erl", 1).
+fc(a) -> %Line 2
+ ok; %Line 3
+fc(L) when length(L) > 2 -> %Line 4
+ %% Not the same as a "real" function_clause error.
+ error(function_clause, [L]). %Line 6
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 556dc54a8f..902867bc19 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -79,21 +79,18 @@ beam_files(Config) when is_list(Config) ->
%% a grammatical error in the output of the io:format/2 call below. ;-)
?line [_,_|_] = Fs = filelib:wildcard(Wc),
?line io:format("~p files\n", [length(Fs)]),
- beam_files_1(Fs, 0).
-
-beam_files_1([F|Fs], Errors) ->
- ?line case beam_validator:file(F) of
- ok ->
- beam_files_1(Fs, Errors);
- {error,Es} ->
- io:format("File: ~s", [F]),
- io:format("Error: ~p\n", [Es]),
- beam_files_1(Fs, Errors+1)
- end;
-beam_files_1([], 0) -> ok;
-beam_files_1([], Errors) ->
- ?line io:format("~p error(s)", [Errors]),
- ?line ?t:fail().
+ test_lib:p_run(fun do_beam_file/1, Fs).
+
+
+do_beam_file(F) ->
+ case beam_validator:file(F) of
+ ok ->
+ ok;
+ {error,Es} ->
+ io:format("File: ~s", [F]),
+ io:format("Error: ~p\n", [Es]),
+ error
+ end.
compiler_bug(Config) when is_list(Config) ->
%% Check that the compiler returns an error if we try to
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index 31c7890f26..9ab76449c7 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -468,6 +468,10 @@ opt(Config) when is_list(Config) ->
?line {'EXIT',_} = (catch <<<<23,56,0,2>>:64/float>>),
?line {'EXIT',_} = (catch <<<<23,56,0,2:7>>/binary>>),
+ %% Test constant propagation - there should be a warning.
+ BadSz = 2.5,
+ {'EXIT',_} = (catch <<<<N,56,0,2>>:BadSz/binary>>),
+
case id(false) of
true -> ?line opt_dont_call_me();
false -> ok
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 6a795f6634..86c8cb23f5 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -342,6 +342,10 @@ partitioned_bs_match(Config) when is_list(Config) ->
?line fc(partitioned_bs_match_2, [4,<<0:17>>],
catch partitioned_bs_match_2(4, <<0:17>>)),
+
+ anything = partitioned_bs_match_3(anything, <<42>>),
+ ok = partitioned_bs_match_3(1, 2),
+
ok.
partitioned_bs_match(_, <<42:8,T/binary>>) ->
@@ -356,6 +360,9 @@ partitioned_bs_match_2(1, <<B:8,T/binary>>) ->
partitioned_bs_match_2(Len, <<_:8,T/binary>>) ->
{Len,T}.
+partitioned_bs_match_3(Var, <<_>>) -> Var;
+partitioned_bs_match_3(1, 2) -> ok.
+
function_clause(Config) when is_list(Config) ->
?line ok = function_clause_1(<<0,7,0,7,42>>),
?line fc(function_clause_1, [<<0,1,2,3>>],
@@ -793,12 +800,29 @@ matching_and_andalso(Config) when is_list(Config) ->
?line {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, -8)),
?line {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, blurf)),
?line {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, 19)),
+
+ {"abc",<<"xyz">>} = matching_and_andalso_2("abc", <<"-xyz">>),
+ {"abc",<<"">>} = matching_and_andalso_2("abc", <<($a-1)>>),
+ {"abc",<<"">>} = matching_and_andalso_2("abc", <<($z+1)>>),
+ {"abc",<<"">>} = matching_and_andalso_2("abc", <<($A-1)>>),
+ {"abc",<<"">>} = matching_and_andalso_2("abc", <<($Z+1)>>),
+ error = matching_and_andalso_2([], <<>>),
+ error = matching_and_andalso_2([], <<$A>>),
+ error = matching_and_andalso_2([], <<$Z>>),
+ error = matching_and_andalso_2([], <<$a>>),
+ error = matching_and_andalso_2([], <<$z>>),
ok.
matching_and_andalso_1(<<Bitmap/binary>>, K)
when is_integer(K) andalso size(Bitmap) >= K andalso 0 < K ->
ok.
+matching_and_andalso_2(Datetime, <<H,T/binary>>)
+ when not ((H >= $a) andalso (H =< $z)) andalso
+ not ((H >= $A) andalso (H =< $Z)) ->
+ {Datetime,T};
+matching_and_andalso_2(_, _) -> error.
+
%% Thanks to Tomas Stejskal.
otp_7188(Config) when is_list(Config) ->
MP3 = <<84,65,71,68,117,154,105,232,107,121,0,0,0,0,0,0,0,0,0,0,
@@ -1028,8 +1052,8 @@ haystack_2(Haystack) ->
fc({'EXIT',{function_clause,_}}) -> ok;
fc({'EXIT',{{case_clause,_},_}}) when ?MODULE =:= bs_match_inline_SUITE -> ok.
-fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args}|_]}}) -> ok;
-fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity}|_]}})
+fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args,_}|_]}}) -> ok;
+fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity,_}|_]}})
when length(Args) =:= Arity ->
true = test_server:is_native(?MODULE);
fc(_, Args, {'EXIT',{{case_clause,ActualArgs},_}})
diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl
index f30a4d3fef..94549ad0d3 100644
--- a/lib/compiler/test/bs_utf_SUITE.erl
+++ b/lib/compiler/test/bs_utf_SUITE.erl
@@ -264,18 +264,10 @@ literals(Config) when is_list(Config) ->
?line {'EXIT',{badarg,_}} = (catch <<(-1)/utf32,I/utf8>>),
?line {'EXIT',{badarg,_}} = (catch <<(-1)/little-utf32,I/utf8>>),
?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf8,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf8,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/utf8,I/utf8>>),
?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf16,I/utf8>>),
?line {'EXIT',{badarg,_}} = (catch <<16#D800/little-utf16,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf16,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/little-utf16,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/utf16,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/little-utf16,I/utf8>>),
?line {'EXIT',{badarg,_}} = (catch <<16#D800/utf32,I/utf8>>),
?line {'EXIT',{badarg,_}} = (catch <<16#D800/little-utf32,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFE/utf32,I/utf8>>),
- ?line {'EXIT',{badarg,_}} = (catch <<16#FFFF/little-utf32,I/utf8>>),
B = 16#10FFFF+1,
?line {'EXIT',{badarg,_}} = (catch <<B/utf8>>),
@@ -286,20 +278,11 @@ literals(Config) when is_list(Config) ->
%% Matching of bad literals.
?line error = bad_literal_match(<<237,160,128>>), %16#D800 in UTF-8
- ?line error = bad_literal_match(<<239,191,190>>), %16#FFFE in UTF-8
- ?line error = bad_literal_match(<<239,191,191>>), %16#FFFF in UTF-8
?line error = bad_literal_match(<<244,144,128,128>>), %16#110000 in UTF-8
- ?line error = bad_literal_match(<<255,254>>), %16#FFFE in UTF-16
- ?line error = bad_literal_match(<<255,255>>), %16#FFFF in UTF-16
-
?line error = bad_literal_match(<<16#D800:32>>),
- ?line error = bad_literal_match(<<16#FFFE:32>>),
- ?line error = bad_literal_match(<<16#FFFF:32>>),
?line error = bad_literal_match(<<16#110000:32>>),
?line error = bad_literal_match(<<16#D800:32/little>>),
- ?line error = bad_literal_match(<<16#FFFE:32/little>>),
- ?line error = bad_literal_match(<<16#FFFF:32/little>>),
?line error = bad_literal_match(<<16#110000:32/little>>),
ok.
@@ -314,11 +297,7 @@ match_literal(<<"bj\366rn"/big-utf16>>) -> bjorn_utf16be;
match_literal(<<"bj\366rn"/little-utf16>>) -> bjorn_utf16le.
bad_literal_match(<<16#D800/utf8>>) -> ok;
-bad_literal_match(<<16#FFFE/utf8>>) -> ok;
-bad_literal_match(<<16#FFFF/utf8>>) -> ok;
bad_literal_match(<<16#110000/utf8>>) -> ok;
-bad_literal_match(<<16#FFFE/utf16>>) -> ok;
-bad_literal_match(<<16#FFFF/utf16>>) -> ok;
bad_literal_match(<<16#D800/utf32>>) -> ok;
bad_literal_match(<<16#110000/utf32>>) -> ok;
bad_literal_match(<<16#D800/little-utf32>>) -> ok;
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index 1343fbd1c9..fed7bec7d4 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -44,7 +44,7 @@ all() ->
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].
+ string_table,otp_8949_a,otp_8949_a,split_cases].
groups() ->
[{vsn, [], [vsn_1, vsn_2, vsn_3]}].
@@ -159,6 +159,7 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) ->
?comp(convopts).
?comp(otp_7202).
?comp(on_load).
+?comp(on_load_inline).
beam_compiler_7(doc) ->
"Code snippet submitted from Ulf Wiger which fails in R3 Beam.";
@@ -427,9 +428,9 @@ self_compile_1(Config, Prefix, Opts) ->
%% Compile the compiler again using the newly compiled compiler.
%% (In another node because reloading the compiler would disturb cover.)
CompilerB = Prefix++"compiler_b",
- ?line CompB = make_compiler_dir(Priv, Prefix++"compiler_b"),
+ CompB = make_compiler_dir(Priv, CompilerB),
?line VsnB = VsnA ++ ".0",
- ?line self_compile_node(CompilerB, CompA, CompB, VsnB, Opts),
+ self_compile_node(CompA, CompB, VsnB, Opts),
%% Compare compiler directories.
?line compare_compilers(CompA, CompB),
@@ -438,21 +439,26 @@ self_compile_1(Config, Prefix, Opts) ->
?line CompilerC = Prefix++"compiler_c",
?line CompC = make_compiler_dir(Priv, CompilerC),
?line VsnC = VsnB ++ ".0",
- ?line self_compile_node(CompilerC, CompB, CompC, VsnC, Opts),
+ self_compile_node(CompB, CompC, VsnC, Opts),
?line compare_compilers(CompB, CompC),
?line test_server:timetrap_cancel(Dog),
ok.
-self_compile_node(NodeName0, CompilerDir, OutDir, Version, Opts) ->
- ?line NodeName = list_to_atom(NodeName0),
- ?line Dog = test_server:timetrap(test_server:minutes(10)),
+self_compile_node(CompilerDir, OutDir, Version, Opts) ->
+ ?line Dog = test_server:timetrap(test_server:minutes(15)),
?line Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++
" -pa " ++ CompilerDir,
- ?line {ok,Node} = start_node(NodeName, Pa),
?line Files = compiler_src(),
- ?line ok = rpc:call(Node, ?MODULE, compile_compiler, [Files,OutDir,Version,Opts]),
- ?line test_server:stop_node(Node),
+
+ %% We don't want the cover server started on the other node,
+ %% because it will load the same cover-compiled code as on this
+ %% node. Use a shielded node to prevent the cover server from
+ %% being started.
+ ?t:run_on_shielded_node(
+ fun() ->
+ compile_compiler(Files, OutDir, Version, Opts)
+ end, Pa),
?line test_server:timetrap_cancel(Dog),
ok.
@@ -465,9 +471,12 @@ compile_compiler(Files, OutDir, Version, InlineOpts) ->
{d,'COMPILER_VSN',"\""++Version++"\""},
nowarn_shadow_vars,
{i,filename:join(code:lib_dir(stdlib), "include")}|InlineOpts],
- lists:foreach(fun(File) ->
- {ok,_} = compile:file(File, Opts)
- end, Files).
+ test_lib:p_run(fun(File) ->
+ case compile:file(File, Opts) of
+ {ok,_} -> ok;
+ _ -> error
+ end
+ end, Files).
compiler_src() ->
filelib:wildcard(filename:join([code:lib_dir(compiler), "src", "*.erl"])).
@@ -657,5 +666,19 @@ otp_8949_b(A, B) ->
id(Var)
end.
+split_cases(_) ->
+ dummy1 = do_split_cases(x),
+ {'EXIT',{{badmatch,b},_}} = (catch do_split_cases(y)),
+ ok.
+
+do_split_cases(A) ->
+ case A of
+ x ->
+ Z = dummy1;
+ _ ->
+ Z = dummy2,
+ a=b
+ end,
+ Z.
id(I) -> I.
diff --git a/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl
new file mode 100644
index 0000000000..322843b61e
--- /dev/null
+++ b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl
@@ -0,0 +1,23 @@
+-module(on_load_inline).
+-export([?MODULE/0]).
+-on_load(on_load/0).
+-compile(inline).
+
+?MODULE() ->
+ [{pid,Pid}] = ets:lookup(on_load_executed, pid),
+ exit(Pid, kill),
+ ok.
+
+on_load() ->
+ Parent = self(),
+ spawn(fun() ->
+ T = ets:new(on_load_executed, [named_table]),
+ ets:insert(T, {pid,self()}),
+ Parent ! done,
+ receive
+ wait_forever -> ok
+ end
+ end),
+ receive
+ done -> ok
+ end.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index b3e5376ffd..2cd75944f4 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -25,11 +25,12 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
app_test/1,
- file_1/1, module_mismatch/1, big_file/1, outdir/1,
+ file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1,
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, package_forms/1, encrypted_abstr/1,
bad_record_use1/1, bad_record_use2/1, strict_record/1,
- missing_testheap/1, cover/1, env/1, core/1, asm/1]).
+ missing_testheap/1, cover/1, env/1, core/1, asm/1,
+ sys_pre_attributes/1]).
-export([init/3]).
@@ -41,11 +42,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [app_test, file_1, module_mismatch, big_file, outdir,
+ [app_test, file_1, forms_2, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, package_forms, encrypted_abstr,
{group, bad_record_use}, strict_record,
- missing_testheap, cover, env, core, asm].
+ missing_testheap, cover, env, core, asm,
+ sys_pre_attributes].
groups() ->
[{bad_record_use, [],
@@ -74,14 +76,28 @@ app_test(Config) when is_list(Config) ->
file_1(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(5)),
+
+ process_flag(trap_exit, true),
+
?line {Simple, Target} = files(Config, "file_1"),
?line {ok, Cwd} = file:get_cwd(),
?line ok = file:set_cwd(filename:dirname(Target)),
- ?line {ok,simple} = compile:file(Simple), %Smoke test only.
+
+ %% Native from BEAM without compilation info.
?line {ok,simple} = compile:file(Simple, [slim]), %Smoke test only.
- ?line {ok,simple} = compile:file(Simple, [native,report]), %Smoke test.
?line {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test.
- ?line {ok,simple} = compile:file(Simple, [debug_info]),
+
+ %% Native from BEAM with compilation info.
+ ?line {ok,simple} = compile:file(Simple), %Smoke test only.
+ ?line {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test.
+
+ ?line {ok,simple} = compile:file(Simple, [native,report]), %Smoke test.
+
+ ?line compile_and_verify(Simple, Target, []),
+ ?line compile_and_verify(Simple, Target, [native]),
+ ?line compile_and_verify(Simple, Target, [debug_info]),
+ ?line {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage
+
?line ok = file:set_cwd(Cwd),
?line true = exists(Target),
?line passed = run(Target, test, []),
@@ -89,9 +105,37 @@ file_1(Config) when is_list(Config) ->
%% Cleanup.
?line ok = file:delete(Target),
?line ok = file:del_dir(filename:dirname(Target)),
+
+ %% There should not be any messages in the messages.
+ receive
+ Any ->
+ ?t:fail({unexpected,Any})
+ after 10 ->
+ ok
+ end,
+
?line test_server:timetrap_cancel(Dog),
ok.
+forms_2(Config) when is_list(Config) ->
+ Src = "/foo/bar",
+ AbsSrc = filename:absname(Src),
+ {ok,simple,Binary} = compile:forms([{attribute,1,module,simple}],
+ [binary,{source,Src}]),
+ code:load_binary(simple, Src, Binary),
+ Info = simple:module_info(compile),
+
+ %% Test that the proper source is returned.
+ AbsSrc = proplists:get_value(source, Info),
+
+ %% Ensure that the options are not polluted with 'source'.
+ [] = proplists:get_value(options, Info),
+
+ %% Cleanup.
+ true = code:delete(simple),
+ false = code:purge(simple),
+ ok.
+
module_mismatch(Config) when is_list(Config) ->
?line DataDir = ?config(data_dir, Config),
?line File = filename:join(DataDir, "wrong_module_name.erl"),
@@ -112,10 +156,9 @@ big_file(Config) when is_list(Config) ->
?line Big = filename:join(DataDir, "big.erl"),
?line Target = filename:join(PrivDir, "big.beam"),
?line ok = file:set_cwd(PrivDir),
- ?line {ok,big} = compile:file(Big, []),
- ?line {ok,big} = compile:file(Big, [r9,debug_info]),
- ?line {ok,big} = compile:file(Big, [no_postopt]),
- ?line true = exists(Target),
+ ?line compile_and_verify(Big, Target, []),
+ ?line compile_and_verify(Big, Target, [debug_info]),
+ ?line compile_and_verify(Big, Target, [no_postopt]),
%% Cleanup.
?line ok = file:delete(Target),
@@ -199,6 +242,12 @@ makedep(Config) when is_list(Config) ->
[makedep,{makedep_output,Target}|IncludeOptions]),
?line {ok,Mf6} = file:read_file(Target),
?line BasicMf2 = makedep_canonicalize_result(Mf6, DataDir),
+ %% Rule with creating phony target.
+ ?line PhonyMfName = SimpleRootname ++ "-phony.mk",
+ ?line {ok,PhonyMf} = file:read_file(PhonyMfName),
+ ?line {ok,_,Mf7} = compile:file(Simple,
+ [binary,makedep,makedep_phony|IncludeOptions]),
+ ?line PhonyMf = makedep_canonicalize_result(Mf7, DataDir),
?line ok = file:delete(Target),
?line ok = file:del_dir(filename:dirname(Target)),
@@ -774,3 +823,46 @@ do_asm(Beam, Outdir) ->
[M,Class,Error,erlang:get_stacktrace()]),
error
end.
+
+sys_pre_attributes(Config) ->
+ DataDir = ?config(data_dir, Config),
+ File = filename:join(DataDir, "attributes.erl"),
+ Mod = attributes,
+ CommonOpts = [binary,report,verbose,
+ {parse_transform,sys_pre_attributes}],
+ PreOpts = [{attribute,delete,deleted}],
+ PostOpts = [{attribute,insert,inserted,"value"}],
+ PrePostOpts = [{attribute,replace,replaced,42},
+ {attribute,replace,replace_nonexisting,new}],
+ {ok,Mod,Code} = compile:file(File, PrePostOpts ++ PreOpts ++
+ PostOpts ++ CommonOpts),
+ code:load_binary(Mod, File, Code),
+ Attr = Mod:module_info(attributes),
+ io:format("~p", [Attr]),
+ {inserted,"value"} = lists:keyfind(inserted, 1, Attr),
+ {replaced,[42]} = lists:keyfind(replaced, 1, Attr),
+ {replace_nonexisting,[new]} = lists:keyfind(replace_nonexisting, 1, Attr),
+ false = lists:keymember(deleted, 1, Attr),
+
+ %% Cover more code.
+ {ok,Mod,_} = compile:file(File, PostOpts ++ CommonOpts),
+ {ok,Mod,_} = compile:file(File, CommonOpts -- [verbose]),
+ {ok,Mod,_} = compile:file(File, PreOpts ++ CommonOpts),
+ {ok,Mod,_} = compile:file(File,
+ [{attribute,replace,replaced,42}|CommonOpts]),
+ {ok,Mod,_} = compile:file(File, PrePostOpts ++ PreOpts ++
+ PostOpts ++ CommonOpts --
+ [report,verbose]),
+ ok.
+
+%%%
+%%% Utilities.
+%%%
+
+compile_and_verify(Name, Target, Opts) ->
+ Mod = list_to_atom(filename:basename(Name, ".erl")),
+ {ok,Mod} = compile:file(Name, Opts),
+ {ok,{Mod,[{compile_info,CInfo}]}} =
+ beam_lib:chunks(Target, [compile_info]),
+ {options,BeamOpts} = lists:keyfind(options, 1, CInfo),
+ Opts = BeamOpts.
diff --git a/lib/compiler/test/compile_SUITE_data/attributes.erl b/lib/compiler/test/compile_SUITE_data/attributes.erl
new file mode 100644
index 0000000000..9c3451d272
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/attributes.erl
@@ -0,0 +1,23 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(attributes).
+-deleted(dummy).
+-replaced(dummy).
+
diff --git a/lib/compiler/test/compile_SUITE_data/simple-phony.mk b/lib/compiler/test/compile_SUITE_data/simple-phony.mk
new file mode 100644
index 0000000000..c84bcedd2a
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/simple-phony.mk
@@ -0,0 +1,3 @@
+simple.beam: $(srcdir)/simple.erl $(srcdir)/include/simple.hrl
+
+$(srcdir)/include/simple.hrl:
diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover
index 9fc4c7dd43..3fd7fc1937 100644
--- a/lib/compiler/test/compiler.cover
+++ b/lib/compiler/test/compiler.cover
@@ -1,5 +1,5 @@
{incl_app,compiler,details}.
%% -*- erlang -*-
-{excl_mods,[sys_pre_attributes,core_scan,core_parse]}.
+{excl_mods,compiler,[core_scan,core_parse]}.
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 26173c62b8..06185bfc34 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -21,7 +21,9 @@
-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,
- dehydrated_itracer/1,nested_tries/1]).
+ dehydrated_itracer/1,nested_tries/1,
+ seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1,
+ unsafe_case/1,nomatch_shadow/1,reversed_annos/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -41,7 +43,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [dehydrated_itracer, nested_tries].
+ [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq,
+ eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos].
groups() ->
[].
@@ -61,19 +64,19 @@ end_per_group(_GroupName, Config) ->
?comp(dehydrated_itracer).
?comp(nested_tries).
+?comp(seq_in_guard).
+?comp(make_effect_seq).
+?comp(eval_is_boolean).
+?comp(unsafe_case).
+?comp(nomatch_shadow).
+?comp(reversed_annos).
try_it(Mod, Conf) ->
- ?line Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
- ?line Out = ?config(priv_dir,Conf),
- ?line io:format("Compiling: ~s\n", [Src]),
- ?line CompRc0 = compile:file(Src, [from_core,{outdir,Out},report,time]),
- ?line io:format("Result: ~p\n",[CompRc0]),
- ?line {ok,Mod} = CompRc0,
-
- ?line {module,Mod} = code:load_abs(filename:join(Out, Mod)),
- ?line ok = Mod:Mod(),
- ok.
-
-
-
-
+ Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
+ compile_and_load(Src, []),
+ compile_and_load(Src, [no_copt]).
+
+compile_and_load(Src, Opts) ->
+ {ok,Mod,Bin} = compile:file(Src, [from_core,report,time,binary|Opts]),
+ {module,Mod} = code:load_binary(Mod, Mod, Bin),
+ ok = Mod:Mod().
diff --git a/lib/compiler/test/core_SUITE_data/eval_is_boolean.core b/lib/compiler/test/core_SUITE_data/eval_is_boolean.core
new file mode 100644
index 0000000000..6a68b1414d
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/eval_is_boolean.core
@@ -0,0 +1,22 @@
+module 'eval_is_boolean' ['eval_is_boolean'/0]
+ attributes []
+'eval_is_boolean'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ case call 'erlang':'is_boolean'(call 'erlang':'make_ref'()) of
+ <'false'> when 'true' ->
+ 'ok'
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'eval_is_boolean',0}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/make_effect_seq.core b/lib/compiler/test/core_SUITE_data/make_effect_seq.core
new file mode 100644
index 0000000000..9941e63b76
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/make_effect_seq.core
@@ -0,0 +1,51 @@
+module 'make_effect_seq' ['make_effect_seq'/0]
+ attributes []
+'make_effect_seq'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <_cor0> =
+ catch
+ apply 't'/1
+ ('a')
+ in
+ case _cor0 of
+ <{'EXIT',{'badarg',_cor3}}> when 'true' ->
+ let <_cor4> =
+ apply 't'/1
+ ({'a','b','c'})
+ in
+ case _cor4 of
+ <'ok'> when 'true' ->
+ ( _cor4
+ -| ['compiler_generated'] )
+ ( <_cor2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor2})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'make_effect_seq',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <T> when 'true' ->
+ do
+ {'ok',call 'erlang':'element'(2, T)}
+ 'ok'
+ ( <_cor2> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor2})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/nomatch_shadow.core b/lib/compiler/test/core_SUITE_data/nomatch_shadow.core
new file mode 100644
index 0000000000..565d9dc0f3
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/nomatch_shadow.core
@@ -0,0 +1,28 @@
+module 'nomatch_shadow' ['nomatch_shadow'/0]
+ attributes []
+'nomatch_shadow'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ apply 't'/1
+ (42)
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'nomatch_shadow',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <42> when 'true' ->
+ 'ok'
+ <42> when 'true' ->
+ 'ok'
+ ( <_cor1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor1})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/reversed_annos.core b/lib/compiler/test/core_SUITE_data/reversed_annos.core
new file mode 100644
index 0000000000..95b3cd52d6
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/reversed_annos.core
@@ -0,0 +1,49 @@
+module 'reversed_annos' ['reversed_annos'/0]
+ attributes []
+'reversed_annos'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ case apply 't'/1
+ (['a']) of
+ <'ok'> when 'true' ->
+ let <_cor2> =
+ apply 't'/1
+ (['a'|['b']])
+ in
+ case _cor2 of
+ <'ok'> when 'true' ->
+ ( _cor2
+ -| ['compiler_generated'] )
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor0})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'reversed_annos',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <[_cor2|_cor3]> when 'true' ->
+ 'ok'
+ %% Cover v3_kernel:get_line/1.
+ ( <['a']> when 'true' ->
+ 'error'
+ -| [{'file',"reversed_annos.erl"},11] )
+ ( <_cor1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor1})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/seq_in_guard.core b/lib/compiler/test/core_SUITE_data/seq_in_guard.core
new file mode 100644
index 0000000000..44686a7187
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/seq_in_guard.core
@@ -0,0 +1,66 @@
+module 'seq_in_guard' ['seq_in_guard'/0,
+ 't'/1]
+ attributes []
+'seq_in_guard'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <_cor0> =
+ catch
+ %% Line 5
+ apply 't'/1
+ ({})
+ in %% Line 5
+ case _cor0 of
+ <{'EXIT',{'function_clause',_cor4}}> when 'true' ->
+ let <_cor2> =
+ catch
+ %% Line 6
+ apply 't'/1
+ ('atom')
+ in %% Line 6
+ case _cor2 of
+ <{'EXIT',{'function_clause',_cor5}}> when 'true' ->
+ %% Line 7
+ apply 't'/1
+ ({'a','b'})
+ ( <_cor3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor3})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'seq_in_guard',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ %% Line 9
+ fun (_cor0) ->
+ case _cor0 of
+ <X>
+ when try
+ do
+ call 'erlang':'element'
+ (2, X)
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ %% Line 10
+ 'ok'
+ ( <_cor3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor3})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/unsafe_case.core b/lib/compiler/test/core_SUITE_data/unsafe_case.core
new file mode 100644
index 0000000000..84cb2c310a
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/unsafe_case.core
@@ -0,0 +1,25 @@
+module 'unsafe_case' ['unsafe_case'/0]
+ attributes []
+'unsafe_case'/0 =
+ fun () ->
+ case apply 't'/1
+ (42) of
+ <{'ok',42}> when 'true' ->
+ 'ok'
+ ( <_cor0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor0})
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <X>
+ when call 'erlang':'>'
+ (_cor0,
+ 0) ->
+ {'ok',X}
+ %% The default case is intentionally missing
+ %% to cover v3_kernel:build_match/2.
+ end
+end
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index ac14d36e82..54bd52947e 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_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,
t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1,
- eq/1,nested_call_in_case/1,coverage/1]).
+ eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
[t_element, setelement, t_length, append, t_apply, bifs,
- eq, nested_call_in_case, coverage].
+ eq, nested_call_in_case, guard_try_catch, coverage].
groups() ->
[].
@@ -207,6 +207,23 @@ nested_call_in_case(Config) when is_list(Config) ->
?line {'EXIT',_} = (catch Mod:a(not_a_list, 42)),
ok.
+guard_try_catch(_Config) ->
+ false = do_guard_try_catch(key, value),
+ value = get(key),
+ ok.
+
+do_guard_try_catch(K, V) ->
+ %% This try...catch block looks like a guard.
+ %% Make sure that it is not optimized like a guard
+ %% (the put/2 call must not be optimized away).
+ try
+ put(K, V),
+ false
+ catch
+ _:_ ->
+ false
+ end.
+
coverage(Config) when is_list(Config) ->
?line {'EXIT',{{case_clause,{a,b,c}},_}} =
(catch cover_will_match_list_type({a,b,c})),
@@ -214,6 +231,7 @@ coverage(Config) when is_list(Config) ->
(catch cover_will_match_list_type({a,b,c,d})),
?line a = cover_remove_non_vars_alias({a,b,c}),
?line error = cover_will_match_lit_list(),
+ {ok,[a]} = cover_is_safe_bool_expr(a),
%% Make sure that we don't attempt to make literals
%% out of pids. (Putting a pid into a #c_literal{}
@@ -249,4 +267,17 @@ cover_will_match_lit_list() ->
error
end.
+cover_is_safe_bool_expr(X) ->
+ %% Use a try...catch that looks like a try...catch in a guard.
+ try
+ %% let V = [X] in {ok,V}
+ %% is_safe_simple([X]) ==> true
+ %% is_safe_bool_expr([X]) ==> false
+ V = [X],
+ {ok,V}
+ catch
+ _:_ ->
+ false
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index eb5e50818e..fb51e013ce 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index 368a5815bf..6067ee8e06 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -20,7 +20,11 @@
-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]).
+ test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1,
+ external/1]).
+
+%% Internal export.
+-export([call_me/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -28,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [test1, overwritten_fun, otp_7202, bif_fun].
+ [test1,overwritten_fun,otp_7202,bif_fun,external].
groups() ->
[].
@@ -45,7 +49,6 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-
%%% The help functions below are copied from emulator:bs_construct_SUITE.
-define(T(B, L), {B, ??B, L}).
@@ -152,4 +155,47 @@ bif_fun(Config) when is_list(Config) ->
?line F = fun abs/1,
?line 5 = F(-5),
ok.
+
+-define(APPLY(M, F, A), (fun(Fun) -> {ok,{a,b}} = Fun({a,b}) end)(fun M:F/A)).
+-define(APPLY2(M, F, A),
+ (fun(Map) ->
+ Id = fun(I) -> I end,
+ List = [x,y],
+ List = Map(Id, List),
+ {type,external} = erlang:fun_info(Map, type)
+ end)(fun M:F/A)).
+external(Config) when is_list(Config) ->
+ Mod = id(?MODULE),
+ Func = id(call_me),
+ Arity = id(1),
+
+ ?APPLY(?MODULE, call_me, 1),
+ ?APPLY(?MODULE, call_me, Arity),
+ ?APPLY(?MODULE, Func, 1),
+ ?APPLY(?MODULE, Func, Arity),
+ ?APPLY(Mod, call_me, 1),
+ ?APPLY(Mod, call_me, Arity),
+ ?APPLY(Mod, Func, 1),
+ ?APPLY(Mod, Func, Arity),
+
+ ListsMod = id(lists),
+ ListsMap = id(map),
+ ListsArity = id(2),
+
+ ?APPLY2(lists, map, 2),
+ ?APPLY2(lists, map, ListsArity),
+ ?APPLY2(lists, ListsMap, 2),
+ ?APPLY2(lists, ListsMap, ListsArity),
+ ?APPLY2(ListsMod, map, 2),
+ ?APPLY2(ListsMod, map, ListsArity),
+ ?APPLY2(ListsMod, ListsMap, 2),
+ ?APPLY2(ListsMod, ListsMap, ListsArity),
+
+ ok.
+
+call_me(I) ->
+ {ok,I}.
+
+id(I) ->
+ I.
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 0e69efba6b..40711783ed 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -32,7 +32,8 @@
t_is_boolean/1,is_function_2/1,
tricky/1,rel_ops/1,literal_type_tests/1,
basic_andalso_orelse/1,traverse_dcd/1,
- check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1]).
+ check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
+ bad_constants/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -44,7 +45,8 @@ all() ->
more_xor_guards, build_in_guard, old_guard_tests, gbif,
t_is_boolean, is_function_2, tricky, rel_ops,
literal_type_tests, basic_andalso_orelse, traverse_dcd,
- check_qlc_hrl, andalso_semi, t_tuple_size, binary_part].
+ check_qlc_hrl, andalso_semi, t_tuple_size, binary_part,
+ bad_constants].
groups() ->
[].
@@ -1517,8 +1519,27 @@ bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> ->
bptest(_,_,_) ->
error.
-
-
+-define(FAILING(C),
+ if
+ C -> ?t:fail(should_fail);
+ true -> ok
+ end,
+ if
+ true, C -> ?t:fail(should_fail);
+ true -> ok
+ end).
+
+bad_constants(Config) when is_list(Config) ->
+ ?line ?FAILING(false),
+ ?line ?FAILING([]),
+ ?line ?FAILING([a]),
+ ?line ?FAILING([Config]),
+ ?line ?FAILING({a,b}),
+ ?line ?FAILING({a,Config}),
+ ?line ?FAILING(<<1>>),
+ ?line ?FAILING(42),
+ ?line ?FAILING(3.14),
+ ok.
%% Call this function to turn off constant propagation.
id(I) -> I.
diff --git a/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S b/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S
index c0bf04ed8f..cffb792920 100644
--- a/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S
+++ b/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S
@@ -19,10 +19,10 @@
{get_tuple_element,{x,0},1,{x,2}}.
{get_tuple_element,{x,0},2,{x,3}}.
{get_tuple_element,{x,0},3,{x,4}}.
- {gc_bif,'+',{f,0},5,[{x,1},{x,2}],{x,0}}.
- {gc_bif,'+',{f,0},5,[{x,0},{x,3}],{x,0}}.
- {gc_bif,'+',{f,0},5,[{x,0},{x,4}],{x,0}}.
- {gc_bif,'+',{f,0},5,[{x,0},{x,5}],{x,0}}.
+ {gc_bif,'+',{f,0},6,[{x,1},{x,2}],{x,0}}.
+ {gc_bif,'+',{f,0},6,[{x,0},{x,3}],{x,0}}.
+ {gc_bif,'+',{f,0},6,[{x,0},{x,4}],{x,0}}.
+ {gc_bif,'+',{f,0},6,[{x,0},{x,5}],{x,0}}.
return.
{label,3}.
{badmatch,{x,0}}.
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index af2b8ec92a..2e17d3fde6 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -33,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
[attribute, bsdecode, bsdes, barnes2, decode1, smith,
- itracer, pseudoknot, lists, really_inlined, otp_7223,
+ itracer, pseudoknot, comma_splitter, lists, really_inlined, otp_7223,
coverage].
groups() ->
@@ -78,6 +78,7 @@ attribute(Config) when is_list(Config) ->
?comp(smith).
?comp(itracer).
?comp(pseudoknot).
+?comp(comma_splitter).
try_inline(Mod, Config) ->
?line Src = filename:join(?config(data_dir, Config), atom_to_list(Mod)),
@@ -263,7 +264,8 @@ my_apply(M, F, A, Init) ->
really_inlined(Config) when is_list(Config) ->
%% Make sure that badarg/2 really gets inlined.
- {'EXIT',{badarg,[{?MODULE,fail_me_now,[]}|_]}} = (catch fail_me_now()),
+ {'EXIT',{badarg,[{?MODULE,fail_me_now,[],_}|_]}} =
+ (catch fail_me_now()),
ok.
fail_me_now() ->
diff --git a/lib/compiler/test/inline_SUITE_data/comma_splitter.erl b/lib/compiler/test/inline_SUITE_data/comma_splitter.erl
new file mode 100644
index 0000000000..eaa89e0edc
--- /dev/null
+++ b/lib/compiler/test/inline_SUITE_data/comma_splitter.erl
@@ -0,0 +1,18 @@
+-module(comma_splitter).
+-export([?MODULE/0]).
+
+?MODULE() ->
+ {<<"def">>,<<"cba">>} = split_at_comma(<<"abc, def">>, <<>>),
+ ok.
+
+strip_leading_ws(<<N, Rest/binary>>) when N =< $\s ->
+ strip_leading_ws(Rest);
+strip_leading_ws(B) ->
+ B.
+
+split_at_comma(<<>>, Accu) ->
+ {<<>>, Accu};
+split_at_comma(<<$,, Rest/binary>>, Accu) ->
+ {strip_leading_ws(Rest), Accu};
+split_at_comma(<<C, Rest/binary>>, Accu) ->
+ split_at_comma(Rest, <<C, Accu/binary>>).
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index c8908858ba..f5948504b3 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -179,8 +179,8 @@ empty_generator(Config) when is_list(Config) ->
id(I) -> I.
-fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args}|_]}}) -> ok;
-fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity}|_]}})
+fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok;
+fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}})
when length(Args) =:= Arity ->
true = test_server:is_native(?MODULE);
fc(Args, {'EXIT',{{case_clause,ActualArgs},_}})
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index c941a80e61..0376c7ef3e 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -179,7 +179,7 @@ silly_coverage(Config) when is_list(Config) ->
?line expect_error(fun() -> v3_life:module(BadKernel, []) end),
%% v3_codegen
- CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b}]},
+ CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]},
?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end),
%% beam_block
@@ -187,9 +187,27 @@ silly_coverage(Config) when is_list(Config) ->
[{function,foo,0,2,
[{label,1},
{func_info,{atom,?MODULE},{atom,foo},0},
- {label,2}|non_proper_list],99}]},
+ {label,2}|non_proper_list]}],99},
?line expect_error(fun() -> beam_block:module(BlockInput, []) end),
+ %% beam_type
+ TypeInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,0,2,
+ [{label,1},
+ {line,loc},
+ {func_info,{atom,?MODULE},{atom,foo},0},
+ {label,2}|non_proper_list]}],99},
+ expect_error(fun() -> beam_type:module(TypeInput, []) end),
+
+ %% beam_except
+ ExceptInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,0,2,
+ [{label,1},
+ {line,loc},
+ {func_info,{atom,?MODULE},{atom,foo},0},
+ {label,2}|non_proper_list]}],99},
+ expect_error(fun() -> beam_except:module(ExceptInput, []) end),
+
%% beam_bool
BoolInput = {?MODULE,[{foo,0}],[],
[{function,foo,0,2,
@@ -253,8 +271,15 @@ expect_error(Fun) ->
io:format("~p", [Any]),
?t:fail(call_was_supposed_to_fail)
catch
- _:_ ->
- io:format("~p\n", [erlang:get_stacktrace()])
+ Class:Reason ->
+ Stk = erlang:get_stacktrace(),
+ io:format("~p:~p\n~p\n", [Class,Reason,Stk]),
+ case {Class,Reason} of
+ {error,undef} ->
+ ?t:fail(not_supposed_to_fail_with_undef);
+ {_,_} ->
+ ok
+ end
end.
confused_literals(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/parteval_SUITE.erl b/lib/compiler/test/parteval_SUITE.erl
deleted file mode 100644
index 6b1ae38c1b..0000000000
--- a/lib/compiler/test/parteval_SUITE.erl
+++ /dev/null
@@ -1,66 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(parteval_SUITE).
-
--include_lib("test_server/include/test_server.hrl").
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, pe2/1]).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [pe2].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% (This is more general than needed, since we once compiled the same
-%% source code with and without a certain option.)
-compile_and_load(Srcname, Outdir, Module, Options) ->
- ?line Objname = filename:join(Outdir, "t1") ++ code:objfile_extension(),
- ?line {ok, Module} =
- compile:file(Srcname,
- [{d, 'M', Module}, {outdir, Outdir}] ++ Options),
- ?line {ok, B} = file:read_file(Objname),
- ?line {module, Module} = code:load_binary(Module, Objname, B),
- B.
-
-pe2(Config) when is_list(Config) ->
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Srcname = filename:join(DataDir, "t1.erl"),
- ?line compile_and_load(Srcname, PrivDir, t1, []),
-
- ?line {Correct, Actual} = t1:run(),
- ?line Correct = Actual,
- ok.
diff --git a/lib/compiler/test/parteval_SUITE_data/t1.erl b/lib/compiler/test/parteval_SUITE_data/t1.erl
deleted file mode 100644
index 5e4a40f103..0000000000
--- a/lib/compiler/test/parteval_SUITE_data/t1.erl
+++ /dev/null
@@ -1,140 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2009. 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(?M).
-
--compile(export_all).
-
-%%% The arity-0 functions are all called from the test suite.
-
-f2() ->
- size({1,2}).
-
-i() ->
- case [] of
- [] ->
- ok;
- X ->
- hopp
- end.
-
-e() ->
- case 4+5 of
-% X when X>10 -> kvock; % not removed by BEAM opt.
- {X,X} when list(X) ->
- kvack;
- 9 ->
- ok;
- _ ->
- ko
- end.
-
-f() ->
- element(2,{a,b,c,d}),
- erlang:element(2,{a,b,c,d}),
- "hej" ++ "hopp".
-
-g(X) ->
- if
- float(3.4) ->
- hej;
- X == 5, 4==4 ->
- japp;
- 4 == 4, size({1,2}) == 1 ->
- ok
- end.
-
-g() ->
- {g(3),g(5)}.
-
-bliff() ->
- if
- 3==4 ->
- himm
- end.
-
-fi() ->
- case 4 of
- X when 4==3 ->
- {X};
- 4 ->
- 4;
- _ ->
- ok
- end.
-
-iff() when 3==2 ->
- if
- 3 == 4 ->
- baff;
- 3 == 3 ->
- nipp
- end.
-
-sleep(I) -> receive after I -> ok end.
-
-sleep() ->
- sleep(45).
-
-s() ->
- case 4 of
- 3 ->
- ok
- end.
-
-error_reason(R) when atom(R) ->
- R;
-error_reason(R) when tuple(R) ->
- error_reason(element(1, R)).
-
-plusplus() ->
- ?MODULE ++ " -> mindre snygg felhantering".
-
-call_it(F) ->
- case (catch apply(?MODULE, F, [])) of
- {'EXIT', R0} ->
- {'EXIT', error_reason(R0)};
- V ->
- V
- end.
-
-run() ->
- L = [{f2, 2},
- {i, ok},
- {e, ok},
- {f, "hejhopp"},
- {g, {hej, hej}},
- {bliff, {'EXIT', if_clause}},
- {fi, 4},
- {iff, {'EXIT', function_clause}},
- {sleep, ok},
- {s, {'EXIT', case_clause},
- {plusplus, {'EXIT', badarg}}}],
- Actual = [call_it(F) || {F, _} <- L],
- Correct = [C || {_, C} <- L],
- {Correct, Actual}.
-
-
-%%% Don't call, only compile.
-t(A) ->
- receive
- A when 1==2 ->
- ok;
- B ->
- B
- end.
diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl
index 9a317b5762..5dd09a7245 100644
--- a/lib/compiler/test/pmod_SUITE.erl
+++ b/lib/compiler/test/pmod_SUITE.erl
@@ -96,6 +96,11 @@ basic_1(Config, Opts) ->
?line error = Prop4:bar_bar({s,a,b}),
?line error = Prop4:bar_bar([]),
+ %% Call from a fun.
+ Fun = fun(Arg) -> Prop4:bar(Arg) end,
+ ?line ok = Fun({s,0}),
+
+ [{y,[1,2]},{x,[5,19]}] = Prop4:collapse([{y,[2,1]},{x,[19,5]}]),
ok.
otp_8447(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/pmod_SUITE_data/pmod_basic.erl b/lib/compiler/test/pmod_SUITE_data/pmod_basic.erl
index 0d46cffe00..19cce452dc 100644
--- a/lib/compiler/test/pmod_SUITE_data/pmod_basic.erl
+++ b/lib/compiler/test/pmod_SUITE_data/pmod_basic.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -21,6 +21,7 @@
-export([lookup/1,or_props/1,prepend/1,append/1,stupid_sum/0]).
-export([bar/1,bar_bar/1]).
-export([bc1/0, bc2/0]).
+-export([collapse/1]).
lookup(Key) ->
proplists:lookup(Key, Props).
@@ -77,3 +78,6 @@ bc1() ->
bc2() ->
<< <<A:1>> || A <- [1,0,1,0] >>.
+
+collapse(L) ->
+ lists:keymap(fun lists:sort/1, 2, L).
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 53d8c04169..2295592a38 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -77,7 +77,14 @@ get_data_dir(Config) ->
%% Will fail the test case if there were any errors.
p_run(Test, List) ->
- N = erlang:system_info(schedulers) + 1,
+ N = case ?t:is_cover() of
+ false ->
+ erlang:system_info(schedulers);
+ true ->
+ %% Cover is running. Using more than one process
+ %% will probably only slow down compilation.
+ 1
+ end,
p_run_loop(Test, List, N, [], 0, 0).
p_run_loop(_, [], _, [], Errors, Ws) ->
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index c6e0f8d85d..29119c0f5d 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -24,7 +24,7 @@
catch_oops/1,after_oops/1,eclectic/1,rethrow/1,
nested_of/1,nested_catch/1,nested_after/1,
nested_horrid/1,last_call_optimization/1,bool/1,
- plain_catch_coverage/1,andalso_orelse/1]).
+ plain_catch_coverage/1,andalso_orelse/1,get_in_try/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -35,7 +35,7 @@ all() ->
[basic, lean_throw, try_of, try_after, catch_oops,
after_oops, eclectic, rethrow, nested_of, nested_catch,
nested_after, nested_horrid, last_call_optimization,
- bool, plain_catch_coverage, andalso_orelse].
+ bool, plain_catch_coverage, andalso_orelse, get_in_try].
groups() ->
[].
@@ -314,19 +314,19 @@ eclectic(Conf) when is_list(Conf) ->
V = {make_ref(),3.1415926535,[[]|{}]},
?line {{value,{value,V},V},V} =
eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}),
- ?line {{'EXIT',{V,[{?MODULE,foo,1}|_]}},V} =
+ ?line {{'EXIT',{V,[{?MODULE,foo,1,_}|_]}},V} =
eclectic_1({catch_foo,{error,V}}, undefined, {value,V}),
?line {{error,{exit,V},{'EXIT',V}},V} =
eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),
?line {{value,{value,V},V},
- {'EXIT',{badarith,[{?MODULE,my_add,2}|_]}}} =
+ {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} =
eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),
?line {{'EXIT',V},V} =
eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}),
- ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2}|_]}}},
+ ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}},
{'EXIT',V}} =
eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),
- ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,1}|_]}}},
+ ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},
{'EXIT',V}} =
eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}),
%%
@@ -336,15 +336,15 @@ eclectic(Conf) when is_list(Conf) ->
eclectic_2({throw,{value,V}}, throw, {value,V}),
?line {{caught,{'EXIT',V}},undefined} =
eclectic_2({value,{value,V}}, undefined, {exit,V}),
- ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1}|_]}}},undefined} =
+ ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
eclectic_2({error,{value,V}}, throw, {error,V}),
- ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V]}|_]}}},V} =
+ ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =
eclectic_2({value,{'abs',V}}, undefined, {value,V}),
- ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2}|_]}}},V} =
+ ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} =
eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),
?line {{caught,{'EXIT',V}},undefined} =
eclectic_2({value,{error,V}}, undefined, {exit,V}),
- ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1}|_]}}},undefined} =
+ ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} =
eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}),
ok.
@@ -928,3 +928,17 @@ andalso_orelse_2({Type,Keyval}) ->
zero() ->
0.0.
+
+get_in_try(_) ->
+ undefined = get_valid_line([a], []),
+ ok.
+
+get_valid_line([_|T]=Path, Annotations) ->
+ try
+ get(Path)
+ %% beam_dead used to optimize away an assignment to {y,1}
+ %% because it didn't appear to be used.
+ catch
+ _:not_found ->
+ get_valid_line(T, Annotations)
+ end.
diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk
index 04290c0a7f..b77c82309f 100644
--- a/lib/compiler/vsn.mk
+++ b/lib/compiler/vsn.mk
@@ -1 +1 @@
-COMPILER_VSN = 4.7.5
+COMPILER_VSN = 4.8.2