aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/doc/src/Makefile27
-rw-r--r--lib/compiler/doc/src/compile.xml83
-rw-r--r--lib/compiler/doc/src/fascicules.xml15
-rw-r--r--lib/compiler/doc/src/note.gifbin1539 -> 0 bytes
-rw-r--r--lib/compiler/doc/src/notes.xml721
-rw-r--r--lib/compiler/doc/src/part_notes.xml40
-rw-r--r--lib/compiler/doc/src/part_notes_history.xml40
-rw-r--r--lib/compiler/doc/src/user_guide.gifbin1581 -> 0 bytes
-rw-r--r--lib/compiler/doc/src/warning.gifbin1498 -> 0 bytes
-rw-r--r--lib/compiler/internal_doc/cerl-notes.md75
-rw-r--r--lib/compiler/src/Makefile23
-rw-r--r--lib/compiler/src/beam_a.erl19
-rw-r--r--lib/compiler/src/beam_asm.erl103
-rw-r--r--lib/compiler/src/beam_block.erl409
-rw-r--r--lib/compiler/src/beam_bool.erl765
-rw-r--r--lib/compiler/src/beam_bs.erl8
-rw-r--r--lib/compiler/src/beam_bsm.erl62
-rw-r--r--lib/compiler/src/beam_clean.erl101
-rw-r--r--lib/compiler/src/beam_dead.erl143
-rw-r--r--lib/compiler/src/beam_dict.erl32
-rw-r--r--lib/compiler/src/beam_disasm.erl104
-rw-r--r--lib/compiler/src/beam_disasm.hrl5
-rw-r--r--lib/compiler/src/beam_except.erl14
-rw-r--r--lib/compiler/src/beam_flatten.erl14
-rw-r--r--lib/compiler/src/beam_jump.erl209
-rw-r--r--lib/compiler/src/beam_listing.erl86
-rw-r--r--lib/compiler/src/beam_peep.erl42
-rw-r--r--lib/compiler/src/beam_receive.erl10
-rw-r--r--lib/compiler/src/beam_record.erl131
-rw-r--r--lib/compiler/src/beam_reorder.erl8
-rw-r--r--lib/compiler/src/beam_split.erl12
-rw-r--r--lib/compiler/src/beam_trim.erl9
-rw-r--r--lib/compiler/src/beam_type.erl786
-rw-r--r--lib/compiler/src/beam_utils.erl1006
-rw-r--r--lib/compiler/src/beam_validator.erl304
-rw-r--r--lib/compiler/src/beam_z.erl38
-rw-r--r--lib/compiler/src/cerl.erl24
-rw-r--r--lib/compiler/src/cerl_clauses.erl11
-rw-r--r--lib/compiler/src/cerl_inline.erl28
-rw-r--r--lib/compiler/src/cerl_trees.erl125
-rw-r--r--lib/compiler/src/compile.erl616
-rw-r--r--lib/compiler/src/compiler.app.src12
-rw-r--r--lib/compiler/src/core_lint.erl18
-rw-r--r--lib/compiler/src/core_parse.yrl25
-rw-r--r--lib/compiler/src/core_pp.erl12
-rw-r--r--lib/compiler/src/core_scan.erl38
-rw-r--r--lib/compiler/src/erl_bifs.erl13
-rwxr-xr-xlib/compiler/src/genop.tab39
-rw-r--r--lib/compiler/src/rec_env.erl9
-rw-r--r--lib/compiler/src/sys_core_alias.erl307
-rw-r--r--lib/compiler/src/sys_core_bsm.erl355
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl5
-rw-r--r--lib/compiler/src/sys_core_fold.erl1055
-rw-r--r--lib/compiler/src/sys_core_inline.erl6
-rw-r--r--lib/compiler/src/sys_pre_attributes.erl48
-rw-r--r--lib/compiler/src/sys_pre_expand.erl616
-rw-r--r--lib/compiler/src/v3_codegen.erl1721
-rw-r--r--lib/compiler/src/v3_core.erl405
-rw-r--r--lib/compiler/src/v3_kernel.erl824
-rw-r--r--lib/compiler/src/v3_kernel.hrl5
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl33
-rw-r--r--lib/compiler/src/v3_life.erl484
-rw-r--r--lib/compiler/test/Makefile26
-rw-r--r--lib/compiler/test/andor_SUITE.erl4
-rw-r--r--lib/compiler/test/apply_SUITE.erl4
-rw-r--r--lib/compiler/test/beam_block_SUITE.erl76
-rw-r--r--lib/compiler/test/beam_bool_SUITE.erl197
-rw-r--r--lib/compiler/test/beam_except_SUITE.erl4
-rw-r--r--lib/compiler/test/beam_jump_SUITE.erl4
-rw-r--r--lib/compiler/test/beam_reorder_SUITE.erl4
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl205
-rw-r--r--lib/compiler/test/beam_utils_SUITE.erl209
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl90
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S64
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S88
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S390
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl92
-rw-r--r--lib/compiler/test/bif_SUITE.erl65
-rw-r--r--lib/compiler/test/bs_bincomp_SUITE.erl16
-rw-r--r--lib/compiler/test/bs_bit_binaries_SUITE.erl6
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl38
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl320
-rw-r--r--lib/compiler/test/bs_utf_SUITE.erl5
-rw-r--r--lib/compiler/test/compilation_SUITE.erl6
-rw-r--r--lib/compiler/test/compilation_SUITE_data/opt_crash.erl8
-rw-r--r--lib/compiler/test/compile_SUITE.erl562
-rw-r--r--lib/compiler/test/compile_SUITE_data/big.erl6
-rw-r--r--lib/compiler/test/compile_SUITE_data/deterministic_module.erl (renamed from lib/compiler/src/v3_life.hrl)18
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple.erl5
-rw-r--r--lib/compiler/test/compile_SUITE_data/small_float.erl5
-rw-r--r--lib/compiler/test/core_SUITE.erl30
-rw-r--r--lib/compiler/test/core_SUITE_data/cover_v3_kernel_1.core147
-rw-r--r--lib/compiler/test/core_SUITE_data/cover_v3_kernel_2.core98
-rw-r--r--lib/compiler/test/core_SUITE_data/cover_v3_kernel_3.core98
-rw-r--r--lib/compiler/test/core_SUITE_data/cover_v3_kernel_4.core82
-rw-r--r--lib/compiler/test/core_SUITE_data/cover_v3_kernel_5.core98
-rw-r--r--lib/compiler/test/core_SUITE_data/fun_letrec_effect.core25
-rw-r--r--lib/compiler/test/core_SUITE_data/name_capture.core110
-rw-r--r--lib/compiler/test/core_SUITE_data/non_variable_apply.core80
-rw-r--r--lib/compiler/test/core_alias_SUITE.erl195
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl116
-rw-r--r--lib/compiler/test/error_SUITE.erl4
-rw-r--r--lib/compiler/test/float_SUITE.erl16
-rw-r--r--lib/compiler/test/fun_SUITE.erl15
-rw-r--r--lib/compiler/test/guard_SUITE.erl330
-rw-r--r--lib/compiler/test/inline_SUITE.erl4
-rw-r--r--lib/compiler/test/lc_SUITE.erl39
-rw-r--r--lib/compiler/test/lfe-core.patch97
-rw-r--r--lib/compiler/test/lfe-source.patch117
-rw-r--r--lib/compiler/test/lfe.readme31
-rw-r--r--lib/compiler/test/lfe_andor_SUITE.core2014
-rw-r--r--lib/compiler/test/lfe_guard_SUITE.core3438
-rw-r--r--lib/compiler/test/map_SUITE.erl215
-rw-r--r--lib/compiler/test/match_SUITE.erl162
-rw-r--r--lib/compiler/test/misc_SUITE.erl56
-rw-r--r--lib/compiler/test/num_bif_SUITE.erl285
-rw-r--r--lib/compiler/test/overridden_bif_SUITE.erl101
-rw-r--r--lib/compiler/test/receive_SUITE.erl94
-rw-r--r--lib/compiler/test/record_SUITE.erl4
-rw-r--r--lib/compiler/test/record_SUITE_data/record_access_in_guards.erl63
-rw-r--r--lib/compiler/test/regressions_SUITE.erl40
-rw-r--r--lib/compiler/test/test_lib.erl9
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl238
-rw-r--r--lib/compiler/test/warnings_SUITE.erl114
-rw-r--r--lib/compiler/test/z_SUITE.erl7
-rw-r--r--lib/compiler/vsn.mk2
126 files changed, 17803 insertions, 5566 deletions
diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile
index c6864cb835..32f150eef8 100644
--- a/lib/compiler/doc/src/Makefile
+++ b/lib/compiler/doc/src/Makefile
@@ -1,8 +1,8 @@
#
# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1997-2016. All Rights Reserved.
-#
+#
+# Copyright Ericsson AB 1997-2018. All Rights Reserved.
+#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
@@ -14,7 +14,7 @@
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
-#
+#
# %CopyrightEnd%
#
include $(ERL_TOP)/make/target.mk
@@ -38,13 +38,12 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
XML_APPLICATION_FILES = ref_man.xml
XML_REF3_FILES = compile.xml
-XML_PART_FILES = part_notes.xml part_notes_history.xml
-XML_CHAPTER_FILES = notes.xml notes_history.xml
+XML_PART_FILES =
+XML_CHAPTER_FILES = notes.xml
BOOK_FILES = book.xml
-GIF_FILES = \
- warning.gif
+GIF_FILES =
XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
@@ -64,9 +63,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
# ----------------------------------------------------
-# FLAGS
+# FLAGS
# ----------------------------------------------------
-XML_FLAGS +=
+XML_FLAGS +=
# ----------------------------------------------------
# Targets
@@ -86,17 +85,18 @@ man: $(MAN3_FILES)
gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-debug opt:
+debug opt:
clean clean_docs:
rm -rf $(HTMLDIR)/*
+ rm -rf $(XMLDIR)
rm -f $(MAN3DIR)/*
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f errs core *~
+ rm -f errs core *~
# ----------------------------------------------------
# Release Target
-# ----------------------------------------------------
+# ----------------------------------------------------
include $(ERL_TOP)/make/otp_release_targets.mk
release_docs_spec: docs
@@ -110,4 +110,3 @@ release_docs_spec: docs
$(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 9ac16af814..cfbd4c7fda 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>2017</year>
+ <year>1996</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -123,6 +123,17 @@
in the Efficiency Guide.</p>
</item>
+ <tag><c>{compile_info, [{atom(), term()}]}</c></tag>
+ <item>
+ <p>Allows compilers built on top of <c>compile</c> to attach
+ extra compilation metadata to the <c>compile_info</c> chunk
+ in the generated beam file.</p>
+
+ <p>It is advised for compilers to remove all non-deterministic
+ information if the <c>deterministic</c> option is supported and
+ it was supplied by the user.</p>
+ </item>
+
<tag><c>compressed</c></tag>
<item>
<p>The compiler will compress the generated object code,
@@ -132,12 +143,10 @@
<tag><c>debug_info</c></tag>
<item>
<marker id="debug_info"></marker>
- <p>Includes debug information in the form of abstract code
- (see
- <seealso marker="erts:absform">The Abstract Format</seealso>
- in ERTS User's Guide) in the compiled beam module. Tools
- such as Debugger, Xref, and Cover require
- the debug information to be included.</p>
+ <p>Includes debug information in the form of <seealso marker="erts:absform">
+ Erlang Abstract Format</seealso> in the <c>debug_info</c>
+ chunk of the compiled beam module. Tools such as Debugger,
+ Xref, and Cover require the debug information to be included.</p>
<p><em>Warning</em>: Source code can be reconstructed from
the debug information. Use encrypted debug information
@@ -147,6 +156,21 @@
<seealso marker="stdlib:beam_lib#debug_info">beam_lib(3)</seealso>.</p>
</item>
+ <tag><c>{debug_info, {Backend, Data}}</c></tag>
+ <item>
+ <marker id="debug_info"></marker>
+ <p>Includes custom debug information in the form of a
+ <c>Backend</c> module with custom <c>Data</c> in the compiled beam module.
+ The given module must implement a <c>debug_info/4</c> function
+ and is responsible for generating different code representations,
+ as described in the <c>debug_info</c> under
+ <seealso marker="stdlib:beam_lib#debug_info">beam_lib(3)</seealso>.</p>
+
+ <p><em>Warning</em>: Source code can be reconstructed from
+ the debug information. Use encrypted debug information
+ (<c>encrypt_debug_info</c>) to prevent this.</p>
+ </item>
+
<tag><c>{debug_info_key,KeyString}</c></tag>
<item></item>
<tag><c>{debug_info_key,{Mode,KeyString}}</c></tag>
@@ -176,6 +200,15 @@
<seealso marker="stdlib:beam_lib#debug_info">beam_lib(3)</seealso>.</p>
</item>
+ <tag><c>deterministic</c></tag>
+ <item>
+ <p>Omit the <c>options</c> and <c>source</c> tuples in
+ the list returned by <c>Module:module_info(compile)</c>, and
+ reduce the paths in stack traces to the module name alone.
+ This option will make it easier to achieve reproducible builds.
+ </p>
+ </item>
+
<tag><c>makedep</c></tag>
<item>
<p>Produces a Makefile rule to track headers dependencies.
@@ -201,6 +234,15 @@ module.beam: module.erl \
header.hrl</code>
</item>
+ <tag><c>makedep_side_effect</c></tag>
+ <item>
+ <p>The dependecies are created as a side effect to the
+ normal compilation process. This means that the object
+ file will also be produced. This option override the
+ <c>makedep</c> option.
+ </p>
+ </item>
+
<tag><c>{makedep_output, Output}</c></tag>
<item>
<p>Writes generated rules to <c>Output</c> instead of the
@@ -306,8 +348,8 @@ module.beam: module.erl \
<tag><c>{source,FileName}</c></tag>
<item>
- <p>Sets the value of the source, as returned by
- <c>module_info(compile)</c>.</p>
+ <p>Overrides the source file name as presented in
+ <c>module_info(compile)</c> and stack traces.</p>
</item>
<tag><c>{outdir,Dir}</c></tag>
@@ -410,7 +452,7 @@ module.beam: module.erl \
without module prefix to local or imported functions before
trying with auto-imported BIFs. If the BIF is to be
called, use the <c>erlang</c> module prefix in the call, not
- <c>{ no_auto_import,[{F,A}, ...]}</c>.</p>
+ <c>{no_auto_import,[{F,A}, ...]}</c>.</p>
</note>
<p>If this option is written in the source code, as a
<c>-compile</c> directive, the syntax <c>F/A</c> can be used instead
@@ -431,6 +473,15 @@ module.beam: module.erl \
</p>
</item>
+ <tag><c>{extra_chunks, [{binary(), binary()}]}</c></tag>
+ <item>
+ <p>Pass extra chunks to be stored in the <c>.beam</c> file.
+ The extra chunks must be a list of tuples with a four byte
+ binary as chunk name followed by a binary with the chunk contents.
+ See <seealso marker="stdlib:beam_lib">beam_lib</seealso> for
+ more information.
+ </p>
+ </item>
</taglist>
<p>If warnings are turned on (option <c>report_warnings</c>
@@ -498,9 +549,11 @@ module.beam: module.erl \
</warning>
</item>
- <tag><c>warn_export_all</c></tag>
+ <tag><c>nowarn_export_all</c></tag>
<item>
- <p>Emits a warning if option <c>export_all</c> is also given.</p>
+ <p>Turns off warnings for uses of the <c>export_all</c>
+ option. Default is to emit a warning if option
+ <c>export_all</c> is also given.</p>
</item>
<tag><c>warn_export_vars</c></tag>
@@ -568,13 +621,13 @@ module.beam: module.erl \
to be deprecated.</p>
</item>
- <tag><c>warn_obsolete_guard</c></tag>
+ <tag><c>nowarn_obsolete_guard</c></tag>
<item>
- <p>Emits warnings for calls to old type testing BIFs,
+ <p>Turns off warnings for calls to old type testing BIFs,
such as <c>pid/1</c> and <c>list/1</c>. See the
<seealso marker="doc/reference_manual:expressions#guards">Erlang Reference Manual</seealso>
for a complete list of type testing BIFs and their old
- equivalents. Default is to emit no warnings for calls to
+ equivalents. Default is to emit warnings for calls to
old type testing BIFs.</p>
</item>
diff --git a/lib/compiler/doc/src/fascicules.xml b/lib/compiler/doc/src/fascicules.xml
deleted file mode 100644
index fadd37eefb..0000000000
--- a/lib/compiler/doc/src/fascicules.xml
+++ /dev/null
@@ -1,15 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE fascicules SYSTEM "fascicules.dtd">
-
-<fascicules>
- <fascicule file="ref_man" href="ref_man_frame.html" entry="yes">
- Reference Manual
- </fascicule>
- <fascicule file="part_notes" href="part_notes_frame.html" entry="no">
- Release Notes
- </fascicule>
- <fascicule file="" href="../../../../doc/print.html" entry="no">
- Off-Print
- </fascicule>
-</fascicules>
-
diff --git a/lib/compiler/doc/src/note.gif b/lib/compiler/doc/src/note.gif
deleted file mode 100644
index 6fffe30419..0000000000
--- a/lib/compiler/doc/src/note.gif
+++ /dev/null
Binary files differ
diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml
index db50cba094..5024310788 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>2016</year>
+ <year>2004</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -32,6 +32,709 @@
<p>This document describes the changes made to the Compiler
application.</p>
+<section><title>Compiler 7.2.6</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>In rare circumstances, the matched out tail of a
+ binary could be the entire original binary. (There was
+ partial correction to this problem in version 7.2.5 of
+ the compiler application.)</p>
+ <p>
+ Own Id: OTP-15335 Aux Id: ERL-689, OTP-15219 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.2.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed a bug that prevented certain variable-sized
+ binary comprehensions from compiling.</p>
+ <p>
+ Own Id: OTP-15186 Aux Id: ERL-665 </p>
+ </item>
+ <item>
+ <p>When compiling from Core Erlang, funs created in
+ certain expressions that were only used for their
+ side-effects were subtly broken.</p>
+ <p>
+ Own Id: OTP-15188 Aux Id: ERL-658 </p>
+ </item>
+ <item>
+ <p>There could be an internal consistency failure when a
+ <c>receive</c> was nested in a
+ <c>try</c>/<c>catch</c>.</p>
+ <p>
+ Own Id: OTP-15218 Aux Id: ERL-684 </p>
+ </item>
+ <item>
+ <p>In rare circumstances, the matched out tail of a
+ binary could be the entire original binary.</p>
+ <p>
+ Own Id: OTP-15219 Aux Id: ERL-689 </p>
+ </item>
+ <item>
+ <p>When <c>is_map_key/2</c> was used in a guard together
+ with the <c>not/1</c> or <c>or/2</c> operators, the error
+ behavior could be wrong when <c>is_map_key/2</c> was
+ passed a non-map as the second argument. </p>
+ <p>In rare circumstances, compiling code that uses
+ <c>is_map_key/2</c> could cause an internal consistency
+ check failure.</p>
+ <p>
+ Own Id: OTP-15227 Aux Id: ERL-699 </p>
+ </item>
+ <item>
+ <p>The compiler could crash when compiling a function
+ with multiple receives in multiple clauses.</p>
+ <p>
+ Own Id: OTP-15235 Aux Id: ERL-703 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.2.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fix a regression in OTP-15204 that removed
+ <c>.beam</c> file metadata that some external build tools
+ relied on.</p>
+ <p>
+ Own Id: OTP-15292</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.2.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed an issue where files compiled with the
+ <c>+deterministic</c> option differed if they were
+ compiled in a different directory but were otherwise
+ identical.</p>
+ <p>
+ Own Id: OTP-15204 Aux Id: ERL-679 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.2.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>In rare cases involving matching of binary literal
+ strings, the compiler could optimize away code that
+ should be executed.</p>
+ <p>
+ Own Id: OTP-15156 Aux Id: ERL-655 </p>
+ </item>
+ <item>
+ <p>There could be an internal consistency check failure
+ when compiling code that called <c>map_get(Key, Map)</c>
+ and then updated the same map.</p>
+ <p>
+ Own Id: OTP-15157</p>
+ </item>
+ <item>
+ <p>In rare circumstances, the compiler could crash in
+ <c>beam_jump</c> when compiling a floating point
+ operation.</p>
+ <p>
+ Own Id: OTP-15166 Aux Id: ERL-660 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.2.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>The could could crash when compiling a complicated
+ function that used the binary syntax.</p>
+ <p>
+ Own Id: OTP-15150 Aux Id: ERL-650 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed an error in an optimization pass that caused
+ impossible tuple matching.</p>
+ <p>
+ Own Id: OTP-14855 Aux Id: ERL-549 </p>
+ </item>
+ <item>
+ <p>The exception thrown when a list comprehension was
+ given a non-list term was not always correct.</p>
+ <p>
+ Own Id: OTP-14992 Aux Id: ERL-572 </p>
+ </item>
+ <item>
+ <p>The compiler could produce incorrect code in rare
+ circumstances when the <c>[{inline,F/A}]</c> option was
+ used.</p>
+ <p>
+ Own Id: OTP-15115 Aux Id: PR-1831 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>Changed the default behaviour of <c>.erlang</c>
+ loading: <c>.erlang</c> is no longer loaded from the
+ current directory. <c>c:erlangrc(PathList)</c> can be
+ used to search and load an <c>.erlang</c> file from user
+ specified directories.</p> <p><c>escript</c>,
+ <c>erlc</c>, <c>dialyzer</c> and <c>typer</c> no longer
+ load an <c>.erlang</c> at all.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14439</p>
+ </item>
+ <item>
+ <p>Support for "tuple calls" have been removed from the
+ run-time system. Tuple calls was an undocumented and
+ unsupported feature which allowed the module argument for
+ an apply operation to be a tuple: <c>Var = dict:new(),
+ Var:size()</c>. This "feature" frequently caused
+ confusion, especially when such call failed. The
+ stacktrace would point out functions that don't exist in
+ the source code.</p>
+ <p>For legacy code that need to use parameterized modules
+ or tuple calls for some other reason, there is a new
+ compiler option called <c>tuple_calls</c>. When this
+ option is given, the compiler will generate extra code
+ that emulates the old behavior for calls where the module
+ is a variable.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14497</p>
+ </item>
+ <item>
+ <p>In code such as <c>example({ok, Val}) -&gt; {ok,
+ Val}.</c> a tuple would be built. The compiler will now
+ automatically rewrite the code to
+ <c>example({ok,Val}=Tuple) -&gt; Tuple.</c> which will
+ reduce code size, execution time, and remove GC
+ pressure.</p>
+ <p>
+ Own Id: OTP-14505</p>
+ </item>
+ <item>
+ <p>The optimization of <c>case</c> expression where only
+ one of the case arms can execute successfully has been
+ improved.</p>
+ <p>
+ Own Id: OTP-14525</p>
+ </item>
+ <item>
+ <p>Some uses of binary matching has been slightly
+ improved, eliminating unnecessary register shuffling.</p>
+ <p>
+ Own Id: OTP-14594 Aux Id: ERL-444 </p>
+ </item>
+ <item>
+ <p>There is a new <c>{compile_info,Info}</c> option for
+ the compiler that allows BEAM-based languages such as
+ Elixir and LFE to add their own compiler versions.</p>
+ <p>
+ Own Id: OTP-14615 Aux Id: PR-1558 </p>
+ </item>
+ <item>
+ <p>Loaded BEAM code in a 64-bit system requires less
+ memory because of better packing of operands for
+ instructions.</p>
+ <p>These memory savings were achieved by major
+ improvements to the <c>beam_makeops</c> scripts used when
+ building the run time system and BEAM compiler. There is
+ also new for documentation for <c>beam_makeops</c> that
+ describes how new BEAM instructions and loader
+ transformations can be implemented. The documentation is
+ found in here in a source directory or git repository:
+ erts/emulator/internal_doc/beam_makeops.md. An online
+ version can be found here:
+ https://github.com/erlang/otp/blob/master/erts/emulator/internal_doc/beam_makeops.md</p>
+ <p>
+ Own Id: OTP-14626</p>
+ </item>
+ <item>
+ <p>Size calculations for binary constructions has been
+ somewhat optimized, producing smaller code.</p>
+ <p>
+ Own Id: OTP-14654</p>
+ </item>
+ <item>
+ <p>When the value returned from a '<c>catch</c>'
+ expression is ignored, no stacktrace will be built if an
+ exception is caught. That will save time and produce less
+ garbage. There are also some minor optimizations of
+ '<c>try</c>/<c>catch</c>' both in the compiler and
+ run-time system.</p>
+ <p>
+ Own Id: OTP-14683</p>
+ </item>
+ <item>
+ <p>There is a new syntax in '<c>try/catch</c>' for
+ retrieving the stacktrace without calling
+ '<c>erlang:get_stacktrace/0</c>'. See the reference
+ manual for a description of the new syntax. The
+ '<c>erlang:get_stacktrace/0</c>' BIF is now
+ deprecated.</p>
+ <p>
+ Own Id: OTP-14692</p>
+ </item>
+ <item>
+ <p>The following is an internal change in the compiler,
+ that is not noticeable for normal use of the compiler:
+ The module <c>v3_life</c> has been removed. Its
+ functionality has been simplified and integrated into
+ <c>v3_codegen</c>.</p>
+ <p>
+ Own Id: OTP-14712</p>
+ </item>
+ <item>
+ <p>The optimization of binary matching that delays
+ creation of sub binaries (see the Efficiency Guide) could
+ be thwarted by the argument order and could be necessary
+ to change the argument order. The compiler has now become
+ smarter and can handle any argument order.</p>
+ <p>
+ Own Id: OTP-14774</p>
+ </item>
+ <item>
+ <p>When the compiler was faced with complex case
+ expressions it would unnecessarily allocate stack
+ elements and shuffle data between x and y registers.
+ Improved code generation to only allocate a stack frame
+ when strictly necessary.</p>
+ <p>
+ Own Id: OTP-14808 Aux Id: ERL-514 </p>
+ </item>
+ <item>
+ <p>There is a new option '<c>makedep_side_effect</c>' for
+ the compiler and <c>-MMD</c> for '<c>erlc</c>' that
+ generates dependencies and continues to compile as
+ normal.</p>
+ <p>
+ Own Id: OTP-14830</p>
+ </item>
+ <item>
+ <p>When compiling modules with huge functions, the
+ compiler would generate a lot of atoms for its internal,
+ sometimes so many that the atom table would overflow. The
+ compiler has been rewritten to generate far less internal
+ atoms to avoid filling the atom table.</p>
+ <p>
+ Own Id: OTP-14968 Aux Id: ERL-563 </p>
+ </item>
+ <item>
+ <p>External funs with literal values for module, name,
+ and arity (e.g. <c>erlang:abs/1</c>) are now treated as
+ literals. That means more efficient code that produces
+ less garbage on the heap.</p>
+ <p>
+ Own Id: OTP-15003</p>
+ </item>
+ <item>
+ <p>Two new guards BIFs operating on maps have been added:
+ <c>map_get/2</c> and <c>is_map_key/2</c>. They do the
+ same as <c>maps:get/2</c> and <c>maps:is_key/2</c>,
+ respectively, except that they are allowed to be used in
+ guards.</p>
+ <p>
+ Own Id: OTP-15037 Aux Id: PR-1784, PR-1802 </p>
+ </item>
+ <item>
+ <p>A call or apply of a literal external fun will be
+ replaced with a direct call.</p>
+ <p>
+ Own Id: OTP-15044 Aux Id: ERL-614 </p>
+ </item>
+ <item>
+ <p>Part of EEP-44 has been implemented.</p>
+ <p>There is a new predefined macro called
+ <c>OTP_RELEASE</c> which is an integer indicating the OTP
+ release number (its value is <c>21</c> in this
+ release).</p>
+ <p>There are new preprocessor directives
+ <c>-if(Condition).</c> and <c>-elif(Condition).</c>. The
+ <c>if/elif</c> supports the builtin function
+ <c>defined(Symbol)</c>.</p>
+ <p>
+ Own Id: OTP-15087 Aux Id: PR-1810 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1.5.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fix a regression in OTP-15204 that removed
+ <c>.beam</c> file metadata that some external build tools
+ relied on.</p>
+ <p>
+ Own Id: OTP-15292</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1.5.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed an issue where files compiled with the
+ <c>+deterministic</c> option differed if they were
+ compiled in a different directory but were otherwise
+ identical.</p>
+ <p>
+ Own Id: OTP-15204 Aux Id: ERL-679 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>The internal compiler pass (<c>beam_validator</c>)
+ that validates the generated code has been
+ strengthened.</p>
+ <p>When compiling from BEAM assembly code, the
+ <c>beam_type</c> optimizer pass could make the code
+ unsafe. Corrected.</p>
+ <p>
+ Own Id: OTP-14863</p>
+ </item>
+ <item>
+ <p>Corrected optimizations of integers matched out from
+ binaries and used in bit operations.</p>
+ <p>
+ Own Id: OTP-14898</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>The '<c>deterministic</c>' option was not recognized
+ when given in a <c>-compile()</c> attribute in the source
+ code.</p>
+ <p>
+ Own Id: OTP-14773 Aux Id: ERL-498 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>The compiler could issue an incorrect internal
+ consistency failure diagnostic for some complicated bit
+ syntax maches.</p>
+ <p>
+ Own Id: OTP-14640 Aux Id: ERL-490 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fail labels on guard BIFs weren't taken into account
+ during an optimization pass, and a bug in the validation
+ pass sometimes prevented this from being noticed when a
+ fault occurred.</p>
+ <p>
+ Own Id: OTP-14522 Aux Id: ERIERL-48 </p>
+ </item>
+ <item>
+ <p>
+ When compiling from Core Erlang, an 'apply' with a nested
+ apply in the function position would be treated as an
+ invalid call. Corrected. (Thanks to Mikael Pettersson for
+ reporting this bug.)</p>
+ <p>
+ Own Id: OTP-14526</p>
+ </item>
+ <item>
+ <p>Fixed checking of binary matching in the
+ <c>beam_validator</c> module to ensure that potential
+ compiler bugs are found at compile-time instead as
+ emulator crash at run-time.</p>
+ <p>
+ Own Id: OTP-14591</p>
+ </item>
+ <item>
+ <p>There could be false warnings for
+ <c>erlang:get_stacktrace/0</c> being used outside of a
+ <c>try</c> block when using multiple <c>catch</c>
+ clauses.</p>
+ <p>
+ Own Id: OTP-14600 Aux Id: ERL-478 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> The Erlang code linter no longer checks that the
+ functions mentioned in <c>nowarn_deprecated_function</c>
+ options are declared in the module. </p>
+ <p>
+ Own Id: OTP-14378</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fail labels on guard BIFs weren't taken into account
+ during an optimization pass, and a bug in the validation
+ pass sometimes prevented this from being noticed when a
+ fault occurred.</p>
+ <p>
+ Own Id: OTP-14522 Aux Id: ERIERL-48 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 7.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>For many releases, it has been legal to override a BIF
+ with a local function having the same name. However,
+ calling a local function with the same name as guard BIF
+ as filter in a list comprehension was not allowed.</p>
+ <p>
+ Own Id: OTP-13690</p>
+ </item>
+ <item>
+ <p>compile:forms/2 would not return the module name as
+ documented when one of the options '<c>from_core</c>',
+ '<c>from_asm</c>', or '<c>from_beam</c>' was given. Also,
+ the compiler would crash if one of those options was
+ combined with '<c>native</c>'.</p>
+ <p>
+ Own Id: OTP-14408 Aux Id: ERL-417 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Optimized test for tuples with an atom as first element.</p>
+ <p>
+ Own Id: OTP-12148</p>
+ </item>
+ <item>
+ <p>
+ Compilation of modules with huge literal binary strings
+ is now much faster.</p>
+ <p>
+ Own Id: OTP-13794</p>
+ </item>
+ <item>
+ <p>Replaced usage of deprecated symbolic <seealso
+ marker="erts:erlang#type-time_unit"><c>time
+ unit</c></seealso> representations.</p>
+ <p>
+ Own Id: OTP-13831 Aux Id: OTP-13735 </p>
+ </item>
+ <item>
+ <p>The undocumented and unsupported module
+ <c>sys_pre_expand</c> has been removed. As a partial
+ replacement for the functionality, there is a new
+ function <c>erl_internal:add_predefined_functions/1</c>
+ and <c>erl_expand_records</c> will now add a module
+ prefix to calls to BIFs and imported functions.</p>
+ <p>
+ Own Id: OTP-13856</p>
+ </item>
+ <item>
+ <p>The internal compiler passes now start all generated
+ variables with "@" to avoid any conflicts with variables
+ in languages such as Elixir or LFE.</p>
+ <p>
+ Own Id: OTP-13924</p>
+ </item>
+ <item>
+ <p>The function <c>fmod/2</c> has been added to the
+ <c>math</c> module.</p>
+ <p>
+ Own Id: OTP-14000</p>
+ </item>
+ <item>
+ <p>Code generation for complicated guards have been
+ improved.</p>
+ <p>
+ Own Id: OTP-14042</p>
+ </item>
+ <item>
+ <p>
+ The compiler has new warnings for repeated identical map
+ keys.</p>
+ <p>
+ A map expression such as,</p>
+ <p>
+ <c> #{'a' => 1, 'b' => 2, 'a' => 3}.</c></p>
+ <p>
+ will produce a warning for the repeated key 'a'.</p>
+ <p>
+ Own Id: OTP-14058</p>
+ </item>
+ <item>
+ <p>By default, there will now be a warning when
+ <c>export_all</c> is used. The warning can be disabled
+ using <c>nowarn_export_all</c>.</p>
+ <p>
+ Own Id: OTP-14071</p>
+ </item>
+ <item>
+ <p>
+ Optimize maps pattern matching by only examining the
+ common keys in each clause first instead of all keys.
+ This will reduce the number of lookups of each key in
+ maps pattern matching.</p>
+ <p>
+ Own Id: OTP-14072</p>
+ </item>
+ <item>
+ <p>There is a new '<c>deterministic</c>' option to omit
+ '<c>source</c>' and '<c>options</c>' tuples in the BEAM
+ file.</p>
+ <p>
+ Own Id: OTP-14087</p>
+ </item>
+ <item>
+ <p>
+ Analyzing modules with binary construction with huge
+ strings is now much faster. The compiler also compiles
+ such modules slightly faster.</p>
+ <p>
+ Own Id: OTP-14125 Aux Id: ERL-308 </p>
+ </item>
+ <item>
+ <p>Atoms may now contain arbitrary Unicode
+ characters.</p>
+ <p>
+ Own Id: OTP-14178</p>
+ </item>
+ <item>
+ <p><c>compile:file/2</c> now accepts the option
+ <c>extra_chunks</c> to include extra chunks in the BEAM
+ file.</p>
+ <p>
+ Own Id: OTP-14221</p>
+ </item>
+ <item>
+ <p>The format of debug information that is stored in BEAM
+ files (when <c>debug_info</c> is used) has been changed.
+ The purpose of the change is to better support other
+ BEAM-based languages such as Elixir or LFE.</p>
+ <p>All tools included in OTP (dialyzer, debugger, cover,
+ and so on) will handle both the new format and the
+ previous format. Tools that retrieve the debug
+ information using <c>beam_lib:chunk(Beam,
+ [abstract_code])</c> will continue to work with both the
+ new and old format. Tools that call
+ <c>beam_lib:chunk(Beam, ["Abst"])</c> will not work with
+ the new format.</p>
+ <p>For more information, see the description of
+ <c>debug_info</c> in the documentation for
+ <c>beam_lib</c> and the description of the
+ <c>{debug_info,{Backend,Data}}</c> option in the
+ documentation for <c>compile</c>.</p>
+ <p>
+ Own Id: OTP-14369 Aux Id: PR-1367 </p>
+ </item>
+ <item>
+ <p>In a future release, <c>erlang:get_stacktrace/0</c>
+ will probably only work when called from within a
+ '<c>try</c>' expression (otherwise it will return
+ <c>[]</c>.</p>
+ <p>To help prepare for that change, the compiler will now
+ by default warn if '<c>get_stacktrace/0</c>' is used in a
+ way that will not work in the future. Note that the
+ warning will not be issued if '<c>get_stacktrace/0</c>'
+ is used in a function that uses neither '<c>catch</c>'
+ nor '<c>try</c>' (because that could be a legal use if
+ the function is called from within a '<c>try</c>'.</p>
+ <p>
+ Own Id: OTP-14401</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Compiler 7.0.4.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -248,6 +951,22 @@
</section>
+
+<section><title>Compiler 6.0.3.1</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fail labels on guard BIFs weren't taken into account
+ during an optimization pass, and a bug in the validation
+ pass sometimes prevented this from being noticed when a
+ fault occurred.</p>
+ <p>
+ Own Id: OTP-14522 Aux Id: ERIERL-48 </p>
+ </item>
+ </list>
+ </section>
+</section>
+
<section><title>Compiler 6.0.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/compiler/doc/src/part_notes.xml b/lib/compiler/doc/src/part_notes.xml
deleted file mode 100644
index c1f0ff3861..0000000000
--- a/lib/compiler/doc/src/part_notes.xml
+++ /dev/null
@@ -1,40 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part xmlns:xi="http://www.w3.org/2001/XInclude">
- <header>
- <copyright>
- <year>2004</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>Compiler Release Notes</title>
- <prepared></prepared>
- <docno></docno>
- <date>2004-09-07</date>
- <rev>1.0</rev>
- </header>
- <description>
- <p>The <em>Compiler</em> application compiles Erlang
- code to byte-code. The highly compact byte-code is executed by
- the Erlang emulator.</p>
- <p>For information about older versions, see
- <url href="part_notes_history_frame.html">Release Notes History</url>.</p>
- </description>
- <xi:include href="notes.xml"/>
-</part>
-
diff --git a/lib/compiler/doc/src/part_notes_history.xml b/lib/compiler/doc/src/part_notes_history.xml
deleted file mode 100644
index 4019676b83..0000000000
--- a/lib/compiler/doc/src/part_notes_history.xml
+++ /dev/null
@@ -1,40 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE part SYSTEM "part.dtd">
-
-<part>
- <header>
- <copyright>
- <year>2006</year>
- <year>2016</year>
- <holder>Ericsson AB, All Rights Reserved</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- The Initial Developer of the Original Code is Ericsson AB.
- </legalnotice>
-
- <title>Compiler Release Notes History</title>
- <prepared></prepared>
- <docno></docno>
- <date></date>
- <rev></rev>
- </header>
- <description>
- <p>The <em>Compiler</em> application compiles Erlang
- code to byte-code. The highly compact byte-code is executed by
- the Erlang emulator.</p>
- </description>
- <include file="notes_history"></include>
-</part>
-
diff --git a/lib/compiler/doc/src/user_guide.gif b/lib/compiler/doc/src/user_guide.gif
deleted file mode 100644
index e6275a803d..0000000000
--- a/lib/compiler/doc/src/user_guide.gif
+++ /dev/null
Binary files differ
diff --git a/lib/compiler/doc/src/warning.gif b/lib/compiler/doc/src/warning.gif
deleted file mode 100644
index 96af52360e..0000000000
--- a/lib/compiler/doc/src/warning.gif
+++ /dev/null
Binary files differ
diff --git a/lib/compiler/internal_doc/cerl-notes.md b/lib/compiler/internal_doc/cerl-notes.md
new file mode 100644
index 0000000000..705fe8f42d
--- /dev/null
+++ b/lib/compiler/internal_doc/cerl-notes.md
@@ -0,0 +1,75 @@
+Some notes on the cerl modules
+==============================
+
+Maps in cerl_clauses:match/3
+----------------------------
+
+Not much optimization is done for maps in `cerl_clauses:match/3`.
+
+The reason is that the inliner (`cerl_inline`) was not designed for
+data types that depend on variables bound in the enclosing environment
+(for example, the keys for maps). If we attempt to extend the
+optimizations for maps similar to the optimizations for the other data
+types, the inliner will crash for certain code. Here is an example of
+code that would crash the inliner:
+
+ t() ->
+ f(key).
+
+ f(K) ->
+ case #{K => value} of
+ #{key := V} -> V
+ end.
+
+The reason for the crash is that the inliner works in several
+passes and calls `cerl_clauses:match/3` twice. The inliner will
+assume that the same result will be returned both times, but
+for this example different bindings will be returned.
+
+Here is the rough outline of what happens:
+
+* The first time `cerl_clauses:match/3` will be asked to match the
+pattern `#{K := V}` against `#{key => value}`. It cannot say more
+than that the pattern *may* match.
+
+* Now the inliner will add the bindings to body of the clause (which
+is simply `V`). In this case, the bindings are still empty, so
+nothing is added.
+
+* The inliner will now do some substitutions and renaming. The
+variable `K` will be replaced with `key`.
+
+* The next time `cerl_clauses:match/3` is called, it will be asked to
+match the pattern `#{key := V}` against `#{key => value#}`. In this
+case, there will be a match and the bindings can be extended with
+`{V,value}`.
+
+* The inliner will see that the entire case can be removed. Only
+the body for the clause needs to be kept.
+
+Thus, after inlining the function `t/0` will look like this:
+
+ t() ->
+ V.
+
+The problem here is that the inliner assumed that the bindings from
+the first and second call to `cer_clauses:match/3` would be the same.
+It used the empty bindings from the first call for the body.
+
+The correct way would be to add the bindings from the second call:
+
+ t() ->
+ let V = value in V.
+
+### How to fix this ###
+
+The inliner will need to call `cerl_clauses:match/3` after doing
+all substitutions and renaming. It is not clear to me how difficult
+that would be. I assume that the inliner is written the way it is
+for a good reason. That means that switching the order things are
+done would lead to correctness and/or performance problems.
+
+### What must also be done to fix this ###
+
+`cerl_inline:make_template/3` must be extended to create a template
+for maps. That is relatively straightforward.
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 518c89d044..2408c76b48 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2016. All Rights Reserved.
+# Copyright Ericsson AB 1996-2018. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -49,7 +49,6 @@ MODULES = \
beam_a \
beam_asm \
beam_block \
- beam_bool \
beam_bs \
beam_bsm \
beam_clean \
@@ -64,6 +63,7 @@ MODULES = \
beam_peep \
beam_receive \
beam_reorder \
+ beam_record \
beam_split \
beam_trim \
beam_type \
@@ -83,25 +83,24 @@ MODULES = \
core_scan \
erl_bifs \
rec_env \
+ sys_core_alias \
+ sys_core_bsm \
sys_core_dsetel \
sys_core_fold \
sys_core_fold_lists \
sys_core_inline \
sys_pre_attributes \
- sys_pre_expand \
v3_codegen \
v3_core \
v3_kernel \
- v3_kernel_pp \
- v3_life
+ v3_kernel_pp
BEAM_H = $(wildcard ../priv/beam_h/*.h)
HRL_FILES= \
beam_disasm.hrl \
core_parse.hrl \
- v3_kernel.hrl \
- v3_life.hrl
+ v3_kernel.hrl
YRL_FILE = core_parse.yrl
@@ -128,7 +127,7 @@ ERL_COMPILE_FLAGS += +native
endif
ERL_COMPILE_FLAGS += +inline +warn_unused_import \
-Werror \
- -I../../stdlib/include -I$(EGEN) -W
+ -I../../stdlib/include -I$(EGEN) -W +warn_missing_spec
# ----------------------------------------------------
# Targets
@@ -186,21 +185,19 @@ release_docs_spec:
# ----------------------------------------------------
$(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl
-$(EBIN)/beam_listing.beam: v3_life.hrl
-$(EBIN)/beam_validator.beam: beam_disasm.hrl
+$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl
$(EBIN)/cerl.beam: core_parse.hrl
$(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl
$(EBIN)/core_lib.beam: core_parse.hrl
$(EBIN)/core_lint.beam: core_parse.hrl
$(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl
$(EBIN)/core_pp.beam: core_parse.hrl
+$(EBIN)/sys_core_alias.beam: core_parse.hrl
$(EBIN)/sys_core_dsetel.beam: core_parse.hrl
$(EBIN)/sys_core_fold.beam: core_parse.hrl
$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl
$(EBIN)/sys_core_inline.beam: core_parse.hrl
-$(EBIN)/sys_pre_expand.beam: ../../stdlib/include/erl_bits.hrl
-$(EBIN)/v3_codegen.beam: v3_life.hrl
+$(EBIN)/v3_codegen.beam: v3_kernel.hrl
$(EBIN)/v3_core.beam: core_parse.hrl
$(EBIN)/v3_kernel.beam: core_parse.hrl v3_kernel.hrl
$(EBIN)/v3_kernel_pp.beam: v3_kernel.hrl
-$(EBIN)/v3_life.beam: v3_kernel.hrl v3_life.hrl
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index 91e6d80da3..6fd4ace540 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -25,6 +25,9 @@
-export([module/2]).
+-spec module(beam_asm:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -39,8 +42,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = beam_jump:remove_unused_labels(Is1),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -56,8 +58,17 @@ rename_instrs([{call_only,A,F}|Is]) ->
rename_instrs([{call_ext_only,A,F}|Is]) ->
[{call_ext,A,F},return|rename_instrs(Is)];
rename_instrs([{'%live',_}|Is]) ->
- %% When compiling from old .S files.
+ %% Ignore old type of live annotation. Only happens when compiling
+ %% from very old .S files.
rename_instrs(Is);
+rename_instrs([{get_list,S,D1,D2}|Is]) ->
+ %% Only happens when compiling from old .S files.
+ if
+ D1 =:= S ->
+ [{get_tl,S,D2},{get_hd,S,D1}|rename_instrs(Is)];
+ true ->
+ [{get_hd,S,D1},{get_tl,S,D2}|rename_instrs(Is)]
+ end;
rename_instrs([I|Is]) ->
[rename_instr(I)|rename_instrs(Is)];
rename_instrs([]) -> [].
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index f6ca7a0afb..df0321e85a 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,20 +24,51 @@
-export([module/4]).
-export([encode/2]).
+-export_type([fail/0,label/0,reg/0,reg_num/0,src/0,module_code/0,function_name/0]).
+
-import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]).
-include("beam_opcodes.hrl").
-module(Code, Abst, SourceFile, Opts) ->
- {ok,assemble(Code, Abst, SourceFile, Opts)}.
+%% Common types for describing operands for BEAM instructions.
+-type reg_num() :: 0..1023.
+-type reg() :: {'x',reg_num()} | {'y',reg_num()}.
+-type src() :: reg() |
+ {'literal',term()} |
+ {'atom',atom()} |
+ {'integer',integer()} |
+ 'nil' |
+ {'float',float()}.
+-type label() :: pos_integer().
+-type fail() :: {'f',label() | 0}.
+
+%% asm_instruction() describes only the instructions that
+%% are used in BEAM files (as opposed to internal instructions
+%% used only during optimization).
+
+-type asm_instruction() :: atom() | tuple().
+
+-type function_name() :: atom().
+
+-type asm_function() ::
+ {'function',function_name(),arity(),label(),[asm_instruction()]}.
+
+-type module_code() ::
+ {module(),[_],[_],[asm_function()],pos_integer()}.
+
+-spec module(module_code(), [{binary(), binary()}], [{atom(),term()}], [compile:option()]) ->
+ {'ok',binary()}.
+
+module(Code, ExtraChunks, CompileInfo, CompilerOpts) ->
+ {ok,assemble(Code, ExtraChunks, CompileInfo, CompilerOpts)}.
-assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) ->
+assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) ->
{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),
Exp = cerl_sets:from_list(Exp0),
{Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
- build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts).
+ build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts).
on_load(Fs0, Attr0) ->
case proplists:get_value(on_load, Attr0) of
@@ -80,7 +111,7 @@ assemble_function([H|T], Acc, Dict0) ->
assemble_function([], Code, Dict) ->
{Code, Dict}.
-build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
+build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts) ->
%% Create the code chunk.
CodeChunk = chunk(<<"Code">>,
@@ -92,9 +123,9 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
Code),
%% Create the atom table chunk.
-
- {NumAtoms, AtomTab} = beam_dict:atom_table(Dict),
- AtomChunk = chunk(<<"Atom">>, <<NumAtoms:32>>, AtomTab),
+ AtomEncoding = atom_encoding(CompilerOpts),
+ {NumAtoms, AtomTab} = beam_dict:atom_table(Dict, AtomEncoding),
+ AtomChunk = chunk(atom_chunk_name(AtomEncoding), <<NumAtoms:32>>, AtomTab),
%% Create the import table chunk.
@@ -151,25 +182,34 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) ->
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),
+ {Attributes,Compile} = build_attributes(Attr, CompileInfo, MD5),
AttrChunk = chunk(<<"Attr">>, Attributes),
CompileChunk = chunk(<<"CInf">>, Compile),
- %% Create the abstract code chunk.
+ %% Compile all extra chunks.
- AbstChunk = chunk(<<"Abst">>, Abst),
+ CheckedChunks = [chunk(Key, Value) || {Key, Value} <- ExtraChunks],
%% Create IFF chunk.
- Chunks = case member(slim, Opts) of
+ Chunks = case member(slim, CompilerOpts) of
true ->
- [Essentials,AttrChunk,AbstChunk];
+ [Essentials,AttrChunk];
false ->
[Essentials,LocChunk,AttrChunk,
- CompileChunk,AbstChunk,LineChunk]
+ CompileChunk,CheckedChunks,LineChunk]
end,
build_form(<<"BEAM">>, Chunks).
+atom_encoding(Opts) ->
+ case proplists:get_bool(no_utf8_atoms, Opts) of
+ false -> utf8;
+ true -> latin1
+ end.
+
+atom_chunk_name(utf8) -> <<"AtU8">>;
+atom_chunk_name(latin1) -> <<"Atom">>.
+
%% 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
@@ -200,9 +240,7 @@ build_form(Id, Chunks0) when byte_size(Id) =:= 4, is_list(Chunks0) ->
chunk(Id, Contents) when byte_size(Id) =:= 4, is_binary(Contents) ->
Size = byte_size(Contents),
- [<<Id/binary,Size:32>>,Contents|pad(Size)];
-chunk(Id, Contents) when is_list(Contents) ->
- chunk(Id, list_to_binary(Contents)).
+ [<<Id/binary,Size:32>>,Contents|pad(Size)].
%% Build a correctly padded chunk (with a sub-header).
@@ -224,17 +262,10 @@ 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, MD5) ->
- Misc0 = case SourceFile of
- [] -> [];
- [_|_] -> [{source,SourceFile}]
- end,
- Misc = case member(slim, Opts) of
- false -> Misc0;
- true -> []
- end,
- Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc],
- {term_to_binary(set_vsn_attribute(Attr, MD5)),term_to_binary(Compile)}.
+build_attributes(Attr, Compile, MD5) ->
+ AttrBinary = term_to_binary(set_vsn_attribute(Attr, MD5)),
+ CompileBinary = term_to_binary([{version,?COMPILER_VSN}|Compile]),
+ {AttrBinary,CompileBinary}.
build_line_table(Dict) ->
{NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} =
@@ -376,7 +407,17 @@ encode_arg({atom, Atom}, Dict0) when is_atom(Atom) ->
{Index, Dict} = beam_dict:atom(Atom, Dict0),
{encode(?tag_a, Index), Dict};
encode_arg({integer, N}, Dict) ->
- {encode(?tag_i, N), Dict};
+ %% Conservatily assume that all integers whose absolute
+ %% value is greater than 1 bsl 128 will be bignums in
+ %% the runtime system.
+ if
+ N >= 1 bsl 128 ->
+ encode_arg({literal, N}, Dict);
+ N =< -(1 bsl 128) ->
+ encode_arg({literal, N}, Dict);
+ true ->
+ {encode(?tag_i, N), Dict}
+ end;
encode_arg(nil, Dict) ->
{encode(?tag_a, 0), Dict};
encode_arg({f, W}, Dict) ->
@@ -434,6 +475,8 @@ encode_alloc_list_1([{floats,Floats}|T], Dict, Acc0) ->
encode_alloc_list_1([], Dict, Acc) ->
{iolist_to_binary(Acc),Dict}.
+-spec encode(non_neg_integer(), integer()) -> iolist() | integer().
+
encode(Tag, N) when N < 0 ->
encode1(Tag, negative_to_bytes(N));
encode(Tag, N) when N < 16 ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 6a35191f6e..fe43163455 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,27 +23,36 @@
-module(beam_block).
-export([module/2]).
--import(lists, [reverse/1,reverse/2,foldl/3,member/2]).
+-import(lists, [reverse/1,reverse/2,member/2]).
-module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
- Fs = [function(F) || F <- Fs0],
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
+module({Mod,Exp,Attr,Fs0,Lc}, Opts) ->
+ Blockify = not member(no_blockify, Opts),
+ Fs = [function(F, Blockify) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
-function({function,Name,Arity,CLabel,Is0}) ->
+function({function,Name,Arity,CLabel,Is0}, Blockify) ->
try
%% Collect basic blocks and optimize them.
- Is1 = blockify(Is0),
- Is2 = embed_lines(Is1),
- Is3 = move_allocates(Is2),
- Is4 = beam_utils:live_opt(Is3),
- Is5 = opt_blocks(Is4),
- Is6 = beam_utils:delete_live_annos(Is5),
-
- %% Done.
- {function,Name,Arity,CLabel,Is6}
+ Is1 = case Blockify of
+ false -> Is0;
+ true -> blockify(Is0)
+ end,
+ Is2 = embed_lines(Is1),
+ Is3 = local_cse(Is2),
+ Is4 = beam_utils:anno_defs(Is3),
+ Is5 = move_allocates(Is4),
+ Is6 = beam_utils:live_opt(Is5),
+ Is7 = opt_blocks(Is6),
+ Is8 = beam_utils:delete_annos(Is7),
+ Is = opt_allocs(Is8),
+
+ %% Done.
+ {function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -99,7 +108,8 @@ collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}};
collect({put,S}) -> {set,[],[S],put};
collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}};
collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}};
-collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list};
+collect({get_hd,S,D}) -> {set,[D],[S],get_hd};
+collect({get_tl,S,D}) -> {set,[D],[S],get_tl};
collect(remove_message) -> {set,[],[],remove_message};
collect({put_map,F,Op,S,D,R,{list,Puts}}) ->
{set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}};
@@ -127,23 +137,27 @@ embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) ->
embed_lines([{block,B1},{line,_}=Line|T], Acc) ->
B = {block,[{set,[],[],Line}|B1]},
embed_lines([B|T], Acc);
+embed_lines([{block,B2},{block,B1}|T], Acc) ->
+ %% This can only happen when beam_block is run for
+ %% the second time.
+ B = {block,B1++B2},
+ 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,
+ [{'%anno',_}|Bl] = Bl0,
[{block,opt_block(Bl)}|opt_blocks(Is)];
opt_blocks([I|Is]) ->
[I|opt_blocks(Is)];
opt_blocks([]) -> [].
opt_block(Is0) ->
- Is = find_fixpoint(fun(Is) ->
- opt_tuple_element(opt(Is))
- end, Is0),
- opt_alloc(Is).
+ find_fixpoint(fun(Is) ->
+ opt_tuple_element(opt(Is))
+ end, Is0).
find_fixpoint(OptFun, Is0) ->
case OptFun(Is0) of
@@ -170,7 +184,7 @@ find_fixpoint(OptFun, Is0) ->
%% safe to assume that if x(N) is initialized, then all lower-numbered
%% x registers are also initialized.
%%
-%% For example, in general it is not safe to transform the following
+%% For example, we must be careful when transforming the following
%% instructions:
%%
%% get_tuple_element x(0) Element => x(1)
@@ -182,13 +196,9 @@ find_fixpoint(OptFun, Is0) ->
%% get_tuple_element x(0) Element => x(1)
%%
%% The transformation is safe if and only if x(1) has been
-%% initialized previously. Unfortunately, beam_reorder may have moved
-%% a get_tuple_element instruction so that x(1) is not always
-%% initialized when this code is reached. To find whether or not x(1)
-%% is initialized, we would need to analyze all code preceding these
-%% two instructions (across branches). Since we currently don't have
-%% any practical mechanism for doing that, we will have to
-%% conservatively assume that the transformation is unsafe.
+%% initialized previously. We will use the annotations added by
+%% beam_utils:anno_defs/1 to determine whether x(a) has been
+%% initialized.
move_allocates([{block,Bl0}|Is]) ->
Bl = move_allocates_1(reverse(Bl0), []),
@@ -197,40 +207,77 @@ move_allocates([I|Is]) ->
[I|move_allocates(Is)];
move_allocates([]) -> [].
-move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info}}|Acc]=Acc0) ->
- case {alloc_may_pass(I),alloc_live_regs(I, Live0)} of
- {false,_} ->
- move_allocates_1(Is, [I|Acc0]);
- {true,not_possible} ->
- move_allocates_1(Is, [I|Acc0]);
- {true,Live} when is_integer(Live) ->
- A = {set,[],[],{alloc,Live,Info}},
- move_allocates_1(Is, [A,I|Acc])
+move_allocates_1([{'%anno',_}|Is], Acc) ->
+ move_allocates_1(Is, Acc);
+move_allocates_1([I|Is], [{set,[],[],{alloc,Live0,Info0}}|Acc]=Acc0) ->
+ case alloc_may_pass(I) of
+ false ->
+ move_allocates_1(Is, [I|Acc0]);
+ true ->
+ case alloc_live_regs(I, Is, Live0) of
+ not_possible ->
+ move_allocates_1(Is, [I|Acc0]);
+ Live when is_integer(Live) ->
+ Info = safe_info(Info0),
+ A = {set,[],[],{alloc,Live,Info}},
+ move_allocates_1(Is, [A,I|Acc])
+ end
end;
move_allocates_1([I|Is], Acc) ->
move_allocates_1(Is, [I|Acc]);
move_allocates_1([], Acc) -> Acc.
+alloc_may_pass({set,_,[{fr,_}],fmove}) -> false;
alloc_may_pass({set,_,_,{alloc,_,_}}) -> false;
alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false;
alloc_may_pass({set,_,_,put_list}) -> false;
alloc_may_pass({set,_,_,put}) -> false;
alloc_may_pass({set,_,_,_}) -> true.
-
+
+safe_info({nozero,Stack,Heap,_}) ->
+ %% nozero is not safe if the allocation instruction is moved
+ %% upwards past an instruction that may throw an exception
+ %% (such as element/2).
+ {zero,Stack,Heap,[]};
+safe_info(Info) -> Info.
+
%% opt([Instruction]) -> [Instruction]
%% Optimize the instruction stream inside a basic block.
opt([{set,[X],[X],move}|Is]) -> opt(Is);
+opt([{set,[Dst],_,move},{set,[Dst],[Src],move}=I|Is]) when Dst =/= Src ->
+ opt([I|Is]);
+opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[{x,0}],move}|Is]) ->
+ opt([I1,{set,[D2],[S1],move}|Is]);
+opt([{set,[{x,0}],[S1],move}=I1,{set,[D2],[S2],move}|Is0]) when S1 =/= D2 ->
+ %% Place move S x0 at the end of move sequences so that
+ %% loader can merge with the following instruction
+ {Ds,Is} = opt_moves([D2], Is0),
+ [{set,Ds,[S2],move}|opt([I1|Is])];
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([Line2,I2,Line1,I1|Is]);
+opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,L}}}=I1,
+ {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,L}}}=I2|Is])
+ when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg ->
+ opt([I2,I1|Is]);
+opt([{set,Hd0,Cons,get_hd}=GetHd,
+ {set,Tl0,Cons,get_tl}=GetTl|Is0]) ->
+ case {opt_moves(Hd0, [GetTl|Is0]),opt_moves(Tl0, [GetHd|Is0])} of
+ {{Hd0,Is},{Tl0,_}} ->
+ [GetHd|opt(Is)];
+ {{Hd,Is},{Tl0,_}} ->
+ [{set,Hd,Cons,get_hd}|opt(Is)];
+ {{_,_},{Tl,Is}} ->
+ [{set,Tl,Cons,get_tl}|opt(Is)]
+ end;
opt([{set,Ds0,Ss,Op}|Is0]) ->
{Ds,Is} = opt_moves(Ds0, Is0),
[{set,Ds,Ss,Op}|opt(Is)];
-opt([{'%live',_,_}=I|Is]) ->
+opt([{'%anno',_}=I|Is]) ->
[I|opt(Is)];
opt([]) -> [].
@@ -242,17 +289,6 @@ opt_moves([D0]=Ds, Is0) ->
case opt_move(D0, Is0) of
not_possible -> {Ds,Is0};
{D1,Is} -> {[D1],Is}
- end;
-opt_moves([X0,Y0], Is0) ->
- {X,Is2} = case opt_move(X0, Is0) of
- not_possible -> {X0,Is0};
- {Y0,_} -> {X0,Is0};
- {_X1,_Is1} = XIs1 -> XIs1
- end,
- case opt_move(Y0, Is2) of
- not_possible -> {[X,Y0],Is2};
- {X,_} -> {[X,Y0],Is2};
- {Y,Is} -> {[X,Y],Is}
end.
%% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible
@@ -266,7 +302,7 @@ opt_move(Dest, Is) ->
opt_move_1(R, [{set,[D],[R],move}|Is0], Acc) ->
%% Provided that the source register is killed by instructions
%% that follow, the optimization is safe.
- case eliminate_use_of_from_reg(Is0, R, D, []) of
+ case eliminate_use_of_from_reg(Is0, R, D) of
{yes,Is} -> opt_move_rev(D, Acc, Is);
no -> not_possible
end;
@@ -324,13 +360,21 @@ opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) ->
opt_tuple_element_1([{set,_,_,{try_catch,_,_}}|_], _, _, _) ->
no;
opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) ->
- case eliminate_use_of_from_reg(Is0, S, D, []) of
+ case eliminate_use_of_from_reg(Is0, S, D) of
no ->
no;
- {yes,Is} ->
+ {yes,Is1} ->
{set,[S],Ss,Op} = I0,
I = {set,[D],Ss,Op},
- {yes,reverse(Acc, [I|Is])}
+ case opt_move_rev(S, Acc, [I|Is1]) of
+ not_possible ->
+ %% Not safe because the move of the
+ %% get_tuple_element instruction would cause the
+ %% result of a previous instruction to be ignored.
+ no;
+ {_,Is} ->
+ {yes,Is}
+ end
end;
opt_tuple_element_1([{set,Ds,Ss,_}=I|Is], MovedI, {S,D}=Regs, Acc) ->
case member(S, Ds) orelse member(D, Ss) of
@@ -366,6 +410,14 @@ is_killed_or_used(R, {set,Ss,Ds,_}) ->
%% that FromRegister is still used and that the optimization is not
%% possible.
+eliminate_use_of_from_reg(Is, From, To) ->
+ try
+ eliminate_use_of_from_reg(Is, From, To, [])
+ catch
+ throw:not_possible ->
+ no
+ end.
+
eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) ->
if
X < Live ->
@@ -374,21 +426,32 @@ eliminate_use_of_from_reg([{set,_,_,{alloc,Live,_}}|_]=Is0, {x,X}, _, Acc) ->
{yes,reverse(Acc, Is0)}
end;
eliminate_use_of_from_reg([{set,Ds,Ss0,Op}=I0|Is], From, To, Acc) ->
+ ensure_safe_tuple(I0, To),
I = case member(From, Ss0) of
- true ->
- Ss = [case S of
- From -> To;
- _ -> S
- end || S <- Ss0],
- {set,Ds,Ss,Op};
- false ->
- I0
- end,
+ true ->
+ Ss = [case S of
+ From -> To;
+ _ -> S
+ end || S <- Ss0],
+ {set,Ds,Ss,Op};
+ false ->
+ I0
+ end,
case member(From, Ds) of
- true ->
- {yes,reverse(Acc, [I|Is])};
- false ->
- eliminate_use_of_from_reg(Is, From, To, [I|Acc])
+ true ->
+ {yes,reverse(Acc, [I|Is])};
+ false ->
+ case member(To, Ds) of
+ true ->
+ case beam_utils:is_killed_block(From, Is) of
+ true ->
+ {yes,reverse(Acc, [I|Is])};
+ false ->
+ no
+ end;
+ false ->
+ eliminate_use_of_from_reg(Is, From, To, [I|Acc])
+ end
end;
eliminate_use_of_from_reg([I]=Is, From, _To, Acc) ->
case beam_utils:is_killed_block(From, [I]) of
@@ -398,31 +461,51 @@ eliminate_use_of_from_reg([I]=Is, From, _To, Acc) ->
no
end.
+ensure_safe_tuple({set,[To],[],{put_tuple,_}}, To) ->
+ throw(not_possible);
+ensure_safe_tuple(_, _) -> ok.
+
+%% opt_allocs(Instructions) -> Instructions. Optimize allocate
+%% instructions inside blocks. If safe, replace an allocate_zero
+%% instruction with the slightly cheaper allocate instruction.
+
+opt_allocs(Is) ->
+ D = beam_utils:index_labels(Is),
+ opt_allocs_1(Is, D).
+
+opt_allocs_1([{block,Bl0}|Is], D) ->
+ Bl = opt_alloc(Bl0, {D,Is}),
+ [{block,Bl}|opt_allocs_1(Is, D)];
+opt_allocs_1([I|Is], D) ->
+ [I|opt_allocs_1(Is, D)];
+opt_allocs_1([], _) -> [].
+
%% opt_alloc(Instructions) -> Instructions'
%% Optimises all allocate instructions.
opt_alloc([{set,[],[],{alloc,Live0,Info0}},
- {set,[],[],{alloc,Live,Info}}|Is]) ->
+ {set,[],[],{alloc,Live,Info}}|Is], D) ->
Live = Live0, %Assertion.
Alloc = combine_alloc(Info0, Info),
I = {set,[],[],{alloc,Live,Alloc}},
- opt_alloc([I|Is]);
-opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is]) ->
- [{set,[],[],opt_alloc(Is, Ns, Nh, R)}|Is];
-opt_alloc([I|Is]) -> [I|opt_alloc(Is)];
-opt_alloc([]) -> [].
+ opt_alloc([I|Is], D);
+opt_alloc([{set,[],[],{alloc,R,{_,Ns,Nh,[]}}}|Is], D) ->
+ [{set,[],[],opt_alloc(Is, D, Ns, Nh, R)}|Is];
+opt_alloc([I|Is], D) -> [I|opt_alloc(Is, D)];
+opt_alloc([], _) -> [].
combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) ->
{zero,Ns,beam_utils:combine_heap_needs(Nh1, Nh2),Init}.
-
+
%% opt_alloc(Instructions, FrameSize, HeapNeed, LivingRegs) -> [Instr]
%% Generates the optimal sequence of instructions for
%% allocating and initalizing the stack frame and needed heap.
-opt_alloc(_Is, nostack, Nh, LivingRegs) ->
+opt_alloc(_Is, _D, nostack, Nh, LivingRegs) ->
{alloc,LivingRegs,{nozero,nostack,Nh,[]}};
-opt_alloc(Is, Ns, Nh, LivingRegs) ->
- InitRegs = init_yreg(Is, 0),
+opt_alloc(Bl, {D,OuterIs}, Ns, Nh, LivingRegs) ->
+ Is = [{block,Bl}|OuterIs],
+ InitRegs = init_yregs(Ns, Is, D),
case count_ones(InitRegs) of
N when N*2 > Ns ->
{alloc,LivingRegs,{nozero,Ns,Nh,gen_init(Ns, InitRegs)}};
@@ -438,19 +521,14 @@ gen_init(Fs, Regs, Y, Acc) when Regs band 1 =:= 0 ->
gen_init(Fs, Regs, Y, Acc) ->
gen_init(Fs, Regs bsr 1, Y+1, Acc).
-%% init_yreg(Instructions, RegSet) -> RegSetInitialized
-%% Calculate the set of initialized y registers.
-
-init_yreg([{set,_,_,{bif,_,_}}|_], Reg) -> Reg;
-init_yreg([{set,_,_,{alloc,_,{gc_bif,_,_}}}|_], Reg) -> Reg;
-init_yreg([{set,_,_,{alloc,_,{put_map,_,_}}}|_], Reg) -> Reg;
-init_yreg([{set,Ds,_,_}|Is], Reg) -> init_yreg(Is, add_yregs(Ds, Reg));
-init_yreg(_Is, Reg) -> Reg.
-
-add_yregs(Ys, Reg) -> foldl(fun(Y, R0) -> add_yreg(Y, R0) end, Reg, Ys).
-
-add_yreg({y,Y}, Reg) -> Reg bor (1 bsl Y);
-add_yreg(_, Reg) -> Reg.
+init_yregs(Y, Is, D) when Y >= 0 ->
+ case beam_utils:is_killed({y,Y}, Is, D) of
+ true ->
+ (1 bsl Y) bor init_yregs(Y-1, Is, D);
+ false ->
+ init_yregs(Y-1, Is, D)
+ end;
+init_yregs(_, _, _) -> 0.
count_ones(Bits) -> count_ones(Bits, 0).
count_ones(0, Acc) -> Acc;
@@ -460,16 +538,34 @@ count_ones(Bits, Acc) ->
%% Calculate the new number of live registers when we move an allocate
%% instruction upwards, passing a 'set' instruction.
-alloc_live_regs({set,Ds,Ss,_}, Regs0) ->
+alloc_live_regs({set,Ds,Ss,_}, Is, Regs0) ->
Rset = x_live(Ss, x_dead(Ds, (1 bsl Regs0)-1)),
- live_regs(0, Rset).
+ Live = live_regs(0, Rset),
+ case ensure_contiguous(Rset, Live) of
+ not_possible ->
+ %% Liveness information (looking forward in the
+ %% instruction stream) can't prove that moving this
+ %% allocation instruction is safe. Now use the annotation
+ %% of defined registers at the beginning of the current
+ %% block to see whether moving would be safe.
+ Def0 = defined_regs(Is, 0),
+ Def = Def0 band ((1 bsl Live) - 1),
+ ensure_contiguous(Rset bor Def, Live);
+ Live ->
+ %% Safe based on liveness information.
+ Live
+ end.
live_regs(N, 0) ->
N;
-live_regs(N, Regs) when Regs band 1 =:= 1 ->
- live_regs(N+1, Regs bsr 1);
-live_regs(_, _) ->
- not_possible.
+live_regs(N, Regs) ->
+ live_regs(N+1, Regs bsr 1).
+
+ensure_contiguous(Regs, Live) ->
+ case (1 bsl Live) - 1 of
+ Regs -> Live;
+ _ -> not_possible
+ end.
x_dead([{x,N}|Rs], Regs) -> x_dead(Rs, Regs band (bnot (1 bsl N)));
x_dead([_|Rs], Regs) -> x_dead(Rs, Regs);
@@ -478,3 +574,120 @@ x_dead([], Regs) -> Regs.
x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N));
x_live([_|Rs], Regs) -> x_live(Rs, Regs);
x_live([], Regs) -> Regs.
+
+%% defined_regs(ReversedInstructions) -> RegBitmap.
+%% Given a reversed instruction stream, determine the
+%% the registers that are defined.
+
+defined_regs([{'%anno',{def,Def}}|_], Regs) ->
+ Def bor Regs;
+defined_regs([{set,Ds,_,{alloc,Live,_}}|_], Regs) ->
+ x_live(Ds, Regs bor ((1 bsl Live) - 1));
+defined_regs([{set,Ds,_,_}|Is], Regs) ->
+ defined_regs(Is, x_live(Ds, Regs)).
+
+%%%
+%%% Do local common sub expression elimination (CSE) in each block.
+%%%
+
+local_cse([{block,Bl0}|Is]) ->
+ Bl = cse_block(Bl0, orddict:new(), []),
+ [{block,Bl}|local_cse(Is)];
+local_cse([I|Is]) ->
+ [I|local_cse(Is)];
+local_cse([]) -> [].
+
+cse_block([I|Is], Es0, Acc0) ->
+ Es1 = cse_clear(I, Es0),
+ case cse_expr(I) of
+ none ->
+ %% Instruction is not suitable for CSE.
+ cse_block(Is, Es1, [I|Acc0]);
+ {ok,D,Expr} ->
+ %% Suitable instruction. First update the dictionary of
+ %% suitable expressions for the next iteration.
+ Es = cse_add(D, Expr, Es1),
+
+ %% Search for a previous identical expression.
+ case cse_find(Expr, Es0) of
+ error ->
+ %% Nothing found
+ cse_block(Is, Es, [I|Acc0]);
+ Src ->
+ %% Use the previously calculated result.
+ %% Also eliminate any line instruction.
+ Move = {set,[D],[Src],move},
+ case Acc0 of
+ [{set,_,_,{line,_}}|Acc] ->
+ cse_block(Is, Es, [Move|Acc]);
+ [_|_] ->
+ cse_block(Is, Es, [Move|Acc0])
+ end
+ end
+ end;
+cse_block([], _, Acc) ->
+ reverse(Acc).
+
+%% cse_find(Expr, Expressions) -> error | Register.
+%% Find a previously evaluated expression whose result can be reused,
+%% or return 'error' if no such expression is found.
+
+cse_find(Expr, Es) ->
+ case orddict:find(Expr, Es) of
+ {ok,{Src,_}} -> Src;
+ error -> error
+ end.
+
+cse_expr({set,[D],Ss,{bif,N,_}}) ->
+ case D of
+ {fr,_} ->
+ %% There are too many things that can go wrong.
+ none;
+ _ ->
+ {ok,D,{{bif,N},Ss}}
+ end;
+cse_expr({set,[D],Ss,{alloc,_,{gc_bif,N,_}}}) ->
+ {ok,D,{{gc_bif,N},Ss}};
+cse_expr({set,[D],Ss,put_list}) ->
+ {ok,D,{put_list,Ss}};
+cse_expr(_) -> none.
+
+%% cse_clear(Instr, Expressions0) -> Expressions.
+%% Remove all previous expressions that will become
+%% invalid when this instruction is executed. Basically,
+%% an expression is no longer safe to reuse when the
+%% register it has been stored to has been modified, killed,
+%% or if any of the source operands have changed.
+
+cse_clear({set,Ds,_,{alloc,Live,_}}, Es) ->
+ cse_clear_1(Es, Live, Ds);
+cse_clear({set,Ds,_,_}, Es) ->
+ cse_clear_1(Es, all, Ds).
+
+cse_clear_1(Es, Live, Ds0) ->
+ Ds = ordsets:from_list(Ds0),
+ [E || E <- Es, cse_is_safe(E, Live, Ds)].
+
+cse_is_safe({_,{Dst,Interfering}}, Live, Ds) ->
+ ordsets:is_disjoint(Interfering, Ds) andalso
+ case Dst of
+ {x,X} ->
+ X < Live;
+ _ ->
+ true
+ end.
+
+%% cse_add(Dest, Expr, Expressions0) -> Expressions.
+%% Provided that it is safe, add a new expression to the dictionary
+%% of already evaluated expressions.
+
+cse_add(D, {_,Ss}=Expr, Es) ->
+ case member(D, Ss) of
+ false ->
+ Interfering = ordsets:from_list([D|Ss]),
+ orddict:store(Expr, {D,Interfering}, Es);
+ true ->
+ %% Unsafe because the instruction overwrites one of
+ %% source operands.
+ Es
+ end.
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
deleted file mode 100644
index 99e4ccb1e9..0000000000
--- a/lib/compiler/src/beam_bool.erl
+++ /dev/null
@@ -1,765 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% Purpose: Optimizes booleans in guards.
-
--module(beam_bool).
-
--export([module/2]).
-
--import(lists, [reverse/1,reverse/2,foldl/3,mapfoldl/3,map/2]).
-
--record(st,
- {next, %Next label number.
- ll %Live regs at labels.
- }).
-
-module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
- %%io:format("~p:\n", [Mod]),
- {Fs,_} = mapfoldl(fun(Fn, Lbl) -> function(Fn, Lbl) end, 100000000, Fs0),
- {ok,{Mod,Exp,Attr,Fs,Lc}}.
-
-function({function,Name,Arity,CLabel,Is0}, Lbl0) ->
- try
- {Is,#st{next=Lbl}} = bool_opt(Is0, Lbl0),
- {{function,Name,Arity,CLabel,Is},Lbl}
- catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
- io:fwrite("Function: ~w/~w\n", [Name,Arity]),
- erlang:raise(Class, Error, Stack)
- end.
-
-%%
-%% Optimize boolean expressions that use guard bifs. Rewrite to
-%% use test instructions if possible.
-%%
-
-bool_opt(Asm, Lbl) ->
- LiveInfo = beam_utils:index_labels(Asm),
- bopt(Asm, [], #st{next=Lbl,ll=LiveInfo}).
-
-bopt([{block,Bl0}=Block|
- [{jump,{f,Succ}},
- {label,Fail},
- {block,[{set,[Dst],[{atom,false}],move}]},
- {label,Succ}|Is]=Is0], Acc0, St) ->
- case split_block(Bl0, Dst, Fail, Acc0, true) of
- failed ->
- bopt(Is0, [Block|Acc0], St);
- {Bl,PreBlock} ->
- Acc1 = case PreBlock of
- [] -> Acc0;
- _ -> [{block,PreBlock}|Acc0]
- end,
- Acc = [{protected,[Dst],Bl,{Fail,Succ}}|Acc1],
- bopt(Is, Acc, St)
- end;
-bopt([{test,is_eq_exact,{f,Fail},[Reg,{atom,true}]}=I|Is], [{block,_}|_]=Acc0, St0) ->
- case bopt_block(Reg, Fail, Is, Acc0, St0) of
- failed -> bopt(Is, [I|Acc0], St0);
- {Acc,St} -> bopt(Is, Acc, St)
- end;
-bopt([I|Is], Acc, St) ->
- bopt(Is, [I|Acc], St);
-bopt([], Acc, St) ->
- {bopt_reverse(Acc, []),St}.
-
-bopt_reverse([{protected,[Dst],Block,{Fail,Succ}}|Is], Acc0) ->
- Acc = [{block,Block},{jump,{f,Succ}},
- {label,Fail},
- {block,[{set,[Dst],[{atom,false}],move}]},
- {label,Succ}|Acc0],
- bopt_reverse(Is, Acc);
-bopt_reverse([I|Is], Acc) ->
- bopt_reverse(Is, [I|Acc]);
-bopt_reverse([], Acc) -> Acc.
-
-%% bopt_block(Reg, Fail, OldIs, Accumulator, St) -> failed | {NewAcc,St}
-%% Attempt to optimized a block of guard BIFs followed by a test
-%% instruction.
-bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) ->
- case split_block(Bl0, Reg, Fail, Acc0, false) of
- failed ->
- %% Reason for failure: The block either contained no
- %% guard BIFs with the failure label Fail, or the final
- %% instruction in the block did not assign the Reg register.
-
- %%io:format("split ~p: ~P\n", [Reg,Bl0,20]),
- failed;
- {Bl1,BlPre} ->
- %% The block has been splitted. Bl1 is a non-empty list
- %% of guard BIF instructions having the failure label Fail.
- %% BlPre is a (possibly empty list) of instructions preceeding
- %% Bl1.
- Acc1 = make_block(BlPre, Acc0),
- {Bl,Acc} = extend_block(Bl1, Fail, Acc1),
- try
- {NewCode,St} = bopt_tree_cg(Bl, Fail, St0),
- ensure_opt_safe(Bl, NewCode, OldIs, Fail, Acc, St),
- {NewCode++Acc,St}
- catch
- %% Not possible to rewrite because a boolean value is
- %% passed to another guard bif, e.g. 'abs(A > B)'
- %% (in this case, obviously nonsense code). Rare in
- %% practice.
- throw:mixed ->
- failed;
-
- %% There was a reference to a boolean expression
- %% from inside a protected block (try/catch), to
- %% a boolean expression outside.
- throw:protected_barrier ->
- failed;
-
- %% The 'xor' operator was used. We currently don't
- %% find it worthwile to translate 'xor' operators
- %% (the code would be clumsy).
- throw:'xor' ->
- failed;
-
- %% The block does not contain a boolean expression,
- %% but only a call to a guard BIF.
- %% For instance: ... when element(1, T) ->
- throw:not_boolean_expr ->
- failed;
-
- %% The optimization is not safe. (A register
- %% used by the instructions following the
- %% optimized code is either not assigned a
- %% value at all or assigned a different value.)
- throw:all_registers_not_killed ->
- failed;
- throw:registers_used ->
- failed;
-
- %% A protected block refered to the value
- %% returned by another protected block,
- %% probably because the Core Erlang code
- %% used nested try/catches in the guard.
- %% (v3_core never produces nested try/catches
- %% in guards, so it must have been another
- %% Core Erlang translator.)
- throw:protected_violation ->
- failed;
-
- %% Failed to work out the live registers for a GC
- %% BIF. For example, if the number of live registers
- %% needed to be 4 because {x,3} was a source register,
- %% but {x,2} was not known to be initialized, this
- %% exception would be thrown.
- throw:gc_bif_alloc_failure ->
- failed
-
- end
- end.
-
-%% ensure_opt_safe(OriginalCode, OptCode, FollowingCode, Fail,
-%% ReversedPrecedingCode, State) -> ok
-%% Comparing the original code to the optimized code, determine
-%% whether the optimized code is guaranteed to work in the same
-%% way as the original code.
-%%
-%% Throw an exception if the optimization is not safe.
-%%
-ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) ->
- %% Here are the conditions that must be true for the
- %% optimization to be safe.
- %%
- %% 1. If a register is INITIALIZED by PrecedingCode,
- %% then if that register assigned a value in the original
- %% code, but not in the optimized code, it must be UNUSED or KILLED
- %% in the code that follows.
- %%
- %% 2. If a register is not known to be INITIALIZED by PreccedingCode,
- %% then if that register assigned a value in the original
- %% code, but not in the optimized code, it must be KILLED
- %% by the code that follows.
- %%
- %% 3. Any register that is assigned a value in the optimized
- %% code must be UNUSED or KILLED in the following code,
- %% unless we can be sure that it is always assigned the same
- %% value.
-
- InitInPreceding = initialized_regs(PrecedingCode),
-
- PrevDst = dst_regs(Bl),
- NewDst = dst_regs(NewCode),
- NotSet = ordsets:subtract(PrevDst, NewDst),
- MustBeKilled = ordsets:subtract(NotSet, InitInPreceding),
-
- case all_killed(MustBeKilled, OldIs, Fail, St) of
- false -> throw(all_registers_not_killed);
- true -> ok
- end,
- MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst),
- MustBeKilled),
- case none_used(MustBeUnused, OldIs, Fail, St) of
- false -> throw(registers_used);
- true -> ok
- end,
- ok.
-
-update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) ->
- update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]);
-update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) ->
- update_fail_label(Is, Fail,
- [{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,Fail}}}}|Acc]);
-update_fail_label([], _, Acc) -> reverse(Acc).
-
-make_block(Bl) ->
- make_block(Bl, []).
-
-make_block([], Acc) -> Acc;
-make_block(Bl, Acc) -> [{block,Bl}|Acc].
-
-extend_block(BlAcc, Fail, [{protected,_,_,_}=Prot|OldAcc]) ->
- extend_block([Prot|BlAcc], Fail, OldAcc);
-extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]) ->
- case extend_block_1(reverse(Is0), Fail, BlAcc0) of
- {BlAcc,[]} -> extend_block(BlAcc, Fail, OldAcc);
- {BlAcc,Is} -> {BlAcc,[{block,Is}|OldAcc]}
- end;
-extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}.
-
-extend_block_1([{set,[{x,_}],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
- extend_block_1(Is, Fail, [I|Acc]);
-extend_block_1([{set,[{x,_}],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) ->
- case safe_bool_op(Bif, length(As)) of
- false -> {Acc,reverse(Is0)};
- true -> extend_block_1(Is, Fail, [I|Acc])
- end;
-extend_block_1([_|_]=Is, _, Acc) -> {Acc,reverse(Is)};
-extend_block_1([], _, Acc) -> {Acc,[]}.
-
-%% split_block([Instruction], Destination, FailLabel, [PreInstruction],
-%% ProhibitFailLabelInPreBlock) -> failed | {Block,PreBlock}
-%% Split a sequence of instructions into two blocks - one containing
-%% all guard bif instructions and a pre-block all instructions before
-%% the guard BIFs.
-
-split_block(Is0, Dst, Fail, PreIs, ProhibitFailLabel) ->
- case ProhibitFailLabel andalso beam_jump:is_label_used_in(Fail, PreIs) of
- true ->
- %% The failure label was used in one of the instructions (most
- %% probably bit syntax construction) preceeding the block,
- %% the caller might eliminate the label.
- failed;
- false ->
- case reverse(Is0) of
- [{set,[Dst],_,_}|_]=Is ->
- split_block_1(Is, Fail, ProhibitFailLabel);
- _ -> failed
- end
- end.
-
-split_block_1(Is, Fail, ProhibitFailLabel) ->
- case split_block_2(Is, Fail, []) of
- {[],_} -> failed;
- {_,PreBlock}=Res ->
- case ProhibitFailLabel andalso
- split_block_label_used(PreBlock, Fail) of
- true ->
- %% The failure label was used in the pre-block;
- %% not allowed, because the label may be removed.
- failed;
- false ->
- Res
- end
- end.
-
-split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
- split_block_2(Is, Fail, [I|Acc]);
-split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) ->
- split_block_2(Is, Fail, [I|Acc]);
-split_block_2(Is0, _, Acc) ->
- Is = reverse(Is0),
- {Acc,Is}.
-
-split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) ->
- true;
-split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) ->
- true;
-split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) ->
- true;
-split_block_label_used([_|Is], Fail) ->
- split_block_label_used(Is, Fail);
-split_block_label_used([], _) -> false.
-
-dst_regs(Is) ->
- dst_regs(Is, []).
-
-dst_regs([{block,Bl}|Is], Acc) ->
- dst_regs(Bl, dst_regs(Is, Acc));
-dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) ->
- dst_regs(Is, [D|Acc]);
-dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) ->
- dst_regs(Is, [D|Acc]);
-dst_regs([{protected,_,Bl,_}|Is], Acc) ->
- dst_regs(Bl, dst_regs(Is, Acc));
-dst_regs([_|Is], Acc) ->
- dst_regs(Is, Acc);
-dst_regs([], Acc) -> ordsets:from_list(Acc).
-
-all_killed([R|Rs], OldIs, Fail, St) ->
- case is_killed(R, OldIs, Fail, St) of
- false -> false;
- true -> all_killed(Rs, OldIs, Fail, St)
- end;
-all_killed([], _, _, _) -> true.
-
-none_used([R|Rs], OldIs, Fail, St) ->
- case is_not_used(R, OldIs, Fail, St) of
- false -> false;
- true -> none_used(Rs, OldIs, Fail, St)
- end;
-none_used([], _, _, _) -> true.
-
-bopt_tree_cg(Block0, Fail, St) ->
- Free = free_variables(Block0),
- Block = ssa_block(Block0),
-%% io:format("~p\n", [Block0]),
-%% io:format("~p\n", [Block]),
-%% io:format("~p\n", [gb_trees:to_list(Free)]),
- case bopt_tree(Block, Free, []) of
- {Pre0,[{_,Tree}]} ->
- Pre1 = update_fail_label(Pre0, Fail, []),
- Regs0 = init_regs(gb_trees:keys(Free)),
-%% io:format("~p\n", [dst_regs(Block0)]),
-%% io:format("~p\n", [Pre1]),
-%% io:format("~p\n", [Tree]),
-%% io:nl(),
- {Pre,Regs} = rename_regs(Pre1, Regs0),
-%% io:format("~p\n", [Regs0]),
-%% io:format("~p\n", [Pre]),
- bopt_cg(Tree, Fail, Regs, make_block(Pre), St);
- _Res ->
- throw(not_boolean_expr)
- end.
-
-bopt_tree([{set,[Dst],As0,{bif,'not',_}}|Is], Forest0, Pre) ->
- {[Arg],Forest1} = bopt_bool_args(As0, Forest0),
- Forest = gb_trees:enter(Dst, {'not',Arg}, Forest1),
- bopt_tree(Is, Forest, Pre);
-bopt_tree([{set,[Dst],As0,{bif,'and',_}}|Is], Forest0, Pre) ->
- {As,Forest1} = bopt_bool_args(As0, Forest0),
- Node = make_and_node(As),
- Forest = gb_trees:enter(Dst, Node, Forest1),
- bopt_tree(Is, Forest, Pre);
-bopt_tree([{set,[Dst],As0,{bif,'or',_}}|Is], Forest0, Pre) ->
- {As,Forest1} = bopt_bool_args(As0, Forest0),
- Node = make_or_node(As),
- Forest = gb_trees:enter(Dst, Node, Forest1),
- bopt_tree(Is, Forest, Pre);
-bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) ->
- throw('xor');
-bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) ->
- ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]),
- case bopt_tree(Code, ProtForest0, []) of
- {ProtPre,[{_,ProtTree}]} ->
- Prot = {prot,ProtPre,ProtTree},
- Forest = gb_trees:enter(Dst, Prot, Forest0),
- bopt_tree(Is, Forest, Pre);
- _Res ->
- throw(not_boolean_expr)
- end;
-bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) ->
- Ar = length(As),
- case safe_bool_op(N, Ar) of
- false ->
- bopt_good_args(As, Forest0),
- Forest = gb_trees:enter(Dst, any, Forest0),
- bopt_tree(Is, Forest, [Bif|Pre]);
- true ->
- bopt_good_args(As, Forest0),
- Test = bif_to_test(Dst, N, As),
- Forest = gb_trees:enter(Dst, Test, Forest0),
- bopt_tree(Is, Forest, Pre)
- end;
-bopt_tree([{set,[Dst],As,{alloc,_,{gc_bif,_,_}}}=Bif|Is], Forest0, Pre) ->
- bopt_good_args(As, Forest0),
- Forest = gb_trees:enter(Dst, any, Forest0),
- bopt_tree(Is, Forest, [Bif|Pre]);
-bopt_tree([], Forest, Pre) ->
- {reverse(Pre),[R || {_,V}=R <- gb_trees:to_list(Forest), V =/= any]}.
-
-safe_bool_op(N, Ar) ->
- erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar).
-
-bopt_bool_args([V0,V0], Forest0) ->
- {V,Forest} = bopt_bool_arg(V0, Forest0),
- {[V,V],Forest};
-bopt_bool_args(As, Forest) ->
- mapfoldl(fun bopt_bool_arg/2, Forest, As).
-
-bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp ->
- Val = case gb_trees:lookup(R, Forest) of
- {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]};
- {value,Val0} -> Val0;
- none -> throw(mixed)
- end,
- {Val,gb_trees:delete(R, Forest)};
-bopt_bool_arg(Term, Forest) ->
- {Term,Forest}.
-
-bopt_good_args([A|As], Regs) ->
- bopt_good_arg(A, Regs),
- bopt_good_args(As, Regs);
-bopt_good_args([], _) -> ok.
-
-bopt_good_arg({Tag,_}=X, Regs) when Tag =:= x; Tag =:= tmp ->
- case gb_trees:lookup(X, Regs) of
- {value,any} -> ok;
- {value,_} -> throw(mixed);
- none -> throw(protected_barrier)
- end;
-bopt_good_arg(_, _) -> ok.
-
-bif_to_test(_, N, As) ->
- beam_utils:bif_to_test(N, As, fail).
-
-make_and_node(Is) ->
- AndList0 = make_and_list(Is),
- case simplify_and_list(AndList0) of
- [] -> {atom,true};
- [Op] -> Op;
- AndList -> {'and',AndList}
- end.
-
-make_and_list([{'and',As}|Is]) ->
- make_and_list(As++Is);
-make_and_list([I|Is]) ->
- [I|make_and_list(Is)];
-make_and_list([]) -> [].
-
-simplify_and_list([{atom,true}|T]) ->
- simplify_and_list(T);
-simplify_and_list([{atom,false}=False|_]) ->
- [False];
-simplify_and_list([H|T]) ->
- [H|simplify_and_list(T)];
-simplify_and_list([]) -> [].
-
-make_or_node(Is) ->
- OrList0 = make_or_list(Is),
- case simplify_or_list(OrList0) of
- [] -> {atom,false};
- [Op] -> Op;
- OrList -> {'or',OrList}
- end.
-
-make_or_list([{'or',As}|Is]) ->
- make_or_list(As++Is);
-make_or_list([I|Is]) ->
- [I|make_or_list(Is)];
-make_or_list([]) -> [].
-
-simplify_or_list([{atom,false}|T]) ->
- simplify_or_list(T);
-simplify_or_list([{atom,true}=True|_]) ->
- [True];
-simplify_or_list([H|T]) ->
- [H|simplify_or_list(T)];
-simplify_or_list([]) -> [].
-
-%% Code generation for a boolean tree.
-
-bopt_cg({'not',Arg}, Fail, Rs, Acc, St) ->
- I = bopt_cg_not(Arg),
- bopt_cg(I, Fail, Rs, Acc, St);
-bopt_cg({'and',As}, Fail, Rs, Acc, St) ->
- bopt_cg_and(As, Fail, Rs, Acc, St);
-bopt_cg({'or',As}, Fail, Rs, Acc, St0) ->
- {Succ,St} = new_label(St0),
- bopt_cg_or(As, Succ, Fail, Rs, Acc, St);
-bopt_cg({test,N,fail,As0}, Fail, Rs, Acc, St) ->
- As = rename_sources(As0, Rs),
- Test = {test,N,{f,Fail},As},
- {[Test|Acc],St};
-bopt_cg({inverted_test,N,fail,As0}, Fail, Rs, Acc, St0) ->
- As = rename_sources(As0, Rs),
- {Lbl,St} = new_label(St0),
- {[{label,Lbl},{jump,{f,Fail}},{test,N,{f,Lbl},As}|Acc],St};
-bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) ->
- Pre1 = update_fail_label(Pre0, Fail, []),
- {Pre,Rs} = rename_regs(Pre1, Rs0),
- bopt_cg(Tree, Fail, Rs, make_block(Pre, Acc), St0);
-bopt_cg({atom,true}, _Fail, _Rs, Acc, St) ->
- {Acc,St};
-bopt_cg({atom,false}, Fail, _Rs, Acc, St) ->
- {[{jump,{f,Fail}}|Acc],St};
-bopt_cg(_, _, _, _, _) ->
- throw(not_boolean_expr).
-
-bopt_cg_not({'and',As0}) ->
- As = [bopt_cg_not(A) || A <- As0],
- {'or',As};
-bopt_cg_not({'or',As0}) ->
- As = [bopt_cg_not(A) || A <- As0],
- {'and',As};
-bopt_cg_not({'not',Arg}) ->
- bopt_cg_not_not(Arg);
-bopt_cg_not({test,Test,Fail,As}) ->
- {inverted_test,Test,Fail,As};
-bopt_cg_not({atom,Bool}) when is_boolean(Bool) ->
- {atom,not Bool};
-bopt_cg_not(_) ->
- throw(not_boolean_expr).
-
-bopt_cg_not_not({'and',As}) ->
- {'and',[bopt_cg_not_not(A) || A <- As]};
-bopt_cg_not_not({'or',As}) ->
- {'or',[bopt_cg_not_not(A) || A <- As]};
-bopt_cg_not_not({'not',Arg}) ->
- bopt_cg_not(Arg);
-bopt_cg_not_not(Leaf) -> Leaf.
-
-bopt_cg_and([I|Is], Fail, Rs, Acc0, St0) ->
- {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0),
- bopt_cg_and(Is, Fail, Rs, Acc, St);
-bopt_cg_and([], _, _, Acc, St) -> {Acc,St}.
-
-bopt_cg_or([I], Succ, Fail, Rs, Acc0, St0) ->
- {Acc,St} = bopt_cg(I, Fail, Rs, Acc0, St0),
- {[{label,Succ}|Acc],St};
-bopt_cg_or([I|Is], Succ, Fail, Rs, Acc0, St0) ->
- {Lbl,St1} = new_label(St0),
- {Acc,St} = bopt_cg(I, Lbl, Rs, Acc0, St1),
- bopt_cg_or(Is, Succ, Fail, Rs, [{label,Lbl},{jump,{f,Succ}}|Acc], St).
-
-new_label(#st{next=LabelNum}=St) when is_integer(LabelNum) ->
- {LabelNum,St#st{next=LabelNum+1}}.
-
-free_variables(Is) ->
- E = gb_sets:empty(),
- free_vars_1(Is, E, E, E).
-
-free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) ->
- F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)),
- N = gb_sets:union(N0, var_list(Ds)),
- free_vars_1(Is, F, N, A);
-free_vars_1([{set,Ds,As,{alloc,Regs,{gc_bif,_,_}}}|Is], F0, N0, A0) ->
- A = gb_sets:union(A0, gb_sets:from_list(free_vars_regs(Regs))),
- F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)),
- N = gb_sets:union(N0, var_list(Ds)),
- free_vars_1(Is, F, N, A);
-free_vars_1([{protected,_,Pa,_}|Is], F, N, A) ->
- free_vars_1(Pa++Is, F, N, A);
-free_vars_1([], F0, N, A) ->
- F = case gb_sets:is_empty(A) of
- true ->
- %% No GC BIFs.
- {x,X} = gb_sets:smallest(N),
- P = ordsets:from_list(free_vars_regs(X)),
- ordsets:union(gb_sets:to_list(F0), P);
- false ->
- %% At least one GC BIF.
- gb_sets:to_list(gb_sets:union(F0, gb_sets:difference(A, N)))
- end,
- gb_trees:from_orddict([{K,any} || K <- F]).
-
-var_list(Is) ->
- var_list_1(Is, gb_sets:empty()).
-
-var_list_1([{Tag,_}=X|Is], D) when Tag =:= x; Tag =:= y ->
- var_list_1(Is, gb_sets:add(X, D));
-var_list_1([_|Is], D) ->
- var_list_1(Is, D);
-var_list_1([], D) -> D.
-
-free_vars_regs(0) -> [];
-free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)].
-
-rename_regs(Is, Regs) ->
- rename_regs(Is, Regs, []).
-
-rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) ->
- Live = live_regs(Regs0),
- Ss = rename_sources(Ss0, Regs0),
- Regs = put_reg(Dst0, Regs0),
- Dst = fetch_reg(Dst0, Regs),
- rename_regs(Is, Regs, [{set,[Dst],Ss,{alloc,Live,Info}}|Acc]);
-rename_regs([{set,[Dst0],Ss0,Info}|Is], Regs0, Acc) ->
- Ss = rename_sources(Ss0, Regs0),
- Regs = put_reg(Dst0, Regs0),
- Dst = fetch_reg(Dst0, Regs),
- rename_regs(Is, Regs, [{set,[Dst],Ss,Info}|Acc]);
-rename_regs([], Regs, Acc) -> {reverse(Acc),Regs}.
-
-rename_sources(Ss, Regs) ->
- map(fun({x,_}=R) -> fetch_reg(R, Regs);
- ({tmp,_}=R) -> fetch_reg(R, Regs);
- (E) -> E
- end, Ss).
-
-%%%
-%%% Keeping track of register assignments.
-%%%
-
-init_regs(Free) ->
- init_regs_1(Free, 0).
-
-init_regs_1([{x,I}=V|T], I) ->
- [{I,V}|init_regs_1(T, I+1)];
-init_regs_1([{x,X}|_]=T, I) when I < X ->
- [{I,reserved}|init_regs_1(T, I+1)];
-init_regs_1([{y,_}|_], _) -> [];
-init_regs_1([], _) -> [].
-
-put_reg(V, Rs) -> put_reg_1(V, Rs, 0).
-
-put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)];
-put_reg_1(V, [], I) -> [{I,V}].
-
-fetch_reg(V, [{I,V}|_]) -> {x,I};
-fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs).
-
-live_regs([{_,reserved}|_]) ->
- %% We are not sure that this register is initialized, so we must
- %% abort the optimization.
- throw(gc_bif_alloc_failure);
-live_regs([{I,_}]) ->
- I+1;
-live_regs([{_,_}|Regs]) ->
- live_regs(Regs);
-live_regs([]) ->
- 0.
-
-
-%%%
-%%% Convert a block to Static Single Assignment (SSA) form.
-%%%
-
--record(ssa,
- {live=0, %Variable counter.
- sub=gb_trees:empty(), %Substitution table.
- prot=gb_sets:empty(), %Targets assigned by protecteds.
- in_prot=false %Inside a protected.
- }).
-
-ssa_block(Is0) ->
- {Is,_} = ssa_block_1(Is0, #ssa{}, []),
- Is.
-
-ssa_block_1([{protected,[_],Pa0,Pb}|Is], Sub0, Acc) ->
- {Pa,Sub1} = ssa_block_1(Pa0, Sub0#ssa{in_prot=true}, []),
- Dst = ssa_last_target(Pa),
- Sub = Sub1#ssa{prot=gb_sets:insert(Dst, Sub1#ssa.prot),
- in_prot=Sub0#ssa.in_prot},
- ssa_block_1(Is, Sub, [{protected,[Dst],Pa,Pb}|Acc]);
-ssa_block_1([{set,[Dst],As,Bif}|Is], Sub0, Acc0) ->
- Sub1 = ssa_in_use_list(As, Sub0),
- Sub = ssa_assign(Dst, Sub1),
- Acc = [{set,[ssa_sub(Dst, Sub)],ssa_sub_list(As, Sub0),Bif}|Acc0],
- ssa_block_1(Is, Sub, Acc);
-ssa_block_1([], Sub, Acc) -> {reverse(Acc),Sub}.
-
-ssa_in_use_list(As, Sub) ->
- foldl(fun ssa_in_use/2, Sub, As).
-
-ssa_in_use({x,_}=R, #ssa{sub=Sub0}=Ssa) ->
- case gb_trees:is_defined(R, Sub0) of
- true -> Ssa;
- false ->
- Sub = gb_trees:insert(R, R, Sub0),
- Ssa#ssa{sub=Sub}
- end;
-ssa_in_use(_, Ssa) -> Ssa.
-
-ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) ->
- {NewReg,Ssa} = ssa_new_reg(Ssa0),
- case gb_trees:is_defined(R, Sub0) of
- false ->
- Sub = gb_trees:insert(R, NewReg, Sub0),
- Ssa#ssa{sub=Sub};
- true ->
- Sub1 = gb_trees:update(R, NewReg, Sub0),
- Sub = gb_trees:insert(NewReg, NewReg, Sub1),
- Ssa#ssa{sub=Sub}
- end.
-
-ssa_sub_list(List, Sub) ->
- [ssa_sub(E, Sub) || E <- List].
-
-ssa_sub(R0, #ssa{sub=Sub,prot=Prot,in_prot=InProt}) ->
- case gb_trees:lookup(R0, Sub) of
- none -> R0;
- {value,R} ->
- case InProt andalso gb_sets:is_element(R, Prot) of
- true ->
- throw(protected_violation);
- false ->
- R
- end
- end.
-
-ssa_new_reg(#ssa{live=Reg}=Ssa) ->
- {{tmp,Reg},Ssa#ssa{live=Reg+1}}.
-
-ssa_last_target([{set,[Dst],_,_}]) -> Dst;
-ssa_last_target([_|Is]) -> ssa_last_target(Is).
-
-%% is_killed(Register, [Instruction], FailLabel, State) -> true|false
-%% Determine whether a register is killed in the instruction sequence.
-%% The state is used to allow us to determine the kill state
-%% across branches.
-
-is_killed(R, Is, Label, #st{ll=Ll}) ->
- beam_utils:is_killed(R, Is, Ll) andalso
- beam_utils:is_killed_at(R, Label, Ll).
-
-%% is_not_used(Register, [Instruction], FailLabel, State) -> true|false
-%% Determine whether a register is never used in the instruction sequence
-%% (it could still referenced by an allocate instruction, meaning that
-%% it MUST be initialized).
-%% The state is used to allow us to determine the usage state
-%% across branches.
-
-is_not_used(R, Is, Label, #st{ll=Ll}) ->
- beam_utils:is_not_used(R, Is, Ll) andalso
- beam_utils:is_not_used_at(R, Label, Ll).
-
-%% initialized_regs([Instruction]) -> [Register])
-%% Given a REVERSED instruction sequence, return a list of the registers
-%% that are guaranteed to be initialized (not contain garbage).
-
-initialized_regs(Is) ->
- initialized_regs(Is, ordsets:new()).
-
-initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) ->
- Regs = add_init_regs(free_vars_regs(Live), Regs0),
- add_init_regs(Dst, Regs);
-initialized_regs([{set,Dst,Src,_}|Is], Regs) ->
- initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs)));
-initialized_regs([{test,_,_,Src}|Is], Regs) ->
- initialized_regs(Is, add_init_regs(Src, Regs));
-initialized_regs([{block,Bl}|Is], Regs) ->
- initialized_regs(reverse(Bl, Is), Regs);
-initialized_regs([{bs_context_to_binary,Src}|Is], Regs) ->
- initialized_regs(Is, add_init_regs([Src], Regs));
-initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) ->
- InitRegs = free_vars_regs(Arity),
- add_init_regs(InitRegs, Regs);
-initialized_regs([_|_], Regs) -> Regs.
-
-add_init_regs([{x,_}=X|T], Regs) ->
- add_init_regs(T, ordsets:add_element(X, Regs));
-add_init_regs([_|T], Regs) ->
- add_init_regs(T, Regs);
-add_init_regs([], Regs) -> Regs.
diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl
index 2aed98d4e7..5f1b9ed488 100644
--- a/lib/compiler/src/beam_bs.erl
+++ b/lib/compiler/src/beam_bs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -25,6 +25,9 @@
-export([module/2]).
-import(lists, [mapfoldl/3,reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) ->
{Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0),
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -35,8 +38,7 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
{Is,Lc} = bsm_opt(Is1, Lc0),
{{function,Name,Arity,CLabel,Is},Lc}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index ae1b34ba49..1c8e0e9854 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -60,19 +60,26 @@
%%% data structures or passed to BIFs.
%%%
+-type label() :: beam_asm:label().
+-type func_info() :: {beam_asm:reg(),boolean()}.
+
-record(btb,
- {f, %Gbtrees for all functions.
- index, %{Label,Code} index (for liveness).
- ok_br, %Labels that are OK.
- must_not_save, %Must not save position when
- % optimizing (reaches
- % bs_context_to_binary).
- must_save %Must save position when optimizing.
+ {f :: gb_trees:tree(label(), func_info()),
+ index :: beam_utils:code_index(), %{Label,Code} index (for liveness).
+ ok_br=gb_sets:empty() :: gb_sets:set(label()), %Labels that are OK.
+ must_not_save=false :: boolean(), %Must not save position when
+ % optimizing (reaches
+ % bs_context_to_binary).
+ must_save=false :: boolean() %Must save position when optimizing.
}).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, Opts) ->
- D = #btb{f=btb_index(Fs0)},
- Fs = [function(F, D) || F <- Fs0],
+ FIndex = btb_index(Fs0),
+ Fs = [function(F, FIndex) || F <- Fs0],
Code = {Mod,Exp,Attr,Fs,Lc},
case proplists:get_bool(bin_opt_info, Opts) of
true ->
@@ -92,14 +99,13 @@ format_error({no_bin_opt,Reason}) ->
%%% Local functions.
%%%
-function({function,Name,Arity,Entry,Is}, D0) ->
+function({function,Name,Arity,Entry,Is}, FIndex) ->
try
Index = beam_utils:index_labels(Is),
- D = D0#btb{index=Index},
+ D = #btb{f=FIndex,index=Index},
{function,Name,Arity,Entry,btb_opt_1(Is, D, [])}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -118,20 +124,21 @@ btb_opt_1([{test,bs_get_binary2,F,_,[Reg,{atom,all},U,Fs],Reg}=I0|Is], D, Acc0)
end,
btb_opt_1(Is, D, Acc)
end;
-btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is], D, Acc0) ->
- case btb_reaches_match(Is, [Ctx,Dst], D) of
+btb_opt_1([{test,bs_get_binary2,F,_,[Ctx,{atom,all},U,Fs],Dst}=I0|Is0], D, Acc0) ->
+ case btb_reaches_match(Is0, [Ctx,Dst], D) of
{error,Reason} ->
Comment = btb_comment_no_opt(Reason, Fs),
- btb_opt_1(Is, D, [Comment,I0|Acc0]);
+ btb_opt_1(Is0, D, [Comment,I0|Acc0]);
{ok,MustSave} when U =:= 1 ->
Comment = btb_comment_opt(Fs),
- Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]),
- Acc = [{move,Ctx,Dst}|Acc1],
+ Acc = btb_gen_save(MustSave, Ctx, [Comment|Acc0]),
+ Is = prepend_move(Ctx, Dst, Is0),
btb_opt_1(Is, D, Acc);
{ok,MustSave} ->
Comment = btb_comment_opt(Fs),
Acc1 = btb_gen_save(MustSave, Ctx, [Comment|Acc0]),
- Acc = [{move,Ctx,Dst},{test,bs_test_unit,F,[Ctx,U]}|Acc1],
+ Acc = [{test,bs_test_unit,F,[Ctx,U]}|Acc1],
+ Is = prepend_move(Ctx, Dst, Is0),
btb_opt_1(Is, D, Acc)
end;
btb_opt_1([I|Is], D, Acc) ->
@@ -144,6 +151,12 @@ btb_gen_save(true, Reg, Acc) ->
[{bs_save2,Reg,{atom,start}}|Acc];
btb_gen_save(false, _, Acc) -> Acc.
+prepend_move(Ctx, Dst, [{block,Bl0}|Is]) ->
+ Bl = [{set,[Dst],[Ctx],move}|Bl0],
+ [{block,Bl}|Is];
+prepend_move(Ctx, Dst, Is) ->
+ [{move,Ctx,Dst}|Is].
+
%% btb_reaches_match([Instruction], [Register], D) ->
%% {ok,MustSave}|{error,Reason}
%%
@@ -179,15 +192,14 @@ btb_gen_save(false, _, Acc) -> Acc.
%% a bs_context_to_binary instruction.
%%
-btb_reaches_match(Is, RegList, D0) ->
+btb_reaches_match(Is, RegList, D) ->
try
Regs = btb_regs_from_list(RegList),
- D = D0#btb{ok_br=gb_sets:empty(),must_not_save=false,must_save=false},
#btb{must_not_save=MustNotSave,must_save=MustSave} =
- btb_reaches_match_1(Is, Regs, D),
- case MustNotSave and MustSave of
+ btb_reaches_match_1(Is, Regs, D),
+ case MustNotSave andalso MustSave of
true -> btb_error(must_and_must_not_save);
- _ -> {ok,MustSave}
+ false -> {ok,MustSave}
end
catch
throw:{error,_}=Error -> Error
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 10805a3c36..207f1c4deb 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,7 +24,10 @@
-export([module/2]).
-export([bs_clean_saves/1]).
-export([clean_labels/1]).
--import(lists, [map/2,foldl/3,reverse/1,filter/2]).
+-import(lists, [foldl/3,reverse/1]).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
module({Mod,Exp,Attr,Fs0,_}, Opts) ->
Order = [Lbl || {function,_,_,Lbl,_} <- Fs0],
@@ -39,6 +42,10 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) ->
{ok,{Mod,Exp,Attr,Fs,Lc}}.
%% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2.
+
+-spec bs_clean_saves([beam_utils:instruction()]) ->
+ [beam_utils:instruction()].
+
bs_clean_saves(Is) ->
Needed = bs_restores(Is, []),
bs_clean_saves_1(Is, gb_sets:from_list(Needed), []).
@@ -98,15 +105,20 @@ add_to_work_list(F, {Fs,Used}=Sets) ->
%%% want to see the expanded code in a .S file.
%%%
--record(st, {lmap, %Translation tables for labels.
- entry, %Number of entry label.
- lc %Label counter
+-type label() :: beam_asm:label().
+
+-record(st, {lmap :: [{label(),label()}], %Translation tables for labels.
+ entry :: beam_asm:label(), %Number of entry label.
+ lc :: non_neg_integer() %Label counter
}).
+-spec clean_labels([beam_utils:instruction()]) ->
+ {[beam_utils:instruction()],pos_integer()}.
+
clean_labels(Fs0) ->
- St0 = #st{lmap=[],lc=1},
+ St0 = #st{lmap=[],entry=1,lc=1},
{Fs1,#st{lmap=Lmap0,lc=Lc}} = function_renumber(Fs0, St0, []),
- Lmap = gb_trees:from_orddict(ordsets:from_list(Lmap0)),
+ Lmap = maps:from_list(Lmap0),
Fs = function_replace(Fs1, Lmap, []),
{Fs,Lc}.
@@ -175,7 +187,8 @@ is_record_tuple(_, _, _) -> no.
function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
Asm = try
- replace(Asm0, [], Dict)
+ Fb = fun(Old) -> throw({error,{undefined_label,Old}}) end,
+ beam_utils:replace_labels(Asm0, [], Dict, Fb)
catch
throw:{error,{undefined_label,Lbl}=Reason} ->
io:format("Function ~s/~w refers to undefined label ~w\n",
@@ -185,57 +198,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
function_replace(Fs, Dict, [{function,Name,Arity,Entry,Asm}|Acc]);
function_replace([], _, Acc) -> Acc.
-replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) ->
- replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D);
-replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) ->
- replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D);
-replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) ->
- Vls = map(fun ({f,L}) -> {f,label(L, D)};
- (Other) -> Other
- end, Vls0),
- Fail = label(Fail0, D),
- replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D);
-replace([{'try',R,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D);
-replace([{'catch',R,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{'catch',R,{f,label(Lbl, D)}}|Acc], D);
-replace([{jump,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{jump,{f,label(Lbl, D)}}|Acc], D);
-replace([{loop_rec,{f,Lbl},R}|Is], Acc, D) ->
- replace(Is, [{loop_rec,{f,label(Lbl, D)},R}|Acc], D);
-replace([{loop_rec_end,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{loop_rec_end,{f,label(Lbl, D)}}|Acc], D);
-replace([{wait,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{wait,{f,label(Lbl, D)}}|Acc], D);
-replace([{wait_timeout,{f,Lbl},To}|Is], Acc, D) ->
- replace(Is, [{wait_timeout,{f,label(Lbl, D)},To}|Acc], D);
-replace([{bif,Name,{f,Lbl},As,R}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bif,Name,{f,label(Lbl, D)},As,R}|Acc], D);
-replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D);
-replace([{call,Ar,{f,Lbl}}|Is], Acc, D) ->
- replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D);
-replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) ->
- replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D);
-replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D);
-replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D);
-replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D)
- when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D);
-replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 ->
- replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D);
-replace([I|Is], Acc, D) ->
- replace(Is, [I|Acc], D);
-replace([], Acc, _) -> Acc.
-
-label(Old, D) ->
- case gb_trees:lookup(Old, D) of
- {value,Val} -> Val;
- none -> throw({error,{undefined_label,Old}})
- end.
-
%%%
%%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for
%%% new bit syntax matching (introduced in R11B).
@@ -292,7 +254,7 @@ bs_restores([_|Is], Dict) ->
bs_restores([], Dict) -> Dict.
%% Pass 2.
-bs_replace([{test,bs_start_match2,F,Live,[Src,Ctx],CtxR}|T], Dict, Acc) when is_atom(Ctx) ->
+bs_replace([{test,bs_start_match2,F,Live,[Src,{context,Ctx}],CtxR}|T], Dict, Acc) ->
Slots = case gb_trees:lookup(Ctx, Dict) of
{value,Slots0} -> Slots0;
none -> 0
@@ -341,8 +303,21 @@ maybe_remove_lines(Fs, Opts) ->
end.
remove_lines([{function,N,A,Lbl,Is0}|T]) ->
- Is = filter(fun({line,_}) -> false;
- (_) -> true
- end, Is0),
+ Is = remove_lines_fun(Is0),
[{function,N,A,Lbl,Is}|remove_lines(T)];
remove_lines([]) -> [].
+
+remove_lines_fun([{line,_}|Is]) ->
+ remove_lines_fun(Is);
+remove_lines_fun([{block,Bl0}|Is]) ->
+ Bl = remove_lines_block(Bl0),
+ [{block,Bl}|remove_lines_fun(Is)];
+remove_lines_fun([I|Is]) ->
+ [I|remove_lines_fun(Is)];
+remove_lines_fun([]) -> [].
+
+remove_lines_block([{set,_,_,{line,_}}|Is]) ->
+ remove_lines_block(Is);
+remove_lines_block([I|Is]) ->
+ [I|remove_lines_block(Is)];
+remove_lines_block([]) -> [].
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 6f6d742293..efad082152 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,6 +29,10 @@
-import(lists, [mapfoldl/3,reverse/1]).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,_}, _Opts) ->
{Fs1,Lc1} = beam_clean:clean_labels(Fs0),
{Fs,Lc} = mapfoldl(fun function/2, Lc1, Fs1),
@@ -52,8 +56,7 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
Is = move_move_into_block(Is3, []),
{{function,Name,Arity,CLabel,Is},Lc}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -266,26 +269,50 @@ backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) ->
false -> backward([Move|Is], D, [Jump|Acc]);
true -> backward([Jump|Is], D, Acc)
end;
-backward([{jump,{f,To}}=J|[{bif,Op,_,Ops,Reg}|Is]=Is0], D, Acc) ->
+backward([{jump,{f,To}}=J|[{bif,Op,{f,BifFail},Ops,Reg}|Is]=Is0], D, Acc) ->
try replace_comp_op(To, Reg, Op, Ops, D) of
- I -> backward(Is, D, I++Acc)
+ {Test,Jump} ->
+ backward([Jump,Test|Is], D, Acc)
catch
- throw:not_possible -> backward(Is0, D, [J|Acc])
+ throw:not_possible ->
+ case To =:= BifFail of
+ true ->
+ %% The bif instruction is redundant. See the comment
+ %% in the next clause for why there is no need to
+ %% test for liveness of Reg at label To.
+ backward([J|Is], D, Acc);
+ false ->
+ backward(Is0, D, [J|Acc])
+ end
end;
-backward([{test,bs_start_match2,F,_,[R,_],Ctxt}=I|Is], D,
- [{test,bs_match_string,F,[Ctxt,Bs]},
- {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) ->
- case beam_utils:is_killed(Ctxt, Acc0, D) of
- true ->
- Eq = {test,is_eq_exact,F,[R,{literal,Bs}]},
- backward(Is, D, [Eq|Acc0]);
- false ->
- backward(Is, D, [I|Acc])
+backward([{jump,{f,To}}=J|[{gc_bif,_,{f,To},_,_,_Dst}|Is]], D, Acc) ->
+ %% The gc_bif instruction is redundant, since either the gc_bif
+ %% instruction itself or the jump instruction will transfer control
+ %% to label To. Note that a gc_bif instruction does not assign its
+ %% destination register if the failure branch is taken; therefore,
+ %% the code at label To is not allowed to assume that the destination
+ %% register is initialized, and it is therefore no need to test
+ %% for liveness of the destination register at label To.
+ backward([J|Is], D, Acc);
+backward([{test,bs_start_match2,F,Live,[Src,_]=Args,Ctxt}|Is], D, Acc0) ->
+ {f,To0} = F,
+ case test_bs_literal(F, Ctxt, D, Acc0) of
+ {none,Acc} ->
+ %% Ctxt killed immediately after bs_start_match2.
+ To = shortcut_bs_context_to_binary(To0, Src, D),
+ I = {test,is_bitstr,{f,To},[Src]},
+ backward(Is, D, [I|Acc]);
+ {Literal,Acc} ->
+ %% Ctxt killed after matching a literal.
+ To = shortcut_bs_context_to_binary(To0, Src, D),
+ Eq = {test,is_eq_exact,{f,To},[Src,{literal,Literal}]},
+ backward(Is, D, [Eq|Acc]);
+ not_killed ->
+ %% Ctxt not killed. Not much to do.
+ To = shortcut_bs_start_match(To0, Src, D),
+ I = {test,bs_start_match2,{f,To},Live,Args,Ctxt},
+ backward(Is, D, [I|Acc0])
end;
-backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
- To = shortcut_bs_start_match(To0, Src, D),
- I = {test,bs_start_match2,{f,To},Live,Info,Dst},
- backward(Is, D, [I|Acc]);
backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
To2 = shortcut_label(To1, D),
@@ -357,6 +384,34 @@ backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) ->
false -> backward(Is, D, [I|Acc]);
true -> backward(Is, D, Acc)
end;
+backward([{bif,'or',{f,To0},[Dst,{atom,false}],Dst}=I|Is], D,
+ [{test,is_eq_exact,{f,To},[Dst,{atom,true}]}|_]=Acc) ->
+ case shortcut_label(To0, D) of
+ To ->
+ backward(Is, D, Acc);
+ _ ->
+ backward(Is, D, [I|Acc])
+ end;
+backward([{bif,map_get,{f,FF},[Key,Map],_}=I0,
+ {test,has_map_fields,{f,FT}=F,[Map|Keys0]}=I1|Is], D, Acc) when FF =/= 0 ->
+ case shortcut_label(FF, D) of
+ FT ->
+ case lists:delete(Key, Keys0) of
+ [] ->
+ backward([I0|Is], D, Acc);
+ Keys ->
+ Test = {test,has_map_fields,F,[Map|Keys]},
+ backward([Test|Is], D, [I0|Acc])
+ end;
+ _ ->
+ backward([I1|Is], D, [I0|Acc])
+ end;
+backward([{bif,map_get,{f,FF},[_,Map],_}=I0,
+ {test,is_map,{f,FT},[Map]}=I1|Is], D, Acc) when FF =/= 0 ->
+ case shortcut_label(FF, D) of
+ FT -> backward([I0|Is], D, Acc);
+ _ -> backward([I1|Is], D, [I0|Acc])
+ end;
backward([I|Is], D, Acc) ->
backward(Is, D, [I|Acc]);
backward([], _D, Acc) -> Acc.
@@ -375,6 +430,8 @@ shortcut_select_list([Lit,{f,To0}|T], Reg, D, Acc) ->
shortcut_select_list(T, Reg, D, [{f,To},Lit|Acc]);
shortcut_select_list([], _, _, Acc) -> reverse(Acc).
+shortcut_label(0, _) ->
+ 0;
shortcut_label(To0, D) ->
case beam_utils:code_at(To0, D) of
[{jump,{f,To}}|_] -> shortcut_label(To, D);
@@ -410,7 +467,7 @@ prune_redundant([], _) -> [].
replace_comp_op(To, Reg, Op, Ops, D) ->
False = comp_op_find_shortcut(To, Reg, {atom,false}, D),
True = comp_op_find_shortcut(To, Reg, {atom,true}, D),
- [bif_to_test(Op, Ops, False),{jump,{f,True}}].
+ {bif_to_test(Op, Ops, False),{jump,{f,True}}}.
comp_op_find_shortcut(To0, Reg, Val, D) ->
case shortcut_select_label(To0, Reg, Val, D) of
@@ -447,15 +504,22 @@ not_possible() -> throw(not_possible).
%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2
%% L2: .... L2:
%%
-combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_])
- when Type =:= atom; Type =:= integer ->
+combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, Acc)
+ when Type =:= atom; Type =:= integer ->
+ Next = case Acc of
+ [{label,Lbl}|_] -> Lbl;
+ [{jump,{f,Lbl}}|_] -> Lbl
+ end,
case beam_utils:code_at(To, D) of
[{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]},
{label,L2}|_] when Lit1 =/= Lit2 ->
- {select,select_val,Reg,{f,F2},[Lit1,{f,L1},Lit2,{f,L2}]};
+ {select,select_val,Reg,{f,F2},[Lit1,{f,Next},Lit2,{f,L2}]};
+ [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]},
+ {jump,{f,L2}}|_] when Lit1 =/= Lit2 ->
+ {select,select_val,Reg,{f,F2},[Lit1,{f,Next},Lit2,{f,L2}]};
[{select,select_val,Reg,{f,F2},[{Type,_}|_]=List0}|_] ->
List = remove_from_list(Lit1, List0),
- {select,select_val,Reg,{f,F2},[Lit1,{f,L1}|List]};
+ {select,select_val,Reg,{f,F2},[Lit1,{f,Next}|List]};
_Is ->
{test,is_eq_exact,{f,To},Ops}
end;
@@ -468,6 +532,22 @@ remove_from_list(Lit, [Val,{f,_}=Fail|T]) ->
[Val,Fail|remove_from_list(Lit, T)];
remove_from_list(_, []) -> [].
+
+test_bs_literal(F, Ctxt, D,
+ [{test,bs_match_string,F,[Ctxt,Bs]},
+ {test,bs_test_tail2,F,[Ctxt,0]}|Acc]) ->
+ test_bs_literal_1(Ctxt, Acc, D, Bs);
+test_bs_literal(F, Ctxt, D, [{test,bs_test_tail2,F,[Ctxt,0]}|Acc]) ->
+ test_bs_literal_1(Ctxt, Acc, D, <<>>);
+test_bs_literal(_, Ctxt, D, Acc) ->
+ test_bs_literal_1(Ctxt, Acc, D, none).
+
+test_bs_literal_1(Ctxt, Is, D, Literal) ->
+ case beam_utils:is_killed(Ctxt, Is, D) of
+ true -> {Literal,Is};
+ false -> not_killed
+ end.
+
%% shortcut_bs_test(TargetLabel, ReversedInstructions, D) -> TargetLabel'
%% Try to shortcut the failure label for bit syntax matching.
@@ -551,6 +631,21 @@ shortcut_bs_start_match_1([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_],
shortcut_bs_start_match_1(_, _, To, _) ->
To.
+%% shortcut_bs_context_to_binary(TargetLabel, Reg) -> TargetLabel
+%% If a bs_start_match2 instruction has been eliminated, the
+%% bs_context_to_binary instruction can be eliminated too.
+
+shortcut_bs_context_to_binary(To, Reg, D) ->
+ shortcut_bs_ctb_1(beam_utils:code_at(To, D), Reg, To, D).
+
+shortcut_bs_ctb_1([{bs_context_to_binary,Reg}|Is], Reg, To, D) ->
+ shortcut_bs_ctb_1(Is, Reg, To, D);
+shortcut_bs_ctb_1([{jump,{f,To}}|_], Reg, _, D) ->
+ Code = beam_utils:code_at(To, D),
+ shortcut_bs_ctb_1(Code, Reg, To, D);
+shortcut_bs_ctb_1(_, _, To, _) ->
+ To.
+
%% shortcut_rel_op(FailLabel, Operator, [Operand], D) -> FailLabel'
%% Try to shortcut the given test instruction. Example:
%%
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index 9565ab74c4..990e86062a 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -24,11 +24,11 @@
-export([new/0,opcode/2,highest_opcode/1,
atom/2,local/4,export/4,import/4,
string/2,lambda/3,literal/2,line/2,fname/2,
- atom_table/1,local_table/1,export_table/1,import_table/1,
+ atom_table/2,local_table/1,export_table/1,import_table/1,
string_table/1,lambda_table/1,literal_table/1,
line_table/1]).
--type label() :: non_neg_integer().
+-type label() :: beam_asm:label().
-type index() :: non_neg_integer().
@@ -38,13 +38,16 @@
-type line_tab() :: #{{Fname :: index(), Line :: term()} => index()}.
-type literal_tab() :: dict:dict(Literal :: term(), index()).
+-type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}.
+-type lambda_tab() :: {non_neg_integer(),[lambda_info()]}.
+
-record(asm,
{atoms = #{} :: atom_tab(),
exports = [] :: [{label(), arity(), label()}],
locals = [] :: [{label(), arity(), label()}],
imports = gb_trees:empty() :: import_tab(),
strings = <<>> :: binary(), %String pool
- lambdas = {0,[]}, %[{...}]
+ lambdas = {0,[]} :: lambda_tab(),
literals = dict:new() :: literal_tab(),
fnames = #{} :: fname_tab(),
lines = #{} :: line_tab(),
@@ -148,10 +151,7 @@ string(Str, Dict) when is_list(Str) ->
lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) ->
%% 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],
+ Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
{OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}.
%% Returns the index for a literal (adding it to the literal table if necessary).
@@ -185,6 +185,9 @@ line([{location,Name,Line}], #asm{lines=Lines,num_lines=N}=Dict0) ->
{Index, Dict1#asm{lines=Lines#{Key=>Index},num_lines=N+1}}
end.
+-spec fname(nonempty_string(), bdict()) ->
+ {non_neg_integer(), bdict()}.
+
fname(Name, #asm{fnames=Fnames}=Dict) ->
case Fnames of
#{Name := Index} -> {Index,Dict};
@@ -194,15 +197,15 @@ fname(Name, #asm{fnames=Fnames}=Dict) ->
end.
%% Returns the atom table.
-%% atom_table(Dict) -> {LastIndex,[Length,AtomString...]}
--spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}.
+%% atom_table(Dict, Encoding) -> {LastIndex,[Length,AtomString...]}
+-spec atom_table(bdict(), latin1 | utf8) -> {non_neg_integer(), [[non_neg_integer(),...]]}.
-atom_table(#asm{atoms=Atoms}) ->
+atom_table(#asm{atoms=Atoms}, Encoding) ->
NumAtoms = maps:size(Atoms),
Sorted = lists:keysort(2, maps:to_list(Atoms)),
{NumAtoms,[begin
- L = atom_to_list(A),
- [length(L)|L]
+ L = atom_to_binary(A, Encoding),
+ [byte_size(L),L]
end || {A,_} <- Sorted]}.
%% Returns the table of local functions.
@@ -239,8 +242,11 @@ lambda_table(#asm{locals=Loc0,lambdas={NumLambdas,Lambdas0}}) ->
Lambdas1 = sofs:relation(Lambdas0),
Loc = sofs:relation([{Lbl,{F,A}} || {F,A,Lbl} <- Loc0]),
Lambdas2 = sofs:relative_product1(Lambdas1, Loc),
+ %% 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 = [<<F:32,A:32,Lbl:32,Index:32,NumFree:32,OldUniq:32>> ||
- {{_,Lbl,Index,NumFree,OldUniq},{F,A}} <- sofs:to_external(Lambdas2)],
+ {{Index,Lbl,NumFree},{F,A}} <- sofs:to_external(Lambdas2)],
{NumLambdas,Lambdas}.
%% Returns the literal table.
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index c699672db1..6cee9acae4 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -163,8 +163,8 @@ pp_instr(I) ->
file(File) ->
try process_chunks(File)
- catch error:Reason ->
- {error,?MODULE,{internal,{Reason,erlang:get_stacktrace()}}}
+ catch error:Reason:Stack ->
+ {error,?MODULE,{internal,{Reason,Stack}}}
end.
%%-----------------------------------------------------------------------
@@ -719,42 +719,6 @@ resolve_inst({wait,[Lbl]},_,_,_) ->
{wait,Lbl};
resolve_inst({wait_timeout,[Lbl,Int]},_,_,_) ->
{wait_timeout,Lbl,resolve_arg(Int)};
-resolve_inst({m_plus,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'+',W,[SrcR1,SrcR2],DstR};
-resolve_inst({m_minus,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'-',W,[SrcR1,SrcR2],DstR};
-resolve_inst({m_times,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'*',W,[SrcR1,SrcR2],DstR};
-resolve_inst({m_div,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'/',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_div,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'div',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_rem,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'rem',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_band,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'band',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bor,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bor',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bxor,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bxor',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bsl,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bsl',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bsr,Args},_,_,_) ->
- [W,SrcR1,SrcR2,DstR] = resolve_args(Args),
- {arithbif,'bsr',W,[SrcR1,SrcR2],DstR};
-resolve_inst({int_bnot,Args},_,_,_) ->
- [W,SrcR,DstR] = resolve_args(Args),
- {arithbif,'bnot',W,[SrcR],DstR};
resolve_inst({is_lt=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
@@ -800,9 +764,6 @@ resolve_inst({is_nil=I,Args0},_,_,_) ->
resolve_inst({is_binary=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
-resolve_inst({is_constant=I,Args0},_,_,_) ->
- [L|Args] = resolve_args(Args0),
- {test,I,L,Args};
resolve_inst({is_list=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
@@ -815,6 +776,9 @@ resolve_inst({is_tuple=I,Args0},_,_,_) ->
resolve_inst({test_arity=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
+resolve_inst({is_tagged_tuple=I,Args0},_,_,_) ->
+ [F|Args] = resolve_args(Args0),
+ {test,I,F,Args};
resolve_inst({select_val,Args},_,_,_) ->
[Reg,FLbl,{{z,1},{u,_Len},List0}] = Args,
List = resolve_args(List0),
@@ -837,11 +801,6 @@ resolve_inst({get_tuple_element,[Src,{u,Off},Dst]},_,_,_) ->
{get_tuple_element,resolve_arg(Src),Off,resolve_arg(Dst)};
resolve_inst({set_tuple_element,[Src,Dst,{u,Off}]},_,_,_) ->
{set_tuple_element,resolve_arg(Src),resolve_arg(Dst),Off};
-resolve_inst({put_string,[{u,Len},{u,Off},Dst]},_,Strings,_) ->
- String = if Len > 0 -> binary_to_list(Strings, Off+1, Off+Len);
- true -> ""
- end,
- {put_string,Len,{string,String},Dst};
resolve_inst({put_list,[Src1,Src2,Dst]},_,_,_) ->
{put_list,resolve_arg(Src1),resolve_arg(Src2),Dst};
resolve_inst({put_tuple,[{u,Arity},Dst]},_,_,_) ->
@@ -856,9 +815,6 @@ resolve_inst({case_end,[X]},_,_,_) ->
{case_end,resolve_arg(X)};
resolve_inst({call_fun,[{u,N}]},_,_,_) ->
{call_fun,N};
-resolve_inst({make_fun,Args},_,_,Lbls) ->
- [{f,L},Magic,FreeVars] = resolve_args(Args),
- {make_fun,lookup(L,Lbls),Magic,FreeVars};
resolve_inst({is_function=I,Args0},_,_,_) ->
[L|Args] = resolve_args(Args0),
{test,I,L,Args};
@@ -867,30 +823,6 @@ resolve_inst({call_ext_only,[{u,N},{u,MFAix}]},Imports,_,_) ->
%%
%% Instructions for handling binaries added in R7A & R7B
%%
-resolve_inst({bs_start_match,[F,Reg]},_,_,_) ->
- {bs_start_match,F,Reg};
-resolve_inst({bs_get_integer=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
- [A2,A5] = resolve_args([Arg2,Arg5]),
- {test,I,Lbl,[A2,N,decode_field_flags(U),A5]};
-resolve_inst({bs_get_float=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
- [A2,A5] = resolve_args([Arg2,Arg5]),
- {test,I,Lbl,[A2,N,decode_field_flags(U),A5]};
-resolve_inst({bs_get_binary=I,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
- [A2,A5] = resolve_args([Arg2,Arg5]),
- {test,I,Lbl,[A2,N,decode_field_flags(U),A5]};
-resolve_inst({bs_skip_bits,[Lbl,Arg2,{u,N},{u,U}]},_,_,_) ->
- A2 = resolve_arg(Arg2),
- {test,bs_skip_bits,Lbl,[A2,N,decode_field_flags(U)]};
-resolve_inst({bs_test_tail,[F,{u,N}]},_,_,_) ->
- {test,bs_test_tail,F,[N]};
-resolve_inst({bs_save,[{u,N}]},_,_,_) ->
- {bs_save,N};
-resolve_inst({bs_restore,[{u,N}]},_,_,_) ->
- {bs_restore,N};
-resolve_inst({bs_init,[{u,N},{u,U}]},_,_,_) ->
- {bs_init,N,decode_field_flags(U)};
-resolve_inst({bs_final,[F,X]},_,_,_) ->
- {bs_final,F,X};
resolve_inst({bs_put_integer,[Lbl,Arg2,{u,N},{u,U},Arg5]},_,_,_) ->
[A2,A5] = resolve_args([Arg2,Arg5]),
{bs_put_integer,Lbl,A2,N,decode_field_flags(U),A5};
@@ -905,8 +837,6 @@ resolve_inst({bs_put_string,[{u,Len},{u,Off}]},_,Strings,_) ->
true -> ""
end,
{bs_put_string,Len,{string,String}};
-resolve_inst({bs_need_buf,[{u,N}]},_,_,_) ->
- {bs_need_buf,N};
%%
%% Instructions for handling floating point numbers added in June 2001 (R8).
@@ -958,9 +888,6 @@ resolve_inst({raise,[_Reg1,_Reg2]=Regs},_,_,_) ->
resolve_inst({bs_init2,[Lbl,Arg2,{u,W},{u,R},{u,F},Arg6]},_,_,_) ->
[A2,A6] = resolve_args([Arg2,Arg6]),
{bs_init2,Lbl,A2,W,R,decode_field_flags(F),A6};
-resolve_inst({bs_bits_to_bytes,[Lbl,Arg2,Arg3]},_,_,_) ->
- [A2,A3] = resolve_args([Arg2,Arg3]),
- {bs_bits_to_bytes,Lbl,A2,A3};
resolve_inst({bs_add=I,[Lbl,Arg2,Arg3,Arg4,Arg5]},_,_,_) ->
[A2,A3,A4,A5] = resolve_args([Arg2,Arg3,Arg4,Arg5]),
{I,Lbl,[A2,A3,A4],A5};
@@ -1038,12 +965,6 @@ resolve_inst({gc_bif3,Args},Imports,_,_) ->
{gc_bif,BifName,F,Live,[A1,A2,A3],Reg};
%%
-%% New instructions for creating non-byte aligned binaries.
-%%
-resolve_inst({bs_final2,[X,Y]},_,_,_) ->
- {bs_final2,X,Y};
-
-%%
%% R11B-5.
%%
resolve_inst({is_bitstr=I,Args0},_,_,_) ->
@@ -1162,6 +1083,19 @@ resolve_inst({get_map_elements,Args0},_,_,_) ->
{get_map_elements,FLbl,Src,{list,List}};
%%
+%% OTP 21.
+%%
+
+resolve_inst({build_stacktrace,[]},_,_,_) ->
+ build_stacktrace;
+resolve_inst({raw_raise,[]},_,_,_) ->
+ raw_raise;
+resolve_inst({get_hd,[Src,Dst]},_,_,_) ->
+ {get_hd,Src,Dst};
+resolve_inst({get_tl,[Src,Dst]},_,_,_) ->
+ {get_tl,Src,Dst};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl
index d968cd9587..e8ebfc4cfc 100644
--- a/lib/compiler/src/beam_disasm.hrl
+++ b/lib/compiler/src/beam_disasm.hrl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,7 +26,8 @@
%% IT SHOULD BE MOVED TO A FILE THAT DEFINES (AND EXPORTS)
%% PROPER TYPES FOR THE SET OF BEAM INSTRUCTIONS.
%%
--type beam_instr() :: 'bs_init_writable' | 'fclearerror' | 'if_end'
+-type beam_instr() :: 'bs_init_writable' | 'build_stacktrace'
+ | 'fclearerror' | 'if_end' | 'raw_raise'
| 'remove_message' | 'return' | 'send' | 'timeout'
| tuple(). %% XXX: Very underspecified - FIX THIS
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index 4a181c1923..05c0f4fbc7 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -33,6 +33,9 @@
-import(lists, [reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -42,16 +45,15 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = function_1(Is0),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
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
- arity %arity for function
+ {lbl :: beam_asm:label(), %func_info label
+ loc :: [_], %location for func_info
+ arity :: arity() %arity for function
}).
function_1(Is0) ->
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index c9ff07b496..20bd23a912 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -25,6 +25,9 @@
-import(lists, [reverse/1,reverse/2]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs,Lc}, _Opt) ->
{ok,{Mod,Exp,Attr,[function(F) || F <- Fs],Lc}}.
@@ -47,6 +50,9 @@ norm_block([{set,[],[],{alloc,R,Alloc}}|Is], Acc0) ->
Acc ->
norm_block(Is, Acc)
end;
+norm_block([{set,[D1],[S],get_hd},{set,[D2],[S],get_tl}|Is], Acc) ->
+ I = {get_list,S,D1,D2},
+ norm_block(Is, [I|Acc]);
norm_block([I|Is], Acc) -> norm_block(Is, [norm(I)|Acc]);
norm_block([], Acc) -> Acc.
@@ -61,12 +67,14 @@ norm({set,[D],[],{put_tuple,A}}) -> {put_tuple,A,D};
norm({set,[],[S],put}) -> {put,S};
norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D};
norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I};
-norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2};
+norm({set,[D],[S],get_hd}) -> {get_hd,S,D};
+norm({set,[D],[S],get_tl}) -> {get_tl,S,D};
norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) ->
{put_map,F,Op,S,D,R,{list,Puts}};
norm({set,[],[],remove_message}) -> remove_message;
norm({set,[],[],fclearerror}) -> fclearerror;
-norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}.
+norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}};
+norm({set,[],[],{line,_}=Line}) -> Line.
norm_allocate({_Zero,nostack,Nh,[]}, Regs) ->
[{test_heap,Nh,Regs}];
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 48b5a32814..9eee56d604 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,7 +23,7 @@
-export([module/2,
is_unreachable_after/1,is_exit_instruction/1,
- remove_unused_labels/1,is_label_used_in/2]).
+ remove_unused_labels/1]).
%%% The following optimisations are done:
%%%
@@ -71,9 +71,9 @@
%%%
%%% jump L2
%%% . . .
-%%% L1:
%%% L2: ...
%%%
+%%% and all preceding uses of L1 renamed to L2.
%%% If the jump is unreachable, it will be removed according to (1).
%%%
%%% (5) In
@@ -130,6 +130,11 @@
-import(lists, [reverse/1,reverse/2,foldl/3]).
+-type instruction() :: beam_utils:instruction().
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -155,9 +160,7 @@ share(Is0) ->
Is = eliminate_fallthroughs(Is0, []),
share_1(Is, #{}, [], []).
-share_1([{label,_}=Lbl|Is], Dict, [], Acc) ->
- share_1(Is, Dict, [], [Lbl|Acc]);
-share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) ->
+share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) ->
case maps:find(Seq, Dict0) of
error ->
Dict = maps:put(Seq, L, Dict0),
@@ -208,21 +211,18 @@ sharable_with_try([]) -> true.
%% Eliminate all fallthroughs. Return the result reversed.
-eliminate_fallthroughs([I,{label,L}=Lbl|Is], Acc) ->
- case is_unreachable_after(I) orelse is_label(I) of
+eliminate_fallthroughs([{label,L}=Lbl|Is], [I|_]=Acc) ->
+ case is_unreachable_after(I) of
false ->
%% Eliminate fallthrough.
- eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}},I|Acc]);
+ eliminate_fallthroughs(Is, [Lbl,{jump,{f,L}}|Acc]);
true ->
- eliminate_fallthroughs(Is, [Lbl,I|Acc])
+ eliminate_fallthroughs(Is, [Lbl|Acc])
end;
eliminate_fallthroughs([I|Is], Acc) ->
eliminate_fallthroughs(Is, [I|Acc]);
eliminate_fallthroughs([], Acc) -> Acc.
-is_label({label,_}) -> true;
-is_label(_) -> false.
-
%%%
%%% (2) Move short code sequences ending in an instruction that causes an exit
%%% to the end of the function.
@@ -274,15 +274,16 @@ extract_seq_1(_, _) -> no.
-record(st,
{
- entry, %Entry label (must not be moved).
- mlbl, %Moved labels.
- labels :: cerl_sets:set() %Set of referenced labels.
+ entry :: beam_asm:label(), %Entry label (must not be moved).
+ replace :: #{beam_asm:label() := beam_asm:label()}, %Labels to replace.
+ labels :: cerl_sets:set(), %Set of referenced labels.
+ index :: beam_utils:code_index() | {lazy,[beam_utils:instruction()]} %Index built lazily only if needed
}).
opt(Is0, CLabel) ->
find_fixpoint(fun(Is) ->
Lbls = initial_labels(Is),
- St = #st{entry=CLabel,mlbl=#{},labels=Lbls},
+ St = #st{entry=CLabel,replace=#{},labels=Lbls,index={lazy,Is}},
opt(Is, [], St)
end, Is0).
@@ -292,7 +293,7 @@ find_fixpoint(OptFun, Is0) ->
Is -> find_fixpoint(OptFun, Is)
end.
-opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) ->
+opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) ->
%% We have
%% Test Label Ops
%% jump Label
@@ -301,10 +302,23 @@ opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) ->
case beam_utils:is_pure_test(I) of
false ->
%% Test is not pure; we must keep it.
- opt(Is, [I|Acc], label_used(Lbl, St));
+ opt(Is, [I|Acc0], label_used(Lbl, St0));
true ->
%% The test is pure and its failure label is the same
%% as in the jump that follows -- thus it is not needed.
+ %% Check if any of the previous instructions could also be eliminated.
+ {Acc,St} = opt_useless_loads(Acc0, L, St0),
+ opt(Is, Acc, St)
+ end;
+opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) ->
+ %% Similar to the above, except we have a fall-through rather than jump
+ %% Test Label Ops
+ %% label Label
+ case beam_utils:is_pure_test(I) of
+ false ->
+ opt(Is, [I|Acc0], label_used(Lbl, St0));
+ true ->
+ {Acc,St} = opt_useless_loads(Acc0, L, St0),
opt(Is, Acc, St)
end;
opt([{test,Test0,{f,L}=Lbl,Ops}=I|[{jump,To}|Is]=Is0], Acc, St) ->
@@ -326,30 +340,16 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) ->
opt(Is, [I|Acc], label_used(Lbl, St));
opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) ->
skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St));
-opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) ->
- case maps:find(Lbl, Mlbl) of
- {ok,Lbls} ->
- %% Essential to remove the list of labels from the dictionary,
- %% since we will rescan the inserted labels. We MUST rescan.
- St = St0#st{mlbl=maps:remove(Lbl, Mlbl)},
- insert_labels([Lbl|Lbls], Is, Acc, St);
- error ->
- opt(Is, [I|Acc], St0)
- end;
+opt([{label,From}=I,{label,To}|Is], Acc, #st{replace=Replace}=St) ->
+ opt([I|Is], Acc, St#st{replace=Replace#{To => From}});
opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) ->
opt(Is, Acc, St);
opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) ->
opt(Is, Acc, St);
-opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) ->
- %% All labels before this jump instruction should now be
- %% moved to the location of the jump's target.
- {Lbls,Acc} = collect_labels(Acc0, St0),
- St = case Lbls of
- [] -> St0;
- [_|_] ->
- Mlbl = maps_append_list(L, Lbls, Mlbl0),
- St0#st{mlbl=Mlbl}
- end,
+opt([{jump,{f,L}=Lbl}=I|Is], Acc0, St0) ->
+ %% Replace all labels before this jump instruction into the
+ %% location of the jump's target.
+ {Acc,St} = collect_labels(Acc0, L, St0),
skip_unreachable(Is, [I|Acc], label_used(Lbl, St));
%% Optimization: quickly handle some common instructions that don't
%% have any failure labels and where is_unreachable_after(I) =:= false.
@@ -369,36 +369,72 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) ->
true -> skip_unreachable(Is, [I|Acc], St);
false -> opt(Is, [I|Acc], St)
end;
-opt([], Acc, #st{mlbl=Mlbl}) ->
- Code = reverse(Acc),
- insert_fc_labels(Code, Mlbl).
-
-insert_fc_labels([{label,L}=I|Is0], Mlbl) ->
- case maps:find(L, Mlbl) of
- error ->
- [I|insert_fc_labels(Is0, Mlbl)];
- {ok,Lbls} ->
- Is = [{label,Lb} || Lb <- Lbls] ++ Is0,
- [I|insert_fc_labels(Is, maps:remove(L, Mlbl))]
+opt([], Acc, #st{replace=Replace0}) when Replace0 =/= #{} ->
+ Replace = normalize_replace(maps:to_list(Replace0), Replace0, []),
+ beam_utils:replace_labels(Acc, [], Replace, fun(Old) -> Old end);
+opt([], Acc, #st{replace=Replace}) when Replace =:= #{} ->
+ reverse(Acc).
+
+normalize_replace([{From,To0}|Rest], Replace, Acc) ->
+ case Replace of
+ #{To0 := To} ->
+ normalize_replace([{From,To}|Rest], Replace, Acc);
+ _ ->
+ normalize_replace(Rest, Replace, [{From,To0}|Acc])
end;
-insert_fc_labels([_|_]=Is, _) -> Is.
-
-maps_append_list(K,Vs,M) ->
- case M of
- #{K:=Vs0} -> M#{K:=Vs0++Vs}; % same order as dict
- _ -> M#{K => Vs}
- end.
+normalize_replace([], _Replace, Acc) ->
+ maps:from_list(Acc).
+
+%% After eliminating a test, it might happen, that a register was only used
+%% in this test. Let's check if that was the case and if it was so, we can
+%% eliminate the load into the register completely.
+opt_useless_loads([{block,_}|_]=Is, L, #st{index={lazy,FIs}}=St) ->
+ opt_useless_loads(Is, L, St#st{index=beam_utils:index_labels(FIs)});
+opt_useless_loads([{block,Block0}|Is], L, #st{index=Index}=St) ->
+ case opt_useless_block_loads(Block0, L, Index) of
+ [] ->
+ opt_useless_loads(Is, L, St);
+ [_|_]=Block ->
+ {[{block,Block}|Is],St}
+ end;
+%% After eliminating the test and useless blocks, it might happen,
+%% that the previous test could also be eliminated.
+%% It might be that the label was already marked as used, even if ultimately,
+%% it never will be - we can't do much about it at that point, though
+opt_useless_loads([{test,_,{f,L},_}=I|Is], L, St) ->
+ case beam_utils:is_pure_test(I) of
+ false ->
+ {[I|Is],St};
+ true ->
+ opt_useless_loads(Is, L, St)
+ end;
+opt_useless_loads(Is, _L, St) ->
+ {Is,St}.
+
+opt_useless_block_loads([{set,[Dst],_,_}=I|Is], L, Index) ->
+ BlockJump = [{block,Is},{jump,{f,L}}],
+ case beam_utils:is_killed(Dst, BlockJump, Index) of
+ true ->
+ %% The register is killed and not used, we can remove the load
+ opt_useless_block_loads(Is, L, Index);
+ false ->
+ [I|opt_useless_block_loads(Is, L, Index)]
+ end;
+opt_useless_block_loads([I|Is], L, Index) ->
+ [I|opt_useless_block_loads(Is, L, Index)];
+opt_useless_block_loads([], _L, _Index) ->
+ [].
-collect_labels(Is, #st{entry=Entry}) ->
- collect_labels_1(Is, Entry, []).
+collect_labels(Is, Label, #st{entry=Entry,replace=Replace} = St) ->
+ collect_labels_1(Is, Label, Entry, Replace, St).
-collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) ->
+collect_labels_1([{label,Entry}|_]=Is, _Label, Entry, Acc, St) ->
%% Never move the entry label.
- {Acc,Is};
-collect_labels_1([{label,L}|Is], Entry, Acc) ->
- collect_labels_1(Is, Entry, [L|Acc]);
-collect_labels_1(Is, _Entry, Acc) ->
- {Acc,Is}.
+ {Is,St#st{replace=Acc}};
+collect_labels_1([{label,L}|Is], Label, Entry, Acc, St) ->
+ collect_labels_1(Is, Label, Entry, Acc#{L => Label}, St);
+collect_labels_1(Is, _Label, _Entry, Acc, St) ->
+ {Is,St#st{replace=Acc}}.
%% label_defined(Is, Label) -> true | false.
%% Test whether the label Label is defined at the start of the instruction
@@ -418,13 +454,6 @@ invert_test(is_eq_exact) -> is_ne_exact;
invert_test(is_ne_exact) -> is_eq_exact;
invert_test(_) -> not_possible.
-insert_labels([L|Ls], Is, [{jump,{f,L}}|Acc], St) ->
- insert_labels(Ls, [{label,L}|Is], Acc, St);
-insert_labels([L|Ls], Is, Acc, St) ->
- insert_labels(Ls, [{label,L}|Is], Acc, St);
-insert_labels([], Is, Acc, St) ->
- opt(Is, Acc, St).
-
%% skip_unreachable([Instruction], St).
%% Remove all instructions (including definitions of labels
%% that have not been referenced yet) up to the next
@@ -458,6 +487,8 @@ is_label_used(L, St) ->
%% is_unreachable_after(Instruction) -> boolean()
%% Test whether the code after Instruction is unreachable.
+-spec is_unreachable_after(instruction()) -> boolean().
+
is_unreachable_after({func_info,_M,_F,_A}) -> true;
is_unreachable_after(return) -> true;
is_unreachable_after({jump,_Lbl}) -> true;
@@ -470,6 +501,8 @@ is_unreachable_after(I) -> is_exit_instruction(I).
%% Test whether the instruction Instruction always
%% causes an exit/failure.
+-spec is_exit_instruction(instruction()) -> boolean().
+
is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) ->
erl_bifs:is_exit_bif(M, F, A);
is_exit_instruction(if_end) -> true;
@@ -478,40 +511,12 @@ is_exit_instruction({try_case_end,_}) -> true;
is_exit_instruction({badmatch,_}) -> true;
is_exit_instruction(_) -> false.
-%% is_label_used_in(LabelNumber, [Instruction]) -> boolean()
-%% Check whether the label is used in the instruction sequence
-%% (including inside blocks).
-
-is_label_used_in(Lbl, Is) ->
- is_label_used_in_1(Is, Lbl, cerl_sets:new()).
-
-is_label_used_in_1([{block,Block}|Is], Lbl, Empty) ->
- lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block)
- orelse is_label_used_in_1(Is, Lbl, Empty);
-is_label_used_in_1([I|Is], Lbl, Empty) ->
- Used = ulbl(I, Empty),
- cerl_sets:is_element(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty);
-is_label_used_in_1([], _, _) -> false.
-
-is_label_used_in_block({set,_,_,Info}, Lbl) ->
- case Info of
- {bif,_,{f,F}} -> F =:= Lbl;
- {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl;
- {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl;
- {get_map_elements,{f,F}} -> F =:= Lbl;
- {try_catch,_,{f,F}} -> F =:= Lbl;
- {alloc,_,_} -> false;
- {put_tuple,_} -> false;
- {get_tuple_element,_} -> false;
- {set_tuple_element,_} -> false;
- {line,_} -> false;
- _ when is_atom(Info) -> false
- end.
-
%% remove_unused_labels(Instructions0) -> Instructions
%% Remove all unused labels. Also remove unreachable
%% instructions following labels that are removed.
+-spec remove_unused_labels([instruction()]) -> [instruction()].
+
remove_unused_labels(Is) ->
Used0 = initial_labels(Is),
Used = foldl(fun ulbl/2, Used0, Is),
diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl
index ce566373bb..518b958794 100644
--- a/lib/compiler/src/beam_listing.erl
+++ b/lib/compiler/src/beam_listing.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,24 +21,29 @@
-export([module/2]).
--include("v3_life.hrl").
+-include("core_parse.hrl").
+-include("v3_kernel.hrl").
+-include("beam_disasm.hrl").
-import(lists, [foreach/2]).
-module(File, Core) when element(1, Core) == c_module ->
+-type code() :: cerl:c_module()
+ | beam_utils:module_code()
+ | #k_mdef{}
+ | [_]. %form-based format
+
+-spec module(file:io_device(), code()) -> 'ok'.
+
+module(File, #c_module{}=Core) ->
%% This is a core module.
io:put_chars(File, core_pp:format(Core));
-module(File, Kern) when element(1, Kern) == k_mdef ->
+module(File, #k_mdef{}=Kern) ->
%% This is a kernel module.
io:put_chars(File, v3_kernel_pp:format(Kern));
%%io:put_chars(File, io_lib:format("~p~n", [Kern]));
-module(File, {Mod,Exp,Attr,Kern}) ->
- %% This is output from beam_life (v3).
- io:fwrite(File, "~w.~n~p.~n~p.~n", [Mod,Exp,Attr]),
- foreach(fun (F) -> function(File, F) end, Kern);
module(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
- %% This is output from beam_codegen.
- io:format(Stream, "{module, ~p}. %% version = ~w\n",
+ %% This is output from v3_codegen.
+ io:format(Stream, "{module, ~p}. %% version = ~w\n",
[Mod, beam_opcodes:format_number()]),
io:format(Stream, "\n{exports, ~p}.\n", [Exp]),
io:format(Stream, "\n{attributes, ~p}.\n", [Attr]),
@@ -49,10 +54,6 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
[Name, Arity, Entry]),
io:put_chars(Stream, format_asm(Asm))
end, Code);
-module(Stream, {Mod,Exp,Inter}) ->
- %% Other kinds of intermediate formats.
- io:fwrite(Stream, "~w.~n~p.~n", [Mod,Exp]),
- foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Inter);
module(Stream, [_|_]=Fs) ->
%% Form-based abstract format.
foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs).
@@ -62,60 +63,3 @@ format_asm([{label,L}|Is]) ->
format_asm([I|Is]) ->
[io_lib:format(" ~p", [I]),".\n"|format_asm(Is)];
format_asm([]) -> [].
-
-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]),
- print_vdb(File, Vdb),
- put(beam_listing_nl, false),
- nl(File),
- foreach(fun(F) -> format(File, F, []) end, Body),
- nl(File),
- erase(beam_listing_nl).
-
-format(File, #l{ke=Ke,i=I,vdb=Vdb}, Ind) ->
- nl(File),
- ind_format(File, Ind, "~p ", [I]),
- print_vdb(File, Vdb),
- nl(File),
- format(File, Ke, Ind);
-format(File, Tuple, Ind) when is_tuple(Tuple) ->
- ind_format(File, Ind, "{", []),
- format_list(File, tuple_to_list(Tuple), [$\s|Ind]),
- ind_format(File, Ind, "}", []);
-format(File, List, Ind) when is_list(List) ->
- ind_format(File, Ind, "[", []),
- format_list(File, List, [$\s|Ind]),
- ind_format(File, Ind, "]", []);
-format(File, F, Ind) ->
- ind_format(File, Ind, "~p", [F]).
-
-format_list(File, [F], Ind) ->
- format(File, F, Ind);
-format_list(File, [F|Fs], Ind) ->
- format(File, F, Ind),
- ind_format(File, Ind, ",", []),
- format_list(File, Fs, Ind);
-format_list(_, [], _) -> ok.
-
-
-print_vdb(File, [{Var,F,E}|Vs]) ->
- io:format(File, "~p:~p..~p ", [Var,F,E]),
- print_vdb(File, Vs);
-print_vdb(_, []) -> ok.
-
-ind_format(File, Ind, Format, Args) ->
- case get(beam_listing_nl) of
- true ->
- put(beam_listing_nl, false),
- io:put_chars(File, Ind);
- false -> ok
- end,
- io:format(File, Format, Args).
-
-nl(File) ->
- case put(beam_listing_nl, true) of
- true -> ok;
- false -> io:nl(File)
- end.
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index c8bef31824..2b8dd40e29 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,6 +24,9 @@
-import(lists, [reverse/1,member/2]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,_}, _Opts) ->
%% First coalesce adjacent labels.
{Fs1,Lc} = beam_clean:clean_labels(Fs0),
@@ -38,8 +41,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = beam_jump:remove_unused_labels(Is1),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -75,6 +77,12 @@ peep([{bif,tuple_size,_,[_]=Ops,Dst}=I|Is], SeenTests0, Acc) ->
%% Kill all remembered tests that depend on the destination register.
SeenTests = kill_seen(Dst, SeenTests1),
peep(Is, SeenTests, [I|Acc]);
+peep([{bif,map_get,_,[Key,Map],Dst}=I|Is], SeenTests0, Acc) ->
+ %% Pretend that we have seen {test,has_map_fields,_,[Map,Key]}
+ SeenTests1 = gb_sets:add({has_map_fields,[Map,Key]}, SeenTests0),
+ %% Kill all remembered tests that depend on the destination register.
+ SeenTests = kill_seen(Dst, SeenTests1),
+ peep(Is, SeenTests, [I|Acc]);
peep([{bif,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
%% Kill all remembered tests that depend on the destination register.
SeenTests = kill_seen(Dst, SeenTests0),
@@ -86,15 +94,37 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) ->
peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) ->
%% Sometimes beam_jump has missed this optimization.
peep(Is, gb_sets:empty(), [I|Acc]);
-peep([{select,Op,R,F,Vls0}|Is], _, Acc) ->
+peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) ->
case prune_redundant_values(Vls0, F) of
[] ->
%% No values left. Must convert to plain jump.
I = {jump,F},
- peep(Is, gb_sets:empty(), [I|Acc]);
+ peep([I|Is], gb_sets:empty(), Acc0);
+ [{atom,_}=Value,Lbl] when Op =:= select_val ->
+ %% Single value left. Convert to regular test and pop redundant tests.
+ Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is],
+ case Acc0 of
+ [{test,is_atom,F,[R]}|Acc] ->
+ peep(Is1, SeenTests0, Acc);
+ _ ->
+ peep(Is1, SeenTests0, Acc0)
+ end;
+ [{integer,_}=Value,Lbl] when Op =:= select_val ->
+ %% Single value left. Convert to regular test and pop redundant tests.
+ Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is],
+ case Acc0 of
+ [{test,is_integer,F,[R]}|Acc] ->
+ peep(Is1, SeenTests0, Acc);
+ _ ->
+ peep(Is1, SeenTests0, Acc0)
+ end;
+ [Arity,Lbl] when Op =:= select_tuple_arity ->
+ %% Single value left. Convert to regular test
+ Is1 = [{test,test_arity,F,[R,Arity]},{jump,Lbl}|Is],
+ peep(Is1, SeenTests0, Acc0);
[_|_]=Vls ->
I = {select,Op,R,F,Vls},
- peep(Is, gb_sets:empty(), [I|Acc])
+ peep(Is, gb_sets:empty(), [I|Acc0])
end;
peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
case beam_utils:is_pure_test(I) of
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
index 89cafe27ce..ddbe67605a 100644
--- a/lib/compiler/src/beam_receive.erl
+++ b/lib/compiler/src/beam_receive.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -65,6 +65,9 @@
%%% as the SomeUniqInteger.
%%%
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [function(F) || F <- Fs0],
Code = {Mod,Exp,Attr,Fs,Lc},
@@ -79,8 +82,7 @@ function({function,Name,Arity,Entry,Is}) ->
D = beam_utils:index_labels(Is),
{function,Name,Arity,Entry,opt(Is, D, [])}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -204,6 +206,8 @@ opt_update_regs({label,Lbl}, R, L) ->
%% A catch label for a previously seen catch instruction is OK.
{R,L}
end;
+opt_update_regs({'try',_,{f,Lbl}}, R, L) ->
+ {R,gb_sets:add(Lbl, L)};
opt_update_regs({try_end,_}, R, L) ->
{R,L};
opt_update_regs({line,_}, R, L) ->
diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl
new file mode 100644
index 0000000000..58a6de6775
--- /dev/null
+++ b/lib/compiler/src/beam_record.erl
@@ -0,0 +1,131 @@
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2014-2017. 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%
+%%
+
+%% Rewrite the instruction stream on tagged tuple tests.
+%% Tagged tuples means a tuple of any arity with an atom as its
+%% first element, such as records and error tuples.
+%%
+%% From:
+%% ...
+%% {test,is_tuple,Fail,[Src]}.
+%% {test,test_arity,Fail,[Src,Sz]}.
+%% ...
+%% {get_tuple_element,Src,0,Dst}.
+%% ...
+%% {test,is_eq_exact,Fail,[Dst,Atom]}.
+%% ...
+%% To:
+%% ...
+%% {test,is_tagged_tuple,Fail,[Src,Sz,Atom]}.
+%% ...
+%%
+
+-module(beam_record).
+-export([module/2]).
+
+-import(lists, [reverse/1,reverse/2]).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
+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
+ Is1 = beam_utils:anno_defs(Is0),
+ Idx = beam_utils:index_labels(Is1),
+ Is = rewrite(reverse(Is1), Idx),
+ {function,Name,Arity,CLabel,Is}
+ catch
+ Class:Error:Stack ->
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+rewrite(Is, Idx) ->
+ rewrite(Is, Idx, 0, []).
+
+rewrite([{test,test_arity,Fail,[Src,N]}=TA,
+ {test,is_tuple,Fail,[Src]}=TT|Is], Idx, Def, Acc0) ->
+ case is_tagged_tuple(Acc0, Def, Fail, Src, Idx) of
+ no ->
+ rewrite(Is, Idx, 0, [TT,TA|Acc0]);
+ {yes,Atom,Acc} ->
+ I = {test,is_tagged_tuple,Fail,[Src,N,Atom]},
+ rewrite(Is, Idx, Def, [I|Acc])
+ end;
+rewrite([{block,[{'%anno',{def,Def}}|Bl]}|Is], Idx, _Def, Acc) ->
+ rewrite(Is, Idx, Def, [{block,Bl}|Acc]);
+rewrite([{label,L}=I|Is], Idx0, Def, Acc) ->
+ Idx = beam_utils:index_label(L, Acc, Idx0),
+ rewrite(Is, Idx, Def, [I|Acc]);
+rewrite([I|Is], Idx, Def, Acc) ->
+ rewrite(Is, Idx, Def, [I|Acc]);
+rewrite([], _, _, Acc) -> Acc.
+
+is_tagged_tuple([{block,Bl},
+ {test,is_eq_exact,Fail,[Dst,{atom,_}=Atom]}|Is],
+ Def, Fail, Src, Idx) ->
+ case is_tagged_tuple_1(Bl, Is, Fail, Src, Dst, Idx, Def, []) of
+ no ->
+ no;
+ {yes,[]} ->
+ {yes,Atom,Is};
+ {yes,[_|_]=Block} ->
+ {yes,Atom,[{block,Block}|Is]}
+ end;
+is_tagged_tuple(_, _, _, _, _) ->
+ no.
+
+is_tagged_tuple_1([{set,[Dst],[Src],{get_tuple_element,0}}=I|Bl],
+ Is, Fail, Src, Dst, Idx, Def, Acc) ->
+ %% Check usage of Dst to find out whether the get_tuple_element
+ %% is needed.
+ case usage(Dst, Is, Fail, Idx) of
+ killed ->
+ %% Safe to remove the get_tuple_element instruction.
+ {yes,reverse(Acc, Bl)};
+ used ->
+ %% Actively used. Must keep instruction.
+ {yes,reverse(Acc, [I|Bl])};
+ not_used ->
+ %% Not actually used (but must be initialized).
+ case is_defined(Dst, Def) of
+ false ->
+ %% Dst must be initialized, but the
+ %% actual value does not matter.
+ Kill = {set,[Dst],[nil],move},
+ {yes,reverse(Acc, [Kill|Bl])};
+ true ->
+ %% The register is previously initialized.
+ %% We can remove the instruction.
+ {yes,reverse(Acc, Bl)}
+ end
+ end;
+is_tagged_tuple_1([I|Bl], Is, Fail, Src, Dst, Idx, Def, Acc) ->
+ is_tagged_tuple_1(Bl, Is, Fail, Src, Dst, Idx, Def, [I|Acc]);
+is_tagged_tuple_1(_, _, _, _, _, _, _, _) ->
+ no.
+
+usage(Dst, Is, Fail, Idx) ->
+ beam_utils:usage(Dst, [{test,is_number,Fail,[nil]}|Is], Idx).
+
+is_defined({x,X}, Def) ->
+ (Def bsr X) band 1 =:= 1.
diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl
index 6a7c033ec6..8d2ef5a431 100644
--- a/lib/compiler/src/beam_reorder.erl
+++ b/lib/compiler/src/beam_reorder.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,6 +23,9 @@
-export([module/2]).
-import(lists, [member/2,reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -32,8 +35,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
Is = reorder(Is0),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index feeab0af50..809e49b3d0 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,6 +23,9 @@
-import(lists, [reverse/1]).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [split_blocks(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -47,8 +50,9 @@ split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) ->
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,{bif,raise,{f,_}=Fail}}|Is], Bl, Acc) ->
- split_block(Is, [], [{bif,raise,Fail,As,R}|make_block(Bl, Acc)]);
+split_block([{set,[],[],{line,_}=Line},
+ {set,[R],As,{bif,raise,{f,_}=Fail}}|Is], Bl, Acc) ->
+ split_block(Is, [], [{bif,raise,Fail,As,R},Line|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)]);
@@ -58,8 +62,6 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is],
make_block(Bl, Acc)]);
split_block([{set,[R],[],{try_catch,Op,L}}|Is], Bl, Acc) ->
split_block(Is, [], [{Op,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).
diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl
index a8dc6805bc..4da0985085 100644
--- a/lib/compiler/src/beam_trim.erl
+++ b/lib/compiler/src/beam_trim.erl
@@ -24,10 +24,13 @@
-import(lists, [reverse/1,reverse/2,splitwith/2,sort/1]).
-record(st,
- {safe, %Safe labels.
- lbl %Code at each label.
+ {safe :: gb_sets:set(beam_asm:label()), %Safe labels.
+ lbl :: beam_utils:code_index() %Code at each label.
}).
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [function(F) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
@@ -230,7 +233,7 @@ safe_labels([], Acc) -> gb_sets:from_list(Acc).
frame_layout(Is, Kills, #st{safe=Safe,lbl=D}) ->
N = frame_size(Is, Safe),
- IsKilled = fun(R) -> beam_utils:is_killed(R, Is, D) end,
+ IsKilled = fun(R) -> beam_utils:is_not_used(R, Is, D) end,
{N,frame_layout_1(Kills, 0, N, IsKilled, [])}.
frame_layout_1([{kill,{y,Y}}=I|Ks], Y, N, IsKilled, Acc) ->
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index acaf3ede66..b5c979e529 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -17,14 +17,20 @@
%%
%% %CopyrightEnd%
%%
-%% Purpose : Type-based optimisations.
+%% Purpose: Type-based optimisations. See the comment for verified_type/1
+%% the very end of this file for a description of the types in the
+%% type database.
-module(beam_type).
-export([module/2]).
--import(lists, [filter/2,foldl/3,keyfind/3,member/2,
- reverse/1,reverse/2,sort/1]).
+-import(lists, [foldl/3,member/2,reverse/1,reverse/2,sort/1]).
+
+-define(UNICODE_INT, {integer,{0,16#10FFFF}}).
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
Fs = [function(F) || F <- Fs0],
@@ -34,11 +40,11 @@ function({function,Name,Arity,CLabel,Asm0}) ->
try
Asm1 = beam_utils:live_opt(Asm0),
Asm2 = opt(Asm1, [], tdb_new()),
- Asm = beam_utils:delete_live_annos(Asm2),
+ Asm3 = beam_utils:live_opt(Asm2),
+ Asm = beam_utils:delete_annos(Asm3),
{function,Name,Arity,CLabel,Asm}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -75,96 +81,81 @@ simplify(Is0, TypeDb0) ->
%% Basic simplification, mostly tuples, no floating point optimizations.
simplify_basic(Is, Ts) ->
- simplify_basic_1(Is, Ts, []).
-
-simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, Acc) ->
- I = case max_tuple_size(Reg, Ts0) of
- Sz when 0 < Index, Index =< Sz ->
- {set,[D],[Reg],{get_tuple_element,Index-1}};
- _Other -> I0
- end,
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc]);
-simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) ->
- case tdb_find(TupleReg, Ts0) of
- {tuple,_,[Contents]} ->
- simplify_basic_1([{set,[D],[Contents],move}|Is0], Ts0, Acc);
- _ ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is0, Ts, [I|Acc])
+ simplify_basic(Is, Ts, []).
+
+simplify_basic([I0|Is], Ts0, Acc) ->
+ case simplify_instr(I0, Ts0) of
+ [] ->
+ simplify_basic(Is, Ts0, Acc);
+ [I] ->
+ Ts = update(I, Ts0),
+ simplify_basic(Is, Ts, [I|Acc])
end;
-simplify_basic_1([{set,_,_,{try_catch,_,_}}=I|Is], _Ts, Acc) ->
- simplify_basic_1(Is, tdb_new(), [I|Acc]);
-simplify_basic_1([{test,is_atom,_,[R]}=I|Is], Ts, Acc) ->
+simplify_basic([], Ts, Acc) ->
+ {reverse(Acc),Ts}.
+
+%% simplify_instr(Instruction, Ts) -> [Instruction].
+
+%% Simplify a simple instruction using type information. Return an
+%% empty list if the instruction should be removed, or a list with
+%% the original or modified instruction.
+
+simplify_instr({set,[D],[{integer,Index},Reg],{bif,element,_}}=I, Ts) ->
+ case max_tuple_size(Reg, Ts) of
+ Sz when 0 < Index, Index =< Sz ->
+ [{set,[D],[Reg],{get_tuple_element,Index-1}}];
+ _ -> [I]
+ end;
+simplify_instr({test,Test,Fail,[R]}=I, Ts) ->
case tdb_find(R, Ts) of
- boolean -> simplify_basic_1(Is, Ts, Acc);
- _ -> simplify_basic_1(Is, Ts, [I|Acc])
+ any ->
+ [I];
+ Type ->
+ case will_succeed(Test, Type) of
+ yes -> [];
+ no -> [{jump,Fail}];
+ maybe -> [I]
+ end
+ end;
+simplify_instr({set,[D],[TupleReg],{get_tuple_element,0}}=I, Ts) ->
+ case tdb_find(TupleReg, Ts) of
+ {tuple,_,_,[Contents]} ->
+ [{set,[D],[Contents],move}];
+ _ ->
+ [I]
end;
-simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) ->
+simplify_instr({test,test_arity,_,[R,Arity]}=I, Ts) ->
case tdb_find(R, Ts) of
- integer -> simplify_basic_1(Is, Ts, Acc);
- {integer,_} -> simplify_basic_1(Is, Ts, Acc);
- _ -> simplify_basic_1(Is, Ts, [I|Acc])
+ {tuple,exact_size,Arity,_} -> [];
+ _ -> [I]
end;
-simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) ->
+simplify_instr({test,is_eq_exact,Fail,[R,{atom,A}=Atom]}=I, Ts) ->
case tdb_find(R, Ts) of
- {tuple,_,_} -> simplify_basic_1(Is, Ts, Acc);
- _ -> simplify_basic_1(Is, Ts, [I|Acc])
+ {atom,_}=Atom -> [];
+ boolean when is_boolean(A) -> [I];
+ any -> [I];
+ _ -> [{jump,Fail}]
end;
-simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) ->
- case tdb_find(R, Ts0) of
- {tuple,Arity,_} ->
- simplify_basic_1(Is, Ts0, Acc);
- _Other ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc])
+simplify_instr({test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I, Ts) ->
+ case tdb_find(R, Ts) of
+ {tuple,exact_size,Arity,[Tag]} -> [];
+ _ -> [I]
end;
-simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) ->
- case tdb_find(R, Ts0) of
- map -> simplify_basic_1(Is, Ts0, Acc);
- _Other ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc])
+simplify_instr({select,select_val,Reg,_,_}=I, Ts) ->
+ [case tdb_find(Reg, Ts) of
+ {integer,Range} ->
+ simplify_select_val_int(I, Range);
+ boolean ->
+ simplify_select_val_bool(I);
+ _ ->
+ I
+ end];
+simplify_instr({test,bs_test_unit,_,[Src,Unit]}=I, Ts) ->
+ case tdb_find(Src, Ts) of
+ {binary,U} when U rem Unit =:= 0 -> [];
+ _ -> [I]
end;
-simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) ->
- case tdb_find(R, Ts0) of
- nonempty_list -> simplify_basic_1(Is, Ts0, Acc);
- _Other ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc])
- end;
-simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) ->
- Acc = case tdb_find(R, Ts0) of
- {atom,_}=Atom -> Acc0;
- {atom,_} -> [{jump,Fail}|Acc0];
- _ -> [I|Acc0]
- end,
- Ts = update(I, Ts0),
- simplify_basic_1(Is0, Ts, Acc);
-simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0, Acc) ->
- case tdb_find(R, Ts0) of
- {tuple,Arity,[Tag]} ->
- simplify_basic_1(Is, Ts0, Acc);
- _Other ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc])
- end;
-simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) ->
- I = case tdb_find(Reg, Ts) of
- {integer,Range} ->
- simplify_select_val_int(I0, Range);
- boolean ->
- simplify_select_val_bool(I0);
- _ ->
- I0
- end,
- simplify_basic_1(Is, tdb_new(), [I|Acc]);
-simplify_basic_1([I|Is], Ts0, Acc) ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc]);
-simplify_basic_1([], Ts, Acc) ->
- Is = reverse(Acc),
- {Is,Ts}.
+simplify_instr(I, _) -> [I].
simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) ->
Vs = sort([V || {integer,V} <- L0]),
@@ -192,6 +183,53 @@ eq_ranges([H], H, H) -> true;
eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max);
eq_ranges(_, _, _) -> false.
+%% will_succeed(TestOperation, Type) -> yes|no|maybe.
+%% Test whether TestOperation applied to an argument of type Type
+%% will succeed. Return yes, no, or maybe.
+%%
+%% Type is a type as described in the comment for verified_type/1 at
+%% the very end of this file, but it will *never* be 'any'.
+
+will_succeed(is_atom, Type) ->
+ case Type of
+ {atom,_} -> yes;
+ boolean -> yes;
+ _ -> no
+ end;
+will_succeed(is_binary, Type) ->
+ case Type of
+ {binary,U} when U rem 8 =:= 0 -> yes;
+ {binary,_} -> maybe;
+ _ -> no
+ end;
+will_succeed(is_bitstr, Type) ->
+ case Type of
+ {binary,_} -> yes;
+ _ -> no
+ end;
+will_succeed(is_integer, Type) ->
+ case Type of
+ integer -> yes;
+ {integer,_} -> yes;
+ _ -> no
+ end;
+will_succeed(is_map, Type) ->
+ case Type of
+ map -> yes;
+ _ -> no
+ end;
+will_succeed(is_nonempty_list, Type) ->
+ case Type of
+ nonempty_list -> yes;
+ _ -> no
+ end;
+will_succeed(is_tuple, Type) ->
+ case Type of
+ {tuple,_,_,_} -> yes;
+ _ -> no
+ end;
+will_succeed(_, _) -> maybe.
+
%% simplify_float([Instruction], TypeDatabase) ->
%% {[Instruction],TypeDatabase'} | not_possible
%% Simplify floating point operations in blocks.
@@ -221,7 +259,7 @@ simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0,
{D,Rs} = find_dest(D0, Rs1),
Areg = fetch_reg(A, Rs),
Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)],
- Ts = tdb_update([{D0,float}], Ts0),
+ Ts = tdb_store(D0, float, Ts0),
simplify_float_1(Is, Ts, Rs, Acc);
_Other ->
Ts = update(I, Ts0),
@@ -244,7 +282,7 @@ simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0,
Areg = fetch_reg(A, Rs),
Breg = fetch_reg(B, Rs),
Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)],
- Ts = tdb_update([{D0,float}], Ts0),
+ Ts = tdb_store(D0, float, Ts0),
simplify_float_1(Is, Ts, Rs, Acc)
end;
simplify_float_1([{set,_,_,{try_catch,_,_}}=I|Is]=Is0, _Ts, Rs0, Acc0) ->
@@ -295,7 +333,7 @@ clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs].
%% Combine two blocks and eliminate any move instructions that assign
%% to registers that are killed later in the block.
%%
-merge_blocks(B1, [{'%live',_,_}|B2]) ->
+merge_blocks(B1, [{'%anno',_}|B2]) ->
merge_blocks_1(B1++[{set,[],[],stop_here}|B2]).
merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is;
@@ -344,27 +382,17 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) ->
{[],H+1,Fl};
flt_need_heap_2({set,_,_,put}, H, Fl) ->
{[],H+1,Fl};
-%% Then the "neutral" instructions. We just pass them.
-flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,[],[],fclearerror}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,[],[],fcheckerror}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,{bif,_,_}}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,move}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,{get_tuple_element,_}}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,get_list}, H, Fl) ->
- {[],H,Fl};
-flt_need_heap_2({set,_,_,{try_catch,_,_}}, H, Fl) ->
- {[],H,Fl};
-%% All other instructions should cause the insertion of an allocation
+%% The following instructions cause the insertion of an allocation
%% instruction if needed.
+flt_need_heap_2({set,_,_,{alloc,_,_}}, H, Fl) ->
+ {flt_alloc(H, Fl),0,0};
+flt_need_heap_2({set,_,_,{set_tuple_element,_}}, H, Fl) ->
+ {flt_alloc(H, Fl),0,0};
+flt_need_heap_2({'%anno',_}, H, Fl) ->
+ {flt_alloc(H, Fl),0,0};
+%% All other instructions are "neutral". We just pass them.
flt_need_heap_2(_, H, Fl) ->
- {flt_alloc(H, Fl),0,0}.
+ {[],H,Fl}.
flt_alloc(0, 0) ->
[];
@@ -387,7 +415,7 @@ build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}.
%% is not continous at an allocation function (e.g. if {x,0} and {x,2}
%% are live, but not {x,1}).
-flt_liveness([{'%live',_Live,Regs}=LiveInstr|Is]) ->
+flt_liveness([{'%anno',{used,Regs}}=LiveInstr|Is]) ->
flt_liveness_1(Is, Regs, [LiveInstr]).
flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) ->
@@ -399,7 +427,7 @@ flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) ->
flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) ->
Regs = x_live(Ds, Regs0),
flt_liveness_1(Is, Regs, [I|Acc]);
-flt_liveness_1([{'%live',_,_}], _Regs, Acc) ->
+flt_liveness_1([{'%anno',_}], _Regs, Acc) ->
reverse(Acc).
init_regs(Live) ->
@@ -423,99 +451,153 @@ x_live([], Regs) -> Regs.
%% Update the type database to account for executing an instruction.
%%
%% First the cases for instructions inside basic blocks.
-update({'%live',_,_}, Ts) -> Ts;
+update({'%anno',_}, Ts) ->
+ Ts;
update({set,[D],[S],move}, Ts) ->
tdb_copy(S, D, Ts);
-update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) ->
- tdb_update([{Reg,{tuple,I,[]}},{D,kill}], Ts0);
-update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) ->
- tdb_update([{Reg,{tuple,0,[]}},{D,kill}], Ts0);
-update({set,[D],Args,{bif,N,_}}, Ts0) ->
+update({set,[D],[Index,Reg],{bif,element,_}}, Ts0) ->
+ MinSize = case Index of
+ {integer,I} -> I;
+ _ -> 0
+ end,
+ Ts = tdb_meet(Reg, {tuple,min_size,MinSize,[]}, Ts0),
+ tdb_store(D, any, Ts);
+update({set,[D],[_Key,Map],{bif,map_get,_}}, Ts0) ->
+ Ts = tdb_meet(Map, map, Ts0),
+ tdb_store(D, any, Ts);
+update({set,[D],Args,{bif,N,_}}, Ts) ->
Ar = length(Args),
BoolOp = erl_internal:new_type_test(N, Ar) orelse
erl_internal:comp_op(N, Ar) orelse
erl_internal:bool_op(N, Ar),
- case BoolOp of
- true ->
- tdb_update([{D,boolean}], Ts0);
- false ->
- tdb_update([{D,kill}], Ts0)
+ Type = case BoolOp of
+ true -> boolean;
+ false -> unary_op_type(N)
+ end,
+ tdb_store(D, Type, Ts);
+update({set,[D],[S],{get_tuple_element,0}}, Ts0) ->
+ if
+ D =:= S ->
+ tdb_store(D, any, Ts0);
+ true ->
+ Ts = tdb_store(D, {tuple_element,S,0}, Ts0),
+ tdb_store(S, {tuple,min_size,1,[]}, Ts)
end;
-update({set,[D],[S],{get_tuple_element,0}}, Ts) ->
- tdb_update([{D,{tuple_element,S,0}}], Ts);
update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) ->
%% Make sure we reject non-numeric literal argument.
case possibly_numeric(S) of
- true -> tdb_update([{D,float}], Ts0);
- false -> Ts0
+ true -> tdb_store(D, float, Ts0);
+ false -> Ts0
end;
update({set,[D],[S1,S2],{alloc,_,{gc_bif,'band',{f,0}}}}, Ts) ->
- case keyfind(integer, 1, [S1,S2]) of
- {integer,N} ->
- update_band(N, D, Ts);
- false ->
- tdb_update([{D,integer}], Ts)
- end;
-update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) ->
+ Type = band_type(S1, S2, Ts),
+ tdb_store(D, Type, Ts);
+update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts) ->
%% Make sure we reject non-numeric literals.
case possibly_numeric(S1) andalso possibly_numeric(S2) of
- true -> tdb_update([{D,float}], Ts0);
- false -> Ts0
+ true -> tdb_store(D, float, Ts);
+ false -> Ts
end;
update({set,[D],[S1,S2],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts0) ->
case op_type(Op) of
integer ->
- tdb_update([{D,integer}], Ts0);
- {float,_} ->
- case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of
- {float,_} -> tdb_update([{D,float}], Ts0);
- {_,float} -> tdb_update([{D,float}], Ts0);
- {_,_} -> tdb_update([{D,kill}], Ts0)
- end;
- unknown ->
- tdb_update([{D,kill}], Ts0)
- end;
-update({set,[],_Src,_Op}, Ts0) -> Ts0;
-update({set,[D],_Src,_Op}, Ts0) ->
- tdb_update([{D,kill}], Ts0);
-update({set,[D1,D2],_Src,_Op}, Ts0) ->
- tdb_update([{D1,kill},{D2,kill}], Ts0);
+ tdb_store(D, integer, Ts0);
+ {float,_} ->
+ case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of
+ {float,_} -> tdb_store(D, float, Ts0);
+ {_,float} -> tdb_store(D, float, Ts0);
+ {_,_} -> tdb_store(D, any, Ts0)
+ end;
+ Type ->
+ tdb_store(D, Type, Ts0)
+ end;
+update({set,[D],[_],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts) ->
+ tdb_store(D, unary_op_type(Op), Ts);
+update({set,[],_Src,_Op}, Ts) ->
+ Ts;
+update({set,[D],_Src,_Op}, Ts) ->
+ tdb_store(D, any, Ts);
update({kill,D}, Ts) ->
- tdb_update([{D,kill}], Ts);
+ tdb_store(D, any, Ts);
%% Instructions outside of blocks.
-update({test,is_float,_Fail,[Src]}, Ts0) ->
- tdb_update([{Src,float}], Ts0);
-update({test,test_arity,_Fail,[Src,Arity]}, Ts0) ->
- tdb_update([{Src,{tuple,Arity,[]}}], Ts0);
-update({test,is_map,_Fail,[Src]}, Ts0) ->
- tdb_update([{Src,map}], Ts0);
-update({test,is_nonempty_list,_Fail,[Src]}, Ts0) ->
- tdb_update([{Src,nonempty_list}], Ts0);
-update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
- case tdb_find(Reg, Ts) of
- error ->
- Ts;
- {tuple_element,TupleReg,0} ->
- tdb_update([{TupleReg,{tuple,1,[Atom]}}], Ts);
- _ ->
- Ts
- end;
+update({test,test_arity,_Fail,[Src,Arity]}, Ts) ->
+ tdb_meet(Src, {tuple,exact_size,Arity,[]}, Ts);
+update({get_map_elements,_,Src,{list,Elems0}}, Ts0) ->
+ Ts1 = tdb_meet(Src, map, Ts0),
+ {_Ss,Ds} = beam_utils:split_even(Elems0),
+ foldl(fun(Dst, A) -> tdb_store(Dst, any, A) end, Ts1, Ds);
+update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts0) ->
+ Ts = case tdb_find_source_tuple(Reg, Ts0) of
+ {source_tuple,TupleReg} ->
+ tdb_meet(TupleReg, {tuple,min_size,1,[Atom]}, Ts0);
+ none ->
+ Ts0
+ end,
+ tdb_meet(Reg, Atom, Ts);
update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) ->
- tdb_update([{Src,{tuple,Arity,[Tag]}}], Ts);
+ tdb_meet(Src, {tuple,exact_size,Arity,[Tag]}, Ts);
+
+%% Binaries and binary matching.
+
+update({test,bs_get_integer2,_,_,Args,Dst}, Ts) ->
+ tdb_store(Dst, get_bs_integer_type(Args), Ts);
+update({test,bs_get_utf8,_,_,_,Dst}, Ts) ->
+ tdb_store(Dst, ?UNICODE_INT, Ts);
+update({test,bs_get_utf16,_,_,_,Dst}, Ts) ->
+ tdb_store(Dst, ?UNICODE_INT, Ts);
+update({test,bs_get_utf32,_,_,_,Dst}, Ts) ->
+ tdb_store(Dst, ?UNICODE_INT, Ts);
+update({bs_init,_,{bs_init2,_,_},_,_,Dst}, Ts) ->
+ tdb_store(Dst, {binary,8}, Ts);
+update({bs_init,_,_,_,_,Dst}, Ts) ->
+ tdb_store(Dst, {binary,1}, Ts);
+update({bs_put,_,_,_}, Ts) ->
+ Ts;
+update({bs_save2,_,_}, Ts) ->
+ Ts;
+update({bs_restore2,_,_}, Ts) ->
+ Ts;
+update({bs_context_to_binary,Dst}, Ts) ->
+ tdb_store(Dst, any, Ts);
+update({test,bs_start_match2,_,_,[Src,_],Dst}, Ts0) ->
+ Ts = tdb_meet(Src, {binary,1}, Ts0),
+ tdb_copy(Src, Dst, Ts);
+update({test,bs_get_binary2,_,_,[_,_,Unit,_],Dst}, Ts) ->
+ true = is_integer(Unit), %Assertion.
+ tdb_store(Dst, {binary,Unit}, Ts);
+update({test,bs_get_float2,_,_,_,Dst}, Ts) ->
+ tdb_store(Dst, float, Ts);
+update({test,bs_test_unit,_,[Src,Unit]}, Ts) ->
+ tdb_meet(Src, {binary,Unit}, Ts);
+
+%% Other test instructions
+update({test,Test,_Fail,[Src]}, Ts) ->
+ Type = case Test of
+ is_binary -> {binary,8};
+ is_bitstr -> {binary,1};
+ is_boolean -> boolean;
+ is_float -> float;
+ is_integer -> integer;
+ is_map -> map;
+ is_nonempty_list -> nonempty_list;
+ _ -> any
+ end,
+ tdb_meet(Src, Type, Ts);
update({test,_Test,_Fail,_Other}, Ts) ->
Ts;
-update({test,bs_get_integer2,_,_,Args,Dst}, Ts) ->
- tdb_update([{Dst,get_bs_integer_type(Args)}], Ts);
+
+%% Calls
+
update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) ->
case is_math_bif(Math, Ar) of
- true -> tdb_update([{{x,0},float}], Ts);
+ true -> tdb_store({x,0}, float, Ts);
false -> tdb_kill_xregs(Ts)
end;
update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
Ts = tdb_kill_xregs(Ts0),
case tdb_find({x,1}, Ts0) of
- {tuple,Sz,_}=T0 ->
+ {tuple,SzKind,Sz,_}=T0 ->
T = case tdb_find({x,0}, Ts0) of
{integer,{I,I}} when I > 1 ->
%% First element is not changed. The result
@@ -524,36 +606,45 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
_ ->
%% Position is 1 or unknown. May change the
%% first element of the tuple.
- {tuple,Sz,[]}
+ {tuple,SzKind,Sz,[]}
end,
- tdb_update([{{x,0},T}], Ts);
+ tdb_store({x,0}, T, Ts);
_ ->
Ts
end;
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({call_fun, _}, Ts) -> tdb_kill_xregs(Ts);
+update({apply, _}, Ts) -> tdb_kill_xregs(Ts);
+
update({line,_}, Ts) -> Ts;
-update({bs_save2,_,_}, Ts) -> Ts;
-update({bs_restore2,_,_}, Ts) -> Ts;
+update({'%',_}, Ts) -> Ts;
%% The instruction is unknown. Kill all information.
update(_I, _Ts) -> tdb_new().
-update_band(N, Reg, Ts) ->
- Type = update_band_1(N, 0),
- tdb_update([{Reg,Type}], Ts).
+band_type({integer,Int}, Other, Ts) ->
+ band_type_1(Int, Other, Ts);
+band_type(Other, {integer,Int}, Ts) ->
+ band_type_1(Int, Other, Ts);
+band_type(_, _, _) -> integer.
+
+band_type_1(Int, OtherSrc, Ts) ->
+ Type = band_type_2(Int, 0),
+ OtherType = tdb_find(OtherSrc, Ts),
+ meet(Type, OtherType).
-update_band_1(N, Bits) when Bits < 64 ->
+band_type_2(N, Bits) when Bits < 64 ->
case 1 bsl Bits of
P when P =:= N + 1 ->
{integer,{0,N}};
P when P > N + 1 ->
integer;
_ ->
- update_band_1(N, Bits+1)
+ band_type_2(N, Bits+1)
end;
-update_band_1(_, _) ->
+band_type_2(_, _) ->
%% Negative or large positive number. Give up.
integer.
@@ -592,6 +683,9 @@ is_math_bif(log10, 1) -> true;
is_math_bif(sqrt, 1) -> true;
is_math_bif(atan2, 2) -> true;
is_math_bif(pow, 2) -> true;
+is_math_bif(ceil, 1) -> true;
+is_math_bif(floor, 1) -> true;
+is_math_bif(fmod, 2) -> true;
is_math_bif(pi, 0) -> true;
is_math_bif(_, _) -> false.
@@ -604,7 +698,7 @@ possibly_numeric(_) -> false.
max_tuple_size(Reg, Ts) ->
case tdb_find(Reg, Ts) of
- {tuple,Sz,_} -> Sz;
+ {tuple,_,Sz,_} -> Sz;
_Other -> 0
end.
@@ -674,8 +768,19 @@ op_type('bxor') -> integer;
op_type('bsl') -> integer;
op_type('bsr') -> integer;
op_type('div') -> integer;
-op_type(_) -> unknown.
+op_type(_) -> any.
+unary_op_type(bit_size) -> integer;
+unary_op_type(byte_size) -> integer;
+unary_op_type(length) -> integer;
+unary_op_type(map_size) -> integer;
+unary_op_type(size) -> integer;
+unary_op_type(tuple_size) -> integer;
+unary_op_type(_) -> any.
+
+flush(Rs, [{set,[_],[_,_,_],{bif,is_record,_}}|_]=Is0, Acc0) ->
+ Acc = flush_all(Rs, Is0, Acc0),
+ {[],Acc};
flush(Rs, [{set,[_],[],{put_tuple,_}}|_]=Is0, Acc0) ->
Acc = flush_all(Rs, Is0, Acc0),
{[],Acc};
@@ -754,37 +859,39 @@ checkerror_1([], OrigIs) -> OrigIs.
checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs].
-%%% Routines for maintaining a type database. The type database
+%%% Routines for maintaining a type database. The type database
%%% associates type information with registers.
%%%
-%%% {tuple,Size,First} means that the corresponding register contains a
-%%% tuple with *at least* Size elements. An tuple with unknown
-%%% size is represented as {tuple,0,[]}. First is either [] (meaning that
-%%% the tuple's first element is unknown) or [FirstElement] (the contents
-%%% of the first element).
-%%%
-%%% 'float' means that the register contains a float.
-%%%
-%%% 'integer' or {integer,{Min,Max}} that the register contains an
-%%% integer.
+%%% See the comment for verified_type/1 at the end of module for
+%%% a description of the possible types.
%% tdb_new() -> EmptyDataBase
%% Creates a new, empty type database.
tdb_new() -> [].
-%% tdb_find(Register, Db) -> Information|error
+%% tdb_find(Register, Db) -> Type
%% Returns type information or the atom error if there is no type
%% information available for Register.
+%%
+%% See the comment for verified_type/1 at the end of module for
+%% a description of the possible types.
-tdb_find({x,_}=K, Ts) -> tdb_find_1(K, Ts);
-tdb_find({y,_}=K, Ts) -> tdb_find_1(K, Ts);
-tdb_find(_, _) -> error.
+tdb_find(Reg, Ts) ->
+ case tdb_find_raw(Reg, Ts) of
+ {tuple_element,_,_} -> any;
+ Type -> Type
+ end.
-tdb_find_1(K, Ts) ->
- case orddict:find(K, Ts) of
- {ok,Val} -> Val;
- error -> error
+%% tdb_find_source_tuple(Register, Ts) -> {source_tuple,Register} | 'none'.
+%% Find the tuple whose first element was fetched to the register Register.
+
+tdb_find_source_tuple(Reg, Ts) ->
+ case tdb_find_raw(Reg, Ts) of
+ {tuple_element,Src,0} ->
+ {source_tuple,Src};
+ _ ->
+ none
end.
%% tdb_copy(Source, Dest, Db) -> Db'
@@ -792,9 +899,9 @@ tdb_find_1(K, Ts) ->
%% as the Source.
tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y ->
- case tdb_find(S, Ts) of
- error -> orddict:erase(D, Ts);
- Type -> orddict:store(D, Type, Ts)
+ case tdb_find_raw(S, Ts) of
+ any -> orddict:erase(D, Ts);
+ Type -> orddict:store(D, Type, Ts)
end;
tdb_copy(Literal, D, Ts) ->
Type = case Literal of
@@ -805,15 +912,90 @@ tdb_copy(Literal, D, Ts) ->
{literal,#{}} -> map;
{literal,Tuple} when tuple_size(Tuple) >= 1 ->
Lit = tag_literal(element(1, Tuple)),
- {tuple,tuple_size(Tuple),[Lit]};
- _ -> term
+ {tuple,exact_size,tuple_size(Tuple),[Lit]};
+ _ -> any
end,
- if
- Type =:= term ->
- orddict:erase(D, Ts);
- true ->
- verify_type(Type),
- orddict:store(D, Type, Ts)
+ tdb_store(D, verified_type(Type), Ts).
+
+%% tdb_store(Register, Type, Ts0) -> Ts.
+%% Store a new type for register Register. Return the update type
+%% database. Use this function when a new value is assigned to
+%% a register.
+%%
+%% See the comment for verified_type/1 at the end of module for
+%% a description of the possible types.
+
+tdb_store(Reg, any, Ts) ->
+ erase(Reg, Ts);
+tdb_store(Reg, Type, Ts) ->
+ store(Reg, verified_type(Type), Ts).
+
+store(Key, New, [{K,_}|_]=Dict) when Key < K ->
+ [{Key,New}|Dict];
+store(Key, New, [{K,Val}=E|Dict]) when Key > K ->
+ case Val of
+ {tuple_element,Key,_} -> store(Key, New, Dict);
+ _ -> [E|store(Key, New, Dict)]
+ end;
+store(Key, New, [{_K,Old}|Dict]) -> %Key == K
+ case Old of
+ {tuple,_,_,_} ->
+ [{Key,New}|erase_tuple_element(Key, Dict)];
+ _ ->
+ [{Key,New}|Dict]
+ end;
+store(Key, New, []) -> [{Key,New}].
+
+erase(Key, [{K,_}=E|Dict]) when Key < K ->
+ [E|Dict];
+erase(Key, [{K,Val}=E|Dict]) when Key > K ->
+ case Val of
+ {tuple_element,Key,_} -> erase(Key, Dict);
+ _ -> [E|erase(Key, Dict)]
+ end;
+erase(Key, [{_K,Val}|Dict]) -> %Key == K
+ case Val of
+ {tuple,_,_,_} -> erase_tuple_element(Key, Dict);
+ _ -> Dict
+ end;
+erase(_, []) -> [].
+
+erase_tuple_element(Key, [{_,{tuple_element,Key,_}}|Dict]) ->
+ erase_tuple_element(Key, Dict);
+erase_tuple_element(Key, [E|Dict]) ->
+ [E|erase_tuple_element(Key, Dict)];
+erase_tuple_element(_Key, []) -> [].
+
+%% tdb_meet(Register, Type, Ts0) -> Ts.
+%% Update information of a register that is used as the source for an
+%% instruction. The type Type will be combined using the meet operation
+%% with the previous type information for the register, resulting in
+%% narrower (more specific) type.
+%%
+%% For example, if the previous type is {tuple,min_size,2,[]} and the
+%% the new type is {tuple,exact_size,5,[]}, the meet of the types will
+%% be {tuple,exact_size,5,[]}.
+%%
+%% See the comment for verified_type/1 at the end of module for
+%% a description of the possible types.
+
+tdb_meet(Reg, NewType, Ts) ->
+ Update = fun(Type0) -> meet(Type0, NewType) end,
+ orddict:update(Reg, Update, NewType, Ts).
+
+%%%
+%%% Here follows internal helper functions for accessing and
+%%% updating the type database.
+%%%
+
+tdb_find_raw({x,_}=K, Ts) -> tdb_find_raw_1(K, Ts);
+tdb_find_raw({y,_}=K, Ts) -> tdb_find_raw_1(K, Ts);
+tdb_find_raw(_, _) -> any.
+
+tdb_find_raw_1(K, Ts) ->
+ case orddict:find(K, Ts) of
+ {ok,Val} -> Val;
+ error -> any
end.
tag_literal(A) when is_atom(A) -> {atom,A};
@@ -822,45 +1004,6 @@ tag_literal(I) when is_integer(I) -> {integer,I};
tag_literal([]) -> nil;
tag_literal(Lit) -> {literal,Lit}.
-%% tdb_update([UpdateOp], Db) -> NewDb
-%% UpdateOp = {Register,kill}|{Register,NewInfo}
-%% Updates a type database. If a 'kill' operation is given, the type
-%% information for that register will be removed from the database.
-%% A kill operation takes precedence over other operations for the same
-%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the
-%% the existing type information, if any, will be discarded, and the
-%% the '{tuple,5,[]}' information ignored.
-%%
-%% If NewInfo information is given and there exists information about
-%% the register, the old and new type information will be merged.
-%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce
-%% {tuple,10,_}.
-
-tdb_update(Uis0, Ts0) ->
- Uis1 = filter(fun ({{x,_},_Op}) -> true;
- ({{y,_},_Op}) -> true;
- (_) -> false
- end, Uis0),
- tdb_update1(lists:sort(Uis1), Ts0).
-
-tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K ->
- tdb_update1(remove_key(Key, Ops), Db);
-tdb_update1([{Key,Type}=New|Ops], [{K,_Old}|_]=Db) when Key < K ->
- verify_type(Type),
- [New|tdb_update1(Ops, Db)];
-tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) ->
- tdb_update1(remove_key(Key, Ops), Db);
-tdb_update1([{Key,NewInfo}|Ops], [{Key,OldInfo}|Db]) ->
- [{Key,merge_type_info(NewInfo, OldInfo)}|tdb_update1(Ops, Db)];
-tdb_update1([{_,_}|_]=Ops, [Old|Db]) ->
- [Old|tdb_update1(Ops, Db)];
-tdb_update1([{Key,kill}|Ops], []) ->
- tdb_update1(remove_key(Key, Ops), []);
-tdb_update1([{_,Type}=New|Ops], []) ->
- verify_type(Type),
- [New|tdb_update1(Ops, [])];
-tdb_update1([], Db) -> Db.
-
%% tdb_kill_xregs(Db) -> NewDb
%% Kill all information about x registers. Also kill all tuple_element
%% dependencies from y registers to x registers.
@@ -869,37 +1012,106 @@ tdb_kill_xregs([{{x,_},_Type}|Db]) -> tdb_kill_xregs(Db);
tdb_kill_xregs([{{y,_},{tuple_element,{x,_},_}}|Db]) -> tdb_kill_xregs(Db);
tdb_kill_xregs([Any|Db]) -> [Any|tdb_kill_xregs(Db)];
tdb_kill_xregs([]) -> [].
-
-remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops);
-remove_key(_, Ops) -> Ops.
-
-merge_type_info(I, I) -> I;
-merge_type_info({tuple,Sz1,Same}, {tuple,Sz2,Same}=Max) when Sz1 < Sz2 ->
+
+%% meet(Type1, Type2) -> Type
+%% Returns the "meet" of Type1 and Type2. The meet is a narrower
+%% type than Type1 and Type2. For example:
+%%
+%% meet(integer, {integer,{0,3}}) -> {integer,{0,3}}
+%%
+%% The meet for two different types result in 'none', which is
+%% the bottom element for our type lattice:
+%%
+%% meet(integer, map) -> none
+
+meet(T, T) ->
+ T;
+meet({integer,_}=T, integer) ->
+ T;
+meet(integer, {integer,_}=T) ->
+ T;
+meet({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) ->
+ {integer,{max(Min1, Min2),min(Max1, Max2)}};
+meet({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 ->
Max;
-merge_type_info({tuple,Sz1,Same}=Max, {tuple,Sz2,Same}) when Sz1 > Sz2 ->
+meet({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 ->
Max;
-merge_type_info({tuple,Sz1,[]}, {tuple,_Sz2,First}=Tuple2) ->
- merge_type_info({tuple,Sz1,First}, Tuple2);
-merge_type_info({tuple,_Sz1,First}=Tuple1, {tuple,Sz2,_}) ->
- merge_type_info(Tuple1, {tuple,Sz2,First});
-merge_type_info(integer, {integer,_}=Int) ->
- Int;
-merge_type_info({integer,_}=Int, integer) ->
- Int;
-merge_type_info({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) ->
- {integer,{max(Min1, Min2),min(Max1, Max2)}};
-merge_type_info(NewType, _) ->
- verify_type(NewType),
- NewType.
-
-verify_type({atom,_}) -> ok;
-verify_type(boolean) -> ok;
-verify_type(integer) -> ok;
-verify_type({integer,{Min,Max}})
- when is_integer(Min), is_integer(Max) -> ok;
-verify_type(map) -> ok;
-verify_type(nonempty_list) -> ok;
-verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok;
-verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok;
-verify_type({tuple_element,_,_}) -> ok;
-verify_type(float) -> ok.
+meet({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) ->
+ Exact;
+meet({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) ->
+ Exact;
+meet({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) ->
+ meet({tuple,SzKind1,Sz1,First}, Tuple2);
+meet({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) ->
+ meet(Tuple1, {tuple,SzKind2,Sz2,First});
+meet({binary,U1}, {binary,U2}) ->
+ {binary,max(U1, U2)};
+meet(T1, T2) ->
+ case is_any(T1) of
+ true ->
+ verified_type(T2);
+ false ->
+ case is_any(T2) of
+ true ->
+ verified_type(T1);
+ false ->
+ none %The bottom element.
+ end
+ end.
+
+is_any(any) -> true;
+is_any({tuple_element,_,_}) -> true;
+is_any(_) -> false.
+
+%% verified_type(Type) -> Type
+%% Returns the passed in type if it is one of the defined types.
+%% Crashes if there is anything wrong with the type.
+%%
+%% Here are all possible types:
+%%
+%% any Any Erlang term (top element for the type lattice).
+%%
+%% {atom,Atom} The specific atom Atom.
+%% {binary,Unit} Binary/bitstring aligned to unit Unit.
+%% boolean 'true' | 'false'
+%% float Floating point number.
+%% integer Integer.
+%% {integer,{Min,Max}} Integer in the inclusive range Min through Max.
+%% map Map.
+%% nonempty_list Nonempty list.
+%% {tuple,_,_,_} Tuple (see below).
+%%
+%% none No type (bottom element for the type lattice).
+%%
+%% {tuple,min_size,Size,First} means that the corresponding register
+%% contains a tuple with *at least* Size elements (conversely,
+%% {tuple,exact_size,Size,First} means that it contains a tuple with
+%% *exactly* Size elements). An tuple with unknown size is
+%% represented as {tuple,min_size,0,[]}. First is either [] (meaning
+%% that the tuple's first element is unknown) or [FirstElement] (the
+%% contents of the first element).
+%%
+%% There is also a pseudo-type called {tuple_element,_,_}:
+%%
+%% {tuple_element,SrcTuple,ElementNumber}
+%%
+%% that does not provide any information about the type of the
+%% register itself, but provides a link back to the source tuple that
+%% the register got its value from.
+%%
+%% Note that {tuple_element,_,_} will *never* be returned by tdb_find/2.
+%% Use tdb_find_source_tuple/2 to locate the source tuple for a register.
+
+verified_type(any=T) -> T;
+verified_type({atom,_}=T) -> T;
+verified_type({binary,U}=T) when is_integer(U) -> T;
+verified_type(boolean=T) -> T;
+verified_type(integer=T) -> T;
+verified_type({integer,{Min,Max}}=T)
+ when is_integer(Min), is_integer(Max) -> T;
+verified_type(map=T) -> T;
+verified_type(nonempty_list=T) -> T;
+verified_type({tuple,_,Sz,[]}=T) when is_integer(Sz) -> T;
+verified_type({tuple,_,Sz,[_]}=T) when is_integer(Sz) -> T;
+verified_type({tuple_element,_,_}=T) -> T;
+verified_type(float=T) -> T.
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index e743abc773..6e23003fc7 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -22,18 +22,62 @@
-module(beam_utils).
-export([is_killed_block/2,is_killed/3,is_killed_at/3,
- is_not_used/3,is_not_used_at/3,
- empty_label_index/0,index_label/3,index_labels/1,
+ is_not_used/3,usage/3,
+ empty_label_index/0,index_label/3,index_labels/1,replace_labels/4,
code_at/2,bif_to_test/3,is_pure_test/1,
- live_opt/1,delete_live_annos/1,combine_heap_needs/2,
- split_even/1]).
+ live_opt/1,delete_annos/1,combine_heap_needs/2,
+ anno_defs/1,
+ split_even/1
+ ]).
--import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
+-export_type([code_index/0,module_code/0,instruction/0]).
+
+-import(lists, [flatmap/2,map/2,member/2,sort/1,reverse/1,splitwith/2]).
+
+-define(is_const(Val), (Val =:= nil orelse
+ element(1, Val) =:= integer orelse
+ element(1, Val) =:= float orelse
+ element(1, Val) =:= atom orelse
+ element(1, Val) =:= literal)).
+
+%% instruction() describes all instructions that are used during optimzation
+%% (from beam_a to beam_z).
+-type instruction() :: atom() | tuple().
+
+-type code_index() :: gb_trees:tree(beam_asm:label(), [instruction()]).
+
+-type int_function() :: {'function',beam_asm:function_name(),arity(),
+ beam_asm:label(),[instruction()]}.
+
+-type module_code() ::
+ {module(),[_],[_],[int_function()],pos_integer()}.
+
+%% Internal types.
+-type fail() :: beam_asm:fail() | 'fail'.
+-type test() :: {'test',atom(),fail(),[beam_asm:src()]} |
+ {'test',atom(),fail(),integer(),list(),beam_asm:reg()}.
+-type result_cache() :: gb_trees:tree(beam_asm:label(), 'killed' | 'used').
-record(live,
- {bl, %Block check fun.
- lbl, %Label to code index.
- res}). %Result cache for each label.
+ {lbl :: code_index(), %Label to code index.
+ res :: result_cache()}). %Result cache for each label.
+
+%% usage(Register, [Instruction], State) -> killed|not_used|used.
+%% Determine the usage of Register in the instruction sequence.
+%% The return value is one of:
+%%
+%% killed - The register is not used in any way.
+%% not_used - The register is referenced only by an allocating instruction
+%% (the actual value does not matter).
+%% used - The register is used (its value do matter).
+
+-spec usage(beam_asm:reg(), [instruction()], code_index()) ->
+ 'killed' | 'not_used' | 'used'.
+
+usage(R, Is, D) ->
+ St = #live{lbl=D,res=gb_trees:empty()},
+ {Usage,_} = check_liveness(R, Is, St),
+ Usage.
%% is_killed_block(Register, [Instruction]) -> true|false
@@ -45,12 +89,18 @@
%% i.e. it is OK to enter the instruction sequence with Register
%% containing garbage.
-is_killed_block(R, Is) ->
- case check_killed_block(R, Is) of
- killed -> true;
- used -> false;
- transparent -> false
- end.
+-spec is_killed_block(beam_asm:reg(), [instruction()]) -> boolean().
+
+is_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) ->
+ X >= Live;
+is_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
+ not member(R, Ss) andalso (member(R, Ds) orelse is_killed_block(R, Is));
+is_killed_block(R, [{'%anno',{used,Regs}}|Is]) ->
+ case R of
+ {x,X} when (Regs bsr X) band 1 =:= 0 -> true;
+ _ -> is_killed_block(R, Is)
+ end;
+is_killed_block(_, []) -> false.
%% is_killed(Register, [Instruction], State) -> true|false
%% Determine whether a register is killed by the instruction sequence.
@@ -62,21 +112,27 @@ is_killed_block(R, Is) ->
%% The state (constructed by index_instructions/1) is used to allow us
%% to determine the kill state across branches.
+-spec is_killed(beam_asm:reg(), [instruction()], code_index()) -> boolean().
+
is_killed(R, Is, D) ->
- St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
+ St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
- {used,_} -> false
+ {exit_not_used,_} -> false;
+ {_,_} -> false
end.
%% is_killed_at(Reg, Lbl, State) -> true|false
%% Determine whether Reg is killed at label Lbl.
+-spec is_killed_at(beam_asm:reg(), beam_asm:label(), code_index()) -> boolean().
+
is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
- St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
+ St0 = #live{lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St0) of
{killed,_} -> true;
- {used,_} -> false
+ {exit_not_used,_} -> false;
+ {_,_} -> false
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -86,43 +142,39 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
%% The state is used to allow us to determine the usage state
%% across branches.
+-spec is_not_used(beam_asm:reg(), [instruction()], code_index()) -> boolean().
+
is_not_used(R, Is, D) ->
- St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
+ St = #live{lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
- {killed,_} -> true;
- {used,_} -> false
- end.
-
-%% is_not_used(Register, [Instruction], State) -> true|false
-%% Determine whether a register is never used in the instruction sequence
-%% (it could still be referenced by an allocate instruction, meaning that
-%% it MUST be initialized, but that its value does not matter).
-%% The state is used to allow us to determine the usage state
-%% across branches.
-
-is_not_used_at(R, Lbl, D) ->
- St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
- case check_liveness_at(R, Lbl, St) of
- {killed,_} -> true;
- {used,_} -> false
+ {used,_} -> false;
+ {exit_not_used,_} -> true;
+ {_,_} -> true
end.
%% index_labels(FunctionIs) -> State
%% Index the instruction sequence so that we can quickly
%% look up the instruction following a specific label.
+-spec index_labels([instruction()]) -> code_index().
+
index_labels(Is) ->
index_labels_1(Is, []).
%% empty_label_index() -> State
%% Create an empty label index.
+-spec empty_label_index() -> code_index().
+
empty_label_index() ->
gb_trees:empty().
%% index_label(Label, [Instruction], State) -> State
%% Add an index for a label.
+-spec index_label(beam_asm:label(), [instruction()], code_index()) ->
+ code_index().
+
index_label(Lbl, Is0, Acc) ->
Is = drop_labels(Is0),
gb_trees:enter(Lbl, Is, Acc).
@@ -131,12 +183,28 @@ index_label(Lbl, Is0, Acc) ->
%% code_at(Label, State) -> [I].
%% Retrieve the code at the given label.
+-spec code_at(beam_asm:label(), code_index()) -> [instruction()].
+
code_at(L, Ll) ->
gb_trees:get(L, Ll).
+%% replace_labels(FunctionIs, Tail, ReplaceDb, Fallback) -> FunctionIs.
+%% Replace all labels in instructions according to the ReplaceDb.
+%% If label is not found the Fallback is called with the label to
+%% produce a new one.
+
+-spec replace_labels([instruction()],
+ [instruction()],
+ #{beam_asm:label() => beam_asm:label()},
+ fun((beam_asm:label()) -> term())) -> [instruction()].
+replace_labels(Is, Acc, D, Fb) ->
+ replace_labels_1(Is, Acc, D, Fb).
+
%% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]}
%% Convert a BIF to a test. Fail if not possible.
+-spec bif_to_test(atom(), list(), fail()) -> test().
+
bif_to_test(is_atom, [_]=Ops, Fail) -> {test,is_atom,Fail,Ops};
bif_to_test(is_boolean, [_]=Ops, Fail) -> {test,is_boolean,Fail,Ops};
bif_to_test(is_binary, [_]=Ops, Fail) -> {test,is_binary,Fail,Ops};
@@ -157,10 +225,20 @@ bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]};
bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops};
bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops};
bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('==', [nil,A], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('==', [C,A], Fail) when ?is_const(C) ->
+ {test,is_eq,Fail,[A,C]};
bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops};
+bif_to_test('/=', [C,A], Fail) when ?is_const(C) ->
+ {test,is_ne,Fail,[A,C]};
bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops};
bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('=:=', [nil,A], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('=:=', [C,A], Fail) when ?is_const(C) ->
+ {test,is_eq_exact,Fail,[A,C]};
bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops};
+bif_to_test('=/=', [C,A], Fail) when ?is_const(C) ->
+ {test,is_ne_exact,Fail,[A,C]};
bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops};
bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}.
@@ -169,6 +247,9 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}.
%% Return 'true' if the test instruction does not modify any
%% registers and/or bit syntax matching state.
%%
+
+-spec is_pure_test(test()) -> boolean().
+
is_pure_test({test,is_eq,_,[_,_]}) -> true;
is_pure_test({test,is_ne,_,[_,_]}) -> true;
is_pure_test({test,is_eq_exact,_,[_,_]}) -> true;
@@ -189,9 +270,11 @@ is_pure_test({test,Op,_,Ops}) ->
%% Go through the instruction sequence in reverse execution
%% order, keep track of liveness and remove 'move' instructions
%% whose destination is a register that will not be used.
-%% Also insert {'%live',Live,Regs} annotations at the beginning
+%% Also insert {used,Regs} annotations at the beginning
%% and end of each block.
-%%
+
+-spec live_opt([instruction()]) -> [instruction()].
+
live_opt(Is0) ->
{[{label,Fail}|_]=Bef,[Fi|Is]} =
splitwith(fun({func_info,_,_,_}) -> false;
@@ -202,37 +285,59 @@ live_opt(Is0) ->
Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])].
-%% delete_live_annos([Instruction]) -> [Instruction].
-%% Delete all live annotations.
-%%
-delete_live_annos([{block,Bl0}|Is]) ->
- case delete_live_annos(Bl0) of
- [] -> delete_live_annos(Is);
- [_|_]=Bl -> [{block,Bl}|delete_live_annos(Is)]
- end;
-delete_live_annos([{'%live',_,_}|Is]) ->
- delete_live_annos(Is);
-delete_live_annos([I|Is]) ->
- [I|delete_live_annos(Is)];
-delete_live_annos([]) -> [].
-
+%% delete_annos([Instruction]) -> [Instruction].
+%% Delete all annotations.
+
+-spec delete_annos([instruction()]) -> [instruction()].
+
+delete_annos([{block,Bl0}|Is]) ->
+ case delete_annos(Bl0) of
+ [] -> delete_annos(Is);
+ [_|_]=Bl -> [{block,Bl}|delete_annos(Is)]
+ end;
+delete_annos([{'%anno',_}|Is]) ->
+ delete_annos(Is);
+delete_annos([I|Is]) ->
+ [I|delete_annos(Is)];
+delete_annos([]) -> [].
+
%% combine_heap_needs(HeapNeed1, HeapNeed2) -> HeapNeed
%% Combine the heap need for two allocation instructions.
-combine_heap_needs({alloc,Alloc1}, {alloc,Alloc2}) ->
- {alloc,combine_alloc_lists(Alloc1, Alloc2)};
-combine_heap_needs({alloc,Alloc}, Words) when is_integer(Words) ->
- {alloc,combine_alloc_lists(Alloc, [{words,Words}])};
-combine_heap_needs(Words, {alloc,Alloc}) when is_integer(Words) ->
- {alloc,combine_alloc_lists(Alloc, [{words,Words}])};
+-type heap_need_tag() :: 'floats' | 'words'.
+-type heap_need() :: non_neg_integer() |
+ {'alloc',[{heap_need_tag(),non_neg_integer()}]}.
+-spec combine_heap_needs(heap_need(), heap_need()) -> heap_need().
+
combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) ->
- H1+H2.
+ H1 + H2;
+combine_heap_needs(H1, H2) ->
+ {alloc,combine_alloc_lists([H1,H2])}.
+
+
+%% anno_defs(Instructions) -> Instructions'
+%% Add {def,RegisterBitmap} annotations to the beginning of
+%% each block. Iff bit X is set in the the bitmap, it means
+%% that {x,X} is defined when the block is entered.
+
+-spec anno_defs([instruction()]) -> [instruction()].
+
+anno_defs(Is0) ->
+ {Bef,[Fi|Is1]} =
+ splitwith(fun({func_info,_,_,_}) -> false;
+ (_) -> true
+ end, Is0),
+ {func_info,_,_,Arity} = Fi,
+ Regs = init_def_regs(Arity),
+ Is = defs(Is1, Regs, #{}),
+ Bef ++ [Fi|Is].
%% split_even/1
%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
-split_even(Rs) -> split_even(Rs, [], []).
+-spec split_even(list()) -> {list(),list()}.
+split_even(Rs) -> split_even(Rs, [], []).
%%%
%%% Local functions.
@@ -240,15 +345,29 @@ split_even(Rs) -> split_even(Rs, [], []).
%% check_liveness(Reg, [Instruction], #live{}) ->
-%% {killed | used, #live{}}
+%% {killed | not_used | used, #live{}}
%% Find out whether Reg is used or killed in instruction sequence.
-%% 'killed' means that Reg is assigned a new value or killed by an
-%% allocation instruction. 'used' means that Reg is used in some way.
-
-check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) ->
- case BlockCheck(R, Blk, St0) of
- {transparent,St} -> check_liveness(R, Is, St);
- {Other,_}=Res when is_atom(Other) -> Res
+%%
+%% killed - Reg is assigned or killed by an allocation instruction.
+%% not_used - the value of Reg is not used, but Reg must not be garbage
+%% exit_not_used - the value of Reg is not used, but must not be garbage
+%% because the stack will be scanned because an
+%% exit BIF will raise an exception
+%% used - Reg is used
+
+check_liveness({fr,_}, _, St) ->
+ %% Conservatively always consider the floating point register used.
+ {used,St};
+check_liveness(R, [{block,Blk}|Is], St0) ->
+ case check_liveness_block(R, Blk, St0) of
+ {transparent,St1} ->
+ check_liveness(R, Is, St1);
+ {alloc_used,St1} ->
+ %% Used by an allocating instruction, but value not referenced.
+ %% Must check the rest of the instructions.
+ not_used(check_liveness(R, Is, St1));
+ {Other,_}=Res when is_atom(Other) ->
+ Res
end;
check_liveness(R, [{label,_}|Is], St) ->
check_liveness(R, Is, St);
@@ -258,8 +377,14 @@ check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) ->
{used,St0};
false ->
case check_liveness_at(R, Fail, St0) of
- {killed,St} -> check_liveness(R, Is, St);
- {_,_}=Other -> Other
+ {killed,St1} ->
+ check_liveness(R, Is, St1);
+ {exit_not_used,St1} ->
+ not_used(check_liveness(R, Is, St1));
+ {not_used,St1} ->
+ not_used(check_liveness(R, Is, St1));
+ {used,_}=Used ->
+ Used
end
end;
check_liveness(R, [{test,Op,Fail,Live,Ss,Dst}|Is], St) ->
@@ -273,12 +398,14 @@ check_liveness(R, [{select,_,_,Fail,Branches}|_], St) ->
check_liveness_everywhere(R, [Fail|Branches], St);
check_liveness(R, [{jump,{f,F}}|_], St) ->
check_liveness_at(R, F, St);
-check_liveness(R, [{case_end,Used}|_], St) ->
- check_liveness_ret(R, Used, St);
+check_liveness(R, [{case_end,Used}|_], St) ->
+ check_liveness_exit(R, Used, St);
+check_liveness(R, [{try_case_end,Used}|_], St) ->
+ check_liveness_exit(R, Used, St);
check_liveness(R, [{badmatch,Used}|_], St) ->
- check_liveness_ret(R, Used, St);
-check_liveness(_, [if_end|_], St) ->
- {killed,St};
+ check_liveness_exit(R, Used, St);
+check_liveness(R, [if_end|_], St) ->
+ check_liveness_exit(R, ignore, St);
check_liveness(R, [{func_info,_,_,Ar}|_], St) ->
case R of
{x,X} when X < Ar -> {used,St};
@@ -301,17 +428,27 @@ check_liveness(R, [{bs_init,_,_,none,Ss,Dst}|Is], St) ->
check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) ->
case R of
{x,X} ->
- case X < Live orelse member(R, Ss) of
- true -> {used,St};
- false -> {killed,St}
+ case member(R, Ss) of
+ true ->
+ {used,St};
+ false ->
+ if
+ X < Live ->
+ not_used(check_liveness(R, Is, St));
+ true ->
+ {killed,St}
+ end
end;
{y,_} ->
case member(R, Ss) of
true -> {used,St};
false ->
+ %% If the exception is taken, the stack may
+ %% be scanned. Therefore the register is not
+ %% guaranteed to be killed.
if
- R =:= Dst -> {killed,St};
- true -> check_liveness(R, Is, St)
+ R =:= Dst -> {not_used,St};
+ true -> not_used(check_liveness(R, Is, St))
end
end
end;
@@ -329,7 +466,7 @@ check_liveness(R, [{call,Live,_}|Is], St) ->
case R of
{x,X} when X < Live -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness(R, [{call_ext,Live,_}=I|Is], St) ->
case R of
@@ -340,55 +477,32 @@ check_liveness(R, [{call_ext,Live,_}=I|Is], St) ->
{y,_} ->
case beam_jump:is_exit_instruction(I) of
false ->
- check_liveness(R, Is, St);
+ not_used(check_liveness(R, Is, St));
true ->
%% We must make sure we don't check beyond this
%% instruction or we will fall through into random
%% unrelated code and get stuck in a loop.
- {killed,St}
+ {exit_not_used,St}
end
end;
check_liveness(R, [{call_fun,Live}|Is], St) ->
case R of
{x,X} when X =< Live -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
check_liveness(R, [{apply,Args}|Is], St) ->
case R of
{x,X} when X < Args+2 -> {used,St};
{x,_} -> {killed,St};
- {y,_} -> check_liveness(R, Is, St)
- end;
-check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St} = Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
- end;
-check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) ->
- case R of
- {x,X} when X >= Live ->
- {killed,St0};
- {x,_} ->
- {used,St0};
- _ ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St}=Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
- end
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
+check_liveness(R, [{bif,Op,Fail,Ss,D}|Is], St) ->
+ Set = {set,[D],Ss,{bif,Op,Fail}},
+ check_liveness(R, [{block,[Set]}|Is], St);
+check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St) ->
+ Set = {set,[D],Ss,{alloc,Live,{gc_bif,Op,Fail}}},
+ check_liveness(R, [{block,[Set]}|Is], St);
check_liveness(R, [{bs_put,{f,0},_,Ss}|Is], St) ->
case member(R, Ss) of
true -> {used,St};
@@ -414,18 +528,14 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) ->
case R of
{x,X} when X < NumFree -> {used,St};
{x,_} -> {killed,St};
- _ -> check_liveness(R, Is, St)
+ {y,_} -> not_used(check_liveness(R, Is, St))
end;
-check_liveness({x,_}=R, [{'catch',_,_}|Is], St) ->
- %% All x registers will be killed if an exception occurs.
- %% Therefore we only need to check the liveness for the
- %% instructions following the catch instruction.
- check_liveness(R, Is, St);
-check_liveness({x,_}=R, [{'try',_,_}|Is], St) ->
- %% All x registers will be killed if an exception occurs.
- %% Therefore we only need to check the liveness for the
- %% instructions inside the 'try' block.
- check_liveness(R, Is, St);
+check_liveness(R, [{'catch'=Op,Y,Fail}|Is], St) ->
+ Set = {set,[Y],[],{try_catch,Op,Fail}},
+ check_liveness(R, [{block,[Set]}|Is], St);
+check_liveness(R, [{'try'=Op,Y,Fail}|Is], St) ->
+ Set = {set,[Y],[],{try_catch,Op,Fail}},
+ check_liveness(R, [{block,[Set]}|Is], St);
check_liveness(R, [{try_end,Y}|Is], St) ->
case R of
Y ->
@@ -483,40 +593,58 @@ check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) ->
Other
end
end;
-check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) ->
- case R of
- Src ->
- {used,St0};
- {x,X} when X < Live ->
- {used,St0};
- {x,_} ->
- {killed,St0};
- {y,_} ->
- %% Conservatively mark it as used.
- {used,St0}
- end;
+check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) ->
+ Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}},
+ check_liveness(R, [{block,[Set]}||Is], St);
+check_liveness(R, [{put_tuple,Ar,D}|Is], St) ->
+ Set = {set,[D],[],{put_tuple,Ar}},
+ check_liveness(R, [{block,[Set]}||Is], St);
+check_liveness(R, [{put_list,S1,S2,D}|Is], St) ->
+ Set = {set,[D],[S1,S2],put_list},
+ check_liveness(R, [{block,[Set]}||Is], St);
check_liveness(R, [{test_heap,N,Live}|Is], St) ->
I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]},
check_liveness(R, [I|Is], St);
check_liveness(R, [{allocate_zero,N,Live}|Is], St) ->
I = {block,[{set,[],[],{alloc,Live,{zero,N,0,[]}}}]},
check_liveness(R, [I|Is], St);
-check_liveness(R, [{get_list,S,D1,D2}|Is], St) ->
- I = {block,[{set,[D1,D2],[S],get_list}]},
+check_liveness(R, [{get_hd,S,D}|Is], St) ->
+ I = {block,[{set,[D],[S],get_hd}]},
+ check_liveness(R, [I|Is], St);
+check_liveness(R, [{get_tl,S,D}|Is], St) ->
+ I = {block,[{set,[D],[S],get_tl}]},
check_liveness(R, [I|Is], St);
+check_liveness(R, [remove_message|Is], St) ->
+ check_liveness(R, Is, St);
+check_liveness({x,X}, [build_stacktrace|_], St) when X > 0 ->
+ {killed,St};
+check_liveness(R, [{recv_mark,_}|Is], St) ->
+ check_liveness(R, Is, St);
+check_liveness(R, [{recv_set,_}|Is], St) ->
+ check_liveness(R, Is, St);
+check_liveness(R, [{'%',_}|Is], St) ->
+ check_liveness(R, Is, St);
check_liveness(_R, Is, St) when is_list(Is) ->
%% Not implemented. Conservatively assume that the register is used.
{used,St}.
-
-check_liveness_everywhere(R, [{f,Lbl}|T], St0) ->
- case check_liveness_at(R, Lbl, St0) of
- {killed,St} -> check_liveness_everywhere(R, T, St);
- {_,_}=Other -> Other
+
+check_liveness_everywhere(R, Lbls, St0) ->
+ check_liveness_everywhere_1(R, Lbls, killed, St0).
+
+check_liveness_everywhere_1(R, [{f,Lbl}|T], Res0, St0) ->
+ {Res1,St} = check_liveness_at(R, Lbl, St0),
+ Res = case Res1 of
+ killed -> Res0;
+ _ -> Res1
+ end,
+ case Res of
+ used -> {used,St};
+ _ -> check_liveness_everywhere_1(R, T, Res, St)
end;
-check_liveness_everywhere(R, [_|T], St) ->
- check_liveness_everywhere(R, T, St);
-check_liveness_everywhere(_, [], St) ->
- {killed,St}.
+check_liveness_everywhere_1(R, [_|T], Res, St) ->
+ check_liveness_everywhere_1(R, T, Res, St);
+check_liveness_everywhere_1(_, [], Res, St) ->
+ {Res,St}.
check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
case gb_trees:lookup(Lbl, ResMemorized) of
@@ -530,102 +658,116 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
{Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}}
end.
-check_liveness_ret(R, R, St) -> {used,St};
-check_liveness_ret(_, _, St) -> {killed,St}.
+not_used({used,_}=Res) -> Res;
+not_used({_,St}) -> {not_used,St}.
-check_liveness_fail(_, _, _, 0, St) ->
- {killed,St};
-check_liveness_fail(R, Op, Args, Fail, St) ->
- Arity = length(Args),
- case erl_internal:comp_op(Op, Arity) orelse
- erl_internal:new_type_test(Op, Arity) of
- true -> {killed,St};
- false -> check_liveness_at(R, Fail, St)
- end.
-
-%% check_killed_block(Reg, [Instruction], State) -> killed | transparent | used
-%% Finds out how Reg is used in the instruction sequence inside a block.
-%% Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
-%% transparent - Reg is neither used nor killed
-%% used - Reg is used or referenced by an allocation instruction.
-%%
-%% (Unknown instructions will cause an exception.)
-
-check_killed_block_fun() ->
- fun(R, Is, St) -> {check_killed_block(R, Is),St} end.
-
-check_killed_block({x,X}, [{set,_,_,{alloc,Live,_}}|_]) ->
- if
- X >= Live -> killed;
- true -> used
- end;
-check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) ->
- case member(R, Ss) of
- true -> used;
- false ->
- case member(R, Ds) of
- true -> killed;
- false -> check_killed_block(R, Is)
- end
- end;
-check_killed_block(R, [{'%live',_,Regs}|Is]) ->
- case R of
- {x,X} when (Regs bsr X) band 1 =:= 0 -> killed;
- _ -> check_killed_block(R, Is)
- end;
-check_killed_block(_, []) -> transparent.
+check_liveness_exit(R, R, St) -> {used,St};
+check_liveness_exit({x,_}, _, St) -> {killed,St};
+check_liveness_exit({y,_}, _, St) -> {exit_not_used,St}.
-%% check_used_block(Reg, [Instruction], State) -> killed | transparent | used
+%% check_liveness_block(Reg, [Instruction], State) ->
+%% {killed | not_used | used | alloc_used | transparent,State'}
%% Finds out how Reg is used in the instruction sequence inside a block.
%% Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
+%% killed - Reg is assigned a new value or killed by an
+%% allocation instruction
+%% not_used - The value is not used, but the register is referenced
+%% e.g. by an allocation instruction
%% transparent - Reg is neither used nor killed
+%% alloc_used - Used only in an allocate instruction
%% used - Reg is explicitly used by an instruction
%%
-%% '%live' annotations are not allowed.
+%% Annotations are not allowed.
%%
%% (Unknown instructions will cause an exception.)
-check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
+check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) ->
if
- X >= Live -> {killed,St};
- true -> check_used_block_1(R, Ss, Ds, Op, Is, St)
+ X >= Live ->
+ {killed,St0};
+ true ->
+ case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
+ {transparent,St} -> {alloc_used,St};
+ {_,_}=Res -> not_used(Res)
+ end
+ end;
+check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St0) ->
+ case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
+ {transparent,St} -> {alloc_used,St};
+ {_,_}=Res -> not_used(Res)
+ end;
+check_liveness_block({y,_}=R, [{set,Ds,Ss,{try_catch,_,Op}}|Is], St0) ->
+ case Ds of
+ [R] ->
+ {killed,St0};
+ _ ->
+ case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of
+ {exit_not_used,St} ->
+ {used,St};
+ {transparent,St} ->
+ %% Conservatively assumed that it is used.
+ {used,St};
+ {_,_}=Res ->
+ Res
+ end
end;
-check_used_block(R, [{set,Ds,Ss,Op}|Is], St) ->
- check_used_block_1(R, Ss, Ds, Op, Is, St);
-check_used_block(_, [], St) -> {transparent,St}.
+check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) ->
+ check_liveness_block_1(R, Ss, Ds, Op, Is, St);
+check_liveness_block(_, [], St) -> {transparent,St}.
-check_used_block_1(R, Ss, Ds, Op, Is, St0) ->
+check_liveness_block_1(R, Ss, Ds, Op, Is, St0) ->
case member(R, Ss) of
true ->
{used,St0};
false ->
- case is_reg_used_at(R, Op, St0) of
- {true,St} ->
- {used,St};
- {false,St} ->
+ case check_liveness_block_2(R, Op, Ss, St0) of
+ {killed,St} ->
case member(R, Ds) of
true -> {killed,St};
- false -> check_used_block(R, Is, St)
- end
+ false -> check_liveness_block(R, Is, St)
+ end;
+ {exit_not_used,St} ->
+ case member(R, Ds) of
+ true -> {exit_not_used,St};
+ false -> check_liveness_block(R, Is, St)
+ end;
+ {not_used,St} ->
+ not_used(case member(R, Ds) of
+ true -> {killed,St};
+ false -> check_liveness_block(R, Is, St)
+ end);
+ {used,St} ->
+ {used,St}
end
end.
-is_reg_used_at(R, {gc_bif,_,{f,Lbl}}, St) ->
- is_reg_used_at_1(R, Lbl, St);
-is_reg_used_at(R, {bif,_,{f,Lbl}}, St) ->
- is_reg_used_at_1(R, Lbl, St);
-is_reg_used_at(_, _, St) ->
- {false,St}.
+check_liveness_block_2(R, {gc_bif,Op,{f,Lbl}}, Ss, St) ->
+ check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St);
+check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) ->
+ Arity = length(Ss),
+ case erl_internal:comp_op(Op, Arity) orelse
+ erl_internal:new_type_test(Op, Arity) of
+ true ->
+ {killed,St};
+ false ->
+ check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St)
+ end;
+check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) ->
+ check_liveness_block_3(R, Lbl, {unsafe,0}, St);
+check_liveness_block_2(_, _, _, St) ->
+ {killed,St}.
-is_reg_used_at_1(_, 0, St) ->
- {false,St};
-is_reg_used_at_1(R, Lbl, St0) ->
- case check_liveness_at(R, Lbl, St0) of
- {killed,St} -> {false,St};
- {used,St} -> {true,St}
- end.
+check_liveness_block_3({x,_}, 0, _FA, St) ->
+ {killed,St};
+check_liveness_block_3({y,_}, 0, {F,A}, St) ->
+ %% If the exception is thrown, the stack may be scanned,
+ %% thus implicitly using the y register.
+ case erl_bifs:is_safe(erlang, F, A) of
+ true -> {killed,St};
+ false -> {used,St}
+ end;
+check_liveness_block_3(R, Lbl, _FA, St0) ->
+ check_liveness_at(R, Lbl, St0).
index_labels_1([{label,Lbl}|Is0], Acc) ->
Is = drop_labels(Is0),
@@ -637,22 +779,74 @@ index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)).
drop_labels([{label,_}|Is]) -> drop_labels(Is);
drop_labels(Is) -> Is.
-%% Help functions for combine_heap_needs.
-combine_alloc_lists(Al1, Al2) ->
- combine_alloc_lists_1(sort(Al1++Al2)).
+replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb);
+replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Live,Ops,Dst}|Acc], D, Fb);
+replace_labels_1([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D, Fb) ->
+ Vls = map(fun ({f,L}) -> {f,label(L, D, Fb)};
+ (Other) -> Other
+ end, Vls0),
+ Fail = label(Fail0, D, Fb),
+ replace_labels_1(Is, [{select,I,R,{f,Fail},Vls}|Acc], D, Fb);
+replace_labels_1([{'try',R,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{'try',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{'catch',R,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{'catch',R,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{jump,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{jump,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{loop_rec,{f,Lbl},R}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{loop_rec,{f,label(Lbl, D, Fb)},R}|Acc], D, Fb);
+replace_labels_1([{loop_rec_end,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{loop_rec_end,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{wait,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{wait,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{wait_timeout,{f,Lbl},To}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{wait_timeout,{f,label(Lbl, D, Fb)},To}|Acc], D, Fb);
+replace_labels_1([{recv_mark=Op,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{Op,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{recv_set=Op,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{Op,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{bif,Name,{f,Lbl},As,R}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bif,Name,{f,label(Lbl, D, Fb)},As,R}|Acc], D, Fb);
+replace_labels_1([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{gc_bif,Name,{f,label(Lbl, D, Fb)},Live,As,R}|Acc], D, Fb);
+replace_labels_1([{call,Ar,{f,Lbl}}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{call,Ar,{f,label(Lbl, D, Fb)}}|Acc], D, Fb);
+replace_labels_1([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [{make_fun2,{f,label(Lbl, D, Fb)},U1,U2,U3}|Acc], D, Fb);
+replace_labels_1([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bs_init,{f,label(Lbl, D, Fb)},Info,Live,Ss,Dst}|Acc], D, Fb);
+replace_labels_1([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{bs_put,{f,label(Lbl, D, Fb)},Info,Ss}|Acc], D, Fb);
+replace_labels_1([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D, Fb)
+ when Lbl =/= 0 ->
+ replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Op,Src,Dst,Live,List}|Acc], D, Fb);
+replace_labels_1([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D, Fb) when Lbl =/= 0 ->
+ replace_labels_1(Is, [{I,{f,label(Lbl, D, Fb)},Src,List}|Acc], D, Fb);
+replace_labels_1([I|Is], Acc, D, Fb) ->
+ replace_labels_1(Is, [I|Acc], D, Fb);
+replace_labels_1([], Acc, _, _) -> Acc.
+
+label(Old, D, Fb) ->
+ case D of
+ #{Old := New} -> New;
+ _ -> Fb(Old)
+ end.
+
+%% Help function for combine_heap_needs.
-combine_alloc_lists_1([{words,W1},{words,W2}|T])
- when is_integer(W1), is_integer(W2) ->
- [{words,W1+W2}|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([{floats,F1},{floats,F2}|T])
- when is_integer(F1), is_integer(F2) ->
- [{floats,F1+F2}|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([{words,_}=W|T]) ->
- [W|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([{floats,_}=F|T]) ->
- [F|combine_alloc_lists_1(T)];
-combine_alloc_lists_1([]) -> [].
+combine_alloc_lists(Al0) ->
+ Al1 = flatmap(fun(Words) when is_integer(Words) ->
+ [{words,Words}];
+ ({alloc,List}) ->
+ List
+ end, Al0),
+ Al2 = sofs:relation(Al1),
+ Al3 = sofs:relation_to_family(Al2),
+ Al4 = sofs:to_external(Al3),
+ [{Tag,lists:sum(L)} || {Tag,L} <- Al4].
%% live_opt/4.
@@ -691,10 +885,14 @@ live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) ->
%% Other instructions.
live_opt([{block,Bl0}|Is], Regs0, D, Acc) ->
- Live0 = {'%live',live_regs(Regs0),Regs0},
+ Live0 = make_anno({used,Regs0}),
{Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]),
- Live = {'%live',live_regs(Regs),Regs},
+ Live = make_anno({used,Regs}),
live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]);
+live_opt([build_stacktrace=I|Is], _, D, Acc) ->
+ live_opt(Is, live_call(1), D, [I|Acc]);
+live_opt([raw_raise=I|Is], _, D, Acc) ->
+ live_opt(Is, live_call(3), D, [I|Acc]);
live_opt([{label,L}=I|Is], Regs, D0, Acc) ->
D = gb_trees:insert(L, Regs, D0),
live_opt(Is, Regs, D, [I|Acc]);
@@ -736,12 +934,19 @@ live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) ->
Regs1 = x_live(Ss, Regs0),
Regs = live_join_label(Fail, D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) ->
+live_opt([{select,_,Src,Fail,List}=I|Is], _, D, Acc) ->
+ Regs0 = 0,
Regs1 = x_live([Src], Regs0),
Regs = live_join_labels([Fail|List], D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{try_case,_}=I|Is], _, D, Acc) ->
- live_opt(Is, live_call(1), D, [I|Acc]);
+live_opt([{try_case,Y}=I|Is], Regs0, D, Acc) ->
+ Regs = live_call(1),
+ case Regs0 of
+ 0 ->
+ live_opt(Is, Regs, D, [{try_end,Y}|Acc]);
+ _ ->
+ live_opt(Is, live_call(1), D, [I|Acc])
+ end;
live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) ->
live_opt(Is, 0, D, [I|Acc]);
live_opt([timeout=I|Is], _, D, Acc) ->
@@ -753,6 +958,25 @@ live_opt([{get_map_elements,Fail,Src,{list,List}}=I|Is], Regs0, D, Acc) ->
Regs1 = x_live([Src|Ss], x_dead(Ds, Regs0)),
Regs = live_join_label(Fail, D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{gc_bif,N,F,R,As,Dst}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],As,{alloc,R,{gc_bif,N,F}}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{bif,N,F,As,Dst}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],As,{bif,N,F}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{get_tuple_element,Src,Idx,Dst}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],[Src],{get_tuple_element,Idx}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{move,Src,Dst}=I|Is], Regs0, D, Acc) ->
+ Regs = x_live([Src], x_dead([Dst], Regs0)),
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{put_map,F,Op,S,Dst,R,{list,Puts}}=I|Is], Regs0, D, Acc) ->
+ Bl = [{set,[Dst],[S|Puts],{alloc,R,{put_map,Op,F}}}],
+ {_,Regs} = live_opt_block(Bl, Regs0, D, []),
+ live_opt(Is, Regs, D, [I|Acc]);
%% Transparent instructions - they neither use nor modify x registers.
live_opt([{deallocate,_}=I|Is], Regs, D, Acc) ->
@@ -769,6 +993,10 @@ 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]);
+live_opt([{'catch',_,_}=I|Is], Regs, D, Acc) ->
+ live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{'try',_,_}=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 'from_asm' option.
@@ -783,45 +1011,52 @@ live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) ->
live_opt([], _, _, Acc) -> Acc.
-live_opt_block([{set,Ds,Ss,Op0}|Is], Regs0, D, Acc) ->
- Regs1 = x_live(Ss, x_dead(Ds, Regs0)),
- {Op, Regs} = live_opt_block_op(Op0, Regs1, D),
- I = {set, Ds, Ss, Op},
-
- case Ds of
- [{x,X}] ->
- case (not is_live(X, Regs0)) andalso Op =:= move of
- true ->
- live_opt_block(Is, Regs0, D, Acc);
- false ->
- live_opt_block(Is, Regs, D, [I|Acc])
- end;
- _ ->
- live_opt_block(Is, Regs, D, [I|Acc])
+live_opt_block([{set,[{x,X}]=Ds,Ss,move}=I|Is], Regs0, D, Acc) ->
+ Regs = x_live(Ss, x_dead(Ds, Regs0)),
+ case is_live(X, Regs0) of
+ true ->
+ live_opt_block(Is, Regs, D, [I|Acc]);
+ false ->
+ %% Useless move, will never be used.
+ live_opt_block(Is, Regs, D, Acc)
end;
-live_opt_block([], Regs, _, Acc) -> {Acc,Regs}.
-
-live_opt_block_op({alloc,Live0,AllocOp}, Regs0, D) ->
- Regs =
- case AllocOp of
- {Kind, _N, Fail} when Kind =:= gc_bif; Kind =:= put_map ->
- live_join_label(Fail, D, Regs0);
- _ ->
- Regs0
- end,
+live_opt_block([{set,Ds,Ss,{alloc,Live0,AllocOp}}|Is], Regs0, D, Acc) ->
+ %% Calculate liveness from the point of view of the GC.
+ %% There will never be a GC if the instruction fails, so we should
+ %% ignore the failure branch.
+ GcRegs1 = x_dead(Ds, Regs0),
+ GcRegs = x_live(Ss, GcRegs1),
+ Live = live_regs(GcRegs),
%% The life-time analysis used by the code generator is sometimes too
%% conservative, so it may be possible to lower the number of live
%% registers based on the exact liveness information. The main benefit is
%% that more optimizations that depend on liveness information (such as the
- %% beam_bool and beam_dead passes) may be applied.
- Live = live_regs(Regs),
- true = Live =< Live0,
- {{alloc,Live,AllocOp}, live_call(Live)};
-live_opt_block_op({bif,_N,Fail} = Op, Regs, D) ->
- {Op, live_join_label(Fail, D, Regs)};
-live_opt_block_op(Op, Regs, _D) ->
- {Op, Regs}.
+ %% beam_dead pass) may be applied.
+ true = Live =< Live0, %Assertion.
+ I = {set,Ds,Ss,{alloc,Live,AllocOp}},
+
+ %% Calculate liveness from the point of view of the preceding instruction.
+ %% The liveness is the union of live registers in the GC and the live
+ %% registers at the failure label.
+ Regs1 = live_call(Live),
+ Regs = live_join_alloc(AllocOp, D, Regs1),
+ live_opt_block(Is, Regs, D, [I|Acc]);
+live_opt_block([{set,Ds,Ss,{bif,_,Fail}}=I|Is], Regs0, D, Acc) ->
+ Regs1 = x_dead(Ds, Regs0),
+ Regs2 = x_live(Ss, Regs1),
+ Regs = live_join_label(Fail, D, Regs2),
+ live_opt_block(Is, Regs, D, [I|Acc]);
+live_opt_block([{set,Ds,Ss,_}=I|Is], Regs0, D, Acc) ->
+ Regs = x_live(Ss, x_dead(Ds, Regs0)),
+ live_opt_block(Is, Regs, D, [I|Acc]);
+live_opt_block([{'%anno',_}|Is], Regs, D, Acc) ->
+ live_opt_block(Is, Regs, D, Acc);
+live_opt_block([], Regs, _, Acc) -> {Acc,Regs}.
+
+live_join_alloc({Kind,_Name,Fail}, D, Regs) when Kind =:= gc_bif; Kind =:= put_map ->
+ live_join_label(Fail, D, Regs);
+live_join_alloc(_, _, Regs) -> Regs.
live_join_labels([{f,L}|T], D, Regs0) when L =/= 0 ->
Regs = gb_trees:get(L, D) bor Regs0,
@@ -857,3 +1092,228 @@ split_even([], Ss, Ds) ->
{reverse(Ss),reverse(Ds)};
split_even([S,D|Rs], Ss, Ds) ->
split_even(Rs, [S|Ss], [D|Ds]).
+
+%%%
+%%% Add annotations for defined registers.
+%%%
+%%% This analysis is done by scanning the instructions in
+%%% execution order.
+%%%
+
+defs([{apply,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{bif,_,{f,Fail},_Src,Dst}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, update_regs(Fail, Regs0, D))];
+defs([{block,Block0}|Is], Regs0, D0) ->
+ {Block,Regs,D} = defs_list(Block0, Regs0, D0),
+ [{block,[make_anno({def,Regs0})|Block]}|defs(Is, Regs, D)];
+defs([{bs_init,{f,L},_,Live,_,Dst}=I|Is], Regs0, D) ->
+ Regs1 = case Live of
+ none -> Regs0;
+ _ -> init_def_regs(Live)
+ end,
+ Regs = def_regs([Dst], Regs1),
+ [I|defs(Is, Regs, update_regs(L, Regs, D))];
+defs([{test,bs_start_match2,{f,L},Live,_,Dst}=I|Is], _Regs, D) ->
+ Regs0 = init_def_regs(Live),
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, update_regs(L, Regs0, D))];
+defs([{bs_put,{f,L},_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, update_regs(L, Regs, D))];
+defs([build_stacktrace=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{call,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{call_ext,_,{extfunc,M,F,A}}=I|Is], _Regs, D) ->
+ case erl_bifs:is_exit_bif(M, F, A) of
+ false ->
+ [I|defs(Is, 1, D)];
+ true ->
+ [I|defs_unreachable(Is, D)]
+ end;
+defs([{call_ext,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{call_fun,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{'catch',_,{f,L}}=I|Is], Regs, D) ->
+ RegsAtLabel = init_def_regs(1),
+ [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))];
+defs([{catch_end,_}=I|Is], _Regs, D) ->
+ Regs = init_def_regs(1),
+ [I|defs(Is, Regs, D)];
+defs([{gc_bif,_,{f,Fail},Live,_Src,Dst}=I|Is], Regs0, D) ->
+ true = all_defined(Live, Regs0), %Assertion.
+ Regs = def_regs([Dst], init_def_regs(Live)),
+ [I|defs(Is, Regs, update_regs(Fail, Regs0, D))];
+defs([{get_map_elements,{f,L},_Src,{list,DstList}}=I|Is], Regs0, D) ->
+ {_,Ds} = beam_utils:split_even(DstList),
+ Regs = def_regs(Ds, Regs0),
+ [I|defs(Is, Regs, update_regs(L, Regs0, D))];
+defs([{get_tuple_element,_,_,Dst}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, D)];
+defs([{jump,{f,L}}=I|Is], Regs, D) ->
+ [I|defs_unreachable(Is, update_regs(L, Regs, D))];
+defs([{label,L}=I|Is], Regs0, D) ->
+ case D of
+ #{L:=Regs1} ->
+ Regs = Regs0 band Regs1,
+ [I|defs(Is, Regs, D)];
+ #{} ->
+ [I|defs(Is, Regs0, D)]
+ end;
+defs([{loop_rec,{f,L},{x,0}}=I|Is], _Regs, D0) ->
+ RegsAtLabel = init_def_regs(0),
+ D = update_regs(L, RegsAtLabel, D0),
+ [I|defs(Is, init_def_regs(1), D)];
+defs([{loop_rec_end,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{make_fun2,_,_,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([{move,_,Dst}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, D)];
+defs([{put_map,{f,Fail},_,_,Dst,_,_}=I|Is], Regs0, D) ->
+ Regs = def_regs([Dst], Regs0),
+ [I|defs(Is, Regs, update_regs(Fail, Regs0, D))];
+defs([raw_raise=I|Is], _Regs, D) ->
+ [I|defs(Is, 1, D)];
+defs([return=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{select,_,_Src,Fail,List}=I|Is], Regs, D0) ->
+ D = update_list([Fail|List], Regs, D0),
+ [I|defs_unreachable(Is, D)];
+defs([{test,_,{f,L},_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, update_regs(L, Regs, D))];
+defs([{test,_,{f,L},Live,_,Dst}=I|Is], Regs0, D) ->
+ true = all_defined(Live, Regs0), %Assertion.
+ Regs = def_regs([Dst], init_def_regs(Live)),
+ [I|defs(Is, Regs, update_regs(L, Regs0, D))];
+defs([{'try',_,{f,L}}=I|Is], Regs, D) ->
+ RegsAtLabel = init_def_regs(3),
+ [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))];
+defs([{try_case,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, init_def_regs(3), D)];
+defs([{wait,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{wait_timeout,_,_}=I|Is], _Regs, D) ->
+ [I|defs(Is, 0, D)];
+
+%% Exceptions.
+defs([{badmatch,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{case_end,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([if_end=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+defs([{try_case_end,_}=I|Is], _Regs, D) ->
+ [I|defs_unreachable(Is, D)];
+
+%% Neutral instructions
+defs([{bs_context_to_binary,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{bs_restore2,_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{bs_save2,_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{deallocate,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{kill,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{line,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{recv_mark,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{recv_set,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([timeout=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{trim,_,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{try_end,_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([{'%',_}=I|Is], Regs, D) ->
+ [I|defs(Is, Regs, D)];
+defs([], _, _) -> [].
+
+defs_unreachable([{label,L}=I|Is], D) ->
+ case D of
+ #{L:=Regs} ->
+ [I|defs(Is, Regs, D)];
+ #{} ->
+ defs_unreachable(Is, D)
+ end;
+defs_unreachable([_|Is], D) ->
+ defs_unreachable(Is, D);
+defs_unreachable([], _D) -> [].
+
+defs_list(Is, Regs, D) ->
+ defs_list(Is, Regs, D, []).
+
+defs_list([{set,Ds,_,{alloc,Live,Info}}=I|Is], Regs0, D0, Acc) ->
+ true = all_defined(Live, Regs0), %Assertion.
+ D = case Info of
+ {gc_bif,_,{f,Fail}} ->
+ update_regs(Fail, Regs0, D0);
+ {put_map,_,{f,Fail}} ->
+ update_regs(Fail, Regs0, D0);
+ _ ->
+ D0
+ end,
+ Regs = def_regs(Ds, init_def_regs(Live)),
+ defs_list(Is, Regs, D, [I|Acc]);
+defs_list([{set,Ds,_,Info}=I|Is], Regs0, D0, Acc) ->
+ D = case Info of
+ {bif,_,{f,Fail}} ->
+ update_regs(Fail, Regs0, D0);
+ {try_catch,'catch',{f,Fail}} ->
+ update_regs(Fail, init_def_regs(1), D0);
+ {try_catch,'try',{f,Fail}} ->
+ update_regs(Fail, init_def_regs(3), D0);
+ _ ->
+ D0
+ end,
+ Regs = def_regs(Ds, Regs0),
+ defs_list(Is, Regs, D, [I|Acc]);
+defs_list([], Regs, D, Acc) ->
+ {reverse(Acc),Regs,D}.
+
+init_def_regs(Arity) ->
+ (1 bsl Arity) - 1.
+
+def_regs([{x,X}|T], Regs) ->
+ def_regs(T, Regs bor (1 bsl X));
+def_regs([_|T], Regs) ->
+ def_regs(T, Regs);
+def_regs([], Regs) -> Regs.
+
+update_list([{f,L}|T], Regs, D0) ->
+ D = update_regs(L, Regs, D0),
+ update_list(T, Regs, D);
+update_list([_|T], Regs, D) ->
+ update_list(T, Regs, D);
+update_list([], _Regs, D) -> D.
+
+update_regs(L, Regs0, D) ->
+ case D of
+ #{L:=Regs1} ->
+ Regs = Regs0 band Regs1,
+ D#{L:=Regs};
+ #{} ->
+ D#{L=>Regs0}
+ end.
+
+all_defined(Live, Regs) ->
+ All = (1 bsl Live) - 1,
+ Regs band All =:= All.
+
+%%%
+%%% Utilities.
+%%%
+
+%% make_anno(Anno) -> WrappedAnno.
+%% Wrap an annotation term.
+
+make_anno(Anno) ->
+ {'%anno',Anno}.
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 69e34f76b0..fb2e7df65c 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -27,11 +27,13 @@
%% Interface for compiler.
-export([module/2, format_error/1]).
--include("beam_disasm.hrl").
-
--import(lists, [reverse/1,foldl/3,foreach/2,dropwhile/2]).
+-import(lists, [any/2,dropwhile/2,foldl/3,foreach/2,reverse/1]).
%% To be called by the compiler.
+
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_utils:module_code()}.
+
module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) ->
case validate(Mod, Fs) of
@@ -81,8 +83,6 @@ format_error(Error) ->
%%% Things currently not checked. XXX
%%%
%%% - Heap allocation for binaries.
-%%% - That put_tuple is followed by the correct number of
-%%% put instructions.
%%%
%% validate(Module, [Function]) -> [] | [Error]
@@ -126,9 +126,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
throw:Error ->
%% Controlled error.
[Error|validate_0(Module, Fs, Ft)];
- Class:Error ->
+ Class:Error:Stack ->
%% Crash.
- Stack = erlang:get_stacktrace(),
io:fwrite("Function: ~w/~w\n", [Name,Ar]),
erlang:raise(Class, Error, Stack)
end.
@@ -145,7 +144,8 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
hf=0, %Available heap size for floats.
fls=undefined, %Floating point state.
ct=[], %List of hot catch/try labels
- setelem=false %Previous instruction was setelement/3.
+ setelem=false, %Previous instruction was setelement/3.
+ puts_left=none %put/1 instructions left.
}).
-type label() :: integer().
@@ -267,13 +267,17 @@ valfun_1(_I, #vst{current=none}=Vst) ->
Vst;
valfun_1({badmatch,Src}, Vst) ->
assert_term(Src, Vst),
+ verify_y_init(Vst),
kill_state(Vst);
valfun_1({case_end,Src}, Vst) ->
assert_term(Src, Vst),
+ verify_y_init(Vst),
kill_state(Vst);
valfun_1(if_end, Vst) ->
+ verify_y_init(Vst),
kill_state(Vst);
valfun_1({try_case_end,Src}, Vst) ->
+ verify_y_init(Vst),
assert_term(Src, Vst),
kill_state(Vst);
%% Instructions that can not cause exceptions
@@ -290,6 +294,8 @@ valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) ->
end;
valfun_1(bs_init_writable=I, Vst) ->
call(I, 1, Vst);
+valfun_1(build_stacktrace=I, Vst) ->
+ call(I, 1, Vst);
valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) ->
%% The stack trimming optimization may generate a move from an initialized
%% but unassigned Y register to another Y register.
@@ -335,11 +341,25 @@ valfun_1({put_list,A,B,Dst}, Vst0) ->
Vst = eat_heap(2, Vst0),
set_type_reg(cons, Dst, Vst);
valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) ->
+ Vst1 = eat_heap(1, Vst0),
+ Vst = set_type_reg(tuple_in_progress, Dst, Vst1),
+ #vst{current=St0} = Vst,
+ St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}},
+ Vst#vst{current=St};
+valfun_1({put,Src}, Vst0) ->
+ assert_term(Src, Vst0),
Vst = eat_heap(1, Vst0),
- set_type_reg({tuple,Sz}, Dst, Vst);
-valfun_1({put,Src}, Vst) ->
- assert_term(Src, Vst),
- eat_heap(1, Vst);
+ #vst{current=St0} = Vst,
+ case St0 of
+ #st{puts_left=none} ->
+ error(not_building_a_tuple);
+ #st{puts_left={1,{Dst,Type}}} ->
+ St = St0#st{puts_left=none},
+ set_type_reg(Type, Dst, Vst#vst{current=St});
+ #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) ->
+ St = St0#st{puts_left={PutsLeft-1,Info}},
+ Vst#vst{current=St}
+ end;
%% Instructions for optimization of selective receives.
valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
@@ -347,7 +367,9 @@ valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
%% Misc.
valfun_1(remove_message, Vst) ->
- Vst;
+ %% The message term is no longer fragile. It can be used
+ %% without restrictions.
+ remove_fragility(Vst);
valfun_1({'%',_}, Vst) ->
Vst;
valfun_1({line,_}, Vst) ->
@@ -357,6 +379,9 @@ valfun_1({call_ext,Live,Func}=I, Vst) ->
case return_type(Func, Vst) of
exception ->
verify_live(Live, Vst),
+ %% The stack will be scanned, so Y registers
+ %% must be initialized.
+ verify_y_init(Vst),
kill_state(Vst);
_ ->
valfun_2(I, Vst)
@@ -426,6 +451,19 @@ valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) ->
Type ->
error({bad_type,Type})
end;
+valfun_1({get_list,Src,D1,D2}, Vst0) ->
+ assert_type(cons, Src, Vst0),
+ Vst = set_type_reg(term, Src, D1, Vst0),
+ set_type_reg(term, Src, D2, Vst);
+valfun_1({get_hd,Src,Dst}, Vst) ->
+ assert_type(cons, Src, Vst),
+ set_type_reg(term, Src, Dst, Vst);
+valfun_1({get_tl,Src,Dst}, Vst) ->
+ assert_type(cons, Src, Vst),
+ set_type_reg(term, Src, Dst, Vst);
+valfun_1({get_tuple_element,Src,I,Dst}, Vst) ->
+ assert_type({tuple_element,I+1}, Src, Vst),
+ set_type_reg(term, Src, Dst, Vst);
valfun_1(I, Vst) ->
valfun_2(I, Vst).
@@ -515,23 +553,40 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
Vst1 = branch_state(Fail, Vst0),
TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0),
Vst = set_type(TupleType, Tuple, Vst1),
- set_type_reg(term, Dst, Vst);
+ set_type_reg(term, Tuple, Dst, Vst);
valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) ->
validate_src(Src, Vst),
kill_state(Vst);
+valfun_4(raw_raise=I, Vst) ->
+ call(I, 3, Vst);
+valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) ->
+ validate_src(Src, Vst0),
+ Vst1 = branch_state(Fail, Vst0),
+ Vst = set_type(map, Map, Vst1),
+ Type = propagate_fragility(term, Src, Vst),
+ set_type_reg(Type, Dst, Vst);
+valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) ->
+ validate_src(Src, Vst0),
+ Vst1 = branch_state(Fail, Vst0),
+ Vst = set_type(map, Map, Vst1),
+ Type = propagate_fragility(bool, Src, Vst),
+ set_type_reg(Type, Dst, Vst);
valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
validate_src(Src, Vst0),
Vst = branch_state(Fail, Vst0),
- Type = bif_type(Op, Src, Vst),
+ Type0 = bif_type(Op, Src, Vst),
+ Type = propagate_fragility(Type0, Src, Vst),
set_type_reg(Type, Dst, Vst);
valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) ->
+ verify_live(Live, Vst0),
+ verify_y_init(Vst0),
St = kill_heap_allocation(St0),
Vst1 = Vst0#vst{current=St},
- verify_live(Live, Vst1),
Vst2 = branch_state(Fail, Vst1),
Vst = prune_x_regs(Live, Vst2),
validate_src(Src, Vst),
- Type = bif_type(Op, Src, Vst),
+ Type0 = bif_type(Op, Src, Vst),
+ Type = propagate_fragility(Type0, Src, Vst),
set_type_reg(Type, Dst, Vst);
valfun_4(return, #vst{current=#st{numy=none}}=Vst) ->
assert_term({x,0}, Vst),
@@ -542,13 +597,20 @@ valfun_4({jump,{f,Lbl}}, Vst) ->
kill_state(branch_state(Lbl, Vst));
valfun_4({loop_rec,{f,Fail},Dst}, Vst0) ->
Vst = branch_state(Fail, Vst0),
- set_type_reg(term, Dst, Vst);
+ %% This term may not be part of the root set until
+ %% remove_message/0 is executed. If control transfers
+ %% to the loop_rec_end/1 instruction, no part of
+ %% this term must be stored in a Y register.
+ set_type_reg({fragile,term}, Dst, Vst);
valfun_4({wait,_}, Vst) ->
+ verify_y_init(Vst),
kill_state(Vst);
valfun_4({wait_timeout,_,Src}, Vst) ->
assert_term(Src, Vst),
- Vst;
+ verify_y_init(Vst),
+ prune_x_regs(0, Vst);
valfun_4({loop_rec_end,_}, Vst) ->
+ verify_y_init(Vst),
kill_state(Vst);
valfun_4(timeout, #vst{current=St}=Vst) ->
Vst#vst{current=St#st{x=init_regs(0, term)}};
@@ -566,13 +628,6 @@ valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) ->
valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) ->
assert_type(tuple, Tuple, Vst),
kill_state(branch_arities(Choices, Tuple, branch_state(Fail, Vst)));
-valfun_4({get_list,Src,D1,D2}, Vst0) ->
- assert_type(cons, Src, Vst0),
- Vst = set_type_reg(term, D1, Vst0),
- set_type_reg(term, D2, Vst);
-valfun_4({get_tuple_element,Src,I,Dst}, Vst) ->
- assert_type({tuple_element,I+1}, Src, Vst),
- set_type_reg(term, Dst, Vst);
%% New bit syntax matching instructions.
valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
@@ -580,6 +635,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
%% is OK as input.
CtxType = get_move_term_type(Ctx, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
BranchVst = case CtxType of
#ms{} ->
@@ -596,9 +652,10 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) ->
valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) ->
assert_term(Src, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
Vst = branch_state(Fail, Vst1),
- set_type_reg(bsm_match_state(Slots), Dst, Vst);
+ set_type_reg(bsm_match_state(Slots), Src, Dst, Vst);
valfun_4({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) ->
bsm_validate_context(Ctx, Vst),
branch_state(Fail, Vst);
@@ -619,17 +676,18 @@ valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) ->
valfun_4({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) ->
validate_bs_skip_utf(Fail, Ctx, Live, Vst);
valfun_4({test,bs_get_integer2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst);
valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ Type = propagate_fragility(term, [Ctx], Vst),
+ validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst);
valfun_4({test,bs_get_utf8,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({test,bs_get_utf32,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, Dst, Vst);
+ validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({bs_save2,Ctx,SavePoint}, Vst) ->
bsm_save(Ctx, SavePoint, Vst);
valfun_4({bs_restore2,Ctx,SavePoint}, Vst) ->
@@ -649,6 +707,9 @@ valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) ->
valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) ->
assert_type(tuple, Tuple, Vst),
set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst));
+valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) ->
+ validate_src([Src], Vst),
+ set_type_reg({tuple, Sz}, Src, branch_state(Lbl, Vst));
valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) ->
assert_type(map, Src, Vst),
assert_unique_map_keys(List),
@@ -678,6 +739,7 @@ valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) ->
set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
if
is_integer(Sz) ->
ok;
@@ -690,6 +752,7 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
set_type_reg(binary, Dst, Vst);
valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
if
is_integer(Sz) ->
ok;
@@ -702,6 +765,7 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
set_type_reg(binary, Dst, Vst);
valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) ->
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
assert_term(Bits, Vst0),
assert_term(Bin, Vst0),
Vst1 = heap_alloc(Heap, Vst0),
@@ -757,7 +821,7 @@ verify_get_map(Fail, Src, List, Vst0) ->
Vst2 = branch_state(Fail, Vst1),
Keys = extract_map_keys(List),
assert_unique_map_keys(Keys),
- verify_get_map_pair(List,Vst0,Vst2).
+ verify_get_map_pair(List, Src, Vst0, Vst2).
extract_map_vals([_Key,Val|T]) ->
[Val|extract_map_vals(T)];
@@ -767,10 +831,11 @@ extract_map_keys([Key,_Val|T]) ->
[Key|extract_map_keys(T)];
extract_map_keys([]) -> [].
-verify_get_map_pair([],_,Vst) -> Vst;
-verify_get_map_pair([Src,Dst|Vs],Vst0,Vsti) ->
+verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) ->
assert_term(Src, Vst0),
- verify_get_map_pair(Vs,Vst0,set_type_reg(term,Dst,Vsti)).
+ Vsti = set_type_reg(term, Map, Dst, Vsti0),
+ verify_get_map_pair(Vs, Map, Vst0, Vsti);
+verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst.
verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
assert_type(map, Src, Vst0),
@@ -787,18 +852,20 @@ verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
%%
%% Common code for validating bs_get* instructions.
%%
-validate_bs_get(Fail, Ctx, Live, Dst, Vst0) ->
+validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) ->
bsm_validate_context(Ctx, Vst0),
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst1 = prune_x_regs(Live, Vst0),
Vst = branch_state(Fail, Vst1),
- set_type_reg(term, Dst, Vst).
+ set_type_reg(Type, Dst, Vst).
%%
%% Common code for validating bs_skip_utf* instructions.
%%
validate_bs_skip_utf(Fail, Ctx, Live, Vst0) ->
bsm_validate_context(Ctx, Vst0),
+ verify_y_init(Vst0),
verify_live(Live, Vst0),
Vst = prune_x_regs(Live, Vst0),
branch_state(Fail, Vst).
@@ -909,7 +976,7 @@ all_ms_in_x_regs(Live0, Vst) ->
ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) ->
Ys = gb_trees:to_list(Ys0),
- [Y || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id].
+ [{y,Y} || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id].
verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) ->
case gb_trees:lookup(Lbl, Ft) of
@@ -937,6 +1004,7 @@ deallocate(#vst{current=St}=Vst) ->
test_heap(Heap, Live, Vst0) ->
verify_live(Live, Vst0),
+ verify_y_init(Vst0),
Vst = prune_x_regs(Live, Vst0),
heap_alloc(Heap, Vst).
@@ -1059,10 +1127,11 @@ bsm_validate_context(Reg, Vst) ->
bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) ->
case gb_trees:lookup(X, Xs) of
{value,#ms{}=Ctx} -> Ctx;
+ {value,{fragile,#ms{}=Ctx}} -> Ctx;
_ -> error({no_bsm_context,Reg})
end;
bsm_get_context(Reg, _) -> error({bad_source,Reg}).
-
+
bsm_save(Reg, {atom,start}, Vst) ->
%% Save point refering to where the match started.
%% It is always valid. But don't forget to validate the context register.
@@ -1099,13 +1168,34 @@ set_type(Type, {x,_}=Reg, Vst) -> set_type_reg(Type, Reg, Vst);
set_type(Type, {y,_}=Reg, Vst) -> set_type_y(Type, Reg, Vst);
set_type(_, _, #vst{}=Vst) -> Vst.
-set_type_reg(Type, {x,X}=Reg, #vst{current=#st{x=Xs}=St}=Vst)
- when is_integer(X), 0 =< X ->
- check_limit(Reg),
- Vst#vst{current=St#st{x=gb_trees:enter(X, Type, Xs)}};
+set_type_reg(Type, Src, Dst, Vst) ->
+ case get_term_type_1(Src, Vst) of
+ {fragile,_} ->
+ set_type_reg(make_fragile(Type), Dst, Vst);
+ _ ->
+ set_type_reg(Type, Dst, Vst)
+ end.
+
+set_type_reg(Type, {x,_}=Reg, Vst) ->
+ set_type_x(Type, Reg, Vst);
set_type_reg(Type, Reg, Vst) ->
set_type_y(Type, Reg, Vst).
+set_type_x(Type, {x,X}=Reg, #vst{current=#st{x=Xs0}=St}=Vst)
+ when is_integer(X), 0 =< X ->
+ check_limit(Reg),
+ Xs = case gb_trees:lookup(X, Xs0) of
+ none ->
+ gb_trees:insert(X, Type, Xs0);
+ {value,{fragile,_}} ->
+ gb_trees:update(X, make_fragile(Type), Xs0);
+ {value,_} ->
+ gb_trees:update(X, Type, Xs0)
+ end,
+ Vst#vst{current=St#st{x=Xs}};
+set_type_x(Type, Reg, #vst{}) ->
+ error({invalid_store,Reg,Type}).
+
set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst)
when is_integer(Y), 0 =< Y ->
check_limit(Reg),
@@ -1119,13 +1209,40 @@ set_type_y(Type, {y,Y}=Reg, #vst{current=#st{y=Ys0}=St}=Vst)
{value,_} ->
gb_trees:update(Y, Type, Ys0)
end,
+ check_try_catch_tags(Type, Y, Ys0),
Vst#vst{current=St#st{y=Ys}};
set_type_y(Type, Reg, #vst{}) -> error({invalid_store,Reg,Type}).
+make_fragile({fragile,_}=Type) -> Type;
+make_fragile(Type) -> {fragile,Type}.
+
set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) ->
Ys = gb_trees:update(Y, initialized, Ys0),
Vst#vst{current=St#st{y=Ys}}.
+check_try_catch_tags(Type, LastY, Ys) ->
+ case is_try_catch_tag(Type) of
+ false ->
+ ok;
+ true ->
+ %% Every catch or try/catch must use a lower Y register
+ %% number than any enclosing catch or try/catch. That will
+ %% ensure that when the stack is scanned when an
+ %% exception occurs, the innermost try/catch tag is found
+ %% first.
+ Bad = [{{y,Y},Tag} || {Y,Tag} <- gb_trees:to_list(Ys),
+ Y < LastY, is_try_catch_tag(Tag)],
+ case Bad of
+ [] ->
+ ok;
+ [_|_] ->
+ error({bad_try_catch_nesting,{y,LastY},Bad})
+ end
+ end.
+
+is_try_catch_tag({catchtag,_}) -> true;
+is_try_catch_tag({trytag,_}) -> true;
+is_try_catch_tag(_) -> false.
is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst);
is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst);
@@ -1199,9 +1316,26 @@ assert_term(Src, Vst) ->
%%
%% map Map.
%%
+%%
+%%
+%% FRAGILITY
+%% ---------
+%%
+%% The loop_rec/2 instruction may return a reference to a term that is
+%% not part of the root set. That term or any part of it must not be
+%% included in a garbage collection. Therefore, the term (or any part
+%% of it) must not be stored in an Y register.
+%%
+%% Such terms are wrapped in a {fragile,Type} tuple, where Type is one
+%% of the types described above.
assert_type(WantedType, Term, Vst) ->
- assert_type(WantedType, get_term_type(Term, Vst)).
+ case get_term_type(Term, Vst) of
+ {fragile,Type} ->
+ assert_type(WantedType, Type);
+ Type ->
+ assert_type(WantedType, Type)
+ end.
assert_type(Correct, Correct) -> ok;
assert_type(float, {float,_}) -> ok;
@@ -1227,14 +1361,19 @@ assert_type(Needed, Actual) ->
%% is inconsistent, and we know that some instructions will never
%% be executed at run-time.
-upgrade_tuple_type({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz ->
+upgrade_tuple_type(NewType, {fragile,OldType}) ->
+ make_fragile(upgrade_tuple_type_1(NewType, OldType));
+upgrade_tuple_type(NewType, OldType) ->
+ upgrade_tuple_type_1(NewType, OldType).
+
+upgrade_tuple_type_1({tuple,[Sz]}, {tuple,[OldSz]}=T) when Sz < OldSz ->
%% The old type has a higher value for the least tuple size.
T;
-upgrade_tuple_type({tuple,[Sz]}, {tuple,OldSz}=T)
+upgrade_tuple_type_1({tuple,[Sz]}, {tuple,OldSz}=T)
when is_integer(Sz), is_integer(OldSz), Sz =< OldSz ->
%% The old size is exact, and the new size is smaller than the old size.
T;
-upgrade_tuple_type({tuple,_}=T, _) ->
+upgrade_tuple_type_1({tuple,_}=T, _) ->
%% The new type information is exact or has a higher value for
%% the least tuple size.
%% Note that inconsistencies are also handled in this
@@ -1259,6 +1398,7 @@ get_move_term_type(Src, Vst) ->
initialized -> error({unassigned,Src});
{catchtag,_} -> error({catchtag,Src});
{trytag,_} -> error({trytag,Src});
+ tuple_in_progress -> error({tuple_in_progress,Src});
Type -> Type
end.
@@ -1267,10 +1407,7 @@ get_move_term_type(Src, Vst) ->
%% a standard Erlang type (no catch/try tags or match contexts).
get_term_type(Src, Vst) ->
- case get_term_type_1(Src, Vst) of
- initialized -> error({unassigned,Src});
- {catchtag,_} -> error({catchtag,Src});
- {trytag,_} -> error({trytag,Src});
+ case get_move_term_type(Src, Vst) of
#ms{} -> error({match_context,Src});
Type -> Type
end.
@@ -1317,7 +1454,12 @@ branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0)
Vst = branch_state(L, Vst1),
branch_arities(T, Tuple, Vst#vst{current=St}).
-branch_state(0, #vst{}=Vst) -> Vst;
+branch_state(0, #vst{}=Vst) ->
+ %% If the instruction fails, the stack may be scanned
+ %% looking for a catch tag. Therefore the Y registers
+ %% must be initialized at this point.
+ verify_y_init(Vst),
+ Vst;
branch_state(L, #vst{current=St,branched=B}=Vst) ->
Vst#vst{
branched=case gb_trees:is_defined(L, B) of
@@ -1398,6 +1540,14 @@ merge_y_regs_1(_, _, Regs) -> Regs.
%% merge_types(Type1, Type2) -> Type
%% Return the most specific type possible.
%% Note: Type1 must NOT be the same as Type2.
+merge_types({fragile,Same}=Type, Same) ->
+ Type;
+merge_types({fragile,T1}, T2) ->
+ make_fragile(merge_types(T1, T2));
+merge_types(Same, {fragile,Same}=Type) ->
+ Type;
+merge_types(T1, {fragile,T2}) ->
+ make_fragile(merge_types(T1, T2));
merge_types(uninitialized=I, _) -> I;
merge_types(_, uninitialized=I) -> I;
merge_types(initialized=I, _) -> I;
@@ -1423,13 +1573,13 @@ merge_types(bool, {atom,A}) ->
merge_bool(A);
merge_types({atom,A}, bool) ->
merge_bool(A);
-merge_types(#ms{id=Id,valid=B0,slots=Slots}=M,
- #ms{id=Id,valid=B1,slots=Slots}) ->
- M#ms{valid=B0 bor B1,slots=Slots};
-merge_types(#ms{}=M, _) ->
- M;
-merge_types(_, #ms{}=M) ->
- M;
+merge_types(#ms{id=Id1,valid=B1,slots=Slots1},
+ #ms{id=Id2,valid=B2,slots=Slots2}) ->
+ Id = if
+ Id1 =:= Id2 -> Id1;
+ true -> make_ref()
+ end,
+ #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)};
merge_types(T1, T2) when T1 =/= T2 ->
%% Too different. All we know is that the type is a 'term'.
term.
@@ -1448,6 +1598,10 @@ verify_y_init(#vst{current=#st{y=Ys}}) ->
verify_y_init_1([]) -> ok;
verify_y_init_1([{Y,uninitialized}|_]) ->
error({uninitialized_reg,{y,Y}});
+verify_y_init_1([{Y,{fragile,_}}|_]) ->
+ %% Unsafe. This term may be outside any heap belonging
+ %% to the process and would be corrupted by a GC.
+ error({fragile_message_reference,{y,Y}});
verify_y_init_1([{_,_}|Ys]) ->
verify_y_init_1(Ys).
@@ -1493,6 +1647,27 @@ eat_heap_float(#vst{current=#st{hf=HeapFloats0}=St}=Vst) ->
Vst#vst{current=St#st{hf=HeapFloats}}
end.
+remove_fragility(#vst{current=#st{x=Xs0,y=Ys0}=St0}=Vst) ->
+ F = fun(_, {fragile,Type}) -> Type;
+ (_, Type) -> Type
+ end,
+ Xs = gb_trees:map(F, Xs0),
+ Ys = gb_trees:map(F, Ys0),
+ St = St0#st{x=Xs,y=Ys},
+ Vst#vst{current=St}.
+
+propagate_fragility(Type, Ss, Vst) ->
+ F = fun(S) ->
+ case get_term_type_1(S, Vst) of
+ {fragile,_} -> true;
+ _ -> false
+ end
+ end,
+ case any(F, Ss) of
+ true -> make_fragile(Type);
+ false -> Type
+ end.
+
bif_type('-', Src, Vst) ->
arith_type(Src, Vst);
bif_type('+', Src, Vst) ->
@@ -1508,7 +1683,9 @@ bif_type(abs, [Num], Vst) ->
bif_type(float, _, _) -> {float,[]};
bif_type('/', _, _) -> {float,[]};
%% Integer operations.
+bif_type(ceil, [_], _) -> {integer,[]};
bif_type('div', [_,_], _) -> {integer,[]};
+bif_type(floor, [_], _) -> {integer,[]};
bif_type('rem', [_,_], _) -> {integer,[]};
bif_type(length, [_], _) -> {integer,[]};
bif_type(size, [_], _) -> {integer,[]};
@@ -1642,6 +1819,9 @@ return_type_math(log10, 1) -> {float,[]};
return_type_math(sqrt, 1) -> {float,[]};
return_type_math(atan2, 2) -> {float,[]};
return_type_math(pow, 2) -> {float,[]};
+return_type_math(ceil, 1) -> {float,[]};
+return_type_math(floor, 1) -> {float,[]};
+return_type_math(fmod, 2) -> {float,[]};
return_type_math(pi, 0) -> {float,[]};
return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl
index 6c7f8543c2..1c9d762eb1 100644
--- a/lib/compiler/src/beam_z.erl
+++ b/lib/compiler/src/beam_z.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,19 +24,23 @@
-export([module/2]).
--import(lists, [dropwhile/2]).
+-import(lists, [dropwhile/2,map/2]).
-module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
- Fs = [function(F) || F <- Fs0],
+-spec module(beam_utils:module_code(), [compile:option()]) ->
+ {'ok',beam_asm:module_code()}.
+
+module({Mod,Exp,Attr,Fs0,Lc}, Opts) ->
+ NoGetHdTl = proplists:get_bool(no_get_hd_tl, Opts),
+ Fs = [function(F, NoGetHdTl) || F <- Fs0],
{ok,{Mod,Exp,Attr,Fs,Lc}}.
-function({function,Name,Arity,CLabel,Is0}) ->
+function({function,Name,Arity,CLabel,Is0}, NoGetHdTl) ->
try
- Is = undo_renames(Is0),
+ Is1 = undo_renames(Is0),
+ Is = maybe_eliminate_get_hd_tl(Is1, NoGetHdTl),
{function,Name,Arity,CLabel,Is}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end.
@@ -63,6 +67,10 @@ undo_renames([{bif,raise,_,_,_}=I|Is0]) ->
(_) -> true
end, Is0),
[I|undo_renames(Is)];
+undo_renames([{get_hd,Src,Dst1},{get_tl,Src,Dst2}|Is]) ->
+ [{get_list,Src,Dst1,Dst2}|undo_renames(Is)];
+undo_renames([{get_tl,Src,Dst2},{get_hd,Src,Dst1}|Is]) ->
+ [{get_list,Src,Dst1,Dst2}|undo_renames(Is)];
undo_renames([I|Is]) ->
[undo_rename(I)|undo_renames(Is)];
undo_renames([]) -> [].
@@ -105,3 +113,17 @@ undo_rename({get_map_elements,Fail,Src,{list,List}}) ->
undo_rename({select,I,Reg,Fail,List}) ->
{I,Reg,Fail,{list,List}};
undo_rename(I) -> I.
+
+%%%
+%%% Eliminate get_hd/get_tl instructions if requested by
+%%% the no_get_hd_tl option.
+%%%
+
+maybe_eliminate_get_hd_tl(Is, true) ->
+ map(fun({get_hd,Cons,Hd}) ->
+ {get_list,Cons,Hd,{x,1022}};
+ ({get_tl,Cons,Tl}) ->
+ {get_list,Cons,{x,1022},Tl};
+ (I) -> I
+ end, Is);
+maybe_eliminate_get_hd_tl(Is, false) -> Is.
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 61abae344c..fce23bfd68 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,9 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-
-%% =====================================================================
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
%% @doc Core Erlang abstract syntax trees.
%%
%% <p> This module defines an abstract data type for representing Core
@@ -439,6 +433,8 @@ is_literal_term(T) when is_tuple(T) ->
is_literal_term(B) when is_bitstring(B) -> true;
is_literal_term(M) when is_map(M) ->
is_literal_term_list(maps:to_list(M));
+is_literal_term(F) when is_function(F) ->
+ erlang:fun_info(F, type) =:= {type,external};
is_literal_term(_) ->
false.
@@ -1590,6 +1586,8 @@ ann_make_list(_, [], Node) ->
%% @doc Returns <code>true</code> if <code>Node</code> is an abstract
%% map constructor, otherwise <code>false</code>.
+-type map_op() :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}.
+
-spec is_c_map(cerl()) -> boolean().
is_c_map(#c_map{}) ->
@@ -1685,8 +1683,16 @@ update_c_map(#c_map{is_pat=true}=Old, M, Es) ->
update_c_map(#c_map{is_pat=false}=Old, M, Es) ->
ann_c_map(get_ann(Old), M, Es).
+-spec map_pair_key(c_map_pair()) -> cerl().
+
map_pair_key(#c_map_pair{key=K}) -> K.
+
+-spec map_pair_val(c_map_pair()) -> cerl().
+
map_pair_val(#c_map_pair{val=V}) -> V.
+
+-spec map_pair_op(c_map_pair()) -> map_op().
+
map_pair_op(#c_map_pair{op=Op}) -> Op.
-spec c_map_pair(cerl(), cerl()) -> c_map_pair().
@@ -1705,6 +1711,8 @@ c_map_pair_exact(Key,Val) ->
ann_c_map_pair(As,Op,K,V) ->
#c_map_pair{op=Op, key = K, val=V, anno = As}.
+-spec update_c_map_pair(c_map_pair(), map_op(), cerl(), cerl()) -> c_map_pair().
+
update_c_map_pair(Old,Op,K,V) ->
#c_map_pair{op=Op, key=K, val=V, anno = get_ann(Old)}.
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 805095e30c..fa5104c01b 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,8 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
%% @doc Utility functions for Core Erlang case/receive clauses.
%%
%% <p>Syntax trees are defined in the module <a
@@ -358,6 +353,8 @@ match(P, E, Bs) ->
map ->
%% The most we can do is to say "definitely no match" if a
%% map pattern is matched against non-map data.
+ %% (Note: See the document internal_doc/cerl-notes.md for
+ %% information why we don't try to do more here.)
case E of
any ->
{false, Bs};
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 2a8cf2e758..caff47dbcb 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,9 +10,9 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-%%
-%% Core Erlang inliner.
+%% @copyright 1999-2002 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
+%% @doc Core Erlang inliner.
%% =====================================================================
%%
@@ -1827,6 +1822,14 @@ new_var(Env) ->
Name = env__new_vname(Env),
c_var(Name).
+%% The way a template variable is used makes it necessary
+%% to make sure that it is unique in the entire function.
+%% Therefore, template variables are atoms with the prefix "@i".
+
+new_template_var(Env) ->
+ Name = env__new_tname(Env),
+ c_var(Name).
+
residualize_var(R, S) ->
S1 = count_size(weight(var), S),
{ref_to_var(R), st__set_var_referenced(R#ref.loc, S1)}.
@@ -2188,7 +2191,7 @@ make_template(E, Vs0, Env0) ->
T = make_data_skel(data_type(E), Ts),
E1 = update_data(E, data_type(E),
[hd(get_ann(T)) || T <- Ts]),
- V = new_var(Env1),
+ V = new_template_var(Env1),
Env2 = env__bind(var_name(V), E1, Env1),
{set_ann(T, [V]), [V | Vs1], Env2};
false ->
@@ -2203,7 +2206,7 @@ make_template(E, Vs0, Env0) ->
Env2 = env__bind(V, E1, Env1),
{T, Vs1, Env2};
_ ->
- V = new_var(Env0),
+ V = new_template_var(Env0),
Env1 = env__bind(var_name(V), E, Env0),
{set_ann(V, [V]), [V | Vs0], Env1}
end
@@ -2569,6 +2572,11 @@ env__is_defined(Key, Env) ->
env__new_vname(Env) ->
rec_env:new_key(Env).
+env__new_tname(Env) ->
+ rec_env:new_key(fun(I) ->
+ list_to_atom("@i"++integer_to_list(I))
+ end, Env).
+
env__new_fname(A, N, Env) ->
rec_env:new_key(fun (X) ->
S = integer_to_list(X),
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index b3decbec1f..533c984221 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,8 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-
+%% @copyright 1999-2002 Richard Carlsson.
+%% @author Richard Carlsson <[email protected]>
%% @doc Basic functions on Core Erlang abstract syntax trees.
%%
%% <p>Syntax trees are defined in the module <a
@@ -27,7 +22,8 @@
-module(cerl_trees).
-export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2,
- map/2, mapfold/3, mapfold/4, size/1, variables/1]).
+ map/2, mapfold/3, mapfold/4, next_free_variable_name/1,
+ size/1, variables/1]).
-import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3,
ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4,
@@ -355,10 +351,9 @@ mapfold(F, S0, T) ->
mapfold(fun(T0, A) -> {T0, A} end, F, S0, T).
-%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) ->
-%% {cerl(), term()}
-%%
-%% Pre = Post = (cerl(), term()) -> {cerl(), term()}
+%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> {cerl(), term()}
+%% Pre = (cerl(), term()) -> {cerl(), term()}
+%% Post = (cerl(), term()) -> {cerl(), term()}
%%
%% @doc Does a combined map/fold operation on the nodes of the
%% tree. It begins by calling <code>Pre</code> on the tree, using the
@@ -512,6 +507,7 @@ mapfold_pairs(_, _, S, []) ->
%% well-formed Core Erlang syntax tree.
%%
%% @see free_variables/1
+%% @see next_free_variable_name/1
-spec variables(cerl:cerl()) -> [cerl:var_name()].
@@ -524,6 +520,7 @@ variables(T) ->
%% @doc Like <code>variables/1</code>, but only includes variables
%% that are free in the tree.
%%
+%% @see next_free_variable_name/1
%% @see variables/1
-spec free_variables(cerl:cerl()) -> [cerl:var_name()].
@@ -683,6 +680,110 @@ var_list_names([V | Vs], A) ->
var_list_names([], A) ->
A.
+%% ---------------------------------------------------------------------
+
+%% @spec next_free_variable_name(Tree::cerl()) -> var_name()
+%%
+%% var_name() = integer()
+%%
+%% @doc Returns a integer variable name higher than any other integer
+%% variable name in the syntax tree. An exception is thrown if
+%% <code>Tree</code> does not represent a well-formed Core Erlang
+%% syntax tree.
+%%
+%% @see variables/1
+%% @see free_variables/1
+
+-spec next_free_variable_name(cerl:cerl()) -> integer().
+
+next_free_variable_name(T) ->
+ 1 + next_free(T, -1).
+
+next_free(T, Max) ->
+ case type(T) of
+ literal ->
+ Max;
+ var ->
+ case var_name(T) of
+ Int when is_integer(Int) ->
+ max(Int, Max);
+ _ ->
+ Max
+ end;
+ values ->
+ next_free_in_list(values_es(T), Max);
+ cons ->
+ next_free(cons_hd(T), next_free(cons_tl(T), Max));
+ tuple ->
+ next_free_in_list(tuple_es(T), Max);
+ map ->
+ next_free_in_list([map_arg(T)|map_es(T)], Max);
+ map_pair ->
+ next_free_in_list([map_pair_op(T),map_pair_key(T),
+ map_pair_val(T)], Max);
+ 'let' ->
+ Max1 = next_free(let_body(T), Max),
+ Max2 = next_free_in_list(let_vars(T), Max1),
+ next_free(let_arg(T), Max2);
+ seq ->
+ next_free(seq_arg(T),
+ next_free(seq_body(T), Max));
+ apply ->
+ next_free(apply_op(T),
+ next_free_in_list(apply_args(T), Max));
+ call ->
+ next_free(call_module(T),
+ next_free(call_name(T),
+ next_free_in_list(
+ call_args(T), Max)));
+ primop ->
+ next_free_in_list(primop_args(T), Max);
+ 'case' ->
+ next_free(case_arg(T),
+ next_free_in_list(case_clauses(T), Max));
+ clause ->
+ Max1 = next_free(clause_guard(T),
+ next_free(clause_body(T), Max)),
+ next_free_in_list(clause_pats(T), Max1);
+ alias ->
+ next_free(alias_var(T),
+ next_free(alias_pat(T), Max));
+ 'fun' ->
+ next_free(fun_body(T),
+ next_free_in_list(fun_vars(T), Max));
+ 'receive' ->
+ Max1 = next_free_in_list(receive_clauses(T),
+ next_free(receive_timeout(T), Max)),
+ next_free(receive_action(T), Max1);
+ 'try' ->
+ Max1 = next_free(try_body(T), Max),
+ Max2 = next_free_in_list(try_vars(T), Max1),
+ Max3 = next_free(try_handler(T), Max2),
+ Max4 = next_free_in_list(try_evars(T), Max3),
+ next_free(try_arg(T), Max4);
+ 'catch' ->
+ next_free(catch_body(T), Max);
+ binary ->
+ next_free_in_list(binary_segments(T), Max);
+ bitstr ->
+ next_free(bitstr_val(T), next_free(bitstr_size(T), Max));
+ letrec ->
+ Max1 = next_free_in_defs(letrec_defs(T), Max),
+ Max2 = next_free(letrec_body(T), Max1),
+ next_free_in_list(letrec_vars(T), Max2);
+ module ->
+ next_free_in_defs(module_defs(T), Max)
+ end.
+
+next_free_in_list([H | T], Max) ->
+ next_free_in_list(T, next_free(H, Max));
+next_free_in_list([], Max) ->
+ Max.
+
+next_free_in_defs([{_, Post} | Ds], Max) ->
+ next_free_in_defs(Ds, next_free(Post, Max));
+next_free_in_defs([], Max) ->
+ Max.
%% ---------------------------------------------------------------------
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index e37ca31704..6510571441 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -147,8 +147,8 @@ env_compiler_options() -> env_default_opts().
%% Local functions
%%
--define(pass(P), {P,fun P/1}).
--define(pass(P,T), {P,fun T/1,fun P/1}).
+-define(pass(P), {P,fun P/2}).
+-define(pass(P,T), {P,fun T/1,fun P/2}).
env_default_opts() ->
Key = "ERL_COMPILER_OPTIONS",
@@ -198,12 +198,17 @@ expand_opts(Opts0) ->
%% {debug_info_key,Key} implies debug_info.
Opts = case {proplists:get_value(debug_info_key, Opts0),
proplists:get_value(encrypt_debug_info, Opts0),
- proplists:get_bool(debug_info, Opts0)} of
+ proplists:get_value(debug_info, Opts0)} of
{undefined,undefined,_} -> Opts0;
- {_,_,false} -> [debug_info|Opts0];
+ {_,_,undefined} -> [debug_info|Opts0];
{_,_,_} -> Opts0
end,
- foldr(fun expand_opt/2, [], Opts).
+ %% iff,unless processing is to complex...
+ Opts1 = case proplists:is_defined(makedep_side_effect,Opts) of
+ true -> proplists:delete(makedep,Opts);
+ false -> Opts
+ end,
+ foldr(fun expand_opt/2, [], Opts1).
expand_opt(basic_validation, Os) ->
[no_code_generation,to_pp,binary|Os];
@@ -213,12 +218,16 @@ expand_opt(report, Os) ->
[report_errors,report_warnings|Os];
expand_opt(return, Os) ->
[return_errors,return_warnings|Os];
-expand_opt(r12, Os) ->
- [no_recv_opt,no_line_info|Os];
-expand_opt(r13, Os) ->
- [no_recv_opt,no_line_info|Os];
-expand_opt(r14, Os) ->
- [no_line_info|Os];
+expand_opt(r16, Os) ->
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
+expand_opt(r17, Os) ->
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
+expand_opt(r18, Os) ->
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
+expand_opt(r19, Os) ->
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
+expand_opt(r20, Os) ->
+ [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_float_opt, Os) ->
@@ -228,6 +237,8 @@ expand_opt(O, Os) -> [O|Os].
%% format_error(ErrorDescriptor) -> string()
+-spec format_error(term()) -> iolist().
+
format_error(no_native_support) ->
"this system is not configured for native-code compilation.";
format_error(no_crypto) ->
@@ -260,9 +271,9 @@ format_error({delete_temp,File,Error}) ->
io_lib:format("failed to delete temporary file ~ts: ~ts",
[File,file:format_error(Error)]);
format_error({parse_transform,M,R}) ->
- io_lib:format("error in parse transform '~s': ~tp", [M, R]);
+ io_lib:format("error in parse transform '~ts': ~tp", [M, R]);
format_error({undef_parse_transform,M}) ->
- io_lib:format("undefined parse transform '~s'", [M]);
+ io_lib:format("undefined parse transform '~ts'", [M]);
format_error({core_transform,M,R}) ->
io_lib:format("error in core transform '~s': ~tp", [M, R]);
format_error({crash,Pass,Reason}) ->
@@ -284,38 +295,45 @@ format_error_reason({Reason, Stack}) when is_list(Stack) ->
end,
FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end,
[io_lib:format("~tp", [Reason]),"\n\n",
- lib:format_stacktrace(1, Stack, StackFun, FormatFun)];
+ erl_error:format_stacktrace(1, Stack, StackFun, FormatFun)];
format_error_reason(Reason) ->
io_lib:format("~tp", [Reason]).
+-type err_warn_info() :: tuple().
+
%% The compile state record.
-record(compile, {filename="" :: file:filename(),
dir="" :: file:filename(),
base="" :: file:filename(),
ifile="" :: file:filename(),
ofile="" :: file:filename(),
- module=[],
- code=[],
- core_code=[],
- abstract_code=[], %Abstract code for debugger.
- options=[] :: [option()], %Options for compilation
+ module=[] :: module() | [],
+ core_code=[] :: cerl:c_module() | [],
+ abstract_code=[] :: abstract_code(), %Abstract code for debugger.
+ options=[] :: [option()], %Options for compilation
mod_options=[] :: [option()], %Options for module_info
encoding=none :: none | epp:source_encoding(),
- errors=[],
- warnings=[]}).
+ errors=[] :: [err_warn_info()],
+ warnings=[] :: [err_warn_info()],
+ extra_chunks=[] :: [{binary(), binary()}]}).
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);
+ Compile = build_compile(Opts1),
+ internal_comp(Ps, Forms, Source, "", Compile);
internal({file,File}, Opts) ->
{Ext,Ps} = passes(file, Opts),
- Compile = #compile{options=Opts,mod_options=Opts},
- internal_comp(Ps, File, Ext, Compile).
+ Compile = build_compile(Opts),
+ internal_comp(Ps, none, File, Ext, Compile).
-internal_comp(Passes, File, Suffix, St0) ->
+build_compile(Opts0) ->
+ ExtraChunks = proplists:get_value(extra_chunks, Opts0, []),
+ Opts1 = proplists:delete(extra_chunks, Opts0),
+ #compile{options=Opts1,mod_options=Opts1,extra_chunks=ExtraChunks}.
+
+internal_comp(Passes, Code0, File, Suffix, St0) ->
Dir = filename:dirname(File),
Base = filename:basename(File, Suffix),
St1 = St0#compile{filename=File, dir=Dir, base=Base,
@@ -325,36 +343,41 @@ internal_comp(Passes, File, Suffix, St0) ->
Run0 = case member(time, Opts) of
true ->
io:format("Compiling ~tp\n", [File]),
- fun run_tc/2;
- false -> fun({_Name,Fun}, St) -> catch Fun(St) end
+ fun run_tc/3;
+ false ->
+ fun({_Name,Fun}, Code, St) ->
+ catch Fun(Code, St)
+ end
end,
Run = case keyfind(eprof, 1, Opts) of
{eprof,EprofPass} ->
- fun(P, St) ->
- run_eprof(P, EprofPass, St)
+ fun(P, Code, St) ->
+ run_eprof(P, Code, EprofPass, St)
end;
false ->
Run0
end,
- case fold_comp(Passes, Run, St1) of
- {ok,St2} -> comp_ret_ok(St2);
+ case fold_comp(Passes, Run, Code0, St1) of
+ {ok,Code,St2} -> comp_ret_ok(Code, St2);
{error,St2} -> comp_ret_err(St2)
end.
-fold_comp([{delay,Ps0}|Passes], Run, #compile{options=Opts}=St) ->
+fold_comp([{delay,Ps0}|Passes], Run, Code, #compile{options=Opts}=St) ->
Ps = select_passes(Ps0, Opts) ++ Passes,
- fold_comp(Ps, Run, St);
-fold_comp([{Name,Test,Pass}|Ps], Run, St) ->
+ fold_comp(Ps, Run, Code, St);
+fold_comp([{Name,Test,Pass}|Ps], Run, Code, St) ->
case Test(St) of
false -> %Pass is not needed.
- fold_comp(Ps, Run, St);
+ fold_comp(Ps, Run, Code, St);
true -> %Run pass in the usual way.
- fold_comp([{Name,Pass}|Ps], Run, St)
+ fold_comp([{Name,Pass}|Ps], Run, Code, St)
end;
-fold_comp([{Name,Pass}|Ps], Run, St0) ->
- case Run({Name,Pass}, St0) of
- {ok,St1} -> fold_comp(Ps, Run, St1);
- {error,_St1} = Error -> Error;
+fold_comp([{Name,Pass}|Ps], Run, Code0, St0) ->
+ case Run({Name,Pass}, Code0, St0) of
+ {ok,Code,St1} ->
+ fold_comp(Ps, Run, Code, St1);
+ {error,_St1}=Error ->
+ Error;
{'EXIT',Reason} ->
Es = [{St0#compile.ifile,[{none,?MODULE,{crash,Name,Reason}}]}],
{error,St0#compile{errors=St0#compile.errors ++ Es}};
@@ -362,30 +385,30 @@ fold_comp([{Name,Pass}|Ps], Run, St0) ->
Es = [{St0#compile.ifile,[{none,?MODULE,{bad_return,Name,Other}}]}],
{error,St0#compile{errors=St0#compile.errors ++ Es}}
end;
-fold_comp([], _Run, St) -> {ok,St}.
+fold_comp([], _Run, Code, St) -> {ok,Code,St}.
-run_tc({Name,Fun}, St) ->
+run_tc({Name,Fun}, Code, St) ->
T1 = erlang:monotonic_time(),
- Val = (catch Fun(St)),
+ Val = (catch Fun(Code, St)),
T2 = erlang:monotonic_time(),
- Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds),
+ Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond),
Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize),
Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])),
io:format(" ~-30s: ~10.3f s ~12s\n",
[Name,Elapsed/1000,Mem]),
Val.
-run_eprof({Name,Fun}, Name, St) ->
+run_eprof({Name,Fun}, Code, Name, St) ->
io:format("~p: Running eprof\n", [Name]),
c:appcall(tools, eprof, start_profiling, [[self()]]),
- Val = (catch Fun(St)),
+ Val = (catch Fun(Code, St)),
c:appcall(tools, eprof, stop_profiling, []),
c:appcall(tools, eprof, analyze, []),
Val;
-run_eprof({_,Fun}, _, St) ->
- catch Fun(St).
+run_eprof({_,Fun}, Code, _, St) ->
+ catch Fun(Code, St).
-comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) ->
+comp_ret_ok(Code, #compile{warnings=Warn0,module=Mod,options=Opts}=St) ->
case werror(St) of
true ->
case member(report_warnings, Opts) of
@@ -451,8 +474,10 @@ mpf(Ms) ->
passes(Type, Opts) ->
{Ext,Passes0} = passes_1(Opts),
Passes1 = case Type of
- file -> Passes0;
- forms -> tl(Passes0)
+ file ->
+ Passes0;
+ forms ->
+ fix_first_pass(Passes0)
end,
Passes = select_passes(Passes1, Opts),
@@ -489,6 +514,22 @@ pass(from_beam) ->
{".beam",[?pass(read_beam_file)|binary_passes()]};
pass(_) -> none.
+%% For compilation from forms, replace the first pass with a pass
+%% that retrieves the module name. The module name is needed for
+%% proper diagnostics and for compilation to native code.
+
+fix_first_pass([{parse_core,_}|Passes]) ->
+ [?pass(get_module_name_from_core)|Passes];
+fix_first_pass([{beam_consult_asm,_}|Passes]) ->
+ [?pass(get_module_name_from_asm)|Passes];
+fix_first_pass([{read_beam_file,_}|Passes]) ->
+ [?pass(get_module_name_from_beam)|Passes];
+fix_first_pass([_|Passes]) ->
+ %% When compiling from abstract code, the module name
+ %% will be set after running the v3_core pass.
+ Passes.
+
+
%% select_passes([Command], Opts) -> [{Name,Function}]
%% Interpret the lists of commands to return a pure list of passes.
%%
@@ -540,21 +581,21 @@ pass(_) -> none.
%%
select_passes([{pass,Mod}|Ps], Opts) ->
- F = fun(St) ->
- case catch Mod:module(St#compile.code, St#compile.options) of
+ F = fun(Code0, St) ->
+ case catch Mod:module(Code0, St#compile.options) of
{ok,Code} ->
- {ok,St#compile{code=Code}};
+ {ok,Code,St};
{ok,Code,Ws} ->
- {ok,St#compile{code=Code,warnings=St#compile.warnings++Ws}};
+ {ok,Code,St#compile{warnings=St#compile.warnings++Ws}};
{error,Es} ->
{error,St#compile{errors=St#compile.errors ++ Es}}
end
end,
[{Mod,F}|select_passes(Ps, Opts)];
select_passes([{src_listing,Ext}|_], _Opts) ->
- [{listing,fun (St) -> src_listing(Ext, St) end}];
+ [{listing,fun (Code, St) -> src_listing(Ext, Code, St) end}];
select_passes([{listing,Ext}|_], _Opts) ->
- [{listing,fun (St) -> listing(Ext, St) end}];
+ [{listing,fun (Code, St) -> listing(Ext, Code, St) end}];
select_passes([done|_], _Opts) ->
[];
select_passes([{done,Ext}|_], Opts) ->
@@ -640,6 +681,7 @@ select_list_passes_1([], _, Acc) ->
standard_passes() ->
[?pass(transform_module),
+ {iff,makedep_side_effect,?pass(makedep_and_output)},
{iff,makedep,[
?pass(makedep),
{unless,binary,?pass(makedep_output)}
@@ -654,13 +696,13 @@ standard_passes() ->
{iff,'dabstr',{listing,"abstr"}},
{iff,debug_info,?pass(save_abstract_code)},
- ?pass(expand_module),
+ ?pass(expand_records),
{iff,'dexp',{listing,"expand"}},
{iff,'E',{src_listing,"E"}},
{iff,'to_exp',{done,"E"}},
%% Conversion to Core Erlang.
- {pass,v3_core},
+ ?pass(core),
{iff,'dcore',{listing,"core"}},
{iff,'to_core0',{done,"core"}}
| core_passes()].
@@ -670,22 +712,26 @@ core_passes() ->
[{iff,clint0,?pass(core_lint_module)},
{delay,
[{unless,no_copt,
- [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1},
+ [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2},
{iff,doldinline,{listing,"oldinline"}},
- {pass,sys_core_fold},
+ {unless,no_fold,{pass,sys_core_fold}},
{iff,dcorefold,{listing,"corefold"}},
- {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1},
+ {core_inline_module,fun test_core_inliner/1,fun core_inline_module/2},
{iff,dinline,{listing,"inline"}},
{core_fold_after_inlining,fun test_any_inliner/1,
- fun core_fold_module_after_inlining/1},
+ fun core_fold_module_after_inlining/2},
+ {iff,dcopt,{listing,"copt"}},
+ {unless,no_alias,{pass,sys_core_alias}},
+ {iff,dalias,{listing,"core_alias"}},
?pass(core_transforms)]},
- {iff,dcopt,{listing,"copt"}},
{iff,'to_core',{done,"core"}}]}
| kernel_passes()].
kernel_passes() ->
- %% Destructive setelement/3 optimization and core lint.
- [{pass,sys_core_dsetel},
+ %% Optimizations that must be done after all other optimizations.
+ [{pass,sys_core_bsm},
+ {iff,dcbsm,{listing,"core_bsm"}},
+ {pass,sys_core_dsetel},
{iff,dsetel,{listing,"dsetel"}},
{iff,clint,?pass(core_lint_module)},
@@ -695,8 +741,6 @@ kernel_passes() ->
?pass(v3_kernel),
{iff,dkern,{listing,"kernel"}},
{iff,'to_kernel',{done,"kernel"}},
- {pass,v3_life},
- {iff,dlife,{listing,"life"}},
{pass,v3_codegen},
{iff,dcg,{listing,"codegen"}}
| asm_passes()].
@@ -715,8 +759,6 @@ asm_passes() ->
{iff,dexcept,{listing,"except"}},
{unless,no_bs_opt,{pass,beam_bs}},
{iff,dbs,{listing,"bs"}},
- {unless,no_bopt,{pass,beam_bool}},
- {iff,dbool,{listing,"bool"}},
{unless,no_topt,{pass,beam_type}},
{iff,dtype,{listing,"type"}},
{pass,beam_split},
@@ -733,6 +775,10 @@ asm_passes() ->
{iff,dbsm,{listing,"bsm"}},
{unless,no_recv_opt,{pass,beam_receive}},
{iff,drecv,{listing,"recv"}},
+ {unless,no_record_opt,{pass,beam_record}},
+ {iff,drecord,{listing,"record"}},
+ {unless,no_blk2,?pass(block2)},
+ {iff,dblk2,{listing,"block2"}},
{unless,no_stack_trimming,{pass,beam_trim}},
{iff,dtrim,{listing,"trim"}},
{pass,beam_flatten}]},
@@ -751,17 +797,19 @@ asm_passes() ->
| binary_passes()].
binary_passes() ->
- [{native_compile,fun test_native/1,fun native_compile/1},
- {unless,binary,?pass(save_binary,not_werror)}].
+ [{iff,'to_dis',?pass(to_dis)},
+ {native_compile,fun test_native/1,fun native_compile/2},
+ {unless,binary,?pass(save_binary,not_werror)}
+ ].
%%%
%%% Compiler passes.
%%%
%% Remove the target file so we don't have an old one if the compilation fail.
-remove_file(St) ->
+remove_file(Code, St) ->
_ = file:delete(St#compile.ofile),
- {ok,St}.
+ {ok,Code,St}.
-record(asm_module, {module,
exports,
@@ -809,34 +857,50 @@ collect_asm([{attributes, Attr} | Rest], R) ->
collect_asm([X | Rest], R) ->
collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}).
-beam_consult_asm(St) ->
+beam_consult_asm(_Code, St) ->
case file:consult(St#compile.ifile) of
- {ok, Forms0} ->
+ {ok,Forms0} ->
Encoding = epp:read_encoding(St#compile.ifile),
- {Module, Forms} = preprocess_asm_forms(Forms0),
- {ok,St#compile{module=Module, code=Forms, encoding=Encoding}};
+ {Module,Forms} = preprocess_asm_forms(Forms0),
+ {ok,Forms,St#compile{module=Module,encoding=Encoding}};
{error,E} ->
Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
-read_beam_file(St) ->
+get_module_name_from_asm({Mod,_,_,_,_}=Asm, St) ->
+ {ok,Asm,St#compile{module=Mod}};
+get_module_name_from_asm(Asm, St) ->
+ %% Invalid Beam assembly code. Let it crash in a later pass.
+ {ok,Asm,St}.
+
+read_beam_file(_Code, St) ->
case file:read_file(St#compile.ifile) of
{ok,Beam} ->
Infile = St#compile.ifile,
case no_native_compilation(Infile, St) of
true ->
- {ok,St#compile{module=none,code=none}};
+ {ok,none,St#compile{module=none}};
false ->
Mod0 = filename:rootname(filename:basename(Infile)),
Mod = list_to_atom(Mod0),
- {ok,St#compile{module=Mod,code=Beam,ofile=Infile}}
+ {ok,Beam,St#compile{module=Mod,ofile=Infile}}
end;
{error,E} ->
Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+get_module_name_from_beam(Beam, St) ->
+ case beam_lib:info(Beam) of
+ {error,beam_lib,Error} ->
+ Es = [{"((forms))",[{none,beam_lib,Error}]}],
+ {error,St#compile{errors=St#compile.errors ++ Es}};
+ Info ->
+ {module,Mod} = keyfind(module, 1, Info),
+ {ok,Beam,St#compile{module=Mod}}
+ end.
+
no_native_compilation(BeamFile, #compile{options=Opts0}) ->
case beam_lib:chunks(BeamFile, ["CInf"]) of
{ok,{_,[{"CInf",Term0}]}} ->
@@ -849,17 +913,17 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) ->
_ -> false
end.
-parse_module(St0) ->
+parse_module(_Code, St0) ->
case do_parse_module(utf8, St0) of
- {ok,_}=Ret ->
+ {ok,_,_}=Ret ->
Ret;
{error,_}=Ret ->
Ret;
{invalid_unicode,File,Line} ->
case do_parse_module(latin1, St0) of
- {ok,St} ->
+ {ok,Code,St} ->
Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
- {ok,St#compile{warnings=Es++St#compile.warnings}};
+ {ok,Code,St#compile{warnings=Es++St#compile.warnings}};
{error,St} ->
Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
{error,St#compile{errors=Es++St#compile.errors}}
@@ -867,23 +931,29 @@ parse_module(St0) ->
end.
do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) ->
+ SourceName0 = proplists:get_value(source, Opts, File),
+ SourceName = case member(deterministic, Opts) of
+ true -> filename:basename(SourceName0);
+ false -> SourceName0
+ end,
R = epp:parse_file(File,
- [{includes,[".",Dir|inc_paths(Opts)]},
- {macros,pre_defs(Opts)},
- {default_encoding,DefEncoding},
- extra]),
+ [{includes,[".",Dir|inc_paths(Opts)]},
+ {source_name, SourceName},
+ {macros,pre_defs(Opts)},
+ {default_encoding,DefEncoding},
+ extra]),
case R of
{ok,Forms,Extra} ->
Encoding = proplists:get_value(encoding, Extra),
case find_invalid_unicode(Forms, File) of
none ->
- {ok,St#compile{code=Forms,encoding=Encoding}};
+ {ok,Forms,St#compile{encoding=Encoding}};
{invalid_unicode,_,_}=Ret ->
case Encoding of
none ->
Ret;
_ ->
- {ok,St#compile{code=Forms,encoding=Encoding}}
+ {ok,Forms,St#compile{encoding=Encoding}}
end
end;
{error,E} ->
@@ -902,7 +972,7 @@ find_invalid_unicode([H|T], File0) ->
end;
find_invalid_unicode([], _) -> none.
-parse_core(St) ->
+parse_core(_Code, St) ->
case file:read_file(St#compile.ifile) of
{ok,Bin} ->
case core_scan:string(binary_to_list(Bin)) of
@@ -910,7 +980,7 @@ parse_core(St) ->
case core_parse:parse(Toks) of
{ok,Mod} ->
Name = (Mod#c_module.name)#c_literal.val,
- {ok,St#compile{module=Name,code=Mod}};
+ {ok,Mod,St#compile{module=Name}};
{error,E} ->
Es = [{St#compile.ifile,[E]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
@@ -924,6 +994,16 @@ parse_core(St) ->
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+get_module_name_from_core(Core, St) ->
+ try
+ Mod = cerl:concrete(cerl:module_name(Core)),
+ {ok,Core,St#compile{module=Mod}}
+ catch
+ _:_ ->
+ %% Invalid Core Erlang code. Let it crash in a later pass.
+ {ok,Core,St}
+ end.
+
compile_options([{attribute,_L,compile,C}|Fs]) when is_list(C) ->
C ++ compile_options(Fs);
compile_options([{attribute,_L,compile,C}|Fs]) ->
@@ -947,31 +1027,36 @@ clean_parse_transforms_1([], Acc) -> reverse(Acc).
transforms(Os) -> [ M || {parse_transform,M} <- Os ].
-transform_module(#compile{options=Opt,code=Code0}=St0) ->
+transform_module(Code0, #compile{options=Opt}=St) ->
%% Extract compile options from code into options field.
case transforms(Opt ++ compile_options(Code0)) of
- [] -> {ok,St0}; %No parse transforms.
+ [] ->
+ %% No parse transforms.
+ {ok,Code0,St};
Ts ->
%% Remove parse_transform attributes from the abstract code to
%% prevent parse transforms to be run more than once.
Code = clean_parse_transforms(Code0),
- St = St0#compile{code=Code},
- foldl_transform(St, Ts)
+ foldl_transform(Ts, Code, St)
end.
-foldl_transform(St, [T|Ts]) ->
+foldl_transform([T|Ts], Code0, St) ->
Name = "transform " ++ atom_to_list(T),
case code:ensure_loaded(T) =:= {module,T} andalso
- erlang:function_exported(T, parse_transform, 2) of
+ erlang:function_exported(T, parse_transform, 2) of
true ->
- Fun = fun(S) ->
- T:parse_transform(S#compile.code, S#compile.options)
+ Fun = fun(Code, S) ->
+ T:parse_transform(Code, S#compile.options)
end,
Run = case member(time, St#compile.options) of
- true -> fun run_tc/2;
- false -> fun({_Name,F}, S) -> catch F(S) end
+ true ->
+ fun run_tc/3;
+ false ->
+ fun({_Name,F}, Code, S) ->
+ catch F(Code, S)
+ end
end,
- case Run({Name, Fun}, St) of
+ case Run({Name, Fun}, Code0, St) of
{error,Es,Ws} ->
{error,St#compile{warnings=St#compile.warnings ++ Ws,
errors=St#compile.errors ++ Es}};
@@ -980,41 +1065,44 @@ foldl_transform(St, [T|Ts]) ->
{parse_transform,T,R}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}};
{warning, Forms, Ws} ->
- foldl_transform(
- St#compile{code=Forms,
- warnings=St#compile.warnings ++ Ws}, Ts);
+ foldl_transform(Ts, Forms,
+ St#compile{warnings=St#compile.warnings ++ Ws});
Forms ->
- foldl_transform(St#compile{code=Forms}, Ts)
+ foldl_transform(Ts, Forms, St)
end;
false ->
Es = [{St#compile.ifile,[{none,compile,
{undef_parse_transform,T}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end;
-foldl_transform(St, []) -> {ok,St}.
+foldl_transform([], Code, St) -> {ok,Code,St}.
get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts].
-core_transforms(St) ->
+core_transforms(Code, St) ->
%% The options field holds the complete list of options at this
Ts = get_core_transforms(St#compile.options),
- foldl_core_transforms(St, Ts).
+ foldl_core_transforms(Ts, Code, St).
-foldl_core_transforms(St, [T|Ts]) ->
+foldl_core_transforms([T|Ts], Code0, St) ->
Name = "core transform " ++ atom_to_list(T),
- Fun = fun(S) -> T:core_transform(S#compile.code, S#compile.options) end,
+ Fun = fun(Code, S) -> T:core_transform(Code, S#compile.options) end,
Run = case member(time, St#compile.options) of
- true -> fun run_tc/2;
- false -> fun({_Name,F}, S) -> catch F(S) end
+ true ->
+ fun run_tc/3;
+ false ->
+ fun({_Name,F}, Code, S) ->
+ catch F(Code, S)
+ end
end,
- case Run({Name, Fun}, St) of
+ case Run({Name, Fun}, Code0, St) of
{'EXIT',R} ->
Es = [{St#compile.ifile,[{none,compile,{core_transform,T,R}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}};
Forms ->
- foldl_core_transforms(St#compile{code=Forms}, Ts)
+ foldl_core_transforms(Ts, Forms, St)
end;
-foldl_core_transforms(St, []) -> {ok,St}.
+foldl_core_transforms([], Code, St) -> {ok,Code,St}.
%%% Fetches the module name from a list of forms. The module attribute must
%%% be present.
@@ -1035,31 +1123,38 @@ add_default_base(St, Forms) ->
St
end.
-lint_module(St) ->
- case erl_lint:module(St#compile.code,
- St#compile.ifile, St#compile.options) of
+lint_module(Code, St) ->
+ case erl_lint:module(Code, St#compile.ifile, St#compile.options) of
{ok,Ws} ->
%% Insert name of module as base name, if needed. This is
%% for compile:forms to work with listing files.
- St1 = add_default_base(St, St#compile.code),
- {ok,St1#compile{warnings=St1#compile.warnings ++ Ws}};
+ St1 = add_default_base(St, Code),
+ {ok,Code,St1#compile{warnings=St1#compile.warnings ++ Ws}};
{error,Es,Ws} ->
{error,St#compile{warnings=St#compile.warnings ++ Ws,
errors=St#compile.errors ++ Es}}
end.
-core_lint_module(St) ->
- case core_lint:module(St#compile.code, St#compile.options) of
+core_lint_module(Code, St) ->
+ case core_lint:module(Code, St#compile.options) of
{ok,Ws} ->
- {ok,St#compile{warnings=St#compile.warnings ++ Ws}};
+ {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}};
{error,Es,Ws} ->
{error,St#compile{warnings=St#compile.warnings ++ Ws,
errors=St#compile.errors ++ Es}}
end.
-makedep(#compile{code=Code,options=Opts}=St) ->
- Ifile = St#compile.ifile,
- Ofile = St#compile.ofile,
+%% makedep + output and continue
+makedep_and_output(Code0, St) ->
+ {ok,DepCode,St1} = makedep(Code0,St),
+ case makedep_output(DepCode, St1) of
+ {ok,_IgnoreCode,St2} ->
+ {ok,Code0,St2};
+ {error,St2} ->
+ {error,St2}
+ end.
+
+makedep(Code0, #compile{ifile=Ifile,ofile=Ofile,options=Opts}=St) ->
%% Get the target of the Makefile rule.
Target0 =
@@ -1091,7 +1186,7 @@ makedep(#compile{code=Code,options=Opts}=St) ->
%% List the dependencies (includes) for this target.
{MainRule,PhonyRules} = makedep_add_headers(
Ifile, % The input file name.
- Code, % The parsed source.
+ Code0, % The parsed source.
[], % The list of dependencies already added.
length(Target), % The current line length.
Target, % The target.
@@ -1111,7 +1206,8 @@ makedep(#compile{code=Code,options=Opts}=St) ->
true -> MainRule ++ PhonyRules;
_ -> MainRule
end,
- {ok,St#compile{code=iolist_to_binary([Makefile,"\n"])}}.
+ Code = iolist_to_binary([Makefile,"\n"]),
+ {ok,Code,St}.
makedep_add_headers(Ifile, [{attribute,_,file,{File,_}}|Rest],
Included, LineLen, MainTarget, Phony, Opts) ->
@@ -1176,7 +1272,7 @@ makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File) ->
end
end.
-makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) ->
+makedep_output(Code, #compile{options=Opts,ofile=Ofile}=St) ->
%% Write this Makefile (Code) to the selected output.
%% If no output is specified, the default is to write to a file named after
%% the output file.
@@ -1218,7 +1314,7 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) ->
CloseOutput -> ok = file:close(Output1);
true -> ok
end,
- {ok,St}
+ {ok,Code,St}
catch
error:_ ->
%% Couldn't write to output Makefile.
@@ -1235,31 +1331,39 @@ makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) ->
{error,St#compile{errors=St#compile.errors++[Err]}}
end.
-%% expand_module(State) -> State'
-%% Do the common preprocessing of the input forms.
+expand_records(Code0, #compile{options=Opts}=St) ->
+ Code = erl_expand_records:module(Code0, Opts),
+ {ok,Code,St}.
-expand_module(#compile{code=Code,options=Opts0}=St0) ->
- {Mod,Exp,Forms,Opts1} = sys_pre_expand:module(Code, Opts0),
+core(Forms, #compile{options=Opts0}=St) ->
+ Opts1 = lists:flatten([C || {attribute,_,compile,C} <- Forms] ++ Opts0),
Opts = expand_opts(Opts1),
- {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}.
+ {ok,Core,Ws} = v3_core:module(Forms, Opts),
+ Mod = cerl:concrete(cerl:module_name(Core)),
+ {ok,Core,St#compile{module=Mod,options=Opts,
+ warnings=St#compile.warnings++Ws}}.
-core_fold_module_after_inlining(#compile{code=Code0,options=Opts}=St) ->
+core_fold_module_after_inlining(Code0, #compile{options=Opts}=St) ->
%% Inlining may produce code that generates spurious warnings.
%% Ignore all warnings.
{ok,Code,_Ws} = sys_core_fold:module(Code0, Opts),
- {ok,St#compile{code=Code}}.
+ {ok,Code,St}.
-v3_kernel(#compile{code=Code0,options=Opts,warnings=Ws0}=St) ->
+v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) ->
{ok,Code,Ws} = v3_kernel:module(Code0, Opts),
case Ws =:= [] orelse test_core_inliner(St) of
false ->
- {ok,St#compile{code=Code,warnings=Ws0++Ws}};
+ {ok,Code,St#compile{warnings=Ws0++Ws}};
true ->
%% cerl_inline may produce code that generates spurious
%% warnings. Ignore any such warnings.
- {ok,St#compile{code=Code}}
+ {ok,Code,St}
end.
+block2(Code0, #compile{options=Opts}=St) ->
+ {ok,Code} = beam_block:module(Code0, [no_blockify|Opts]),
+ {ok,Code,St}.
+
test_old_inliner(#compile{options=Opts}) ->
%% The point of this test is to avoid loading the old inliner
%% if we know that it will not be used.
@@ -1281,52 +1385,51 @@ test_core_inliner(#compile{options=Opts}) ->
test_any_inliner(St) ->
test_old_inliner(St) orelse test_core_inliner(St).
-core_old_inliner(#compile{code=Code0,options=Opts}=St) ->
+core_old_inliner(Code0, #compile{options=Opts}=St) ->
{ok,Code} = sys_core_inline:module(Code0, Opts),
- {ok,St#compile{code=Code}}.
+ {ok,Code,St}.
-core_inline_module(#compile{code=Code0,options=Opts}=St) ->
+core_inline_module(Code0, #compile{options=Opts}=St) ->
Code = cerl_inline:core_transform(Code0, Opts),
- {ok,St#compile{code=Code}}.
-
-save_abstract_code(#compile{ifile=File}=St) ->
- case abstract_code(St) of
- {ok,Code} ->
- {ok,St#compile{abstract_code=Code}};
- {error,Es} ->
- {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}}
- end.
+ {ok,Code,St}.
+
+save_abstract_code(Code, St) ->
+ {ok,Code,St#compile{abstract_code=erl_parse:anno_to_term(Code)}}.
+
+debug_info(#compile{module=Module,mod_options=Opts0,ofile=OFile,abstract_code=Abst}) ->
+ AbstOpts = cleanup_compile_options(Opts0),
+ Opts1 = proplists:delete(debug_info, Opts0),
+ {Backend,Metadata,Opts2} =
+ case proplists:get_value(debug_info, Opts0, false) of
+ {OptBackend,OptMetadata} when is_atom(OptBackend) -> {OptBackend,OptMetadata,Opts1};
+ false -> {erl_abstract_code,{none,AbstOpts},Opts1};
+ true -> {erl_abstract_code,{Abst,AbstOpts},[debug_info | Opts1]}
+ end,
+ DebugInfo = erlang:term_to_binary({debug_info_v1,Backend,Metadata}, [compressed]),
-abstract_code(#compile{code=Code0,options=Opts,ofile=OFile}) ->
- Code = erl_parse:anno_to_term(Code0),
- Abstr = erlang:term_to_binary({raw_abstract_v1,Code}, [compressed]),
- case member(encrypt_debug_info, Opts) of
+ case member(encrypt_debug_info, Opts2) of
true ->
- case keyfind(debug_info_key, 1, Opts) of
- {_,Key} ->
- encrypt_abs_code(Abstr, Key);
+ case lists:keytake(debug_info_key, 1, Opts2) of
+ {value,{_, Key},Opts3} ->
+ encrypt_debug_info(DebugInfo, Key, [{debug_info_key,'********'} | Opts3]);
false ->
- %% Note: #compile.module has not been set yet.
- %% Here is an approximation that should work for
- %% all valid cases.
- Module = list_to_atom(filename:rootname(filename:basename(OFile))),
- Mode = proplists:get_value(crypto_mode, Opts, des3_cbc),
+ Mode = proplists:get_value(crypto_mode, Opts2, des3_cbc),
case beam_lib:get_crypto_key({debug_info, Mode, Module, OFile}) of
error ->
{error, [{none,?MODULE,no_crypto_key}]};
Key ->
- encrypt_abs_code(Abstr, {Mode, Key})
+ encrypt_debug_info(DebugInfo, {Mode, Key}, Opts2)
end
end;
false ->
- {ok, Abstr}
+ {ok,DebugInfo,Opts2}
end.
-encrypt_abs_code(Abstr, Key0) ->
+encrypt_debug_info(DebugInfo, Key, Opts) ->
try
- RealKey = generate_key(Key0),
+ RealKey = generate_key(Key),
case start_crypto() of
- ok -> {ok,encrypt(RealKey, Abstr)};
+ ok -> {ok,encrypt(RealKey, DebugInfo),Opts};
{error,_}=E -> E
end
catch
@@ -1334,6 +1437,32 @@ encrypt_abs_code(Abstr, Key0) ->
{error,[{none,?MODULE,bad_crypto_key}]}
end.
+cleanup_compile_options(Opts) ->
+ IsDeterministic = lists:member(deterministic, Opts),
+ lists:filter(fun(Opt) ->
+ keep_compile_option(Opt, IsDeterministic)
+ end, Opts).
+
+%% Include paths and current directory don't affect compilation, but they might
+%% be helpful so we include them unless we're doing a deterministic build.
+keep_compile_option({i, _}, Deterministic) ->
+ not Deterministic;
+keep_compile_option({cwd, _}, Deterministic) ->
+ not Deterministic;
+%% We are storing abstract, not asm or core.
+keep_compile_option(from_asm, _Deterministic) ->
+ false;
+keep_compile_option(from_core, _Deterministic) ->
+ false;
+%% Parse transform and macros have already been applied.
+keep_compile_option({parse_transform, _}, _Deterministic) ->
+ false;
+keep_compile_option({d, _, _}, _Deterministic) ->
+ false;
+%% Do not affect compilation result on future calls.
+keep_compile_option(Option, _Deterministic) ->
+ effects_code_generation(Option).
+
start_crypto() ->
try crypto:start() of
{error,{already_started,crypto}} -> ok;
@@ -1357,20 +1486,39 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) ->
TypeString = atom_to_list(Type),
list_to_binary([0,length(TypeString),TypeString,Bin]).
-save_core_code(St) ->
- {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}.
-
-beam_asm(#compile{ifile=File,code=Code0,
- abstract_code=Abst,mod_options=Opts0}=St) ->
- Source = paranoid_absname(File),
- Opts1 = lists:map(fun({debug_info_key,_}) -> {debug_info_key,'********'};
- (Other) -> Other
- end, Opts0),
- 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=[]}}
+save_core_code(Code, St) ->
+ {ok,Code,St#compile{core_code=cerl:from_records(Code)}}.
+
+beam_asm(Code0, #compile{ifile=File,extra_chunks=ExtraChunks,options=CompilerOpts}=St) ->
+ case debug_info(St) of
+ {ok,DebugInfo,Opts0} ->
+ Opts1 = [O || O <- Opts0, effects_code_generation(O)],
+ Chunks = [{<<"Dbgi">>, DebugInfo} | ExtraChunks],
+ CompileInfo = compile_info(File, CompilerOpts, Opts1),
+ {ok,Code} = beam_asm:module(Code0, Chunks, CompileInfo, CompilerOpts),
+ {ok,Code,St#compile{abstract_code=[]}};
+ {error,Es} ->
+ {error,St#compile{errors=St#compile.errors ++ [{File,Es}]}}
end.
+compile_info(File, CompilerOpts, Opts) ->
+ IsSlim = member(slim, CompilerOpts),
+ IsDeterministic = member(deterministic, CompilerOpts),
+ Info0 = proplists:get_value(compile_info, Opts, []),
+ Info1 =
+ case paranoid_absname(File) of
+ [_|_] = Source when not IsSlim, not IsDeterministic ->
+ [{source,Source} | Info0];
+ _ ->
+ Info0
+ end,
+ Info2 =
+ case IsDeterministic of
+ false -> [{options,proplists:delete(compile_info, Opts)} | Info1];
+ true -> Info1
+ end,
+ Info2.
+
paranoid_absname(""=File) ->
File;
paranoid_absname(File) ->
@@ -1392,17 +1540,17 @@ is_native_enabled([no_native|_]) -> false;
is_native_enabled([_|Opts]) -> is_native_enabled(Opts);
is_native_enabled([]) -> false.
-native_compile(#compile{code=none}=St) -> {ok,St};
-native_compile(St) ->
+native_compile(none, St) -> {ok,none,St};
+native_compile(Code, St) ->
case erlang:system_info(hipe_architecture) of
undefined ->
Ws = [{St#compile.ifile,[{none,compile,no_native_support}]}],
- {ok,St#compile{warnings=St#compile.warnings ++ Ws}};
+ {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}};
_ ->
- native_compile_1(St)
+ native_compile_1(Code, St)
end.
-native_compile_1(St) ->
+native_compile_1(Code, St) ->
Opts0 = St#compile.options,
IgnoreErrors = member(ignore_native_errors, Opts0),
Opts = case keyfind(hipe, 1, Opts0) of
@@ -1412,10 +1560,10 @@ native_compile_1(St) ->
end,
try hipe:compile(St#compile.module,
St#compile.core_code,
- St#compile.code,
+ Code,
Opts) of
{ok,{_Type,Bin}=T} when is_binary(Bin) ->
- {ok,embed_native_code(St, T)};
+ {ok,embed_native_code(Code, T),St};
{error,R} ->
case IgnoreErrors of
true ->
@@ -1426,25 +1574,24 @@ native_compile_1(St) ->
{error,St#compile{errors=St#compile.errors ++ Es}}
end
catch
- Class:R ->
- Stk = erlang:get_stacktrace(),
+ Class:R:Stack ->
case IgnoreErrors of
true ->
Ws = [{St#compile.ifile,
- [{none,?MODULE,{native_crash,R,Stk}}]}],
+ [{none,?MODULE,{native_crash,R,Stack}}]}],
{ok,St#compile{warnings=St#compile.warnings ++ Ws}};
false ->
- erlang:raise(Class, R, Stk)
+ erlang:raise(Class, R, Stack)
end
end.
-embed_native_code(St, {Architecture,NativeCode}) ->
- {ok, _, Chunks0} = beam_lib:all_chunks(St#compile.code),
+embed_native_code(Code, {Architecture,NativeCode}) ->
+ {ok, _, Chunks0} = beam_lib:all_chunks(Code),
ChunkName = hipe_unified_loader:chunk_name(Architecture),
Chunks1 = lists:keydelete(ChunkName, 1, Chunks0),
Chunks = Chunks1 ++ [{ChunkName,NativeCode}],
- {ok, BeamPlusNative} = beam_lib:build_module(Chunks),
- St#compile{code=BeamPlusNative}.
+ {ok,BeamPlusNative} = beam_lib:build_module(Chunks),
+ BeamPlusNative.
%% effects_code_generation(Option) -> true|false.
%% Determine whether the option could have any effect on the
@@ -1452,30 +1599,31 @@ embed_native_code(St, {Architecture,NativeCode}) ->
%% errors will be reported).
effects_code_generation(Option) ->
- case Option of
+ case Option of
beam -> false;
report_warnings -> false;
report_errors -> false;
return_errors-> false;
return_warnings-> false;
+ warnings_as_errors -> false;
binary -> false;
verbose -> false;
{cwd,_} -> false;
+ {outdir, _} -> false;
_ -> true
end.
-save_binary(#compile{code=none}=St) -> {ok,St};
-save_binary(#compile{module=Mod,ofile=Outfile,
- options=Opts}=St) ->
+save_binary(none, St) -> {ok,none,St};
+save_binary(Code, #compile{module=Mod,ofile=Outfile,options=Opts}=St) ->
%% Test that the module name and output file name match.
case member(no_error_module_mismatch, Opts) of
true ->
- save_binary_1(St);
+ save_binary_1(Code, St);
false ->
Base = filename:rootname(filename:basename(Outfile)),
case atom_to_list(Mod) of
Base ->
- save_binary_1(St);
+ save_binary_1(Code, St);
_ ->
Es = [{St#compile.ofile,
[{none,?MODULE,{module_name,Mod,Base}}]}],
@@ -1483,14 +1631,14 @@ save_binary(#compile{module=Mod,ofile=Outfile,
end
end.
-save_binary_1(St) ->
+save_binary_1(Code, St) ->
Ofile = St#compile.ofile,
Tfile = tmpfile(Ofile), %Temp working file
- case write_binary(Tfile, St#compile.code, St) of
+ case write_binary(Tfile, Code, St) of
ok ->
case file:rename(Tfile, Ofile) of
ok ->
- {ok,St};
+ {ok,none,St};
{error,RenameError} ->
Es0 = [{Ofile,[{none,?MODULE,{rename,Tfile,Ofile,
RenameError}}]}],
@@ -1590,6 +1738,9 @@ list_errors(_F, []) -> ok.
%% tmpfile(ObjFile) -> TmpFile
%% Work out the correct input and output file names.
+-spec iofile(atom() | file:filename_all()) ->
+ {file:name_all(),file:name_all()}.
+
iofile(File) when is_atom(File) ->
iofile(atom_to_list(File));
iofile(File) ->
@@ -1630,34 +1781,49 @@ pre_defs([]) -> [].
inc_paths(Opts) ->
[ P || {i,P} <- Opts, is_list(P) ].
-src_listing(Ext, St) ->
+src_listing(Ext, Code, St) ->
listing(fun (Lf, {_Mod,_Exp,Fs}) -> do_src_listing(Lf, Fs);
(Lf, Fs) -> do_src_listing(Lf, Fs) end,
- Ext, St).
+ Ext, Code, St).
do_src_listing(Lf, Fs) ->
Opts = [lists:keyfind(encoding, 1, io:getopts(Lf))],
foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F, Opts),"\n"]) end,
Fs).
-listing(Ext, St0) ->
+listing(Ext, Code, St0) ->
St = St0#compile{encoding = none},
- listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St).
+ listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, Code, St).
-listing(LFun, Ext, St) ->
+listing(LFun, Ext, Code, St) ->
Lfile = outfile(St#compile.base, Ext, St#compile.options),
case file:open(Lfile, [write,delayed_write]) of
{ok,Lf} ->
- Code = restore_expanded_types(Ext, St#compile.code),
+ Code = restore_expanded_types(Ext, Code),
output_encoding(Lf, St),
LFun(Lf, Code),
ok = file:close(Lf),
- {ok,St};
+ {ok,Code,St};
{error,Error} ->
Es = [{Lfile,[{none,compile,{write_error,Error}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+to_dis(Code, #compile{module=Module,ofile=Outfile}=St) ->
+ Loaded = code:is_loaded(Module),
+ Sticky = code:is_sticky(Module),
+ _ = [code:unstick_mod(Module) || Sticky],
+
+ {module,Module} = code:load_binary(Module, "", Code),
+ DestDir = filename:dirname(Outfile),
+ DisFile = filename:join(DestDir, atom_to_list(Module) ++ ".dis"),
+ ok = erts_debug:dis_to_file(Module, DisFile),
+
+ %% Restore loaded module
+ _ = [{module, Module} = code:load_file(Module) || Loaded =/= false],
+ [code:stick_mod(Module) || Sticky],
+ {ok,Code,St}.
+
output_encoding(F, #compile{encoding = none}) ->
ok = io:setopts(F, [{encoding, epp:default_encoding()}]);
output_encoding(F, #compile{encoding = Encoding}) ->
@@ -1724,6 +1890,8 @@ help(_) ->
%% compile(AbsFileName, Outfilename, Options)
%% Compile entry point for erl_compile.
+-spec compile(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile(File0, _OutFile, Options) ->
pre_load(),
File = shorten_filename(File0),
@@ -1732,6 +1900,8 @@ compile(File0, _OutFile, Options) ->
Other -> Other
end.
+-spec compile_beam(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile_beam(File0, _OutFile, Opts) ->
File = shorten_filename(File0),
case file(File, [from_beam|make_erl_options(Opts)]) of
@@ -1739,6 +1909,8 @@ compile_beam(File0, _OutFile, Opts) ->
Other -> Other
end.
+-spec compile_asm(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile_asm(File0, _OutFile, Opts) ->
File = shorten_filename(File0),
case file(File, [from_asm|make_erl_options(Opts)]) of
@@ -1746,6 +1918,8 @@ compile_asm(File0, _OutFile, Opts) ->
Other -> Other
end.
+-spec compile_core(file:filename(), _, #options{}) -> 'ok' | 'error'.
+
compile_core(File0, _OutFile, Opts) ->
File = shorten_filename(File0),
case file(File, [from_core|make_erl_options(Opts)]) of
@@ -1795,7 +1969,6 @@ pre_load() ->
L = [beam_a,
beam_asm,
beam_block,
- beam_bool,
beam_bs,
beam_bsm,
beam_clean,
@@ -1807,6 +1980,7 @@ pre_load() ->
beam_opcodes,
beam_peep,
beam_receive,
+ beam_record,
beam_reorder,
beam_split,
beam_trim,
@@ -1825,12 +1999,12 @@ pre_load() ->
erl_lint,
erl_parse,
erl_scan,
+ sys_core_alias,
+ sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
- sys_pre_expand,
v3_codegen,
v3_core,
- v3_kernel,
- v3_life],
+ v3_kernel],
_ = code:ensure_modules_loaded(L),
ok.
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 1fd7800e85..cf32fd251c 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-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,7 +24,6 @@
beam_a,
beam_asm,
beam_block,
- beam_bool,
beam_bs,
beam_bsm,
beam_clean,
@@ -39,6 +38,7 @@
beam_peep,
beam_receive,
beam_reorder,
+ beam_record,
beam_split,
beam_trim,
beam_type,
@@ -58,20 +58,20 @@
core_lib,
erl_bifs,
rec_env,
+ sys_core_alias,
+ sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
sys_core_fold_lists,
sys_core_inline,
sys_pre_attributes,
- sys_pre_expand,
v3_codegen,
v3_core,
v3_kernel,
- v3_kernel_pp,
- v3_life
+ v3_kernel_pp
]},
{registered, []},
{applications, [kernel, stdlib]},
{env, []},
- {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-7.0",
+ {runtime_dependencies, ["stdlib-2.5","kernel-4.0","hipe-3.12","erts-9.0",
"crypto-3.6"]}]}.
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 7d3513c0ba..3f69cb03a9 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2015. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -353,12 +353,6 @@ expr(#c_case{arg=Arg,clauses=Cs}, Def, Rt, St0) ->
Pc = case_patcount(Cs),
St1 = body(Arg, Def, Pc, St0),
clauses(Cs, Def, Pc, Rt, St1);
-expr(#c_receive{clauses=Cs,timeout=#c_literal{val=infinity},
- action=#c_literal{}},
- Def, Rt, St) ->
- %% If the timeout is 'infinity', the after code can never
- %% be reached. We don't care if the return count is wrong.
- clauses(Cs, Def, 1, Rt, St);
expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) ->
St1 = expr(T, Def, 1, St0),
St2 = body(A, Def, Rt, St1),
@@ -497,8 +491,10 @@ pattern(#c_tuple{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
pattern(#c_map{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
-pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V},Def,Ps,St) ->
- pattern_list([K,V],Def,Ps,St);
+pattern(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Def, Ps, St) ->
+ %% The key is an input.
+ pat_map_expr(K, Def, St),
+ pattern_list([V],Def,Ps,St);
pattern(#c_binary{segments=Ss}, Def, Ps, St0) ->
St = pat_bin_tail_check(Ss, St0),
pat_bin(Ss, Def, Ps, St);
@@ -561,6 +557,10 @@ pat_bit_expr(#c_binary{}, _, _Def, St) ->
pat_bit_expr(_, _, _, St) ->
add_error({illegal_expr,St#lint.func}, St).
+pat_map_expr(#c_var{name=N}, Def, St) -> expr_var(N, Def, St);
+pat_map_expr(#c_literal{}, _Def, St) -> St;
+pat_map_expr(_, _, St) -> add_error({illegal_expr,St#lint.func}, St).
+
%% pattern_list([Var], Defined, State) -> {[PatVar],State}.
%% pattern_list([Var], Defined, [PatVar], State) -> {[PatVar],State}.
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index 8028aa99bb..10d8c44dd3 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -1,7 +1,7 @@
%% -*-Erlang-*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -36,7 +36,7 @@ other_pattern atomic_pattern tuple_pattern cons_pattern tail_pattern
binary_pattern segment_patterns segment_pattern
expression single_expression
-literal literals atomic_literal tuple_literal cons_literal tail_literal
+literal literals atomic_literal tuple_literal cons_literal tail_literal fun_literal
nil tuple cons tail
binary segments segment
@@ -267,6 +267,7 @@ single_expression -> cons : '$1'.
single_expression -> binary : '$1'.
single_expression -> variable : '$1'.
single_expression -> function_name : '$1'.
+single_expression -> fun_literal : '$1'.
single_expression -> fun_expr : '$1'.
single_expression -> let_expr : '$1'.
single_expression -> letrec_expr : '$1'.
@@ -303,6 +304,9 @@ tail_literal -> ']' : #c_literal{val=[]}.
tail_literal -> '|' literal ']' : '$2'.
tail_literal -> ',' literal tail_literal : c_cons('$2', '$3').
+fun_literal -> 'fun' atom ':' atom '/' integer :
+ #c_literal{val = erlang:make_fun(tok_val('$2'), tok_val('$4'), tok_val('$6'))}.
+
tuple -> '{' '}' : c_tuple([]).
tuple -> '{' anno_expressions '}' : c_tuple('$2').
@@ -432,6 +436,21 @@ timeout ->
%% ====================================================================== %%
+Header
+"%% This file was automatically generated from the file \"core_parse.yrl\"."
+"%%"
+"%% Copyright Ericsson AB 1999-2009. All Rights Reserved."
+"%%"
+"%% Licensed under the Apache License, Version 2.0 (the \"License\"); you may"
+"%% not use this file except in compliance with the License. You may obtain"
+"%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>"
+"%%"
+"%% Unless required by applicable law or agreed to in writing, software"
+"%% distributed under the License is distributed on an \"AS IS\" BASIS,"
+"%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied."
+"%% See the License for the specific language governing permissions and"
+"%% limitations under the License."
+"".
Erlang code.
@@ -481,7 +500,7 @@ make_lit_bin(Acc, [#c_bitstr{val=I0,size=Sz0,unit=U0,type=Type0,flags=F0}|T]) ->
throw(impossible)
end,
if
- Sz =< 8, T =:= [] ->
+ 0 =< Sz, Sz =< 8, T =:= [] ->
<<Acc/binary,I:Sz>>;
Sz =:= 8 ->
make_lit_bin(<<Acc/binary,I:8>>, T);
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 67209d06be..cb3f24fd08 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -136,6 +136,11 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
key=#c_literal{val=K},
val=#c_literal{val=V}} || {K,V} <- Pairs],
format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
+format_1(#c_literal{val=F},_Ctxt) when is_function(F) ->
+ {module,M} = erlang:fun_info(F, module),
+ {name,N} = erlang:fun_info(F, name),
+ {arity,A} = erlang:fun_info(F, arity),
+ ["fun ",core_atom(M),$:,core_atom(N),$/,integer_to_list(A)];
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
format_1(#c_var{name=V}, _) ->
@@ -179,7 +184,7 @@ format_1(#c_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#c_map{arg=#c_literal{anno=[],val=M},es=Es}, Ctxt)
+format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt)
when is_map(M), map_size(M) =:= 0 ->
["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
@@ -464,7 +469,7 @@ indent(#ctxt{indent=N}) ->
N =< 0 ->
"";
true ->
- string:chars($\t, N div ?TAB_WIDTH, spaces(N rem ?TAB_WIDTH))
+ lists:duplicate(N div ?TAB_WIDTH, $\t) ++ spaces(N rem ?TAB_WIDTH)
end.
nl_indent(Ctxt) -> [$\n|indent(Ctxt)].
@@ -541,4 +546,3 @@ segs_from_bitstring(Bitstring) ->
unit=#c_literal{val=1},
type=#c_literal{val=integer},
flags=#c_literal{val=[unsigned,big]}}].
-
diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl
index 11b52f6c5f..a50a2ffa8d 100644
--- a/lib/compiler/src/core_scan.erl
+++ b/lib/compiler/src/core_scan.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -49,13 +49,37 @@
-import(lists, [reverse/1]).
+-type location() :: integer().
+-type category() :: atom().
+-type symbol() :: atom() | float() | integer() | string().
+-type token() :: {category(), Anno :: location(), symbol()}
+ | {category(), Anno :: location()}.
+-type tokens() :: [token()].
+-type error_description() :: term().
+-type error_info() :: {erl_anno:location(), module(), error_description()}.
+
%% string([Char]) ->
%% string([Char], StartPos) ->
%% {ok, [Tok], EndPos} |
%% {error, {Pos,core_scan,What}, EndPos}
+-spec string(String) -> Return when
+ String :: string(),
+ Return :: {'ok', Tokens :: tokens(), EndLocation}
+ | {'error', ErrorInfo :: error_info(), ErrorLocation},
+ EndLocation :: location(),
+ ErrorLocation :: location().
+
string(Cs) -> string(Cs, 1).
+-spec string(String, StartLocation) -> Return when
+ String :: string(),
+ Return :: {'ok', Tokens :: tokens(), EndLocation}
+ | {'error', ErrorInfo :: error_info(), ErrorLocation},
+ StartLocation :: location(),
+ EndLocation :: location(),
+ ErrorLocation :: location().
+
string(Cs, Sp) ->
%% Add an 'eof' to always get correct handling.
case string_pre_scan(Cs, [], Sp) of
@@ -176,8 +200,8 @@ pre_string(eof, Q, _, Sp, SoFar, Pos) ->
pre_string_error(Q, Sp, SoFar, Pos).
pre_string_error(Q, Sp, SoFar, Pos) ->
- S = reverse(string:substr(SoFar, 1, string:chr(SoFar, Q)-1)),
- pre_error({string,Q,string:substr(S, 1, 16)}, Sp, Pos).
+ [S,_] = string:split(SoFar, [Q]),
+ pre_error({string,Q,string:slice(string:reverse(S), 0, 16)}, Sp, Pos).
pre_char([C|Cs], SoFar) -> pre_char(C, Cs, SoFar);
pre_char([], _) -> more;
@@ -259,10 +283,12 @@ scan1([$$|Cs0], Toks, Pos) -> %Character constant
scan1(Cs, [{char,Pos,C}|Toks], Pos1);
scan1([$'|Cs0], Toks, Pos) -> %Atom (always quoted)
{S,Cs1,Pos1} = scan_string(Cs0, $', Pos),
- case catch list_to_atom(S) of
+ try binary_to_atom(list_to_binary(S), utf8) of
A when is_atom(A) ->
- scan1(Cs1, [{atom,Pos,A}|Toks], Pos1);
- _Error -> scan_error({illegal,atom}, Pos)
+ scan1(Cs1, [{atom,Pos,A}|Toks], Pos1)
+ catch
+ error:_ ->
+ scan_error({illegal,atom}, Pos)
end;
scan1([$"|Cs0], Toks, Pos) -> %String
{S,Cs1,Pos1} = scan_string(Cs0, $", Pos),
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 6b2d781a76..68489a0122 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -75,11 +75,12 @@ 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, ceil, 1) -> true;
is_pure(erlang, element, 2) -> true;
is_pure(erlang, float, 1) -> true;
is_pure(erlang, float_to_list, 1) -> true;
is_pure(erlang, float_to_binary, 1) -> true;
-is_pure(erlang, hash, 2) -> false;
+is_pure(erlang, floor, 1) -> true;
is_pure(erlang, hd, 1) -> true;
is_pure(erlang, integer_to_binary, 1) -> true;
is_pure(erlang, integer_to_list, 1) -> true;
@@ -93,6 +94,7 @@ is_pure(erlang, is_function, 1) -> true;
is_pure(erlang, is_integer, 1) -> true;
is_pure(erlang, is_list, 1) -> true;
is_pure(erlang, is_map, 1) -> true;
+is_pure(erlang, is_map_key, 2) -> true;
is_pure(erlang, is_number, 1) -> true;
is_pure(erlang, is_pid, 1) -> true;
is_pure(erlang, is_port, 1) -> true;
@@ -108,6 +110,8 @@ is_pure(erlang, list_to_integer, 1) -> true;
is_pure(erlang, list_to_pid, 1) -> true;
is_pure(erlang, list_to_tuple, 1) -> true;
is_pure(erlang, max, 2) -> true;
+is_pure(erlang, make_fun, 3) -> true;
+is_pure(erlang, map_get, 2) -> true;
is_pure(erlang, min, 2) -> true;
is_pure(erlang, phash, 2) -> false;
is_pure(erlang, pid_to_list, 1) -> true;
@@ -129,11 +133,14 @@ is_pure(math, asinh, 1) -> true;
is_pure(math, atan, 1) -> true;
is_pure(math, atan2, 2) -> true;
is_pure(math, atanh, 1) -> true;
+is_pure(math, ceil, 1) -> true;
is_pure(math, cos, 1) -> true;
is_pure(math, cosh, 1) -> true;
is_pure(math, erf, 1) -> true;
is_pure(math, erfc, 1) -> true;
is_pure(math, exp, 1) -> true;
+is_pure(math, floor, 1) -> true;
+is_pure(math, fmod, 2) -> true;
is_pure(math, log, 1) -> true;
is_pure(math, log2, 1) -> true;
is_pure(math, log10, 1) -> true;
@@ -192,6 +199,7 @@ is_safe(erlang, is_port, 1) -> true;
is_safe(erlang, is_reference, 1) -> true;
is_safe(erlang, is_tuple, 1) -> true;
is_safe(erlang, make_ref, 0) -> true;
+is_safe(erlang, make_fun, 3) -> true;
is_safe(erlang, max, 2) -> true;
is_safe(erlang, min, 2) -> true;
is_safe(erlang, node, 0) -> true;
@@ -203,7 +211,6 @@ is_safe(erlang, registered, 0) -> true;
is_safe(erlang, self, 0) -> true;
is_safe(erlang, term_to_binary, 1) -> true;
is_safe(erlang, time, 0) -> true;
-is_safe(error_logger, warning_map, 0) -> true;
is_safe(_, _, _) -> false.
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index dcbdeb32e6..02dead9e92 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1998-2016. All Rights Reserved.
+# Copyright Ericsson AB 1998-2018. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -537,3 +537,40 @@ BEAM_FORMAT_NUMBER=0
156: is_map/2
157: has_map_fields/3
158: get_map_elements/3
+
+# OTP 20
+
+## @spec is_tagged_tuple Lbl Reg N Atom
+## @doc Test the type of Reg and jumps to Lbl if it is not a tuple.
+## Test the arity of Reg and jumps to Lbl if it is not N.
+## Test the first element of the tuple and jumps to Lbl if it is not Atom.
+159: is_tagged_tuple/4
+
+# OTP 21
+
+## @spec build_stacktrace
+## @doc Given the raw stacktrace in x(0), build a cooked stacktrace suitable
+## for human consumption. Store it in x(0). Destroys all other registers.
+## Do a garbage collection if necessary to allocate space on the heap
+## for the result.
+160: build_stacktrace/0
+
+## @spec raw_raise
+## @doc This instruction works like the erlang:raise/3 BIF, except that the
+## stacktrace in x(2) must be a raw stacktrace.
+## x(0) is the class of the exception (error, exit, or throw),
+## x(1) is the exception term, and x(2) is the raw stackframe.
+## If x(0) is not a valid class, the instruction will not throw an
+## exception, but store the atom 'badarg' in x(0) and execute the
+## next instruction.
+161: raw_raise/0
+
+## @spec get_hd Source Head
+## @doc Get the head (or car) part of a list (a cons cell) from Source and
+## put it into the register Head.
+162: get_hd/2
+
+## @spec get_tl Source Tail
+## @doc Get the tail (or cdr) part of a list (a cons cell) from Source and
+## put it into the register Tail.
+163: get_tl/2
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index cdc513e57c..48d39776dc 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,10 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-%%
-%% @author Richard Carlsson <[email protected]>
%% @copyright 1999-2004 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
%% @doc Abstract environments, supporting self-referential bindings and
%% automatic new-key generation.
diff --git a/lib/compiler/src/sys_core_alias.erl b/lib/compiler/src/sys_core_alias.erl
new file mode 100644
index 0000000000..3326c6a2a8
--- /dev/null
+++ b/lib/compiler/src/sys_core_alias.erl
@@ -0,0 +1,307 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Replace values by aliases from patterns optimisation for Core
+
+%% Replace expressions by aliases from patterns. For example:
+%%
+%% example({ok, Val}) ->
+%% {ok, Val}.
+%%
+%% will become:
+%%
+%% example({ok, Val} = Tuple) ->
+%% Tuple.
+%%
+%% Currently this pass aliases tuple and cons nodes made of literals,
+%% variables and other cons. The tuple/cons may appear anywhere in the
+%% pattern and it will be aliased if used later on.
+%%
+%% Notice a tuple/cons made only of literals is not aliased as it may
+%% be part of the literal pool.
+
+-module(sys_core_alias).
+
+-export([module/2]).
+
+-include("core_parse.hrl").
+
+-define(NOTSET, 0).
+
+-record(sub, {p=#{} :: #{term() => ?NOTSET | atom()}, %% Found pattern substitutions
+ v=cerl_sets:new() :: cerl_sets:set(cerl:var_name()), %% Variables used by patterns
+ t=undefined :: term()}). %% Temporary information from pre to post
+
+-type sub() :: #sub{}.
+
+-spec module(cerl:c_module(), [compile:option()]) ->
+ {'ok',cerl:c_module(),[]}.
+
+module(#c_module{defs=Ds0}=Mod, _Opts) ->
+ Ds1 = [def(D) || D <- Ds0],
+ {ok,Mod#c_module{defs=Ds1},[]}.
+
+def({#c_var{name={F,Arity}}=Name,B0}) ->
+ try
+ put(new_var_num, 0),
+ {B1,_} = cerl_trees:mapfold(fun pre/2, fun post/2, sub_new(undefined), B0),
+ erase(new_var_num),
+ {Name,B1}
+ catch
+ Class:Error:Stack ->
+ io:fwrite("Function: ~w/~w\n", [F,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+pre(#c_let{vars=Vars}=Node, Sub) ->
+ {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_fun{vars=Vars}=Node, Sub) ->
+ {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_clause{pats=Pats}=Node, Sub0) ->
+ VarNames = get_variables(Pats),
+ Sub1 = sub_fold(VarNames, Sub0),
+ Keys = get_pattern_keys(Pats),
+ Sub2 = sub_add_keys(Keys, Sub1),
+
+ #sub{v=SubNames,t=Temp} = Sub2,
+ Sub3 = Sub2#sub{v=merge_variables(VarNames, SubNames),
+ t={clause,Pats,Keys,SubNames,Temp}},
+
+ {Node#c_clause{pats=[]},Sub3};
+
+pre(Node, Sub0) ->
+ %% We cache only tuples and cons.
+ case cerl:is_data(Node) andalso not cerl:is_literal(Node) of
+ false ->
+ {Node,Sub0};
+ true ->
+ Kind = cerl:data_type(Node),
+ Es = cerl:data_es(Node),
+ case sub_cache_nodes(Kind, Es, Sub0) of
+ {Name,Sub1} ->
+ {cerl:ann_c_var(cerl:get_ann(Node), Name),Sub1};
+ error ->
+ {Node,Sub0}
+ end
+ end.
+
+post(#c_let{}=Node, Sub) ->
+ {Node,sub_unfold(Sub)};
+
+post(#c_fun{}=Node, Sub) ->
+ {Node,sub_unfold(Sub)};
+
+post(#c_clause{}=Node, #sub{t={clause,Pats0,Keys,V,T}}=Sub0) ->
+ {Sub1,PostKeys} = sub_take_keys(Keys, Sub0),
+ Pats1 = put_pattern_keys(Pats0, PostKeys),
+ Sub2 = sub_unfold(Sub1#sub{v=V,t=T}),
+ {Node#c_clause{pats=Pats1},Sub2};
+
+post(Node, Sub) ->
+ {Node,Sub}.
+
+%% sub_new/1
+%% sub_add_keys/2
+%% sub_take_keys/3
+%% sub_cache_nodes/3
+%%
+%% Manages the substitutions record.
+
+%% Builds a new sub.
+-spec sub_new(term()) -> sub().
+sub_new(Temp) ->
+ #sub{t=Temp}.
+
+%% Folds the sub into a new one if the variables in nodes are not disjoint
+sub_fold(VarNames, #sub{v=SubNames}=Sub) ->
+ case is_disjoint_variables(VarNames, SubNames) of
+ true -> Sub#sub{t={temp,Sub#sub.t}};
+ false -> sub_new({sub,Sub})
+ end.
+
+%% Unfolds the sub in case one was folded in the previous step
+sub_unfold(#sub{t={temp,Temp}}=Sub) ->
+ Sub#sub{t=Temp};
+sub_unfold(#sub{t={sub,Sub}}) ->
+ Sub.
+
+%% Adds the keys extracted from patterns to the state.
+-spec sub_add_keys([term()], sub()) -> sub().
+sub_add_keys(Keys, #sub{p=Pat0}=Sub) ->
+ Pat1 =
+ lists:foldl(fun(Key, Acc) ->
+ false = maps:is_key(Key, Acc), %Assertion.
+ maps:put(Key, ?NOTSET, Acc)
+ end, Pat0, Keys),
+ Sub#sub{p=Pat1}.
+
+%% Take the keys from the map taking into account the keys
+%% that have changed as those must become aliases in the pattern.
+-spec sub_take_keys([term()], sub()) -> {sub(), [{term(), atom()}]}.
+sub_take_keys(Keys, #sub{p=Pat0}=Sub) ->
+ {Pat1,Acc} = sub_take_keys(Keys, Pat0, []),
+ {Sub#sub{p=Pat1},Acc}.
+
+sub_take_keys([K|T], Sub0, Acc) ->
+ case maps:take(K, Sub0) of
+ {?NOTSET,Sub1} ->
+ sub_take_keys(T, Sub1, Acc);
+ {Name,Sub1} ->
+ sub_take_keys(T, Sub1, [{K,Name}|Acc])
+ end;
+sub_take_keys([], Sub, Acc) ->
+ {Sub,Acc}.
+
+%% Check if the node can be cached based on the state information.
+%% If it can be cached and it does not have an alias for it, we
+%% build one.
+-spec sub_cache_nodes(atom(), [cerl:cerl()], sub()) -> {atom(), sub()} | error.
+sub_cache_nodes(Kind, Nodes, #sub{p=Pat}=Sub) ->
+ case nodes_to_key(Kind, Nodes) of
+ {ok, Key} ->
+ case Pat of
+ #{Key := ?NOTSET} ->
+ new_var_name(Key, Sub);
+ #{Key := Name} ->
+ {Name,Sub};
+ #{} ->
+ error
+ end;
+ error ->
+ error
+ end.
+
+new_var_name(Key, #sub{p=Pat}=Sub) ->
+ Counter = get(new_var_num),
+ Name = list_to_atom("@r" ++ integer_to_list(Counter)),
+ put(new_var_num, Counter + 1),
+ {Name,Sub#sub{p=maps:put(Key, Name, Pat)}}.
+
+%% get_variables/1
+%% is_disjoint_variables/2
+%% merge_variables/2
+
+get_variables(NodesList) ->
+ cerl_sets:from_list([Var || Node <- NodesList, Var <- cerl_trees:variables(Node)]).
+
+is_disjoint_variables(Vars1, Vars2) ->
+ cerl_sets:is_disjoint(Vars1, Vars2).
+
+merge_variables(Vars1, Vars2) ->
+ cerl_sets:union(Vars1, Vars2).
+
+%% get_pattern_keys/2
+%% put_pattern_keys/2
+%%
+%% Gets keys from patterns or add them as aliases.
+
+get_pattern_keys(Patterns) ->
+ lists:foldl(fun get_pattern_keys/2, [], Patterns).
+
+get_pattern_keys(#c_tuple{es=Es}, Acc0) ->
+ Acc1 = accumulate_pattern_keys(tuple, Es, Acc0),
+ lists:foldl(fun get_pattern_keys/2, Acc1, Es);
+get_pattern_keys(#c_cons{hd=Hd,tl=Tl}, Acc0) ->
+ Acc1 = accumulate_pattern_keys(cons, [Hd, Tl], Acc0),
+ get_pattern_keys(Tl, get_pattern_keys(Hd, Acc1));
+get_pattern_keys(#c_alias{pat=Pat}, Acc0) ->
+ get_pattern_keys(Pat, Acc0);
+get_pattern_keys(#c_map{es=Es}, Acc0) ->
+ lists:foldl(fun get_pattern_keys/2, Acc0, Es);
+get_pattern_keys(#c_map_pair{val=Val}, Acc0) ->
+ get_pattern_keys(Val, Acc0);
+get_pattern_keys(_, Acc) ->
+ Acc.
+
+accumulate_pattern_keys(Kind, Nodes, Acc) ->
+ case nodes_to_key(Kind, Nodes) of
+ {ok,Key} -> [Key|Acc];
+ error -> Acc
+ end.
+
+put_pattern_keys(Patterns, []) ->
+ Patterns;
+put_pattern_keys(Patterns, Keys) ->
+ {NewPatterns,Map} =
+ lists:mapfoldl(fun alias_pattern_keys/2, maps:from_list(Keys), Patterns),
+ %% Check all aliases have been consumed from the map.
+ 0 = map_size(Map),
+ NewPatterns.
+
+alias_pattern_keys(#c_tuple{anno=Anno,es=Es0}=Node, Acc0) ->
+ {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+ nodes_to_alias(tuple, Es0, Anno, Node#c_tuple{es=Es1}, Acc1);
+alias_pattern_keys(#c_cons{anno=Anno,hd=Hd0,tl=Tl0}=Node, Acc0) ->
+ {Hd1,Acc1} = alias_pattern_keys(Hd0, Acc0),
+ {Tl1,Acc2} = alias_pattern_keys(Tl0, Acc1),
+ nodes_to_alias(cons, [Hd0, Tl0], Anno, Node#c_cons{hd=Hd1,tl=Tl1}, Acc2);
+alias_pattern_keys(#c_alias{pat=Pat0}=Node, Acc0) ->
+ {Pat1,Acc1} = alias_pattern_keys(Pat0, Acc0),
+ {Node#c_alias{pat=Pat1}, Acc1};
+alias_pattern_keys(#c_map{es=Es0}=Node, Acc0) ->
+ {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+ {Node#c_map{es=Es1}, Acc1};
+alias_pattern_keys(#c_map_pair{val=Val0}=Node, Acc0) ->
+ {Val1,Acc1} = alias_pattern_keys(Val0, Acc0),
+ {Node#c_map_pair{val=Val1}, Acc1};
+alias_pattern_keys(Pattern, Acc) ->
+ {Pattern,Acc}.
+
+%% Check if a node must become an alias because
+%% its pattern was used later on as an expression.
+nodes_to_alias(Kind, Inner, Anno, Node, Keys0) ->
+ case nodes_to_key(Kind, Inner) of
+ {ok,Key} ->
+ case maps:take(Key, Keys0) of
+ {Name,Keys1} ->
+ Var = cerl:ann_c_var(Anno, Name),
+ {cerl:ann_c_alias(Anno, Var, Node), Keys1};
+ error ->
+ {Node,Keys0}
+ end;
+ error ->
+ {Node,Keys0}
+ end.
+
+%% Builds the key used to check if a value can be
+%% replaced by an alias. It considers literals,
+%% aliases, variables, tuples and cons recursively.
+nodes_to_key(Kind, Nodes) ->
+ nodes_to_key(Nodes, [], Kind).
+
+nodes_to_key([#c_alias{var=Var}|T], Acc, Kind) ->
+ nodes_to_key([Var|T], Acc, Kind);
+nodes_to_key([#c_var{name=Name}|T], Acc, Kind) ->
+ nodes_to_key(T, [[var,Name]|Acc], Kind);
+nodes_to_key([Node|T], Acc0, Kind) ->
+ case cerl:is_data(Node) of
+ false ->
+ error;
+ true ->
+ case nodes_to_key(cerl:data_es(Node), [], cerl:data_type(Node)) of
+ {ok,Key} ->
+ nodes_to_key(T, [Key|Acc0], Kind);
+ error ->
+ error
+ end
+ end;
+nodes_to_key([], Acc, Kind) ->
+ {ok,[Kind|Acc]}.
diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl
new file mode 100644
index 0000000000..62657933ee
--- /dev/null
+++ b/lib/compiler/src/sys_core_bsm.erl
@@ -0,0 +1,355 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Optimize bit syntax matching.
+
+
+-module(sys_core_bsm).
+-export([module/2,format_error/1]).
+
+-include("core_parse.hrl").
+-import(lists, [member/2,reverse/1,usort/1]).
+
+-spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}.
+
+module(#c_module{defs=Ds0}=Mod, Opts) ->
+ {Ds,Ws0} = function(Ds0, [], []),
+ case member(bin_opt_info, Opts) of
+ false ->
+ {ok,Mod#c_module{defs=Ds}};
+ true ->
+ Ws1 = [make_warning(Where, What) || {Where,What} <- Ws0],
+ Ws = usort(Ws1),
+ {ok,Mod#c_module{defs=Ds},Ws}
+ end.
+
+function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) ->
+ try cerl_trees:mapfold(fun bsm_an/2, Ws0, B0) of
+ {B,Ws} ->
+ function(Fs, [{Name,B}|FsAcc], Ws)
+ catch
+ throw:unsafe_bs_context_to_binary ->
+ %% Unsafe bs_context_to_binary (in the sense that the
+ %% contents of the binary will probably be wrong).
+ %% Disable binary optimizations for the entire function.
+ %% We don't generate an INFO message, because this happens
+ %% very infrequently and it would be hard to explain in
+ %% a comprehensible way in an INFO message.
+ function(Fs, [{Name,B0}|FsAcc], Ws0);
+ Class:Error:Stack ->
+ io:fwrite("Function: ~w/~w\n", [F,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end;
+function([], Fs, Ws) ->
+ {reverse(Fs),Ws}.
+
+-type error() :: atom().
+-spec format_error(error()) -> nonempty_string().
+
+format_error(bin_opt_alias) ->
+ "INFO: the '=' operator will prevent delayed sub binary optimization";
+format_error(bin_partition) ->
+ "INFO: matching non-variables after a previous clause matching a variable "
+ "will prevent delayed sub binary optimization";
+format_error(bin_var_used) ->
+ "INFO: using a matched out sub binary will prevent "
+ "delayed sub binary optimization";
+format_error(orig_bin_var_used_in_guard) ->
+ "INFO: using the original binary variable in a guard will prevent "
+ "delayed sub binary optimization";
+format_error(bin_var_used_in_guard) ->
+ "INFO: using a matched out sub binary in a guard will prevent "
+ "delayed sub binary optimization".
+
+
+%%%
+%%% Annotate bit syntax matching to faciliate optimization in further passes.
+%%%
+
+bsm_an(Core0, Ws0) ->
+ case bsm_an(Core0) of
+ {ok,Core} ->
+ {Core,Ws0};
+ {ok,Core,W} ->
+ {Core,[W|Ws0]}
+ end.
+
+bsm_an(#c_case{arg=#c_var{}=V}=Case) ->
+ bsm_an_1([V], Case);
+bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
+ bsm_an_1(Es, Case);
+bsm_an(Other) ->
+ {ok,Other}.
+
+bsm_an_1(Vs0, #c_case{clauses=Cs0}=Case) ->
+ case bsm_leftmost(Cs0) of
+ none ->
+ {ok,Case};
+ 1 ->
+ bsm_an_2(Vs0, Cs0, Case);
+ Pos ->
+ Vs = move_from_col(Pos, Vs0),
+ Cs = [C#c_clause{pats=move_from_col(Pos, Ps)} ||
+ #c_clause{pats=Ps}=C <- Cs0],
+ bsm_an_2(Vs, Cs, Case)
+ end.
+
+bsm_an_2(Vs, Cs, Case) ->
+ try
+ bsm_ensure_no_partition(Cs),
+ {ok,bsm_do_an(Vs, Cs, Case)}
+ catch
+ throw:{problem,Where,What} ->
+ {ok,Case,{Where,What}}
+ end.
+
+move_from_col(Pos, L) ->
+ {First,[Col|Rest]} = lists:split(Pos - 1, L),
+ [Col|First] ++ Rest.
+
+bsm_do_an([#c_var{name=Vname}=V0|Vs0], Cs0, Case) ->
+ bsm_inner_context_to_binary(Cs0),
+ Cs = bsm_do_an_var(Vname, Cs0),
+ V = bsm_annotate_for_reuse(V0),
+ Vs = core_lib:make_values([V|Vs0]),
+ Case#c_case{arg=Vs,clauses=Cs};
+bsm_do_an(_Vs, _Cs, Case) -> Case.
+
+bsm_inner_context_to_binary([#c_clause{body=B}|Cs]) ->
+ %% Consider:
+ %%
+ %% foo(<<Length, Data/binary>>) -> %Line 1
+ %% case {Data, Length} of %Line 2
+ %% {_, 0} -> Data; %Line 3
+ %% {<<...>>, 4} -> ... %Line 4
+ %% end.
+ %%
+ %% No sub binary will be created for Data in line 1. The match
+ %% context will be passed on to the `case` in line 2. In line 3,
+ %% this pass inserts a `bs_context_to_binary` instruction to
+ %% convert the match context representing Data to a binary before
+ %% returning it. The problem is that the binary created will be
+ %% the original binary (including the matched out Length field),
+ %% not the tail of the binary as it is supposed to be.
+ %%
+ %% Here follows a heuristic to disable the binary optimizations
+ %% for the entire function if this code kind of code is found.
+
+ case cerl_trees:free_variables(B) of
+ [] ->
+ %% Since there are no free variables in the body of
+ %% this clause, there can't be any troublesome
+ %% bs_context_to_binary instructions.
+ bsm_inner_context_to_binary(Cs);
+ [_|_]=Free ->
+ %% One of the free variables could refer to a match context
+ %% created by the outer binary match.
+ F = fun(#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]}, _) ->
+ case member(V, Free) of
+ true ->
+ %% This bs_context_to_binary instruction will
+ %% make a binary of the match context from an
+ %% outer binary match. It is very likely that
+ %% the contents of the binary will be wrong
+ %% (the original binary as opposed to only
+ %% the tail binary).
+ throw(unsafe_bs_context_to_binary);
+ false ->
+ %% Safe. This bs_context_to_binary instruction
+ %% will make a binary from a match context
+ %% defined in the body of the clause.
+ ok
+ end;
+ (_, _) ->
+ ok
+ end,
+ cerl_trees:fold(F, ok, B)
+ end;
+bsm_inner_context_to_binary([]) -> ok.
+
+bsm_do_an_var(V, [#c_clause{pats=[P|_],guard=G,body=B0}=C0|Cs]) ->
+ case P of
+ #c_var{name=VarName} ->
+ case core_lib:is_var_used(V, G) of
+ true -> bsm_problem(C0, orig_bin_var_used_in_guard);
+ false -> ok
+ end,
+ case core_lib:is_var_used(VarName, G) of
+ true -> bsm_problem(C0, bin_var_used_in_guard);
+ false -> ok
+ end,
+ B1 = bsm_maybe_ctx_to_binary(VarName, B0),
+ B = bsm_maybe_ctx_to_binary(V, B1),
+ C = C0#c_clause{body=B},
+ [C|bsm_do_an_var(V, Cs)];
+ #c_alias{} ->
+ case bsm_could_match_binary(P) of
+ false ->
+ [C0|bsm_do_an_var(V, Cs)];
+ true ->
+ bsm_problem(C0, bin_opt_alias)
+ end;
+ _ ->
+ case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
+ false ->
+ [C0|bsm_do_an_var(V, Cs)];
+ true ->
+ bsm_problem(C0, bin_var_used)
+ end
+ end;
+bsm_do_an_var(_, []) -> [].
+
+bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
+ Var#c_var{anno=[reuse_for_context|Anno]}.
+
+bsm_is_var_used(V, G, B) ->
+ core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B).
+
+bsm_maybe_ctx_to_binary(V, B) ->
+ case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of
+ false ->
+ B;
+ true ->
+ #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]},
+ body=B}
+ end.
+
+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.
+
+%% bsm_leftmost(Cs) -> none | ArgumentNumber
+%% Find the leftmost argument that matches a nonempty binary.
+%% Return either 'none' or the argument number (1-N).
+
+bsm_leftmost(Cs) ->
+ bsm_leftmost_1(Cs, none).
+
+bsm_leftmost_1([_|_], 1) ->
+ 1;
+bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
+ bsm_leftmost_2(Ps, Cs, 1, Pos);
+bsm_leftmost_1([], Pos) -> Pos.
+
+bsm_leftmost_2(_, Cs, Pos, Pos) ->
+ bsm_leftmost_1(Cs, Pos);
+bsm_leftmost_2([#c_binary{segments=[_|_]}|_], Cs, N, _) ->
+ bsm_leftmost_1(Cs, N);
+bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
+ bsm_leftmost_2(Ps, Cs, N+1, Pos);
+bsm_leftmost_2([], Cs, _, Pos) ->
+ bsm_leftmost_1(Cs, Pos).
+
+%% bsm_ensure_no_partition(Cs) -> ok (exception if problem)
+%% There must only be a single bs_start_match2 instruction if we
+%% are to reuse the binary variable for the match context.
+%%
+%% To make sure that there is only a single bs_start_match2
+%% instruction, we will check for partitions such as:
+%%
+%% foo(<<...>>) -> ...
+%% foo(<Variable>) when ... -> ...
+%% foo(<Non-variable pattern>) ->
+%%
+%% If there is such partition, we reject the optimization.
+
+bsm_ensure_no_partition(Cs) ->
+ bsm_ensure_no_partition_1(Cs, before).
+
+%% Loop through each clause.
+bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], State0) ->
+ State = bsm_ensure_no_partition_2(Ps, G, State0),
+ case State of
+ 'after' ->
+ bsm_ensure_no_partition_after(Cs);
+ _ ->
+ ok
+ end,
+ bsm_ensure_no_partition_1(Cs, State);
+bsm_ensure_no_partition_1([], _) -> ok.
+
+bsm_ensure_no_partition_2([#c_binary{}|_], _, _State) ->
+ within;
+bsm_ensure_no_partition_2([#c_alias{}=Alias|_], N, State) ->
+ %% Retrieve the real pattern that the alias refers to and check that.
+ P = bsm_real_pattern(Alias),
+ bsm_ensure_no_partition_2([P], N, State);
+bsm_ensure_no_partition_2([_|_], _, before=State) ->
+ %% No binary matching yet - therefore no partition.
+ State;
+bsm_ensure_no_partition_2([P|_], _, State) ->
+ case bsm_could_match_binary(P) of
+ false ->
+ State;
+ true ->
+ %% The pattern P *may* match a binary, so we must update the state.
+ %% (P must be a variable.)
+ 'after'
+ end.
+
+bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs]) ->
+ case Ps of
+ [#c_var{}|_] ->
+ bsm_ensure_no_partition_after(Cs);
+ _ ->
+ bsm_problem(C, bin_partition)
+ end;
+bsm_ensure_no_partition_after([]) -> ok.
+
+bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
+bsm_could_match_binary(#c_cons{}) -> false;
+bsm_could_match_binary(#c_tuple{}) -> false;
+bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit);
+bsm_could_match_binary(_) -> true.
+
+bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P);
+bsm_real_pattern(P) -> P.
+
+bsm_problem(Where, What) ->
+ throw({problem,Where,What}).
+
+make_warning(Core, Term) ->
+ case should_suppress_warning(Core) of
+ true ->
+ ok;
+ false ->
+ Anno = cerl:get_ann(Core),
+ Line = get_line(Anno),
+ File = get_file(Anno),
+ {File,[{Line,?MODULE,Term}]}
+ end.
+
+should_suppress_warning(Core) ->
+ Ann = cerl:get_ann(Core),
+ member(compiler_generated, Ann).
+
+get_line([Line|_]) when is_integer(Line) -> Line;
+get_line([_|T]) -> get_line(T);
+get_line([]) -> none.
+
+get_file([{file,File}|_]) -> File;
+get_file([_|T]) -> get_file(T);
+get_file([]) -> "no_file". % should not happen
diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
index bd3eeae238..9ab83c210f 100644
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ b/lib/compiler/src/sys_core_dsetel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -81,8 +81,7 @@ visit_module_1([{Name,F0}|Fs], Env, Acc) ->
{F,_} ->
visit_module_1(Fs, Env, [{Name,F}|Acc])
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
#c_var{name={Func,Arity}} = Name,
io:fwrite("Function: ~w/~w\n", [Func,Arity]),
erlang:raise(Class, Error, Stack)
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 4922953407..3a65b40fa5 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-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -71,7 +71,7 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
- reverse/1,reverse/2,member/2,nth/2,flatten/1,
+ reverse/1,reverse/2,member/2,flatten/1,
unzip/1,keyfind/3]).
-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]).
@@ -83,10 +83,11 @@
-ifdef(DEBUG).
-define(ASSERT(E),
case E of
- true -> ok;
+ true ->
+ ok;
false ->
io:format("~p, line ~p: assertion failed\n", [?MODULE,?LINE]),
- exit(assertion_failed)
+ error(assertion_failed)
end).
-else.
-define(ASSERT(E), ignore).
@@ -106,29 +107,42 @@
{'ok', cerl:c_module(), [_]}.
module(#c_module{defs=Ds0}=Mod, Opts) ->
- put(bin_opt_info, member(bin_opt_info, Opts)),
put(no_inline_list_funcs, not member(inline_list_funcs, Opts)),
- case get(new_var_num) of
- undefined -> put(new_var_num, 0);
- _ -> ok
- end,
init_warnings(),
Ds1 = [function_1(D) || D <- Ds0],
+ erase(new_var_num),
erase(no_inline_list_funcs),
- erase(bin_opt_info),
{ok,Mod#c_module{defs=Ds1},get_warnings()}.
function_1({#c_var{name={F,Arity}}=Name,B0}) ->
try
- B = expr(B0, value, sub_new()), %This must be a fun!
+ %% Find a suitable starting value for the variable
+ %% counter. Note that this pass assumes that new_var_name/1
+ %% returns a variable name distinct from any variable used in
+ %% the entire body of the function. We use integers as
+ %% variable names to avoid filling up the atom table when
+ %% compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(B0),
+ put(new_var_num, Count),
+ B = find_fixpoint(fun(Core) ->
+ %% This must be a fun!
+ expr(Core, value, sub_new())
+ end, B0, 20),
{Name,B}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [F,Arity]),
erlang:raise(Class, Error, Stack)
end.
+find_fixpoint(_OptFun, Core, 0) ->
+ Core;
+find_fixpoint(OptFun, Core0, Max) ->
+ case OptFun(Core0) of
+ Core0 -> Core0;
+ Core -> find_fixpoint(OptFun, Core, Max-1)
+ end.
+
%% body(Expr, Sub) -> Expr.
%% body(Expr, Context, Sub) -> Expr.
%% No special handling of anything except values.
@@ -136,14 +150,9 @@ function_1({#c_var{name={F,Arity}}=Name,B0}) ->
body(Body, Sub) ->
body(Body, value, Sub).
-body(#c_values{anno=A,es=Es0}, Ctxt, Sub) ->
- Es1 = expr_list(Es0, Ctxt, Sub),
- case Ctxt of
- value ->
- #c_values{anno=A,es=Es1};
- effect ->
- make_effect_seq(Es1, Sub)
- end;
+body(#c_values{anno=A,es=Es0}, value, Sub) ->
+ Es1 = expr_list(Es0, value, Sub),
+ #c_values{anno=A,es=Es1};
body(E, Ctxt, Sub) ->
?ASSERT(verify_scope(E, Sub)),
expr(E, Ctxt, Sub).
@@ -160,13 +169,23 @@ guard(Expr, Sub) ->
%%
opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) ->
Body = opt_guard_try(Body0),
- case {Arg,Body} of
- {#c_call{module=#c_literal{val=Mod},
- name=#c_literal{val=Name},
- args=Args},#c_literal{val=false}} ->
+ WillFail = case Body of
+ #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=error},
+ args=[_]} ->
+ true;
+ #c_literal{val=false} ->
+ true;
+ _ ->
+ false
+ end,
+ case Arg of
+ #c_call{module=#c_literal{val=Mod},
+ name=#c_literal{val=Name},
+ args=Args} when WillFail ->
%% We have sequence consisting of a call (evaluated
%% for a possible exception and/or side effect only),
- %% followed by 'false'.
+ %% followed by 'false' or a call to error/1.
%% 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
@@ -181,13 +200,15 @@ opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) ->
%% be safely removed.
Body
end;
- {_,_} ->
+ _ ->
Seq#c_seq{body=Body}
end;
opt_guard_try(#c_case{clauses=Cs}=Term) ->
Term#c_case{clauses=opt_guard_try_list(Cs)};
opt_guard_try(#c_clause{body=B0}=Term) ->
Term#c_clause{body=opt_guard_try(B0)};
+opt_guard_try(#c_let{vars=[],arg=#c_values{es=[]},body=B}) ->
+ B;
opt_guard_try(#c_let{arg=Arg,body=B0}=Term) ->
case opt_guard_try(B0) of
#c_literal{}=B ->
@@ -239,7 +260,7 @@ expr(#c_cons{anno=Anno,hd=H0,tl=T0}=Cons, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Cons, useless_building),
- expr(make_effect_seq([H1,T1], Sub), Ctxt, Sub);
+ make_effect_seq([H1,T1], Sub);
value ->
ann_c_cons(Anno, H1, T1)
end;
@@ -248,7 +269,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Tuple, useless_building),
- expr(make_effect_seq(Es, Sub), Ctxt, Sub);
+ make_effect_seq(Es, Sub);
value ->
ann_c_tuple(Anno, Es)
end;
@@ -257,7 +278,7 @@ expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) ->
case Ctxt of
effect ->
add_warning(Map, useless_building),
- expr(make_effect_seq(Es, Sub), Ctxt, Sub);
+ make_effect_seq(Es, Sub);
value ->
V = expr(V0, Ctxt, Sub),
ann_c_map(Anno,V,Es)
@@ -294,9 +315,15 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) ->
false ->
%% Arg cannot be "values" here - only a single value
%% make sense here.
- case is_safe_simple(Arg, Sub) of
- true -> B1;
- false -> Seq0#c_seq{arg=Arg,body=B1}
+ case {Ctxt,is_safe_simple(Arg, Sub)} of
+ {effect,true} -> B1;
+ {effect,false} ->
+ case is_safe_simple(B1, Sub) of
+ true -> Arg;
+ false -> Seq0#c_seq{arg=Arg,body=B1}
+ end;
+ {value,true} -> B1;
+ {value,false} -> Seq0#c_seq{arg=Arg,body=B1}
end
end;
expr(#c_let{}=Let0, Ctxt, Sub) ->
@@ -310,7 +337,7 @@ expr(#c_let{}=Let0, Ctxt, Sub) ->
Expr ->
%% The let body was successfully moved into the let argument.
%% Now recursively re-process the new expression.
- expr(Expr, Ctxt, sub_new_preserve_types(Sub))
+ Expr
end;
expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
%% This is named fun in an 'effect' context. Warn and ignore.
@@ -318,7 +345,12 @@ expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
void();
expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
Fs1 = map(fun ({Name,Fb}) ->
- {Name,expr(Fb, {letrec,Ctxt}, Sub)}
+ case Ctxt =:= effect andalso is_fun_effect_safe(Name, B0) of
+ true ->
+ {Name,expr(Fb, {letrec, effect}, Sub)};
+ false ->
+ {Name,expr(Fb, {letrec, value}, Sub)}
+ end
end, Fs0),
B1 = body(B0, Ctxt, Sub),
Letrec#c_letrec{defs=Fs1,body=B1};
@@ -351,7 +383,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
%% (in addition to any warnings that may have been emitted
%% according to the rules above).
%%
- case opt_bool_case(Case0) of
+ case opt_bool_case(Case0, Sub) of
#c_case{arg=Arg0,clauses=Cs0}=Case1 ->
Arg1 = body(Arg0, value, Sub),
LitExpr = cerl:is_literal(Arg1),
@@ -360,12 +392,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
Case = Case1#c_case{arg=Arg2,clauses=Cs2},
warn_no_clause_match(Case1, Case),
Expr = eval_case(Case, Sub),
- case move_case_into_arg(Case, Sub) of
- impossible ->
- bsm_an(Expr);
- Other ->
- expr(Other, Ctxt, sub_new_preserve_types(Sub))
- end;
+ move_case_into_arg(Expr, Sub);
Other ->
expr(Other, Ctxt, Sub)
end;
@@ -374,14 +401,15 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
T1 = expr(T0, value, Sub),
A1 = body(A0, Ctxt, Sub),
Recv#c_receive{clauses=Cs1,timeout=T1,action=A1};
-expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
+expr(#c_apply{anno=Anno,op=Op0,args=As0}=Apply0, _, Sub) ->
Op1 = expr(Op0, value, Sub),
As1 = expr_list(As0, value, Sub),
- case Op1 of
- #c_var{} ->
- App#c_apply{op=Op1,args=As1};
- _ ->
- add_warning(App, invalid_call),
+ case cerl:is_data(Op1) andalso not is_literal_fun(Op1) of
+ false ->
+ Apply = Apply0#c_apply{op=Op1,args=As1},
+ fold_apply(Apply, Op1, As1);
+ true ->
+ add_warning(Apply0, invalid_call),
Err = #c_call{anno=Anno,
module=#c_literal{val=erlang},
name=#c_literal{val=error},
@@ -397,9 +425,20 @@ expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) ->
no -> call(Call, M1, N1, Sub);
{yes,Seq} -> expr(Seq, Ctxt, Sub)
end;
+expr(#c_primop{name=#c_literal{val=build_stacktrace}}, effect, _Sub) ->
+ void();
expr(#c_primop{args=As0}=Prim, _, Sub) ->
As1 = expr_list(As0, value, Sub),
Prim#c_primop{args=As1};
+expr(#c_catch{anno=Anno,body=B}, effect, Sub) ->
+ %% When the return value of the 'catch' is ignored, we can replace it
+ %% with a try/catch to avoid building a stack trace when an exception
+ %% occurs.
+ Var = #c_var{name='catch_value'},
+ Evs = [#c_var{name='Class'},#c_var{name='Reason'},#c_var{name='Stk'}],
+ Try = #c_try{anno=Anno,arg=B,vars=[Var],body=Var,
+ evars=Evs,handler=void()},
+ expr(Try, effect, Sub);
expr(#c_catch{body=B0}=Catch, _, Sub) ->
%% We can remove catch if the value is simple
B1 = body(B0, value, Sub),
@@ -442,6 +481,86 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0)
Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1}
end.
+
+%% If a fun or its application is used as an argument, then it's unsafe to
+%% handle it in effect context as the side-effects may rely on its return
+%% value. The following is a minimal example of where it can go wrong:
+%%
+%% do letrec 'f'/0 = fun () -> ... whatever ...
+%% in call 'side':'effect'(apply 'f'/0())
+%% 'ok'
+%%
+%% This function returns 'true' if Body definitely does not rely on a
+%% value produced by FVar, or 'false' if Body depends on or might depend on
+%% a value produced by FVar.
+
+is_fun_effect_safe(#c_var{}=FVar, Body) ->
+ ifes_1(FVar, Body, true).
+
+ifes_1(FVar, #c_alias{pat=Pat}, _Safe) ->
+ ifes_1(FVar, Pat, false);
+ifes_1(FVar, #c_apply{op=Op,args=Args}, Safe) ->
+ %% FVar(...) is safe as long its return value is ignored, but it's never
+ %% okay to pass FVar as an argument.
+ ifes_list(FVar, Args, false) andalso ifes_1(FVar, Op, Safe);
+ifes_1(FVar, #c_binary{segments=Segments}, _Safe) ->
+ ifes_list(FVar, Segments, false);
+ifes_1(FVar, #c_bitstr{val=Val,size=Size,unit=Unit}, _Safe) ->
+ ifes_list(FVar, [Val, Size, Unit], false);
+ifes_1(FVar, #c_call{args=Args}, _Safe) ->
+ ifes_list(FVar, Args, false);
+ifes_1(FVar, #c_case{arg=Arg,clauses=Clauses}, Safe) ->
+ ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Clauses, Safe);
+ifes_1(FVar, #c_catch{body=Body}, _Safe) ->
+ ifes_1(FVar, Body, false);
+ifes_1(FVar, #c_clause{pats=Pats,guard=Guard,body=Body}, Safe) ->
+ ifes_list(FVar, Pats, false) andalso
+ ifes_1(FVar, Guard, false) andalso
+ ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_cons{hd=Hd,tl=Tl}, _Safe) ->
+ ifes_1(FVar, Hd, false) andalso ifes_1(FVar, Tl, false);
+ifes_1(FVar, #c_fun{body=Body}, _Safe) ->
+ ifes_1(FVar, Body, false);
+ifes_1(FVar, #c_let{arg=Arg,body=Body}, Safe) ->
+ ifes_1(FVar, Arg, false) andalso ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_letrec{defs=Defs,body=Body}, Safe) ->
+ Funs = [Fun || {_,Fun} <- Defs],
+ ifes_list(FVar, Funs, false) andalso ifes_1(FVar, Body, Safe);
+ifes_1(_FVar, #c_literal{}, _Safe) ->
+ true;
+ifes_1(FVar, #c_map{arg=Arg,es=Elements}, _Safe) ->
+ ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Elements, false);
+ifes_1(FVar, #c_map_pair{key=Key,val=Val}, _Safe) ->
+ ifes_1(FVar, Key, false) andalso ifes_1(FVar, Val, false);
+ifes_1(FVar, #c_primop{args=Args}, _Safe) ->
+ ifes_list(FVar, Args, false);
+ifes_1(FVar, #c_receive{timeout=Timeout,action=Action,clauses=Clauses}, Safe) ->
+ ifes_1(FVar, Timeout, false) andalso
+ ifes_1(FVar, Action, Safe) andalso
+ ifes_list(FVar, Clauses, Safe);
+ifes_1(FVar, #c_seq{arg=Arg,body=Body}, Safe) ->
+ %% Arg of a #c_seq{} has no effect so it's okay to use FVar there even if
+ %% Safe=false.
+ ifes_1(FVar, Arg, true) andalso ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_try{arg=Arg,handler=Handler,body=Body}, Safe) ->
+ ifes_1(FVar, Arg, false) andalso
+ ifes_1(FVar, Handler, Safe) andalso
+ ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_tuple{es=Elements}, _Safe) ->
+ ifes_list(FVar, Elements, false);
+ifes_1(FVar, #c_values{es=Elements}, _Safe) ->
+ ifes_list(FVar, Elements, false);
+ifes_1(#c_var{name=Name}, #c_var{name=Name}, Safe) ->
+ %% It's safe to return FVar if it's unused.
+ Safe;
+ifes_1(_FVar, #c_var{}, _Safe) ->
+ true.
+
+ifes_list(FVar, [E|Es], Safe) ->
+ ifes_1(FVar, E, Safe) andalso ifes_list(FVar, Es, Safe);
+ifes_list(_FVar, [], _Safe) ->
+ true.
+
expr_list(Es, Ctxt, Sub) ->
[expr(E, Ctxt, Sub) || E <- Es].
@@ -461,6 +580,9 @@ bitstr_list(Es, Sub) ->
bitstr(#c_bitstr{val=Val,size=Size}=BinSeg, Sub) ->
BinSeg#c_bitstr{val=expr(Val, Sub),size=expr(Size, value, Sub)}.
+is_literal_fun(#c_literal{val=F}) -> is_function(F);
+is_literal_fun(_) -> false.
+
%% is_safe_simple(Expr, Sub) -> true | false.
%% A safe simple cannot fail with badarg and is safe to use
%% in a guard.
@@ -725,6 +847,25 @@ make_effect_seq([H|T], Sub) ->
end;
make_effect_seq([], _) -> void().
+%% fold_apply(Apply, LiteraFun, Args) -> Apply.
+%% Replace an apply of a literal external fun with a call.
+
+fold_apply(Apply, #c_literal{val=Fun}, Args) when is_function(Fun) ->
+ {module,Mod} = erlang:fun_info(Fun, module),
+ {name,Name} = erlang:fun_info(Fun, name),
+ {arity,Arity} = erlang:fun_info(Fun, arity),
+ if
+ Arity =:= length(Args) ->
+ #c_call{anno=Apply#c_apply.anno,
+ module=#c_literal{val=Mod},
+ name=#c_literal{val=Name},
+ args=Args};
+ true ->
+ Apply
+ end;
+fold_apply(Apply, _, _) -> Apply.
+
+
%% Handling remote calls. The module/name fields have been processed.
call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) ->
@@ -762,6 +903,8 @@ fold_call(Call, #c_literal{val=M}, #c_literal{val=F}, Args, Sub) ->
fold_call_1(Call, M, F, Args, Sub);
fold_call(Call, _M, _N, _Args, _Sub) -> Call.
+fold_call_1(Call, erlang, apply, [Fun,Args], _) ->
+ simplify_fun_apply(Call, Fun, Args);
fold_call_1(Call, erlang, apply, [Mod,Func,Args], _) ->
simplify_apply(Call, Mod, Func, Args);
fold_call_1(Call, Mod, Name, Args, Sub) ->
@@ -1070,24 +1213,38 @@ eval_failure(Call, Reason) ->
%% Simplify an apply/3 to a call if the number of arguments
%% are known at compile time.
-simplify_apply(Call, Mod, Func, Args) ->
+simplify_apply(Call, Mod, Func, Args0) ->
case is_atom_or_var(Mod) andalso is_atom_or_var(Func) of
- true -> simplify_apply_1(Args, Call, Mod, Func, []);
- false -> Call
+ true ->
+ case get_fixed_args(Args0, []) of
+ error ->
+ Call;
+ {ok,Args} ->
+ Call#c_call{module=Mod,name=Func,args=Args}
+ end;
+ false ->
+ Call
end.
-
-simplify_apply_1(#c_literal{val=MoreArgs0}, Call, Mod, Func, Args)
- when length(MoreArgs0) >= 0 ->
- MoreArgs = [#c_literal{val=Arg} || Arg <- MoreArgs0],
- Call#c_call{module=Mod,name=Func,args=reverse(Args, MoreArgs)};
-simplify_apply_1(#c_cons{hd=Arg,tl=T}, Call, Mod, Func, Args) ->
- simplify_apply_1(T, Call, Mod, Func, [Arg|Args]);
-simplify_apply_1(_, Call, _, _, _) -> Call.
-
is_atom_or_var(#c_literal{val=Atom}) when is_atom(Atom) -> true;
is_atom_or_var(#c_var{}) -> true;
is_atom_or_var(_) -> false.
+simplify_fun_apply(#c_call{anno=Anno}=Call, Fun, Args0) ->
+ case get_fixed_args(Args0, []) of
+ error ->
+ Call;
+ {ok,Args} ->
+ #c_apply{anno=Anno,op=Fun,args=Args}
+ end.
+
+get_fixed_args(#c_literal{val=MoreArgs0}, Args)
+ when length(MoreArgs0) >= 0 ->
+ MoreArgs = [#c_literal{val=Arg} || Arg <- MoreArgs0],
+ {ok,reverse(Args, MoreArgs)};
+get_fixed_args(#c_cons{hd=Arg,tl=T}, Args) ->
+ get_fixed_args(T, [Arg|Args]);
+get_fixed_args(_, _) -> error.
+
%% clause(Clause, Cepxr, Context, Sub) -> Clause.
clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) ->
@@ -1196,13 +1353,18 @@ let_subst_list([], [], _) -> {[],[],[]}.
%%pattern(Pat, Sub) -> pattern(Pat, Sub, Sub).
pattern(#c_var{}=Pat, Isub, Osub) ->
- case sub_is_val(Pat, Isub) of
+ case sub_is_in_scope(Pat, Isub) of
true ->
+ %% This variable either has a substitution or is used in
+ %% the variable list of an enclosing `let`. In either
+ %% case, it must be renamed to an unused name to avoid
+ %% name capture problems.
V1 = make_var_name(),
Pat1 = #c_var{name=V1},
{Pat1,sub_set_var(Pat, Pat1, sub_add_scope([V1], Osub))};
false ->
- {Pat,sub_del_var(Pat, Osub)}
+ %% This variable has never been used. Add it to the scope.
+ {Pat,sub_add_scope([Pat#c_var.name], Osub)}
end;
pattern(#c_literal{}=Pat, _, Osub) -> {Pat,Osub};
pattern(#c_cons{anno=Anno,hd=H0,tl=T0}, Isub, Osub0) ->
@@ -1381,8 +1543,8 @@ is_subst(_) -> false.
%% sub_set_name(Name, Value, #sub{}) -> #sub{}.
%% sub_del_var(Var, #sub{}) -> #sub{}.
%% sub_subst_var(Var, Value, #sub{}) -> [{Name,Value}].
-%% sub_is_val(Var, #sub{}) -> boolean().
-%% sub_add_scope(#sub{}) -> #sub{}
+%% sub_is_in_scope(Var, #sub{}) -> boolean().
+%% sub_add_scope([Var], #sub{}) -> #sub{}
%% sub_subst_scope(#sub{}) -> #sub{}
%%
%% We use the variable name as key so as not have problems with
@@ -1403,9 +1565,6 @@ sub_new() -> #sub{v=orddict:new(),s=cerl_sets:new(),t=#{}}.
sub_new(#sub{}=Sub) ->
Sub#sub{v=orddict:new(),t=#{}}.
-sub_new_preserve_types(#sub{}=Sub) ->
- Sub#sub{v=orddict:new()}.
-
sub_get_var(#c_var{name=V}=Var, #sub{v=S}) ->
case orddict:find(V, S) of
{ok,Val} -> Val;
@@ -1420,18 +1579,6 @@ sub_set_name(V, Val, #sub{v=S,s=Scope,t=Tdb0}=Sub) ->
Tdb = copy_type(V, Val, Tdb1),
Sub#sub{v=orddict:store(V, Val, S),s=cerl_sets:add_element(V, Scope),t=Tdb}.
-sub_del_var(#c_var{name=V}, #sub{v=S,s=Scope,t=Tdb}=Sub) ->
- %% Profiling shows that for programs with many record operations,
- %% sub_del_var/2 is a bottleneck. Since the scope contains all
- %% variables that are live, we know that V cannot be present in S
- %% if it is not in the scope.
- case cerl_sets:is_element(V, Scope) of
- false ->
- Sub#sub{s=cerl_sets:add_element(V, Scope)};
- true ->
- Sub#sub{v=orddict:erase(V, S),t=kill_types(V, Tdb)}
- end.
-
sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) ->
%% Fold chained substitutions.
[{V,Val}] ++ [ {K,Val} || {K,#c_var{name=V1}} <- S0, V1 =:= V].
@@ -1443,19 +1590,22 @@ sub_add_scope(Vs, #sub{s=Scope0}=Sub) ->
Sub#sub{s=Scope}.
sub_subst_scope(#sub{v=S0,s=Scope}=Sub) ->
- S = [{-1,#c_var{name=Sv}} || Sv <- cerl_sets:to_list(Scope)]++S0,
- Sub#sub{v=S}.
-
-sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) ->
- %% When the bottleneck in sub_del_var/2 was eliminated, this
- %% became the new bottleneck. Since the scope contains all
- %% live variables, a variable V can only be the target for
- %% a substitution if it is in the scope.
- cerl_sets:is_element(V, Scope) andalso v_is_value(V, S).
-
-v_is_value(Var, [{_,#c_var{name=Var}}|_]) -> true;
-v_is_value(Var, [_|T]) -> v_is_value(Var, T);
-v_is_value(_, []) -> false.
+ Initial = case S0 of
+ [{NegInt,_}|_] when is_integer(NegInt), NegInt < 0 ->
+ NegInt - 1;
+ _ ->
+ -1
+ end,
+ S = sub_subst_scope_1(cerl_sets:to_list(Scope), Initial, S0),
+ Sub#sub{v=orddict:from_list(S)}.
+
+%% The keys in an orddict must be unique. Make them so!
+sub_subst_scope_1([H|T], Key, Acc) ->
+ sub_subst_scope_1(T, Key-1, [{Key,#c_var{name=H}}|Acc]);
+sub_subst_scope_1([], _, Acc) -> Acc.
+
+sub_is_in_scope(#c_var{name=V}, #sub{s=Scope}) ->
+ cerl_sets:is_element(V, Scope).
%% warn_no_clause_match(CaseOrig, CaseOpt) -> ok
%% Generate a warning if none of the user-specified clauses
@@ -1535,9 +1685,11 @@ will_match(E, [P]) ->
will_match_1({false,_}) -> maybe;
will_match_1({true,_}) -> yes.
-%% opt_bool_case(CoreExpr) - CoreExpr'.
-%% Do various optimizations to case statement that has a
-%% boolean case expression.
+%% opt_bool_case(CoreExpr, Sub) - CoreExpr'.
+%%
+%% In bodies, do various optimizations to case statements that have
+%% boolean case expressions. We don't do the optimizations in guards,
+%% because they would thwart the optimization in v3_kernel.
%%
%% We start with some simple optimizations and normalization
%% to facilitate later optimizations.
@@ -1546,7 +1698,7 @@ will_match_1({true,_}) -> yes.
%% (or fail), we can remove any clause that cannot
%% possibly match 'true' or 'false'. Also, any clause
%% following both 'true' and 'false' clause can
-%% be removed. If successful, we will end up this:
+%% be removed. If successful, we will end up like this:
%%
%% case BoolExpr of case BoolExpr of
%% true -> false ->
@@ -1557,8 +1709,11 @@ will_match_1({true,_}) -> yes.
%%
%% We give up if there are clauses with guards, or if there
%% is a variable clause that matches anything.
-%%
-opt_bool_case(#c_case{arg=Arg}=Case0) ->
+
+opt_bool_case(#c_case{}=Case, #sub{in_guard=true}) ->
+ %% v3_kernel does a better job without "help".
+ Case;
+opt_bool_case(#c_case{arg=Arg}=Case0, #sub{in_guard=false}) ->
case is_bool_expr(Arg) of
false ->
Case0;
@@ -1570,8 +1725,7 @@ opt_bool_case(#c_case{arg=Arg}=Case0) ->
impossible ->
Case0
end
- end;
-opt_bool_case(Core) -> Core.
+ end.
opt_bool_clauses(#c_case{clauses=Cs}=Case) ->
Case#c_case{clauses=opt_bool_clauses(Cs, false, false)}.
@@ -1587,16 +1741,14 @@ opt_bool_clauses(Cs, true, true) ->
[]
end;
opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}],
- guard=#c_literal{val=true},
- body=B}=C0|Cs], SeenT, SeenF) ->
+ guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) ->
case is_boolean(Lit) of
false ->
%% Not a boolean - this clause can't match.
- add_warning(C0, nomatch_clause_type),
+ add_warning(C, nomatch_clause_type),
opt_bool_clauses(Cs, SeenT, SeenF);
true ->
%% This clause will match.
- C = C0#c_clause{body=opt_bool_case(B)},
case {Lit,SeenT,SeenF} of
{false,_,false} ->
[C|opt_bool_clauses(Cs, SeenT, true)];
@@ -1872,10 +2024,10 @@ case_opt_arg_1(E0, Cs0, LitExpr) ->
true ->
E = case_opt_compiler_generated(E0),
Cs = case_opt_nomatch(E, Cs0, LitExpr),
- case cerl:data_type(E) of
- {atomic,_} ->
+ case cerl:is_literal(E) of
+ true ->
case_opt_lit(E, Cs);
- _ ->
+ false ->
case_opt_data(E, Cs)
end
end.
@@ -2023,10 +2175,10 @@ case_opt_lit_1(_, []) -> [].
%% the clauses where it is actually needed.
case_opt_data(E, Cs0) ->
- Es = cerl:data_es(E),
TypeSig = {cerl:data_type(E),cerl:data_arity(E)},
- try case_opt_data_1(Cs0, Es, TypeSig) of
+ try case_opt_data_1(Cs0, TypeSig) of
Cs ->
+ Es = cerl:data_es(E),
{ok,Es,Cs}
catch
throw:impossible ->
@@ -2034,44 +2186,47 @@ case_opt_data(E, Cs0) ->
{error,Cs0}
end.
-case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
+case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], TypeSig) ->
P = case_opt_compiler_generated(P0),
- BindTo = #c_var{name=dummy},
- {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []),
- [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)];
-case_opt_data_1([], _, _) -> [].
+ {Ps1,Bs} = case_opt_data_2(P, TypeSig, Bs0),
+ [{Ps1++Ps0,C,PsAcc,Bs}|case_opt_data_1(Cs, TypeSig)];
+case_opt_data_1([], _) -> [].
-case_data_pat_alias(P, BindTo0, TypeSig, Bs0) ->
- case cerl:type(P) of
- alias ->
- %% Recursively handle the pattern and bind to
- %% the alias variable.
- BindTo = cerl:alias_var(P),
- Apat0 = cerl:alias_pat(P),
- Ann = [compiler_generated],
- Apat = cerl:set_ann(Apat0, Ann),
- {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0),
- {Ps,[{BindTo0,BindTo}|Bs]};
- var ->
- %% Here we will need to actually build the data and bind
- %% it to the variable.
+case_opt_data_2(P, TypeSig, Bs0) ->
+ case case_analyze_pat(P) of
+ {[],Pat} when Pat =/= none ->
+ DataEs = cerl:data_es(P),
+ {DataEs,Bs0};
+ {[V|Vs],none} ->
{Type,Arity} = TypeSig,
Ann = [compiler_generated],
Vars = make_vars(Ann, Arity),
Data = cerl:ann_make_data(Ann, Type, Vars),
- Bs = [{BindTo0,P},{P,Data}|Bs0],
+ Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0],
{Vars,Bs};
- _ ->
- %% Since case_opt_nomatch/3 has removed all clauses that
- %% cannot match, we KNOW that this clause must match and
- %% that the pattern must be a data constructor.
- %% Here we must build the data and bind it to the variable.
+ {[V|Vs],Pat} when Pat =/= none ->
{Type,_} = TypeSig,
- DataEs = cerl:data_es(P),
+ DataEs = cerl:data_es(Pat),
Vars = pat_to_expr_list(DataEs),
Ann = [compiler_generated],
Data = cerl:ann_make_data(Ann, Type, Vars),
- {DataEs,[{BindTo0,Data}]}
+ Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0],
+ {DataEs,Bs}
+ end.
+
+case_analyze_pat(P) ->
+ case_analyze_pat_1(P, [], none).
+
+case_analyze_pat_1(P, Vs, Pat) ->
+ case cerl:type(P) of
+ alias ->
+ V = cerl:alias_var(P),
+ Apat = cerl:alias_pat(P),
+ case_analyze_pat_1(Apat, [V|Vs], Pat);
+ var ->
+ {[P|Vs],Pat};
+ _ ->
+ {Vs,P}
end.
%% pat_to_expr(Pattern) -> Expression.
@@ -2115,7 +2270,7 @@ make_var(A) ->
make_var_name() ->
N = get(new_var_num),
put(new_var_num, N+1),
- list_to_atom("fol"++integer_to_list(N)).
+ N.
letify(Bs, Body) ->
Ann = cerl:get_ann(Body),
@@ -2129,7 +2284,7 @@ letify(Bs, Body) ->
-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl().
opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) ->
- case opt_not_in_let(Vs0, Arg0, Body0) of
+ case opt_not_in_let_0(Vs0, Arg0, Body0) of
{[],#c_values{es=[]},Body} ->
Body;
{Vs,Arg,Body} ->
@@ -2137,13 +2292,7 @@ opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) ->
end;
opt_not_in_let(Let) -> Let.
-%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'}
-%% Try to optimize away a 'not' operator in a 'let'.
-
--spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) ->
- {[cerl:c_var()],cerl:cerl(),cerl:cerl()}.
-
-opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) ->
+opt_not_in_let_0([#c_var{name=V}]=Vs0, Arg0, Body0) ->
case cerl:type(Body0) of
call ->
%% let <V> = Expr in not V ==>
@@ -2174,9 +2323,7 @@ opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) ->
end;
_ ->
{Vs0,Arg0,Body0}
- end;
-opt_not_in_let(Vs, Arg, Body) ->
- {Vs,Arg,Body}.
+ end.
opt_not_in_let_1(V, Call, Body) ->
case Call of
@@ -2222,24 +2369,24 @@ inverse_rel_op('=<') -> '>';
inverse_rel_op(_) -> no.
-%% opt_bool_case_in_let(LetExpr, Sub) -> Core
+%% opt_bool_case_in_let(LetExpr) -> Core
opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
- opt_case_in_let_1(Vs, Arg, B, Let, Sub).
+ opt_bool_case_in_let_1(Vs, Arg, B, Let, Sub).
-opt_case_in_let_1([#c_var{name=V}], Arg,
+opt_bool_case_in_let_1([#c_var{name=V}], Arg,
#c_case{arg=#c_var{name=V}}=Case0, Let, Sub) ->
case is_simple_case_arg(Arg) of
true ->
- Case = opt_bool_case(Case0#c_case{arg=Arg}),
+ Case = opt_bool_case(Case0#c_case{arg=Arg}, Sub),
case core_lib:is_var_used(V, Case) of
- false -> expr(Case, sub_new(Sub));
+ false -> Case;
true -> Let
end;
false ->
Let
end;
-opt_case_in_let_1(_, _, _, Let, _) -> Let.
+opt_bool_case_in_let_1(_, _, _, Let, _) -> Let.
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
@@ -2372,9 +2519,7 @@ is_safe_bool_expr_list([], _, _) -> true.
%% as a let or a sequence, move the original let body into the complex
%% expression.
-simplify_let(#c_let{arg=Arg0}=Let0, Sub) ->
- Arg = opt_bool_case(Arg0),
- Let = Let0#c_let{arg=Arg},
+simplify_let(#c_let{arg=Arg}=Let, Sub) ->
move_let_into_expr(Let, Arg, Sub).
move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
@@ -2401,16 +2546,10 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner,
Outer#c_let{vars=OuterVs,arg=Arg,
body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}};
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
- #c_case{arg=Cexpr0,clauses=[Ca0,Cb0|Cs]}=Case, Sub0) ->
- %% Test if there are no more clauses than Ca0 and Cb0, or if
- %% Cb0 is guaranteed to match.
- TwoClauses = Cs =:= [] orelse
- case Cb0 of
- #c_clause{pats=[#c_var{}],guard=#c_literal{val=true}} -> true;
- _ -> false
- end,
- case {TwoClauses,is_failing_clause(Ca0),is_failing_clause(Cb0)} of
- {true,false,true} ->
+ #c_case{arg=Cexpr0,clauses=[Ca0|Cs0]}=Case, Sub0) ->
+ case not is_failing_clause(Ca0) andalso
+ are_all_failing_clauses(Cs0) of
+ true ->
%% let <Lvars> = case <Case-expr> of
%% <Cpats> -> <Clause-body>;
%% <OtherCpats> -> erlang:error(...)
@@ -2446,8 +2585,8 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
body=Lbody},
Ca = Ca0#c_clause{pats=CaPats,guard=G,body=B},
- Cb = clause(Cb0, Cexpr, value, Sub0),
- Case#c_case{arg=Cexpr,clauses=[Ca,Cb]}
+ Cs = [clause(C, Cexpr, value, Sub0) || C <- Cs0],
+ Case#c_case{arg=Cexpr,clauses=[Ca|Cs]}
catch
nomatch ->
%% This is not a defeat. The code will eventually
@@ -2455,7 +2594,7 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
%% optimizations done in this module.
impossible
end;
- {_,_,_} -> impossible
+ false -> impossible
end;
move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
#c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) ->
@@ -2478,9 +2617,78 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let,
body=Lbody}};
move_let_into_expr(_Let, _Expr, _Sub) -> impossible.
+are_all_failing_clauses(Cs) ->
+ all(fun is_failing_clause/1, Cs).
+
is_failing_clause(#c_clause{body=B}) ->
will_fail(B).
+%% opt_build_stacktrace(Let) -> Core.
+%% If the stacktrace is *only* used in a call to erlang:raise/3,
+%% there is no need to build a cooked stackframe using build_stacktrace/1.
+
+opt_build_stacktrace(#c_let{vars=[#c_var{name=Cooked}],
+ arg=#c_primop{name=#c_literal{val=build_stacktrace},
+ args=[RawStk]},
+ body=Body}=Let) ->
+ case Body of
+ #c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=raise},
+ args=[Class,Exp,#c_var{name=Cooked}]} ->
+ %% The stacktrace is only used in a call to erlang:raise/3.
+ %% There is no need to build the stacktrace. Replace the
+ %% call to erlang:raise/3 with the the raw_raise/3 instruction,
+ %% which will use a raw stacktrace.
+ #c_primop{name=#c_literal{val=raw_raise},
+ args=[Class,Exp,RawStk]};
+ #c_let{vars=[#c_var{name=V}],arg=Arg,body=B0} when V =/= Cooked ->
+ case core_lib:is_var_used(Cooked, Arg) of
+ false ->
+ %% The built stacktrace is not used in the argument,
+ %% so we can sink the building of the stacktrace into
+ %% the body of the let.
+ B = opt_build_stacktrace(Let#c_let{body=B0}),
+ Body#c_let{body=B};
+ true ->
+ Let
+ end;
+ #c_seq{arg=Arg,body=B0} ->
+ case core_lib:is_var_used(Cooked, Arg) of
+ false ->
+ %% The built stacktrace is not used in the argument,
+ %% so we can sink the building of the stacktrace into
+ %% the body of the sequence.
+ B = opt_build_stacktrace(Let#c_let{body=B0}),
+ Body#c_seq{body=B};
+ true ->
+ Let
+ end;
+ #c_case{arg=Arg,clauses=Cs0} ->
+ case core_lib:is_var_used(Cooked, Arg) orelse
+ is_used_in_any_guard(Cooked, Cs0) of
+ false ->
+ %% The built stacktrace is not used in the argument,
+ %% so we can sink the building of the stacktrace into
+ %% each arm of the case.
+ Cs = [begin
+ B = opt_build_stacktrace(Let#c_let{body=B0}),
+ C#c_clause{body=B}
+ end || #c_clause{body=B0}=C <- Cs0],
+ Body#c_case{clauses=Cs};
+ true ->
+ Let
+ end;
+ _ ->
+ Let
+ end;
+opt_build_stacktrace(Expr) ->
+ Expr.
+
+is_used_in_any_guard(V, Cs) ->
+ any(fun(#c_clause{guard=G}) ->
+ core_lib:is_var_used(V, G)
+ end, Cs).
+
%% opt_case_in_let(Let) -> Let'
%% Try to avoid building tuples that are immediately matched.
%% A common pattern is:
@@ -2595,9 +2803,13 @@ delay_build_expr_1(#c_receive{clauses=Cs0,
timeout=Timeout,
action=A0}=Rec, TypeSig) ->
Cs = delay_build_cs(Cs0, TypeSig),
- A = case Timeout of
- #c_literal{val=infinity} -> A0;
- _ -> delay_build_expr(A0, TypeSig)
+ A = case {Timeout,A0} of
+ {#c_literal{val=infinity},#c_literal{}} ->
+ {_Type,Arity} = TypeSig,
+ Es = lists:duplicate(Arity, A0),
+ core_lib:make_values(Es);
+ _ ->
+ delay_build_expr(A0, TypeSig)
end,
Rec#c_receive{clauses=Cs,action=A};
delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) ->
@@ -2630,60 +2842,96 @@ opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) ->
opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) ->
%% Optimise let and add new substitutions.
- {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
- BodySub = update_let_types(Vs1, Args, Sub1),
- B1 = body(B0, Ctxt, BodySub),
- Arg1 = core_lib:make_values(Args),
- {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1),
- opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1).
-
-opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
+ {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0),
+ BodySub = update_let_types(Vs, Args, Sub1),
+ Sub = Sub1#sub{v=[],s=cerl_sets:new()},
+ B = body(B0, Ctxt, BodySub),
+ Arg = core_lib:make_values(Args),
+ opt_simple_let_2(Let, Vs, Arg, B, B0, Sub).
+
+
+%% opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Core.
+%% Do final simplifications of the let.
+%%
+%% Note that the substitutions and scope in Sub have been cleared
+%% and should not be used.
+
+opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
case {Vs0,Arg0,Body} of
- {[#c_var{name=N1}],Arg1,#c_var{name=N2}} ->
- case N1 =:= N2 of
- true ->
- %% let <Var> = Arg in <Var> ==> Arg
- Arg1;
- false ->
- %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar
- Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody),
- expr(#c_seq{arg=Arg,body=Body}, Ctxt,
- sub_new_preserve_types(Sub))
- end;
+ {[#c_var{name=V}],Arg1,#c_var{name=V}} ->
+ %% let <Var> = Arg in <Var> ==> Arg
+ Arg1;
{[],#c_values{es=[]},_} ->
%% No variables left.
Body;
- {Vs,Arg1,#c_literal{}} ->
- Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- E = case Ctxt of
- effect ->
- %% Throw away the literal body.
- Arg;
- value ->
- %% Since the variable is not used in the body, we
- %% can rewrite the let to a sequence.
- %% let <Var> = Arg in Literal ==> seq Arg Literal
- #c_seq{arg=Arg,body=Body}
- end,
- expr(E, Ctxt, sub_new_preserve_types(Sub));
- {Vs,Arg1,Body} ->
- %% If none of the variables are used in the body, we can
- %% rewrite the let to a sequence:
- %% let <Var> = Arg in BodyWithoutVar ==>
- %% seq Arg BodyWithoutVar
- case is_any_var_used(Vs, Body) of
- false ->
- Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody),
- expr(#c_seq{arg=Arg,body=Body}, Ctxt,
- sub_new_preserve_types(Sub));
- true ->
- Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body},
- Let2 = opt_bool_case_in_let(Let1, Sub),
- opt_case_in_let_arg(Let2, Ctxt, Sub)
+ {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} ->
+ case core_lib:is_var_used(V, Body) of
+ false when Vars =:= [] ->
+ %% If the variable is not used in the body, we can
+ %% rewrite the let to a sequence:
+ %% let <Var> = Arg in BodyWithoutVar ==>
+ %% seq Arg BodyWithoutVar
+ Arg = maybe_suppress_warnings(Arg1, Var, PrevBody),
+ #c_seq{arg=Arg,body=Body};
+ false ->
+ %% There are multiple values returned by the argument
+ %% and the first value is not used (this is a 'case'
+ %% with exported variables, but the return value is
+ %% ignored). We can remove the first variable and the
+ %% the first value returned from the 'let' argument.
+ Arg2 = remove_first_value(Arg1, Sub),
+ Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body},
+ post_opt_let(Let1, Sub);
+ true ->
+ Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body},
+ post_opt_let(Let1, Sub)
end
end.
-%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg'
+%% post_opt_let(Let, Sub)
+%% Final optimizations of the let.
+%%
+%% Note that the substitutions and scope in Sub have been cleared
+%% and should not be used.
+
+post_opt_let(Let0, Sub) ->
+ Let1 = opt_bool_case_in_let(Let0, Sub),
+ opt_build_stacktrace(Let1).
+
+
+%% remove_first_value(Core0, Sub) -> Core.
+%% Core0 is an expression that returns at least two values.
+%% Remove the first value returned from Core0.
+
+remove_first_value(#c_values{es=[V|Vs]}, Sub) ->
+ Values = core_lib:make_values(Vs),
+ case is_safe_simple(V, Sub) of
+ false ->
+ #c_seq{arg=V,body=Values};
+ true ->
+ Values
+ end;
+remove_first_value(#c_case{clauses=Cs0}=Core, Sub) ->
+ Cs = remove_first_value_cs(Cs0, Sub),
+ Core#c_case{clauses=Cs};
+remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) ->
+ Cs = remove_first_value_cs(Cs0, Sub),
+ Act = remove_first_value(Act0, Sub),
+ Core#c_receive{clauses=Cs,action=Act};
+remove_first_value(#c_let{body=B}=Core, Sub) ->
+ Core#c_let{body=remove_first_value(B, Sub)};
+remove_first_value(#c_seq{body=B}=Core, Sub) ->
+ Core#c_seq{body=remove_first_value(B, Sub)};
+remove_first_value(#c_primop{}=Core, _Sub) ->
+ Core;
+remove_first_value(#c_call{}=Core, _Sub) ->
+ Core.
+
+remove_first_value_cs(Cs, Sub) ->
+ [C#c_clause{body=remove_first_value(B, Sub)} ||
+ #c_clause{body=B}=C <- Cs].
+
+%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg'
%% Try to suppress false warnings when a variable is not used.
%% For instance, we don't expect a warning for useless building in:
%%
@@ -2694,12 +2942,12 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) ->
%% referenced in the original unoptimized code. If they were, we will
%% consider the warning false and suppress it.
-maybe_suppress_warnings(Arg, Vs, PrevBody) ->
+maybe_suppress_warnings(Arg, #c_var{name=V}, PrevBody) ->
case should_suppress_warning(Arg) of
true ->
Arg; %Already suppressed.
false ->
- case is_any_var_used(Vs, PrevBody) of
+ case core_lib:is_var_used(V, PrevBody) of
true ->
suppress_warning([Arg]);
false ->
@@ -2788,7 +3036,7 @@ move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg,
Outer#c_case{arg=OuterArg,
clauses=[OuterCa,OuterCb]};
false ->
- impossible
+ Inner0
end;
move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
clauses=InnerClauses}=Inner, _Sub) ->
@@ -2804,57 +3052,8 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
%%
Outer#c_seq{arg=OuterArg,
body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
-move_case_into_arg(_, _) ->
- impossible.
-
-%% In guards only, rewrite a case in a let argument like
-%%
-%% let <Var> = case <> of
-%% <> when AnyGuard -> Literal1;
-%% <> when AnyGuard -> Literal2
-%% end
-%% in LetBody
-%%
-%% to
-%%
-%% case <> of
-%% <> when AnyGuard ->
-%% let <Var> = Literal1 in LetBody
-%% <> when 'true' ->
-%% let <Var> = Literal2 in LetBody
-%% end
-%%
-%% In the worst case, the size of the code could increase.
-%% In practice, though, substituting the literals into
-%% LetBody and doing constant folding will decrease the code
-%% size. (Doing this transformation outside of guards could
-%% lead to a substantational increase in code size.)
-%%
-opt_case_in_let_arg(#c_let{arg=#c_case{}=Case}=Let, Ctxt,
- #sub{in_guard=true}=Sub) ->
- opt_case_in_let_arg_1(Let, Case, Ctxt, Sub);
-opt_case_in_let_arg(Let, _, _) -> Let.
-
-opt_case_in_let_arg_1(Let0, #c_case{arg=#c_values{es=[]},
- clauses=Cs}=Case0, Ctxt, Sub) ->
- Let = mark_compiler_generated(Let0),
- case Cs of
- [#c_clause{body=#c_literal{}=BodyA}=Ca0,
- #c_clause{body=#c_literal{}=BodyB}=Cb0] ->
- Ca = Ca0#c_clause{body=Let#c_let{arg=BodyA}},
- Cb = Cb0#c_clause{body=Let#c_let{arg=BodyB}},
- Case = Case0#c_case{clauses=[Ca,Cb]},
- expr(Case, Ctxt, sub_new_preserve_types(Sub));
- _ -> Let
- end;
-opt_case_in_let_arg_1(Let, _, _, _) -> Let.
-
-is_any_var_used([#c_var{name=V}|Vs], Expr) ->
- case core_lib:is_var_used(V, Expr) of
- false -> is_any_var_used(Vs, Expr);
- true -> true
- end;
-is_any_var_used([], _) -> false.
+move_case_into_arg(Expr, _) ->
+ Expr.
%%%
%%% Retrieving information about types.
@@ -2956,7 +3155,9 @@ returns_integer(bit_size, [_]) -> true;
returns_integer('bsl', [_,_]) -> true;
returns_integer('bsr', [_,_]) -> true;
returns_integer(byte_size, [_]) -> true;
+returns_integer(ceil, [_]) -> true;
returns_integer('div', [_,_]) -> true;
+returns_integer(floor, [_]) -> true;
returns_integer(length, [_]) -> true;
returns_integer('rem', [_,_]) -> true;
returns_integer('round', [_]) -> true;
@@ -2974,15 +3175,8 @@ update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
Tdb = update_types_1(Expr, Pat, Tdb0),
Sub#sub{t=Tdb}.
-update_types_1(#c_var{name=V,anno=Anno}, Pat, Types) ->
- case member(reuse_for_context, Anno) of
- true ->
- %% If a variable has been marked for reuse of binary context,
- %% optimizations based on type information are unsafe.
- kill_types(V, Types);
- false ->
- update_types_2(V, Pat, Types)
- end;
+update_types_1(#c_var{name=V}, Pat, Types) ->
+ update_types_2(V, Pat, Types);
update_types_1(_, _, Types) -> Types.
update_types_2(V, [#c_tuple{}=P], Types) ->
@@ -3025,274 +3219,14 @@ copy_type(_, _, Tdb) -> Tdb.
void() -> #c_literal{val=ok}.
-%%%
-%%% Annotate bit syntax matching to faciliate optimization in further passes.
-%%%
-
-bsm_an(#c_case{arg=#c_var{}=V}=Case) ->
- bsm_an_1([V], Case);
-bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
- bsm_an_1(Es, Case);
-bsm_an(Other) -> Other.
-
-bsm_an_1(Vs, #c_case{clauses=Cs}=Case) ->
- case bsm_leftmost(Cs) of
- none -> Case;
- Pos -> bsm_an_2(Vs, Cs, Case, Pos)
- end.
-
-bsm_an_2(Vs, Cs, Case, Pos) ->
- case bsm_nonempty(Cs, Pos) of
- true -> bsm_an_3(Vs, Cs, Case, Pos);
- false -> Case
- end.
-
-bsm_an_3(Vs, Cs, Case, Pos) ->
- try
- bsm_ensure_no_partition(Cs, Pos),
- bsm_do_an(Vs, Pos, Cs, Case)
- catch
- throw:{problem,Where,What} ->
- add_bin_opt_info(Where, What),
- Case
- end.
-
-bsm_do_an(Vs0, Pos, Cs0, Case) ->
- case nth(Pos, Vs0) of
- #c_var{name=Vname}=V0 ->
- Cs = bsm_do_an_var(Vname, Pos, Cs0, []),
- V = bsm_annotate_for_reuse(V0),
- Bef = lists:sublist(Vs0, Pos-1),
- Aft = lists:nthtail(Pos, Vs0),
- case Bef ++ [V|Aft] of
- [_] ->
- Case#c_case{arg=V,clauses=Cs};
- Vs ->
- Case#c_case{arg=#c_values{es=Vs},clauses=Cs}
- end;
- _ ->
- Case
- end.
-
-bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
- case nth(S, Ps) of
- #c_var{name=VarName} ->
- case core_lib:is_var_used(V, G) of
- true -> bsm_problem(C0, orig_bin_var_used_in_guard);
- false -> ok
- end,
- case core_lib:is_var_used(VarName, G) of
- true -> bsm_problem(C0, bin_var_used_in_guard);
- false -> ok
- end,
- B1 = bsm_maybe_ctx_to_binary(VarName, B0),
- B = bsm_maybe_ctx_to_binary(V, B1),
- C = C0#c_clause{body=B},
- bsm_do_an_var(V, S, Cs, [C|Acc]);
- #c_alias{}=P ->
- case bsm_could_match_binary(P) of
- false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
- true ->
- bsm_problem(C0, bin_opt_alias)
- end;
- P ->
- case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
- false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
- true ->
- bsm_problem(C0, bin_var_used)
- end
- end;
-bsm_do_an_var(_, _, [], Acc) -> reverse(Acc).
-
-bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
- case member(reuse_for_context, Anno) of
- false -> Var#c_var{anno=[reuse_for_context|Anno]};
- true -> Var
- end.
-
-bsm_is_var_used(V, G, B) ->
- core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B).
-
-bsm_maybe_ctx_to_binary(V, B) ->
- case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of
- false ->
- B;
- true ->
- #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
- args=[#c_var{name=V}]},
- body=B}
- end.
-
-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.
-
-%% bsm_leftmost(Cs) -> none | ArgumentNumber
-%% Find the leftmost argument that does binary matching. Return
-%% the number of the argument (1-N).
-
-bsm_leftmost(Cs) ->
- bsm_leftmost_1(Cs, none).
-
-bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
- bsm_leftmost_2(Ps, Cs, 1, Pos);
-bsm_leftmost_1([], Pos) -> Pos.
-
-bsm_leftmost_2(_, Cs, Pos, Pos) ->
- bsm_leftmost_1(Cs, Pos);
-bsm_leftmost_2([#c_binary{}|_], Cs, N, _) ->
- bsm_leftmost_1(Cs, N);
-bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
- bsm_leftmost_2(Ps, Cs, N+1, Pos);
-bsm_leftmost_2([], Cs, _, Pos) ->
- bsm_leftmost_1(Cs, Pos).
-
-%% bsm_nonempty(Cs, Pos) -> true|false
-%% Check if at least one of the clauses matches a non-empty
-%% binary in the given argument position.
-%%
-bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_binary{segments=[_|_]} ->
- true;
- _ ->
- bsm_nonempty(Cs, Pos)
- end;
-bsm_nonempty([], _ ) -> false.
-
-%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem)
-%% We must make sure that matching is not partitioned between
-%% variables like this:
-%% foo(<<...>>) -> ...
-%% foo(<Variable>) when ... -> ...
-%% foo(<Any non-variable pattern>) ->
-%% If there is such partition, we are not allowed to reuse the binary variable
-%% for the match context.
-%%
-%% Also, arguments to the left of the argument that is matched
-%% against a binary, are only allowed to be simple variables, not
-%% used in guards. The reason is that we must know that the binary is
-%% only matched in one place (i.e. there must be only one bs_start_match2
-%% instruction emitted).
-
-bsm_ensure_no_partition(Cs, Pos) ->
- bsm_ensure_no_partition_1(Cs, Pos, before).
-
-%% Loop through each clause.
-bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) ->
- State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0),
- case State of
- 'after' ->
- bsm_ensure_no_partition_after(Cs, Pos);
- _ ->
- ok
- end,
- bsm_ensure_no_partition_1(Cs, Pos, State);
-bsm_ensure_no_partition_1([], _, _) -> ok.
-
-%% Loop through each pattern for this clause.
-bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) ->
- case State of
- before when Vstate =:= simple_vars -> within;
- before -> bsm_problem(Where, Vstate);
- within when Vstate =:= simple_vars -> within;
- within -> bsm_problem(Where, Vstate)
- end;
-bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) ->
- %% Retrieve the real pattern that the alias refers to and check that.
- P = bsm_real_pattern(Alias),
- bsm_ensure_no_partition_2([P], 1, N, Vstate, State);
-bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) ->
- %% No binary matching yet - therefore no partition.
- State;
-bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
- case bsm_could_match_binary(P) of
- false ->
- %% If clauses can be freely arranged (Vstate =:= simple_vars),
- %% a clause that cannot match a binary will not partition the clause.
- %% Example:
- %%
- %% a(Var, <<>>) -> ...
- %% a(Var, []) -> ...
- %% a(Var, <<B>>) -> ...
- %%
- %% But if the clauses can't be freely rearranged, as in
- %%
- %% b(Var, <<X>>) -> ...
- %% b(1, 2) -> ...
- %%
- %% we do have a problem.
- %%
- case Vstate of
- simple_vars -> State;
- _ -> bsm_problem(P, Vstate)
- end;
- true ->
- %% The pattern P *may* match a binary, so we must update the state.
- %% (P must be a variable.)
- case State of
- within -> 'after';
- 'after' -> 'after'
- end
- end;
-bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) ->
- case core_lib:is_var_used(V, G) of
- false ->
- bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S);
- true ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S)
- end;
-bsm_ensure_no_partition_2([_|Ps], N, G, _, S) ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S).
-
-bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_var{} ->
- bsm_ensure_no_partition_after(Cs, Pos);
- _ ->
- bsm_problem(C, bin_partition)
- end;
-bsm_ensure_no_partition_after([], _) -> ok.
-
-bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
-bsm_could_match_binary(#c_cons{}) -> false;
-bsm_could_match_binary(#c_tuple{}) -> false;
-bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit);
-bsm_could_match_binary(_) -> true.
-
-bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P);
-bsm_real_pattern(P) -> P.
-
-bsm_problem(Where, What) ->
- throw({problem,Where,What}).
%%%
%%% Handling of warnings.
%%%
-mark_compiler_generated(Term) ->
- cerl_trees:map(fun mark_compiler_generated_1/1, Term).
-
-mark_compiler_generated_1(#c_call{anno=Anno}=Term) ->
- Term#c_call{anno=[compiler_generated|Anno--[compiler_generated]]};
-mark_compiler_generated_1(Term) -> Term.
-
init_warnings() ->
put({?MODULE,warnings}, []).
-add_bin_opt_info(Core, Term) ->
- case get(bin_opt_info) of
- true -> add_warning(Core, Term);
- false -> ok
- end.
-
add_warning(Core, Term) ->
case should_suppress_warning(Core) of
true ->
@@ -3414,28 +3348,7 @@ format_error(result_ignored) ->
format_error(invalid_call) ->
"invalid function call";
format_error(useless_building) ->
- "a term is constructed, but never used";
-format_error(bin_opt_alias) ->
- "INFO: the '=' operator will prevent delayed sub binary optimization";
-format_error(bin_partition) ->
- "INFO: matching non-variables after a previous clause matching a variable "
- "will prevent delayed sub binary optimization";
-format_error(bin_left_var_used_in_guard) ->
- "INFO: a variable to the left of the binary pattern is used in a guard; "
- "will prevent delayed sub binary optimization";
-format_error(bin_argument_order) ->
- "INFO: matching anything else but a plain variable to the left of "
- "binary pattern will prevent delayed sub binary optimization; "
- "SUGGEST changing argument order";
-format_error(bin_var_used) ->
- "INFO: using a matched out sub binary will prevent "
- "delayed sub binary optimization";
-format_error(orig_bin_var_used_in_guard) ->
- "INFO: using the original binary variable in a guard will prevent "
- "delayed sub binary optimization";
-format_error(bin_var_used_in_guard) ->
- "INFO: using a matched out sub binary in a guard will prevent "
- "delayed sub binary optimization".
+ "a term is constructed, but never used".
-ifdef(DEBUG).
%% In order for simplify_let/2 to work correctly, the list of
@@ -3446,12 +3359,18 @@ format_error(bin_var_used_in_guard) ->
verify_scope(E, #sub{s=Scope}) ->
Free0 = cerl_trees:free_variables(E),
Free = [V || V <- Free0, not is_tuple(V)], %Ignore function names.
- case ordsets:is_subset(Free, cerl_sets:to_list(Scope)) of
- true -> true;
+ case is_subset_of_scope(Free, Scope) of
+ true ->
+ true;
false ->
io:format("~p\n", [E]),
io:format("~p\n", [Free]),
- io:format("~p\n", [cerl_sets:to_list(Scope)]),
+ io:format("~p\n", [ordsets:from_list(cerl_sets:to_list(Scope))]),
false
end.
+
+is_subset_of_scope([V|Vs], Scope) ->
+ cerl_sets:is_element(V, Scope) andalso is_subset_of_scope(Vs, Scope);
+is_subset_of_scope([], _) -> true.
+
-endif.
diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl
index 8c1f69d5de..5a6cc45e4a 100644
--- a/lib/compiler/src/sys_core_inline.erl
+++ b/lib/compiler/src/sys_core_inline.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -143,7 +143,7 @@ inline_inline(#ifun{body=B,weight=Iw}=If, Is) ->
case find_inl(F, A, Is) of
#ifun{vars=Vs,body=B2,weight=W} when W < Iw ->
#c_let{vars=Vs,
- arg=core_lib:make_values(As),
+ arg=kill_id_anns(core_lib:make_values(As)),
body=kill_id_anns(B2)};
_Other -> Call
end;
@@ -160,7 +160,7 @@ inline_func(#fstat{def={Name,F0}}=Fstat, Is) ->
case find_inl(F, A, Is) of
#ifun{vars=Vs,body=B} ->
{#c_let{vars=Vs,
- arg=core_lib:make_values(As),
+ arg=kill_id_anns(core_lib:make_values(As)),
body=kill_id_anns(B)},
true}; %Have modified
_Other -> {Call,Mod}
diff --git a/lib/compiler/src/sys_pre_attributes.erl b/lib/compiler/src/sys_pre_attributes.erl
index bc93c85989..67adae5acf 100644
--- a/lib/compiler/src/sys_pre_attributes.erl
+++ b/lib/compiler/src/sys_pre_attributes.erl
@@ -25,10 +25,10 @@
-define(OPTION_TAG, attributes).
--record(state, {forms,
- pre_ops = [],
- post_ops = [],
- options}).
+-record(state, {forms :: [form()],
+ pre_ops = [] :: [op()],
+ post_ops = [] :: [op()],
+ options :: [option()]}).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Inserts, deletes and replaces Erlang compiler attributes.
@@ -59,9 +59,23 @@
%% due to that the pre_transform pass did not find the attribute plus
%% all insert operations.
+-type attribute() :: atom().
+-type value() :: term().
+-type form() :: {function, integer(), atom(), arity(), _}
+ | {attribute, integer(), attribute(), _}.
+-type option() :: compile:option()
+ | {'attribute', 'insert', attribute(), value()}
+ | {'attribute', 'replace', attribute(), value()}
+ | {'attribute', 'delete', attribute()}.
+-type op() :: {'insert', attribute(), value()}
+ | {'replace', attribute(), value()}
+ | {'delete', attribute()}.
+
+-spec parse_transform([form()], [option()]) -> [form()].
+
parse_transform(Forms, Options) ->
S = #state{forms = Forms, options = Options},
- S2 = init_transform(S),
+ S2 = init_transform(Options, S),
report_verbose("Pre options: ~p~n", [S2#state.pre_ops], S2),
report_verbose("Post options: ~p~n", [S2#state.post_ops], S2),
S3 = pre_transform(S2),
@@ -71,13 +85,6 @@ parse_transform(Forms, Options) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Computes the lists of pre_ops and post_ops that are
%% used in the real transformation.
-init_transform(S) ->
- case S#state.options of
- Options when is_list(Options) ->
- init_transform(Options, S);
- Option ->
- init_transform([Option], S)
- end.
init_transform([{attribute, insert, Name, Val} | Tail], S) ->
Op = {insert, Name, Val},
@@ -92,12 +99,9 @@ init_transform([{attribute, delete, Name} | Tail], S) ->
Op = {delete, Name},
PreOps = [Op | S#state.pre_ops],
init_transform(Tail, S#state{pre_ops = PreOps});
-init_transform([], S) ->
- S;
init_transform([_ | T], S) ->
init_transform(T, S);
-init_transform(BadOpt, S) ->
- report_error("Illegal option (ignored): ~p~n", [BadOpt], S),
+init_transform([], S) ->
S.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -176,18 +180,9 @@ attrs([], _, _) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Report functions.
%%
-%% Errors messages are controlled with the 'report_errors' compiler option
%% Warning messages are controlled with the 'report_warnings' compiler option
%% Verbose messages are controlled with the 'verbose' compiler option
-report_error(Format, Args, S) ->
- case is_error(S) of
- true ->
- io:format("~p: * ERROR * " ++ Format, [?MODULE | Args]);
- false ->
- ok
- end.
-
report_warning(Format, Args, S) ->
case is_warning(S) of
true ->
@@ -204,9 +199,6 @@ report_verbose(Format, Args, S) ->
ok
end.
-is_error(S) ->
- lists:member(report_errors, S#state.options) or is_verbose(S).
-
is_warning(S) ->
lists:member(report_warnings, S#state.options) or is_verbose(S).
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
deleted file mode 100644
index 7ab4e1845c..0000000000
--- a/lib/compiler/src/sys_pre_expand.erl
+++ /dev/null
@@ -1,616 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% Purpose : Expand some source Erlang constructions. This is part of the
-%% pre-processing phase.
-
-%% N.B. Although structs (tagged tuples) are not yet allowed in the
-%% language there is code included in pattern/2 and expr/3 (commented out)
-%% that handles them by transforming them to tuples.
-
--module(sys_pre_expand).
-
-%% Main entry point.
--export([module/2]).
-
--import(lists, [member/2,foldl/3,foldr/3]).
-
--type fa() :: {atom(), arity()}.
-
--record(expand, {module=[], %Module name
- exports=[], %Exports
- attributes=[], %Attributes
- callbacks=[], %Callbacks
- optional_callbacks=[] :: [fa()], %Optional callbacks
- vcount=0, %Variable counter
- func=[], %Current function
- arity=[], %Arity for current function
- fcount=0, %Local fun count
- ctype %Call type map
- }).
-
-%% module(Forms, CompileOptions)
-%% {ModuleName,Exports,TransformedForms,CompileOptions'}
-%% Expand the forms in one module.
-%%
-%% CompileOptions is augmented with options from -compile attributes.
-
-module(Fs0, Opts0) ->
-
- %% Expand records. Normalise guard tests.
- Fs = erl_expand_records:module(Fs0, Opts0),
-
- Opts = compiler_options(Fs) ++ Opts0,
-
- %% Set pre-defined exported functions.
- PreExp = [{module_info,0},{module_info,1}],
-
- %% Build the set of defined functions and the initial call
- %% type map.
- Defined = defined_functions(Fs, PreExp),
- Ctype = maps:from_list([{K,local} || K <- Defined]),
-
- %% Build initial expand record.
- St0 = #expand{exports=PreExp,
- ctype=Ctype
- },
-
- %% Expand the functions.
- {Tfs,St1} = forms(Fs, St0),
-
- %% Get the correct list of exported functions.
- Exports = case member(export_all, Opts) of
- true -> Defined;
- false -> St1#expand.exports
- end,
- St2 = St1#expand{exports=Exports,ctype=undefined},
-
- %% Generate all functions from stored info.
- {Ats,St3} = module_attrs(St2),
- {Mfs,St4} = module_predef_funcs(St3),
- {St4#expand.module, St4#expand.exports, Ats ++ Tfs ++ Mfs,
- Opts}.
-
-compiler_options(Forms) ->
- lists:flatten([C || {attribute,_,compile,C} <- Forms]).
-
-%% defined_function(Forms, Predef) -> Functions.
-%% Add function to defined if form is a function.
-
-defined_functions(Forms, Predef) ->
- Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc];
- (_, Acc) -> Acc
- end, Predef, Forms),
- ordsets:from_list(Fs).
-
-module_attrs(#expand{attributes=Attributes}=St) ->
- Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
- Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
- OptionalCallbacks = get_optional_callbacks(Attrs),
- {Attrs,St#expand{callbacks=Callbacks,
- optional_callbacks=OptionalCallbacks}}.
-
-get_optional_callbacks(Attrs) ->
- L = [O ||
- {attribute, _, optional_callbacks, O} <- Attrs,
- is_fa_list(O)],
- lists:append(L).
-
-is_fa_list([{FuncName, Arity}|L])
- when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
- is_fa_list(L);
-is_fa_list([]) -> true;
-is_fa_list(_) -> false.
-
-module_predef_funcs(St0) ->
- {Mpf1,St1} = module_predef_func_beh_info(St0),
- Mpf2 = module_predef_funcs_mod_info(St1),
- Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2],
- {Mpf,St1}.
-
-module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
- {[], St};
-module_predef_func_beh_info(#expand{callbacks=Callbacks,
- optional_callbacks=OptionalCallbacks,
- exports=Exports}=St) ->
- PreDef0 = [{behaviour_info,1}],
- PreDef = ordsets:from_list(PreDef0),
- {[gen_beh_info(Callbacks, OptionalCallbacks)],
- St#expand{exports=ordsets:union(PreDef, Exports)}}.
-
-gen_beh_info(Callbacks, OptionalCallbacks) ->
- List = make_list(Callbacks),
- OptionalList = make_optional_list(OptionalCallbacks),
- {function,0,behaviour_info,1,
- [{clause,0,[{atom,0,callbacks}],[],
- [List]},
- {clause,0,[{atom,0,optional_callbacks}],[],
- [OptionalList]}]}.
-
-make_list([]) -> {nil,0};
-make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
- {cons,0,
- {tuple,0,
- [{atom,0,Name},
- {integer,0,Arity}]},
- make_list(Rest)}.
-
-make_optional_list([]) -> {nil,0};
-make_optional_list([{Name,Arity}|Rest]) ->
- {cons,0,
- {tuple,0,
- [{atom,0,Name},
- {integer,0,Arity}]},
- make_optional_list(Rest)}.
-
-module_predef_funcs_mod_info(#expand{module=Mod}) ->
- ModAtom = {atom,0,Mod},
- [{function,0,module_info,0,
- [{clause,0,[],[],
- [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
- [ModAtom]}]}]},
- {function,0,module_info,1,
- [{clause,0,[{var,0,'X'}],[],
- [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
- [ModAtom,{var,0,'X'}]}]}]}].
-
-%% forms(Forms, State) ->
-%% {TransformedForms,State'}
-%% Process the forms. Attributes are lost and just affect the state.
-%% Ignore uninteresting forms like eof and type.
-
-forms([{attribute,_,file,_File}=F|Fs0], St0) ->
- {Fs,St1} = forms(Fs0, St0),
- {[F|Fs],St1};
-forms([{attribute,Line,Name,Val}|Fs0], St0) ->
- St1 = attribute(Name, Val, Line, St0),
- forms(Fs0, St1);
-forms([{function,L,N,A,Cs}|Fs0], St0) ->
- {Ff,St1} = function(L, N, A, Cs, St0),
- {Fs,St2} = forms(Fs0, St1),
- {[Ff|Fs],St2};
-forms([_|Fs], St) -> forms(Fs, St);
-forms([], St) -> {[],St}.
-
-%% attribute(Attribute, Value, Line, State) -> State'.
-%% Process an attribute, this just affects the state.
-
-attribute(module, Module, _L, St) ->
- true = is_atom(Module),
- St#expand{module=Module};
-attribute(export, Es, _L, St) ->
- St#expand{exports=ordsets:union(ordsets:from_list(Es),
- St#expand.exports)};
-attribute(import, Is, _L, St) ->
- import(Is, St);
-attribute(compile, _C, _L, St) ->
- St;
-attribute(Name, Val, Line, St) when is_list(Val) ->
- St#expand{attributes=St#expand.attributes ++ [{Name,Line,Val}]};
-attribute(Name, Val, Line, St) ->
- St#expand{attributes=St#expand.attributes ++ [{Name,Line,[Val]}]}.
-
-function(L, N, A, Cs0, St0) ->
- {Cs,St} = clauses(Cs0, St0#expand{func=N,arity=A,fcount=0}),
- {{function,L,N,A,Cs},St}.
-
-%% clauses([Clause], State) ->
-%% {[TransformedClause],State}.
-%% Expand function clauses.
-
-clauses([{clause,Line,H0,G0,B0}|Cs0], St0) ->
- {H,St1} = head(H0, St0),
- {G,St2} = guard(G0, St1),
- {B,St3} = exprs(B0, St2),
- {Cs,St4} = clauses(Cs0, St3),
- {[{clause,Line,H,G,B}|Cs],St4};
-clauses([], St) -> {[],St}.
-
-%% head(HeadPatterns, State) ->
-%% {TransformedPatterns,Variables,UsedVariables,State'}
-
-head(As, St) -> pattern_list(As, St).
-
-%% pattern(Pattern, State) ->
-%% {TransformedPattern,State'}
-%%
-
-pattern({var,_,_}=Var, St) ->
- {Var,St};
-pattern({char,_,_}=Char, St) ->
- {Char,St};
-pattern({integer,_,_}=Int, St) ->
- {Int,St};
-pattern({float,_,_}=Float, St) ->
- {Float,St};
-pattern({atom,_,_}=Atom, St) ->
- {Atom,St};
-pattern({string,_,_}=String, St) ->
- {String,St};
-pattern({nil,_}=Nil, St) ->
- {Nil,St};
-pattern({cons,Line,H,T}, St0) ->
- {TH,St1} = pattern(H, St0),
- {TT,St2} = pattern(T, St1),
- {{cons,Line,TH,TT},St2};
-pattern({tuple,Line,Ps}, St0) ->
- {TPs,St1} = pattern_list(Ps, St0),
- {{tuple,Line,TPs},St1};
-pattern({map,Line,Ps}, St0) ->
- {TPs,St1} = pattern_list(Ps, St0),
- {{map,Line,TPs},St1};
-pattern({map_field_exact,Line,K0,V0}, St0) ->
- %% Key should be treated as an expression
- %% but since expressions are not allowed yet,
- %% process it through pattern .. and handle assoc
- %% (normalise unary op integer -> integer)
- {K,St1} = pattern(K0, St0),
- {V,St2} = pattern(V0, St1),
- {{map_field_exact,Line,K,V},St2};
-pattern({map_field_assoc,Line,K0,V0}, St0) ->
- %% when keys are Maps
- {K,St1} = pattern(K0, St0),
- {V,St2} = pattern(V0, St1),
- {{map_field_assoc,Line,K,V},St2};
-%%pattern({struct,Line,Tag,Ps}, St0) ->
-%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
-%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
-pattern({bin,Line,Es0}, St0) ->
- {Es1,St1} = pattern_bin(Es0, St0),
- {{bin,Line,Es1},St1};
-pattern({op,_,'++',{nil,_},R}, St) ->
- pattern(R, St);
-pattern({op,_,'++',{cons,Li,H,T},R}, St) ->
- pattern({cons,Li,H,{op,Li,'++',T,R}}, St);
-pattern({op,_,'++',{string,Li,L},R}, St) ->
- pattern(string_to_conses(Li, L, R), St);
-pattern({match,Line,Pat1, Pat2}, St0) ->
- {TH,St1} = pattern(Pat2, St0),
- {TT,St2} = pattern(Pat1, St1),
- {{match,Line,TT,TH},St2};
-%% Compile-time pattern expressions, including unary operators.
-pattern({op,_Line,_Op,_A}=Op, St) ->
- {erl_eval:partial_eval(Op),St};
-pattern({op,_Line,_Op,_L,_R}=Op, St) ->
- {erl_eval:partial_eval(Op),St}.
-
-pattern_list([P0|Ps0], St0) ->
- {P,St1} = pattern(P0, St0),
- {Ps,St2} = pattern_list(Ps0, St1),
- {[P|Ps],St2};
-pattern_list([], St) -> {[],St}.
-
-%% guard(Guard, State) ->
-%% {TransformedGuard,State'}
-%% Transform a list of guard tests. We KNOW that this has been checked
-%% and what the guards test are. Use expr for transforming the guard
-%% expressions.
-
-guard([G0|Gs0], St0) ->
- {G,St1} = guard_tests(G0, St0),
- {Gs,St2} = guard(Gs0, St1),
- {[G|Gs],St2};
-guard([], St) -> {[],St}.
-
-guard_tests([Gt0|Gts0], St0) ->
- {Gt1,St1} = guard_test(Gt0, St0),
- {Gts1,St2} = guard_tests(Gts0, St1),
- {[Gt1|Gts1],St2};
-guard_tests([], St) -> {[],St}.
-
-guard_test(Test, St) ->
- expr(Test, St).
-
-%% exprs(Expressions, State) ->
-%% {TransformedExprs,State'}
-
-exprs([E0|Es0], St0) ->
- {E,St1} = expr(E0, St0),
- {Es,St2} = exprs(Es0, St1),
- {[E|Es],St2};
-exprs([], St) -> {[],St}.
-
-%% expr(Expression, State) ->
-%% {TransformedExpression,State'}
-
-expr({var,_,_}=Var, St) ->
- {Var,St};
-expr({char,_,_}=Char, St) ->
- {Char,St};
-expr({integer,_,_}=Int, St) ->
- {Int,St};
-expr({float,_,_}=Float, St) ->
- {Float,St};
-expr({atom,_,_}=Atom, St) ->
- {Atom,St};
-expr({string,_,_}=String, St) ->
- {String,St};
-expr({nil,_}=Nil, St) ->
- {Nil,St};
-expr({cons,Line,H0,T0}, St0) ->
- {H,St1} = expr(H0, St0),
- {T,St2} = expr(T0, St1),
- {{cons,Line,H,T},St2};
-expr({lc,Line,E0,Qs0}, St0) ->
- {Qs1,St1} = lc_tq(Line, Qs0, St0),
- {E1,St2} = expr(E0, St1),
- {{lc,Line,E1,Qs1},St2};
-expr({bc,Line,E0,Qs0}, St0) ->
- {Qs1,St1} = lc_tq(Line, Qs0, St0),
- {E1,St2} = expr(E0, St1),
- {{bc,Line,E1,Qs1},St2};
-expr({tuple,Line,Es0}, St0) ->
- {Es1,St1} = expr_list(Es0, St0),
- {{tuple,Line,Es1},St1};
-%%expr({struct,Line,Tag,Es0}, Vs, St0) ->
-%% {Es1,Esvs,Esus,St1} = expr_list(Es0, Vs, St0),
-%% {{tuple,Line,[{atom,Line,Tag}|Es1]},Esvs,Esus,St1};
-expr({map,Line,Es0}, St0) ->
- {Es1,St1} = expr_list(Es0, St0),
- {{map,Line,Es1},St1};
-expr({map,Line,E0,Es0}, St0) ->
- {E1,St1} = expr(E0, St0),
- {Es1,St2} = expr_list(Es0, St1),
- {{map,Line,E1,Es1},St2};
-expr({map_field_assoc,Line,K0,V0}, St0) ->
- {K,St1} = expr(K0, St0),
- {V,St2} = expr(V0, St1),
- {{map_field_assoc,Line,K,V},St2};
-expr({map_field_exact,Line,K0,V0}, St0) ->
- {K,St1} = expr(K0, St0),
- {V,St2} = expr(V0, St1),
- {{map_field_exact,Line,K,V},St2};
-expr({bin,Line,Es0}, St0) ->
- {Es1,St1} = expr_bin(Es0, St0),
- {{bin,Line,Es1},St1};
-expr({block,Line,Es0}, St0) ->
- {Es,St1} = exprs(Es0, St0),
- {{block,Line,Es},St1};
-expr({'if',Line,Cs0}, St0) ->
- {Cs,St1} = clauses(Cs0, St0),
- {{'if',Line,Cs},St1};
-expr({'case',Line,E0,Cs0}, St0) ->
- {E,St1} = expr(E0, St0),
- {Cs,St2} = clauses(Cs0, St1),
- {{'case',Line,E,Cs},St2};
-expr({'receive',Line,Cs0}, St0) ->
- {Cs,St1} = clauses(Cs0, St0),
- {{'receive',Line,Cs},St1};
-expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
- {To,St1} = expr(To0, St0),
- {ToEs,St2} = exprs(ToEs0, St1),
- {Cs,St3} = clauses(Cs0, St2),
- {{'receive',Line,Cs,To,ToEs},St3};
-expr({'fun',Line,Body}, St) ->
- fun_tq(Line, Body, St);
-expr({named_fun,Line,Name,Cs}, St) ->
- fun_tq(Line, Cs, St, Name);
-expr({call,Line,{atom,La,N}=Atom,As0}, St0) ->
- {As,St1} = expr_list(As0, St0),
- Ar = length(As),
- Key = {N,Ar},
- case St1#expand.ctype of
- #{Key:=local} ->
- {{call,Line,Atom,As},St1};
- #{Key:={imported,Mod}} ->
- {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
- _ ->
- true = erl_internal:bif(N, Ar),
- {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1}
- end;
-expr({call,Line,{remote,Lr,M0,F},As0}, St0) ->
- {[M1,F1|As1],St1} = expr_list([M0,F|As0], St0),
- {{call,Line,{remote,Lr,M1,F1},As1},St1};
-expr({call,Line,F,As0}, St0) ->
- {[Fun1|As1],St1} = expr_list([F|As0], St0),
- {{call,Line,Fun1,As1},St1};
-expr({'try',Line,Es0,Scs0,Ccs0,As0}, St0) ->
- {Es1,St1} = exprs(Es0, St0),
- {Scs1,St2} = clauses(Scs0, St1),
- {Ccs1,St3} = clauses(Ccs0, St2),
- {As1,St4} = exprs(As0, St3),
- {{'try',Line,Es1,Scs1,Ccs1,As1},St4};
-expr({'catch',Line,E0}, St0) ->
- {E,St1} = expr(E0, St0),
- {{'catch',Line,E},St1};
-expr({match,Line,P0,E0}, St0) ->
- {E,St1} = expr(E0, St0),
- {P,St2} = pattern(P0, St1),
- {{match,Line,P,E},St2};
-expr({op,Line,Op,A0}, St0) ->
- {A,St1} = expr(A0, St0),
- {{op,Line,Op,A},St1};
-expr({op,Line,Op,L0,R0}, St0) ->
- {L,St1} = expr(L0, St0),
- {R,St2} = expr(R0, St1),
- {{op,Line,Op,L,R},St2}.
-
-expr_list([E0|Es0], St0) ->
- {E,St1} = expr(E0, St0),
- {Es,St2} = expr_list(Es0, St1),
- {[E|Es],St2};
-expr_list([], St) -> {[],St}.
-
-%% lc_tq(Line, Qualifiers, State) ->
-%% {[TransQual],State'}
-
-lc_tq(Line, [{generate,Lg,P0,G0} | Qs0], St0) ->
- {G1,St1} = expr(G0, St0),
- {P1,St2} = pattern(P0, St1),
- {Qs1,St3} = lc_tq(Line, Qs0, St2),
- {[{generate,Lg,P1,G1} | Qs1],St3};
-
-lc_tq(Line, [{b_generate,Lg,P0,G0}|Qs0], St0) ->
- {G1,St1} = expr(G0, St0),
- {P1,St2} = pattern(P0, St1),
- {Qs1,St3} = lc_tq(Line, Qs0, St2),
- {[{b_generate,Lg,P1,G1}|Qs1],St3};
-lc_tq(Line, [F0 | Qs0], St0) ->
- {F1,St1} = expr(F0, St0),
- {Qs1,St2} = lc_tq(Line, Qs0, St1),
- {[F1|Qs1],St2};
-lc_tq(_Line, [], St0) ->
- {[],St0}.
-
-
-%% fun_tq(Line, Body, State) ->
-%% {Fun,State'}
-%% 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).
-%% "Implicit" funs {'fun', Line, {function, F, A}} are not changed.
-
-fun_tq(Lf, {function,F,A}=Function, St0) ->
- 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 ->
- {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) 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) ->
- {Cs1,St1} = clauses(Cs0, St0),
- {Fname,St2} = new_fun_name(St1),
- %% 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_tq(Line, Cs0, St0, Name) ->
- {Cs1,St1} = clauses(Cs0, St0),
- {Fname,St2} = new_fun_name(St1, Name),
- {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}.
-
-%% new_fun_name(State) -> {FunName,State}.
-
-new_fun_name(St) ->
- new_fun_name(St, 'fun').
-
-new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) ->
- Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A)
- ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-",
- {list_to_atom(Name),St#expand{fcount=I+1}}.
-
-%% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}.
-
-pattern_bin(Es0, St) ->
- Es1 = bin_expand_strings(Es0),
- foldr(fun (E, Acc) -> pattern_element(E, Acc) end, {[],St}, Es1).
-
-pattern_element({bin_element,Line,Expr0,Size0,Type0}, {Es,St0}) ->
- {Expr1,St1} = pattern(Expr0, St0),
- {Size1,St2} = pat_bit_size(Size0, St1),
- {Size,Type} = make_bit_type(Line, Size1, Type0),
- Expr = coerce_to_float(Expr1, Type0),
- {[{bin_element,Line,Expr,Size,Type}|Es],St2}.
-
-pat_bit_size(default, St) -> {default,St};
-pat_bit_size({var,_Lv,_V}=Var, St) -> {Var,St};
-pat_bit_size(Size, St) ->
- Line = element(2, Size),
- {value,Sz,_} = erl_eval:expr(Size, erl_eval:new_bindings()),
- {{integer,Line,Sz},St}.
-
-make_bit_type(Line, default, Type0) ->
- case erl_bits:set_bit_type(default, Type0) of
- {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
- {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
- {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}
- end;
-make_bit_type(_Line, Size, Type0) -> %Integer or 'all'
- {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0),
- {Size,erl_bits:as_list(Bt)}.
-
-coerce_to_float({integer,L,I}=E, [float|_]) ->
- try
- {float,L,float(I)}
- catch
- error:badarg -> E
- end;
-coerce_to_float(E, _) -> E.
-
-%% expr_bin([Element], State) -> {[Element],State}.
-
-expr_bin(Es0, St) ->
- Es1 = bin_expand_strings(Es0),
- foldr(fun (E, Acc) -> bin_element(E, Acc) end, {[],St}, Es1).
-
-bin_element({bin_element,Line,Expr,Size,Type}, {Es,St0}) ->
- {Expr1,St1} = expr(Expr, St0),
- {Size1,St2} = if Size == default -> {default,St1};
- true -> expr(Size, St1)
- end,
- {Size2,Type1} = make_bit_type(Line, Size1, Type),
- {[{bin_element,Line,Expr1,Size2,Type1}|Es],St2}.
-
-bin_expand_strings(Es) ->
- foldr(fun ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) ->
- foldr(fun (C, Es2) ->
- [{bin_element,Line,{char,Line,C},Sz,Ts}|Es2]
- end, Es1, S);
- (E, Es1) -> [E|Es1]
- end, [], Es).
-
-%% new_var_name(State) -> {VarName,State}.
-
-new_var_name(St) ->
- C = St#expand.vcount,
- {list_to_atom("pre" ++ integer_to_list(C)),St#expand{vcount=C+1}}.
-
-%% new_var(Line, State) -> {Var,State}.
-
-new_var(L, St0) ->
- {New,St1} = new_var_name(St0),
- {{var,L,New},St1}.
-
-%% new_vars(Count, Line, State) -> {[Var],State}.
-%% Make Count new variables.
-
-new_vars(N, L, St) -> new_vars(N, L, St, []).
-
-new_vars(N, L, St0, Vs) when N > 0 ->
- {V,St1} = new_var(L, St0),
- new_vars(N-1, L, St1, [V|Vs]);
-new_vars(0, _L, St, Vs) -> {Vs,St}.
-
-string_to_conses(Line, Cs, Tail) ->
- foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs).
-
-
-%% import(Line, Imports, State) ->
-%% State'
-%% Handle import declarations.
-
-import({Mod,Fs}, #expand{ctype=Ctype0}=St) ->
- true = is_atom(Mod),
- Ctype = foldl(fun(F, A) ->
- A#{F=>{imported,Mod}}
- end, Ctype0, Fs),
- St#expand{ctype=Ctype}.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 4df1aadd0a..e9152ba88f 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -19,25 +19,6 @@
%%
%% Purpose : Code generator for Beam.
-%% The following assumptions have been made:
-%%
-%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return
-%% values; no variables are exported. If the match would have returned
-%% extra variables then these have been transformed to multiple return
-%% values.
-%%
-%% 2. All BIF's called in guards are gc-safe so there is no need to
-%% put thing on the stack in the guard. While this would in principle
-%% work it would be difficult to keep track of the stack depth when
-%% trimming.
-%%
-%% The code generation uses variable lifetime information added by
-%% the v3_life module to save variables, allocate registers and
-%% move registers to the stack when necessary.
-%%
-%% We try to use a consistent variable name scheme throughout. The
-%% StackReg record is always called Bef,Int<n>,Aft.
-
-module(v3_codegen).
%% The main interface.
@@ -45,12 +26,14 @@
-import(lists, [member/2,keymember/3,keysort/2,keydelete/3,
append/1,flatmap/2,filter/2,foldl/3,foldr/3,mapfoldl/3,
- sort/1,reverse/1,reverse/2]).
--import(v3_life, [vdb_find/2]).
+ sort/1,reverse/1,reverse/2,map/2]).
+-import(ordsets, [add_element/2,intersection/2,union/2]).
-%%-compile([export_all]).
+-include("v3_kernel.hrl").
--include("v3_life.hrl").
+%% These are not defined in v3_kernel.hrl.
+get_kanno(Kthing) -> element(2, Kthing).
+set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
%% Main codegen structure.
-record(cg, {lcount=1, %Label counter
@@ -61,34 +44,400 @@
functable=#{}, %Map of local functions: {Name,Arity}=>Label
in_catch=false, %Inside a catch or not.
need_frame, %Need a stack frame.
- ultimate_failure %Label for ultimate match failure.
- }).
+ ultimate_failure, %Label for ultimate match failure.
+ ctx %Match context.
+ }).
%% Stack/register state record.
-record(sr, {reg=[], %Register table
stk=[], %Stack table
- res=[]}). %Reserved regs: [{reserved,I,V}]
+ res=[]}). %Registers to reserve
-module({Mod,Exp,Attr,Forms}, _Options) ->
- {Fs,St} = functions(Forms, {atom,Mod}),
- {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}.
+%% Internal records.
+-record(cg_need_heap, {anno=[] :: term(),
+ h=0 :: integer()}).
+-record(cg_block, {anno=[] :: term(),
+ es=[] :: [term()]}).
+
+-type vdb_entry() :: {atom(),non_neg_integer(),non_neg_integer()}.
+
+-record(l, {i=0 :: non_neg_integer(), %Op number
+ vdb=[] :: [vdb_entry()], %Variable database
+ a=[] :: [term()]}). %Core annotation
+
+-spec module(#k_mdef{}, [compile:option()]) -> {'ok',beam_asm:module_code()}.
+
+module(#k_mdef{name=Mod,exports=Es,attributes=Attr,body=Forms}, _Opts) ->
+ {Asm,St} = functions(Forms, {atom,Mod}),
+ {ok,{Mod,Es,Attr,Asm,St#cg.lcount}}.
functions(Forms, AtomMod) ->
mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms).
-function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) ->
+function(#k_fdef{anno=#k{a=Anno},func=Name,arity=Arity,
+ vars=As,body=Kb}, AtomMod, St0) ->
try
- {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod,
- {Name,Arity}, Anno, St0),
- Func = {function,Name,Arity,EntryLabel,Asm},
- {Func,St}
+ #k_match{} = Kb, %Assertion.
+
+ %% Try to suppress the stack frame unless it is
+ %% really needed.
+ Body0 = avoid_stack_frame(Kb),
+
+ %% Annotate kernel records with variable usage.
+ Vdb0 = init_vars(As),
+ {Body,_,Vdb} = body(Body0, 1, Vdb0),
+
+ %% Generate the BEAM assembly code.
+ {Asm,EntryLabel,St} = cg_fun(Body, As, Vdb, AtomMod,
+ {Name,Arity}, Anno, St0),
+ Func = {function,Name,Arity,EntryLabel,Asm},
+ {Func,St}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
- io:fwrite("Function: ~w/~w\n", [Name,Arity]),
- erlang:raise(Class, Error, Stack)
+ Class:Error:Stack ->
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
end.
+
+%% avoid_stack_frame(Kernel) -> Kernel'
+%% If possible, avoid setting up a stack frame. Functions
+%% that only do matching, calls to guard BIFs, and tail-recursive
+%% calls don't need a stack frame.
+
+avoid_stack_frame(#k_match{body=Body}=M) ->
+ try
+ M#k_match{body=avoid_stack_frame_1(Body)}
+ catch
+ impossible ->
+ M
+ end.
+
+avoid_stack_frame_1(#k_alt{first=First0,then=Then0}=Alt) ->
+ First = avoid_stack_frame_1(First0),
+ Then = avoid_stack_frame_1(Then0),
+ Alt#k_alt{first=First,then=Then};
+avoid_stack_frame_1(#k_bif{op=Op}=Bif) ->
+ case Op of
+ #k_internal{} ->
+ %% Most internal BIFs clobber the X registers.
+ throw(impossible);
+ _ ->
+ Bif
+ end;
+avoid_stack_frame_1(#k_break{anno=Anno,args=Args}) ->
+ #k_guard_break{anno=Anno,args=Args};
+avoid_stack_frame_1(#k_guard_break{}=Break) ->
+ Break;
+avoid_stack_frame_1(#k_enter{}=Enter) ->
+ %% Tail-recursive calls don't need a stack frame.
+ Enter;
+avoid_stack_frame_1(#k_guard{clauses=Cs0}=Guard) ->
+ Cs = avoid_stack_frame_list(Cs0),
+ Guard#k_guard{clauses=Cs};
+avoid_stack_frame_1(#k_guard_clause{guard=G0,body=B0}=C) ->
+ G = avoid_stack_frame_1(G0),
+ B = avoid_stack_frame_1(B0),
+ C#k_guard_clause{guard=G,body=B};
+avoid_stack_frame_1(#k_match{anno=A,vars=Vs,body=B0,ret=Ret}) ->
+ %% Use #k_guard_match{} instead to avoid saving the X registers
+ %% to the stack before matching.
+ B = avoid_stack_frame_1(B0),
+ #k_guard_match{anno=A,vars=Vs,body=B,ret=Ret};
+avoid_stack_frame_1(#k_guard_match{body=B0}=M) ->
+ B = avoid_stack_frame_1(B0),
+ M#k_guard_match{body=B};
+avoid_stack_frame_1(#k_protected{arg=Arg0}=Prot) ->
+ Arg = avoid_stack_frame_1(Arg0),
+ Prot#k_protected{arg=Arg};
+avoid_stack_frame_1(#k_put{}=Put) ->
+ Put;
+avoid_stack_frame_1(#k_return{}=Ret) ->
+ Ret;
+avoid_stack_frame_1(#k_select{var=#k_var{anno=Vanno},types=Types0}=Select) ->
+ case member(reuse_for_context, Vanno) of
+ false ->
+ Types = avoid_stack_frame_list(Types0),
+ Select#k_select{types=Types};
+ true ->
+ %% Including binary patterns that overwrite the register containing
+ %% the binary with the match context may not be safe. For example,
+ %% bs_match_SUITE:bin_tail_e/1 with inlining will be rejected by
+ %% beam_validator.
+ %%
+ %% Essentially the following code is produced:
+ %%
+ %% bs_match {x,0} => {x,0}
+ %% ...
+ %% bs_match {x,0} => {x,1} %% ILLEGAL
+ %%
+ %% A bs_match instruction will only accept a match context as the
+ %% source operand if the source and destination registers are the
+ %% the same (as in the first bs_match instruction above).
+ %% The second bs_match instruction is therefore illegal.
+ %%
+ %% This situation is avoided if there is a stack frame:
+ %%
+ %% move {x,0} => {y,0}
+ %% bs_match {x,0} => {x,0}
+ %% ...
+ %% bs_match {y,0} => {x,1} %% LEGAL
+ %%
+ throw(impossible)
+ end;
+avoid_stack_frame_1(#k_seq{arg=#k_call{anno=Anno,op=Op}=Call,
+ body=#k_break{args=BrArgs0}}=Seq) ->
+ case Op of
+ #k_remote{mod=#k_atom{val=Mod},
+ name=#k_atom{val=Name},
+ arity=Arity} ->
+ case erl_bifs:is_exit_bif(Mod, Name, Arity) of
+ false ->
+ %% Will clobber X registers. Must have a stack frame.
+ throw(impossible);
+ true ->
+ %% The call to this BIF will never return. It is safe
+ %% to suppress the stack frame.
+ Bif = #k_bif{anno=Anno,
+ op=#k_internal{name=guard_error,arity=1},
+ args=[Call],ret=[]},
+ BrArgs = lists:duplicate(length(BrArgs0), #k_nil{}),
+ GB = #k_guard_break{anno=#k{us=[],ns=[],a=[]},args=BrArgs},
+ Seq#k_seq{arg=Bif,body=GB}
+ end;
+ _ ->
+ %% Will clobber X registers. Must have a stack frame.
+ throw(impossible)
+ end;
+avoid_stack_frame_1(#k_seq{arg=A0,body=B0}=Seq) ->
+ A = avoid_stack_frame_1(A0),
+ B = avoid_stack_frame_1(B0),
+ Seq#k_seq{arg=A,body=B};
+avoid_stack_frame_1(#k_test{}=Test) ->
+ Test;
+avoid_stack_frame_1(#k_type_clause{values=Values0}=TC) ->
+ Values = avoid_stack_frame_list(Values0),
+ TC#k_type_clause{values=Values};
+avoid_stack_frame_1(#k_val_clause{body=B0}=VC) ->
+ B = avoid_stack_frame_1(B0),
+ VC#k_val_clause{body=B};
+avoid_stack_frame_1(_Body) ->
+ throw(impossible).
+
+avoid_stack_frame_list([H|T]) ->
+ [avoid_stack_frame_1(H)|avoid_stack_frame_list(T)];
+avoid_stack_frame_list([]) -> [].
+
+
+%% This pass creates beam format annotated with variable lifetime
+%% information. Each thing is given an index and for each variable we
+%% store the first and last index for its occurrence. The variable
+%% database, VDB, attached to each thing is only relevant internally
+%% for that thing.
+%%
+%% For nested things like matches the numbering continues locally and
+%% the VDB for that thing refers to the variable usage within that
+%% thing. Variables which live through a such a thing are internally
+%% given a very large last index. Internally the indexes continue
+%% after the index of that thing. This creates no problems as the
+%% internal variable info never escapes and externally we only see
+%% variable which are alive both before or after.
+%%
+%% This means that variables never "escape" from a thing and the only
+%% way to get values from a thing is to "return" them, with 'break' or
+%% 'return'. Externally these values become the return values of the
+%% thing. This is no real limitation as most nested things have
+%% multiple threads so working out a common best variable usage is
+%% difficult.
+
+%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
+%% 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),
+ Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
+ {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1),
+ E = expr(Ke, I, Vdb2),
+ {[E|Es],MaxI,Vdb2};
+body(Ke, I, Vdb0) ->
+ %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
+ A = get_kanno(Ke),
+ Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
+ E = expr(Ke, I, Vdb1),
+ {[E],I,Vdb1}.
+
+%% expr(Kexpr, I, Vdb) -> Expr.
+
+expr(#k_test{anno=A}=Test, I, _Vdb) ->
+ Test#k_test{anno=#l{i=I,a=A#k.a}};
+expr(#k_call{anno=A}=Call, I, _Vdb) ->
+ Call#k_call{anno=#l{i=I,a=A#k.a}};
+expr(#k_enter{anno=A}=Enter, I, _Vdb) ->
+ Enter#k_enter{anno=#l{i=I,a=A#k.a}};
+expr(#k_bif{anno=A}=Bif, I, _Vdb) ->
+ Bif#k_bif{anno=#l{i=I,a=A#k.a}};
+expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
+ %% 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 = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a},
+ #k_match{anno=L,body=M,ret=Rs};
+expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
+ %% 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 = #l{i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a},
+ #k_guard_match{anno=L,body=M,ret=Rs};
+expr(#k_protected{}=Protected, I, Vdb) ->
+ protected(Protected, I, Vdb);
+expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}=Try, 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(union(Ab#k.us, 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(sort(map(Vnames, Vs)), I+3, Tdb2)),
+ {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)),
+ L = #l{i=I,vdb=Tdb1,a=A#k.a},
+ Try#k_try{anno=L,
+ arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}},
+ vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}},
+ evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}};
+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.
+ 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(union(Ab#k.us, 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, 1000000, Tdb2)),
+ {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)),
+ {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)),
+ L = #l{i=I,vdb=Tdb1,a=A#k.a},
+ #k_try_enter{anno=L,
+ arg=#cg_block{es=Aes,anno=#l{i=I+1,vdb=Adb,a=[]}},
+ vars=Vs,body=#cg_block{es=Bes,anno=#l{i=I+3,vdb=Bdb,a=[]}},
+ evars=Evs,handler=#cg_block{es=Hes,anno=#l{i=I+3,vdb=Hdb,a=[]}}};
+expr(#k_catch{anno=A,body=Kb}=Catch, I, Vdb) ->
+ %% Lock variables that are alive before the catch and used afterwards.
+ %% Don't lock variables that are only used inside the catch.
+ %% Add catch tag 'variable'.
+ Cdb0 = vdb_sub(I, I+1, Vdb),
+ {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)),
+ L = #l{i=I,vdb=Cdb1,a=A#k.a},
+ Catch#k_catch{anno=L,body=#cg_block{es=Es}};
+expr(#k_receive{anno=A,var=V,body=Kb,action=Ka}=Recv, I, Vdb) ->
+ %% Work out imported variables which need to be locked.
+ Rdb = vdb_sub(I, I+1, Vdb),
+ M = match(Kb, add_element(V#k_var.name, A#k.us), I+1,
+ new_vars([V#k_var.name], I, Rdb)),
+ {Tes,_,Adb} = body(Ka, I+1, Rdb),
+ Le = #l{i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a},
+ Recv#k_receive{anno=Le,body=M,
+ action=#cg_block{anno=#l{i=I+1,vdb=Adb,a=[]},es=Tes}};
+expr(#k_receive_accept{anno=A}, I, _Vdb) ->
+ #k_receive_accept{anno=#l{i=I,a=A#k.a}};
+expr(#k_receive_next{anno=A}, I, _Vdb) ->
+ #k_receive_next{anno=#l{i=I,a=A#k.a}};
+expr(#k_put{anno=A}=Put, I, _Vdb) ->
+ Put#k_put{anno=#l{i=I,a=A#k.a}};
+expr(#k_break{anno=A}=Break, I, _Vdb) ->
+ Break#k_break{anno=#l{i=I,a=A#k.a}};
+expr(#k_guard_break{anno=A}=Break, I, _Vdb) ->
+ Break#k_guard_break{anno=#l{i=I,a=A#k.a}};
+expr(#k_return{anno=A}=Ret, I, _Vdb) ->
+ Ret#k_return{anno=#l{i=I,a=A#k.a}}.
+
+%% protected(Kprotected, I, Vdb) -> Protected.
+%% Only used in guards.
+
+protected(#k_protected{anno=A,arg=Ts}=Prot, I, Vdb) ->
+ %% Lock variables that are alive before try and used afterwards.
+ %% Don't lock variables that are only used inside the protected
+ %% expression.
+ Pdb0 = vdb_sub(I, I+1, Vdb),
+ {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0),
+ Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values
+ Prot#k_protected{arg=T,anno=#l{i=I,a=A#k.a,vdb=Pdb2}}.
+
+%% match(Kexpr, [LockVar], I, Vdb) -> Expr.
+%% Convert match tree to old format.
+
+match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
+ F = match(Kf, Ls, I+1, Vdb1),
+ T = match(Kt, Ls, I+1, Vdb1),
+ #k_alt{anno=[],first=F,then=T};
+match(#k_select{anno=A,types=Kts}=Select, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
+ Ts = [type_clause(Tc, Ls, I+1, Vdb1) || Tc <- Kts],
+ Select#k_select{anno=[],types=Ts};
+match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
+ Cs = [guard_clause(G, Ls, I+1, Vdb1) || G <- Kcs],
+ #k_guard{anno=[],clauses=Cs};
+match(Other, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(Ls, I, Vdb0),
+ {B,_,Vdb2} = body(Other, I+1, Vdb1),
+ Le = #l{i=I,vdb=Vdb2,a=[]},
+ #cg_block{anno=Le,es=B}.
+
+type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Vdb0) ->
+ %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]),
+ Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0),
+ Vs = [val_clause(Vc, Ls, I+1, Vdb1) || Vc <- Kvs],
+ #k_type_clause{anno=[],type=T,values=Vs}.
+
+val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Vdb0) ->
+ New = (get_kanno(V))#k.ns,
+ Bus = (get_kanno(Kb))#k.us,
+ %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]),
+ Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety
+ Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)),
+ B = match(Kb, Ls1, I+1, Vdb1),
+ Le = #l{i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a},
+ #k_val_clause{anno=Le,val=V,body=B}.
+
+guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Vdb0) ->
+ Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
+ Gdb = vdb_sub(I+1, I+2, Vdb1),
+ G = protected(Kg, I+1, Gdb),
+ B = match(Kb, Ls, I+2, Vdb1),
+ Le = #l{i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),a=A#k.a},
+ #k_guard_clause{anno=Le,guard=G,body=B}.
+
+
+%% Here follows the code generator pass.
+%%
+%% The following assumptions have been made:
+%%
+%% 1. Matches, i.e. things with {match,M,Ret} wrappers, only return
+%% values; no variables are exported. If the match would have returned
+%% extra variables then these have been transformed to multiple return
+%% values.
+%%
+%% 2. All BIF's called in guards are gc-safe so there is no need to
+%% put thing on the stack in the guard. While this would in principle
+%% work it would be difficult to keep track of the stack depth when
+%% trimming.
+%%
+%% The code generation uses variable lifetime information added by
+%% the previous pass to save variables, allocate registers and
+%% move registers to the stack when necessary.
+%%
+%% We try to use a consistent variable name scheme throughout. The
+%% StackReg record is always called Bef,Int<n>,Aft.
+
%% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State}
cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
@@ -110,18 +459,18 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
%% Note that and 'if_end' instruction does not need any
%% live x registers, so it will always be safe to jump to
%% it. (We never ever expect the jump to be taken, and in
- %% must functions there will never be any references to
+ %% most functions there will never be any references to
%% the label in the first place.)
%%
{UltimateMatchFail,St3} = new_label(St2),
%% Create initial stack/register state, clear unused arguments.
- Bef = clear_dead(#sr{reg=foldl(fun ({var,V}, Reg) ->
+ Bef = clear_dead(#sr{reg=foldl(fun (#k_var{name=V}, Reg) ->
put_reg(V, Reg)
end, [], Hvs),
stk=[]}, 0, Vdb),
- {B,_Aft,St} = cg_list(Les, 0, Vdb, Bef,
+ {B,_Aft,St} = cg_list(Les, Vdb, Bef,
St3#cg{bfail=0,
ultimate_failure=UltimateMatchFail,
is_top_block=true}),
@@ -132,64 +481,64 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
%% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}.
%% Generate code for a kexpr.
-%% Split function into two steps for clarity, not efficiency.
-cg(Le, Vdb, Bef, St) ->
- cg(Le#l.ke, Le, Vdb, Bef, St).
-
-cg({block,Es}, Le, Vdb, Bef, St) ->
+cg(#cg_block{anno=Le,es=Es}, Vdb, Bef, St) ->
block_cg(Es, Le, Vdb, Bef, St);
-cg({match,M,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) ->
match_cg(M, Rs, Le, Vdb, Bef, St);
-cg({guard_match,M,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_guard_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) ->
guard_match_cg(M, Rs, Le, Vdb, Bef, St);
-cg({call,Func,As,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_call{anno=Le,op=Func,args=As,ret=Rs}, Vdb, Bef, St) ->
call_cg(Func, As, Rs, Le, Vdb, Bef, St);
-cg({enter,Func,As}, Le, Vdb, Bef, St) ->
+cg(#k_enter{anno=Le,op=Func,args=As}, Vdb, Bef, St) ->
enter_cg(Func, As, Le, Vdb, Bef, St);
-cg({bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
- bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
-cg({gc_bif,Bif,As,Rs}, Le, Vdb, Bef, St) ->
- gc_bif_cg(Bif, As, Rs, Le, Vdb, Bef, St);
-cg({receive_loop,Te,Rvar,Rm,Tes,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_bif{anno=Le}=Bif, Vdb, Bef, St) ->
+ bif_cg(Bif, Le, Vdb, Bef, St);
+cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs},
+ Vdb, Bef, St) ->
recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St);
-cg(receive_next, Le, Vdb, Bef, St) ->
+cg(#k_receive_next{anno=Le}, Vdb, Bef, St) ->
recv_next_cg(Le, Vdb, Bef, St);
-cg(receive_accept, _Le, _Vdb, Bef, St) -> {[remove_message],Bef,St};
-cg({'try',Ta,Vs,Tb,Evs,Th,Rs}, Le, Vdb, Bef, St) ->
+cg(#k_receive_accept{}, _Vdb, Bef, St) ->
+ {[remove_message],Bef,St};
+cg(#k_try{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th,ret=Rs},
+ Vdb, Bef, St) ->
try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St);
-cg({try_enter,Ta,Vs,Tb,Evs,Th}, Le, Vdb, Bef, St) ->
+cg(#k_try_enter{anno=Le,arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th},
+ Vdb, Bef, St) ->
try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St);
-cg({'catch',Cb,R}, Le, Vdb, Bef, St) ->
+cg(#k_catch{anno=Le,body=Cb,ret=[R]}, Vdb, Bef, St) ->
catch_cg(Cb, R, Le, Vdb, Bef, St);
-cg({set,Var,Con}, Le, Vdb, Bef, St) ->
- set_cg(Var, Con, Le, Vdb, Bef, St);
-cg({return,Rs}, Le, Vdb, Bef, St) -> return_cg(Rs, Le, Vdb, Bef, St);
-cg({break,Bs}, Le, Vdb, Bef, St) -> break_cg(Bs, Le, Vdb, Bef, St);
-cg({guard_break,Bs,N}, Le, Vdb, Bef, St) ->
- guard_break_cg(Bs, N, Le, Vdb, Bef, St);
-cg({need_heap,H}, _Le, _Vdb, Bef, St) ->
+cg(#k_put{anno=Le,arg=Con,ret=Var}, Vdb, Bef, St) ->
+ put_cg(Var, Con, Le, Vdb, Bef, St);
+cg(#k_return{anno=Le,args=Rs}, Vdb, Bef, St) ->
+ return_cg(Rs, Le, Vdb, Bef, St);
+cg(#k_break{anno=Le,args=Bs}, Vdb, Bef, St) ->
+ break_cg(Bs, Le, Vdb, Bef, St);
+cg(#k_guard_break{anno=Le,args=Bs}, Vdb, Bef, St) ->
+ guard_break_cg(Bs, Le, Vdb, Bef, St);
+cg(#cg_need_heap{h=H}, _Vdb, Bef, St) ->
{[{test_heap,H,max_reg(Bef#sr.reg)}],Bef,St}.
%% cg_list([Kexpr], FirstI, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.
-cg_list(Kes, I, Vdb, Bef, St0) ->
+cg_list(Kes, Vdb, Bef, St0) ->
{Keis,{Aft,St1}} =
flatmapfoldl(fun (Ke, {Inta,Sta}) ->
{Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta),
{Keis,{Intb,Stb}}
- end, {Bef,St0}, need_heap(Kes, I)),
+ end, {Bef,St0}, need_heap(Kes)),
{Keis,Aft,St1}.
%% need_heap([Lkexpr], I, St) -> [Lkexpr].
%% Insert need_heap instructions in Kexpr list. Try to be smart and
%% collect them together as much as possible.
-need_heap(Kes0, I) ->
+need_heap(Kes0) ->
{Kes,H} = need_heap_0(reverse(Kes0), 0, []),
%% Prepend need_heap if necessary.
- need_heap_need(I, H) ++ Kes.
+ need_heap_need(H) ++ Kes.
need_heap_0([Ke|Kes], H0, Acc) ->
{Ns,H} = need_heap_1(Ke, H0),
@@ -197,32 +546,56 @@ need_heap_0([Ke|Kes], H0, Acc) ->
need_heap_0([], H, Acc) ->
{Acc,H}.
-need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={set,_,Val}}, H) ->
+need_heap_1(#k_put{arg=#k_binary{}}, H) ->
+ {need_heap_need(H),0};
+need_heap_1(#k_put{arg=#k_map{}}, H) ->
+ {need_heap_need(H),0};
+need_heap_1(#k_put{arg=Val}, H) ->
%% Just pass through adding to needed heap.
{[],H + case Val of
- {cons,_} -> 2;
- {tuple,Es} -> 1 + length(Es);
+ #k_cons{} -> 2;
+ #k_tuple{es=Es} -> 1 + length(Es);
_Other -> 0
end};
-need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={bif,{make_fun,_,_,_,_},_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={bif,bs_init_writable,_As,_Rs},i=I}, H) ->
- {need_heap_need(I, H),0};
-need_heap_1(#l{ke={bif,_Bif,_As,_Rs}}, H) ->
- {[],H};
-need_heap_1(#l{i=I}, H) ->
- {need_heap_need(I, H),0}.
-
-need_heap_need(_I, 0) -> [];
-need_heap_need(I, H) -> [#l{ke={need_heap,H},i=I}].
-
-%% match_cg(Match, [Ret], Le, Vdb, StackReg, State) ->
+need_heap_1(#k_bif{}=Bif, H) ->
+ case is_gc_bif(Bif) of
+ false ->
+ {[],H};
+ true ->
+ {need_heap_need(H),0}
+ end;
+need_heap_1(_Ke, H) ->
+ %% Call or call-like instruction such as set_tuple_element/3.
+ {need_heap_need(H),0}.
+
+need_heap_need(0) -> [];
+need_heap_need(H) -> [#cg_need_heap{h=H}].
+
+%% is_gc_bif(#k_bif{}) -> true|false.
+%% is_gc_bif(Name, Arity) -> true|false.
+%% Determines whether the BIF Name/Arity might do a GC.
+
+is_gc_bif(#k_bif{op=#k_remote{name=#k_atom{val=Name}},args=Args}) ->
+ is_gc_bif(Name, length(Args));
+is_gc_bif(#k_bif{op=#k_internal{}}) ->
+ true.
+
+is_gc_bif(hd, 1) -> false;
+is_gc_bif(tl, 1) -> false;
+is_gc_bif(self, 0) -> false;
+is_gc_bif(node, 0) -> false;
+is_gc_bif(node, 1) -> false;
+is_gc_bif(element, 2) -> false;
+is_gc_bif(get, 1) -> false;
+is_gc_bif(tuple_size, 1) -> false;
+is_gc_bif(map_get, 2) -> false;
+is_gc_bif(is_map_key, 2) -> false;
+is_gc_bif(Bif, Arity) ->
+ not (erl_internal:bool_op(Bif, Arity) orelse
+ erl_internal:new_type_test(Bif, Arity) orelse
+ erl_internal:comp_op(Bif, Arity)).
+
+%% match_cg(Matc, [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
%% Generate code for a match. First save all variables on the stack
%% that are to survive after the match. We leave saved variables in
@@ -243,7 +616,10 @@ match_cg(M, Rs, Le, Vdb, Bef, St0) ->
guard_match_cg(M, Rs, Le, Vdb, Bef, St0) ->
I = Le#l.i,
{B,St1} = new_label(St0),
- #cg{bfail=Fail} = St1,
+ Fail = case St0 of
+ #cg{bfail=0,ultimate_failure=Fail0} -> Fail0;
+ #cg{bfail=Fail0} -> Fail0
+ end,
{Mis,Aft,St2} = match_cg(M, Fail, Bef, St1#cg{break=B}),
%% Update the register descriptors for the return registers.
Reg = guard_match_regs(Aft#sr.reg, Rs),
@@ -251,7 +627,7 @@ guard_match_cg(M, Rs, Le, Vdb, Bef, St0) ->
clear_dead(Aft#sr{reg=Reg}, I, Vdb),
St2#cg{break=St1#cg.break}}.
-guard_match_regs([{I,gbreakvar}|Rs], [{var,V}|Vs]) ->
+guard_match_regs([{I,gbreakvar}|Rs], [#k_var{name=V}|Vs]) ->
[{I,V}|guard_match_regs(Rs, Vs)];
guard_match_regs([R|Rs], Vs) ->
[R|guard_match_regs(Rs, Vs)];
@@ -263,17 +639,14 @@ guard_match_regs([], []) -> [].
%% down as each level which uses this takes its own internal Vdb not
%% the outer one.
-match_cg(Le, Fail, Bef, St) ->
- match_cg(Le#l.ke, Le, Fail, Bef, St).
-
-match_cg({alt,F,S}, _Le, Fail, Bef, St0) ->
+match_cg(#k_alt{first=F,then=S}, Fail, Bef, St0) ->
{Tf,St1} = new_label(St0),
{Fis,Faft,St2} = match_cg(F, Tf, Bef, St1),
{Sis,Saft,St3} = match_cg(S, Fail, Bef, St2),
Aft = sr_merge(Faft, Saft),
{Fis ++ [{label,Tf}] ++ Sis,Aft,St3};
-match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) ->
- ReuseForContext = member(reuse_for_context, Anno) andalso
+match_cg(#k_select{var=#k_var{anno=Vanno,name=Vname}=V,types=Scs0}, Fail, Bef, St) ->
+ ReuseForContext = member(reuse_for_context, Vanno) andalso
find_reg(Vname, Bef#sr.reg) =/= error,
Scs = case ReuseForContext of
false -> Scs0;
@@ -282,10 +655,10 @@ match_cg({select,{var,Vname}=V,Scs0}, #l{a=Anno}, Fail, Bef, St) ->
match_fmf(fun (S, F, Sta) ->
select_cg(S, V, F, Fail, Bef, Sta) end,
Fail, St, Scs);
-match_cg({guard,Gcs}, _Le, Fail, Bef, St) ->
+match_cg(#k_guard{clauses=Gcs}, Fail, Bef, St) ->
match_fmf(fun (G, F, Sta) -> guard_clause_cg(G, F, Bef, Sta) end,
Fail, St, Gcs);
-match_cg({block,Es}, Le, _Fail, Bef, St) ->
+match_cg(#cg_block{anno=Le,es=Es}, _Fail, Bef, St) ->
%% Must clear registers and stack of dead variables.
Int = clear_dead(Bef, Le#l.i, Le#l.vdb),
block_cg(Es, Le, Int, St).
@@ -293,8 +666,8 @@ match_cg({block,Es}, Le, _Fail, Bef, 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
-%% alive at the same time (even though the conservative life time
-%% information calculated by v3_life says so).
+%% alive at the same time (even though the life time information
+%% says so).
%%
%% The easiest way to have those variables share the same register is
%% to rename the variable with the shortest life-span (the match
@@ -305,12 +678,14 @@ match_cg({block,Es}, Le, _Fail, Bef, St) ->
%% We must also remove all information about the match context
%% variable from all life-time information databases (Vdb).
-bsm_rename_ctx([#l{ke={type_clause,binary,
- [#l{ke={val_clause,{binary,{var,Old}},Ke0}}=L2]}}=L1|Cs], New) ->
+bsm_rename_ctx([#k_type_clause{type=k_binary,values=Vcs}=TC|Cs], New) ->
+ [#k_val_clause{val=#k_binary{segs=#k_var{name=Old}}=Bin,
+ body=Ke0}=VC0] = Vcs,
Ke = bsm_rename_ctx(Ke0, Old, New, false),
- [L1#l{ke={type_clause,binary,
- [L2#l{ke={val_clause,{binary,{var,New}},Ke}}]}}|bsm_rename_ctx(Cs, New)];
-bsm_rename_ctx([C|Cs], New) ->
+ VC = VC0#k_val_clause{val=Bin#k_binary{segs=#k_var{name=New}},
+ body=Ke},
+ [TC#k_type_clause{values=[VC]}|bsm_rename_ctx(Cs, New)];
+bsm_rename_ctx([C|Cs], New) ->
[C|bsm_rename_ctx(Cs, New)];
bsm_rename_ctx([], _) -> [].
@@ -320,34 +695,24 @@ bsm_rename_ctx([], _) -> [].
%% only complicatate things to recurse into blocks not in a protected
%% (the match context variable is not live inside them).
-bsm_rename_ctx(#l{ke={select,{var,V},Cs0}}=L, Old, New, InProt) ->
+bsm_rename_ctx(#k_select{var=#k_var{name=V},types=Cs0}=Sel,
+ Old, New, InProt) ->
Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt),
- L#l{ke={select,{var,bsm_rename_var(V, Old, New)},Cs}};
-bsm_rename_ctx(#l{ke={type_clause,Type,Cs0}}=L, Old, New, InProt) ->
+ Sel#k_select{var=#k_var{name=bsm_rename_var(V, Old, New)},types=Cs};
+bsm_rename_ctx(#k_type_clause{values=Cs0}=TC, Old, New, InProt) ->
Cs = bsm_rename_ctx_list(Cs0, Old, New, InProt),
- L#l{ke={type_clause,Type,Cs}};
-bsm_rename_ctx(#l{ke={val_clause,{bin_end,V},Ke0}}=L, Old, New, InProt) ->
- Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,{bin_end,bsm_rename_var(V, Old, New)},Ke}};
-bsm_rename_ctx(#l{ke={val_clause,{bin_seg,V,Sz,U,Type,Fl,Vs},Ke0}}=L,
- Old, New, InProt) ->
- Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,{bin_seg,bsm_rename_var(V, Old, New),Sz,U,Type,Fl,Vs},Ke}};
-bsm_rename_ctx(#l{ke={val_clause,{bin_int,V,Sz,U,Fl,Val,Vs},Ke0}}=L,
- Old, New, InProt) ->
+ TC#k_type_clause{values=Cs};
+bsm_rename_ctx(#k_val_clause{body=Ke0}=VC, Old, New, InProt) ->
Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,{bin_int,bsm_rename_var(V, Old, New),Sz,U,Fl,Val,Vs},Ke}};
-bsm_rename_ctx(#l{ke={val_clause,Val,Ke0}}=L, Old, New, InProt) ->
- Ke = bsm_rename_ctx(Ke0, Old, New, InProt),
- L#l{ke={val_clause,Val,Ke}};
-bsm_rename_ctx(#l{ke={alt,F0,S0}}=L, Old, New, InProt) ->
+ VC#k_val_clause{body=Ke};
+bsm_rename_ctx(#k_alt{first=F0,then=S0}=Alt, Old, New, InProt) ->
F = bsm_rename_ctx(F0, Old, New, InProt),
S = bsm_rename_ctx(S0, Old, New, InProt),
- L#l{ke={alt,F,S}};
-bsm_rename_ctx(#l{ke={guard,Gcs0}}=L, Old, New, InProt) ->
+ Alt#k_alt{first=F,then=S};
+bsm_rename_ctx(#k_guard{clauses=Gcs0}=Guard, Old, New, InProt) ->
Gcs = bsm_rename_ctx_list(Gcs0, Old, New, InProt),
- L#l{ke={guard,Gcs}};
-bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) ->
+ Guard#k_guard{clauses=Gcs};
+bsm_rename_ctx(#k_guard_clause{guard=G0,body=B0}=GC, Old, New, InProt) ->
G = bsm_rename_ctx(G0, Old, New, InProt),
B = bsm_rename_ctx(B0, Old, New, InProt),
%% A guard clause may cause unsaved variables to be saved on the stack.
@@ -355,49 +720,45 @@ bsm_rename_ctx(#l{ke={guard_clause,G0,B0}}=L, Old, New, InProt) ->
%% same register), it is neither in the stack nor register descriptor
%% lists and we would crash when we didn't find it unless we remove
%% it from the database.
- bsm_forget_var(L#l{ke={guard_clause,G,B}}, Old);
-bsm_rename_ctx(#l{ke={protected,Ts0,Rs}}=L, Old, New, _InProt) ->
+ bsm_forget_var(GC#k_guard_clause{guard=G,body=B}, Old);
+bsm_rename_ctx(#k_protected{arg=Ts0}=Prot, Old, New, _InProt) ->
InProt = true,
Ts = bsm_rename_ctx_list(Ts0, Old, New, InProt),
- bsm_forget_var(L#l{ke={protected,Ts,Rs}}, Old);
-bsm_rename_ctx(#l{ke={match,Ms0,Rs}}=L, Old, New, InProt) ->
- Ms = bsm_rename_ctx(Ms0, Old, New, InProt),
- L#l{ke={match,Ms,Rs}};
-bsm_rename_ctx(#l{ke={guard_match,Ms0,Rs}}=L, Old, New, InProt) ->
+ bsm_forget_var(Prot#k_protected{arg=Ts}, Old);
+bsm_rename_ctx(#k_guard_match{body=Ms0}=Match, Old, New, InProt) ->
Ms = bsm_rename_ctx(Ms0, Old, New, InProt),
- L#l{ke={guard_match,Ms,Rs}};
-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) ->
+ Match#k_guard_match{body=Ms};
+bsm_rename_ctx(#k_test{}=Test, _, _, _) -> Test;
+bsm_rename_ctx(#k_bif{}=Bif, _, _, _) -> Bif;
+bsm_rename_ctx(#k_put{}=Put, _, _, _) -> Put;
+bsm_rename_ctx(#k_call{}=Call, _, _, _) -> Call;
+bsm_rename_ctx(#cg_block{}=Block, Old, _, false) ->
%% This block is not inside a protected. The match context variable cannot
%% possibly be live inside the block.
- bsm_forget_var(L, Old);
-bsm_rename_ctx(#l{ke={block,Bl0}}=L, Old, New, true) ->
+ bsm_forget_var(Block, Old);
+bsm_rename_ctx(#cg_block{es=Es0}=Block, Old, New, true) ->
%% A block in a protected. We must recursively rename the variable
%% inside the block.
- Bl = bsm_rename_ctx_list(Bl0, Old, New, true),
- bsm_forget_var(L#l{ke={block,Bl}}, Old);
-bsm_rename_ctx(#l{ke={guard_break,Bs,Locked0}}=L0, Old, _New, _InProt) ->
- Locked = Locked0 -- [Old],
- L = L0#l{ke={guard_break,Bs,Locked}},
- bsm_forget_var(L, Old).
+ Es = bsm_rename_ctx_list(Es0, Old, New, true),
+ bsm_forget_var(Block#cg_block{es=Es}, Old);
+bsm_rename_ctx(#k_guard_break{}=Break, Old, _New, _InProt) ->
+ bsm_forget_var(Break, Old).
bsm_rename_ctx_list([C|Cs], Old, New, InProt) ->
[bsm_rename_ctx(C, Old, New, InProt)|
bsm_rename_ctx_list(Cs, Old, New, InProt)];
bsm_rename_ctx_list([], _, _, _) -> [].
-
+
bsm_rename_var(Old, Old, New) -> New;
bsm_rename_var(V, _, _) -> V.
%% bsm_forget_var(#l{}, Variable) -> #l{}
%% Remove a variable from the variable life-time database.
-bsm_forget_var(#l{vdb=Vdb}=L, V) ->
- L#l{vdb=keydelete(V, 1, Vdb)}.
+bsm_forget_var(Ke, V) ->
+ #l{vdb=Vdb} = L0 = get_kanno(Ke),
+ L = L0#l{vdb=keydelete(V, 1, Vdb)},
+ set_kanno(Ke, L).
%% block_cg([Kexpr], Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}.
%% block_cg([Kexpr], Le, StackReg, St) -> {[Ainstr],StackReg,St}.
@@ -406,158 +767,227 @@ block_cg(Es, Le, _Vdb, Bef, St) ->
block_cg(Es, Le, Bef, St).
block_cg(Es, Le, Bef, #cg{is_top_block=false}=St) ->
- cg_block(Es, Le#l.i, Le#l.vdb, Bef, St);
-block_cg(Es, Le, Bef, St0) ->
- {Is0,Aft,St} = cg_block(Es, Le#l.i, Le#l.vdb, Bef,
- St0#cg{is_top_block=false,need_frame=false}),
- Is = top_level_block(Is0, Aft, max_reg(Bef#sr.reg), St),
- {Is,Aft,St#cg{is_top_block=true}}.
-
-cg_block([], _I, _Vdb, Bef, St0) ->
+ cg_block(Es, Le#l.vdb, Bef, St);
+block_cg(Es, Le, Bef, #cg{is_top_block=true}=St0) ->
+ %% No stack frame has been established yet. Do we need one?
+ case need_stackframe(Es) of
+ true ->
+ %% We need a stack frame. Generate the code and add the
+ %% code for creating and deallocating the stack frame.
+ {Is0,Aft,St} = cg_block(Es, Le#l.vdb, Bef,
+ St0#cg{is_top_block=false,need_frame=false}),
+ Is = top_level_block(Is0, Aft, max_reg(Bef#sr.reg), St),
+ {Is,Aft,St#cg{is_top_block=true}};
+ false ->
+ %% This sequence of instructions ending in a #k_match{} (a
+ %% 'case' or 'if') in the Erlang code does not need a
+ %% stack frame yet. Delay the creation (if a stack frame
+ %% is needed at all, it will be created inside the
+ %% #k_match{}).
+ cg_list(Es, Le#l.vdb, Bef, St0)
+ end.
+
+%% need_stackframe([Kexpr]) -> true|false.
+%% Does this list of instructions need a stack frame?
+%%
+%% A sequence of instructions that don't clobber the X registers
+%% followed by a single #k_match{} doesn't need a stack frame.
+
+need_stackframe([H|T]) ->
+ case H of
+ #k_bif{op=#k_internal{}} -> true;
+ #k_put{arg=#k_binary{}} -> true;
+ #k_bif{} -> need_stackframe(T);
+ #k_put{} -> need_stackframe(T);
+ #k_guard_match{} -> need_stackframe(T);
+ #k_match{} when T =:= [] -> false;
+ _ -> true
+ end;
+need_stackframe([]) -> false.
+
+cg_block([], _Vdb, Bef, St0) ->
{[],Bef,St0};
-cg_block(Kes0, I, Vdb, Bef, St0) ->
+cg_block(Kes0, Vdb, Bef, St0) ->
{Kes2,Int1,St1} =
case basic_block(Kes0) of
{Kes1,LastI,Args,Rest} ->
- Ke = hd(Kes1),
- Fb = Ke#l.i,
- cg_basic_block(Kes1, Fb, LastI, Args, Vdb, Bef, St0);
+ cg_basic_block(Kes1, LastI, Args, Vdb, Bef, St0);
{Kes1,Rest} ->
- cg_list(Kes1, I, Vdb, Bef, St0)
+ cg_list(Kes1, Vdb, Bef, St0)
end,
- {Kes3,Int2,St2} = cg_block(Rest, I, Vdb, Int1, St1),
+ {Kes3,Int2,St2} = cg_block(Rest, Vdb, Int1, St1),
{Kes2 ++ Kes3,Int2,St2}.
basic_block(Kes) -> basic_block(Kes, []).
-basic_block([Le|Les], Acc) ->
- case collect_block(Le#l.ke) of
- include -> basic_block(Les, [Le|Acc]);
+basic_block([Ke|Kes], Acc) ->
+ case collect_block(Ke) of
+ include -> basic_block(Kes, [Ke|Acc]);
{block_end,As} ->
case Acc of
[] ->
- %% If the basic block does not contain any set instructions,
+ %% If the basic block does not contain any #k_put{} instructions,
%% it serves no useful purpose to do basic block optimizations.
- {[Le],Les};
+ {[Ke],Kes};
_ ->
- {reverse(Acc, [Le]),Le#l.i,As,Les}
+ #l{i=I} = get_kanno(Ke),
+ {reverse(Acc, [Ke]),I,As,Kes}
end;
- no_block -> {reverse(Acc, [Le]),Les}
+ no_block -> {reverse(Acc, [Ke]),Kes}
end.
-%% sets that may garbage collect are not allowed in basic blocks.
-
-collect_block({set,_,{binary,_}}) -> no_block;
-collect_block({set,_,{map,_,_,_}}) -> no_block;
-collect_block({set,_,_}) -> include;
-collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]};
-collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)};
-collect_block({enter,{var,_}=Var,As})-> {block_end,As++[Var]};
-collect_block({enter,Func,As}) -> {block_end,As++func_vars(Func)};
-collect_block({return,Rs}) -> {block_end,Rs};
-collect_block({break,Bs}) -> {block_end,Bs};
-collect_block(_) -> no_block.
-
-func_vars({remote,M,F}) when element(1, M) =:= var;
- element(1, F) =:= var ->
+collect_block(#k_put{arg=Arg}) ->
+ %% #k_put{} instructions that may garbage collect are not allowed
+ %% in basic blocks.
+ case Arg of
+ #k_binary{} -> no_block;
+ #k_map{} -> no_block;
+ _ -> include
+ end;
+collect_block(#k_call{op=Func,args=As}) ->
+ {block_end,As++func_vars(Func)};
+collect_block(#k_enter{op=Func,args=As}) ->
+ {block_end,As++func_vars(Func)};
+collect_block(#k_return{args=Rs}) ->
+ {block_end,Rs};
+collect_block(#k_break{args=Bs}) ->
+ {block_end,Bs};
+collect_block(_) -> no_block.
+
+func_vars(#k_var{}=Var) ->
+ [Var];
+func_vars(#k_remote{mod=M,name=F})
+ when is_record(M, k_var); is_record(F, k_var) ->
[M,F];
func_vars(_) -> [].
-%% cg_basic_block([Kexpr], FirstI, LastI, As, Vdb, StackReg, State) ->
+%% cg_basic_block([Kexpr], FirstI, LastI, Arguments, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-
-cg_basic_block(Kes, Fb, Lf, As, Vdb, Bef, St0) ->
- Res = make_reservation(As, 0),
- Regs0 = reserve(Res, Bef#sr.reg, Bef#sr.stk),
- Stk = extend_stack(Bef, Lf, Lf+1, Vdb),
- Int0 = Bef#sr{reg=Regs0,stk=Stk,res=Res},
- X0_v0 = x0_vars(As, Fb, Lf, Vdb),
- {Keis,{Aft,_,St1}} =
+%%
+%% Do a specialized code generation for a basic block of #put{}
+%% instructions (that don't do any garbage collection) followed by a
+%% call, break, or return.
+%%
+%% 'Arguments' is a list of the variables that must be loaded into
+%% consecutive X registers before the last instruction in the block.
+%% The point of this specialized code generation is to try put the
+%% all of the variables in 'Arguments' into the correct X register
+%% to begin with, instead of putting them into the first available
+%% X register and having to move them to the correct X register
+%% later.
+%%
+%% To achieve that, we attempt to reserve the X registers that the
+%% variables in 'Arguments' will need to be in when the block ends.
+%%
+%% To make it more likely that reservations will be successful, we
+%% will try to save variables that need to be saved to the stack as
+%% early as possible (if an X register needed by a variable in
+%% Arguments is occupied by another variable, the value in the
+%% X register can be evicted if it is saved on the stack).
+%%
+%% We will take care not to increase the size of stack frame compared
+%% to what the standard code generator would have done (that is, to
+%% save all X registers at the last possible moment). We will do that
+%% by extending the stack frame to the minimal size needed to save
+%% all that needs to be saved using extend_stack/4, and use
+%% save_carefully/4 during code generation to only save the variables
+%% that can be saved without growing the stack frame.
+
+cg_basic_block(Kes, Lf, As, Vdb, Bef, St0) ->
+ Int0 = reserve_arg_regs(As, Bef),
+ Int = extend_stack(Int0, Lf, Lf+1, Vdb),
+ {Keis,{Aft,St1}} =
flatmapfoldl(fun(Ke, St) -> cg_basic_block(Ke, St, Lf, Vdb) end,
- {Int0,X0_v0,St0}, need_heap(Kes, Fb)),
+ {Int,St0}, need_heap(Kes)),
{Keis,Aft,St1}.
-cg_basic_block(#l{ke={need_heap,_}}=Ke, {Inta,X0v,Sta}, _Lf, Vdb) ->
- {Keis,Intb,Stb} = cg(Ke, Vdb, Inta, Sta),
- {Keis, {Intb,X0v,Stb}};
-cg_basic_block(Ke, {Inta,X0_v1,Sta}, Lf, Vdb) ->
- {Sis,Intb} = save_carefully(Inta, Ke#l.i, Lf+1, Vdb),
- {X0_v2,Intc} = allocate_x0(X0_v1, Ke#l.i, Intb),
- Intd = reserve(Intc),
- {Keis,Inte,Stb} = cg(Ke, Vdb, Intd, Sta),
- {Sis ++ Keis, {Inte,X0_v2,Stb}}.
-
-make_reservation([], _) -> [];
-make_reservation([{var,V}|As], I) -> [{I,V}|make_reservation(As, I+1)];
-make_reservation([A|As], I) -> [{I,A}|make_reservation(As, I+1)].
-
-reserve(Sr) -> Sr#sr{reg=reserve(Sr#sr.res, Sr#sr.reg, Sr#sr.stk)}.
-
-reserve([{I,V}|Rs], [free|Regs], Stk) -> [{reserved,I,V}|reserve(Rs, Regs, Stk)];
-reserve([{I,V}|Rs], [{I,V}|Regs], Stk) -> [{I,V}|reserve(Rs, Regs, Stk)];
-reserve([{I,V}|Rs], [{I,Var}|Regs], Stk) ->
+cg_basic_block(#cg_need_heap{}=Ke, {Bef,St0}, _Lf, Vdb) ->
+ {Keis,Aft,St1} = cg(Ke, Vdb, Bef, St0),
+ {Keis,{Aft,St1}};
+cg_basic_block(Ke, {Bef,St0}, Lf, Vdb) ->
+ #l{i=I} = get_kanno(Ke),
+
+ %% Save all we can to increase the possibility that reserving
+ %% registers will succeed.
+ {Sis,Int0} = save_carefully(Bef, I, Lf+1, Vdb),
+ Int1 = reserve(Int0),
+ {Keis,Aft,St1} = cg(Ke, Vdb, Int1, St0),
+ {Sis ++ Keis,{Aft,St1}}.
+
+%% reserve_arg_regs([Argument], Bef) -> Aft.
+%% Try to reserve the X registers for all arguments. All registers
+%% that we wish to reserve will be saved in Bef#sr.res.
+
+reserve_arg_regs(As, Bef) ->
+ Res = reserve_arg_regs_1(As, 0),
+ reserve(Bef#sr{res=Res}).
+
+reserve_arg_regs_1([#k_var{name=V}|As], I) ->
+ [{I,V}|reserve_arg_regs_1(As, I+1)];
+reserve_arg_regs_1([A|As], I) ->
+ [{I,A}|reserve_arg_regs_1(As, I+1)];
+reserve_arg_regs_1([], _) -> [].
+
+%% reserve(Bef) -> Aft.
+%% Try to reserve more registers. The registers we wish to reserve
+%% are found in Bef#sr.res.
+
+reserve(#sr{reg=Regs,stk=Stk,res=Res}=Sr) ->
+ Sr#sr{reg=reserve_1(Res, Regs, Stk)}.
+
+reserve_1([{I,V}|Rs], [free|Regs], Stk) ->
+ [{reserved,I,V}|reserve_1(Rs, Regs, Stk)];
+reserve_1([{I,V}|Rs], [{I,V}|Regs], Stk) ->
+ [{I,V}|reserve_1(Rs, Regs, Stk)];
+reserve_1([{I,V}|Rs], [{I,Var}|Regs], Stk) ->
case on_stack(Var, Stk) of
- true -> [{reserved,I,V}|reserve(Rs, Regs, Stk)];
- false -> [{I,Var}|reserve(Rs, Regs, Stk)]
+ true -> [{reserved,I,V}|reserve_1(Rs, Regs, Stk)];
+ false -> [{I,Var}|reserve_1(Rs, Regs, Stk)]
end;
-reserve([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) ->
- [{reserved,I,V}|reserve(Rs, Regs, Stk)];
-%reserve([{I,V}|Rs], [Other|Regs], Stk) -> [Other|reserve(Rs, Regs, Stk)];
-reserve([{I,V}|Rs], [], Stk) -> [{reserved,I,V}|reserve(Rs, [], Stk)];
-reserve([], Regs, _) -> Regs.
-
-extend_stack(Bef, Fb, Lf, Vdb) ->
- Stk0 = clear_dead_stk(Bef#sr.stk, Fb, Vdb),
- Saves = [V || {V,F,L} <- Vdb,
- F < Fb,
- L >= Lf,
- not on_stack(V, Stk0)],
- Stk1 = foldl(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves),
- Bef#sr.stk ++ lists:duplicate(length(Stk1) - length(Bef#sr.stk), free).
-
-save_carefully(Bef, Fb, Lf, Vdb) ->
- Stk = Bef#sr.stk,
- %% New variables that are in use but not on stack.
- New = [VFL || {V,F,L} = VFL <- Vdb,
- F < Fb,
- L >= Lf,
- not on_stack(V, Stk)],
- Saves = [V || {V,_,_} <- keysort(2, New)],
- save_carefully(Saves, Bef, []).
-
-save_carefully([], Bef, Acc) -> {reverse(Acc),Bef};
-save_carefully([V|Vs], Bef, Acc) ->
- case put_stack_carefully(V, Bef#sr.stk) of
- error -> {reverse(Acc),Bef};
+reserve_1([{I,V}|Rs], [{reserved,I,_}|Regs], Stk) ->
+ [{reserved,I,V}|reserve_1(Rs, Regs, Stk)];
+reserve_1([{I,V}|Rs], [], Stk) ->
+ [{reserved,I,V}|reserve_1(Rs, [], Stk)];
+reserve_1([], Regs, _) -> Regs.
+
+%% extend_stack(Bef, FirstBefore, LastFrom, Vdb) -> Aft.
+%% Extend the stack enough to fit all variables alive past LastFrom
+%% and not already on the stack.
+
+extend_stack(#sr{stk=Stk0}=Bef, Fb, Lf, Vdb) ->
+ Stk1 = clear_dead_stk(Stk0, Fb, Vdb),
+ New = new_not_on_stack(Stk1, Fb, Lf, Vdb),
+ Stk2 = foldl(fun ({V,_,_}, Stk) -> put_stack(V, Stk) end, Stk1, New),
+ Stk = Stk0 ++ lists:duplicate(length(Stk2) - length(Stk0), free),
+ Bef#sr{stk=Stk}.
+
+%% save_carefully(Bef, FirstBefore, LastFrom, Vdb) -> {[SaveVar],Aft}.
+%% Save variables which are used past current point and which are not
+%% already on the stack, but only if the variables can be saved without
+%% growing the stack frame.
+
+save_carefully(#sr{stk=Stk}=Bef, Fb, Lf, Vdb) ->
+ New0 = new_not_on_stack(Stk, Fb, Lf, Vdb),
+ New = keysort(2, New0),
+ save_carefully_1(New, Bef, []).
+
+save_carefully_1([{V,_,_}|Vs], #sr{reg=Regs,stk=Stk0}=Bef, Acc) ->
+ case put_stack_carefully(V, Stk0) of
+ error ->
+ {reverse(Acc),Bef};
Stk1 ->
- SrcReg = fetch_reg(V, Bef#sr.reg),
+ SrcReg = fetch_reg(V, Regs),
Move = {move,SrcReg,fetch_stack(V, Stk1)},
{x,_} = SrcReg, %Assertion - must be X register.
- save_carefully(Vs, Bef#sr{stk=Stk1}, [Move|Acc])
- end.
+ save_carefully_1(Vs, Bef#sr{stk=Stk1}, [Move|Acc])
+ end;
+save_carefully_1([], Bef, Acc) ->
+ {reverse(Acc),Bef}.
-x0_vars([], _Fb, _Lf, _Vdb) -> [];
-x0_vars([{var,V}|_], Fb, _Lf, Vdb) ->
- {V,F,_L} = VFL = vdb_find(V, Vdb),
- x0_vars1([VFL], Fb, F, Vdb);
-x0_vars([X0|_], Fb, Lf, Vdb) ->
- x0_vars1([{X0,Lf,Lf}], Fb, Lf, Vdb).
-
-x0_vars1(X0, Fb, Xf, Vdb) ->
- Vs0 = [VFL || {_V,F,L}=VFL <- Vdb,
- F >= Fb,
- L < Xf],
- Vs1 = keysort(3, Vs0),
- keysort(2, X0++Vs1).
-
-allocate_x0([], _, Bef) -> {[],Bef#sr{res=[]}};
-allocate_x0([{_,_,L}|Vs], I, Bef) when L =< I ->
- allocate_x0(Vs, I, Bef);
-allocate_x0([{V,_F,_L}=VFL|Vs], _, Bef) ->
- {[VFL|Vs],Bef#sr{res=reserve_x0(V, Bef#sr.res)}}.
-
-reserve_x0(V, [_|Res]) -> [{0,V}|Res];
-reserve_x0(V, []) -> [{0,V}].
+%% top_level_block([Instruction], Bef, MaxRegs, St) -> [Instruction].
+%% For the top-level block, allocate a stack frame a necessary,
+%% adjust Y register numbering and instructions that return
+%% from the function.
top_level_block(Keis, #sr{stk=[]}, _MaxRegs, #cg{need_frame=false}) ->
Keis;
@@ -639,21 +1069,27 @@ turn_yreg(Other, _MaxY) ->
%% wrong. These are different as in the second case there is no need
%% to try the next type, it will always fail.
-select_cg(#l{ke={type_clause,cons,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(#k_type_clause{type=Type,values=Vs}, Var, Tf, Vf, Bef, St) ->
+ #k_var{name=V} = Var,
+ select_cg(Type, Vs, V, Tf, Vf, Bef, St).
+
+select_cg(k_cons, [S], V, Tf, Vf, Bef, St) ->
select_cons(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,nil,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(k_nil, [S], V, Tf, Vf, Bef, St) ->
select_nil(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,binary,[S]}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(k_binary, [S], V, Tf, Vf, Bef, St) ->
select_binary(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,bin_seg,S}}, {var,V}, Tf, _Vf, Bef, St) ->
+select_cg(k_bin_seg, S, V, Tf, _Vf, Bef, St) ->
select_bin_segs(S, V, Tf, Bef, St);
-select_cg(#l{ke={type_clause,bin_int,S}}, {var,V}, Tf, _Vf, Bef, St) ->
+select_cg(k_bin_int, S, V, Tf, _Vf, Bef, St) ->
select_bin_segs(S, V, Tf, Bef, St);
-select_cg(#l{ke={type_clause,bin_end,[S]}}, {var,V}, Tf, _Vf, Bef, St) ->
+select_cg(k_bin_end, [S], V, Tf, _Vf, Bef, St) ->
select_bin_end(S, V, Tf, Bef, St);
-select_cg(#l{ke={type_clause,map,S}}, {var,V}, Tf, Vf, Bef, St) ->
+select_cg(k_map, S, V, Tf, Vf, Bef, St) ->
select_map(S, V, Tf, Vf, Bef, St);
-select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) ->
+select_cg(k_literal, S, V, Tf, Vf, Bef, St) ->
+ select_literal(S, V, Tf, Vf, Bef, St);
+select_cg(Type, Scs, V, Tf, Vf, Bef, St0) ->
{Vis,{Aft,St1}} =
mapfoldl(fun (S, {Int,Sta}) ->
{Val,Is,Inta,Stb} = select_val(S, V, Vf, Bef, Sta),
@@ -663,22 +1099,29 @@ select_cg(#l{ke={type_clause,Type,Scs}}, {var,V}, Tf, Vf, Bef, St0) ->
{Vls,Sis,St2} = select_labels(OptVls, St1, [], []),
{select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}.
-select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
+select_val_cg(k_tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
[{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis];
-select_val_cg(tuple, R, Vls, Tf, Vf, Sis) ->
+select_val_cg(k_tuple, R, Vls, Tf, Vf, Sis) ->
[{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
- [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis];
+ [{test,is_eq_exact,{f,Fail},[R,{type(Type),Val}]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
[{test,select_type_test(Type),{f,Tf},[R]},
- {test,is_eq_exact,{f,Vf},[R,{Type,Val}]}|Sis];
+ {test,is_eq_exact,{f,Vf},[R,{type(Type),Val}]}|Sis];
select_val_cg(Type, R, Vls0, Tf, Vf, Sis) ->
- Vls1 = [case Value of {f,_Lbl} -> Value; _ -> {Type,Value} end || Value <- Vls0],
+ Vls1 = [case Value of
+ {f,_Lbl} -> Value;
+ _ -> {type(Type),Value}
+ end || Value <- Vls0],
[{test,select_type_test(Type),{f,Tf},[R]}, {select_val,R,{f,Vf},{list,Vls1}}|Sis].
-
-select_type_test(integer) -> is_integer;
-select_type_test(atom) -> is_atom;
-select_type_test(float) -> is_float.
+
+type(k_atom) -> atom;
+type(k_float) -> float;
+type(k_int) -> integer.
+
+select_type_test(k_int) -> is_integer;
+select_type_test(k_atom) -> is_atom;
+select_type_test(k_float) -> is_float.
combine([{Is,Vs1}, {Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]);
combine([V|Vis]) -> [V|combine(Vis)];
@@ -694,36 +1137,50 @@ add_vls([V|Vs], Lbl, Acc) ->
add_vls(Vs, Lbl, [V, {f,Lbl}|Acc]);
add_vls([], _, Acc) -> Acc.
-select_cons(#l{ke={val_clause,{cons,Es},B},i=I,vdb=Vdb}, V, Tf, Vf, Bef, St0) ->
+select_literal(S, V, Tf, Vf, Bef, St) ->
+ Reg = fetch_var(V, Bef),
+ F = fun(ValClause, Fail, St0) ->
+ {Val,Is,Aft,St1} = select_val(ValClause, V, Vf, Bef, St0),
+ Test = {test,is_eq_exact,{f,Fail},[Reg,{literal,Val}]},
+ {[Test|Is],Aft,St1}
+ end,
+ match_fmf(F, Tf, St, S).
+
+select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B,anno=#l{i=I,vdb=Vdb}},
+ V, Tf, Vf, Bef, St0) ->
+ Es = [Hd,Tl],
{Eis,Int,St1} = select_extract_cons(V, Es, I, Vdb, Bef, St0),
{Bis,Aft,St2} = match_cg(B, Vf, Int, St1),
{[{test,is_nonempty_list,{f,Tf},[fetch_var(V, Bef)]}] ++ Eis ++ Bis,Aft,St2}.
-select_nil(#l{ke={val_clause,nil,B}}, V, Tf, Vf, Bef, St0) ->
+select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, Bef, St0) ->
{Bis,Aft,St1} = match_cg(B, Vf, Bef, St0),
{[{test,is_nil,{f,Tf},[fetch_var(V, Bef)]}] ++ Bis,Aft,St1}.
-select_binary(#l{ke={val_clause,{binary,{var,V}},B},i=I,vdb=Vdb},
- V, Tf, Vf, Bef, St0) ->
+select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=V}},body=B,
+ anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) ->
+ #cg{ctx=OldCtx} = St0,
Int0 = clear_dead(Bef#sr{reg=Bef#sr.reg}, I, Vdb),
- {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0),
+ {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=V}),
CtxReg = fetch_var(V, Int0),
Live = max_reg(Bef#sr.reg),
- Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg},
+ Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,{context,V}],CtxReg},
{bs_save2,CtxReg,{V,V}}|Bis0],
Bis = finish_select_binary(Bis1),
- {Bis,Aft,St1};
-select_binary(#l{ke={val_clause,{binary,{var,Ivar}},B},i=I,vdb=Vdb},
- V, Tf, Vf, Bef, St0) ->
+ {Bis,Aft,St1#cg{ctx=OldCtx}};
+select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ivar}},body=B,
+ anno=#l{i=I,vdb=Vdb}}, V, Tf, Vf, Bef, St0) ->
+ #cg{ctx=OldCtx} = St0,
Regs = put_reg(Ivar, Bef#sr.reg),
Int0 = clear_dead(Bef#sr{reg=Regs}, I, Vdb),
- {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0),
+ {Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=Ivar}),
CtxReg = fetch_var(Ivar, Int0),
Live = max_reg(Bef#sr.reg),
- Bis1 = [{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg},
+ Bis1 = [{test,bs_start_match2,{f,Tf},Live,
+ [fetch_var(V, Bef),{context,Ivar}],CtxReg},
{bs_save2,CtxReg,{Ivar,Ivar}}|Bis0],
Bis = finish_select_binary(Bis1),
- {Bis,Aft,St1}.
+ {Bis,Aft,St1#cg{ctx=OldCtx}}.
finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) ->
[I|finish_select_binary(Is)];
@@ -745,9 +1202,16 @@ select_bin_segs(Scs, Ivar, Tf, Bef, St) ->
select_bin_seg(S, Ivar, Fail, Bef, Sta) end,
Tf, St, Scs).
-select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a=A},
- Ivar, Fail, Bef, St0) ->
+select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T,
+ seg=Seg,flags=Fs0,next=Next},
+ body=B,
+ anno=#l{i=I,vdb=Vdb,a=A}}, Ivar, Fail, Bef, St0) ->
+ Ctx = St0#cg.ctx,
Fs = [{anno,A}|Fs0],
+ Es = case Next of
+ [] -> [Seg];
+ _ -> [Seg,Next]
+ end,
{Mis,Int,St1} = select_extract_bin(Es, Size, U, T, Fs, Fail,
I, Vdb, Bef, Ctx, B, St0),
{Bis,Aft,St2} = match_cg(B, Fail, Int, St1),
@@ -760,9 +1224,12 @@ select_bin_seg(#l{ke={val_clause,{bin_seg,Ctx,Size,U,T,Fs0,Es},B},i=I,vdb=Vdb,a=
[{bs_restore2,CtxReg,{Ctx,Ivar}}|Mis++Bis]
end,
{Is,Aft,St2};
-select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb},
- Ivar, Fail, Bef, St0) ->
- {Mis,Int,St1} = select_extract_int(Es, Val, Sz, U, Fs, Fail,
+select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs,
+ val=Val,next=Next},
+ body=B,
+ anno=#l{i=I,vdb=Vdb}}, Ivar, Fail, Bef, St0) ->
+ Ctx = St0#cg.ctx,
+ {Mis,Int,St1} = select_extract_int(Next, Val, Sz, U, Fs, Fail,
I, Vdb, Bef, Ctx, St0),
{Bis,Aft,St2} = match_cg(B, Fail, Int, St1),
CtxReg = fetch_var(Ctx, Bef),
@@ -783,7 +1250,7 @@ select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb},
end,
{[{bs_restore2,CtxReg,{Ctx,Ivar}}|Is],Aft,St2}.
-select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf,
+select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf,
I, Vdb, Bef, Ctx, St) ->
Bits = U*Sz,
Bin = case member(big, Fs) of
@@ -804,7 +1271,7 @@ select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf,
end,
{Is,clear_dead(Bef, I, Vdb),St}.
-select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf,
+select_extract_bin([#k_var{name=Hd},#k_var{name=Tl}], Size0, Unit, Type, Flags, Vf,
I, Vdb, Bef, Ctx, _Body, St) ->
SizeReg = get_bin_size_reg(Size0, Bef),
{Es,Aft} =
@@ -827,11 +1294,11 @@ select_extract_bin([{var,Hd},{var,Tl}], Size0, Unit, Type, Flags, Vf,
{bs_save2,CtxReg,{Ctx,Tl}}],Int1}
end,
{Es,clear_dead(Aft, I, Vdb),St};
-select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf,
+select_extract_bin([#k_var{name=Hd}], Size, Unit, binary, Flags, Vf,
I, Vdb, Bef, Ctx, Body, St) ->
%% Match the last segment of a binary. We KNOW that the size
%% must be 'all'.
- Size = {atom,all}, %Assertion.
+ #k_atom{val=all} = Size, %Assertion.
{Es,Aft} =
case vdb_find(Hd, Vdb) of
{_,_,Lhd} when Lhd =< I ->
@@ -856,7 +1323,7 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf,
Name = bs_get_binary2,
Live = max_reg(Bef#sr.reg),
{[{test,Name,{f,Vf},Live,
- [CtxReg,Size,Unit,{field_flags,Flags}],Rhd}],
+ [CtxReg,atomic(Size),Unit,{field_flags,Flags}],Rhd}],
Int1};
true ->
%% Since the matching context will not be used again,
@@ -871,36 +1338,42 @@ select_extract_bin([{var,Hd}], Size, Unit, binary, Flags, Vf,
Name = bs_get_binary2,
Live = max_reg(Int1#sr.reg),
{[{test,Name,{f,Vf},Live,
- [CtxReg,Size,Unit,{field_flags,Flags}],CtxReg}],
+ [CtxReg,atomic(Size),Unit,{field_flags,Flags}],CtxReg}],
Int1}
end
end,
{Es,clear_dead(Aft, I, Vdb),St}.
%% is_context_unused(Ke) -> true | false
-%% Simple heurististic to determine whether the code that follows will
-%% use the current matching context again. (The information of liveness
-%% calculcated by v3_life is too conservative to be useful for this purpose.)
-%% 'true' means that the code that follows will definitely not use the context
-%% again (because it is a block, not guard or matching code); 'false' that we
-%% are not sure (there is either a guard, or more matching, either which may
-%% reference the context again).
-
-is_context_unused(#l{ke=Ke}) -> is_context_unused(Ke);
-is_context_unused({block,_}) -> true;
-is_context_unused(_) -> false.
-
-select_bin_end(#l{ke={val_clause,{bin_end,Ctx},B}},
- Ivar, Tf, Bef, St0) ->
+%% Simple heurististic to determine whether the code that follows
+%% will use the current matching context again. (The liveness
+%% information is too conservative to be useful for this purpose.)
+%% 'true' means that the code that follows will definitely not use
+%% the context again (because it is a block, not guard or matching
+%% code); 'false' that we are not sure (there could be more
+%% matching).
+
+is_context_unused(#k_alt{then=Then}) ->
+ %% #k_alt{} can be used for different purposes. If the Then part
+ %% is a block, it means that matching has finished and is used for a guard
+ %% to choose between the matched clauses.
+ is_context_unused(Then);
+is_context_unused(#cg_block{}) ->
+ true;
+is_context_unused(_) ->
+ false.
+
+select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Ivar, Tf, Bef, St0) ->
+ Ctx = St0#cg.ctx,
{Bis,Aft,St2} = match_cg(B, Tf, Bef, St0),
CtxReg = fetch_var(Ctx, Bef),
{[{bs_restore2,CtxReg,{Ctx,Ivar}},
{test,bs_test_tail2,{f,Tf},[CtxReg,0]}|Bis],Aft,St2}.
-get_bin_size_reg({var,V}, Bef) ->
+get_bin_size_reg(#k_var{name=V}, Bef) ->
fetch_var(V, Bef);
get_bin_size_reg(Literal, _Bef) ->
- Literal.
+ atomic(Literal).
build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags, Rhd) ->
{Format,Name} = case Type of
@@ -934,11 +1407,18 @@ build_skip_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags) ->
{test,Name,{f,Vf},[CtxReg,Live,{field_flags,Flags}]}
end.
-select_val(#l{ke={val_clause,{tuple,Es},B},i=I,vdb=Vdb}, V, Vf, Bef, St0) ->
+select_val(#k_val_clause{val=#k_tuple{es=Es},body=B,anno=#l{i=I,vdb=Vdb}},
+ V, Vf, Bef, St0) ->
{Eis,Int,St1} = select_extract_tuple(V, Es, I, Vdb, Bef, St0),
{Bis,Aft,St2} = match_cg(B, Vf, Int, St1),
{length(Es),Eis ++ Bis,Aft,St2};
-select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) ->
+select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, Bef, St0) ->
+ Val = case Val0 of
+ #k_atom{val=Lit} -> Lit;
+ #k_float{val=Lit} -> Lit;
+ #k_int{val=Lit} -> Lit;
+ #k_literal{val=Lit} -> Lit
+ end,
{Bis,Aft,St1} = match_cg(B, Vf, Bef, St0),
{Val,Bis,Aft,St1}.
@@ -947,7 +1427,7 @@ select_val(#l{ke={val_clause,{_,Val},B}}, _V, Vf, Bef, St0) ->
%% Extract tuple elements, but only if they do not immediately die.
select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
- F = fun ({var,V}, {Int0,Elem}) ->
+ F = fun (#k_var{name=V}, {Int0,Elem}) ->
case vdb_find(V, Vdb) of
{V,_,L} when L =< I -> {[], {Int0,Elem+1}};
_Other ->
@@ -964,9 +1444,10 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) ->
select_map(Scs, V, Tf, Vf, Bef, St0) ->
Reg = fetch_var(V, Bef),
{Is,Aft,St1} =
- match_fmf(fun(#l{ke={val_clause,{map,exact,_,Es},B},i=I,vdb=Vdb}, Fail, St1) ->
- select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)
- end, Vf, St0, Scs),
+ match_fmf(fun(#k_val_clause{val=#k_map{op=exact,es=Es},
+ body=B,anno=#l{i=I,vdb=Vdb}}, Fail, St1) ->
+ select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1)
+ end, Vf, St0, Scs),
{[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}.
select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) ->
@@ -983,29 +1464,32 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
%% Assume keys are term-sorted
Rsrc = fetch_var(Src, Bef),
- {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun
- ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
- case vdb_find(V, Vdb) of
- {V,_,L} when L =< I ->
- RK = fetch_var(K,Int0),
- {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0};
- _Other ->
- Reg1 = put_reg(V, Int0#sr.reg),
- Int1 = Int0#sr{reg=Reg1},
- RK = fetch_var(K,Int0),
- RV = fetch_reg(V,Reg1),
- {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1}
- end;
- ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
- case vdb_find(V, Vdb) of
- {V,_,L} when L =< I ->
- {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0};
- _Other ->
- Reg1 = put_reg(V, Int0#sr.reg),
- Int1 = Int0#sr{reg=Reg1},
- {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1}
- end
- end, {{[],[],[],[]},Bef}, Vs),
+ {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} =
+ foldr(fun(#k_map_pair{key=#k_var{name=K},val=#k_var{name=V}},
+ {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ RK = fetch_var(K,Int0),
+ {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ RK = fetch_var(K,Int0),
+ RV = fetch_reg(V,Reg1),
+ {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1}
+ end;
+ (#k_map_pair{key=Key,val=#k_var{name=V}},
+ {{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ {{[atomic(Key)|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ {{HasKsi,[atomic(Key),fetch_reg(V, Reg1)|GetVsi],
+ HasVarVsi,GetVarVsi},Int1}
+ end
+ end, {{[],[],[],[]},Bef}, Vs),
Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++
[{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++
@@ -1014,30 +1498,36 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
{Code, Aft, St}.
-select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) ->
- {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of
- {{_,_,Lhd}, {_,_,Ltl}} when Lhd =< I, Ltl =< I ->
- %% Both head and tail are dead. No need to generate
- %% any instruction.
- {[], Bef};
- _ ->
- %% At least one of head and tail will be used,
- %% but we must always fetch both. We will call
- %% clear_dead/2 to allow reuse of the register
- %% in case only of them is used.
-
- Reg0 = put_reg(Tl, put_reg(Hd, Bef#sr.reg)),
- Int0 = Bef#sr{reg=Reg0},
- Rsrc = fetch_var(Src, Int0),
- Rhd = fetch_reg(Hd, Reg0),
- Rtl = fetch_reg(Tl, Reg0),
- Int1 = clear_dead(Int0, I, Vdb),
- {[{get_list,Rsrc,Rhd,Rtl}], Int1}
- end,
- {Es,Aft,St}.
-
+select_extract_cons(Src, [#k_var{name=Hd},#k_var{name=Tl}], I, Vdb, Bef, St) ->
+ Rsrc = fetch_var(Src, Bef),
+ Int = clear_dead(Bef, I, Vdb),
+ {{_,_,Lhd},{_,_,Ltl}} = {vdb_find(Hd, Vdb),vdb_find(Tl, Vdb)},
+ case {Lhd =< I, Ltl =< I} of
+ {true,true} ->
+ %% Both dead.
+ {[],Bef,St};
+ {true,false} ->
+ %% Head dead.
+ Reg0 = put_reg(Tl, Bef#sr.reg),
+ Aft = Int#sr{reg=Reg0},
+ Rtl = fetch_reg(Tl, Reg0),
+ {[{get_tl,Rsrc,Rtl}],Aft,St};
+ {false,true} ->
+ %% Tail dead.
+ Reg0 = put_reg(Hd, Bef#sr.reg),
+ Aft = Int#sr{reg=Reg0},
+ Rhd = fetch_reg(Hd, Reg0),
+ {[{get_hd,Rsrc,Rhd}],Aft,St};
+ {false,false} ->
+ %% Both used.
+ Reg0 = put_reg(Tl, put_reg(Hd, Bef#sr.reg)),
+ Aft = Bef#sr{reg=Reg0},
+ Rhd = fetch_reg(Hd, Reg0),
+ Rtl = fetch_reg(Tl, Reg0),
+ {[{get_hd,Rsrc,Rhd},{get_tl,Rsrc,Rtl}],Aft,St}
+ end.
-guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) ->
+guard_clause_cg(#k_guard_clause{anno=#l{vdb=Vdb},guard=G,body=B}, Fail, Bef, St0) ->
{Gis,Int,St1} = guard_cg(G, Fail, Vdb, Bef, St0),
{Bis,Aft,St} = match_cg(B, Fail, Int, St1),
{Gis ++ Bis,Aft,St}.
@@ -1050,18 +1540,37 @@ guard_clause_cg(#l{ke={guard_clause,G,B},vdb=Vdb}, Fail, Bef, St0) ->
%% the correct exit point. Primops and tests all go to the next
%% instruction on success or jump to a failure label.
-guard_cg(#l{ke={protected,Ts,Rs},i=I,vdb=Pdb}, Fail, _Vdb, Bef, St) ->
- protected_cg(Ts, Rs, Fail, I, Pdb, Bef, St);
-guard_cg(#l{ke={block,Ts},i=I,vdb=Bdb}, Fail, _Vdb, Bef, St) ->
- guard_cg_list(Ts, Fail, I, Bdb, Bef, St);
-guard_cg(#l{ke={test,Test,As},i=I,vdb=_Tdb}, Fail, Vdb, Bef, St) ->
- test_cg(Test, As, Fail, I, Vdb, Bef, St);
+guard_cg(#k_protected{arg=Ts,ret=Rs,anno=#l{vdb=Pdb}}, Fail, _Vdb, Bef, St) ->
+ protected_cg(Ts, Rs, Fail, Pdb, Bef, St);
+guard_cg(#k_test{anno=#l{i=I},op=Test0,args=As,inverted=Inverted},
+ Fail, Vdb, Bef, St0) ->
+ #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0,
+ case Inverted of
+ false ->
+ test_cg(Test, As, Fail, I, Vdb, Bef, St0);
+ true ->
+ {Psucc,St1} = new_label(St0),
+ {Is,Aft,St2} = test_cg(Test, As, Psucc, I, Vdb, Bef, St1),
+ {Is++[{jump,{f,Fail}},{label,Psucc}],Aft,St2}
+ end;
guard_cg(G, _Fail, Vdb, Bef, St) ->
%%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{G,Fail,Vdb,Bef}]),
{Gis,Aft,St1} = cg(G, Vdb, Bef, St),
%%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Aft}]),
{Gis,Aft,St1}.
+%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) ->
+%% {[Ainstr],StackReg,St}.
+
+guard_cg_list(Kes, Fail, Vdb, Bef, St0) ->
+ {Keis,{Aft,St1}} =
+ flatmapfoldl(fun (Ke, {Inta,Sta}) ->
+ {Keis,Intb,Stb} =
+ guard_cg(Ke, Fail, Vdb, Inta, Sta),
+ {Keis,{Intb,Stb}}
+ end, {Bef,St0}, need_heap(Kes)),
+ {Keis,Aft,St1}.
+
%% protected_cg([Kexpr], [Ret], Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
%% Do a protected. Protecteds without return values are just done
%% for effect, the return value is not checked, success passes on to
@@ -1069,19 +1578,18 @@ guard_cg(G, _Fail, Vdb, Bef, St) ->
%% return values then these must be set to 'false' on failure,
%% control always passes to the next instruction.
-protected_cg(Ts, [], Fail, I, Vdb, Bef, St0) ->
+protected_cg(Ts, [], Fail, Vdb, Bef, St0) ->
%% Protect these calls, revert when done.
- {Tis,Aft,St1} = guard_cg_list(Ts, Fail, I, Vdb, Bef,
- St0#cg{bfail=Fail}),
+ {Tis,Aft,St1} = guard_cg_list(Ts, Fail, Vdb, Bef, St0#cg{bfail=Fail}),
{Tis,Aft,St1#cg{bfail=St0#cg.bfail}};
-protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) ->
+protected_cg(Ts, Rs, _Fail, Vdb, Bef, St0) ->
{Pfail,St1} = new_label(St0),
{Psucc,St2} = new_label(St1),
- {Tis,Aft,St3} = guard_cg_list(Ts, Pfail, I, Vdb, Bef,
+ {Tis,Aft,St3} = guard_cg_list(Ts, Pfail, Vdb, Bef,
St2#cg{bfail=Pfail}),
%%ok = io:fwrite("cg ~w: ~p~n", [?LINE,{Rs,I,Vdb,Aft}]),
%% Set return values to false.
- Mis = [{move,{atom,false},fetch_var(V,Aft)}||{var,V} <- Rs],
+ Mis = [{move,{atom,false},fetch_var(V,Aft)}||#k_var{name=V} <- Rs],
{Tis ++ [{jump,{f,Psucc}},
{label,Pfail}] ++ Mis ++ [{label,Psucc}],
Aft,St3#cg{bfail=St0#cg.bfail}}.
@@ -1106,23 +1614,18 @@ test_cg(is_map, [A], Fail, I, Vdb, Bef, St) ->
Arg = cg_reg_arg_prefer_y(A, Bef),
Aft = clear_dead(Bef, I, Vdb),
{[{test,is_map,{f,Fail},[Arg]}],Aft,St};
+test_cg(is_boolean, [#k_atom{val=Val}], Fail, I, Vdb, Bef, St) ->
+ Aft = clear_dead(Bef, I, Vdb),
+ Is = case is_boolean(Val) of
+ true -> [];
+ false -> [{jump,{f,Fail}}]
+ end,
+ {Is,Aft,St};
test_cg(Test, As, Fail, I, Vdb, Bef, St) ->
Args = cg_reg_args(As, Bef),
Aft = clear_dead(Bef, I, Vdb),
{[beam_utils:bif_to_test(Test, Args, {f,Fail})],Aft,St}.
-%% guard_cg_list([Kexpr], Fail, I, Vdb, StackReg, St) ->
-%% {[Ainstr],StackReg,St}.
-
-guard_cg_list(Kes, Fail, I, Vdb, Bef, St0) ->
- {Keis,{Aft,St1}} =
- flatmapfoldl(fun (Ke, {Inta,Sta}) ->
- {Keis,Intb,Stb} =
- guard_cg(Ke, Fail, Vdb, Inta, Sta),
- {Keis,{Intb,Stb}}
- end, {Bef,St0}, need_heap(Kes, I)),
- {Keis,Aft,St1}.
-
%% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,Aft,State}.
%% This is a special flatmapfoldl for match code gen where we
%% generate a "failure" label for each clause. The last clause uses
@@ -1145,7 +1648,7 @@ match_fmf(F, LastFail, St0, [H|T]) ->
%% frame size. Finally the actual call is made. Call then needs the
%% return values filled in.
-call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) ->
+call_cg(#k_var{}=Var, As, Rs, Le, Vdb, Bef, St0) ->
{Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb),
%% Put return values in registers.
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
@@ -1154,9 +1657,8 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) ->
{Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)),
{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;
- element(1, Name) =:= var ->
+call_cg(#k_remote{mod=Mod,name=Name}, As, Rs, Le, Vdb, Bef, St0)
+ when is_record(Mod, k_var); is_record(Name, k_var) ->
{Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb),
%% Put return values in registers.
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
@@ -1174,8 +1676,9 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
%%
%% move {atom,ok} DestReg
%% jump FailureLabel
- {remote,{atom,erlang},{atom,error}} = Func, %Assertion.
- [{var,DestVar}] = Rs,
+ #k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=error}} = Func, %Assertion.
+ [#k_var{name=DestVar}] = Rs,
Int0 = clear_dead(Bef, Le#l.i, Vdb),
Reg = put_reg(DestVar, Int0#sr.reg),
Int = Int0#sr{reg=Reg},
@@ -1194,11 +1697,11 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) ->
{Sis ++ Frees ++ [line(Le)|Call],Aft,St1}
end.
-build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) ->
+build_call(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) ->
{[send],need_stack_frame(St0)};
-build_call({remote,{atom,Mod},{atom,Name}}, Arity, St0) ->
+build_call(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) ->
{[{call_ext,Arity,{extfunc,Mod,Name,Arity}}],need_stack_frame(St0)};
-build_call(Name, Arity, St0) when is_atom(Name) ->
+build_call(#k_local{name=Name}, Arity, St0) when is_atom(Name) ->
{Lbl,St1} = local_func_label(Name, Arity, need_stack_frame(St0)),
{[{call,Arity,{f,Lbl}}],St1}.
@@ -1214,16 +1717,15 @@ free_dead([Any|Stk], Y, Instr, StkAcc) ->
free_dead(Stk, Y+1, Instr, [Any|StkAcc]);
free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}.
-enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) ->
+enter_cg(#k_var{} = 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 ++ [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)
- when element(1, Mod) =:= var;
- element(1, Name) =:= var ->
+enter_cg(#k_remote{mod=Mod,name=Name}, As, Le, Vdb, Bef, St0)
+ when is_record(Mod, k_var); is_record(Name, k_var) ->
{Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb),
%% Build complete code and final stack/register state.
Arity = length(As),
@@ -1241,19 +1743,19 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) ->
clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb),
St1}.
-build_enter({remote,{atom,erlang},{atom,'!'}}, 2, St0) ->
+build_enter(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) ->
{[send,return],need_stack_frame(St0)};
-build_enter({remote,{atom,Mod},{atom,Name}}, Arity, St0) ->
+build_enter(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, St0) ->
St1 = case trap_bif(Mod, Name, Arity) of
true -> need_stack_frame(St0);
false -> St0
end,
{[{call_ext_only,Arity,{extfunc,Mod,Name,Arity}}],St1};
-build_enter(Name, Arity, St0) when is_atom(Name) ->
+build_enter(#k_local{name=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) ->
+enter_line(#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}}, Arity, Le) ->
case erl_bifs:is_safe(Mod, Name, Arity) of
false ->
%% Tail-recursive call, possibly to a BIF.
@@ -1301,37 +1803,78 @@ trap_bif(erlang, group_leader, 2) -> true;
trap_bif(erlang, exit, 2) -> true;
trap_bif(_, _, _) -> false.
-%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
+%% bif_cg(#k_bif{}, Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-
-bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
- [Src] = cg_reg_args([Src0], Bef),
- case is_register(Src) of
+%% Generate code a BIF.
+
+bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, Vdb, Bef, St) ->
+ internal_cg(Name, As, Rs, Le, Vdb, Bef, St);
+bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}},
+ args=As,ret=Rs}, Le, Vdb, Bef, St) ->
+ Ar = length(As),
+ case is_gc_bif(Name, Ar) of
false ->
- {[],clear_dead(Bef, Le#l.i, Vdb), St0};
+ bif_cg(Name, As, Rs, Le, Vdb, Bef, St);
true ->
- {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}
- end;
-bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
+ gc_bif_cg(Name, As, Rs, Le, Vdb, Bef, St)
+ end.
+
+%% internal_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
+%% {[Ainstr],StackReg,State}.
+
+internal_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
+ [Src] = cg_reg_args([Src0], Bef),
+ {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0};
+internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
[New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef),
Index = Index1-1,
{[{set_tuple_element,New,Tuple,Index}],
clear_dead(Bef, Le#l.i, Vdb), St0};
-bif_cg({make_fun,Func,Arity,Index,Uniq}, As, Rs, Le, Vdb, Bef, St0) ->
+internal_cg(make_fun, [Func0,Arity0|As], Rs, Le, Vdb, Bef, St0) ->
%% This behaves more like a function call.
+ #k_atom{val=Func} = Func0,
+ #k_int{val=Arity} = Arity0,
{Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
{FuncLbl,St1} = local_func_label(Func, Arity, St0),
- MakeFun = {make_fun2,{f,FuncLbl},Index,Uniq,length(As)},
+ MakeFun = {make_fun2,{f,FuncLbl},0,0,length(As)},
{Sis ++ [MakeFun],
clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),
St1};
-bif_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) ->
+internal_cg(bs_init_writable=I, As, Rs, Le, Vdb, Bef, St) ->
+ %% This behaves like a function call.
+ {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
+ Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
+ {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St};
+internal_cg(build_stacktrace=I, As, Rs, Le, Vdb, Bef, St) ->
%% This behaves like a function call.
{Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
{Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St};
-bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
+internal_cg(raise, As, Rs, Le, Vdb, Bef, St) ->
+ %% raise can be treated like a guard BIF.
+ bif_cg(raise, As, Rs, Le, Vdb, Bef, St);
+internal_cg(guard_error, [ExitCall], _Rs, Le, Vdb, Bef, St) ->
+ %% A call an exit BIF from inside a #k_guard_match{}.
+ %% Generate a standard call, but leave the register descriptors
+ %% alone, effectively pretending that there was no call.
+ #k_call{op=#k_remote{mod=#k_atom{val=Mod},name=#k_atom{val=Name}},
+ args=As} = ExitCall,
+ Arity = length(As),
+ {Ms,_} = cg_call_args(As, Bef, Le#l.i, Vdb),
+ Call = {call_ext,Arity,{extfunc,Mod,Name,Arity}},
+ Is = Ms++[line(Le),Call],
+ {Is,Bef,St};
+internal_cg(raw_raise=I, As, Rs, Le, Vdb, Bef, St) ->
+ %% This behaves like a function call.
+ {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
+ Reg = load_vars(Rs, clear_regs(Int#sr.reg)),
+ {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}.
+
+%% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
+%% {[Ainstr],StackReg,State}.
+
+bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) ->
Ars = cg_reg_args(As, Bef),
%% If we are inside a catch and in a body (not in guard) and the
@@ -1369,7 +1912,7 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
%% gc_bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) ->
%% {[Ainstr],StackReg,State}.
-gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) ->
+gc_bif_cg(Bif, As, [#k_var{name=V}], Le, Vdb, Bef, St0) ->
Ars = cg_reg_args(As, Bef),
%% If we are inside a catch and in a body (not in guard) and the
@@ -1415,7 +1958,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) ->
%% cg_recv_mesg( ) -> {[Ainstr],Aft,St}.
-cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) ->
+cg_recv_mesg(#k_var{name=R}, Rm, Tl, Bef, St0) ->
Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
Ret = fetch_reg(R, Int0#sr.reg),
%% Int1 = clear_dead(Int0, I, Rm#l.vdb),
@@ -1425,22 +1968,22 @@ cg_recv_mesg({var,R}, Rm, Tl, Bef, St0) ->
%% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}.
-cg_recv_wait({atom,infinity}, Tes, I, Bef, St0) ->
+cg_recv_wait(#k_atom{val=infinity}, #cg_block{anno=Le,es=Tes}, I, Bef, St0) ->
%% We know that the 'after' body will never be executed.
%% But to keep the stack and register information up to date,
%% we will generate the code for the 'after' body, and then discard it.
- Int1 = clear_dead(Bef, I, Tes#l.vdb),
- {_,Int2,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb,
- Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0),
+ Int1 = clear_dead(Bef, I, Le#l.vdb),
+ {_,Int2,St1} = cg_block(Tes, Le#l.vdb,
+ Int1#sr{reg=clear_regs(Int1#sr.reg)}, St0),
{[{wait,{f,St1#cg.recv}}],Int2,St1};
-cg_recv_wait({integer,0}, Tes, _I, Bef, St0) ->
- {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb, Bef, St0),
+cg_recv_wait(#k_int{val=0}, #cg_block{anno=Le,es=Tes}, _I, Bef, St0) ->
+ {Tis,Int,St1} = cg_block(Tes, Le#l.vdb, Bef, St0),
{[timeout|Tis],Int,St1};
-cg_recv_wait(Te, Tes, I, Bef, St0) ->
+cg_recv_wait(Te, #cg_block{anno=Le,es=Tes}, I, Bef, St0) ->
Reg = cg_reg_arg(Te, Bef),
%% Must have empty registers here! Bug if anything in registers.
- Int0 = clear_dead(Bef, I, Tes#l.vdb),
- {Tis,Int,St1} = cg_block(Tes#l.ke, Tes#l.i, Tes#l.vdb,
+ Int0 = clear_dead(Bef, I, Le#l.vdb),
+ {Tis,Int,St1} = cg_block(Tes, Le#l.vdb,
Int0#sr{reg=clear_regs(Int0#sr.reg)}, St0),
{[{wait_timeout,{f,St1#cg.recv},Reg},timeout] ++ Tis,Int,St1}.
@@ -1458,7 +2001,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) ->
{B,St1} = new_label(St0), %Body label
{H,St2} = new_label(St1), %Handler label
{E,St3} = new_label(St2), %End label
- TryTag = Ta#l.i,
+ #l{i=TryTag} = get_kanno(Ta),
Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)},
TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk),
{Ais,Int2,St4} = cg(Ta, Vdb, Int1, St3#cg{break=B,in_catch=true}),
@@ -1478,7 +2021,7 @@ try_cg(Ta, Vs, Tb, Evs, Th, Rs, Le, Vdb, Bef, St0) ->
try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) ->
{B,St1} = new_label(St0), %Body label
{H,St2} = new_label(St1), %Handler label
- TryTag = Ta#l.i,
+ #l{i=TryTag} = get_kanno(Ta),
Int1 = Bef#sr{stk=put_catch(TryTag, Bef#sr.stk)},
TryReg = fetch_stack({catch_tag,TryTag}, Int1#sr.stk),
{Ais,Int2,St3} = cg(Ta, Vdb, Int1, St2#cg{break=B,in_catch=true}),
@@ -1496,12 +2039,12 @@ try_enter_cg(Ta, Vs, Tb, Evs, Th, Le, Vdb, Bef, St0) ->
%% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
-catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
+catch_cg(#cg_block{es=C}, #k_var{name=R}, Le, Vdb, Bef, St0) ->
{B,St1} = new_label(St0),
CatchTag = Le#l.i,
Int1 = Bef#sr{stk=put_catch(CatchTag, Bef#sr.stk)},
CatchReg = fetch_stack({catch_tag,CatchTag}, Int1#sr.stk),
- {Cis,Int2,St2} = cg_block(C, Le#l.i, Le#l.vdb, Int1,
+ {Cis,Int2,St2} = cg_block(C, Le#l.vdb, Int1,
St1#cg{break=B,in_catch=true}),
[] = Int2#sr.reg, %Assertion.
Aft = Int2#sr{reg=[{0,R}],stk=drop_catch(CatchTag, Int2#sr.stk)},
@@ -1510,8 +2053,8 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
clear_dead(Aft, Le#l.i, Vdb),
St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}.
-%% set_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
-%% We have to be careful how a 'set' works. First the structure is
+%% put_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}.
+%% We have to be careful how a 'put' works. First the structure is
%% built, then it is filled and finally things can be cleared. The
%% annotation must reflect this and make sure that the return
%% variable is allocated first.
@@ -1519,13 +2062,14 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) ->
%% put_list and put_map are atomic instructions, both of
%% which can safely resuse one of the source registers as target.
-set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) ->
- [S1,S2] = cg_reg_args(Es, Bef),
+put_cg([#k_var{name=R}], #k_cons{hd=Hd,tl=Tl}, Le, Vdb, Bef, St) ->
+ [S1,S2] = cg_reg_args([Hd,Tl], Bef),
Int0 = clear_dead(Bef, Le#l.i, Vdb),
Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
Ret = fetch_reg(R, Int1#sr.reg),
{[{put_list,S1,S2,Ret}], Int1, St};
-set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) ->
+put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, Vdb, Bef,
+ #cg{bfail=Bfail}=St) ->
%% At run-time, binaries are constructed in three stages:
%% 1) First the size of the binary is calculated.
%% 2) Then the binary is allocated.
@@ -1553,7 +2097,9 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) ->
{Sis++Code,Aft,St};
%% Map: single variable key.
-set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) ->
+put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,
+ es=[#k_map_pair{key=#k_var{}=K,val=V}]},
+ Le, Vdb, Bef, St0) ->
{Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0),
SrcReg = cg_reg_arg_prefer_y(Map, Int0),
@@ -1568,22 +2114,23 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, St0) ->
Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)},
Target = fetch_reg(R, Aft#sr.reg),
- {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
+ {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
{Sis++Is,Aft,St1};
%% Map: (possibly) multiple literal keys.
-set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) ->
+put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, Vdb, Bef, St0) ->
%% assert key literals
- [] = [Var||{map_pair,{var,_}=Var,_} <- Es],
+ [] = [Var || #k_map_pair{key=#k_var{}=Var} <- Es],
{Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0),
SrcReg = cg_reg_arg_prefer_y(Map, Int0),
Line = line(Le#l.a),
%% fetch registers for values to be put into the map
- Pairs = [{K,V} || {_,K,V} <- Es],
- List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs),
+ List = flatmap(fun(#k_map_pair{key=K,val=V}) ->
+ [atomic(K),cg_reg_arg(V, Int0)]
+ end, Es),
Live = max_reg(Bef#sr.reg),
@@ -1592,16 +2139,16 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, St0) ->
Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)},
Target = fetch_reg(R, Aft#sr.reg),
- {Is,St1} = set_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
+ {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0),
{Sis++Is,Aft,St1};
%% Everything else.
-set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
+put_cg([#k_var{name=R}], Con, Le, Vdb, Bef, St) ->
%% Find a place for the return register first.
Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)},
Ret = fetch_reg(R, Int#sr.reg),
Ais = case Con of
- {tuple,Es} ->
+ #k_tuple{es=Es} ->
[{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef);
Other ->
[{move,cg_reg_arg(Other, Int),Ret}]
@@ -1609,7 +2156,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
{Ais,clear_dead(Int, Le#l.i, Vdb),St}.
-set_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) ->
+put_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) ->
Bfail = St0#cg.bfail,
Fail = {f,St0#cg.bfail},
Op = case Op0 of
@@ -1787,24 +2334,44 @@ cg_gen_binsize([], _, _, _, _, Acc) -> Acc.
%% cg_bin_opt(Code0) -> Code
%% Optimize the size calculations for binary construction.
-cg_bin_opt([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) ->
- cg_bin_opt([{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|Is]);
-cg_bin_opt([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) ->
- cg_bin_opt([{bs_private_append,Fail,Size,U,Bin,Flags,D}|Is]);
-cg_bin_opt([{move,{integer,0},D},{bs_add,_,[D,{integer,_}=S,1],Dst}|Is]) ->
- cg_bin_opt([{move,S,Dst}|Is]);
-cg_bin_opt([{move,{integer,0},D},{bs_add,Fail,[D,S,U],Dst}|Is]) ->
- cg_bin_opt([{bs_add,Fail,[{integer,0},S,U],Dst}|Is]);
-cg_bin_opt([{move,{integer,Bytes},D},{Op,Fail,D,Extra,Regs,Flags,D}|Is])
+cg_bin_opt([{move,S1,{x,X}=D},{gc_bif,Op,Fail,Live0,As,Dst}|Is]) ->
+ Live = if
+ X + 1 =:= Live0 -> X;
+ true -> Live0
+ end,
+ [{gc_bif,Op,Fail,Live,As,D}|cg_bin_opt([{move,S1,Dst}|Is])];
+cg_bin_opt([{move,_,_}=I1,{Op,_,_,_}=I2|Is])
+ when Op =:= bs_utf8_size orelse Op =:= bs_utf16_size ->
+ [I2|cg_bin_opt([I1|Is])];
+cg_bin_opt([{bs_add,_,[{integer,0},Src,1],Dst}|Is]) ->
+ cg_bin_opt_1([{move,Src,Dst}|Is]);
+cg_bin_opt([{bs_add,_,[Src,{integer,0},_],Dst}|Is]) ->
+ cg_bin_opt_1([{move,Src,Dst}|Is]);
+cg_bin_opt(Is) ->
+ cg_bin_opt_1(Is).
+
+cg_bin_opt_1([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) ->
+ [{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|cg_bin_opt(Is)];
+cg_bin_opt_1([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) ->
+ [{bs_private_append,Fail,Size,U,Bin,Flags,D}|cg_bin_opt(Is)];
+cg_bin_opt_1([{move,Size,D},{Op,Fail,D,Extra,Regs,Flags,D}|Is])
when Op =:= bs_init2; Op =:= bs_init_bits ->
- cg_bin_opt([{Op,Fail,Bytes,Extra,Regs,Flags,D}|Is]);
-cg_bin_opt([{move,Src1,Dst},{bs_add,Fail,[Dst,Src2,U],Dst}|Is]) ->
- cg_bin_opt([{bs_add,Fail,[Src1,Src2,U],Dst}|Is]);
-cg_bin_opt([I|Is]) ->
+ Bytes = case Size of
+ {integer,Int} -> Int;
+ _ -> Size
+ end,
+ [{Op,Fail,Bytes,Extra,Regs,Flags,D}|cg_bin_opt(Is)];
+cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[D,S2,U],Dst}|Is]) ->
+ cg_bin_opt([{bs_add,Fail,[S1,S2,U],Dst}|Is]);
+cg_bin_opt_1([{move,S1,D},{bs_add,Fail,[S2,D,U],Dst}|Is]) ->
+ cg_bin_opt([{bs_add,Fail,[S2,S1,U],Dst}|Is]);
+cg_bin_opt_1([I|Is]) ->
[I|cg_bin_opt(Is)];
-cg_bin_opt([]) -> [].
+cg_bin_opt_1([]) ->
+ [].
-cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) ->
+cg_bin_put(#k_bin_seg{size=S0,unit=U,type=T,flags=Fs,seg=E0,next=Next},
+ Fail, Bef) ->
S1 = cg_reg_arg(S0, Bef),
E1 = cg_reg_arg(E0, Bef),
{Format,Op} = case T of
@@ -1821,7 +2388,7 @@ cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) ->
utf ->
[{Op,Fail,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)]
end;
-cg_bin_put({bin_end,[]}, _, _) -> [].
+cg_bin_put(#k_bin_end{}, _, _) -> [].
cg_build_args(As, Bef) ->
[{put,cg_reg_arg(A, Bef)} || A <- As].
@@ -1841,13 +2408,12 @@ break_cg(Bs, Le, Vdb, Bef, St) ->
{Ms ++ [{jump,{f,St#cg.break}}],
Int#sr{reg=clear_regs(Int#sr.reg)},St}.
-guard_break_cg(Bs, Locked, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) ->
- RegLocked = get_locked_regs(Reg0, Locked),
- #sr{reg=Reg1} = Int = clear_dead(Bef#sr{reg=RegLocked}, I, Vdb),
+guard_break_cg(Bs, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) ->
+ #sr{reg=Reg1} = Int = clear_dead(Bef, I, Vdb),
Reg2 = trim_free(Reg1),
NumLocked = length(Reg2),
Moves0 = gen_moves(Bs, Bef, NumLocked, []),
- Moves = order_moves(Moves0, find_scratch_reg(RegLocked)),
+ Moves = order_moves(Moves0, find_scratch_reg(Reg0)),
{BreakVars,_} = mapfoldl(fun(_, RegNum) ->
{{RegNum,gbreakvar},RegNum+1}
end, length(Reg2), Bs),
@@ -1855,31 +2421,17 @@ guard_break_cg(Bs, Locked, #l{i=I}, Vdb, #sr{reg=Reg0}=Bef, St) ->
Aft = Int#sr{reg=Reg},
{Moves ++ [{jump,{f,St#cg.break}}],Aft,St}.
-get_locked_regs([R|Rs0], Preserve) ->
- case {get_locked_regs(Rs0, Preserve),R} of
- {[],{_,V}} ->
- case lists:member(V, Preserve) of
- true -> [R];
- false -> []
- end;
- {[],_} ->
- [];
- {Rs,_} ->
- [R|Rs]
- end;
-get_locked_regs([], _) -> [].
-
%% cg_reg_arg(Arg0, Info) -> Arg
%% cg_reg_args([Arg0], Info) -> [Arg]
%% Convert argument[s] into registers. Literal values are returned unchanged.
cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As].
-cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef);
-cg_reg_arg(Literal, _) -> Literal.
+cg_reg_arg(#k_var{name=V}, Bef) -> fetch_var(V, Bef);
+cg_reg_arg(Literal, _) -> atomic(Literal).
-cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef);
-cg_reg_arg_prefer_y(Literal, _) -> Literal.
+cg_reg_arg_prefer_y(#k_var{name=V}, Bef) -> fetch_var_prefer_y(V, Bef);
+cg_reg_arg_prefer_y(Literal, _) -> atomic(Literal).
%% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}.
%% Do the complete setup for a call/enter.
@@ -1917,9 +2469,9 @@ cg_call_args(As, Bef, I, Vdb) ->
load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0).
-load_arg_regs([_|Rs], [{var,V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)];
+load_arg_regs([_|Rs], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs(Rs, As, I+1)];
load_arg_regs([_|Rs], [A|As], I) -> [{I,A}|load_arg_regs(Rs, As, I+1)];
-load_arg_regs([], [{var,V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)];
+load_arg_regs([], [#k_var{name=V}|As], I) -> [{I,V}|load_arg_regs([], As, I+1)];
load_arg_regs([], [A|As], I) -> [{I,A}|load_arg_regs([], As, I+1)];
load_arg_regs(Rs, [], _) -> Rs.
@@ -1955,12 +2507,13 @@ move_unsaved([], _, Regs, Acc) -> {Acc,Regs}.
gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []).
-gen_moves([{var,V}|As], Sr, I, Acc) ->
+gen_moves([#k_var{name=V}|As], Sr, I, Acc) ->
case fetch_var(V, Sr) of
{x,I} -> gen_moves(As, Sr, I+1, Acc);
Reg -> gen_moves(As, Sr, I+1, [{move,Reg,{x,I}}|Acc])
end;
-gen_moves([A|As], Sr, I, Acc) ->
+gen_moves([A0|As], Sr, I, Acc) ->
+ A = atomic(A0),
gen_moves(As, Sr, I+1, [{move,A,{x,I}}|Acc]);
gen_moves([], _, _, Acc) -> lists:keysort(3, Acc).
@@ -2008,21 +2561,21 @@ break_up_cycle1(Dst, [M|Path], LastMove) ->
%% clear_dead(Sr, Until, Vdb) -> Aft.
%% Remove all variables in Sr which have died AT ALL so far.
-clear_dead(Sr, Until, Vdb) ->
- Sr#sr{reg=clear_dead_reg(Sr, Until, Vdb),
- stk=clear_dead_stk(Sr#sr.stk, Until, Vdb)}.
+clear_dead(#sr{stk=Stk}=Sr0, Until, Vdb) ->
+ Sr = Sr0#sr{reg=clear_dead_reg(Sr0, Until, Vdb),
+ stk=clear_dead_stk(Stk, Until, Vdb)},
+ reserve(Sr).
clear_dead_reg(Sr, Until, Vdb) ->
- Reg = [case R of
- {_I,V} = IV ->
- case vdb_find(V, Vdb) of
- {V,_,L} when L > Until -> IV;
- _ -> free %Remove anything else
- end;
- {reserved,_I,_V} = Reserved -> Reserved;
- free -> free
- end || R <- Sr#sr.reg],
- reserve(Sr#sr.res, Reg, Sr#sr.stk).
+ [case R of
+ {_I,V} = IV ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L > Until -> IV;
+ _ -> free %Remove anything else
+ end;
+ {reserved,_I,_V}=Reserved -> Reserved;
+ free -> free
+ end || R <- Sr#sr.reg].
clear_dead_stk(Stk, Until, Vdb) ->
[case S of
@@ -2094,16 +2647,25 @@ adjust_stack(Bef, Fb, Lf, Vdb) ->
save_stack(Stk0, Fb, Lf, Vdb) ->
%% New variables that are in use but not on stack.
- New = [VFL || {V,F,L} = VFL <- Vdb,
- F < Fb,
- L >= Lf,
- not on_stack(V, Stk0)],
+ New = new_not_on_stack(Stk0, Fb, Lf, Vdb),
+
%% Add new variables that are not just dropped immediately.
%% N.B. foldr works backwards from the end!!
Saves = [V || {V,_,_} <- keysort(3, New)],
Stk1 = foldr(fun (V, Stk) -> put_stack(V, Stk) end, Stk0, Saves),
{Stk1,Saves}.
+%% new_not_on_stack(Stack, FirstBefore, LastFrom, Vdb) ->
+%% [{Variable,First,Last}]
+%% Return information about all variables that are used past current
+%% point and that are not already on the stack.
+
+new_not_on_stack(Stk, Fb, Lf, Vdb) ->
+ [VFL || {V,F,L} = VFL <- Vdb,
+ F < Fb,
+ L >= Lf,
+ not on_stack(V, Stk)].
+
%% saves([SaveVar], Reg, Stk) -> [{move,Reg,Stk}].
%% Generate move instructions to save variables onto stack. The
%% stack/reg info used is that after the new stack has been made.
@@ -2129,7 +2691,7 @@ fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) ->
end.
load_vars(Vs, Regs) ->
- foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).
+ foldl(fun (#k_var{name=V}, Rs) -> put_reg(V, Rs) end, Regs, Vs).
%% put_reg(Val, Regs) -> Regs.
%% find_reg(Val, Regs) -> {ok,r{R}} | error.
@@ -2209,10 +2771,6 @@ find_stack(_, [], _) -> error.
on_stack(V, Stk) -> keymember(V, 1, Stk).
-is_register({x,_}) -> true;
-is_register({yy,_}) -> true;
-is_register(_) -> false.
-
%% put_catch(CatchTag, Stack) -> Stack'
%% drop_catch(CatchTag, Stack) -> Stack'
%% Special interface for putting and removing catch tags, to ensure that
@@ -2230,6 +2788,16 @@ put_catch(Tag, [Other|Stk], Acc) ->
drop_catch(Tag, [{{catch_tag,Tag}}|Stk]) -> [free|Stk];
drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)].
+%% atomic(Klit) -> Lit.
+%% atomic_list([Klit]) -> [Lit].
+
+atomic(#k_literal{val=V}) -> {literal,V};
+atomic(#k_int{val=I}) -> {integer,I};
+atomic(#k_float{val=F}) -> {float,F};
+atomic(#k_atom{val=A}) -> {atom,A};
+%%atomic(#k_char{val=C}) -> {char,C};
+atomic(#k_nil{}) -> nil.
+
%% new_label(St) -> {L,St}.
new_label(#cg{lcount=Next}=St) ->
@@ -2272,3 +2840,86 @@ flatmapfoldl(F, Accu0, [Hd|Tail]) ->
{Rs,Accu2} = flatmapfoldl(F, Accu1, Tail),
{R++Rs,Accu2};
flatmapfoldl(_, Accu, []) -> {[],Accu}.
+
+%% Keep track of life time for variables.
+%%
+%% init_vars([{var,VarName}]) -> Vdb.
+%% new_vars([VarName], I, Vdb) -> Vdb.
+%% use_vars([VarName], I, Vdb) -> Vdb.
+%% add_var(VarName, F, L, Vdb) -> Vdb.
+%%
+%% The list of variable names for new_vars/3 and use_vars/3
+%% must be sorted.
+
+init_vars(Vs) ->
+ vdb_new(Vs).
+
+new_vars([], _, Vdb) -> Vdb;
+new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb);
+new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
+
+use_vars([], _, Vdb) ->
+ Vdb;
+use_vars([V], I, Vdb) ->
+ case vdb_find(V, Vdb) of
+ {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb);
+ {V,_,_} -> Vdb;
+ error -> vdb_store_new(V, {V,I,I}, Vdb)
+ end;
+use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
+
+add_var(V, F, L, Vdb) ->
+ vdb_store_new(V, {V,F,L}, Vdb).
+
+%% vdb
+
+vdb_new(Vs) ->
+ ordsets:from_list([{V,0,0} || #k_var{name=V} <- Vs]).
+
+-type var() :: atom().
+
+-spec vdb_find(var(), [vdb_entry()]) -> 'error' | vdb_entry().
+
+vdb_find(V, Vdb) ->
+ case lists:keyfind(V, 1, Vdb) of
+ false -> error;
+ Vd -> Vd
+ end.
+
+vdb_update(V, Update, [{V,_,_}|Vdb]) ->
+ [Update|Vdb];
+vdb_update(V, Update, [Vd|Vdb]) ->
+ [Vd|vdb_update(V, Update, Vdb)].
+
+vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 ->
+ [Vd|vdb_store_new(V, New, Vdb)];
+vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 ->
+ [New|Vdb];
+vdb_store_new(_, New, []) -> [New].
+
+vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 ->
+ [Vd|vdb_update_vars(Vs, Vdb, I)];
+vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 ->
+ %% New variable.
+ [{V,I,I}|vdb_update_vars(Vs, Vdb, I)];
+vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) ->
+ %% Existing variable.
+ if
+ I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)];
+ true -> [Vd|vdb_update_vars(Vs, Vdb, I)]
+ end;
+vdb_update_vars([V|Vs], [], I) ->
+ %% New variable.
+ [{V,I,I}|vdb_update_vars(Vs, [], I)];
+vdb_update_vars([], Vdb, _) -> Vdb.
+
+%% vdb_sub(Min, Max, Vdb) -> Vdb.
+%% Extract variables which are used before and after Min. Lock
+%% variables alive after Max.
+
+vdb_sub(Min, Max, Vdb) ->
+ [ if L >= Max -> {V,F,locked};
+ true -> Vd
+ end || {V,F,L}=Vd <- Vdb,
+ F < Min,
+ L >= Min ].
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index d71411de80..c9517c3e51 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -137,11 +137,13 @@
-record(core, {vcount=0 :: non_neg_integer(), %Variable counter
fcount=0 :: non_neg_integer(), %Function counter
+ function={none,0} :: fa(), %Current function.
in_guard=false :: boolean(), %In guard or not.
wanted=true :: boolean(), %Result wanted or not.
opts :: [compile:option()], %Options.
ws=[] :: [warning()], %Warnings.
- file=[{file,""}]}). %File
+ file=[{file,""}] %File.
+ }).
%% XXX: The following type declarations do not belong in this module
-type fa() :: {atom(), arity()}.
@@ -149,38 +151,73 @@
-type form() :: {function, integer(), atom(), arity(), _}
| {attribute, integer(), attribute(), _}.
--spec module({module(), [fa()], [form()]}, [compile:option()]) ->
+-record(imodule, {name = [],
+ exports = ordsets:new(),
+ attrs = [],
+ defs = [],
+ file = [],
+ opts = [],
+ ws = []}).
+
+-spec module([form()], [compile:option()]) ->
{'ok',cerl:c_module(),[warning()]}.
-module({Mod,Exp,Forms}, Opts) ->
- Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp),
- {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) ->
- form(F, Acc, Opts)
- end, {[],[],[],[]}, Forms),
- Kfs = reverse(Kfs0),
+module(Forms0, Opts) ->
+ Forms = erl_internal:add_predefined_functions(Forms0),
+ Module = foldl(fun (F, Acc) ->
+ form(F, Acc, Opts)
+ end, #imodule{}, Forms),
+ #imodule{name=Mod,exports=Exp0,attrs=As0,defs=Kfs0,ws=Ws} = Module,
+ Exp = case member(export_all, Opts) of
+ true -> defined_functions(Forms);
+ false -> Exp0
+ end,
+ Cexp = [#c_var{name=FA} || {_,_}=FA <- Exp],
As = reverse(As0),
+ Kfs = reverse(Kfs0),
{ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}.
-form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) ->
+form({function,_,_,_,_}=F0, Module, Opts) ->
+ #imodule{file=File,defs=Defs,ws=Ws0} = Module,
{F,Ws} = function(F0, Ws0, File, Opts),
- {[F|Fs],As,Ws,File};
-form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) ->
- {Fs,As,Ws,File};
-form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
- {Fs,[attribute(F)|As],Ws,File}.
-
-attribute(Attribute) ->
- Fun = fun(A) -> [erl_anno:location(A)] end,
- {attribute,Line,Name,Val} = erl_parse:map_anno(Fun, Attribute),
+ Module#imodule{defs=[F|Defs],ws=Ws};
+form({attribute,_,module,Mod}, Module, _Opts) ->
+ true = is_atom(Mod),
+ Module#imodule{name=Mod};
+form({attribute,_,file,{File,_Line}}=F, #imodule{attrs=As}=Module, _Opts) ->
+ Module#imodule{file=File, attrs=[attribute(F)|As]};
+form({attribute,_,import,_}, Module, _Opts) ->
+ %% Ignore. We have no futher use for imports.
+ Module;
+form({attribute,_,export,Es}, #imodule{exports=Exp0}=Module, _Opts) ->
+ Exp = ordsets:union(ordsets:from_list(Es), Exp0),
+ Module#imodule{exports=Exp};
+form({attribute,_,_,_}=F, #imodule{attrs=As}=Module, _Opts) ->
+ Module#imodule{attrs=[attribute(F)|As]};
+form(_, Module, _Opts) ->
+ %% Ignore uninteresting forms such as 'eof'.
+ Module.
+
+attribute({attribute,A,Name,Val0}) ->
+ Line = [erl_anno:location(A)],
+ Val = if
+ is_list(Val0) -> Val0;
+ true -> [Val0]
+ end,
{#c_literal{val=Name, anno=Line}, #c_literal{val=Val, anno=Line}}.
+defined_functions(Forms) ->
+ Fs = [{Name,Arity} || {function,_,Name,Arity,_} <- Forms],
+ ordsets:from_list(Fs).
+
%% function_dump(module_info,_,_,_) -> ok;
%% function_dump(Name,Arity,Format,Terms) ->
%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms),
%% ok.
function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
- St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
+ St0 = #core{vcount=0,function={Name,Arity},opts=Opts,
+ ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
%% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]),
{B1,St2} = ubody(B0, St1),
@@ -291,14 +328,16 @@ gexpr({protect,Line,Arg}, Bools0, St0) ->
Anno = lineno_anno(Line, St),
{#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St}
end;
-gexpr({op,L,'andalso',E1,E2}, Bools, St0) ->
+gexpr({op,_,'andalso',_,_}=E0, Bools, St0) ->
+ {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0),
Anno = lineno_anno(L, St0),
{#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
False = {atom,L,false},
E = make_bool_switch_guard(L, E1, V, E2, False),
gexpr(E, Bools, St);
-gexpr({op,L,'orelse',E1,E2}, Bools, St0) ->
+gexpr({op,_,'orelse',_,_}=E0, Bools, St0) ->
+ {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0),
Anno = lineno_anno(L, St0),
{#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
@@ -632,9 +671,11 @@ expr({'catch',L,E0}, St0) ->
{E1,Eps,St1} = expr(E0, St0),
Lanno = lineno_anno(L, St1),
{#icatch{anno=#a{anno=Lanno},body=Eps ++ [E1]},[],St1};
-expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) ->
- Lanno = full_anno(L, St),
- {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St};
+expr({'fun',L,{function,F,A}}, St0) ->
+ {Fname,St1} = new_fun_name(St0),
+ Lanno = full_anno(L, St1),
+ Id = {0,0,Fname},
+ {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St1};
expr({'fun',L,{function,M,F,A}}, St0) ->
{As,Aps,St1} = safe_list([M,F,A], St0),
Lanno = full_anno(L, St1),
@@ -642,12 +683,12 @@ expr({'fun',L,{function,M,F,A}}, St0) ->
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, unnamed);
-expr({named_fun,L,'_',Cs,Id}, St) ->
- fun_tq(Id, Cs, L, St, unnamed);
-expr({named_fun,L,Name,Cs,Id}, St) ->
- fun_tq(Id, Cs, L, St, {named,Name});
+expr({'fun',L,{clauses,Cs}}, St) ->
+ fun_tq(Cs, L, St, unnamed);
+expr({named_fun,L,'_',Cs}, St) ->
+ fun_tq(Cs, L, St, unnamed);
+expr({named_fun,L,Name,Cs}, St) ->
+ fun_tq(Cs, L, St, {named,Name});
expr({call,L,{remote,_,M,F},As0}, St0) ->
{[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0),
Anno = full_anno(L, St1),
@@ -840,19 +881,33 @@ badmap_term(Map, #core{in_guard=false}) ->
c_tuple([#c_literal{val=badmap},Map]).
map_build_pairs(Map, Es0, Ann, St0) ->
- {Es,Pre,St1} = map_build_pairs_1(Es0, St0),
+ {Es,Pre,_,St1} = map_build_pairs_1(Es0, cerl_sets:new(), St0),
{ann_c_map(Ann, Map, Es),Pre,St1}.
-map_build_pairs_1([{Op0,L,K0,V0}|Es], St0) ->
+map_build_pairs_1([{Op0,L,K0,V0}|Es], Used0, St0) ->
{K,Pre0,St1} = safe(K0, St0),
{V,Pre1,St2} = safe(V0, St1),
- {Pairs,Pre2,St3} = map_build_pairs_1(Es, St2),
+ {Pairs,Pre2,Used1,St3} = map_build_pairs_1(Es, Used0, St2),
As = lineno_anno(L, St3),
Op = map_op(Op0),
+ {Used2,St4} = maybe_warn_repeated_keys(K, L, Used1, St3),
Pair = cerl:ann_c_map_pair(As, Op, K, V),
- {[Pair|Pairs],Pre0++Pre1++Pre2,St3};
-map_build_pairs_1([], St) ->
- {[],[],St}.
+ {[Pair|Pairs],Pre0++Pre1++Pre2,Used2,St4};
+map_build_pairs_1([], Used, St) ->
+ {[],[],Used,St}.
+
+maybe_warn_repeated_keys(Ck,Line,Used,St) ->
+ case cerl:is_literal(Ck) of
+ false -> {Used,St};
+ true ->
+ K = cerl:concrete(Ck),
+ case cerl_sets:is_element(K,Used) of
+ true ->
+ {Used, add_warning(Line, {map_key_repeated,K}, St)};
+ false ->
+ {cerl_sets:add_element(K,Used), St}
+ end
+ end.
map_op(map_field_assoc) -> #c_literal{val=assoc};
map_op(map_field_exact) -> #c_literal{val=exact}.
@@ -867,8 +922,9 @@ try_exception(Ecs0, St0) ->
%% Note that Tag is not needed for rethrow - it is already in Info.
{Evs,St1} = new_vars(3, St0), % Tag, Value, Info
{Ecs1,Ceps,St2} = clauses(Ecs0, St1),
+ Ecs2 = try_build_stacktrace(Ecs1, hd(Evs)),
[_,Value,Info] = Evs,
- LA = case Ecs1 of
+ LA = case Ecs2 of
[] -> [];
[C|_] -> get_lineno_anno(C)
end,
@@ -877,7 +933,7 @@ try_exception(Ecs0, St0) ->
body=[#iprimop{anno=#a{}, %Must have an #a{}
name=#c_literal{val=raise},
args=[Info,Value]}]},
- Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}],
+ Hs = [#icase{anno=#a{anno=LA},args=[c_tuple(Evs)],clauses=Ecs2,fc=Ec}],
{Evs,Ceps++Hs,St2}.
try_after(As, St0) ->
@@ -893,20 +949,54 @@ try_after(As, St0) ->
Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=[],fc=Ec}],
{Evs,Hs,St1}.
+try_build_stacktrace([#iclause{pats=Ps0,body=B0}=C0|Cs], RawStk) ->
+ [#c_tuple{es=[Class,Exc,Stk]}=Tup] = Ps0,
+ case Stk of
+ #c_var{name='_'} ->
+ %% Stacktrace variable is not used. Nothing to do.
+ [C0|try_build_stacktrace(Cs, RawStk)];
+ _ ->
+ %% Add code to build the stacktrace.
+ Ps = [Tup#c_tuple{es=[Class,Exc,RawStk]}],
+ Call = #iprimop{anno=#a{},
+ name=#c_literal{val=build_stacktrace},
+ args=[RawStk]},
+ Iset = #iset{var=Stk,arg=Call},
+ B = [Iset|B0],
+ C = C0#iclause{pats=Ps,body=B},
+ [C|try_build_stacktrace(Cs, RawStk)]
+ end;
+try_build_stacktrace([], _) -> [].
+
%% expr_bin([ArgExpr], St) -> {[Arg],[PreExpr],St}.
%% Flatten the arguments of a bin. Do this straight left to right!
%% Note that ibinary needs to have its annotation wrapped in a #a{}
%% record whereas c_literal should not have a wrapped annotation
expr_bin(Es0, Anno, St0) ->
- case constant_bin(Es0) of
+ Es1 = [bin_element(E) || E <- Es0],
+ case constant_bin(Es1) of
error ->
- {Es,Eps,St} = expr_bin_1(Es0, St0),
+ {Es,Eps,St} = expr_bin_1(bin_expand_strings(Es1), St0),
{#ibinary{anno=#a{anno=Anno},segments=Es},Eps,St};
Bin ->
{#c_literal{anno=Anno,val=Bin},[],St0}
end.
+bin_element({bin_element,Line,Expr,Size0,Type0}) ->
+ {Size,Type} = make_bit_type(Line, Size0, Type0),
+ {bin_element,Line,Expr,Size,Type}.
+
+make_bit_type(Line, default, Type0) ->
+ case erl_bits:set_bit_type(default, Type0) of
+ {ok,all,Bt} -> {{atom,Line,all},erl_bits:as_list(Bt)};
+ {ok,undefined,Bt} -> {{atom,Line,undefined},erl_bits:as_list(Bt)};
+ {ok,Size,Bt} -> {{integer,Line,Size},erl_bits:as_list(Bt)}
+ end;
+make_bit_type(_Line, Size, Type0) -> %Integer or 'all'
+ {ok,Size,Bt} = erl_bits:set_bit_type(Size, Type0),
+ {Size,erl_bits:as_list(Bt)}.
+
%% constant_bin([{bin_element,_,_,_,_}]) -> binary() | error
%% If the binary construction is truly constant (no variables,
%% no native fields), and does not contain fields whose expansion
@@ -923,7 +1013,8 @@ constant_bin(Es) ->
constant_bin_1(Es) ->
verify_suitable_fields(Es),
EmptyBindings = erl_eval:new_bindings(),
- EvalFun = fun({integer,_,I}, B) -> {value,I,B};
+ EvalFun = fun({string,_,S}, B) -> {value,S,B};
+ ({integer,_,I}, B) -> {value,I,B};
({char,_,C}, B) -> {value,C,B};
({float,_,F}, B) -> {value,F,B};
({atom,_,undefined}, B) -> {value,undefined,B}
@@ -944,6 +1035,9 @@ verify_suitable_fields([{bin_element,_,Val,SzTerm,Opts}|Es]) ->
end,
{unit,Unit} = keyfind(unit, 1, Opts),
case {SzTerm,Val} of
+ {{atom,_,undefined},{string,_,_}} ->
+ %% UTF-8/16/32.
+ ok;
{{atom,_,undefined},{char,_,_}} ->
%% UTF-8/16/32.
ok;
@@ -983,6 +1077,31 @@ count_bits(Int) ->
count_bits_1(0, Bits) -> Bits;
count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64).
+bin_expand_strings(Es0) ->
+ foldr(fun ({bin_element,Line,{string,_,S},{integer,_,8},_}, Es) ->
+ bin_expand_string(S, Line, 0, 0) ++ Es;
+ ({bin_element,Line,{string,_,S},Sz,Ts}, Es1) ->
+ foldr(
+ fun (C, Es) ->
+ [{bin_element,Line,{char,Line,C},Sz,Ts}|Es]
+ end, Es1, S);
+ (E, Es) ->
+ [E|Es]
+ end, [], Es0).
+
+bin_expand_string(S, Line, Val, Size) when Size >= 2048 ->
+ Combined = make_combined(Line, Val, Size),
+ [Combined|bin_expand_string(S, Line, 0, 0)];
+bin_expand_string([H|T], Line, Val, Size) ->
+ bin_expand_string(T, Line, (Val bsl 8) bor H, Size+8);
+bin_expand_string([], Line, Val, Size) ->
+ [make_combined(Line, Val, Size)].
+
+make_combined(Line, Val, Size) ->
+ {bin_element,Line,{integer,Line,Val},
+ {integer,Line,Size},
+ [integer,{unit,1},unsigned,big]}.
+
expr_bin_1(Es, St) ->
foldr(fun (E, {Ces,Esp,St0}) ->
{Ce,Ep,St1} = bitstr(E, St0),
@@ -1018,22 +1137,24 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}.
-fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
+fun_tq(Cs0, L, St0, NameInfo) ->
Arity = clause_arity(hd(Cs0)),
{Cs1,Ceps,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
Anno = full_anno(L, St3),
+ {Name,St4} = new_fun_name(St3),
Fc = function_clause(Ps, Anno, {Name,Arity}),
+ Id = {0,0,Name},
Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
vars=Args,clauses=Cs1,fc=Fc,name=NameInfo},
- {Fun,Ceps,St3}.
+ {Fun,Ceps,St4}.
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
-lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps,
+lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno,ceps=Ceps,
acc_pat=AccPat,acc_guard=AccGuard,
skip_pat=SkipPat,tail=Tail,tail_pat=TailPat,
arg={Pre,Arg}}|Qs], Mc, St0) ->
@@ -1043,7 +1164,7 @@ lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps,
F = #c_var{anno=LA,name={Name,1}},
Nc = #iapply{anno=GAnno,op=F,args=[Tail]},
{Var,St2} = new_var(St1),
- Fc = function_clause([Var], LA, {Name,1}),
+ Fc = function_clause([Var], GA, {Name,1}),
TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]},
Cs0 = case {AccPat,AccGuard} of
{SkipPat,[]} ->
@@ -1066,9 +1187,9 @@ lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps,
body=Lps ++ [Lc]}|Cs0],
St3}
end,
- Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}],
- body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]},
+ Fun = #ifun{anno=GAnno,id=[],vars=[Var],clauses=Cs,fc=Fc},
+ {#iletrec{anno=GAnno#a{anno=[list_comprehension|GA]},defs=[{{Name,1},Fun}],
+ body=Pre ++ [#iapply{anno=GAnno,op=F,args=[Arg]}]},
Ceps,St4};
lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) ->
filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5);
@@ -1354,8 +1475,9 @@ list_gen_pattern(P0, Line, St) ->
%%% the result binary in a binary comprehension.
%%%
-bc_initial_size(E, Q, St0) ->
+bc_initial_size(E0, Q, St0) ->
try
+ E = bin_bin_element(E0),
{ElemSzExpr,ElemSzPre,EVs,St1} = bc_elem_size(E, St0),
{V,St2} = new_var(St1),
{GenSzExpr,GenSzPre,St3} = bc_gen_size(Q, EVs, St2),
@@ -1381,7 +1503,7 @@ bc_initial_size(E, Q, St0) ->
end.
bc_elem_size({bin,_,El}, St0) ->
- case bc_elem_size_1(El, 0, []) of
+ case bc_elem_size_1(El, ordsets:new(), 0, []) of
{Bits,[]} ->
{#c_literal{val=Bits},[],[],St0};
{Bits,Vars0} ->
@@ -1394,16 +1516,34 @@ bc_elem_size({bin,_,El}, St0) ->
bc_elem_size(_, _) ->
throw(impossible).
-bc_elem_size_1([{bin_element,_,_,{integer,_,N},Flags}|Es], Bits, Vars) ->
- {unit,U} = keyfind(unit, 1, Flags),
- bc_elem_size_1(Es, Bits+U*N, Vars);
-bc_elem_size_1([{bin_element,_,_,{var,_,Var},Flags}|Es], Bits, Vars) ->
- {unit,U} = keyfind(unit, 1, Flags),
- bc_elem_size_1(Es, Bits, [{U,#c_var{name=Var}}|Vars]);
-bc_elem_size_1([_|_], _, _) ->
+bc_elem_size_1([{bin_element,_,{string,_,String},{integer,_,N},_}=El|Es],
+ DefVars, Bits, SizeVars) ->
+ U = get_unit(El),
+ bc_elem_size_1(Es, DefVars, Bits+U*N*length(String), SizeVars);
+bc_elem_size_1([{bin_element,_,Expr,{integer,_,N},_}=El|Es],
+ DefVars0, Bits, SizeVars) ->
+ U = get_unit(El),
+ DefVars = bc_elem_size_def_var(Expr, DefVars0),
+ bc_elem_size_1(Es, DefVars, Bits+U*N, SizeVars);
+bc_elem_size_1([{bin_element,_,Expr,{var,_,Src},_}=El|Es],
+ DefVars0, Bits, SizeVars) ->
+ case ordsets:is_element(Src, DefVars0) of
+ false ->
+ U = get_unit(El),
+ DefVars = bc_elem_size_def_var(Expr, DefVars0),
+ bc_elem_size_1(Es, DefVars, Bits, [{U,#c_var{name=Src}}|SizeVars]);
+ true ->
+ throw(impossible)
+ end;
+bc_elem_size_1([_|_], _, _, _) ->
throw(impossible);
-bc_elem_size_1([], Bits, Vars) ->
- {Bits,Vars}.
+bc_elem_size_1([], _DefVars, Bits, SizeVars) ->
+ {Bits,SizeVars}.
+
+bc_elem_size_def_var({var,_,Var}, DefVars) ->
+ ordsets:add_element(Var, DefVars);
+bc_elem_size_def_var(_Expr, DefVars) ->
+ DefVars.
bc_elem_size_combine([{U,V}|T], U, UVars, Acc) ->
bc_elem_size_combine(T, U, [V|UVars], Acc);
@@ -1455,7 +1595,9 @@ bc_gen_size_1([{generate,L,El,Gen}|Qs], EVs, E0, Pre0, St0) ->
{E,Pre,St} = bc_gen_size_mul(E0, #c_literal{val=Len}, Pre0, St0),
bc_gen_size_1(Qs, EVs, E, Pre, St)
end;
-bc_gen_size_1([{b_generate,_,El,Gen}|Qs], EVs, E0, Pre0, St0) ->
+bc_gen_size_1([{b_generate,_,El0,Gen0}|Qs], EVs, E0, Pre0, St0) ->
+ El = bin_bin_element(El0),
+ Gen = bin_bin_element(Gen0),
bc_verify_non_filtering(El, EVs),
{MatchSzExpr,Pre1,_,St1} = bc_elem_size(El, St0),
Pre2 = reverse(Pre1, Pre0),
@@ -1471,6 +1613,10 @@ bc_gen_size_1([], _, E, Pre, St) ->
bc_gen_size_1(_, _, _, _, _) ->
throw(impossible).
+bin_bin_element({bin,L,El}) ->
+ {bin,L,[bin_element(E) || E <- El]};
+bin_bin_element(Other) -> Other.
+
bc_gen_bit_size({var,L,V}, Pre0, St0) ->
Lanno = lineno_anno(L, St0),
{SzVar,St} = new_var(St0),
@@ -1513,8 +1659,11 @@ bc_list_length(_, _) ->
bc_bin_size({bin,_,Els}) ->
bc_bin_size_1(Els, 0).
-bc_bin_size_1([{bin_element,_,_,{integer,_,Sz},Flags}|Els], N) ->
- {unit,U} = keyfind(unit, 1, Flags),
+bc_bin_size_1([{bin_element,_,{string,_,String},{integer,_,Sz},_}=El|Els], N) ->
+ U = get_unit(El),
+ bc_bin_size_1(Els, N+U*Sz*length(String));
+bc_bin_size_1([{bin_element,_,_,{integer,_,Sz},_}=El|Els], N) ->
+ U = get_unit(El),
bc_bin_size_1(Els, N+U*Sz);
bc_bin_size_1([], N) -> N;
bc_bin_size_1(_, _) -> throw(impossible).
@@ -1549,11 +1698,24 @@ bc_bsr(E1, E2) ->
name=#c_literal{val='bsr'},
args=[E1,E2]}.
-%% is_guard_test(Expression) -> true | false.
-%% Test if a general expression is a guard test. Use erl_lint here
-%% as it now allows sys_pre_expand transformed source.
+get_unit({bin_element,_,_,_,Flags}) ->
+ {unit,U} = keyfind(unit, 1, Flags),
+ U.
-is_guard_test(E) -> erl_lint:is_guard_test(E).
+%% is_guard_test(Expression) -> true | false.
+%% Test if a general expression is a guard test.
+%%
+%% Note that a local function overrides a BIF with the same name.
+%% For example, if there is a local function named is_list/1,
+%% any unqualified call to is_list/1 will be to the local function.
+%% The guard function must be explicitly called as erlang:is_list/1.
+
+is_guard_test(E) ->
+ %% erl_expand_records has added a module prefix to any call
+ %% to a BIF or imported function. Any call without a module
+ %% prefix that remains must therefore be to a local function.
+ IsOverridden = fun({_,_}) -> true end,
+ erl_lint:is_guard_test(E, [], IsOverridden).
%% novars(Expr, State) -> {Novars,[PreExpr],State}.
%% Generate a novars expression, basically a call or a safe. At this
@@ -1696,7 +1858,18 @@ pattern({bin,L,Ps}, St) ->
pattern({match,_,P1,P2}, St) ->
{Cp1,Eps1,St1} = pattern(P1,St),
{Cp2,Eps2,St2} = pattern(P2,St1),
- {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}.
+ {pat_alias(Cp1,Cp2),Eps1++Eps2,St2};
+%% Evaluate compile-time expressions.
+pattern({op,_,'++',{nil,_},R}, St) ->
+ pattern(R, St);
+pattern({op,_,'++',{cons,Li,H,T},R}, St) ->
+ pattern({cons,Li,H,{op,Li,'++',T,R}}, St);
+pattern({op,_,'++',{string,Li,L},R}, St) ->
+ pattern(string_to_conses(Li, L, R), St);
+pattern({op,_Line,_Op,_A}=Op, St) ->
+ pattern(erl_eval:partial_eval(Op), St);
+pattern({op,_Line,_Op,_L,_R}=Op, St) ->
+ pattern(erl_eval:partial_eval(Op), St).
%% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}]
pattern_map_pairs(Ps, St) ->
@@ -1736,18 +1909,29 @@ pat_alias_map_pairs_1([]) -> [].
%% pat_bin([BinElement], State) -> [BinSeg].
-pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
+pat_bin(Ps, St) -> [pat_segment(P, St) || P <- bin_expand_strings(Ps)].
-pat_segment({bin_element,L,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
+pat_segment({bin_element,L,Val,Size0,Type0}, St) ->
+ {Size,Type1} = make_bit_type(L, Size0, Type0),
+ [Type,{unit,Unit}|Flags] = Type1,
Anno = lineno_anno(L, St),
- {Pval,[],St1} = pattern(Val,St),
- {Psize,[],_St2} = pattern(Size,St1),
+ {Pval0,[],St1} = pattern(Val, St),
+ Pval = coerce_to_float(Pval0, Type0),
+ {Psize,[],_St2} = pattern(Size, St1),
#c_bitstr{anno=Anno,
val=Pval,size=Psize,
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
flags=#c_literal{val=Flags}}.
+coerce_to_float(#c_literal{val=Int}=E, [float|_]) when is_integer(Int) ->
+ try
+ E#c_literal{val=float(Int)}
+ catch
+ error:badarg -> E
+ end;
+coerce_to_float(E, _) -> E.
+
%% pat_alias(CorePat, CorePat) -> AliasPat.
%% Normalise aliases. Trap bad aliases by throwing 'nomatch'.
@@ -1817,11 +2001,18 @@ pattern_list([P0|Ps0], St0) ->
pattern_list([], St) ->
{[],[],St}.
+string_to_conses(Line, Cs, Tail) ->
+ foldr(fun (C, T) -> {cons,Line,{char,Line,C},T} end, Tail, Cs).
%% make_vars([Name]) -> [{Var,Name}].
make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ].
+new_fun_name(#core{function={F,A},fcount=I}=St) ->
+ Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A)
+ ++ "-fun-" ++ integer_to_list(I) ++ "-",
+ {list_to_atom(Name),St#core{fcount=I+1}}.
+
%% new_fun_name(Type, State) -> {FunName,State}.
new_fun_name(Type, #core{fcount=C}=St) ->
@@ -1830,7 +2021,7 @@ new_fun_name(Type, #core{fcount=C}=St) ->
%% new_var_name(State) -> {VarName,State}.
new_var_name(#core{vcount=C}=St) ->
- {list_to_atom("cor" ++ integer_to_list(C)),St#core{vcount=C + 1}}.
+ {C,St#core{vcount=C + 1}}.
%% new_var(State) -> {{var,Name},State}.
%% new_var(LineAnno, State) -> {{var,Name},State}.
@@ -1865,6 +2056,19 @@ fail_clause(Pats, Anno, Arg) ->
body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail},
args=[Arg]}]}.
+%% Optimization for Dialyzer.
+right_assoc(E, Op, St) ->
+ case member(dialyzer, St#core.opts) of
+ true ->
+ right_assoc2(E, Op);
+ false ->
+ E
+ end.
+
+right_assoc2({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) ->
+ right_assoc2({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op);
+right_assoc2(E, _Op) -> E.
+
annotate_tuple(A, Es, St) ->
case member(dialyzer, St#core.opts) of
true ->
@@ -2307,9 +2511,11 @@ cexpr(#icase{anno=A,args=Largs,clauses=Lcs,fc=Lfc}, As, St0) ->
cexpr(#ireceive1{anno=A,clauses=Lcs}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
{Ccs,St1} = cclauses(Lcs, Exp, St0),
+ True = #c_literal{val=true},
+ Action = core_lib:make_values(lists:duplicate(1+length(Exp), True)),
{#c_receive{anno=A#a.anno,
clauses=Ccs,
- timeout=#c_literal{val=infinity},action=#c_literal{val=true}},
+ timeout=#c_literal{val=infinity},action=Action},
Exp,A#a.us,St1};
cexpr(#ireceive2{anno=A,clauses=Lcs,timeout=Lto,action=Les}, As, St0) ->
Exp = intersection(A#a.ns, As), %Exports
@@ -2350,8 +2556,46 @@ cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0,
end;
cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) ->
{#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St};
-cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) ->
- {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St};
+cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St0) ->
+ Anno = A#a.anno,
+ case (not cerl:is_c_atom(Mod)) andalso member(tuple_calls, St0#core.opts) of
+ true ->
+ GenAnno = [compiler_generated|Anno],
+
+ %% Generate the clause that matches on the tuple
+ {TupleVar,St1} = new_var(GenAnno, St0),
+ {TupleSizeVar, St2} = new_var(GenAnno, St1),
+ {TupleModVar, St3} = new_var(GenAnno, St2),
+ {TupleArgsVar, St4} = new_var(GenAnno, St3),
+ TryVar = cerl:c_var('Try'),
+
+ TupleGuardExpr =
+ cerl:c_let([TupleSizeVar],
+ c_call_erl(tuple_size, [TupleVar]),
+ c_call_erl('>', [TupleSizeVar, cerl:c_int(0)])),
+
+ TupleGuard =
+ cerl:c_try(TupleGuardExpr, [TryVar], TryVar,
+ [cerl:c_var('T'),cerl:c_var('R')], cerl:c_atom(false)),
+
+ TupleApply =
+ cerl:c_let([TupleModVar],
+ c_call_erl(element, [cerl:c_int(1),TupleVar]),
+ cerl:c_let([TupleArgsVar],
+ cerl:make_list(Args ++ [TupleVar]),
+ c_call_erl(apply, [TupleModVar,Name,TupleArgsVar]))),
+
+ TupleClause = cerl:ann_c_clause(GenAnno, [TupleVar], TupleGuard, TupleApply),
+
+ %% Generate the fallback clause
+ {OtherVar,St5} = new_var(GenAnno, St4),
+ OtherApply = cerl:ann_c_call(GenAnno, OtherVar, Name, Args),
+ OtherClause = cerl:ann_c_clause(GenAnno, [OtherVar], OtherApply),
+
+ {cerl:ann_c_case(GenAnno, Mod, [TupleClause,OtherClause]),[],A#a.us,St5};
+ false ->
+ {#c_call{anno=Anno,module=Mod,name=Name,args=Args},[],A#a.us,St0}
+ end;
cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) ->
{#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St};
cexpr(#iprotect{anno=A,body=Es}, _As, St0) ->
@@ -2381,6 +2625,9 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
clauses=Ccs ++ [Cfc]}},
[],A#a.us,St2}.
+c_call_erl(Fun, Args) ->
+ cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args).
+
%% lit_vars(Literal) -> [Var].
lit_vars(Lit) -> lit_vars(Lit, []).
@@ -2475,7 +2722,11 @@ format_error(nomatch) ->
format_error(bad_binary) ->
"binary construction will fail because of a type mismatch";
format_error(badmap) ->
- "map construction will fail because of a type mismatch".
+ "map construction will fail because of a type mismatch";
+format_error({map_key_repeated,Key}) when is_atom(Key) ->
+ io_lib:format("key '~w' will be overridden in expression", [Key]);
+format_error({map_key_repeated,Key}) ->
+ io_lib:format("key ~p will be overridden in expression", [Key]).
add_warning(Anno, Term, #core{ws=Ws,file=[{file,File}]}=St) ->
case erl_anno:generated(Anno) of
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index b4bbc5e739..aef0b6cc9f 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -82,7 +82,8 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
- keymember/3,keyfind/3,partition/2,droplast/1,last/1]).
+ keymember/3,keyfind/3,partition/2,droplast/1,last/1,sort/1,
+ reverse/1]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
-import(cerl, [c_tuple/1]).
@@ -107,6 +108,7 @@ copy_anno(Kdst, Ksrc) ->
-record(iclause, {anno=[],isub,osub,pats,guard,body}).
-record(ireceive_accept, {anno=[],arg}).
-record(ireceive_next, {anno=[],arg}).
+-record(ignored, {anno=[]}).
-type warning() :: term(). % XXX: REFINE
@@ -148,24 +150,30 @@ include_attribute(opaque) -> false;
include_attribute(export_type) -> false;
include_attribute(record) -> false;
include_attribute(optional_callbacks) -> false;
+include_attribute(file) -> false;
+include_attribute(compile) -> false;
include_attribute(_) -> true.
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
+ %%io:format("~w/~w~n", [F,Arity]),
try
- St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=cerl_sets:new()},
+ %% Find a suitable starting value for the variable counter. Note
+ %% that this pass assumes that new_var_name/1 returns a variable
+ %% name distinct from any variable used in the entire body of
+ %% the function. We use integers as variable names to avoid
+ %% filling up the atom table when compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(Body),
+ St1 = St0#kern{func=FA,ff=undefined,vcount=Count,fcount=0,ds=cerl_sets:new()},
{#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1),
{B1,_,St3} = ubody(B0, return, St2),
%%B1 = B0, St3 = St2, %Null second pass
- {#k_fdef{anno=#k{us=[],ns=[],a=Ab},
- func=F,arity=Arity,vars=Kvs,body=B1},St3}
+ {make_fdef(#k{us=[],ns=[],a=Ab}, F, Arity, Kvs, B1),St3}
catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
+ Class:Error:Stack ->
io:fwrite("Function: ~w/~w\n", [F,Arity]),
erlang:raise(Class, Error, Stack)
end.
-
%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}.
%% Do the main sequence of a body. A body ends in an atomic value or
%% values. Must check if vector first so do expr.
@@ -190,9 +198,479 @@ body(Ce, Sub, St0) ->
guard(G0, Sub, St0) ->
{G1,St1} = wrap_guard(G0, St0),
{Ge0,Pre,St2} = expr(G1, Sub, St1),
- {Ge,St} = gexpr_test(Ge0, St2),
+ {Ge1,St3} = gexpr_test(Ge0, St2),
+ {Ge,St} = guard_opt(Ge1, St3),
{pre_seq(Pre, Ge),St}.
+%% guard_opt(Kexpr, State) -> {Kexpr,State}.
+%% Optimize the Kexpr for the guard. Instead of evaluating a boolean
+%% expression comparing it to 'true' in a final #k_test{},
+%% replace BIF calls with #k_test{} in the expression.
+%%
+%% As an example, take the guard:
+%%
+%% when is_integer(V0), is_atom(V1) ->
+%%
+%% The unoptimized Kexpr translated to pseudo BEAM assembly
+%% code would look like:
+%%
+%% bif is_integer V0 => Bool0
+%% bif is_atom V1 => Bool1
+%% bif and Bool0 Bool1 => Bool
+%% test Bool =:= true else goto Fail
+%% ...
+%% Fail:
+%% ...
+%%
+%% The optimized code would look like:
+%%
+%% test is_integer V0 else goto Fail
+%% test is_atom V1 else goto Fail
+%% ...
+%% Fail:
+%% ...
+%%
+%% An 'or' operation is only slightly more complicated:
+%%
+%% test is_integer V0 else goto NotFailedYet
+%% goto Success
+%%
+%% NotFailedYet:
+%% test is_atom V1 else goto Fail
+%%
+%% Success:
+%% ...
+%% Fail:
+%% ...
+
+guard_opt(G, St0) ->
+ {Root,Forest0,St1} = make_forest(G, St0),
+ {Exprs,Forest,St} = rewrite_bool(Root, Forest0, false, St1),
+ E = forest_pre_seq(Exprs, Forest),
+ {G#k_try{arg=E},St}.
+
+%% rewrite_bool(Kexpr, Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%% Rewrite Kexpr to use #k_test{} operations instead of comparison
+%% and type test BIFs.
+%%
+%% If Kexpr is a #k_test{} operation, the call will always
+%% succeed. Otherwise, a 'not_possible' exception will be
+%% thrown if Kexpr cannot be rewritten.
+
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+ args=[#k_var{}=V,#k_atom{val=true}]}=Test, Forest0, Inv, St0) ->
+ try rewrite_bool_var(V, Forest0, Inv, St0) of
+ {_,_,_}=Res ->
+ Res
+ catch
+ throw:not_possible ->
+ {[Test],Forest0,St0}
+ end;
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+ args=[#k_var{}=V,#k_atom{val=false}]}=Test, Forest0, Inv, St0) ->
+ try rewrite_bool_var(V, Forest0, not Inv, St0) of
+ {_,_,_}=Res ->
+ Res
+ catch
+ throw:not_possible ->
+ {[Test],Forest0,St0}
+ end;
+rewrite_bool(#k_test{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='=:='}},
+ args=[#k_atom{val=V1},#k_atom{val=V2}]}, Forest0, false, St0) ->
+ case V1 =:= V2 of
+ true ->
+ {[make_test(is_boolean, [#k_atom{val=true}])],Forest0,St0};
+ false ->
+ {[make_failing_test()],Forest0,St0}
+ end;
+rewrite_bool(#k_test{}=Test, Forest, false, St) ->
+ {[Test],Forest,St};
+rewrite_bool(#k_try{vars=[#k_var{name=X}],body=#k_var{name=X},
+ handler=#k_atom{val=false},ret=[]}=Prot,
+ Forest0, Inv, St0) ->
+ {Root,Forest1,St1} = make_forest(Prot, Forest0, St0),
+ {Exprs,Forest2,St} = rewrite_bool(Root, Forest1, Inv, St1),
+ InnerForest = maps:without(maps:keys(Forest0), Forest2),
+ Forest = maps:without(maps:keys(InnerForest), Forest2),
+ E = forest_pre_seq(Exprs, InnerForest),
+ {[Prot#k_try{arg=E}],Forest,St};
+rewrite_bool(#k_match{body=Body,ret=[]}, Forest, Inv, St) ->
+ rewrite_match(Body, Forest, Inv, St);
+rewrite_bool(Other, Forest, Inv, St) ->
+ case extract_bif(Other) of
+ {Name,Args} ->
+ rewrite_bif(Name, Args, Forest, Inv, St);
+ error ->
+ throw(not_possible)
+ end.
+
+%% rewrite_bool_var(Var, Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%% Rewrite the boolean expression whose key in Forest is
+%% given by Var. Throw a 'not_possible' expression if something
+%% prevents the rewriting.
+
+rewrite_bool_var(Arg, Forest0, Inv, St) ->
+ {Expr,Forest} = forest_take_expr(Arg, Forest0),
+ rewrite_bool(Expr, Forest, Inv, St).
+
+%% rewrite_bool_args([Kexpr], Forest, Inv, St) -> {[[Kexpr]],Forest,St}.
+%% Rewrite each Kexpr in the list. The input Kexpr should be variables
+%% or boolean values. Throw a 'not_possible' expression if something
+%% prevents the rewriting.
+%%
+%% This function is suitable for handling the arguments for both
+%% 'and' and 'or'.
+
+rewrite_bool_args([#k_atom{val=B}=A|Vs], Forest0, false=Inv, St0) when is_boolean(B) ->
+ {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0),
+ Bif = make_bif('=:=', [A,#k_atom{val=true}]),
+ {Exprs,Forest,St} = rewrite_bool(Bif, Forest1, Inv, St1),
+ {[Exprs|Tail],Forest,St};
+rewrite_bool_args([#k_var{}=Var|Vs], Forest0, false=Inv, St0) ->
+ {Tail,Forest1,St1} = rewrite_bool_args(Vs, Forest0, Inv, St0),
+ {Exprs,Forest,St} =
+ case is_bool_expr(Var, Forest0) of
+ true ->
+ rewrite_bool_var(Var, Forest1, Inv, St1);
+ false ->
+ Bif = make_bif('=:=', [Var,#k_atom{val=true}]),
+ rewrite_bool(Bif, Forest1, Inv, St1)
+ end,
+ {[Exprs|Tail],Forest,St};
+rewrite_bool_args([_|_], _Forest, _Inv, _St) ->
+ throw(not_possible);
+rewrite_bool_args([], Forest, _Inv, St) ->
+ {[],Forest,St}.
+
+%% rewrite_bif(Name, [Kexpr], Forest, Inv, St) -> {[Kexpr],Forest,St}.
+%% Rewrite a BIF. Throw a 'not_possible' expression if something
+%% prevents the rewriting.
+
+rewrite_bif('or', Args, Forest, true, St) ->
+ rewrite_not_args('and', Args, Forest, St);
+rewrite_bif('and', Args, Forest, true, St) ->
+ rewrite_not_args('or', Args, Forest, St);
+rewrite_bif('and', [#k_atom{val=Val},Arg], Forest0, Inv, St0) ->
+ false = Inv, %Assertion.
+ case Val of
+ true ->
+ %% The result only depends on Arg.
+ rewrite_bool_var(Arg, Forest0, Inv, St0);
+ _ ->
+ %% Will fail. There is no need to evalute the expression
+ %% represented by Arg. Take it out from the forest and
+ %% discard the expression.
+ Failing = make_failing_test(),
+ try rewrite_bool_var(Arg, Forest0, Inv, St0) of
+ {_,Forest,St} ->
+ {[Failing],Forest,St}
+ catch
+ throw:not_possible ->
+ try forest_take_expr(Arg, Forest0) of
+ {_,Forest} ->
+ {[Failing],Forest,St0}
+ catch
+ throw:not_possible ->
+ %% Arg is probably a variable bound in an
+ %% outer scope.
+ {[Failing],Forest0,St0}
+ end
+ end
+ end;
+rewrite_bif('and', [Arg,#k_atom{}=Atom], Forest, Inv, St) ->
+ false = Inv, %Assertion.
+ rewrite_bif('and', [Atom,Arg], Forest, Inv, St);
+rewrite_bif('and', Args, Forest0, Inv, St0) ->
+ false = Inv, %Assertion.
+ {[Es1,Es2],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0),
+ {Es1 ++ Es2,Forest,St};
+rewrite_bif('or', Args, Forest0, Inv, St0) ->
+ false = Inv, %Assertion.
+ {[First,Then],Forest,St} = rewrite_bool_args(Args, Forest0, Inv, St0),
+ Alt = make_alt(First, Then),
+ {[Alt],Forest,St};
+rewrite_bif('xor', [_,_], _Forest, _Inv, _St) ->
+ %% Rewriting 'xor' is not practical. Fortunately, 'xor' is
+ %% almost never used in practice.
+ throw(not_possible);
+rewrite_bif('not', [Arg], Forest0, Inv, St) ->
+ {Expr,Forest} = forest_take_expr(Arg, Forest0),
+ rewrite_bool(Expr, Forest, not Inv, St);
+rewrite_bif(Op, Args, Forest, Inv, St) ->
+ case is_test(Op, Args) of
+ true ->
+ rewrite_bool(make_test(Op, Args, Inv), Forest, false, St);
+ false ->
+ throw(not_possible)
+ end.
+
+rewrite_not_args(Op, [A0,B0], Forest0, St0) ->
+ {A,Forest1,St1} = rewrite_not_args_1(A0, Forest0, St0),
+ {B,Forest2,St2} = rewrite_not_args_1(B0, Forest1, St1),
+ rewrite_bif(Op, [A,B], Forest2, false, St2).
+
+rewrite_not_args_1(Arg, Forest, St) ->
+ Not = make_bif('not', [Arg]),
+ forest_add_expr(Not, Forest, St).
+
+%% rewrite_match(Kvar, TypeClause, Forest, Inv, St) ->
+%% {[Kexpr],Forest,St}.
+%% Try to rewrite a #k_match{} originating from an 'andalso' or an 'orelse'.
+
+rewrite_match(#k_alt{first=First,then=Then}, Forest, Inv, St) ->
+ case {First,Then} of
+ {#k_select{var=#k_var{name=V}=Var,types=[TypeClause]},#k_var{name=V}} ->
+ rewrite_match_1(Var, TypeClause, Forest, Inv, St);
+ {_,_} ->
+ throw(not_possible)
+ end.
+
+rewrite_match_1(Var, #k_type_clause{values=Cs0}, Forest0, Inv, St0) ->
+ Cs = sort([{Val,B} || #k_val_clause{val=#k_atom{val=Val},body=B} <- Cs0]),
+ case Cs of
+ [{false,False},{true,True}] ->
+ rewrite_match_2(Var, False, True, Forest0, Inv, St0);
+ _ ->
+ throw(not_possible)
+ end.
+
+rewrite_match_2(Var, False, #k_atom{val=true}, Forest0, Inv, St0) ->
+ %% Originates from an 'orelse'.
+ case False of
+ #k_atom{val=NotBool} when not is_boolean(NotBool) ->
+ rewrite_bool(Var, Forest0, Inv, St0);
+ _ ->
+ {CodeVar,Forest1,St1} = add_protected_expr(False, Forest0, St0),
+ rewrite_bif('or', [Var,CodeVar], Forest1, Inv, St1)
+ end;
+rewrite_match_2(Var, #k_atom{val=false}, True, Forest0, Inv, St0) ->
+ %% Originates from an 'andalso'.
+ {CodeVar,Forest1,St1} = add_protected_expr(True, Forest0, St0),
+ rewrite_bif('and', [Var,CodeVar], Forest1, Inv, St1);
+rewrite_match_2(_V, _, _, _Forest, _Inv, _St) ->
+ throw(not_possible).
+
+%% is_bool_expr(#k_var{}, Forest) -> true|false.
+%% Return true if the variable refers to a boolean expression
+%% that does not need an explicit '=:= true' test.
+
+is_bool_expr(V, Forest) ->
+ case forest_peek_expr(V, Forest) of
+ error ->
+ %% Defined outside of the guard. We can't know.
+ false;
+ Expr ->
+ case extract_bif(Expr) of
+ {Name,Args} ->
+ is_test(Name, Args) orelse
+ erl_internal:bool_op(Name, length(Args));
+ error ->
+ %% Not a BIF. Should be possible to rewrite
+ %% to a boolean. Definitely does not need
+ %% a '=:= true' test.
+ true
+ end
+ end.
+
+make_bif(Op, Args) ->
+ #k_bif{op=#k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=Op},
+ arity=length(Args)},
+ args=Args}.
+
+extract_bif(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=Name}},
+ args=Args}) ->
+ {Name,Args};
+extract_bif(_) ->
+ error.
+
+%% make_alt(First, Then) -> KMatch.
+%% Make a #k_alt{} within a #k_match{} to implement
+%% 'or' or 'orelse'.
+
+make_alt(First0, Then0) ->
+ First1 = pre_seq(droplast(First0), last(First0)),
+ Then1 = pre_seq(droplast(Then0), last(Then0)),
+ First2 = make_protected(First1),
+ Then2 = make_protected(Then1),
+ Body = #ignored{},
+ First3 = #k_guard_clause{guard=First2,body=Body},
+ Then3 = #k_guard_clause{guard=Then2,body=Body},
+ First = #k_guard{clauses=[First3]},
+ Then = #k_guard{clauses=[Then3]},
+ Alt = #k_alt{first=First,then=Then},
+ #k_match{vars=[],body=Alt}.
+
+add_protected_expr(#k_atom{}=Atom, Forest, St) ->
+ {Atom,Forest,St};
+add_protected_expr(#k_var{}=Var, Forest, St) ->
+ {Var,Forest,St};
+add_protected_expr(E0, Forest, St) ->
+ E = make_protected(E0),
+ forest_add_expr(E, Forest, St).
+
+make_protected(#k_try{}=Try) ->
+ Try;
+make_protected(B) ->
+ #k_try{arg=B,vars=[#k_var{name=''}],body=#k_var{name=''},
+ handler=#k_atom{val=false}}.
+
+make_failing_test() ->
+ make_test(is_boolean, [#k_atom{val=fail}]).
+
+make_test(Op, Args) ->
+ make_test(Op, Args, false).
+
+make_test(Op, Args, Inv) ->
+ Remote = #k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=Op},
+ arity=length(Args)},
+ #k_test{op=Remote,args=Args,inverted=Inv}.
+
+is_test(Op, Args) ->
+ A = length(Args),
+ erl_internal:new_type_test(Op, A) orelse erl_internal:comp_op(Op, A).
+
+%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}.
+%% Build a forest out of Kexpr. RootKexpr is the final expression
+%% nested inside Kexpr.
+
+make_forest(G, St) ->
+ make_forest_1(G, #{}, 0, St).
+
+%% make_forest(Kexpr, St) -> {RootKexpr,Forest,St}.
+%% Add to Forest from Kexpr. RootKexpr is the final expression
+%% nested inside Kexpr.
+
+make_forest(G, Forest0, St) ->
+ N = forest_next_index(Forest0),
+ make_forest_1(G, Forest0, N, St).
+
+make_forest_1(#k_try{arg=B}, Forest, I, St) ->
+ make_forest_1(B, Forest, I, St);
+make_forest_1(#iset{vars=[]}=Iset0, Forest, I, St0) ->
+ {UnrefVar,St} = new_var(St0),
+ Iset = Iset0#iset{vars=[UnrefVar]},
+ make_forest_1(Iset, Forest, I, St);
+make_forest_1(#iset{vars=[#k_var{name=V}],arg=Arg,body=B}, Forest0, I, St) ->
+ Forest = Forest0#{V => {I,Arg}, {untaken,V} => true},
+ make_forest_1(B, Forest, I+1, St);
+make_forest_1(Innermost, Forest, _I, St) ->
+ {Innermost,Forest,St}.
+
+%% forest_take_expr(Kexpr, Forest) -> {Expr,Forest}.
+%% If Kexpr is a variable, take out the expression corresponding
+%% to variable in Forest. Expressions that have been taken out
+%% of the forest will not be included the Kexpr returned
+%% by forest_pre_seq/2.
+%%
+%% Throw a 'not_possible' exception if Kexpr is not a variable or
+%% if the name of the variable is not a key in Forest.
+
+forest_take_expr(#k_var{name=V}, Forest0) ->
+ %% v3_core currently always generates guard expressions that can
+ %% be represented as a tree. Other code generators (such as LFE)
+ %% could generate guard expressions that can only be represented
+ %% as a DAG (i.e. some nodes are referenced more than once). To
+ %% handle DAGs, we must never remove a node from the forest, but
+ %% just remove the {untaken,V} marker. That will effectively convert
+ %% the DAG to a tree by duplicating the shared nodes and their
+ %% descendants.
+
+ case maps:find(V, Forest0) of
+ {ok,{_,Expr}} ->
+ Forest = maps:remove({untaken,V}, Forest0),
+ {Expr,Forest};
+ error ->
+ throw(not_possible)
+ end;
+forest_take_expr(_, _) ->
+ throw(not_possible).
+
+%% forest_peek_expr(Kvar, Forest) -> Kexpr | error.
+%% Return the expression corresponding to Kvar in Forest or
+%% return 'error' if there is a corresponding expression.
+
+forest_peek_expr(#k_var{name=V}, Forest0) ->
+ case maps:find(V, Forest0) of
+ {ok,{_,Expr}} -> Expr;
+ error -> error
+ end.
+
+%% forest_add_expr(Kexpr, Forest, St) -> {Kvar,Forest,St}.
+%% Add a new expression to Forest.
+
+forest_add_expr(Expr, Forest0, St0) ->
+ {#k_var{name=V}=Var,St} = new_var(St0),
+ N = forest_next_index(Forest0),
+ Forest = Forest0#{V => {N,Expr}},
+ {Var,Forest,St}.
+
+forest_next_index(Forest) ->
+ 1 + lists:max([N || {N,_} <- maps:values(Forest),
+ is_integer(N)] ++ [0]).
+
+%% forest_pre_seq([Kexpr], Forest) -> Kexpr.
+%% Package the list of Kexprs into a nested Kexpr, prepending all
+%% expressions in Forest that have not been taken out using
+%% forest_take_expr/2.
+
+forest_pre_seq(Exprs, Forest) ->
+ Es0 = [#k_var{name=V} || {untaken,V} <- maps:keys(Forest)],
+ Es = Es0 ++ Exprs,
+ Vs = extract_all_vars(Es, Forest, []),
+ Pre0 = sort([{maps:get(V, Forest),V} || V <- Vs]),
+ Pre = [#iset{vars=[#k_var{name=V}],arg=A} ||
+ {{_,A},V} <- Pre0],
+ pre_seq(Pre++droplast(Exprs), last(Exprs)).
+
+extract_all_vars(Es, Forest, Acc0) ->
+ case extract_var_list(Es) of
+ [] ->
+ Acc0;
+ [_|_]=Vs0 ->
+ Vs = [V || V <- Vs0, maps:is_key(V, Forest)],
+ NewVs = ordsets:subtract(Vs, Acc0),
+ NewEs = [begin
+ {_,E} = maps:get(V, Forest),
+ E
+ end || V <- NewVs],
+ Acc = union(NewVs, Acc0),
+ extract_all_vars(NewEs, Forest, Acc)
+ end.
+
+extract_vars(#iset{arg=A,body=B}) ->
+ union(extract_vars(A), extract_vars(B));
+extract_vars(#k_bif{args=Args}) ->
+ ordsets:from_list(lit_list_vars(Args));
+extract_vars(#k_call{}) ->
+ [];
+extract_vars(#k_test{args=Args}) ->
+ ordsets:from_list(lit_list_vars(Args));
+extract_vars(#k_match{body=Body}) ->
+ extract_vars(Body);
+extract_vars(#k_alt{first=First,then=Then}) ->
+ union(extract_vars(First), extract_vars(Then));
+extract_vars(#k_guard{clauses=Cs}) ->
+ extract_var_list(Cs);
+extract_vars(#k_guard_clause{guard=G}) ->
+ extract_vars(G);
+extract_vars(#k_select{var=Var,types=Types}) ->
+ union(ordsets:from_list(lit_vars(Var)),
+ extract_var_list(Types));
+extract_vars(#k_type_clause{values=Values}) ->
+ extract_var_list(Values);
+extract_vars(#k_val_clause{body=Body}) ->
+ extract_vars(Body);
+extract_vars(#k_try{arg=Arg}) ->
+ extract_vars(Arg);
+extract_vars(Lit) ->
+ ordsets:from_list(lit_vars(Lit)).
+
+extract_var_list(L) ->
+ union([extract_vars(E) || E <- L]).
+
%% Wrap the entire guard in a try/catch if needed.
wrap_guard(#c_try{}=Try, St) -> {Try,St};
@@ -840,23 +1318,26 @@ get_vsub(V, Vsub) ->
set_vsub(V, S, Vsub) ->
orddict:store(V, S, Vsub).
-subst_vsub(Key, New, [{K,Key}|Dict]) ->
+subst_vsub(Key, New, Vsub) ->
+ orddict:from_list(subst_vsub_1(Key, New, Vsub)).
+
+subst_vsub_1(Key, New, [{K,Key}|Dict]) ->
%% Fold chained substitution.
- [{K,New}|subst_vsub(Key, New, Dict)];
-subst_vsub(Key, New, [{K,_}|_]=Dict) when Key < K ->
+ [{K,New}|subst_vsub_1(Key, New, Dict)];
+subst_vsub_1(Key, New, [{K,_}|_]=Dict) when Key < K ->
%% Insert the new substitution here, and continue
%% look for chained substitutions.
- [{Key,New}|subst_vsub_1(Key, New, Dict)];
-subst_vsub(Key, New, [{K,_}=E|Dict]) when Key > K ->
- [E|subst_vsub(Key, New, Dict)];
-subst_vsub(Key, New, []) -> [{Key,New}].
+ [{Key,New}|subst_vsub_2(Key, New, Dict)];
+subst_vsub_1(Key, New, [{K,_}=E|Dict]) when Key > K ->
+ [E|subst_vsub_1(Key, New, Dict)];
+subst_vsub_1(Key, New, []) -> [{Key,New}].
-subst_vsub_1(V, S, [{K,V}|Dict]) ->
+subst_vsub_2(V, S, [{K,V}|Dict]) ->
%% Fold chained substitution.
- [{K,S}|subst_vsub_1(V, S, Dict)];
-subst_vsub_1(V, S, [E|Dict]) ->
- [E|subst_vsub_1(V, S, Dict)];
-subst_vsub_1(_, _, []) -> [].
+ [{K,S}|subst_vsub_2(V, S, Dict)];
+subst_vsub_2(V, S, [E|Dict]) ->
+ [E|subst_vsub_2(V, S, Dict)];
+subst_vsub_2(_, _, []) -> [].
get_fsub(F, A, Fsub) ->
case orddict:find({F,A}, Fsub) of
@@ -880,7 +1361,7 @@ new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) ->
%% new_var_name(State) -> {VarName,State}.
new_var_name(#kern{vcount=C}=St) ->
- {list_to_atom("ker" ++ integer_to_list(C)),St#kern{vcount=C+1}}.
+ {C,St#kern{vcount=C+1}}.
%% new_var(State) -> {#k_var{},State}.
@@ -1113,23 +1594,18 @@ match_var([U|Us], Cs0, Def, St) ->
%% according to type, the order is really irrelevant but tries to be
%% smart.
-match_con(Us, [C], Def, St) ->
- %% There is only one clause. We can keep literal tuples and
- %% lists, but we must convert []/integer/float/atom literals
- %% to the proper record (#k_nil{} and so on).
- Cs = [expand_pat_lit_clause(C, false)],
- match_con_1(Us, Cs, Def, St);
match_con(Us, Cs0, Def, St) ->
- %% More than one clause. Remove literals at the top level.
- Cs = [expand_pat_lit_clause(C, true) || C <- Cs0],
+ %% Expand literals at the top level.
+ Cs = [expand_pat_lit_clause(C) || C <- Cs0],
match_con_1(Us, Cs, Def, St).
match_con_1([U|_Us] = L, Cs, Def, St0) ->
%% Extract clauses for different constructors (types).
%%ok = io:format("match_con ~p~n", [Cs]),
- Ttcs = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++
- select_types([k_cons,k_tuple,k_map,k_atom,k_float,k_int,
- k_nil,k_literal], Cs),
+ Ttcs0 = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++
+ select_types([k_cons,k_tuple,k_map,k_atom,k_float,
+ k_int,k_nil], Cs),
+ Ttcs = opt_single_valued(Ttcs0),
%%ok = io:format("ttcs = ~p~n", [Ttcs]),
{Scs,St1} =
mapfoldl(fun ({T,Tcs}, St) ->
@@ -1142,28 +1618,14 @@ match_con_1([U|_Us] = L, Cs, Def, St0) ->
select_types(Types, Cs) ->
[{T,Tcs} || T <- Types, begin Tcs = select(T, Cs), Tcs =/= [] end].
-
-expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C, B) ->
- P = case B of
- true -> expand_pat_lit(Val, A);
- false -> literal(Val, A)
- end,
+
+expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C) ->
+ P = expand_pat_lit(Val, A),
C#iclause{pats=[Alias#ialias{pat=P}|Ps]};
-expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C, B) ->
- P = case B of
- true -> expand_pat_lit(Val, A);
- false -> literal(Val, A)
- end,
+expand_pat_lit_clause(#iclause{pats=[#k_literal{anno=A,val=Val}|Ps]}=C) ->
+ P = expand_pat_lit(Val, A),
C#iclause{pats=[P|Ps]};
-expand_pat_lit_clause(#iclause{pats=[#k_binary{anno=A,segs=#k_bin_end{}}|Ps]}=C, B) ->
- case B of
- true ->
- C;
- false ->
- P = #k_literal{anno=A,val = <<>>},
- C#iclause{pats=[P|Ps]}
- end;
-expand_pat_lit_clause(C, _) -> C.
+expand_pat_lit_clause(C) -> C.
expand_pat_lit([H|T], A) ->
#k_cons{anno=A,hd=literal(H, A),tl=literal(T, A)};
@@ -1183,6 +1645,107 @@ literal(Val, A) when is_atom(Val) ->
literal(Val, A) when is_list(Val); is_tuple(Val) ->
#k_literal{anno=A,val=Val}.
+%% opt_singled_valued([{Type,Clauses}]) -> [{Type,Clauses}].
+%% If a type only has one clause and if the pattern is literal,
+%% the matching can be done more efficiently by directly comparing
+%% with the literal (that is especially true for binaries).
+
+opt_single_valued(Ttcs) ->
+ opt_single_valued(Ttcs, [], []).
+
+opt_single_valued([{_,[#iclause{pats=[P0|Ps]}=Tc]}=Ttc|Ttcs], TtcAcc, LitAcc) ->
+ try combine_lit_pat(P0) of
+ P ->
+ LitTtc = Tc#iclause{pats=[P|Ps]},
+ opt_single_valued(Ttcs, TtcAcc, [LitTtc|LitAcc])
+ catch
+ not_possible ->
+ opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc)
+ end;
+opt_single_valued([Ttc|Ttcs], TtcAcc, LitAcc) ->
+ opt_single_valued(Ttcs, [Ttc|TtcAcc], LitAcc);
+opt_single_valued([], TtcAcc, []) ->
+ reverse(TtcAcc);
+opt_single_valued([], TtcAcc, LitAcc) ->
+ Literals = {k_literal,reverse(LitAcc)},
+ %% Test the literals as early as possible.
+ case reverse(TtcAcc) of
+ [{k_binary,_}=Bin|Ttcs] ->
+ %% The delayed creation of sub binaries requires
+ %% bs_start_match2 to be the first instruction in the
+ %% function.
+ [Bin,Literals|Ttcs];
+ Ttcs ->
+ [Literals|Ttcs]
+ end.
+
+combine_lit_pat(#ialias{pat=Pat0}=Alias) ->
+ Pat = combine_lit_pat(Pat0),
+ Alias#ialias{pat=Pat};
+combine_lit_pat(Pat) ->
+ case do_combine_lit_pat(Pat) of
+ #k_literal{val=Val} when is_atom(Val) ->
+ throw(not_possible);
+ #k_literal{val=Val} when is_number(Val) ->
+ throw(not_possible);
+ #k_literal{val=[]} ->
+ throw(not_possible);
+ #k_literal{}=Lit ->
+ Lit
+ end.
+
+do_combine_lit_pat(#k_atom{anno=A,val=Val}) ->
+ #k_literal{anno=A,val=Val};
+do_combine_lit_pat(#k_float{anno=A,val=Val}) ->
+ #k_literal{anno=A,val=Val};
+do_combine_lit_pat(#k_int{anno=A,val=Val}) ->
+ #k_literal{anno=A,val=Val};
+do_combine_lit_pat(#k_nil{anno=A}) ->
+ #k_literal{anno=A,val=[]};
+do_combine_lit_pat(#k_binary{anno=A,segs=Segs}) ->
+ Bin = combine_bin_segs(Segs),
+ #k_literal{anno=A,val=Bin};
+do_combine_lit_pat(#k_cons{anno=A,hd=Hd0,tl=Tl0}) ->
+ #k_literal{val=Hd} = do_combine_lit_pat(Hd0),
+ #k_literal{val=Tl} = do_combine_lit_pat(Tl0),
+ #k_literal{anno=A,val=[Hd|Tl]};
+do_combine_lit_pat(#k_literal{}=Lit) ->
+ Lit;
+do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) ->
+ Es = [begin
+ #k_literal{val=Lit} = do_combine_lit_pat(El),
+ Lit
+ end || El <- Es0],
+ #k_literal{anno=A,val=list_to_tuple(Es)};
+do_combine_lit_pat(_) ->
+ throw(not_possible).
+
+combine_bin_segs(#k_bin_seg{size=Size0,unit=Unit,type=integer,
+ flags=[unsigned,big],seg=Seg,next=Next}) ->
+ #k_literal{val=Size1} = do_combine_lit_pat(Size0),
+ #k_literal{val=Int} = do_combine_lit_pat(Seg),
+ Size = Size1 * Unit,
+ if
+ 0 < Size, Size < 64 ->
+ Bin = <<Int:Size>>,
+ case Bin of
+ <<Int:Size>> ->
+ NextBin = combine_bin_segs(Next),
+ <<Bin/bits,NextBin/bits>>;
+ _ ->
+ %% The integer Int does not fit in the segment,
+ %% thus it will not match.
+ throw(not_possible)
+ end;
+ true ->
+ %% Avoid creating huge binary literals.
+ throw(not_possible)
+ end;
+combine_bin_segs(#k_bin_end{}) ->
+ <<>>;
+combine_bin_segs(_) ->
+ throw(not_possible).
+
%% select_bin_con([Clause]) -> [{Type,[Clause]}].
%% Extract clauses for the k_bin_seg constructor. As k_bin_seg
%% matching can overlap, the k_bin_seg constructors cannot be
@@ -1350,10 +1913,70 @@ select(T, Cs) -> [ C || C <- Cs, clause_con(C) =:= T ].
%% At this point all the clauses have the same constructor, we must
%% now separate them according to value.
-match_value(Us, T, Cs0, Def, St0) ->
- Css = group_value(T, Cs0),
+match_value(Us0, T, Cs0, Def, St0) ->
+ {Us1,Cs1,St1} = partition_intersection(T, Us0, Cs0, St0),
+ UCss = group_value(T, Us1, Cs1),
%%ok = io:format("match_value ~p ~p~n", [T, Css]),
- mapfoldl(fun (Cs, St) -> match_clause(Us, Cs, Def, St) end, St0, Css).
+ mapfoldl(fun ({Us,Cs}, St) -> match_clause(Us, Cs, Def, St) end, St1, UCss).
+
+%% partition_intersection
+%% Partitions a map into two maps with the most common keys to the first map.
+%% case <M> of
+%% <#{a}>
+%% <#{a,b}>
+%% <#{a,c}>
+%% <#{c}>
+%% end
+%% becomes
+%% case <M,M> of
+%% <#{a}, #{ }>
+%% <#{a}, #{b}>
+%% <#{ }, #{c}>
+%% <#{a}, #{c}>
+%% end
+%% The intention is to group as many keys together as possible and thus
+%% reduce the number of lookups to that key.
+partition_intersection(k_map, [U|_]=Us0, [_,_|_]=Cs0,St0) ->
+ Ps = [clause_val(C) || C <- Cs0],
+ case find_key_partition(Ps) of
+ no_partition ->
+ {Us0,Cs0,St0};
+ Ks ->
+ {Cs1,St1} = mapfoldl(fun(#iclause{pats=[Arg|Args]}=C, Sti) ->
+ {{Arg1,Arg2},St} = partition_key_intersection(Arg, Ks, Sti),
+ {C#iclause{pats=[Arg1,Arg2|Args]}, St}
+ end, St0, Cs0),
+ {[U|Us0],Cs1,St1}
+ end;
+partition_intersection(_, Us, Cs, St) ->
+ {Us,Cs,St}.
+
+partition_key_intersection(#k_map{es=Pairs}=Map,Ks,St0) ->
+ F = fun(#k_map_pair{key=Key}) -> member(map_key_clean(Key), Ks) end,
+ {Ps1,Ps2} = partition(F, Pairs),
+ {{Map#k_map{es=Ps1},Map#k_map{es=Ps2}},St0};
+partition_key_intersection(#ialias{pat=Map}=Alias,Ks,St0) ->
+ %% only alias one of them
+ {{Map1,Map2},St1} = partition_key_intersection(Map, Ks, St0),
+ {{Map1,Alias#ialias{pat=Map2}},St1}.
+
+% Only check for the complete intersection of keys and not commonality
+find_key_partition(Ps) ->
+ Sets = [sets:from_list(Ks)||Ks <- Ps],
+ Is = sets:intersection(Sets),
+ case sets:to_list(Is) of
+ [] -> no_partition;
+ KeyIntersection ->
+ %% Check if the intersection are all keys in all clauses.
+ %% Don't split if they are since this will only
+ %% infer extra is_map instructions with no gain.
+ All = foldl(fun (Kset, Bool) ->
+ Bool andalso sets:is_subset(Kset, Is)
+ end, true, Sets),
+ if All -> no_partition;
+ true -> KeyIntersection
+ end
+ end.
%% group_value([Clause]) -> [[Clause]].
%% Group clauses according to value. Here we know that
@@ -1361,30 +1984,30 @@ match_value(Us, T, Cs0, Def, St0) ->
%% 2. The clauses in bin_segs cannot be reordered only grouped
%% 3. Other types are disjoint and can be reordered
-group_value(k_cons, Cs) -> [Cs]; %These are single valued
-group_value(k_nil, Cs) -> [Cs];
-group_value(k_binary, Cs) -> [Cs];
-group_value(k_bin_end, Cs) -> [Cs];
-group_value(k_bin_seg, Cs) -> group_bin_seg(Cs);
-group_value(k_bin_int, Cs) -> [Cs];
-group_value(k_map, Cs) -> group_map(Cs);
-group_value(_, Cs) ->
+group_value(k_cons, Us, Cs) -> [{Us,Cs}]; %These are single valued
+group_value(k_nil, Us, Cs) -> [{Us,Cs}];
+group_value(k_binary, Us, Cs) -> [{Us,Cs}];
+group_value(k_bin_end, Us, Cs) -> [{Us,Cs}];
+group_value(k_bin_seg, Us, Cs) -> group_bin_seg(Us,Cs);
+group_value(k_bin_int, Us, Cs) -> [{Us,Cs}];
+group_value(k_map, Us, Cs) -> group_map(Us,Cs);
+group_value(_, Us, Cs) ->
%% group_value(Cs).
Cd = foldl(fun (C, Gcs0) -> dict:append(clause_val(C), C, Gcs0) end,
dict:new(), Cs),
- dict:fold(fun (_, Vcs, Css) -> [Vcs|Css] end, [], Cd).
+ dict:fold(fun (_, Vcs, Css) -> [{Us,Vcs}|Css] end, [], Cd).
-group_bin_seg([C1|Cs]) ->
+group_bin_seg(Us, [C1|Cs]) ->
V1 = clause_val(C1),
{More,Rest} = splitwith(fun (C) -> clause_val(C) == V1 end, Cs),
- [[C1|More]|group_bin_seg(Rest)];
-group_bin_seg([]) -> [].
+ [{Us,[C1|More]}|group_bin_seg(Us,Rest)];
+group_bin_seg(_, []) -> [].
-group_map([C1|Cs]) ->
+group_map(Us, [C1|Cs]) ->
V1 = clause_val(C1),
{More,Rest} = splitwith(fun (C) -> clause_val(C) =:= V1 end, Cs),
- [[C1|More]|group_map(Rest)];
-group_map([]) -> [].
+ [{Us,[C1|More]}|group_map(Us,Rest)];
+group_map(_, []) -> [].
%% Profiling shows that this quadratic implementation account for a big amount
%% of the execution time if there are many values.
@@ -1607,7 +2230,9 @@ ubody(E, return, St0) ->
{Ea,Pa,St1} = force_atomic(E, St0),
ubody(pre_seq(Pa, #ivalues{args=[Ea]}), return, St1)
end;
-ubody(E, {break,_Rs} = Break, St0) ->
+ubody(#ignored{}, {break,_} = Break, St) ->
+ ubody(#ivalues{args=[]}, Break, St);
+ubody(E, {break,[_]} = Break, St0) ->
%%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]),
%% Exiting expressions need no trailing break.
case is_exit_expr(E) of
@@ -1615,6 +2240,16 @@ 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, {break,Rs}=Break, St0) ->
+ case is_exit_expr(E) of
+ true ->
+ uexpr(E, return, St0);
+ false ->
+ {Vs,St1} = new_vars(length(Rs), St0),
+ Iset = #iset{vars=Vs,arg=E},
+ PreSeq = pre_seq([Iset], #ivalues{args=Vs}),
+ ubody(PreSeq, Break, St1)
end.
iletrec_funs(#iletrec{defs=Fs}, St0) ->
@@ -1643,9 +2278,8 @@ iletrec_funs_gen(Fs, FreeVs, St) ->
Arity0 = length(Vs),
{Fb1,_,Lst1} = ubody(Fb0, return, Lst0#kern{ff={N,Arity0}}),
Arity = Arity0 + length(FreeVs),
- Fun = #k_fdef{anno=#k{us=[],ns=[],a=Fa},
- func=N,arity=Arity,
- vars=Vs ++ FreeVs,body=Fb1},
+ Fun = make_fdef(#k{us=[],ns=[],a=Fa}, N, Arity,
+ Vs++FreeVs, Fb1),
Lst1#kern{funs=[Fun|Lst1#kern.funs]}
end, St, Fs).
@@ -1734,26 +2368,25 @@ 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}=Try,
+uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
{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};
+ {#k_protected{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}
+ {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs0),a=A},
+ arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs0},
+ Used,St4}
end;
uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
return, St0) ->
@@ -1761,13 +2394,11 @@ uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
{A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here!
{B1,Bu,St3} = ubody(B0, return, St2),
{H1,Hu,St4} = ubody(H0, return, St3),
- NumNew = 1,
- {Ns,St5} = new_vars(NumNew, St4),
Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
subtract(Hu, lit_list_vars(Evs))]),
- {#k_try_enter{anno=#k{us=Used,ns=Ns,a=A},
+ {#k_try_enter{anno=#k{us=Used,ns=[],a=A},
arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1},
- Used,St5};
+ Used,St4};
uexpr(#k_catch{anno=A,body=B0}, {break,Rs0}, St0) ->
{Rb,St1} = new_var(St0),
{B1,Bu,St2} = ubody(B0, {break,[Rb]}, St1),
@@ -1789,15 +2420,10 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) ->
%% 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,
+ Fun = make_fdef(#k{us=[],ns=[],a=A}, Fname, Arity, Vs++Fvs, B1),
{#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],
+ op=#k_internal{name=make_fun,arity=length(Free)+2},
+ args=[#k_atom{val=Fname},#k_int{val=Arity}|Fvs],
ret=Rs},
Free,add_local_function(Fun, St)};
uexpr(Lit, {break,Rs0}, St0) ->
@@ -1811,6 +2437,16 @@ uexpr(Lit, {break,Rs0}, St0) ->
add_local_function(_, #kern{funs=ignore}=St) -> St;
add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}.
+%% Make a #k_fdef{}, making sure that the body is always a #k_match{}.
+make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) ->
+ #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Body};
+make_fdef(Anno, Name, Arity, Vs, Body) ->
+ Ka = get_kanno(Body),
+ Match = #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
+ vars=Vs,body=Body,ret=[]},
+ #k_fdef{anno=Anno,func=Name,arity=Arity,vars=Vs,body=Match}.
+
+
%% handle_reuse_annos([#k_var{}], State) -> State.
%% In general, it is only safe to reuse a variable for a match context
%% if the original value of the variable will no longer be needed.
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index 5216a1a620..e6f0d3c1f7 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -58,7 +58,7 @@
-record(k_seq, {anno=[],arg,body}).
-record(k_put, {anno=[],arg,ret=[]}).
-record(k_bif, {anno=[],op,args,ret=[]}).
--record(k_test, {anno=[],op,args}).
+-record(k_test, {anno=[],op,args,inverted=false}).
-record(k_call, {anno=[],op,args,ret=[]}).
-record(k_enter, {anno=[],op,args}).
-record(k_receive, {anno=[],var,body,timeout,action,ret=[]}).
@@ -66,6 +66,7 @@
-record(k_receive_next, {anno=[]}).
-record(k_try, {anno=[],arg,vars,body,evars,handler,ret=[]}).
-record(k_try_enter, {anno=[],arg,vars,body,evars,handler}).
+-record(k_protected, {anno=[],arg,ret=[]}).
-record(k_catch, {anno=[],body,ret=[]}).
-record(k_guard_match, {anno=[],vars,body,ret=[]}).
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 0b90f0a1e0..c12c301ee2 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -47,7 +47,7 @@
canno(Cthing) -> element(2, Cthing).
--spec format(cerl:cerl()) -> iolist().
+-spec format(#k_mdef{}) -> iolist().
format(Node) -> format(Node, #ctxt{}).
@@ -145,7 +145,7 @@ format_1(#k_local{name=N,arity=A}, Ctxt) ->
"local " ++ format_fa_pair({N,A}, Ctxt);
format_1(#k_remote{mod=M,name=N,arity=A}, _Ctxt) ->
%% This is for our internal translator.
- io_lib:format("remote ~s:~s/~w", [format(M),format(N),A]);
+ io_lib:format("remote ~ts:~ts/~w", [format(M),format(N),A]);
format_1(#k_internal{name=N,arity=A}, Ctxt) ->
"internal " ++ format_fa_pair({N,A}, Ctxt);
format_1(#k_seq{arg=A,body=B}, Ctxt) ->
@@ -235,15 +235,20 @@ format_1(#k_bif{op=Op,args=As,ret=Rs}, Ctxt) ->
[Txt,format_args(As, Ctxt1),
format_ret(Rs, Ctxt1)
];
-format_1(#k_test{op=Op,args=As}, Ctxt) ->
- Txt = ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)],
+format_1(#k_test{op=Op,args=As,inverted=Inverted}, Ctxt) ->
+ Txt = case Inverted of
+ false ->
+ ["test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)];
+ true ->
+ ["inverted_test (",format(Op, ctxt_bump_indent(Ctxt, 6)),$)]
+ end,
Ctxt1 = ctxt_bump_indent(Ctxt, 2),
[Txt,format_args(As, Ctxt1)];
format_1(#k_put{arg=A,ret=Rs}, Ctxt) ->
[format(A, Ctxt),
format_ret(Rs, ctxt_bump_indent(Ctxt, 1))
];
-format_1(#k_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
+format_1(#k_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H,ret=Rs}, Ctxt) ->
Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
["try",
nl_indent(Ctxt1),
@@ -259,7 +264,8 @@ format_1(#k_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
nl_indent(Ctxt1),
format(H, Ctxt1),
nl_indent(Ctxt),
- "end"
+ "end",
+ format_ret(Rs, Ctxt)
];
format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
@@ -279,6 +285,15 @@ format_1(#k_try_enter{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Ctxt) ->
nl_indent(Ctxt),
"end"
];
+format_1(#k_protected{arg=A,ret=Rs}, Ctxt) ->
+ Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
+ ["protected",
+ nl_indent(Ctxt1),
+ format(A, Ctxt1),
+ nl_indent(Ctxt),
+ "end",
+ format_ret(Rs, ctxt_bump_indent(Ctxt, 1))
+ ];
format_1(#k_catch{body=B,ret=Rs}, Ctxt) ->
Ctxt1 = ctxt_bump_indent(Ctxt, Ctxt#ctxt.body_indent),
["catch",
@@ -477,7 +492,7 @@ indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt).
indent(N, _Ctxt) when N =< 0 -> "";
indent(N, Ctxt) ->
T = Ctxt#ctxt.tab_width,
- string:chars($\t, N div T, string:chars($\s, N rem T)).
+ lists:duplicate(N div T, $\t) ++ lists:duplicate(N rem T, $\s).
nl_indent(Ctxt) -> [$\n|indent(Ctxt)].
@@ -494,7 +509,7 @@ unindent([$\t|T], N, Ctxt, C) ->
if N >= Tab ->
unindent(T, N - Tab, Ctxt, C);
true ->
- unindent([string:chars($\s, Tab - N)|T], 0, Ctxt, C)
+ unindent([lists:duplicate(Tab - N, $\s)|T], 0, Ctxt, C)
end;
unindent([L|T], N, Ctxt, C) when is_list(L) ->
unindent(L, N, Ctxt, [T|C]);
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
deleted file mode 100644
index 1452b78d1d..0000000000
--- a/lib/compiler/src/v3_life.erl
+++ /dev/null
@@ -1,484 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% Purpose : Convert annotated kernel expressions to annotated beam format.
-
-%% This module creates beam format annotated with variable lifetime
-%% information. Each thing is given an index and for each variable we
-%% store the first and last index for its occurrence. The variable
-%% database, VDB, attached to each thing is only relevant internally
-%% for that thing.
-%%
-%% For nested things like matches the numbering continues locally and
-%% the VDB for that thing refers to the variable usage within that
-%% thing. Variables which live through a such a thing are internally
-%% given a very large last index. Internally the indexes continue
-%% after the index of that thing. This creates no problems as the
-%% internal variable info never escapes and externally we only see
-%% variable which are alive both before or after.
-%%
-%% This means that variables never "escape" from a thing and the only
-%% way to get values from a thing is to "return" them, with 'break' or
-%% 'return'. Externally these values become the return values of the
-%% thing. This is no real limitation as most nested things have
-%% multiple threads so working out a common best variable usage is
-%% difficult.
-
--module(v3_life).
-
--export([module/2]).
-
--export([vdb_find/2]).
-
--import(lists, [member/2,map/2,reverse/1,sort/1]).
--import(ordsets, [add_element/2,intersection/2,union/2]).
-
--include("v3_kernel.hrl").
--include("v3_life.hrl").
-
-%% These are not defined in v3_kernel.hrl.
-get_kanno(Kthing) -> element(2, Kthing).
-%%set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
-
-module(#k_mdef{name=M,exports=Es,attributes=As,body=Fs0}, _Opts) ->
- Fs1 = functions(Fs0, []),
- {ok,{M,Es,As,Fs1}}.
-
-functions([F|Fs], Acc) ->
- functions(Fs, [function(F)|Acc]);
-functions([], Acc) -> reverse(Acc).
-
-%% function(Kfunc) -> Func.
-
-function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) ->
- try
- As = var_list(Vs),
- Vdb0 = init_vars(As),
- %% Force a top-level match!
- B0 = case Kb of
- #k_match{} -> Kb;
- _ ->
- Ka = get_kanno(Kb),
- #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
- vars=Vs,body=Kb,ret=[]}
- end,
- put(guard_refc, 0),
- {B1,_,Vdb1} = body(B0, 1, Vdb0),
- erase(guard_refc),
- {function,F,Ar,As,B1,Vdb1,Anno}
- catch
- Class:Error ->
- Stack = erlang:get_stacktrace(),
- io:fwrite("Function: ~w/~w\n", [F,Ar]),
- erlang:raise(Class, Error, Stack)
- end.
-
-%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
-%% Handle a body.
-
-body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) ->
- %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
- A = get_kanno(Ke),
- Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
- {Es,MaxI,Vdb2} = body(Kb, I+1, Vdb1),
- E = expr(Ke, I, Vdb2),
- {[E|Es],MaxI,Vdb2};
-body(Ke, I, Vdb0) ->
- %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
- A = get_kanno(Ke),
- Vdb1 = use_vars(union(A#k.us, A#k.ns), I, Vdb0),
- E = expr(Ke, I, Vdb1),
- {[E],I,Vdb1}.
-
-%% guard(Kguard, I, Vdb) -> Guard.
-
-guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X},
- handler=#k_atom{val=false},ret=Rs}, I, Vdb) ->
- %% 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} = 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}.
-
-%% 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) ->
- #l{ke={enter,call_op(Op),atomic_list(As)},i=I,a=A#k.a};
-expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) ->
- Bif = k_bif(A, Op, As, Rs),
- #l{ke=Bif,i=I,a=A#k.a};
-expr(#k_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
- %% 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={match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
-expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
- %% 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};
-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.
- 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(union(Ab#k.us, 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, 1000000, Tdb2)),
- {Bes,_,Bdb} = body(Kb, I+4, new_vars(sort(map(Vnames, Vs)), I+3, Tdb2)),
- {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(map(Vnames, Evs)), I+3, Tdb2)),
- #l{ke={try_enter,#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=[]}},
- i=I,vdb=Tdb1,a=A#k.a};
-expr(#k_catch{anno=A,body=Kb,ret=[R]}, I, Vdb) ->
- %% Lock variables that are alive before the catch and used afterwards.
- %% Don't lock variables that are only used inside the catch.
- %% Add catch tag 'variable'.
- Cdb0 = vdb_sub(I, I+1, Vdb),
- {Es,_,Cdb1} = body(Kb, I+1, add_var({catch_tag,I}, I, locked, Cdb0)),
- #l{ke={'catch',Es,variable(R)},i=I,vdb=Cdb1,a=A#k.a};
-expr(#k_receive{anno=A,var=V,body=Kb,timeout=T,action=Ka,ret=Rs}, I, Vdb) ->
- %% Work out imported variables which need to be locked.
- Rdb = vdb_sub(I, I+1, Vdb),
- M = match(Kb, add_element(V#k_var.name, A#k.us), I+1, [],
- new_vars([V#k_var.name], I, Rdb)),
- {Tes,_,Adb} = body(Ka, I+1, Rdb),
- #l{ke={receive_loop,atomic(T),variable(V),M,
- #l{ke=Tes,i=I+1,vdb=Adb,a=[]},var_list(Rs)},
- i=I,vdb=use_vars(A#k.us, I+1, Vdb),a=A#k.a};
-expr(#k_receive_accept{anno=A}, I, _Vdb) ->
- #l{ke=receive_accept,i=I,a=A#k.a};
-expr(#k_receive_next{anno=A}, I, _Vdb) ->
- #l{ke=receive_next,i=I,a=A#k.a};
-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};
-expr(#k_break{anno=A,args=As}, I, _Vdb) ->
- #l{ke={break,atomic_list(As)},i=I,a=A#k.a};
-expr(#k_guard_break{anno=A,args=As}, I, Vdb) ->
- Locked = [V || {V,_,_} <- Vdb],
- #l{ke={guard_break,atomic_list(As),Locked},i=I,a=A#k.a};
-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(union(Ab#k.us, 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(sort(map(Vnames, Vs)), I+3, Tdb2)),
- {Hes,_,Hdb} = body(Kh, I+4, new_vars(sort(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.
-%% Do any necessary name translations here to munge into beam format.
-
-call_op(#k_local{name=N}) -> N;
-call_op(#k_remote{mod=M,name=N}) -> {remote,atomic(M),atomic(N)};
-call_op(Other) -> variable(Other).
-
-bif_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N;
-bif_op(#k_internal{name=N}) -> N.
-
-test_op(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=N}}) -> N.
-
-%% k_bif(Anno, Op, [Arg], [Ret], Vdb) -> Expr.
-%% Build bifs, do special handling of internal some calls.
-
-k_bif(_A, #k_internal{name=dsetelement,arity=3}, As, []) ->
- {bif,dsetelement,atomic_list(As),[]};
-k_bif(_A, #k_internal{name=bs_context_to_binary=Op,arity=1}, As, []) ->
- {bif,Op,atomic_list(As),[]};
-k_bif(_A, #k_internal{name=bs_init_writable=Op,arity=1}, As, Rs) ->
- {bif,Op,atomic_list(As),var_list(Rs)};
-k_bif(_A, #k_internal{name=make_fun},
- [#k_atom{val=Fun},#k_int{val=Arity},
- #k_int{val=Index},#k_int{val=Uniq}|Free],
- Rs) ->
- {bif,{make_fun,Fun,Arity,Index,Uniq},var_list(Free),var_list(Rs)};
-k_bif(_A, Op, As, Rs) ->
- %% The general case.
- Name = bif_op(Op),
- Ar = length(As),
- case is_gc_bif(Name, Ar) of
- false ->
- {bif,Name,atomic_list(As),var_list(Rs)};
- true ->
- {gc_bif,Name,atomic_list(As),var_list(Rs)}
- end.
-
-%% match(Kexpr, [LockVar], I, Vdb) -> Expr.
-%% Convert match tree to old format.
-
-match(#k_alt{anno=A,first=Kf,then=Kt}, Ls, I, Ctxt, Vdb0) ->
- Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
- F = match(Kf, Ls, I+1, Ctxt, Vdb1),
- T = match(Kt, Ls, I+1, Ctxt, Vdb1),
- #l{ke={alt,F,T},i=I,vdb=Vdb1,a=A#k.a};
-match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) ->
- Vanno = get_kanno(V),
- Ls1 = case member(no_usage, Vanno) of
- false -> add_element(V#k_var.name, Ls0);
- true -> Ls0
- end,
- Anno = case member(reuse_for_context, Vanno) of
- true -> [reuse_for_context|A#k.a];
- false -> A#k.a
- end,
- Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0),
- Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts],
- #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno};
-match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) ->
- Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0),
- Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs],
- #l{ke={guard,Cs},i=I,vdb=Vdb1,a=A#k.a};
-match(Other, Ls, I, _Ctxt, Vdb0) ->
- Vdb1 = use_vars(Ls, I, Vdb0),
- {B,_,Vdb2} = body(Other, I+1, Vdb1),
- #l{ke={block,B},i=I,vdb=Vdb2,a=[]}.
-
-type_clause(#k_type_clause{anno=A,type=T,values=Kvs}, Ls, I, Ctxt, Vdb0) ->
- %%ok = io:format("life ~w: ~p~n", [?LINE,{T,Kvs}]),
- Vdb1 = use_vars(union(A#k.us, Ls), I+1, Vdb0),
- Vs = [val_clause(Vc, Ls, I+1, Ctxt, Vdb1) || Vc <- Kvs],
- #l{ke={type_clause,type(T),Vs},i=I,vdb=Vdb1,a=A#k.a}.
-
-val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) ->
- New = (get_kanno(V))#k.ns,
- Bus = (get_kanno(Kb))#k.us,
- %%ok = io:format("Ls0 = ~p, Used=~p\n New=~p, Bus=~p\n", [Ls0,Used,New,Bus]),
- Ls1 = union(intersection(New, Bus), Ls0), %Lock for safety
- Vdb1 = use_vars(union(A#k.us, Ls1), I+1, new_vars(New, I, Vdb0)),
- Ctxt = case V of
- #k_binary{segs=#k_var{name=C0}} -> C0;
- _ -> Ctxt0
- end,
- B = match(Kb, Ls1, I+1, Ctxt, Vdb1),
- #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}.
-
-guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
- Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0),
- Gdb = vdb_sub(I+1, I+2, Vdb1),
- OldRefc = put(guard_refc, get(guard_refc)+1),
- G = guard(Kg, I+1, Gdb),
- put(guard_refc, OldRefc),
- B = match(Kb, Ls, I+2, Ctxt, Vdb1),
- #l{ke={guard_clause,G,B},
- i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),
- a=A#k.a}.
-
-%% type(Ktype) -> Type.
-
-type(k_literal) -> literal;
-type(k_int) -> integer;
-%%type(k_char) -> integer; %Hhhmmm???
-type(k_float) -> float;
-type(k_atom) -> atom;
-type(k_nil) -> nil;
-type(k_cons) -> cons;
-type(k_tuple) -> tuple;
-type(k_binary) -> binary;
-type(k_bin_seg) -> bin_seg;
-type(k_bin_int) -> bin_int;
-type(k_bin_end) -> bin_end;
-type(k_map) -> map.
-
-%% variable(Klit) -> Lit.
-%% var_list([Klit]) -> [Lit].
-
-variable(#k_var{name=N}) -> {var,N}.
-
-var_list(Ks) -> [variable(K) || K <- Ks].
-
-%% atomic(Klit) -> Lit.
-%% atomic_list([Klit]) -> [Lit].
-
-atomic(#k_literal{val=V}) -> {literal,V};
-atomic(#k_var{name=N}) -> {var,N};
-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_nil{}) -> nil.
-
-atomic_list(Ks) -> [atomic(K) || K <- Ks].
-
-%% literal(Klit) -> Lit.
-%% literal_list([Klit]) -> [Lit].
-
-literal(#k_var{name=N}, _) -> {var,N};
-literal(#k_literal{val=I}, _) -> {literal,I};
-literal(#k_int{val=I}, _) -> {integer,I};
-literal(#k_float{val=F}, _) -> {float,F};
-literal(#k_atom{val=N}, _) -> {atom,N};
-%%literal(#k_char{val=C}, _) -> {char,C};
-literal(#k_nil{}, _) -> nil;
-literal(#k_cons{hd=H,tl=T}, Ctxt) ->
- {cons,[literal(H, Ctxt),literal(T, Ctxt)]};
-literal(#k_binary{segs=V}, Ctxt) ->
- {binary,literal(V, Ctxt)};
-literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) ->
- %% Only occurs in patterns.
- {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]};
-literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) ->
- {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,
- [literal(Seg, Ctxt),literal(N, Ctxt)]};
-literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) ->
- %% Only occurs in patterns.
- {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int,
- [literal(N, Ctxt)]};
-literal(#k_bin_end{}, Ctxt) ->
- {bin_end,Ctxt};
-literal(#k_tuple{es=Es}, Ctxt) ->
- {tuple,literal_list(Es, Ctxt)};
-literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) ->
- {map,Op,literal(Var, Ctxt),literal_list(Es0, Ctxt)};
-literal(#k_map_pair{key=K,val=V}, Ctxt) ->
- {map_pair,literal(K, Ctxt),literal(V, Ctxt)}.
-
-literal_list(Ks, Ctxt) ->
- [literal(K, Ctxt) || K <- Ks].
-
-
-%% is_gc_bif(Name, Arity) -> true|false
-%% Determines whether the BIF Name/Arity might do a GC.
-
-is_gc_bif(hd, 1) -> false;
-is_gc_bif(tl, 1) -> false;
-is_gc_bif(self, 0) -> false;
-is_gc_bif(node, 0) -> false;
-is_gc_bif(node, 1) -> false;
-is_gc_bif(element, 2) -> false;
-is_gc_bif(get, 1) -> false;
-is_gc_bif(raise, 2) -> false;
-is_gc_bif(tuple_size, 1) -> false;
-is_gc_bif(Bif, Arity) ->
- not (erl_internal:bool_op(Bif, Arity) orelse
- erl_internal:new_type_test(Bif, Arity) orelse
- erl_internal:comp_op(Bif, Arity)).
-
-%% Keep track of life time for variables.
-%%
-%% init_vars([{var,VarName}]) -> Vdb.
-%% new_vars([VarName], I, Vdb) -> Vdb.
-%% use_vars([VarName], I, Vdb) -> Vdb.
-%% add_var(VarName, F, L, Vdb) -> Vdb.
-%%
-%% The list of variable names for new_vars/3 and use_vars/3
-%% must be sorted.
-
-init_vars(Vs) ->
- vdb_new(Vs).
-
-new_vars([], _, Vdb) -> Vdb;
-new_vars([V], I, Vdb) -> vdb_store_new(V, {V,I,I}, Vdb);
-new_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
-
-use_vars([], _, Vdb) ->
- Vdb;
-use_vars([V], I, Vdb) ->
- case vdb_find(V, Vdb) of
- {V,F,L} when I > L -> vdb_update(V, {V,F,I}, Vdb);
- {V,_,_} -> Vdb;
- error -> vdb_store_new(V, {V,I,I}, Vdb)
- end;
-use_vars(Vs, I, Vdb) -> vdb_update_vars(Vs, Vdb, I).
-
-add_var(V, F, L, Vdb) ->
- vdb_store_new(V, {V,F,L}, Vdb).
-
-%% is_in_guard() -> true|false.
-
-is_in_guard() ->
- get(guard_refc) > 0.
-
-%% vdb
-
-vdb_new(Vs) ->
- sort([{V,0,0} || {var,V} <- Vs]).
-
-vdb_find(V, Vdb) ->
- case lists:keyfind(V, 1, Vdb) of
- false -> error;
- Vd -> Vd
- end.
-
-vdb_update(V, Update, [{V,_,_}|Vdb]) ->
- [Update|Vdb];
-vdb_update(V, Update, [Vd|Vdb]) ->
- [Vd|vdb_update(V, Update, Vdb)].
-
-vdb_store_new(V, New, [{V1,_,_}=Vd|Vdb]) when V > V1 ->
- [Vd|vdb_store_new(V, New, Vdb)];
-vdb_store_new(V, New, [{V1,_,_}|_]=Vdb) when V < V1 ->
- [New|Vdb];
-vdb_store_new(_, New, []) -> [New].
-
-vdb_update_vars([V|_]=Vs, [{V1,_,_}=Vd|Vdb], I) when V > V1 ->
- [Vd|vdb_update_vars(Vs, Vdb, I)];
-vdb_update_vars([V|Vs], [{V1,_,_}|_]=Vdb, I) when V < V1 ->
- %% New variable.
- [{V,I,I}|vdb_update_vars(Vs, Vdb, I)];
-vdb_update_vars([V|Vs], [{_,F,L}=Vd|Vdb], I) ->
- %% Existing variable.
- if
- I > L -> [{V,F,I}|vdb_update_vars(Vs, Vdb, I)];
- true -> [Vd|vdb_update_vars(Vs, Vdb, I)]
- end;
-vdb_update_vars([V|Vs], [], I) ->
- %% New variable.
- [{V,I,I}|vdb_update_vars(Vs, [], I)];
-vdb_update_vars([], Vdb, _) -> Vdb.
-
-%% vdb_sub(Min, Max, Vdb) -> Vdb.
-%% Extract variables which are used before and after Min. Lock
-%% variables alive after Max.
-
-vdb_sub(Min, Max, Vdb) ->
- [ if L >= Max -> {V,F,locked};
- true -> Vd
- end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ].
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index f0185acbc7..da5d207db9 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -9,7 +9,6 @@ MODULES= \
andor_SUITE \
apply_SUITE \
beam_block_SUITE \
- beam_bool_SUITE \
beam_validator_SUITE \
beam_disasm_SUITE \
beam_except_SUITE \
@@ -23,6 +22,7 @@ MODULES= \
bs_construct_SUITE \
bs_match_SUITE \
bs_utf_SUITE \
+ core_alias_SUITE \
core_fold_SUITE \
compile_SUITE \
compilation_SUITE \
@@ -36,7 +36,7 @@ MODULES= \
map_SUITE \
match_SUITE \
misc_SUITE \
- num_bif_SUITE \
+ overridden_bif_SUITE \
receive_SUITE \
record_SUITE \
regressions_SUITE \
@@ -49,7 +49,6 @@ NO_OPT= \
andor \
apply \
beam_block \
- beam_bool \
beam_except \
beam_jump \
beam_reorder \
@@ -67,7 +66,7 @@ NO_OPT= \
map \
match \
misc \
- num_bif \
+ overridden_bif \
receive \
record \
trycatch
@@ -76,8 +75,8 @@ INLINE= \
andor \
apply \
beam_block \
- beam_bool \
beam_utils \
+ bif \
bs_bincomp \
bs_bit_binaries \
bs_construct \
@@ -91,10 +90,14 @@ INLINE= \
map \
match \
misc \
- num_bif \
+ overridden_bif \
receive \
record
+CORE_MODULES = \
+ lfe_andor_SUITE \
+ lfe_guard_SUITE
+
NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE)
NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl)
POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE)
@@ -103,6 +106,8 @@ INLINE_MODULES= $(INLINE:%=%_inline_SUITE)
INLINE_ERL_FILES= $(INLINE_MODULES:%=%.erl)
ERL_FILES= $(MODULES:%=%.erl)
+CORE_FILES= $(CORE_MODULES:%=%.core)
+ERL_DUMMY_FILES= $(CORE_MODULES:%=%.erl)
##TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
##INSTALL_PROGS= $(TARGET_FILES)
@@ -136,6 +141,8 @@ make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(INLINE_ERL_FILES)
-o$(EBIN) $(POST_OPT_MODULES) >> $(EMAKEFILE)
$(ERL_TOP)/make/make_emakefile +inline $(ERL_COMPILE_FLAGS) \
-o$(EBIN) $(INLINE_MODULES) >> $(EMAKEFILE)
+ $(ERL_TOP)/make/make_emakefile +from_core $(ERL_COMPILE_FLAGS) \
+ -o$(EBIN) $(CORE_MODULES) >> $(EMAKEFILE)
tests debug opt: make_emakefile
erl $(ERL_MAKE_FLAGS) -make
@@ -173,6 +180,13 @@ release_tests_spec: make_emakefile
$(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)"
$(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \
$(INLINE_ERL_FILES) "$(RELSYSDIR)"
+ $(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)"
+ for file in $(ERL_DUMMY_FILES); do \
+ module=`basename $$file .erl`; \
+ echo "-module($$module). %% dummy .erl file" >$$file; \
+ done
+ $(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)"
+ rm $(ERL_DUMMY_FILES)
chmod -R u+w "$(RELSYSDIR)"
@tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index 05c087104d..5c463063c1 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,7 +29,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -38,6 +37,7 @@ groups() ->
combined,in_case,slow_compilation]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl
index cca92e4713..0f82a56fb7 100644
--- a/lib/compiler/test/apply_SUITE.erl
+++ b/lib/compiler/test/apply_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,13 +29,13 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[mfa, fun_apply].
groups() ->
[].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl
index 55d5f2dbe8..40a30b65d7 100644
--- a/lib/compiler/test/beam_block_SUITE.erl
+++ b/lib/compiler/test/beam_block_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -22,7 +22,7 @@
-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
init_per_group/2,end_per_group/2,
get_map_elements/1,otp_7345/1,move_opt_across_gc_bif/1,
- erl_202/1,repro/1]).
+ erl_202/1,repro/1,local_cse/1,second_block_pass/1]).
%% The only test for the following functions is that
%% the code compiles and is accepted by beam_validator.
@@ -31,7 +31,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -40,10 +39,13 @@ groups() ->
otp_7345,
move_opt_across_gc_bif,
erl_202,
- repro
+ repro,
+ local_cse,
+ second_block_pass
]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -237,6 +239,72 @@ find_operands(Cfg,XsiGraph,ActiveList,Count) ->
[Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))],
find_operands(NewCfg,XsiGraph,NewActiveList,Count+1).
+%% Some tests of local common subexpression elimination (CSE).
+
+local_cse(_Config) ->
+ {Self,{ok,Self}} = local_cse_1(),
+
+ local_cse_2([]),
+ local_cse_2(lists:seq(1, 512)),
+ local_cse_2(?MODULE:module_info()),
+
+ {[b],[a,b]} = local_cse_3(a, b),
+
+ {2000,Self,{Self,write_cache}} = local_cse_4(),
+
+ ok.
+
+local_cse_1() ->
+ %% Cover handling of unsafe tuple construction in
+ %% eliminate_use_of_from_reg/4. It became necessary to handle
+ %% unsafe tuples when local CSE was introduced.
+
+ {self(),{ok,self()}}.
+
+local_cse_2(Term) ->
+ case cse_make_binary(Term) of
+ <<Size:8,BinTerm:Size/binary>> ->
+ Term = binary_to_term(BinTerm);
+ <<Size:8,SizeTerm:Size/binary,BinTerm/binary>> ->
+ {'$size',TermSize} = binary_to_term(SizeTerm),
+ TermSize = byte_size(BinTerm),
+ Term = binary_to_term(BinTerm)
+ end.
+
+%% Copy of observer_backend:ttb_make_binary/1. During development of
+%% the local CSE optimization this function was incorrectly optimized.
+
+cse_make_binary(Term) ->
+ B = term_to_binary(Term),
+ SizeB = byte_size(B),
+ if SizeB > 255 ->
+ SB = term_to_binary({'$size',SizeB}),
+ <<(byte_size(SB)):8, SB/binary, B/binary>>;
+ true ->
+ <<SizeB:8, B/binary>>
+ end.
+
+local_cse_3(X, Y) ->
+ %% The following expression was incorrectly transformed to {[X,Y],[X,Y]}
+ %% during development of the local CSE optimization.
+
+ {[Y],[X,Y]}.
+
+local_cse_4() ->
+ do_local_cse_4(2000, self(), {self(), write_cache}).
+
+do_local_cse_4(X, Y, Z) ->
+ {X,Y,Z}.
+
+%% Tests previously found bugs when running beam_block the second time.
+
+second_block_pass(_Config) ->
+ [#{dts:=5.0}] = second_1([#{dts => 10.0}], 2.0),
+ ok.
+
+second_1(Fs, TS) ->
+ [F#{dts=>DTS / TS} || #{dts:=DTS} = F <- Fs].
+
%%%
%%% Common functions.
%%%
diff --git a/lib/compiler/test/beam_bool_SUITE.erl b/lib/compiler/test/beam_bool_SUITE.erl
deleted file mode 100644
index e585eaedb5..0000000000
--- a/lib/compiler/test/beam_bool_SUITE.erl
+++ /dev/null
@@ -1,197 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(beam_bool_SUITE).
-
--export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
- init_per_group/2,end_per_group/2,
- before_and_inside_if/1,
- scotland/1,y_registers/1,protected/1,
- maps/1]).
-
-suite() ->
- [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- test_lib:recompile(?MODULE),
- [{group,p}].
-
-groups() ->
- [{p,[parallel],
- [before_and_inside_if,
- scotland,
- y_registers,
- protected,
- maps
- ]}].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-before_and_inside_if(_Config) ->
- no = before_and_inside_if([a], [b], delete),
- no = before_and_inside_if([a], [b], x),
- no = before_and_inside_if([a], [], delete),
- no = before_and_inside_if([a], [], x),
- no = before_and_inside_if([], [], delete),
- yes = before_and_inside_if([], [], x),
- yes = before_and_inside_if([], [b], delete),
- yes = before_and_inside_if([], [b], x),
-
- {ch1,ch2} = before_and_inside_if_2([a], [b], blah),
- {ch1,ch2} = before_and_inside_if_2([a], [b], xx),
- {ch1,ch2} = before_and_inside_if_2([a], [], blah),
- {ch1,ch2} = before_and_inside_if_2([a], [], xx),
- {no,no} = before_and_inside_if_2([], [b], blah),
- {no,no} = before_and_inside_if_2([], [b], xx),
- {ch1,no} = before_and_inside_if_2([], [], blah),
- {no,ch2} = before_and_inside_if_2([], [], xx),
- ok.
-
-%% Thanks to Simon Cornish and Kostis Sagonas.
-%% Used to crash beam_bool.
-before_and_inside_if(XDo1, XDo2, Do3) ->
- Do1 = (XDo1 =/= []),
- Do2 = (XDo2 =/= []),
- if
- %% This expression occurs in a try/catch (protected)
- %% block, which cannot refer to variables outside of
- %% the block that are boolean expressions.
- Do1 =:= true;
- Do1 =:= false, Do2 =:= false, Do3 =:= delete ->
- no;
- true ->
- yes
- end.
-
-%% Thanks to Simon Cornish.
-%% Used to generate code that would not set {y,0} on
-%% all paths before its use (and therefore fail
-%% validation by the beam_validator).
-before_and_inside_if_2(XDo1, XDo2, Do3) ->
- Do1 = (XDo1 =/= []),
- Do2 = (XDo2 =/= []),
- CH1 = if Do1 == true;
- Do1 == false,Do2==false,Do3 == blah ->
- ch1;
- true ->
- no
- end,
- CH2 = if Do1 == true;
- Do1 == false,Do2==false,Do3 == xx ->
- ch2;
- true ->
- no
- end,
- {CH1,CH2}.
-
-
-%% beam_bool would remove the initialization of {y,0}.
-%% (Thanks to Thomas Arts and QuickCheck.)
-
-scotland(_Config) ->
- million = do_scotland(placed),
- {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)),
- {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)),
- {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)),
- ok.
-
-do_scotland(Echo) ->
- found(case Echo of
- Echo when true; Echo, Echo, Echo ->
- Echo;
- echo ->
- []
- end,
- Echo = placed).
-
-found(_, _) -> million.
-
-
-%% ERL-143: beam_bool could not handle Y registers as a destination.
-y_registers(_Config) ->
- {'EXIT',{badarith,[_|_]}} = (catch baker(valentine)),
- {'EXIT',{badarith,[_|_]}} = (catch baker(clementine)),
-
- {not_ok,true} = potter([]),
- {ok,false} = potter([{encoding,any}]),
-
- ok.
-
-%% Thanks to Quickcheck.
-baker(Baker) ->
- (valentine == Baker) +
- case Baker of
- Baker when Baker; Baker ->
- Baker;
- Baker ->
- []
- end.
-
-%% Thanks to Jose Valim.
-potter(Modes) ->
- Raw = lists:keyfind(encoding, 1, Modes) == false,
- Final = case Raw of
- X when X == false; X == nil -> ok;
- _ -> not_ok
- end,
- {Final,Raw}.
-
-protected(_Config) ->
- {'EXIT',{if_clause,_}} = (catch photographs({1, surprise, true}, opinions)),
-
- {{true}} = welcome({perfect, true}),
- {'EXIT',{if_clause,_}} = (catch welcome({perfect, false})),
- ok.
-
-photographs({_Violation, surprise, Deep}, opinions) ->
- {if
- 0; "here", Deep ->
- Deep = Deep
- end}.
-
-welcome({perfect, Profit}) ->
- if
- Profit, Profit, Profit; 0 ->
- {id({Profit})}
- end.
-
-maps(_Config) ->
- ok = evidence(#{0 => 42}).
-
-%% Cover handling of put_map in in split_block_label_used/2.
-evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} ->
- ok.
-
-
-%%%
-%%% Common utilities.
-%%%
-
-id(I) ->
- I.
diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl
index 47367d6eab..2b4a780899 100644
--- a/lib/compiler/test/beam_except_SUITE.erl
+++ b/lib/compiler/test/beam_except_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,7 +26,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -35,6 +34,7 @@ groups() ->
coverage]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl
index 088f63606c..c61e4ab65c 100644
--- a/lib/compiler/test/beam_jump_SUITE.erl
+++ b/lib/compiler/test/beam_jump_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2016. All Rights Reserved.
+%% Copyright Ericsson AB 2016-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -27,7 +27,6 @@ suite() ->
[{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -37,6 +36,7 @@ groups() ->
]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/beam_reorder_SUITE.erl b/lib/compiler/test/beam_reorder_SUITE.erl
index 27ce51eec3..c8a4f9a75f 100644
--- a/lib/compiler/test/beam_reorder_SUITE.erl
+++ b/lib/compiler/test/beam_reorder_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,7 +26,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -36,6 +35,7 @@ groups() ->
]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
index 492067ef00..061076b3ff 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -22,12 +22,12 @@
-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
init_per_group/2,end_per_group/2,
integers/1,coverage/1,booleans/1,setelement/1,cons/1,
- tuple/1]).
+ tuple/1,record_float/1,binary_float/1,float_compare/1,
+ arity_checks/1,elixir_binaries/1,find_best/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -37,10 +37,17 @@ groups() ->
booleans,
setelement,
cons,
- tuple
+ tuple,
+ record_float,
+ binary_float,
+ float_compare,
+ arity_checks,
+ elixir_binaries,
+ find_best
]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -61,6 +68,15 @@ integers(_Config) ->
college = do_integers_3(),
+ zero = do_integers_4(<<0:1>>, 0),
+ one = do_integers_4(<<1:1>>, 0),
+ other = do_integers_4(<<1:1>>, 2),
+
+ zero = do_integers_5(0, 0),
+ one = do_integers_5(0, 1),
+ two = do_integers_5(0, 2),
+ three = do_integers_5(0, 3),
+
ok.
do_integers_1(B0) ->
@@ -83,7 +99,31 @@ do_integers_3() ->
1 -> 0
end.
-coverage(_Config) ->
+do_integers_4(<<X:1,T/bits>>, C) ->
+ %% Binary matching gives the range 0-1 for X.
+ %% The range for `X bor C` is unknown. It must not be inherited
+ %% from X. (`X bor C` will reuse the register used for X.)
+ case X bor C of
+ 0 -> do_integers_4(T, C, zero);
+ 1 -> do_integers_4(T, C, one);
+ _ -> do_integers_4(T, C, other)
+ end.
+
+do_integers_4(_, _, Res) ->
+ Res.
+
+do_integers_5(X0, Y0) ->
+ %% X and Y will use the same register.
+ X = X0 band 1,
+ Y = Y0 band 3,
+ case Y of
+ 0 -> zero;
+ 1 -> one;
+ 2 -> two;
+ 3 -> three
+ end.
+
+coverage(Config) ->
{'EXIT',{badarith,_}} = (catch id(1) bsl 0.5),
{'EXIT',{badarith,_}} = (catch id(2.0) bsl 2),
{'EXIT',{badarith,_}} = (catch a + 0.5),
@@ -94,6 +134,29 @@ coverage(_Config) ->
id(id(42) band 387439739874298734983787934283479243879),
id(-1 band id(13)),
+ error = if
+ is_map(Config), is_integer(Config) -> ok;
+ true -> error
+ end,
+ error = if
+ is_map(Config), is_atom(Config) -> ok;
+ true -> error
+ end,
+ error = if
+ is_map(Config), is_tuple(Config) -> ok;
+ true -> error
+ end,
+ error = if
+ is_integer(Config), is_bitstring(Config) -> ok;
+ true -> error
+ end,
+
+ ok = case Config of
+ <<_>> when is_binary(Config) ->
+ impossible;
+ [_|_] ->
+ ok
+ end,
ok.
booleans(_Config) ->
@@ -126,5 +189,137 @@ tuple(_Config) ->
do_tuple() ->
{0, _} = {necessary}.
+-record(x, {a}).
+
+record_float(_Config) ->
+ 17.0 = record_float(#x{a={0}}, 1700),
+ 23.0 = record_float(#x{a={0}}, 2300.0),
+ {'EXIT',{if_clause,_}} = (catch record_float(#x{a={1}}, 88)),
+ {'EXIT',{if_clause,_}} = (catch record_float(#x{a={}}, 88)),
+ {'EXIT',{if_clause,_}} = (catch record_float(#x{}, 88)),
+ ok.
+
+record_float(R, N0) ->
+ N = N0 / 100,
+ if element(1, R#x.a) =:= 0 ->
+ N
+ end.
+
+binary_float(_Config) ->
+ <<-1/float>> = binary_negate_float(<<1/float>>),
+ ok.
+
+binary_negate_float(<<Float/float>>) ->
+ <<-Float/float>>.
+
+float_compare(_Config) ->
+ false = do_float_compare(-42.0),
+ false = do_float_compare(-42),
+ false = do_float_compare(0),
+ false = do_float_compare(0.0),
+ true = do_float_compare(42),
+ true = do_float_compare(42.0),
+ ok.
+
+do_float_compare(X) ->
+ %% ERL-433: Used to fail before OTP 20. Was accidentally fixed
+ %% in OTP 20. Add a test case to ensure it stays fixed.
+
+ Y = X + 1.0,
+ case X > 0 of
+ T when (T =:= nil) or (T =:= false) -> T;
+ _T -> Y > 0
+ end.
+
+arity_checks(_Config) ->
+ %% ERL-549: an unsafe optimization removed a test_arity instruction,
+ %% causing the following to return 'broken' instead of 'ok'.
+ ok = do_record_arity_check({rgb, 255, 255, 255, 1}),
+ ok = do_tuple_arity_check({255, 255, 255, 1}).
+
+-record(rgb, {r = 255, g = 255, b = 255}).
+
+do_record_arity_check(RGB) when
+ (element(2, RGB) >= 0), (element(2, RGB) =< 255),
+ (element(3, RGB) >= 0), (element(3, RGB) =< 255),
+ (element(4, RGB) >= 0), (element(4, RGB) =< 255) ->
+ if
+ element(1, RGB) =:= rgb, is_record(RGB, rgb) -> broken;
+ true -> ok
+ end.
+
+do_tuple_arity_check(RGB) when is_tuple(RGB),
+ (element(1, RGB) >= 0), (element(1, RGB) =< 255),
+ (element(2, RGB) >= 0), (element(2, RGB) =< 255),
+ (element(3, RGB) >= 0), (element(3, RGB) =< 255) ->
+ case RGB of
+ {255, _, _} -> broken;
+ _ -> ok
+ end.
+
+elixir_binaries(_Config) ->
+ <<"foo blitzky baz">> = elixir_binary_1(<<"blitzky">>),
+ <<"foo * baz">> = elixir_binary_2($*),
+ <<7:4,755:10>> = elixir_bitstring_3(<<755:10>>),
+ ok.
+
+elixir_binary_1(Bar) when is_binary(Bar) ->
+ <<"foo ",
+ case Bar of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ list_to_binary(Rewrite)
+ end/binary,
+ " baz">>.
+
+elixir_binary_2(Arg) ->
+ Bin = <<Arg>>,
+ <<"foo ",
+ case Bin of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ list_to_binary:to_string(Rewrite)
+ end/binary,
+ " baz">>.
+
+elixir_bitstring_3(Bar) when is_bitstring(Bar) ->
+ <<7:4,
+ case Bar of
+ Rewrite when is_bitstring(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ list_to_bitstring(Rewrite)
+ end/bitstring>>.
+
+find_best(_Config) ->
+ ok = find_best([a], nil),
+ ok = find_best([<<"a">>], nil),
+ {error,_} = find_best([], nil),
+ ok.
+
+%% Failed because beam_type assumed that the operand
+%% for bs_context_binary must be a binary. Not true!
+find_best([a|Tail], Best) ->
+ find_best(Tail,
+ case Best of
+ X when X =:= nil orelse X =:= false -> a;
+ X -> X
+ end);
+find_best([<<"a">>|Tail], Best) ->
+ find_best(Tail,
+ case Best of
+ X when X =:= nil orelse X =:= false -> <<"a">>;
+ X -> X
+ end);
+find_best([], a) ->
+ ok;
+find_best([], <<"a">>) ->
+ ok;
+find_best([], nil) ->
+ {error,<<"should not get here">>}.
+
+
id(I) ->
I.
diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl
index ac734a70be..ac19305d69 100644
--- a/lib/compiler/test/beam_utils_SUITE.erl
+++ b/lib/compiler/test/beam_utils_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,13 +24,14 @@
apply_fun/1,apply_mf/1,bs_init/1,bs_save/1,
is_not_killed/1,is_not_used_at/1,
select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1,
- y_registers/1]).
+ y_registers/1,user_predef/1,scan_f/1,cafu/1,
+ receive_label/1,read_size_file_version/1,not_used/1,
+ is_used_fr/1]).
-export([id/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -46,10 +47,17 @@ groups() ->
otp_8949_b,
liveopt,
coverage,
- y_registers
+ y_registers,
+ user_predef,
+ scan_f,
+ cafu,
+ read_size_file_version,
+ not_used,
+ is_used_fr
]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -117,6 +125,24 @@ bs_init(_Config) ->
{'EXIT',{badarg,_}} = (catch do_bs_init_2([0.5])),
{'EXIT',{badarg,_}} = (catch do_bs_init_2([-1])),
{'EXIT',{badarg,_}} = (catch do_bs_init_2([1 bsl 32])),
+
+ <<>> = do_bs_init_3({tag,0}, 0, 0),
+ <<0>> = do_bs_init_3({tag,0}, 2, 1),
+
+ <<"_build/shared">> = do_bs_init_4([], false),
+ <<"abc/shared">> = do_bs_init_4(<<"abc">>, false),
+ <<"foo/foo">> = do_bs_init_4(<<"foo">>, true),
+ error = do_bs_init_4([], not_boolean),
+
+ Id = 17575,
+ Domain = -8798798,
+ [<<10,1:16,Id:16/signed>>,<<8,2:16,Domain:32/signed>>] =
+ do_bs_init_5(#{tag=>value,id=>Id,domain=>Domain}),
+ {'EXIT',{{required,id},[_|_]}} =
+ (catch do_bs_init_5(#{tag=>value,id=>nil,domain=>Domain})),
+ {'EXIT',{{required,domain},[_|_]}} =
+ (catch do_bs_init_5(#{tag=>value,id=>Id,domain=>nil})),
+
ok.
do_bs_init_1([?MODULE], Sz) ->
@@ -134,6 +160,59 @@ do_bs_init_2(SigNos) ->
erlang:error(badarg)
>>.
+do_bs_init_3({tag,Pos}, Offset, Len) ->
+ N0 = Offset - Pos,
+ N = if N0 > Len -> Len;
+ true -> N0
+ end,
+ <<0:N/unit:8>>.
+
+do_bs_init_4(Arg1, Arg2) ->
+ Build =
+ case id(Arg1) of
+ X when X =:= [] orelse X =:= false -> <<"_build">>;
+ X -> X
+ end,
+ case id(Arg2) of
+ true ->
+ id(<<case Build of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ id(Rewrite)
+ end/binary,
+ "/",
+ case id(<<"foo">>) of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ id(Rewrite)
+ end/binary>>);
+ false ->
+ id(<<case Build of
+ Rewrite when is_binary(Rewrite) ->
+ Rewrite;
+ Rewrite ->
+ id(Rewrite)
+ end/binary,
+ "/shared">>);
+ Other ->
+ error
+ end.
+
+do_bs_init_5(#{tag := value, id := Id, domain := Domain}) ->
+ [case Id of
+ nil ->
+ error(id({required, id}));
+ _ ->
+ <<10, 1:16/signed, Id:16/signed>>
+ end,
+ case Domain of
+ nil ->
+ error(id({required, domain}));
+ _ ->
+ <<8, 2:16/signed, Domain:32/signed>>
+ end].
bs_save(_Config) ->
{a,30,<<>>} = do_bs_save(<<1:1,30:5>>),
@@ -300,6 +379,9 @@ coverage(_Config) ->
{'EXIT',{function_clause,_}} = (catch town(overall, {{abc},alcohol})),
+ self() ! junk_message,
+ {"url",#{true:="url"}} = appointment(#{"resolution" => "url"}),
+
ok.
%% Cover check_liveness/3.
@@ -369,6 +451,125 @@ yellow(Hill) ->
Hill,
id(42).
+do(A, B) -> {A,B}.
+appointment(#{"resolution" := Url}) ->
+ do(receive _ -> Url end, #{true => Url}).
+
+%% From epp.erl.
+user_predef(_Config) ->
+ #{key:="value"} = user_predef({key,"value"}, #{}),
+ #{key:="value"} = user_predef({key,"value"}, #{key=>defined}),
+ error = user_predef({key,"value"}, #{key=>[defined]}),
+ ok.
+
+user_predef({M,Val}, Ms) ->
+ case Ms of
+ #{M:=Defs} when is_list(Defs) ->
+ error;
+ _ ->
+ Ms#{M=>Val}
+ end.
+
+%% From disk_log_1.erl.
+scan_f(_Config) ->
+ {1,<<>>,[]} = scan_f(<<1:32>>, 1, []),
+ {1,<<>>,[<<156>>]} = scan_f(<<1:32,156,1:32>>, 1, []),
+ ok.
+
+scan_f(<<Size:32,Tail/binary>>, FSz, Acc) when Size =< FSz ->
+ case Tail of
+ <<BinTerm:Size/binary,Tail2/binary>> ->
+ scan_f(Tail2, FSz, [BinTerm | Acc]);
+ _ ->
+ {Size,Tail,Acc}
+ end.
+
+%% From file_io_server.erl.
+cafu(_Config) ->
+ error = cafu(<<42:32>>, -1, 0, {utf32,big}),
+ error = cafu(<<42:32>>, 10, 0, {utf32,big}),
+ error = cafu(<<42:32>>, -1, 0, {utf32,little}),
+ ok.
+
+cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) when N < 0 ->
+ cafu(Rest, -1, Count+1, {utf32,big});
+cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) ->
+ cafu(Rest, N-1, Count+1, {utf32,big});
+cafu(<<_/little-utf32,Rest/binary>>, N, Count, {utf32,little}) when N < 0 ->
+ cafu(Rest, -1, Count+1, {utf32,little});
+cafu(_, _, _, _) ->
+ error.
+
+-record(rec_label, {bool}).
+
+receive_label(_Config) ->
+ Pid = spawn_link(fun() -> do_receive_label(#rec_label{bool=true}) end),
+ Msg = {a,b,c},
+ Pid ! {self(),Msg},
+ receive
+ {ok,Msg} ->
+ unlink(Pid),
+ exit(Pid, die),
+ ok
+ end.
+
+do_receive_label(Rec) ->
+ receive
+ {From,Message} when Rec#rec_label.bool ->
+ From ! {ok,Message},
+ do_receive_label(Rec)
+ end.
+
+read_size_file_version(_Config) ->
+ ok = do_read_size_file_version({ok,<<42>>}),
+ {ok,7777} = do_read_size_file_version({ok,<<7777:32>>}),
+ ok.
+
+do_read_size_file_version(E) ->
+ case E of
+ {ok,<<Version>>} when Version =:= 42 ->
+ ok;
+ {ok,<<MaxFiles:32>>} ->
+ {ok,MaxFiles}
+ end.
+
+-record(s, { a, b }).
+-record(k, { v }).
+
+not_used(_Config) ->
+ [] = not_used_p(any, #s{b=true}, #k{}, ignored),
+ #k{v=42} = not_used_p(any, #s{b=false}, #k{v=42}, ignored),
+ #k{v=42} = not_used_p(any, #s{b=bad}, #k{v=42}, ignored),
+ ok.
+
+not_used_p(_C, S, K, L) when is_record(K, k) ->
+ if ((S#s.b) and
+ (S#s.b)) ->
+ [];
+ true ->
+ id(L),
+ id(K#k.v),
+ id(K)
+ end.
+
+is_used_fr(Config) ->
+ 1 = is_used_fr(self(), self()),
+ 1 = is_used_fr(self(), other),
+ receive 1 -> ok end,
+ receive 1 -> ok end,
+ receive 1 -> ok end,
+ receive 1 -> ok end,
+ ok.
+
+is_used_fr(X, Y) ->
+ %% beam_utils:is_used({fr,R}, Code) would crash.
+ _ = 0 / (X ! 1),
+ _ = case Y of
+ X -> ok;
+ _ -> error
+ end,
+ X ! 1.
+
%% The identity function.
id(I) -> I.
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index ca85eef688..d3e544a9cc 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -33,8 +33,9 @@
state_after_fault_in_catch/1,no_exception_in_catch/1,
undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,
map_field_lists/1,cover_bin_opt/1,
- val_dsetel/1]).
-
+ val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1,
+ receive_stacked/1]).
+
-include_lib("common_test/include/ct.hrl").
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
@@ -48,7 +49,6 @@ suite() ->
{timetrap,{minutes,10}}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -61,9 +61,12 @@ groups() ->
freg_state,bad_bin_match,bad_dsetel,
state_after_fault_in_catch,no_exception_in_catch,
undef_label,illegal_instruction,failing_gc_guard_bif,
- map_field_lists,cover_bin_opt,val_dsetel]}].
+ map_field_lists,cover_bin_opt,val_dsetel,
+ bad_tuples,bad_try_catch_nesting,
+ receive_stacked]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -154,8 +157,8 @@ call_last(Config) when is_list(Config) ->
merge_undefined(Config) when is_list(Config) ->
Errors = do_val(merge_undefined, Config),
[{{t,handle_call,2},
- {{call_ext,2,{extfunc,debug,filter,2}},
- 22,
+ {{call_ext,1,{extfunc,erlang,exit,1}},
+ 10,
{uninitialized_reg,{y,0}}}}] = Errors,
ok.
@@ -421,9 +424,9 @@ try_bin_opt(Mod) ->
try
do_bin_opt(Mod)
catch
- Class:Error ->
+ Class:Error:Stk ->
io:format("~p: ~p ~p\n~p\n",
- [Mod,Class,Error,erlang:get_stacktrace()]),
+ [Mod,Class,Error,Stk]),
error
end.
@@ -446,7 +449,7 @@ do_bin_opt(Mod, Asm) ->
do_bin_opt(Transform, Mod, Asm0) ->
Asm = Transform(Asm0),
case compile:forms(Asm, [from_asm,no_postopt,return]) of
- {ok,[],Code,_Warnings} when is_binary(Code) ->
+ {ok,Mod,Code,_Warnings} when is_binary(Code) ->
ok;
{error,Errors0,_} ->
%% beam_validator must return errors, not simply crash,
@@ -509,6 +512,73 @@ destroy_reg({Tag,N}) ->
{y,N+1}
end.
+bad_tuples(Config) ->
+ Errors = do_val(bad_tuples, Config),
+ [{{bad_tuples,heap_overflow,1},
+ {{put,{x,0}},8,{heap_overflow,{left,0},{wanted,1}}}},
+ {{bad_tuples,long,2},
+ {{put,{atom,too_long}},8,not_building_a_tuple}},
+ {{bad_tuples,self_referential,1},
+ {{put,{x,1}},7,{tuple_in_progress,{x,1}}}},
+ {{bad_tuples,short,1},
+ {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors,
+
+ ok.
+
+bad_try_catch_nesting(Config) ->
+ Errors = do_val(bad_try_catch_nesting, Config),
+ [{{bad_try_catch_nesting,main,2},
+ {{'try',{y,2},{f,3}},
+ 7,
+ {bad_try_catch_nesting,{y,2},[{{y,1},{trytag,[5]}}]}}}] = Errors,
+ ok.
+
+receive_stacked(Config) ->
+ Mod = ?FUNCTION_NAME,
+ Errors = do_val(Mod, Config),
+ [{{receive_stacked,f1,0},
+ {{loop_rec_end,{f,3}},
+ 17,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,f2,0},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f3,0},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f4,0},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f5,0},
+ {{loop_rec_end,{f,23}},
+ 23,
+ {fragile_message_reference,{y,1}}}},
+ {{receive_stacked,f6,0},
+ {{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}},
+ 12,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,f7,0},
+ {{loop_rec_end,{f,33}},
+ 20,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,f8,0},
+ {{loop_rec_end,{f,38}},
+ 20,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,m1,0},
+ {{loop_rec_end,{f,43}},
+ 19,
+ {fragile_message_reference,{y,0}}}},
+ {{receive_stacked,m2,0},
+ {{loop_rec_end,{f,48}},
+ 33,
+ {fragile_message_reference,{y,0}}}}] = Errors,
+
+ %% Compile the original source code as a smoke test.
+ Data = proplists:get_value(data_dir, Config),
+ Base = atom_to_list(Mod),
+ File = filename:join(Data, Base),
+ {ok,Mod,_} = compile:file(File, [binary]),
+
+ ok.
+
%%%-------------------------------------------------------------------------
transform_remove(Remove, Module) ->
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S b/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S
new file mode 100644
index 0000000000..9f1b21a17b
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S
@@ -0,0 +1,64 @@
+{module, bad_try_catch_nesting}. %% version = 0
+
+{exports, [{main,2},{module_info,0},{module_info,1}]}.
+
+{attributes, []}.
+
+{labels, 11}.
+
+
+{function, main, 2, 2}.
+ {label,1}.
+ {line,[{location,"bad_try_catch_nesting.erl",4}]}.
+ {func_info,{atom,bad_try_catch_nesting},{atom,main},2}.
+ {label,2}.
+ {allocate_zero,3,2}.
+ {'try',{y,1},{f,5}}.
+ {move,{x,1},{y,0}}.
+ {'try',{y,2},{f,3}}.
+ {line,[{location,"bad_try_catch_nesting.erl",7}]}.
+ {call_fun,0}.
+ {try_end,{y,2}}.
+ {jump,{f,4}}.
+ {label,3}.
+ {try_case,{y,2}}.
+ {test,is_ne_exact,{f,4},[{x,0},{atom,error}]}.
+ {line,[]}.
+ {bif,raise,{f,0},[{x,2},{x,1}],{x,0}}.
+ {label,4}.
+ {move,{y,0},{x,0}}.
+ {kill,{y,0}}.
+ {line,[{location,"bad_try_catch_nesting.erl",12}]}.
+ {call_fun,0}.
+ {try_end,{y,1}}.
+ {deallocate,3}.
+ return.
+ {label,5}.
+ {try_case,{y,1}}.
+ {test,is_eq_exact,{f,6},[{x,0},{atom,throw}]}.
+ {deallocate,3}.
+ return.
+ {label,6}.
+ {line,[]}.
+ {bif,raise,{f,0},[{x,2},{x,1}],{x,0}}.
+
+
+{function, module_info, 0, 8}.
+ {label,7}.
+ {line,[]}.
+ {func_info,{atom,bad_try_catch_nesting},{atom,module_info},0}.
+ {label,8}.
+ {move,{atom,bad_try_catch_nesting},{x,0}}.
+ {line,[]}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 10}.
+ {label,9}.
+ {line,[]}.
+ {func_info,{atom,bad_try_catch_nesting},{atom,module_info},1}.
+ {label,10}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,bad_try_catch_nesting},{x,0}}.
+ {line,[]}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S
new file mode 100644
index 0000000000..7980241c37
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S
@@ -0,0 +1,88 @@
+{module, bad_tuples}. %% version = 0
+
+{exports, [{heap_overflow,1},
+ {long,2},
+ {module_info,0},
+ {module_info,1},
+ {self_referential,1},
+ {short,1}]}.
+
+{attributes, []}.
+
+{labels, 13}.
+
+
+{function, short, 1, 2}.
+ {label,1}.
+ {line,[{location,"bad_tuples.erl",4}]}.
+ {func_info,{atom,bad_tuples},{atom,short},1}.
+ {label,2}.
+ {test_heap,3,1}.
+ {put_tuple,2,{x,1}}.
+ {put,{atom,ok}}.
+ {move,{x,1},{x,0}}.
+ return.
+
+
+{function, long, 2, 4}.
+ {label,3}.
+ {line,[{location,"bad_tuples.erl",7}]}.
+ {func_info,{atom,bad_tuples},{atom,long},2}.
+ {label,4}.
+ {test_heap,6,2}.
+ {put_tuple,2,{x,2}}.
+ {put,{x,0}}.
+ {put,{x,1}}.
+ {put,{atom,too_long}}.
+ {put_tuple,2,{x,0}}.
+ {put,{atom,ok}}.
+ {put,{x,2}}.
+ return.
+
+
+{function, heap_overflow, 1, 6}.
+ {label,5}.
+ {line,[{location,"bad_tuples.erl",10}]}.
+ {func_info,{atom,bad_tuples},{atom,heap_overflow},1}.
+ {label,6}.
+ {test_heap,3,1}.
+ {put_tuple,2,{x,1}}.
+ {put,{atom,ok}}.
+ {put,{x,0}}.
+ {put,{x,0}}.
+ {move,{x,1},{x,0}}.
+ return.
+
+
+{function, self_referential, 1, 8}.
+ {label,7}.
+ {line,[{location,"bad_tuples.erl",13}]}.
+ {func_info,{atom,bad_tuples},{atom,self_referential},1}.
+ {label,8}.
+ {test_heap,3,1}.
+ {put_tuple,2,{x,1}}.
+ {put,{atom,ok}}.
+ {put,{x,1}}.
+ {move,{x,1},{x,0}}.
+ return.
+
+
+{function, module_info, 0, 10}.
+ {label,9}.
+ {line,[]}.
+ {func_info,{atom,bad_tuples},{atom,module_info},0}.
+ {label,10}.
+ {move,{atom,bad_tuples},{x,0}}.
+ {line,[]}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 12}.
+ {label,11}.
+ {line,[]}.
+ {func_info,{atom,bad_tuples},{atom,module_info},1}.
+ {label,12}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,bad_tuples},{x,0}}.
+ {line,[]}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S
new file mode 100644
index 0000000000..cca052a9c4
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S
@@ -0,0 +1,390 @@
+{module, receive_stacked}. %% version = 0
+
+{exports, [{f1,0},
+ {f2,0},
+ {f3,0},
+ {f4,0},
+ {f5,0},
+ {f6,0},
+ {f7,0},
+ {f8,0},
+ {id,1},
+ {m1,0},
+ {m2,0},
+ {module_info,0},
+ {module_info,1}]}.
+
+{attributes, []}.
+
+{labels, 57}.
+
+
+{function, f1, 0, 2}.
+ {label,1}.
+ {line,[{location,"receive_stacked.erl",15}]}.
+ {func_info,{atom,receive_stacked},{atom,f1},0}.
+ {label,2}.
+ {allocate_zero,1,0}.
+ {label,3}.
+ {loop_rec,{f,5},{x,0}}.
+ {move,{x,0},{y,0}}.
+ {test,is_integer,{f,4},[{y,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",18}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,4}.
+ {loop_rec_end,{f,3}}.
+ {label,5}.
+ {wait,{f,3}}.
+
+
+{function, f2, 0, 7}.
+ {label,6}.
+ {line,[{location,"receive_stacked.erl",22}]}.
+ {func_info,{atom,receive_stacked},{atom,f2},0}.
+ {label,7}.
+ {allocate_zero,2,0}.
+ {label,8}.
+ {loop_rec,{f,10},{x,0}}.
+ {test,is_nonempty_list,{f,9},[{x,0}]}.
+ {get_list,{x,0},{y,1},{x,0}}.
+ {test,is_nil,{f,9},[{x,0}]}.
+ {test_heap,3,0}.
+ remove_message.
+ {put_tuple,2,{y,0}}.
+ {put,{atom,ok}}.
+ {put,{y,1}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",26}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,9}.
+ {loop_rec_end,{f,8}}.
+ {label,10}.
+ {wait,{f,8}}.
+
+
+{function, f3, 0, 12}.
+ {label,11}.
+ {line,[{location,"receive_stacked.erl",30}]}.
+ {func_info,{atom,receive_stacked},{atom,f3},0}.
+ {label,12}.
+ {allocate_zero,2,0}.
+ {label,13}.
+ {loop_rec,{f,15},{x,0}}.
+ {test,is_nonempty_list,{f,14},[{x,0}]}.
+ {get_hd,{x,0},{y,1}}.
+ {test,is_integer,{f,14},[{y,1}]}.
+ {test_heap,3,0}.
+ remove_message.
+ {put_tuple,2,{y,0}}.
+ {put,{atom,ok}}.
+ {put,{y,1}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",34}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,14}.
+ {loop_rec_end,{f,13}}.
+ {label,15}.
+ {wait,{f,13}}.
+
+
+{function, f4, 0, 17}.
+ {label,16}.
+ {line,[{location,"receive_stacked.erl",38}]}.
+ {func_info,{atom,receive_stacked},{atom,f4},0}.
+ {label,17}.
+ {allocate_zero,2,0}.
+ {label,18}.
+ {loop_rec,{f,20},{x,0}}.
+ {test,is_nonempty_list,{f,19},[{x,0}]}.
+ {get_tl,{x,0},{y,1}}.
+ {test,is_list,{f,19},[{y,1}]}.
+ {test_heap,3,0}.
+ remove_message.
+ {put_tuple,2,{y,0}}.
+ {put,{atom,ok}}.
+ {put,{y,1}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",42}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,19}.
+ {loop_rec_end,{f,18}}.
+ {label,20}.
+ {wait,{f,18}}.
+
+
+{function, f5, 0, 22}.
+ {label,21}.
+ {line,[{location,"receive_stacked.erl",46}]}.
+ {func_info,{atom,receive_stacked},{atom,f5},0}.
+ {label,22}.
+ {allocate_zero,2,0}.
+ {label,23}.
+ {loop_rec,{f,25},{x,0}}.
+ {test,is_tuple,{f,24},[{x,0}]}.
+ {test,test_arity,{f,24},[{x,0},1]}.
+ {get_tuple_element,{x,0},0,{y,1}}.
+ {test,is_integer,{f,24},[{y,1}]}.
+ remove_message.
+ {put_map_assoc,{f,0},{literal,#{}},{y,0},0,{list,[{atom,key},{y,1}]}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",50}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,0}}.
+ {put,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,24}.
+ {loop_rec_end,{f,23}}.
+ {label,25}.
+ {wait,{f,23}}.
+
+
+{function, f6, 0, 27}.
+ {label,26}.
+ {line,[{location,"receive_stacked.erl",54}]}.
+ {func_info,{atom,receive_stacked},{atom,f6},0}.
+ {label,27}.
+ {allocate_zero,1,0}.
+ {label,28}.
+ {loop_rec,{f,30},{x,0}}.
+ {test,bs_start_match2,{f,29},1,[{x,0},0],{x,0}}.
+ {test,bs_get_integer2,
+ {f,29},
+ 1,
+ [{x,0},
+ {integer,8},
+ 1,
+ {field_flags,[{anno,[56,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {x,1}}.
+ {test,bs_get_binary2,
+ {f,29},
+ 1,
+ [{x,0},
+ {atom,all},
+ 8,
+ {field_flags,[{anno,[56,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {y,0}}.
+ {'%',
+ {no_bin_opt,
+ {binary_used_in,{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}}},
+ [56,{file,"receive_stacked.erl"}]}}.
+ {line,[{location,"receive_stacked.erl",56}]}.
+ {gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}}.
+ {test,is_lt,{f,29},[{integer,8},{x,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",57}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,29}.
+ {loop_rec_end,{f,28}}.
+ {label,30}.
+ {wait,{f,28}}.
+
+
+{function, f7, 0, 32}.
+ {label,31}.
+ {line,[{location,"receive_stacked.erl",61}]}.
+ {func_info,{atom,receive_stacked},{atom,f7},0}.
+ {label,32}.
+ {allocate_zero,1,0}.
+ {label,33}.
+ {loop_rec,{f,35},{x,0}}.
+ {test,bs_start_match2,{f,34},1,[{x,0},0],{x,0}}.
+ {test,bs_get_integer2,
+ {f,34},
+ 1,
+ [{x,0},
+ {integer,8},
+ 1,
+ {field_flags,[{anno,[63,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {x,1}}.
+ {test,bs_get_binary2,
+ {f,34},
+ 1,
+ [{x,0},
+ {atom,all},
+ 8,
+ {field_flags,[{anno,[63,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {y,0}}.
+ {'%',{no_bin_opt,{binary_used_in,{test,is_binary,{f,34},[{y,0}]}},
+ [63,{file,"receive_stacked.erl"}]}}.
+ {test,is_binary,{f,34},[{y,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",64}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,34}.
+ {loop_rec_end,{f,33}}.
+ {label,35}.
+ {wait,{f,33}}.
+
+
+{function, f8, 0, 37}.
+ {label,36}.
+ {line,[{location,"receive_stacked.erl",68}]}.
+ {func_info,{atom,receive_stacked},{atom,f8},0}.
+ {label,37}.
+ {allocate_zero,1,0}.
+ {label,38}.
+ {loop_rec,{f,40},{x,0}}.
+ {test,bs_start_match2,{f,39},1,[{x,0},0],{x,1}}.
+ {test,bs_get_integer2,
+ {f,39},
+ 2,
+ [{x,1},
+ {integer,8},
+ 1,
+ {field_flags,[{anno,[70,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {x,2}}.
+ {test,bs_get_binary2,
+ {f,39},
+ 2,
+ [{x,1},
+ {atom,all},
+ 8,
+ {field_flags,[{anno,[70,{file,"receive_stacked.erl"}]},
+ unsigned,big]}],
+ {y,0}}.
+ {'%',{no_bin_opt,{[{x,1},{y,0}],{loop_rec_end,{f,38}},not_handled},
+ [70,{file,"receive_stacked.erl"}]}}.
+ {test,is_binary,{f,39},[{x,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",71}]}.
+ {call,1,{f,52}}.
+ {move,{y,0},{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,39}.
+ {loop_rec_end,{f,38}}.
+ {label,40}.
+ {wait,{f,38}}.
+
+
+{function, m1, 0, 42}.
+ {label,41}.
+ {line,[{location,"receive_stacked.erl",75}]}.
+ {func_info,{atom,receive_stacked},{atom,m1},0}.
+ {label,42}.
+ {allocate_zero,1,0}.
+ {label,43}.
+ {loop_rec,{f,45},{x,0}}.
+ {test,is_map,{f,44},[{x,0}]}.
+ {get_map_elements,{f,44},{x,0},{list,[{atom,key},{y,0}]}}.
+ {test,is_integer,{f,44},[{y,0}]}.
+ remove_message.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",78}]}.
+ {call,1,{f,52}}.
+ {test_heap,2,0}.
+ {put_list,{y,0},nil,{x,0}}.
+ {deallocate,1}.
+ return.
+ {label,44}.
+ {loop_rec_end,{f,43}}.
+ {label,45}.
+ {wait,{f,43}}.
+
+
+{function, m2, 0, 47}.
+ {label,46}.
+ {line,[{location,"receive_stacked.erl",82}]}.
+ {func_info,{atom,receive_stacked},{atom,m2},0}.
+ {label,47}.
+ {allocate_zero,4,0}.
+ {move,{atom,key1},{x,0}}.
+ {line,[{location,"receive_stacked.erl",83}]}.
+ {call,1,{f,52}}.
+ {move,{x,0},{y,3}}.
+ {move,{atom,key2},{x,0}}.
+ {line,[{location,"receive_stacked.erl",84}]}.
+ {call,1,{f,52}}.
+ {move,{x,0},{y,2}}.
+ {label,48}.
+ {loop_rec,{f,50},{x,0}}.
+ {test,is_map,{f,49},[{x,0}]}.
+ {get_map_elements,{f,49},{x,0},{list,[{y,3},{y,1}]}}.
+ {get_map_elements,{f,49},{x,0},{list,[{y,2},{y,0}]}}.
+ {test,is_integer,{f,49},[{y,1}]}.
+ {test,is_integer,{f,49},[{y,0}]}.
+ remove_message.
+ {kill,{y,2}}.
+ {kill,{y,3}}.
+ {move,{integer,42},{x,0}}.
+ {line,[{location,"receive_stacked.erl",87}]}.
+ {call,1,{f,52}}.
+ {test_heap,3,0}.
+ {put_tuple,2,{x,0}}.
+ {put,{y,1}}.
+ {put,{y,0}}.
+ {deallocate,4}.
+ return.
+ {label,49}.
+ {loop_rec_end,{f,48}}.
+ {label,50}.
+ {wait,{f,48}}.
+
+
+{function, id, 1, 52}.
+ {label,51}.
+ {line,[{location,"receive_stacked.erl",91}]}.
+ {func_info,{atom,receive_stacked},{atom,id},1}.
+ {label,52}.
+ return.
+
+
+{function, module_info, 0, 54}.
+ {label,53}.
+ {line,[]}.
+ {func_info,{atom,receive_stacked},{atom,module_info},0}.
+ {label,54}.
+ {move,{atom,receive_stacked},{x,0}}.
+ {line,[]}.
+ {call_ext_only,1,{extfunc,erlang,get_module_info,1}}.
+
+
+{function, module_info, 1, 56}.
+ {label,55}.
+ {line,[]}.
+ {func_info,{atom,receive_stacked},{atom,module_info},1}.
+ {label,56}.
+ {move,{x,0},{x,1}}.
+ {move,{atom,receive_stacked},{x,0}}.
+ {line,[]}.
+ {call_ext_only,2,{extfunc,erlang,get_module_info,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl
new file mode 100644
index 0000000000..b95fa9ca62
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.erl
@@ -0,0 +1,92 @@
+-module(receive_stacked).
+-compile([export_all,nowarn_export_all]).
+
+%% Messages may be stored outside any process heap until they
+%% have been accepted by the 'remove_message' instruction.
+%% When matching of a message fails, it is not allowed to
+%% leave references to the message or any part of it in
+%% the Y registers. An experimental code generator could
+%% do that, causing an emulator crash if there happenened to
+%% be a garbage collection.
+%%
+%% The 'S' file corresponding to this file was compiled with
+%% that experimental code generator.
+
+f1() ->
+ receive
+ X when is_integer(X) ->
+ id(42),
+ X
+ end.
+
+f2() ->
+ receive
+ [X] ->
+ Res = {ok,X},
+ id(42),
+ {Res,X}
+ end.
+
+f3() ->
+ receive
+ [H|_] when is_integer(H) ->
+ Res = {ok,H},
+ id(42),
+ {Res,H}
+ end.
+
+f4() ->
+ receive
+ [_|T] when is_list(T) ->
+ Res = {ok,T},
+ id(42),
+ {Res,T}
+ end.
+
+f5() ->
+ receive
+ {X} when is_integer(X) ->
+ Res = #{key=>X},
+ id(42),
+ {Res,X}
+ end.
+
+f6() ->
+ receive
+ <<_:8,T/binary>> when byte_size(T) > 8 ->
+ id(42),
+ T
+ end.
+
+f7() ->
+ receive
+ <<_:8,T/binary>> when is_binary(T) ->
+ id(42),
+ T
+ end.
+
+f8() ->
+ receive
+ <<_:8,T/binary>> = Bin when is_binary(Bin) ->
+ id(42),
+ T
+ end.
+
+m1() ->
+ receive
+ #{key:=V} when is_integer(V) ->
+ id(42),
+ [V]
+ end.
+
+m2() ->
+ K1 = id(key1),
+ K2 = id(key2),
+ receive
+ #{K1:=V1,K2:=V2} when is_integer(V1), is_integer(V2) ->
+ id(42),
+ {V1,V2}
+ end.
+
+id(I) ->
+ I.
diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl
index 51bc71da81..42ba5d5365 100644
--- a/lib/compiler/test/bif_SUITE.erl
+++ b/lib/compiler/test/bif_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2016. All Rights Reserved.
+%% Copyright Ericsson AB 2016-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -19,23 +19,27 @@
%%
-module(bif_SUITE).
+-include_lib("syntax_tools/include/merl.hrl").
+
-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
init_per_group/2,end_per_group/2,
- beam_validator/1]).
+ beam_validator/1,trunc_and_friends/1,cover_safe_bifs/1]).
suite() ->
[{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
[{p,[parallel],
- [beam_validator
+ [beam_validator,
+ trunc_and_friends,
+ cover_safe_bifs
]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -63,3 +67,56 @@ food(Curriculum) ->
catch _ ->
0
end, Curriculum].
+
+%% Test trunc/1, round/1, floor/1, ceil/1.
+trunc_and_friends(_Config) ->
+ Bifs = [trunc,round,floor,ceil],
+ Fs = trunc_and_friends_1(Bifs),
+ Mod = ?FUNCTION_NAME,
+ Calls = [begin
+ Atom = erl_syntax:function_name(N),
+ ?Q("'@Atom'()")
+ end || N <- Fs],
+ Tree = ?Q(["-module('@Mod@').",
+ "-export([test/0]).",
+ "test() -> _@Calls, ok.",
+ "id(I) -> I."]) ++ Fs,
+ merl:print(Tree),
+ Opts = test_lib:opt_opts(?MODULE),
+ {ok,_Bin} = merl:compile_and_load(Tree, Opts),
+ Mod:test(),
+ ok.
+
+trunc_and_friends_1([F|Fs]) ->
+ Func = list_to_atom("f"++integer_to_list(length(Fs))),
+ [trunc_template(Func, F)|trunc_and_friends_1(Fs)];
+trunc_and_friends_1([]) -> [].
+
+trunc_template(Func, Bif) ->
+ Val = 42.77,
+ Res = erlang:Bif(Val),
+ FloatRes = float(Res),
+ ?Q("'@Func@'() ->
+ Var = id(_@Val@),
+ if _@Bif@(Var) =:= _@Res@ -> ok end,
+ if _@Bif@(Var) == _@FloatRes@ -> ok end,
+ if _@Bif@(Var) == _@Res@ -> ok end,
+ _@Res@ = _@Bif@(Var),
+ try begin _@Bif@(a), ok end
+ catch error:badarg -> ok end,
+ ok.").
+
+cover_safe_bifs(Config) ->
+ _ = get(),
+ _ = get_keys(a),
+ _ = group_leader(),
+ _ = is_alive(),
+ _ = min(Config, []),
+ _ = nodes(),
+ _ = erlang:ports(),
+ _ = pre_loaded(),
+ _ = processes(),
+ _ = registered(),
+ _ = term_to_binary(Config),
+
+ ok.
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index 4743821337..0419b16eea 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,22 +26,22 @@
init_per_group/2,end_per_group/2,
byte_aligned/1,bit_aligned/1,extended_byte_aligned/1,
extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1,
- nomatch/1,sizes/1,general_expressions/1]).
+ nomatch/1,sizes/1,general_expressions/1,matched_out_size/1]).
-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[byte_aligned, bit_aligned, extended_byte_aligned,
extended_bit_aligned, mixed, filters, trim_coverage,
- nomatch, sizes, general_expressions].
+ nomatch, sizes, general_expressions, matched_out_size].
groups() ->
[].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -56,6 +56,7 @@ end_per_group(_GroupName, Config) ->
byte_aligned(Config) when is_list(Config) ->
cs_init(),
<<"abcdefg">> = cs(<< <<(X+32)>> || <<X>> <= <<"ABCDEFG">> >>),
+ <<"AxyzBxyzCxyz">> = cs(<< <<X, "xyz">> || <<X>> <= <<"ABC">> >>),
<<1:32/little,2:32/little,3:32/little,4:32/little>> =
cs(<< <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>),
cs(<<1:32/little,2:32/little,3:32/little,4:32/little>> =
@@ -337,6 +338,13 @@ general_expressions(_) ->
-undef(BAD).
+matched_out_size(Config) when is_list(Config) ->
+ <<1, 2>> = matched_out_size_1(<<4, 1:4, 4, 2:4>>),
+ ok.
+
+matched_out_size_1(Binary) ->
+ << <<X>> || <<S, X:S>> <= Binary>>.
+
cs_init() ->
erts_debug:set_internal_state(available_internal_state, true),
ok.
diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl
index 208d8c5487..526769f3a6 100644
--- a/lib/compiler/test/bs_bit_binaries_SUITE.erl
+++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -34,7 +34,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -43,9 +42,10 @@ groups() ->
asymmetric_tests,big_asymmetric_tests,
binary_to_and_from_list,big_binary_to_and_from_list,
send_and_receive,send_and_receive_alot]}].
-
+
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index ff18f8b41c..ccc49df005 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-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,7 +29,8 @@
init_per_testcase/2,end_per_testcase/2,
two/1,test1/1,fail/1,float_bin/1,in_guard/1,in_catch/1,
nasty_literals/1,coerce_to_float/1,side_effect/1,
- opt/1,otp_7556/1,float_arith/1,otp_8054/1]).
+ opt/1,otp_7556/1,float_arith/1,otp_8054/1,
+ cover/1]).
-include_lib("common_test/include/ct.hrl").
@@ -37,18 +38,18 @@ suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,1}}].
-all() ->
- test_lib:recompile(?MODULE),
+all() ->
[{group,p}].
-groups() ->
+groups() ->
[{p,[parallel],
[two,test1,fail,float_bin,in_guard,in_catch,
nasty_literals,side_effect,opt,otp_7556,float_arith,
- otp_8054]}].
+ otp_8054,cover]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -302,7 +303,14 @@ fail(Config) when is_list(Config) ->
{'EXIT',{badarg,_}} = (catch <<42.0/integer>>),
{'EXIT',{badarg,_}} = (catch <<42/binary>>),
{'EXIT',{badarg,_}} = (catch <<an_atom/integer>>),
-
+
+ %% Bad literal sizes
+ Bin = i(<<>>),
+ {'EXIT',{badarg,_}} = (catch <<0:(-1)>>),
+ {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-1)>>),
+ {'EXIT',{badarg,_}} = (catch <<0:(-(1 bsl 100))>>),
+ {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-(1 bsl 100))>>),
+
ok.
float_bin(Config) when is_list(Config) ->
@@ -552,3 +560,19 @@ otp_8054_1([H|T], Bin) ->
end,
otp_8054_1(T, Bin);
otp_8054_1([], Bin) -> Bin.
+
+-define(LONG_STRING,
+ "3lz7Q4au2i3DJWNlNhWuzmvA7gYWGXG+LAPtgtlEO2VGSxRqL2WOoHW"
+ "QxORTQfJw17mNEU8i87UKvEPbo9YY8ppiM7vfaG88TTyfEzgUMTgY3I"
+ "vsikMBELPz2AayVz5aaMh9PBFTZ4DkBIFxURBUKHho4Vgt7IzYnWNgn"
+ "3ON5D9VS89TPANK5/PwSUoMQYZ2fk5VLbq7D1ExlnCScvTDnF/WHMQ3"
+ "m2GUcQWb+ajfOf3bnP7EX4f1Q3d/1Soe6lEpf1KN/5S7A/ugjMhy4+H"
+ "Zuo1J1J6CCwEVZ/wDc79OpDPPj/qOGhDK73F8DaMcynZ91El+01vfTn"
+ "uUxNFUHLpuoQ==").
+
+cover(Config) ->
+ %% Cover handling of a huge partially literal string.
+ L = length(Config),
+ Bin = id(<<L:32,?LONG_STRING>>),
+ <<L:32,?LONG_STRING>> = Bin,
+ ok.
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index a9bee888d9..a751f6fda5 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-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -38,8 +38,10 @@
no_partition/1,calling_a_binary/1,binary_in_map/1,
match_string_opt/1,select_on_integer/1,
map_and_binary/1,unsafe_branch_caching/1,
- bad_literals/1,good_literals/1,constant_propagation/1
- ]).
+ bad_literals/1,good_literals/1,constant_propagation/1,
+ parse_xml/1,get_payload/1,escape/1,num_slots_different/1,
+ beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1,erl_689/1,
+ bs_start_match2_defs/1]).
-export([coverage_id/1,coverage_external_ignore/2]).
@@ -52,7 +54,6 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -70,10 +71,14 @@ groups() ->
no_partition,calling_a_binary,binary_in_map,
match_string_opt,select_on_integer,
map_and_binary,unsafe_branch_caching,
- bad_literals,good_literals,constant_propagation]}].
+ bad_literals,good_literals,constant_propagation,parse_xml,
+ get_payload,escape,num_slots_different,
+ beam_bsm,guard,is_ascii,non_opt_eq,erl_689,
+ bs_start_match2_defs]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -327,6 +332,11 @@ save_restore(Config) when is_list(Config) ->
{"-",<<"x">>} = nnn(C),
{"-",<<"x">>} = ooo(C),
+ a = multiple_matches(<<777:16>>, <<777:16>>),
+ b = multiple_matches(<<777:16>>, <<999:16>>),
+ c = multiple_matches(<<777:16>>, <<57:8>>),
+ d = multiple_matches(<<17:8>>, <<1111:16>>),
+
Bin = <<-1:64>>,
case bad_float_unpack_match(Bin) of
-1 -> ok;
@@ -354,6 +364,11 @@ nnn(<<Char, Tail/binary>>) -> {[Char],Tail}. %% Buggy Tail!
ooo(<<" - ", Tail/binary>>) -> Tail;
ooo(<<Char, Tail/binary>>) -> {[Char],Tail}.
+multiple_matches(<<Y:16>>, <<Y:16>>) -> a;
+multiple_matches(<<_:16>>, <<_:16>>) -> b;
+multiple_matches(<<_:16>>, <<_:8>>) -> c;
+multiple_matches(<<_:8>>, <<_:16>>) -> d.
+
bad_float_unpack_match(<<F:64/float>>) -> F;
bad_float_unpack_match(<<I:64/integer-signed>>) -> I.
@@ -675,6 +690,10 @@ coverage(Config) when is_list(Config) ->
<<>> = coverage_per_key(<<4:32>>),
<<$a,$b,$c>> = coverage_per_key(<<7:32,"abc">>),
+ binary = coverage_bitstring(<<>>),
+ binary = coverage_bitstring(<<7>>),
+ bitstring = coverage_bitstring(<<7:4>>),
+ other = coverage_bitstring([a]),
ok.
coverage_fold(Fun, Acc, <<H,T/binary>>) ->
@@ -765,6 +784,10 @@ coverage_per_key(<<BinSize:32,Bin/binary>> = B) ->
true = (byte_size(B) =:= BinSize),
Bin.
+coverage_bitstring(Bin) when is_binary(Bin) -> binary;
+coverage_bitstring(<<_/bitstring>>) -> bitstring;
+coverage_bitstring(_) -> other.
+
multiple_uses(Config) when is_list(Config) ->
{344,62879,345,<<245,159,1,89>>} = multiple_uses_1(<<1,88,245,159,1,89>>),
true = multiple_uses_2(<<0,0,197,18>>),
@@ -798,7 +821,7 @@ multiple_uses_cmp(<<_:16>>, <<_:16>>) -> false.
first_after(Data, Offset) ->
case byte_size(Data) > Offset of
false ->
- {First, Rest} = {ok, ok},
+ {_First, _Rest} = {ok, ok},
ok;
true ->
<<_:Offset/binary, Rest/binary>> = Data,
@@ -887,28 +910,41 @@ matching_and_andalso(Config) when is_list(Config) ->
{'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, blurf)),
{'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>>),
+ {"abc",<<"xyz">>} = matching_and_andalso_23("abc", <<"-xyz">>),
+ {"abc",<<"">>} = matching_and_andalso_23("abc", <<($a-1)>>),
+ {"abc",<<"">>} = matching_and_andalso_23("abc", <<($z+1)>>),
+ {"abc",<<"">>} = matching_and_andalso_23("abc", <<($A-1)>>),
+ {"abc",<<"">>} = matching_and_andalso_23("abc", <<($Z+1)>>),
+ error = matching_and_andalso_23([], <<>>),
+ error = matching_and_andalso_23([], <<$A>>),
+ error = matching_and_andalso_23([], <<$Z>>),
+ error = matching_and_andalso_23([], <<$a>>),
+ error = matching_and_andalso_23([], <<$z>>),
ok.
matching_and_andalso_1(<<Bitmap/binary>>, K)
when is_integer(K) andalso size(Bitmap) >= K andalso 0 < K ->
ok.
+matching_and_andalso_23(Datetime, Bin) ->
+ Res = matching_and_andalso_2(Datetime, Bin),
+ Res = matching_and_andalso_3(Datetime, Bin),
+ Res.
+
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.
+%% Contrived example to ensure we cover the handling of 'call' instructions
+%% in v3_codegen:bsm_rename_ctx/4.
+matching_and_andalso_3(Datetime, <<H,T/binary>>)
+ when not ((abs(H) >= $a) andalso (abs(H) =< $z)) andalso
+ not ((abs(H) >= $A) andalso (abs(H) =< $Z)) ->
+ {Datetime,T};
+matching_and_andalso_3(_, _) -> 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,
@@ -1475,6 +1511,258 @@ constant_propagation_c() ->
X
end.
+parse_xml(_Config) ->
+ <<"<?xmlX">> = do_parse_xml(<<"<?xmlX">>),
+ <<" ">> = do_parse_xml(<<"<?xml ">>),
+ ok.
+
+do_parse_xml(<<"<?xml"/utf8,Rest/binary>> = Bytes) ->
+ %% Delayed sub-binary creation is not safe. A buggy (development)
+ %% version of check_liveness_everywhere() in beam_utils would turn
+ %% on the optimization.
+ Rest1 = case is_next_char_whitespace(Rest) of
+ false ->
+ Bytes;
+ true ->
+ id(Rest)
+ end,
+ id(Rest1).
+
+is_next_char_whitespace(<<C/utf8,_/binary>>) ->
+ C =:= $\s.
+
+-record(ext_header,
+ {this_hdr = 17,
+ ext_hdr_opts}).
+
+get_payload(_Config) ->
+ <<3445:48>> = do_get_payload(#ext_header{ext_hdr_opts = <<3445:48>>}),
+ {'EXIT',_} = (catch do_get_payload(#ext_header{})),
+ ok.
+
+do_get_payload(ExtHdr) ->
+ _ = ExtHdr#ext_header.this_hdr,
+ ExtHdrOptions = ExtHdr#ext_header.ext_hdr_opts,
+ <<_:13,_:35>> = ExtHdr#ext_header.ext_hdr_opts,
+ ExtHdrOptions.
+
+escape(_Config) ->
+ 0 = escape(<<>>, 0),
+ 1 = escape(<<128>>, 0),
+ 2 = escape(<<128,255>>, 0),
+ 42 = escape(<<42>>, 0),
+ 50 = escape(<<42,8>>, 0),
+ ok.
+
+escape(<<Byte, Rest/bits>>, Pos) when Byte >= 127 ->
+ escape(Rest, Pos + 1);
+escape(<<Byte, Rest/bits>>, Pos) ->
+ escape(Rest, Pos + Byte);
+escape(<<_Rest/bits>>, Pos) ->
+ Pos.
+
+%% ERL-490
+num_slots_different(_Config) ->
+ Ts = [{<<"de">>, <<"default">>, <<"Remove">>, <<"a">>},
+ {<<"de">>, <<"default">>, <<"Remove from list">>, <<"a">>},
+ {<<"de">>, <<"default">>, <<"Remove from the list">>, <<"a">>},
+ {<<"de">>, <<"default">>, <<"Results">>, <<"Ergebnisse">>},
+ {<<"de">>, <<"default">>, <<"Reservatio">>, <<"a">>},
+ {<<"de">>, <<"navigation">>, <<"Results">>, <<"Ergebnisse">>},
+ {<<"de">>, <<"navigation">>, <<"Resources">>, <<"Ressourcen">>}],
+ _ = [{ok,Res} = lgettext(A, B, C) || {A,B,C,Res} <- Ts],
+
+ {'EXIT',_} = (catch lgettext(<<"d">>, <<"default">>, <<"Remove">>)),
+ {'EXIT',_} = (catch lgettext("", <<"default">>, <<"Remove">>)),
+ {'EXIT',_} = (catch lgettext(<<"de">>, <<"def">>, <<"Remove">>)),
+ {'EXIT',_} = (catch lgettext(<<"de">>, <<"default">>, <<"Res">>)),
+ ok.
+
+
+lgettext(<<"de">>, <<"default">>, <<"Remove">>) ->
+ {ok, <<"a">>};
+lgettext(<<"de">>, <<"default">>, <<"Remove from list">>) ->
+ {ok, <<"a">>};
+lgettext(<<"de">>, <<"default">>, <<"Remove from the list">>) ->
+ {ok, <<"a">>};
+lgettext(<<"de">>, <<"default">>, <<"Results">>) ->
+ {ok, <<"Ergebnisse">>};
+lgettext(<<"de">>, <<"default">>, <<"Reservatio">>) ->
+ {ok, <<"a">>};
+lgettext(<<"de">>, <<"navigation">>, <<"Results">>) ->
+ {ok, <<"Ergebnisse">>};
+lgettext(<<"de">>, <<"navigation">>, <<"Resources">>) ->
+ {ok, <<"Ressourcen">>}.
+
+%% Test more code in beam_bsm.
+beam_bsm(_Config) ->
+ true = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [1,0,1,1]),
+ false = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [0]),
+
+ true = bsm_validate_scheme(<<>>),
+ true = bsm_validate_scheme(<<5,10>>),
+ false = bsm_validate_scheme(<<5,10,11,12>>),
+ true = bsm_validate_scheme([]),
+ true = bsm_validate_scheme([5,10]),
+ false = bsm_validate_scheme([5,6,7]),
+
+ <<1,2,3>> = bsm_must_save_and_not_save(<<1,2,3>>, []),
+ D = fun(N) -> 2*N end,
+ [2,4|<<3>>] = bsm_must_save_and_not_save(<<1,2,3>>, [D,D]),
+
+ ok.
+
+check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) ->
+ check_bitstring_list(T1, T2);
+check_bitstring_list(<<>>, []) ->
+ true;
+check_bitstring_list(_, _) ->
+ false.
+
+bsm_validate_scheme([]) -> true;
+bsm_validate_scheme([H|T]) ->
+ case bsm_is_scheme(H) of
+ true -> bsm_validate_scheme(T);
+ false -> false
+ end;
+bsm_validate_scheme(<<>>) -> true;
+bsm_validate_scheme(<<H, Rest/binary>>) ->
+ case bsm_is_scheme(H) of
+ true -> bsm_validate_scheme(Rest);
+ false -> false
+ end.
+
+bsm_is_scheme(Int) ->
+ Int rem 5 =:= 0.
+
+%% NOT OPTIMIZED: different control paths use different positions in the binary
+bsm_must_save_and_not_save(Bin, []) ->
+ Bin;
+bsm_must_save_and_not_save(<<H,T/binary>>, [F|Fs]) ->
+ [F(H)|bsm_must_save_and_not_save(T, Fs)];
+bsm_must_save_and_not_save(<<>>, []) ->
+ [].
+
+guard(_Config) ->
+ _Tuple = id({a,b}),
+ ok = guard_1(<<1,2,3>>, {1,2,3}),
+ ok = guard_2(<<42>>, #{}),
+ ok.
+
+%% Cover handling of #k_put{} in v3_codegen:bsm_rename_ctx/4.
+guard_1(<<A,B,C>>, Tuple) when Tuple =:= {A,B,C} ->
+ ok.
+
+%% Cover handling of #k_call{} in v3_codegen:bsm_rename_ctx/4.
+guard_2(<<_>>, Healing) when Healing#{[] => Healing} =:= #{[] => #{}} ->
+ ok.
+
+is_ascii(_Config) ->
+ true = do_is_ascii(<<>>),
+ true = do_is_ascii(<<"string">>),
+ false = do_is_ascii(<<1024/utf8>>),
+ {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<$A,0:3>>)),
+ {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<16#80,0:3>>)),
+ ok.
+
+do_is_ascii(<<>>) ->
+ true;
+do_is_ascii(<<C,_/binary>>) when C >= 16#80 ->
+ %% This clause must fail to match if the size of the argument in
+ %% bits is not divisible by 8. Beware of unsafe optimizations.
+ false;
+do_is_ascii(<<_, T/binary>>) ->
+ do_is_ascii(T).
+
+non_opt_eq(_Config) ->
+ true = non_opt_eq([], <<>>),
+ true = non_opt_eq([$a], <<$a>>),
+ false = non_opt_eq([$a], <<$b>>),
+ ok.
+
+%% An example from the Efficiency Guide. It used to be not optimized,
+%% but now it can be optimized.
+
+non_opt_eq([H|T1], <<H,T2/binary>>) ->
+ non_opt_eq(T1, T2);
+non_opt_eq([_|_], <<_,_/binary>>) ->
+ false;
+non_opt_eq([], <<>>) ->
+ true.
+
+%% ERL-689
+
+erl_689(_Config) ->
+ {{0, 0, 0}, <<>>} = do_erl_689_1(<<0>>, ?MODULE),
+ {{2018, 8, 7}, <<>>} = do_erl_689_1(<<4,2018:16/little,8,7>>, ?MODULE),
+ {{0, 0, 0}, <<>>} = do_erl_689_2(?MODULE, <<0>>),
+ {{2018, 8, 7}, <<>>} = do_erl_689_2(?MODULE, <<4,2018:16/little,8,7>>),
+ ok.
+
+do_erl_689_1(Arg1, Arg2) ->
+ Res = do_erl_689_1a(Arg1, Arg2),
+ Res = do_erl_689_1b(Arg1, Arg2).
+
+do_erl_689_2(Arg1, Arg2) ->
+ Res = do_erl_689_2a(Arg1, Arg2),
+ Res = do_erl_689_2b(Arg1, Arg2).
+
+do_erl_689_1a(<<Length, Data/binary>>, _) ->
+ case {Data, Length} of
+ {_, 0} ->
+ %% bs_context_to_binary would incorrectly set Data to the original
+ %% binary (before matching in the function head).
+ {{0, 0, 0}, Data};
+ {<<Y:16/little, M, D, Rest/binary>>, 4} ->
+ {{Y, M, D}, Rest}
+ end.
+
+do_erl_689_1b(<<Length, Data/binary>>, _) ->
+ case {Data, Length} of
+ {_, 0} ->
+ %% bs_context_to_binary would incorrectly set Data to the original
+ %% binary (before matching in the function head).
+ id(0),
+ {{0, 0, 0}, Data};
+ {<<Y:16/little, M, D, Rest/binary>>, 4} ->
+ id(1),
+ {{Y, M, D}, Rest}
+ end.
+
+do_erl_689_2a(_, <<Length, Data/binary>>) ->
+ case {Length, Data} of
+ {0, _} ->
+ %% bs_context_to_binary would incorrectly set Data to the original
+ %% binary (before matching in the function head).
+ {{0, 0, 0}, Data};
+ {4, <<Y:16/little, M, D, Rest/binary>>} ->
+ {{Y, M, D}, Rest}
+ end.
+
+do_erl_689_2b(_, <<Length, Data/binary>>) ->
+ case {Length, Data} of
+ {0, _} ->
+ %% bs_context_to_binary would incorrectly set Data to the original
+ %% binary (before matching in the function head).
+ id(0),
+ {{0, 0, 0}, Data};
+ {4, <<Y:16/little, M, D, Rest/binary>>} ->
+ id(1),
+ {{Y, M, D}, Rest}
+ end.
+
+%% ERL-753
+
+bs_start_match2_defs(_Config) ->
+ {<<"http://127.0.0.1:1234/vsaas/hello">>} = api_url(<<"hello">>, dummy),
+ {"https://127.0.0.1:4321/vsaas/hello"} = api_url({https, "hello"}, dummy).
+
+api_url(URL, Auth) ->
+ Header = [],
+ case URL of
+ <<_/binary>> -> {<<"http://127.0.0.1:1234/vsaas/",URL/binary>>};
+ {https, [_|_] = URL1} -> {"https://127.0.0.1:4321/vsaas/"++URL1}
+ end.
check(F, R) ->
R = F().
diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl
index c894041f72..8ea4a849ec 100644
--- a/lib/compiler/test/bs_utf_SUITE.erl
+++ b/lib/compiler/test/bs_utf_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -31,7 +31,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[utf8_roundtrip, unused_utf_char, utf16_roundtrip,
utf32_roundtrip, guard, extreme_tripping, literals,
coverage].
@@ -40,6 +39,7 @@ groups() ->
[].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -235,6 +235,7 @@ utf32_to_unicode(<<>>) -> [].
literals(Config) when is_list(Config) ->
abc_utf8 = match_literal(<<"abc"/utf8>>),
abc_utf8 = match_literal(<<$a,$b,$c>>),
+ abc_utf8 = match_literal(<<$a/utf8,$b/utf8,$c/utf8>>),
abc_utf16be = match_literal(<<"abc"/utf16>>),
abc_utf16be = match_literal(<<$a:16,$b:16,$c:16>>),
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index cd1bc099e9..139f7af0d4 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -66,7 +66,6 @@ suite() ->
{timetrap,{minutes,10}}].
all() ->
- test_lib:recompile(?MODULE),
[self_compile_old_inliner,self_compile,
{group,p}].
@@ -88,6 +87,7 @@ groups() ->
string_table,otp_8949_a,split_cases]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -319,7 +319,7 @@ self_compile_1(Config, Prefix, Opts) ->
%% Compile the compiler. (In this node to get better coverage.)
CompA = make_compiler_dir(Priv, Prefix++"compiler_a"),
VsnA = Version ++ ".0",
- compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]),
+ compile_compiler(compiler_src(), CompA, VsnA, Opts),
%% Compile the compiler again using the newly compiled compiler.
%% (In another node because reloading the compiler would disturb cover.)
diff --git a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
index f1607cca68..4643ce61f6 100644
--- a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
+++ b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -33,7 +33,7 @@ test() ->
{userinfo,nil},
fun() -> nil end},
nil},
- {'query',nil}}},
+ {query,nil}}},
{absoluteURI,
{scheme,_},
@@ -43,7 +43,7 @@ test() ->
{userinfo,nil},
HostportBefore},
nil},
- {'query',nil}}} = URI_Before,
+ {query,nil}}} = URI_Before,
%% ... some funky code ommitted, not relevant ...
@@ -55,7 +55,7 @@ test() ->
{userinfo,nil},
HostportAfter},
nil},
- {'query',nil}}} = URI_Before,
+ {query,nil}}} = URI_Before,
%% NOTE: I intended to write URI_After instead of URI_Before
%% but the accident revealed that when you add the line below,
%% it causes internal error in v3_codegen on compilation
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index b0148f7103..6b230710b3 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -27,14 +27,16 @@
-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,appup_test/1,
+ debug_info/4, custom_debug_info/1, custom_compile_info/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, encrypted_abstr/1,
- strict_record/1,
- cover/1, env/1, core/1,
- core_roundtrip/1, asm/1,
+ other_output/1, kernel_listing/1, encrypted_abstr/1,
+ strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1,
+ cover/1, env/1, core_pp/1, tuple_calls/1,
+ core_roundtrip/1, asm/1, optimized_guards/1,
sys_pre_attributes/1, dialyzer/1,
- warnings/1, pre_load_check/1, env_compiler_options/1
+ warnings/1, pre_load_check/1, env_compiler_options/1,
+ bc_options/1, deterministic_include/1, deterministic_paths/1
]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -44,19 +46,20 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
-spec all() -> all_return_type().
all() ->
- test_lib:recompile(?MODULE),
[app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
- other_output, encrypted_abstr,
- strict_record,
- cover, env, core, core_roundtrip, asm,
+ other_output, kernel_listing, encrypted_abstr, tuple_calls,
+ strict_record, utf8_atoms, utf8_functions, extra_chunks,
+ cover, env, core_pp, core_roundtrip, asm, optimized_guards,
sys_pre_attributes, dialyzer, warnings, pre_load_check,
- env_compiler_options].
+ env_compiler_options, custom_debug_info, bc_options,
+ custom_compile_info, deterministic_include, deterministic_paths].
groups() ->
[].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -105,13 +108,31 @@ file_1(Config) when is_list(Config) ->
{ok,simple} = compile:file(Simple, [{eprof,beam_z}]), %Coverage
+
+ %% Test option 'deterministic'.
+ {ok,simple} = compile:file(Simple, [deterministic]),
+ {module,simple} = c:l(simple),
+ [{version,_}] = simple:module_info(compile),
+ true = code:delete(simple),
+ false = code:purge(simple),
+
ok = file:set_cwd(Cwd),
true = exists(Target),
passed = run(Target, test, []),
+ %% Test option 'deterministic' as a compiler attribute.
+ Det = deterministic_module,
+ {DetPath, DetTarget} = get_files(Config, Det, "det_target"),
+ {ok,Det,DetCode} = compile:file(DetPath, [binary]),
+ {module,Det} = code:load_binary(Det, "", DetCode),
+ [{version,_}] = Det:module_info(compile),
+ true = code:delete(Det),
+ false = code:purge(Det),
+
%% Cleanup.
ok = file:delete(Target),
ok = file:del_dir(filename:dirname(Target)),
+ ok = file:del_dir(filename:dirname(DetTarget)),
%% There should not be any messages in the messages.
receive
@@ -153,6 +174,24 @@ forms_2(Config) when is_list(Config) ->
ok
end,
+ {ok,simple,Core} = compile:forms(SimpleCode, [to_core0,binary]),
+ forms_compile_and_load(Core, [from_core]),
+ forms_compile_and_load(Core, [from_core,native]),
+
+ {ok,simple,Asm} = compile:forms(SimpleCode, [to_asm,binary]),
+ forms_compile_and_load(Asm, [from_asm]),
+ forms_compile_and_load(Asm, [from_asm,native]),
+
+ {ok,simple,Beam} = compile:forms(SimpleCode, []),
+ forms_compile_and_load(Beam, [from_beam]),
+ forms_compile_and_load(Beam, [from_beam,native]),
+
+ %% Cover the error handling code.
+ error = compile:forms(bad_core, [from_core,report]),
+ error = compile:forms(bad_asm, [from_asm,report]),
+ error = compile:forms(<<"bad_beam">>, [from_beam,report]),
+ error = compile:forms(<<"bad_beam">>, [from_beam,native,report]),
+
ok.
@@ -170,6 +209,14 @@ forms_load_code(Mod, Src, Bin) ->
SourceOption.
+forms_compile_and_load(Code, Opts) ->
+ Mod = simple,
+ {ok,Mod,Bin} = compile:forms(Code, Opts),
+ {module,Mod} = code:load_binary(Mod, "ignore", Bin),
+ _ = Mod:module_info(),
+ true = code:delete(simple),
+ false = code:purge(simple),
+ ok.
module_mismatch(Config) when is_list(Config) ->
DataDir = proplists:get_value(data_dir, Config),
@@ -335,14 +382,13 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
do_listing(Simple, TargetDir, dinline, ".inline"),
do_listing(Simple, TargetDir, dcore, ".core"),
do_listing(Simple, TargetDir, dcopt, ".copt"),
+ do_listing(Simple, TargetDir, dcbsm, ".core_bsm"),
do_listing(Simple, TargetDir, dsetel, ".dsetel"),
do_listing(Simple, TargetDir, dkern, ".kernel"),
- do_listing(Simple, TargetDir, dlife, ".life"),
do_listing(Simple, TargetDir, dcg, ".codegen"),
do_listing(Simple, TargetDir, dblk, ".block"),
do_listing(Simple, TargetDir, dexcept, ".except"),
do_listing(Simple, TargetDir, dbs, ".bs"),
- do_listing(Simple, TargetDir, dbool, ".bool"),
do_listing(Simple, TargetDir, dtype, ".type"),
do_listing(Simple, TargetDir, ddead, ".dead"),
do_listing(Simple, TargetDir, djmp, ".jump"),
@@ -362,6 +408,7 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
ok = file:delete(filename:join(Listings, File ++ ".core")),
do_listing(Simple, TargetDir, to_core, ".core"),
do_listing(Simple, TargetDir, to_kernel, ".kernel"),
+ do_listing(Simple, TargetDir, to_dis, ".dis"),
%% Final clean up.
lists:foreach(fun(F) -> ok = file:delete(F) end,
@@ -377,6 +424,7 @@ listings_big(Config) when is_list(Config) ->
do_listing(Big, TargetDir, 'E'),
do_listing(Big, TargetDir, 'P'),
do_listing(Big, TargetDir, dkern, ".kernel"),
+ do_listing(Big, TargetDir, to_dis, ".dis"),
TargetNoext = filename:rootname(Target, code:objfile_extension()),
{ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]),
@@ -403,12 +451,11 @@ other_output(Config) when is_list(Config) ->
end],
io:put_chars("to_exp (file)"),
- {ok,simple,Expand} = compile:file(Simple, [to_exp,binary,time]),
- case Expand of
- {simple,Exports,Forms} when is_list(Exports), is_list(Forms) -> ok
- end,
+ {ok,[],Expand} = compile:file(Simple, [to_exp,binary,time]),
+ true = is_list(Expand),
+ {attribute,_,module,simple} = lists:keyfind(module, 3, Expand),
io:put_chars("to_exp (forms)"),
- {ok,simple,Expand} = compile:forms(PP, [to_exp,binary,time]),
+ {ok,[],Expand} = compile:forms(PP, [to_exp,binary,time]),
io:put_chars("to_core (file)"),
{ok,simple,Core} = compile:file(Simple, [to_core,binary,time]),
@@ -431,6 +478,33 @@ other_output(Config) when is_list(Config) ->
ok.
+%% Smoke test and cover of pretty-printing of Kernel code.
+kernel_listing(_Config) ->
+ TestBeams = get_unique_beam_files(),
+ Abstr = [begin {ok,{Mod,[{abstract_code,
+ {raw_abstract_v1,Abstr}}]}} =
+ beam_lib:chunks(Beam, [abstract_code]),
+ {Mod,Abstr} end || Beam <- TestBeams],
+ test_lib:p_run(fun(F) -> do_kernel_listing(F) end, Abstr).
+
+do_kernel_listing({M,A}) ->
+ try
+ {ok,M,Kern} = compile:forms(A, [to_kernel]),
+ IoList = v3_kernel_pp:format(Kern),
+ case unicode:characters_to_binary(IoList) of
+ Bin when is_binary(Bin) ->
+ ok
+ end
+ catch
+ throw:{error,Error} ->
+ io:format("*** compilation failure '~p' for module ~s\n",
+ [Error,M]),
+ error;
+ Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
+ error
+ end.
+
encrypted_abstr(Config) when is_list(Config) ->
{Simple,Target} = get_files(Config, simple, "encrypted_abstr"),
@@ -470,17 +544,23 @@ encrypted_abstr_1(Simple, Target) ->
{ok,simple} = compile:file(Simple,
[debug_info,{debug_info_key,Key},
{outdir,TargetDir}]),
- verify_abstract(Target),
+ verify_abstract(Target, erl_abstract_code),
{ok,simple} = compile:file(Simple,
[{debug_info_key,Key},
{outdir,TargetDir}]),
- verify_abstract(Target),
+ verify_abstract(Target, erl_abstract_code),
{ok,simple} = compile:file(Simple,
[debug_info,{debug_info_key,{des3_cbc,Key}},
{outdir,TargetDir}]),
- verify_abstract(Target),
+ verify_abstract(Target, erl_abstract_code),
+
+ {ok,simple} = compile:file(Simple,
+ [{debug_info,{?MODULE,ok}},
+ {debug_info_key,Key},
+ {outdir,TargetDir}]),
+ verify_abstract(Target, ?MODULE),
{ok,{simple,[{compile_info,CInfo}]}} =
beam_lib:chunks(Target, [compile_info]),
@@ -505,7 +585,7 @@ encrypted_abstr_1(Simple, Target) ->
NewKey = "better use another key here",
write_crypt_file(["[{debug_info,des3_cbc,simple,\"",NewKey,"\"}].\n"]),
{ok,simple} = compile:file(Simple, [encrypt_debug_info,report]),
- verify_abstract("simple.beam"),
+ verify_abstract("simple.beam", erl_abstract_code),
ok = file:delete(".erlang.crypt"),
beam_lib:clear_crypto_key_fun(),
{error,beam_lib,{key_missing_or_invalid,"simple.beam",abstract_code}} =
@@ -538,9 +618,10 @@ encrypted_abstr_no_crypto(Simple, Target) ->
{outdir,TargetDir},report]),
ok.
-verify_abstract(Target) ->
- {ok,{simple,[Chunk]}} = beam_lib:chunks(Target, [abstract_code]),
- {abstract_code,{raw_abstract_v1,_}} = Chunk.
+verify_abstract(Beam, Backend) ->
+ {ok,{simple,[Abst, Dbgi]}} = beam_lib:chunks(Beam, [abstract_code, debug_info]),
+ {abstract_code,{raw_abstract_v1,_}} = Abst,
+ {debug_info,{debug_info_v1,Backend,_}} = Dbgi.
has_crypto() ->
try
@@ -559,6 +640,43 @@ install_crypto_key(Key) ->
ok = beam_lib:crypto_key_fun(F).
%% Miscellanous tests, mainly to get better coverage.
+debug_info(erlang_v1, Module, ok, _Opts) ->
+ {ok, [Module]};
+debug_info(erlang_v1, _Module, error, _Opts) ->
+ {error, unknown_format}.
+
+custom_debug_info(Config) when is_list(Config) ->
+ {Simple,_} = get_files(Config, simple, "file_1"),
+
+ {ok,simple,OkBin} = compile:file(Simple, [binary, {debug_info,{?MODULE,ok}}]), %Coverage
+ {ok,{simple,[{abstract_code,{raw_abstract_v1,[simple]}}]}} =
+ beam_lib:chunks(OkBin, [abstract_code]),
+ {ok,{simple,[{debug_info,{debug_info_v1,?MODULE,ok}}]}} =
+ beam_lib:chunks(OkBin, [debug_info]),
+
+ {ok,simple,ErrorBin} = compile:file(Simple, [binary, {debug_info,{?MODULE,error}}]), %Coverage
+ {ok,{simple,[{abstract_code,no_abstract_code}]}} =
+ beam_lib:chunks(ErrorBin, [abstract_code]),
+ {ok,{simple,[{debug_info,{debug_info_v1,?MODULE,error}}]}} =
+ beam_lib:chunks(ErrorBin, [debug_info]).
+
+custom_compile_info(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Forms = [{attribute,Anno,module,custom_compile_info}],
+ Opts = [binary,{compile_info,[{another,version}]}],
+
+ {ok,custom_compile_info,Bin} = compile:forms(Forms, Opts),
+ {ok,{custom_compile_info,[{compile_info,CompileInfo}]}} =
+ beam_lib:chunks(Bin, [compile_info]),
+ version = proplists:get_value(another, CompileInfo),
+ CompileOpts = proplists:get_value(options, CompileInfo),
+ undefined = proplists:get_value(compile_info, CompileOpts),
+
+ {ok,custom_compile_info,DetBin} = compile:forms(Forms, [deterministic|Opts]),
+ {ok,{custom_compile_info,[{compile_info,DetInfo}]}} =
+ beam_lib:chunks(DetBin, [compile_info]),
+ version = proplists:get_value(another, DetInfo).
+
cover(Config) when is_list(Config) ->
io:format("~p\n", [compile:options()]),
ok.
@@ -648,6 +766,80 @@ test_sloppy() ->
{1,2} = record_access:test(Turtle),
Turtle.
+utf8_atoms(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Atom = binary_to_atom(<<"こんにちは"/utf8>>, utf8),
+ Forms = [{attribute,Anno,compile,[export_all]},
+ {function,Anno,atom,0,[{clause,Anno,[],[],[{atom,Anno,Atom}]}]}],
+
+ Utf8AtomForms = [{attribute,Anno,module,utf8_atom}|Forms],
+ {ok,utf8_atom,Utf8AtomBin} =
+ compile:forms(Utf8AtomForms, [binary]),
+ {ok,{utf8_atom,[{atoms,_}]}} =
+ beam_lib:chunks(Utf8AtomBin, [atoms]),
+ code:load_binary(utf8_atom, "compile_SUITE", Utf8AtomBin),
+ Atom = utf8_atom:atom(),
+
+ NoUtf8AtomForms = [{attribute,Anno,module,no_utf8_atom}|Forms],
+ error = compile:forms(NoUtf8AtomForms, [binary, r19]).
+
+utf8_functions(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Atom = binary_to_atom(<<"こんにちは"/utf8>>, utf8),
+ Forms = [{attribute,Anno,compile,[export_all]},
+ {function,Anno,Atom,0,[{clause,Anno,[],[],[{atom,Anno,world}]}]}],
+
+ Utf8FunctionForms = [{attribute,Anno,module,utf8_function}|Forms],
+ {ok,utf8_function,Utf8FunctionBin} =
+ compile:forms(Utf8FunctionForms, [binary]),
+ {ok,{utf8_function,[{atoms,_}]}} =
+ beam_lib:chunks(Utf8FunctionBin, [atoms]),
+ code:load_binary(utf8_function, "compile_SUITE", Utf8FunctionBin),
+ world = utf8_function:Atom(),
+
+ NoUtf8FunctionForms = [{attribute,Anno,module,no_utf8_function}|Forms],
+ error = compile:forms(NoUtf8FunctionForms, [binary, r19]).
+
+extra_chunks(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Forms = [{attribute,Anno,module,extra_chunks}],
+
+ {ok,extra_chunks,ExtraChunksBinary} =
+ compile:forms(Forms, [binary, {extra_chunks, [{<<"ExCh">>, <<"Contents">>}]}]),
+ {ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} =
+ beam_lib:chunks(ExtraChunksBinary, ["ExCh"]).
+
+tuple_calls(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Forms = [{attribute,Anno,export,[{size,1},{store,1}]},
+ {function,Anno,size,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],size}},[]}]}]},
+ {function,Anno,store,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],store}},[{atom,[],key},{atom,[],value}]}]}]}],
+
+ TupleCallsFalse = [{attribute,Anno,module,tuple_calls_false}|Forms],
+ {ok,_,TupleCallsFalseBinary} = compile:forms(TupleCallsFalse, [binary]),
+ code:load_binary(tuple_calls_false, "compile_SUITE.erl", TupleCallsFalseBinary),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:store(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(empty_tuple())),
+
+ TupleCallsTrue = [{attribute,Anno,module,tuple_calls_true}|Forms],
+ {ok,_,TupleCallsTrueBinary} = compile:forms(TupleCallsTrue, [binary,tuple_calls]),
+ code:load_binary(tuple_calls_true, "compile_SUITE.erl", TupleCallsTrueBinary),
+ Dict = tuple_calls_true:store(dict()),
+ 1 = tuple_calls_true:size(Dict),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_true:size(empty_tuple())),
+
+ ok.
+
+dict() ->
+ dict:new().
+empty_tuple() ->
+ {}.
+
env(Config) when is_list(Config) ->
{Simple,Target} = get_files(Config, simple, env),
{ok,Cwd} = file:get_cwd(),
@@ -689,9 +881,9 @@ env_1(Simple, Target) ->
%% Test pretty-printing in Core Erlang format and then try to
%% compile the generated Core Erlang files.
-core(Config) when is_list(Config) ->
+core_pp(Config) when is_list(Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
- Outdir = filename:join(PrivDir, "core"),
+ Outdir = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)),
ok = file:make_dir(Outdir),
TestBeams = get_unique_beam_files(),
@@ -699,27 +891,26 @@ core(Config) when is_list(Config) ->
{raw_abstract_v1,Abstr}}]}} =
beam_lib:chunks(Beam, [abstract_code]),
{Mod,Abstr} end || Beam <- TestBeams],
- test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr).
+ test_lib:p_run(fun(F) -> do_core_pp(F, Outdir) end, Abstr).
-do_core({M,A}, Outdir) ->
+do_core_pp({M,A}, Outdir) ->
try
- do_core_1(M, A, Outdir)
+ do_core_pp_1(M, A, Outdir)
catch
throw:{error,Error} ->
io:format("*** compilation failure '~p' for module ~s\n",
[Error,M]),
error;
- Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [M,Class,Error,erlang:get_stacktrace()]),
+ Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
error
end.
-do_core_1(M, A, Outdir) ->
+do_core_pp_1(M, A, Outdir) ->
{ok,M,Core0} = compile:forms(A, [to_core]),
CoreFile = filename:join(Outdir, atom_to_list(M)++".core"),
CorePP = core_pp:format(Core0),
- ok = file:write_file(CoreFile, CorePP),
+ ok = file:write_file(CoreFile, unicode:characters_to_binary(CorePP)),
%% Parse the .core file and return the result as Core Erlang Terms.
Core = case compile:file(CoreFile, [report_errors,from_core,no_copt,to_core,binary]) of
@@ -729,7 +920,7 @@ do_core_1(M, A, Outdir) ->
ok = file:delete(CoreFile),
%% Compile as usual (including optimizations).
- compile_forms(Core, [clint,from_core,binary]),
+ compile_forms(M, Core, [clint,from_core,binary]),
%% Don't optimize to test that we are not dependent
%% on the Core Erlang optmimization passes.
@@ -738,13 +929,13 @@ do_core_1(M, A, Outdir) ->
%% records; if sys_core_fold was run it would fix
%% that; if sys_core_fold was not run v3_kernel would
%% crash.)
- compile_forms(Core, [clint,from_core,no_copt,binary]),
+ compile_forms(M, Core, [clint,from_core,no_copt,binary]),
ok.
-compile_forms(Forms, Opts) ->
+compile_forms(Mod, Forms, Opts) ->
case compile:forms(Forms, [report_errors|Opts]) of
- {ok,[],_} -> ok;
+ {ok,Mod,_} -> ok;
Other -> throw({error,Other})
end.
@@ -768,9 +959,8 @@ do_core_roundtrip(Beam, Outdir) ->
io:format("*** compilation failure '~p' for file ~s\n",
[Error,Beam]),
error;
- Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [Beam,Class,Error,erlang:get_stacktrace()]),
+ Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [Beam,Class,Error,Stk]),
error
end.
@@ -791,7 +981,7 @@ do_core_roundtrip_1(Mod, Abstr, Outdir) ->
do_core_roundtrip_2(M, Core0, Outdir) ->
CoreFile = filename:join(Outdir, atom_to_list(M)++".core"),
CorePP = core_pp:format_all(Core0),
- ok = file:write_file(CoreFile, CorePP),
+ ok = file:write_file(CoreFile, unicode:characters_to_binary(CorePP)),
%% Parse the .core file and return the result as Core Erlang Terms.
Core2 = case compile:file(CoreFile, [report_errors,from_core,
@@ -805,9 +995,7 @@ do_core_roundtrip_2(M, Core0, Outdir) ->
case cmp_core(Core0, Core, M) of
true -> ok;
false -> error
- end,
-
- ok.
+ end.
undo_var_translation(Tree) ->
F = fun(Node) ->
@@ -860,11 +1048,92 @@ diff(E, E) ->
diff([H1|T1], [H2|T2]) ->
[diff(H1, H2)|diff(T1, T2)];
diff(T1, T2) when tuple_size(T1) =:= tuple_size(T2) ->
- L = diff(tuple_to_list(T1), tuple_to_list(T2)),
- list_to_tuple(L);
+ case cerl:is_c_var(T1) andalso cerl:is_c_var(T2) of
+ true ->
+ diff_var(T1, T2);
+ false ->
+ case cerl:is_c_map(T1) andalso cerl:is_c_map(T2) of
+ true ->
+ diff_map(T1, T2);
+ false ->
+ diff_tuple(T1, T2)
+ end
+ end;
diff(E1, E2) ->
{'DIFF',E1,E2}.
+diff_var(V1, V2) ->
+ case {cerl:var_name(V1),cerl:var_name(V2)} of
+ {Same,Same} ->
+ V1;
+ {Name1,Name2} ->
+ %% The inliner uses integers as variable names. Such integers
+ %% are read back as atoms.
+ case is_integer(Name1) andalso
+ list_to_atom(integer_to_list(Name1)) =:= Name2 of
+ true ->
+ V1;
+ _ ->
+ cerl:update_c_var(V1, {'DIFF',Name1,Name2})
+ end
+ end.
+
+%% Annotations for maps are not preserved exactly, but that is not
+%% a real problem. Workaround by not comparing all annotations when
+%% comparing maps.
+
+diff_map(M, M) ->
+ M;
+diff_map(M1, M2) ->
+ case cerl:get_ann(M1) =:= cerl:get_ann(M2) of
+ false ->
+ diff_tuple(M1, M2);
+ true ->
+ case remove_compiler_gen(M1) =:= remove_compiler_gen(M2) of
+ true ->
+ M1;
+ false ->
+ diff_tuple(M1, M2)
+ end
+ end.
+
+diff_tuple(T1, T2) ->
+ L = diff(tuple_to_list(T1), tuple_to_list(T2)),
+ list_to_tuple(L).
+
+remove_compiler_gen(M) ->
+ Arg0 = cerl:map_arg(M),
+ Arg = cerl:set_ann(Arg0, []),
+ Es0 = cerl:map_es(M),
+ Es = [remove_compiler_gen_1(Pair) || Pair <- Es0],
+ cerl:update_c_map(M, Arg, Es).
+
+remove_compiler_gen_1(Pair) ->
+ Op0 = cerl:map_pair_op(Pair),
+ Op = cerl:set_ann(Op0, []),
+ K = map_var(cerl:map_pair_key(Pair)),
+ V = map_var(cerl:map_pair_val(Pair)),
+ cerl:update_c_map_pair(Pair, Op, K, V).
+
+map_var(Var) ->
+ case cerl:is_c_var(Var) of
+ true ->
+ case cerl:var_name(Var) of
+ Name when is_atom(Name) ->
+ L = atom_to_list(Name),
+ try list_to_integer(L) of
+ Int ->
+ cerl:update_c_var(Var, Int)
+ catch
+ error:_ ->
+ Var
+ end;
+ _ ->
+ Var
+ end;
+ false ->
+ Var
+ end.
%% Compile to Beam assembly language (.S) and then try to
%% run .S through the compiler again.
@@ -896,12 +1165,100 @@ do_asm(Beam, Outdir) ->
[Other,AsmFile]),
error
end
- catch Class:Error ->
- io:format("~p: ~p ~p\n~p\n",
- [M,Class,Error,erlang:get_stacktrace()]),
+ catch Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
error
end.
+%% Make sure that guards are fully optimized. Guards should
+%% should use 'test' instructions, not 'bif' instructions.
+
+optimized_guards(_Config) ->
+ TestBeams = get_unique_beam_files(),
+ test_lib:p_run(fun(F) -> do_opt_guards(F) end, TestBeams).
+
+do_opt_guards(Beam) ->
+ {ok,{M,[{abstract_code,{raw_abstract_v1,A}}]}} =
+ beam_lib:chunks(Beam, [abstract_code]),
+ try
+ {ok,M,Asm} = compile:forms(A, ['S']),
+ do_opt_guards_mod(Asm)
+ catch Class:Error:Stk ->
+ io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
+ error
+ end.
+
+do_opt_guards_mod({Mod,_Exp,_Attr,Asm,_NumLabels}) ->
+ case do_opt_guards_fs(Mod, Asm) of
+ [] ->
+ ok;
+ [_|_]=Bifs ->
+ io:format("ERRORS FOR ~p:\n~p\n", [Mod,Bifs]),
+ error
+ end.
+
+do_opt_guards_fs(Mod, [{function,Name,Arity,_,Is}|Fs]) ->
+ Bifs0 = do_opt_guards_fun(Is),
+
+ %% The compiler does not attempt to optimize 'xor'.
+ %% Therefore, ignore all functions that use 'xor' in
+ %% a guard.
+ Bifs = case lists:any(fun({bif,'xor',_,_,_}) -> true;
+ (_) -> false
+ end, Bifs0) of
+ true -> [];
+ false -> Bifs0
+ end,
+
+ %% Filter out the allowed exceptions.
+ FA = {Name,Arity},
+ case {Bifs,is_exception(Mod, FA)} of
+ {[_|_],true} ->
+ io:format("~p:~p/~p IGNORED:\n~p\n",
+ [Mod,Name,Arity,Bifs]),
+ do_opt_guards_fs(Mod, Fs);
+ {[_|_],false} ->
+ [{FA,Bifs}|do_opt_guards_fs(Mod, Fs)];
+ {[],false} ->
+ do_opt_guards_fs(Mod, Fs);
+ {[],true} ->
+ io:format("Redundant exception for ~p:~p/~p\n",
+ [Mod,Name,Arity]),
+ error(redundant)
+ end;
+do_opt_guards_fs(_, []) -> [].
+
+do_opt_guards_fun([{bif,Name,{f,F},As,_}=I|Is]) when F =/= 0 ->
+ Arity = length(As),
+ case erl_internal:comp_op(Name, Arity) orelse
+ erl_internal:bool_op(Name, Arity) orelse
+ erl_internal:new_type_test(Name, Arity) of
+ true ->
+ [I|do_opt_guards_fun(Is)];
+ false ->
+ do_opt_guards_fun(Is)
+ end;
+do_opt_guards_fun([_|Is]) ->
+ do_opt_guards_fun(Is);
+do_opt_guards_fun([]) -> [].
+
+is_exception(bs_match_SUITE, {matching_and_andalso_2,2}) -> true;
+is_exception(bs_match_SUITE, {matching_and_andalso_3,2}) -> true;
+is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true;
+is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true;
+is_exception(guard_SUITE, {basic_andalso_orelse,1}) -> true;
+is_exception(guard_SUITE, {bad_guards,1}) -> true;
+is_exception(guard_SUITE, {bad_guards_2,2}) -> true;
+is_exception(guard_SUITE, {bad_guards_3,2}) -> true;
+is_exception(guard_SUITE, {cqlc,4}) -> true;
+is_exception(guard_SUITE, {csemi7,3}) -> true;
+is_exception(guard_SUITE, {misc,1}) -> true;
+is_exception(guard_SUITE, {nested_not_2b,4}) -> true;
+is_exception(guard_SUITE, {tricky_1,2}) -> true;
+is_exception(map_SUITE, {map_guard_update,2}) -> true;
+is_exception(map_SUITE, {map_guard_update_variables,3}) -> true;
+is_exception(_, _) -> false.
+
sys_pre_attributes(Config) ->
DataDir = proplists:get_value(data_dir, Config),
File = filename:join(DataDir, "attributes.erl"),
@@ -988,10 +1345,13 @@ do_warnings_2([], Next, F) ->
%% pre-loads the modules that are used by a typical compilation.
pre_load_check(Config) ->
- case test_server:is_cover() of
- true ->
+ case {test_server:is_cover(),code:module_info(native)} of
+ {true,_} ->
{skip,"Cover is running"};
- false ->
+ {false,true} ->
+ %% Tracing won't work.
+ {skip,"'code' is native-compiled"};
+ {false,false} ->
try
do_pre_load_check(Config)
after
@@ -1110,6 +1470,91 @@ env_compiler_options(_Config) ->
end,
lists:foreach(F, Cases).
+%% Test options for compatibility with previous major versions of OTP.
+
+bc_options(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+
+ 101 = highest_opcode(DataDir, small_float, [no_get_hd_tl,no_line_info]),
+
+ 103 = highest_opcode(DataDir, big,
+ [no_get_hd_tl,no_record_opt,
+ no_line_info,no_stack_trimming]),
+
+ 125 = highest_opcode(DataDir, small_float,
+ [no_get_hd_tl,no_line_info,no_float_opt]),
+
+ 132 = highest_opcode(DataDir, small,
+ [no_get_hd_tl,no_record_opt,no_float_opt,no_line_info]),
+
+ 136 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt,no_line_info]),
+
+ 153 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt]),
+ 153 = highest_opcode(DataDir, big, [r16]),
+ 153 = highest_opcode(DataDir, big, [r17]),
+ 153 = highest_opcode(DataDir, big, [r18]),
+ 153 = highest_opcode(DataDir, big, [r19]),
+ 153 = highest_opcode(DataDir, small_float, [r16]),
+ 153 = highest_opcode(DataDir, small_float, []),
+
+ 158 = highest_opcode(DataDir, small_maps, [r17]),
+ 158 = highest_opcode(DataDir, small_maps, [r18]),
+ 158 = highest_opcode(DataDir, small_maps, [r19]),
+ 158 = highest_opcode(DataDir, small_maps, [r20]),
+ 158 = highest_opcode(DataDir, small_maps, []),
+
+ 163 = highest_opcode(DataDir, big, []),
+
+ ok.
+
+highest_opcode(DataDir, Mod, Opt) ->
+ Src = filename:join(DataDir, atom_to_list(Mod)++".erl"),
+ {ok,Mod,Beam} = compile:file(Src, [binary|Opt]),
+ {ok,{Mod,[{"Code",Code}]}} = beam_lib:chunks(Beam, ["Code"]),
+ <<16:32,0:32,HighestOpcode:32,_/binary>> = Code,
+ HighestOpcode.
+
+deterministic_include(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ Simple = filename:join(DataDir, "simple"),
+
+ %% Files without +deterministic should differ if their include paths do,
+ %% as their debug info will be different.
+ {ok,_,NonDetA} = compile:file(Simple, [binary, {i,"gurka"}]),
+ {ok,_,NonDetB} = compile:file(Simple, [binary, {i,"gaffel"}]),
+ true = NonDetA =/= NonDetB,
+
+ %% ... but files with +deterministic shouldn't.
+ {ok,_,DetC} = compile:file(Simple, [binary, deterministic, {i,"gurka"}]),
+ {ok,_,DetD} = compile:file(Simple, [binary, deterministic, {i,"gaffel"}]),
+ true = DetC =:= DetD,
+
+ ok.
+
+deterministic_paths(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+
+ %% Files without +deterministic should differ if they were compiled from a
+ %% different directory.
+ true = deterministic_paths_1(DataDir, "simple", []),
+
+ %% ... but files with +deterministic shouldn't.
+ false = deterministic_paths_1(DataDir, "simple", [deterministic]),
+
+ ok.
+
+deterministic_paths_1(DataDir, Name, Opts) ->
+ Simple = filename:join(DataDir, "simple"),
+ {ok, Cwd} = file:get_cwd(),
+ try
+ {ok,_,A} = compile:file(Simple, [binary | Opts]),
+ ok = file:set_cwd(DataDir),
+ {ok,_,B} = compile:file(Name, [binary | Opts]),
+ A =/= B
+ after
+ file:set_cwd(Cwd)
+ end.
+
%%%
%%% Utilities.
%%%
@@ -1127,8 +1572,15 @@ get_unique_beam_files() ->
get_unique_files(Ext) ->
Wc = filename:join(filename:dirname(code:which(?MODULE)), "*"++Ext),
- [F || F <- filelib:wildcard(Wc), not is_cloned(F, Ext)].
+ [F || F <- filelib:wildcard(Wc),
+ not is_cloned(F, Ext), not is_lfe_module(F, Ext)].
is_cloned(File, Ext) ->
Mod = list_to_atom(filename:basename(File, Ext)),
test_lib:is_cloned_mod(Mod).
+
+is_lfe_module(File, Ext) ->
+ case filename:basename(File, Ext) of
+ "lfe_" ++ _ -> true;
+ _ -> false
+ end.
diff --git a/lib/compiler/test/compile_SUITE_data/big.erl b/lib/compiler/test/compile_SUITE_data/big.erl
index 2e54ee8660..765c71c07d 100644
--- a/lib/compiler/test/compile_SUITE_data/big.erl
+++ b/lib/compiler/test/compile_SUITE_data/big.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -741,3 +741,7 @@ snmp_access(suite) ->
debug_support(suite) ->
[ info, schema, schema, kill, lkill ].
+%% Cover translation of get_hd/2 to get_list/3 when option no_get_hd_tl
+%% is given.
+cover_get_hd([Hd|_]) ->
+ Hd.
diff --git a/lib/compiler/src/v3_life.hrl b/lib/compiler/test/compile_SUITE_data/deterministic_module.erl
index 9d03a86ccd..5e0e29c25e 100644
--- a/lib/compiler/src/v3_life.hrl
+++ b/lib/compiler/test/compile_SUITE_data/deterministic_module.erl
@@ -1,8 +1,8 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -14,14 +14,8 @@
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-%%
+%%
%% %CopyrightEnd%
%%
-%% This record contains variable life-time annotation for a
-%% kernel expression. Added by v3_life, used by v3_codegen.
-
--record(l, {ke, %Kernel expression
- i=0, %Op number
- vdb=[], %Variable database
- a}). %Core annotation
-
+-module(deterministic_module).
+-compile([deterministic]).
diff --git a/lib/compiler/test/compile_SUITE_data/simple.erl b/lib/compiler/test/compile_SUITE_data/simple.erl
index d8324dafaf..9385d101e0 100644
--- a/lib/compiler/test/compile_SUITE_data/simple.erl
+++ b/lib/compiler/test/compile_SUITE_data/simple.erl
@@ -19,7 +19,7 @@
%%
-module(simple).
--export([test/0]).
+-export([test/0,unicode/0]).
-ifdef(need_foo).
-export([foo/0]).
@@ -28,6 +28,9 @@
test() ->
passed.
+unicode() ->
+ {"это",'спутник'}.
+
%% Conditional inclusion.
%% Compile with [{d, need_foo}, {d, foo_value, 42}].
diff --git a/lib/compiler/test/compile_SUITE_data/small_float.erl b/lib/compiler/test/compile_SUITE_data/small_float.erl
new file mode 100644
index 0000000000..5cbb5aef83
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/small_float.erl
@@ -0,0 +1,5 @@
+-module(small_float).
+-export([f/1]).
+
+f(F) when is_float(F) ->
+ F / 2.
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index b768f49e2c..e5611e99d1 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,8 +26,10 @@
seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1,
unsafe_case/1,nomatch_shadow/1,reversed_annos/1,
map_core_test/1,eval_case/1,bad_boolean_guard/1,
- bs_shadowed_size_var/1
- ]).
+ bs_shadowed_size_var/1,
+ cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1,
+ cover_v3_kernel_4/1,cover_v3_kernel_5/1,
+ non_variable_apply/1,name_capture/1,fun_letrec_effect/1]).
-include_lib("common_test/include/ct.hrl").
@@ -45,7 +47,6 @@ suite() ->
{timetrap,{minutes,5}}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -53,21 +54,25 @@ groups() ->
[dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq,
eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos,
map_core_test,eval_case,bad_boolean_guard,
- bs_shadowed_size_var
- ]}].
+ bs_shadowed_size_var,
+ cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3,
+ cover_v3_kernel_4,cover_v3_kernel_5,
+ non_variable_apply,name_capture,fun_letrec_effect
+ ]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
ok.
init_per_group(_GroupName, Config) ->
- Config.
+ Config.
end_per_group(_GroupName, Config) ->
- Config.
+ Config.
?comp(dehydrated_itracer).
@@ -82,7 +87,14 @@ end_per_group(_GroupName, Config) ->
?comp(eval_case).
?comp(bad_boolean_guard).
?comp(bs_shadowed_size_var).
-
+?comp(cover_v3_kernel_1).
+?comp(cover_v3_kernel_2).
+?comp(cover_v3_kernel_3).
+?comp(cover_v3_kernel_4).
+?comp(cover_v3_kernel_5).
+?comp(non_variable_apply).
+?comp(name_capture).
+?comp(fun_letrec_effect).
try_it(Mod, Conf) ->
Src = filename:join(proplists:get_value(data_dir, Conf),
diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_1.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_1.core
new file mode 100644
index 0000000000..9e5788796f
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_1.core
@@ -0,0 +1,147 @@
+module 'cover_v3_kernel_1' ['cover_v3_kernel_1'/0,
+ 'module_info'/0,
+ 'module_info'/1]
+ attributes []
+'cover_v3_kernel_1'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ %% Line 5
+ case apply 'bad_and_args'/1
+ ('x') of
+ <'error'> when 'true' ->
+ %% Line 7
+ case apply 'bad_and_args'/2
+ (1, 2) of
+ <'error'> when 'true' ->
+ %% Line 8
+ case apply 'bad_and_args'/2
+ (1, 'true') of
+ <'error'> when 'true' ->
+ %% Line 9
+ case apply 'bad_and_args'/2
+ ('true', 42) of
+ <'error'> when 'true' ->
+ %% Line 10
+ case apply 'bad_and_args'/2
+ ('true', 'false') of
+ <'error'> when 'true' ->
+ %% Line 11
+ case apply 'bad_and_args'/2
+ ('false', 'true') of
+ <'error'> when 'true' ->
+ %% Line 12
+ case apply 'bad_and_args'/2
+ ('true', 'true') of
+ <'ok'> when 'true' ->
+ %% Line 14
+ 'ok'
+ ( <_@c6> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c6})
+ -| ['compiler_generated'] )
+ end
+ ( <_@c5> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c5})
+ -| ['compiler_generated'] )
+ end
+ ( <_@c4> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c4})
+ -| ['compiler_generated'] )
+ end
+ ( <_@c3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c3})
+ -| ['compiler_generated'] )
+ end
+ ( <_@c2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c2})
+ -| ['compiler_generated'] )
+ end
+ ( <_@c1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c1})
+ -| ['compiler_generated'] )
+ end
+ ( <_@c0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c0})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'cover_v3_kernel_1',0}}] )
+ -| ['compiler_generated'] )
+ end
+'bad_and_args'/1 =
+ %% Line 16
+ fun (_@c0) ->
+ case _@c0 of
+ <A>
+ when try
+ call 'erlang':'and'(A, 42)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ %% Line 17
+ <_@c4> when 'true' ->
+ 'error'
+ ( <_@c3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c3})
+ -| [{'function_name',{'bad_and_args',1}}] )
+ -| ['compiler_generated'] )
+ end
+'bad_and_args'/2 =
+ %% Line 19
+ fun (_@c1,_@c0) ->
+ case <_@c1,_@c0> of
+ <X,Y>
+ when try
+ call 'erlang':'and'(X, Y)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ %% Line 20
+ <_@c6,_@c7> when 'true' ->
+ 'error'
+ ( <_@c5,_@c4> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c5,_@c4})
+ -| [{'function_name',{'bad_and_args',2}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_1')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'module_info',0}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/1 =
+ fun (_@c0) ->
+ case _@c0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_1', X)
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'module_info',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_2.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_2.core
new file mode 100644
index 0000000000..165aacd691
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_2.core
@@ -0,0 +1,98 @@
+module 'cover_v3_kernel_2' ['cover_v3_kernel_2'/0,
+ 'module_info'/0,
+ 'module_info'/1]
+ attributes []
+'cover_v3_kernel_2'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ %% Line 5
+ case apply 'strange_case'/1
+ ('a') of
+ <'ok'> when 'true' ->
+ %% Line 6
+ case apply 'strange_case'/1
+ ('b') of
+ <'ok'> when 'true' ->
+ %% Line 7
+ case apply 'strange_case'/1
+ ('c') of
+ <'error'> when 'true' ->
+ %% Line 8
+ case apply 'strange_case'/1
+ (42) of
+ <'error'> when 'true' ->
+ %% Line 9
+ 'ok'
+ ( <_cor3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor3})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor2})
+ -| ['compiler_generated'] )
+ end
+ ( <_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',{'cover_v3_kernel_2',0}}] )
+ -| ['compiler_generated'] )
+ end
+'strange_case'/1 =
+ %% Line 12
+ fun (_cor0) ->
+ case _cor0 of
+ <X> when
+ case X of
+ <'a'> when 'true' -> 'true'
+ <'b'> when 'true' -> 'true'
+ <Other> when 'true' -> 'false'
+ end ->
+ 'ok'
+ %% Line 13
+ <_cor4> when 'true' ->
+ 'error'
+ ( <_cor3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor3})
+ -| [{'function_name',{'strange_case',1}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_2')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'module_info',0}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_2', X)
+ ( <_cor1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor1})
+ -| [{'function_name',{'module_info',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_3.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_3.core
new file mode 100644
index 0000000000..88a9edc354
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_3.core
@@ -0,0 +1,98 @@
+module 'cover_v3_kernel_3' ['cover_v3_kernel_3'/0,
+ 'module_info'/0,
+ 'module_info'/1]
+ attributes []
+'cover_v3_kernel_3'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ %% Line 5
+ case apply 'strange_case'/1
+ (1) of
+ <'ok'> when 'true' ->
+ %% Line 6
+ case apply 'strange_case'/1
+ (2) of
+ <'ok'> when 'true' ->
+ %% Line 7
+ case apply 'strange_case'/1
+ (42) of
+ <'error'> when 'true' ->
+ %% Line 8
+ case apply 'strange_case'/1
+ ('atom') of
+ <'error'> when 'true' ->
+ %% Line 9
+ 'ok'
+ ( <_cor3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor3})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor2})
+ -| ['compiler_generated'] )
+ end
+ ( <_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',{'cover_v3_kernel_3',0}}] )
+ -| ['compiler_generated'] )
+ end
+'strange_case'/1 =
+ %% Line 12
+ fun (_cor0) ->
+ case _cor0 of
+ <X> when
+ case X of
+ <1> when 'true' -> 'true'
+ <2> when 'true' -> 'true'
+ <Other> when 'true' -> 'false'
+ end ->
+ 'ok'
+ %% Line 13
+ <_cor4> when 'true' ->
+ 'error'
+ ( <_cor3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor3})
+ -| [{'function_name',{'strange_case',1}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_3')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'module_info',0}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_3', X)
+ ( <_cor1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor1})
+ -| [{'function_name',{'module_info',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_4.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_4.core
new file mode 100644
index 0000000000..905e236f26
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_4.core
@@ -0,0 +1,82 @@
+module 'cover_v3_kernel_4' ['cover_v3_kernel_4'/0,
+ 'module_info'/0,
+ 'module_info'/1]
+ attributes []
+'cover_v3_kernel_4'/0 =
+ %% Line 4
+ fun () ->
+ %% Line 5
+ case apply 'turned_case'/1
+ (20) of
+ <'ok'> when 'true' ->
+ %% Line 6
+ case apply 'turned_case'/1
+ (0) of
+ <'error'> when 'true' ->
+ %% Line 7
+ 'ok'
+ ( <_@c1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c1})
+ -| ['compiler_generated'] )
+ end
+ ( <_@c0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_@c0})
+ -| ['compiler_generated'] )
+ end
+'turned_case'/1 =
+ %% Line 9
+ fun (_@c0) ->
+ let <True> =
+ apply %% Line 10
+ 'id'/1
+ (%% Line 10
+ 'true')
+ in %% Line 11
+ case <> of
+ %% Line 12
+ <>
+ when try
+ ( let <_@c4> =
+ case call 'erlang':'<'
+ (_@c0, 10) of
+ ( <( 'false'
+ -| ['compiler_generated'] )> when 'true' ->
+ True
+ -| ['compiler_generated'] )
+ ( <( 'true'
+ -| ['compiler_generated'] )> when 'true' ->
+ 'false'
+ -| ['compiler_generated'] )
+ ( <_@c2> when 'true' ->
+ _@c2
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (( _@c4
+ -| ['compiler_generated'] ), 'true')
+ -| ['compiler_generated'] )
+ -| ['compiler_generated'] )
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ %% Line 13
+ <> when 'true' ->
+ 'error'
+ end
+'id'/1 =
+ %% Line 16
+ fun (_@c0) ->
+ _@c0
+'module_info'/0 =
+ fun () ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_4')
+'module_info'/1 =
+ fun (_@c0) ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_4', _@c0)
+end \ No newline at end of file
diff --git a/lib/compiler/test/core_SUITE_data/cover_v3_kernel_5.core b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_5.core
new file mode 100644
index 0000000000..48c1bb84e6
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/cover_v3_kernel_5.core
@@ -0,0 +1,98 @@
+module 'cover_v3_kernel_5' ['cover_v3_kernel_5'/0,
+ 'module_info'/0,
+ 'module_info'/1]
+ attributes []
+'cover_v3_kernel_5'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ %% Line 5
+ case apply 'strange_case'/1
+ (1) of
+ <'ok'> when 'true' ->
+ %% Line 6
+ case apply 'strange_case'/1
+ (2) of
+ <'ok'> when 'true' ->
+ %% Line 7
+ case apply 'strange_case'/1
+ (42) of
+ <'error'> when 'true' ->
+ %% Line 8
+ case apply 'strange_case'/1
+ ('atom') of
+ <'error'> when 'true' ->
+ %% Line 9
+ 'ok'
+ ( <_cor3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor3})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor2})
+ -| ['compiler_generated'] )
+ end
+ ( <_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',{'cover_v3_kernel_5',0}}] )
+ -| ['compiler_generated'] )
+ end
+'strange_case'/1 =
+ %% Line 12
+ fun (_cor0) ->
+ case _cor0 of
+ <X> when
+ case X of
+ <1> when 'true' -> 'true'
+ <2> when 'true' -> 'true'
+ <Other> when 'true' -> X
+ end ->
+ 'ok'
+ %% Line 13
+ <_cor4> when 'true' ->
+ 'error'
+ ( <_cor3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor3})
+ -| [{'function_name',{'strange_case',1}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_5')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'module_info',0}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('cover_v3_kernel_5', X)
+ ( <_cor1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor1})
+ -| [{'function_name',{'module_info',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core b/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core
new file mode 100644
index 0000000000..ab6f5b7940
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core
@@ -0,0 +1,25 @@
+module 'fun_letrec_effect' ['fun_letrec_effect'/0, 'ok'/0, 'wat'/0]
+attributes []
+
+'fun_letrec_effect'/0 =
+ fun () ->
+ do apply 'wat'/0()
+ receive
+ <'bar'> when 'true' -> 'ok'
+ <_0> when 'true' -> 'failed'
+ after 'infinity' ->
+ 'true'
+
+%% The return value (bar) of the fun was optimized away because the result of
+%% the `letrec ... in` was unused, despite the fun's return value being
+%% relevant for the side-effect of the expression.
+'wat'/0 =
+ fun () ->
+ let <Self> = call 'erlang':'self'() in
+ do letrec 'f'/0 = fun () ->
+ do call 'maps':'put'('foo', 'bar', ~{}~)
+ 'bar'
+ in call 'erlang':'send'(Self, apply 'f'/0())
+ 'undefined'
+
+end
diff --git a/lib/compiler/test/core_SUITE_data/name_capture.core b/lib/compiler/test/core_SUITE_data/name_capture.core
new file mode 100644
index 0000000000..0969f95b72
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/name_capture.core
@@ -0,0 +1,110 @@
+module 'name_capture' ['module_info'/0,
+ 'module_info'/1,
+ 'name_capture'/0]
+ attributes ['compile' =
+ [{'inline',[{'badarg_exit',2}]}]]
+'name_capture'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <_0> =
+ catch
+ apply 'first'/1
+ ('badarg')
+ in case _0 of
+ <{'EXIT',{'badarg',_7}}> when 'true' ->
+ let <Seq> =
+ call 'lists':'seq'
+ (7, 17)
+ in case apply 'first'/1
+ ({'ok',Seq}) of
+ <_8>
+ when call 'erlang':'=:='
+ (_8,
+ Seq) ->
+ let <SomeOtherTerm> =
+ {'some','other','term'}
+ in let <_5> =
+ catch
+ apply 'first'/1
+ (SomeOtherTerm)
+ in case _5 of
+ <{'EXIT',_9}>
+ when call 'erlang':'=:='
+ (_9,
+ SomeOtherTerm) ->
+ 'ok'
+ <_6> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_6})
+ end
+ <_3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_3})
+ end
+ <_1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_1})
+ end
+ <> when 'true' ->
+ primop 'match_fail'
+ ({'function_clause'})
+ end
+'first'/1 =
+ fun (_0) ->
+ case _0 of
+ <Tab> when 'true' ->
+ let <_1> =
+ apply 'treq'/2
+ (Tab, 'first')
+ %% The _1 variable in the `let` must be renamed
+ %% to avoid a name capture problem.
+ in let <_0,_1> =
+ <_1,[Tab|[]]>
+ in case <_0,_1> of
+ <'badarg',A> when 'true' ->
+ call 'erlang':'error'
+ ('badarg', A)
+ <{'ok',Reply},_X_A> when 'true' ->
+ Reply
+ <Reply,_X_A> when 'true' ->
+ call 'erlang':'exit'
+ (Reply)
+ <_3,_2> when 'true' ->
+ primop 'match_fail'
+ ({'function_clause',_3,_2})
+ end
+ <_2> when 'true' ->
+ primop 'match_fail'
+ ({'function_clause',_2})
+ end
+'treq'/2 =
+ fun (_0,_1) ->
+ case <_0,_1> of
+ <Action,_4> when 'true' ->
+ Action
+ <_3,_2> when 'true' ->
+ primop 'match_fail'
+ ({'function_clause',_3,_2})
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('name_capture')
+ <> when 'true' ->
+ primop 'match_fail'
+ ({'function_clause'})
+ end
+'module_info'/1 =
+ fun (_0) ->
+ case _0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('name_capture', X)
+ <_1> when 'true' ->
+ primop 'match_fail'
+ ({'function_clause',_1})
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/non_variable_apply.core b/lib/compiler/test/core_SUITE_data/non_variable_apply.core
new file mode 100644
index 0000000000..d9322cc455
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/non_variable_apply.core
@@ -0,0 +1,80 @@
+module 'non_variable_apply' ['module_info'/0,
+ 'module_info'/1,
+ 'non_variable_apply'/0]
+ attributes []
+
+'non_variable_apply'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <OkFun> =
+ fun (_@c0) ->
+ %% Line 5
+ case _@c0 of
+ <'ok'> when 'true' ->
+ 'ok'
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'-non_variable_apply/0-fun-0-',1}}] )
+ -| ['compiler_generated'] )
+ end
+ in let <F> =
+ fun (_@c5,_@c4) ->
+ %% Line 6
+ case <_@c5,_@c4> of
+ <F,X> when 'true' ->
+ apply apply 'id'/1 (F) (X)
+ ( <_@c7,_@c6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c7,_@c6})
+ -| [{'function_name',{'-non_variable_apply/0-fun-1-',2}}] )
+ -| ['compiler_generated'] )
+ end
+ in %% Line 9
+ apply F
+ (OkFun, 'ok')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'non_variable_apply',0}}] )
+ -| ['compiler_generated'] )
+ end
+'id'/1 =
+ %% Line 11
+ fun (_@c0) ->
+ case _@c0 of
+ <I> when 'true' ->
+ I
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'id',1}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('non_variable_apply')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'module_info',0}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/1 =
+ fun (_@c0) ->
+ case _@c0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('non_variable_apply', X)
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'module_info',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl
new file mode 100644
index 0000000000..737b1567d4
--- /dev/null
+++ b/lib/compiler/test/core_alias_SUITE.erl
@@ -0,0 +1,195 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(core_alias_SUITE).
+
+-export([all/0, suite/0, groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ tuples/1, cons/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [tuples, cons]}].
+
+init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+id(X) -> X.
+
+tuples(Config) when is_list(Config) ->
+ Tuple = {ok,id(value)},
+
+ true = erts_debug:same(Tuple, simple_tuple(Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})),
+ true = erts_debug:same(Tuple, simple_tuple_case_repeated(Tuple, Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)),
+
+ {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple),
+ true = erts_debug:same(Tuple, Tuple1),
+ true = erts_debug:same(Tuple, Tuple2),
+
+ Nested = {nested,Tuple},
+ true = erts_debug:same(Tuple, nested_tuple_part(Nested)),
+ true = erts_debug:same(Nested, nested_tuple_whole(Nested)),
+ true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)),
+
+ true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)),
+
+ Tuple = unaliased_tuple_rebinding_before(Tuple),
+ false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)),
+ Nested = unaliased_literal_tuple_head(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)),
+ Nested = unaliased_literal_tuple_body(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)),
+ Nested = unaliased_different_var_tuple(Nested, Tuple),
+ false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)).
+
+simple_tuple({ok,X}) ->
+ {ok,X}.
+simple_tuple_twice_head({ok,X}, {ok,X}) ->
+ {ok,X}.
+simple_tuple_twice_body({ok,X}) ->
+ {{ok,X},{ok,X}}.
+simple_tuple_in_map(#{hello := {ok,X}}) ->
+ {ok,X}.
+simple_tuple_fun_repeated({ok,X}, Y) ->
+ io:format("~p~n", [X]),
+ (fun({ok,X}) -> {ok,X} end)(Y).
+simple_tuple_case_repeated({ok,X}, Y) ->
+ io:format("~p~n", [X]),
+ case Y of {ok,X} -> {ok,X} end.
+
+nested_tuple_part({nested,{ok,X}}) ->
+ {ok,X}.
+nested_tuple_whole({nested,{ok,X}}) ->
+ {nested,{ok,X}}.
+nested_tuple_with_alias({nested,{ok,_}=Y}) ->
+ {nested,Y}.
+
+tuple_rebinding_after(Y) ->
+ (fun(X) -> {ok,X} end)(Y),
+ case Y of {ok,X} -> {ok,X} end.
+unaliased_tuple_rebinding_before({ok,X}) ->
+ io:format("~p~n", [X]),
+ (fun(X) -> {ok,X} end)(value).
+unaliased_literal_tuple_head({nested,{ok,value}=X}) ->
+ io:format("~p~n", [X]),
+ {nested,{ok,value}}.
+unaliased_literal_tuple_body({nested,{ok,value}=X}) ->
+ Res = {nested,Y={ok,value}},
+ io:format("~p~n", [[X,Y]]),
+ Res.
+unaliased_different_var_tuple({nested,{ok,value}=X}, Y) ->
+ io:format("~p~n", [X]),
+ {nested,Y}.
+
+cons(Config) when is_list(Config) ->
+ Cons = [ok|id(value)],
+
+ true = erts_debug:same(Cons, simple_cons(Cons)),
+ true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})),
+ true = erts_debug:same(Cons, simple_cons_case_repeated(Cons, Cons)),
+ true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)),
+ true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)),
+
+ {Cons1,Cons2} = simple_cons_twice_body(Cons),
+ true = erts_debug:same(Cons, Cons1),
+ true = erts_debug:same(Cons, Cons2),
+
+ Nested = [nested,Cons],
+ true = erts_debug:same(Cons, nested_cons_part(Nested)),
+ true = erts_debug:same(Nested, nested_cons_whole(Nested)),
+ true = erts_debug:same(Nested, nested_cons_with_alias(Nested)),
+ true = erts_debug:same(Cons, cons_rebinding_after(Cons)),
+
+ Unstripped = id([a,b]),
+ Stripped = cons_with_binary([<<>>|Unstripped]),
+ true = erts_debug:same(Unstripped, Stripped),
+
+ Cons = unaliased_cons_rebinding_before(Cons),
+ false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)),
+ Nested = unaliased_literal_cons_head(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)),
+ Nested = unaliased_literal_cons_body(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)),
+ Nested = unaliased_different_var_cons(Nested, Cons),
+ false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)).
+
+simple_cons([ok|X]) ->
+ [ok|X].
+simple_cons_twice_head([ok|X], [ok|X]) ->
+ [ok|X].
+simple_cons_twice_body([ok|X]) ->
+ {[ok|X],[ok|X]}.
+simple_cons_in_map(#{hello := [ok|X]}) ->
+ [ok|X].
+simple_cons_fun_repeated([ok|X], Y) ->
+ io:format("~p~n", [X]),
+ (fun([ok|X]) -> [ok|X] end)(Y).
+simple_cons_case_repeated([ok|X], Y) ->
+ io:format("~p~n", [X]),
+ case Y of [ok|X] -> [ok|X] end.
+
+nested_cons_part([nested,[ok|X]]) ->
+ [ok|X].
+nested_cons_whole([nested,[ok|X]]) ->
+ [nested,[ok|X]].
+nested_cons_with_alias([nested,[ok|_]=Y]) ->
+ [nested,Y].
+
+cons_with_binary([<<>>,X|Y]) ->
+ cons_with_binary([X|Y]);
+cons_with_binary(A) ->
+ A.
+
+cons_rebinding_after(Y) ->
+ (fun(X) -> [ok|X] end)(Y),
+ case Y of [ok|X] -> [ok|X] end.
+unaliased_cons_rebinding_before([ok|X]) ->
+ io:format("~p~n", [X]),
+ (fun(X) -> [ok|X] end)(value).
+unaliased_literal_cons_head([nested,[ok|value]=X]) ->
+ io:format("~p~n", [X]),
+ [nested,[ok|value]].
+unaliased_literal_cons_body([nested,[ok|value]=X]) ->
+ Res = [nested,Y=[ok|value]],
+ io:format("~p~n", [[X, Y]]),
+ Res.
+unaliased_different_var_cons([nested,[ok|value]=X], Y) ->
+ io:format("~p~n", [X]),
+ [nested,Y].
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index ced0e39d06..47606014c3 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,7 +26,9 @@
unused_multiple_values_error/1,unused_multiple_values/1,
multiple_aliases/1,redundant_boolean_clauses/1,
mixed_matching_clauses/1,unnecessary_building/1,
- no_no_file/1,configuration/1]).
+ no_no_file/1,configuration/1,supplies/1,
+ redundant_stack_frame/1,export_from_case/1,
+ empty_values/1,cover_letrec_effect/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -35,7 +37,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -45,10 +46,13 @@ groups() ->
unused_multiple_values_error,unused_multiple_values,
multiple_aliases,redundant_boolean_clauses,
mixed_matching_clauses,unnecessary_building,
- no_no_file,configuration]}].
+ no_no_file,configuration,supplies,
+ redundant_stack_frame,export_from_case,
+ empty_values,cover_letrec_effect]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -511,4 +515,108 @@ configuration() ->
art() ->
creating.
+%% core_lint would complain after optimization. A call to error/1
+%% must not occur unconditionally in a guard.
+supplies(_Config) ->
+ case ?MODULE of
+ core_fold_inline_SUITE ->
+ %% Other error behaviour when inlined.
+ ok;
+ _ ->
+ {'EXIT',{function_clause,_}} = (catch do_supplies(#{1 => <<1,2,3>>})),
+ {'EXIT',{function_clause,_}} = (catch do_supplies(#{1 => a})),
+ {'EXIT',{function_clause,_}} = (catch do_supplies(42)),
+ ok
+ end.
+
+do_supplies(#{1 := Value}) when byte_size(Value), byte_size(kg) -> working.
+
+redundant_stack_frame(_Config) ->
+ {1,2} = do_redundant_stack_frame(#{x=>1,y=>2}),
+ {'EXIT',{{badkey,_,x},_}} = (catch do_redundant_stack_frame(#{y=>2})),
+ {'EXIT',{{badkey,_,y},_}} = (catch do_redundant_stack_frame(#{x=>1})),
+ ok.
+
+do_redundant_stack_frame(Map) ->
+ %% There should not be a stack frame for this function.
+ X = case Map of
+ #{x := X0} ->
+ X0;
+ #{} ->
+ erlang:error({badkey, Map, x})
+ end,
+ Y = case Map of
+ #{y := Y0} ->
+ Y0;
+ #{} ->
+ erlang:error({badkey, Map, y})
+ end,
+ {X, Y}.
+
+%% Cover some clauses in sys_core_fold:remove_first_value/2.
+
+-record(export_from_case, {val}).
+
+export_from_case(_Config) ->
+ a = export_from_case_1(true),
+ b = export_from_case_1(false),
+
+ R = #export_from_case{val=0},
+ {ok,R} = export_from_case_2(false, R),
+ {ok,#export_from_case{val=42}} = export_from_case_2(true, R),
+
+ ok.
+
+export_from_case_1(Bool) ->
+ case Bool of
+ true ->
+ id(42),
+ Result = a;
+ false ->
+ Result = b
+ end,
+ id(Result).
+
+export_from_case_2(Bool, Rec) ->
+ case Bool of
+ false ->
+ Result = Rec;
+ true ->
+ Result = Rec#export_from_case{val=42}
+ end,
+ {ok,Result}.
+
+empty_values(_Config) ->
+ case ?MODULE of
+ core_fold_inline_SUITE ->
+ {'EXIT',_} = (catch do_empty_values());
+ _ ->
+ {'EXIT',{function_clause,_}} = (catch do_empty_values())
+ end,
+ ok.
+
+do_empty_values() when (#{})#{} ->
+ c.
+
+cover_letrec_effect(_Config) ->
+ self() ! {tag,42},
+ _ = try
+ try
+ ignore
+ after
+ receive
+ {tag,Int}=Term ->
+ Res = #{k => {Term,<<Int:16>>}},
+ self() ! Res
+ end
+ end
+ after
+ ok
+ end,
+ receive
+ Any ->
+ #{k := {{tag,42},<<42:16>>}} = Any
+ end,
+ ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index 01c779b181..8b9dbe4aa0 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -31,7 +31,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -40,6 +39,7 @@ groups() ->
transforms,maps_warnings,bad_utf8]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl
index f6095947ca..012810aba2 100644
--- a/lib/compiler/test/float_SUITE.erl
+++ b/lib/compiler/test/float_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -27,7 +27,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[pending, bif_calls, math_functions,
mixed_float_and_int].
@@ -35,6 +34,7 @@ groups() ->
[].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -150,6 +150,18 @@ math_functions(Config) when is_list(Config) ->
?OPTIONAL(0.0, math:erf(id(0))),
?OPTIONAL(1.0, math:erfc(id(0))),
+ 5.0 = math:floor(5.6),
+ 6.0 = math:ceil(5.6),
+ 5.0 = math:floor(id(5.4)),
+ 6.0 = math:ceil(id(5.4)),
+
+ 0.0 = math:fmod(42, 42),
+ 0.25 = math:fmod(1, 0.75),
+ -1.0 = math:fmod(-4.0, 1.5),
+ -0.375 = math:fmod(-3.0, -0.875),
+ 0.125 = math:fmod(8.125, -4),
+ {'EXIT',{badarith,_}} = (catch math:fmod(5.0, 0.0)),
+
%% Only for coverage (of beam_type.erl).
{'EXIT',{undef,_}} = (catch math:fnurfla(0)),
{'EXIT',{undef,_}} = (catch math:fnurfla(0, 0)),
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index 16474adf5b..e00885fcd6 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -32,7 +32,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -41,6 +40,7 @@ groups() ->
eep37_dup,badarity,badfun]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -194,6 +194,17 @@ external(Config) when is_list(Config) ->
?APPLY2(ListsMod, ListsMap, 2),
?APPLY2(ListsMod, ListsMap, ListsArity),
+ 42 = (fun erlang:abs/1)(-42),
+ 42 = (id(fun erlang:abs/1))(-42),
+ 42 = apply(fun erlang:abs/1, [-42]),
+ 42 = apply(id(fun erlang:abs/1), [-42]),
+ 6 = (fun lists:sum/1)([1,2,3]),
+ 6 = (id(fun lists:sum/1))([1,2,3]),
+
+ {'EXIT',{{badarity,_},_}} = (catch (fun lists:sum/1)(1, 2, 3)),
+ {'EXIT',{{badarity,_},_}} = (catch (id(fun lists:sum/1))(1, 2, 3)),
+ {'EXIT',{{badarity,_},_}} = (catch apply(fun lists:sum/1, [1,2,3])),
+
ok.
call_me(I) ->
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 429d6b79e0..6ad73b46f7 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -35,12 +35,12 @@
basic_andalso_orelse/1,traverse_dcd/1,
check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
bad_constants/1,bad_guards/1,
- guard_in_catch/1]).
+ guard_in_catch/1,beam_bool_SUITE/1,
+ cover_beam_dead/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -54,9 +54,11 @@ groups() ->
rel_ops,rel_op_combinations,
literal_type_tests,basic_andalso_orelse,traverse_dcd,
check_qlc_hrl,andalso_semi,t_tuple_size,binary_part,
- bad_constants,bad_guards,guard_in_catch]}].
+ bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE,
+ cover_beam_dead]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -88,8 +90,31 @@ misc(Config) when is_list(Config) ->
{ok,buf,<<>>} = get_data({o,false,0}, 0, buf),
error = get_data({o,false,0}, 42, buf),
+ relief = misc_2(0),
+ error = misc_2(1),
+ error = misc_2(true),
+
+ if
+ is_integer(Config) =/= true ->
+ ok
+ end,
+
+ true = misc_3(1, 0),
+ true = misc_3(0, 0),
+ false = misc_3(0, 2),
+
+ %% Abuse of boolean values.
+
+ Zero = id(0),
+ One = id(1),
+ ok = if (Zero == 0) > false -> ok end,
+ ok = if (Zero == 0) =:= (One == 1) -> ok end,
+ ok = if (Zero == 0) =:= (One == 1) -> ok end,
+ ok = if is_atom(Zero > One) -> ok end,
+ error = if abs(Zero > One) -> ok; true -> error end,
+ ok = if is_integer(Zero) >= is_integer(One) -> ok end,
+
ok.
-
misc_1([{W},{X},{Y},{Z}]) ->
if
@@ -99,6 +124,17 @@ misc_1([{W},{X},{Y},{Z}]) ->
none
end.
+misc_2(0) -> relief;
+misc_2(Adapter = 1) when Adapter -> franklin;
+misc_2(_) -> error.
+
+misc_3(LenUp, LenDw) ->
+ if
+ %% Cover handling of #k_alt{}.
+ LenUp >= 1 orelse ((LenDw >= 2) xor true) -> true;
+ true -> false
+ end.
+
get_data({o,Active,Raw}, BytesToRead, Buffer)
when Raw =:= raw; Raw =:= 0 ->
if
@@ -164,6 +200,12 @@ basic_not(Config) when is_list(Config) ->
check(fun() -> if not glurf -> ok; true -> error end end, error),
check(fun() -> if not Glurf -> ok; true -> error end end, error),
+ check(fun() -> if not (not true) -> broken end end, broken),
+
+ check(fun() -> if not (True xor True) -> ok end end, ok),
+ check(fun() -> if not (True xor False) -> ok;
+ true -> error end end, error),
+
ok.
complex_not(Config) when is_list(Config) ->
@@ -188,8 +230,60 @@ complex_not(Config) when is_list(Config) ->
check(fun() -> if not(element(1, ATuple) orelse element(3, ATuple)) -> ok;
true -> error end end, error),
+ %% complex_not_1/4
+ ok = complex_not_1(1, 1, 1, a),
+ error = complex_not_1(1, 1, 1, []),
+ error = complex_not_1(1, 1, 3, a),
+ error = complex_not_1(1, 1, 3, []),
+ error = complex_not_1(1, 2, 1, a),
+ error = complex_not_1(1, 2, 1, []),
+ error = complex_not_1(1, 2, 3, a),
+ error = complex_not_1(1, 2, 3, []),
+
+ %% complex_not_2/4
+ ok = complex_not_2(1, 2, 0, x),
+ error = complex_not_2(1, 2, 0, []),
+ error = complex_not_2(1, 2, 3, x),
+ error = complex_not_2(1, 2, 3, []),
+ error = complex_not_2(1, 1, 0, x),
+ error = complex_not_2(1, 1, 0, []),
+ error = complex_not_2(1, 1, 3, x),
+ error = complex_not_2(1, 1, 3, []),
+
ok.
+complex_not_1(A, B, C, D) ->
+ Res = complex_not_1a(A, B, C, D),
+ Res = complex_not_1b(A, B, C, D).
+
+complex_not_1a(A, B, C, D)
+ when (not (A < B)) andalso (not (B < C)) andalso (not is_list(D)) ->
+ ok;
+complex_not_1a(_, _, _, _) ->
+ error.
+
+complex_not_1b(A, B, C, D)
+ when (not (A < B)) and (not (B < C)) and (not is_list(D)) ->
+ ok;
+complex_not_1b(_, _, _, _) ->
+ error.
+
+complex_not_2(A, B, C, D) ->
+ Res = complex_not_2a(A, B, C, D),
+ Res = complex_not_2b(A, B, C, D).
+
+complex_not_2a(A, B, C, D)
+ when A < B andalso not (B < C) andalso not is_list(D) ->
+ ok;
+complex_not_2a(_, _, _, _) ->
+ error.
+
+complex_not_2b(A, B, C, D)
+ when A < B, not (B < C), not is_list(D) ->
+ ok;
+complex_not_2b(_, _, _, _) ->
+ error.
+
nested_nots(Config) when is_list(Config) ->
true = nested_not_1(0, 0),
true = nested_not_1(0, 1),
@@ -210,19 +304,36 @@ nested_nots(Config) when is_list(Config) ->
false = nested_not_2(true, true, atom),
ok.
-nested_not_1(X, Y) when not (((X>Y) or not(is_atom(X))) and
+nested_not_1(X, Y) ->
+ Res = nested_not_1a(X, Y),
+ Res = nested_not_1b(X, Y).
+
+nested_not_1a(X, Y) when not (((X>Y) or not(is_atom(X))) and
(is_atom(Y) or (X==3.4))) ->
true;
-nested_not_1(_, _) ->
+nested_not_1a(_, _) ->
+ false.
+
+nested_not_1b(X, Y) when not (((X>Y) orelse not(is_atom(X))) andalso
+ (is_atom(Y) orelse (X==3.4))) ->
+ true;
+nested_not_1b(_, _) ->
false.
nested_not_2(X, Y, Z) ->
- nested_not_2(X, Y, Z, true).
+ Res = nested_not_2a(X, Y, Z, true),
+ Res = nested_not_2b(X, Y, Z, true).
-nested_not_2(X, Y, Z, True)
+nested_not_2a(X, Y, Z, True)
when not(True and not((not(X) and not(Y)) or not(is_atom(Z)))) ->
true;
-nested_not_2(_, _, _, _) ->
+nested_not_2a(_, _, _, _) ->
+ false.
+
+nested_not_2b(X, Y, Z, True)
+ when not(True andalso not((not(X) andalso not(Y)) orelse not(is_atom(Z)))) ->
+ true;
+nested_not_2b(_, _, _, _) ->
false.
semicolon(Config) when is_list(Config) ->
@@ -1094,6 +1205,13 @@ tricky(Config) when is_list(Config) ->
false = rb(100000, [1], 42),
true = rb(100000, [], 42),
true = rb(555, [a,b,c], 19),
+
+ error = tricky_3(42),
+ error = tricky_3(42.0),
+ error = tricky_3(<<>>),
+ error = tricky_3(#{}),
+ error = tricky_3({a,b}),
+
ok.
tricky_1(X, Y) when abs((X == 1) or (Y == 2)) -> ok;
@@ -1102,6 +1220,15 @@ tricky_1(_, _) -> not_ok.
tricky_2(X) when float(X) or float(X) -> ok;
tricky_2(_) -> error.
+tricky_3(X)
+ when abs(X) or bit_size(X) or byte_size(X) or ceil(X) or
+ float(X) or floor(X) or length(X) or
+ map_size(X) or node() or node(X) or round(X) or
+ self() or size(X) or tl(X) or trunc(X) or tuple_size(X) ->
+ ok;
+tricky_3(_) ->
+ error.
+
%% From dets_v9:read_buckets/11, simplified.
rb(Size, ToRead, SoFar) when SoFar + Size < 81920; ToRead == [] -> true;
@@ -1166,6 +1293,10 @@ rel_ops(Config) when is_list(Config) ->
true = any_atom /= id(42),
true = [] /= id(42),
+ %% Coverage of beam_utils:bif_to_test/3
+ Empty = id([]),
+ ?T(==, [], Empty),
+
ok.
-undef(TestOp).
@@ -1413,7 +1544,7 @@ literal_type_tests_1(Config) ->
Func = {function, Anno, test, 0, [{clause,Anno,[],[],Tests}]},
Form = [{attribute,Anno,module,Mod},
{attribute,Anno,compile,export_all},
- Func, {eof,Anno}],
+ Func, {eof,999}],
%% Print generated code for inspection.
lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form),
@@ -1490,7 +1621,9 @@ type_tests() ->
is_reference,
is_port,
is_binary,
- is_function].
+ is_bitstring,
+ is_function,
+ is_map].
basic_andalso_orelse(Config) when is_list(Config) ->
T = id({type,integers,23,42}),
@@ -1925,6 +2058,179 @@ do_guard_in_catch_bin(From) ->
saint
end.
+%%%
+%%% The beam_bool pass has been eliminated. Here are the tests from
+%%% beam_bool_SUITE.
+%%%
+
+beam_bool_SUITE(_Config) ->
+ before_and_inside_if(),
+ scotland(),
+ y_registers(),
+ protected(),
+ maps(),
+ ok.
+
+before_and_inside_if() ->
+ no = before_and_inside_if([a], [b], delete),
+ no = before_and_inside_if([a], [b], x),
+ no = before_and_inside_if([a], [], delete),
+ no = before_and_inside_if([a], [], x),
+ no = before_and_inside_if([], [], delete),
+ yes = before_and_inside_if([], [], x),
+ yes = before_and_inside_if([], [b], delete),
+ yes = before_and_inside_if([], [b], x),
+
+ {ch1,ch2} = before_and_inside_if_2([a], [b], blah),
+ {ch1,ch2} = before_and_inside_if_2([a], [b], xx),
+ {ch1,ch2} = before_and_inside_if_2([a], [], blah),
+ {ch1,ch2} = before_and_inside_if_2([a], [], xx),
+ {no,no} = before_and_inside_if_2([], [b], blah),
+ {no,no} = before_and_inside_if_2([], [b], xx),
+ {ch1,no} = before_and_inside_if_2([], [], blah),
+ {no,ch2} = before_and_inside_if_2([], [], xx),
+ ok.
+
+%% Thanks to Simon Cornish and Kostis Sagonas.
+%% Used to crash beam_bool.
+before_and_inside_if(XDo1, XDo2, Do3) ->
+ Do1 = (XDo1 =/= []),
+ Do2 = (XDo2 =/= []),
+ if
+ %% This expression occurs in a try/catch (protected)
+ %% block, which cannot refer to variables outside of
+ %% the block that are boolean expressions.
+ Do1 =:= true;
+ Do1 =:= false, Do2 =:= false, Do3 =:= delete ->
+ no;
+ true ->
+ yes
+ end.
+
+%% Thanks to Simon Cornish.
+%% Used to generate code that would not set {y,0} on
+%% all paths before its use (and therefore fail
+%% validation by the beam_validator).
+before_and_inside_if_2(XDo1, XDo2, Do3) ->
+ Do1 = (XDo1 =/= []),
+ Do2 = (XDo2 =/= []),
+ CH1 = if Do1 == true;
+ Do1 == false,Do2==false,Do3 == blah ->
+ ch1;
+ true ->
+ no
+ end,
+ CH2 = if Do1 == true;
+ Do1 == false,Do2==false,Do3 == xx ->
+ ch2;
+ true ->
+ no
+ end,
+ {CH1,CH2}.
+
+
+%% beam_bool would remove the initialization of {y,0}.
+%% (Thanks to Thomas Arts and QuickCheck.)
+
+scotland() ->
+ million = do_scotland(placed),
+ {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)),
+ {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)),
+ {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)),
+ ok.
+
+do_scotland(Echo) ->
+ found(case Echo of
+ Echo when true; Echo, Echo, Echo ->
+ Echo;
+ echo ->
+ []
+ end,
+ Echo = placed).
+
+found(_, _) -> million.
+
+
+%% ERL-143: beam_bool could not handle Y registers as a destination.
+y_registers() ->
+ {'EXIT',{badarith,[_|_]}} = (catch baker(valentine)),
+ {'EXIT',{badarith,[_|_]}} = (catch baker(clementine)),
+
+ {not_ok,true} = potter([]),
+ {ok,false} = potter([{encoding,any}]),
+
+ ok.
+
+%% Thanks to Quickcheck.
+baker(Baker) ->
+ (valentine == Baker) +
+ case Baker of
+ Baker when Baker; Baker ->
+ Baker;
+ Baker ->
+ []
+ end.
+
+%% Thanks to Jose Valim.
+potter(Modes) ->
+ Raw = lists:keyfind(encoding, 1, Modes) == false,
+ Final = case Raw of
+ X when X == false; X == nil -> ok;
+ _ -> not_ok
+ end,
+ {Final,Raw}.
+
+protected() ->
+ {'EXIT',{if_clause,_}} = (catch photographs({1, surprise, true}, opinions)),
+
+ {{true}} = welcome({perfect, true}),
+ {'EXIT',{if_clause,_}} = (catch welcome({perfect, false})),
+ ok.
+
+photographs({_Violation, surprise, Deep}, opinions) ->
+ {if
+ 0; "here", Deep ->
+ Deep = Deep
+ end}.
+
+welcome({perfect, Profit}) ->
+ if
+ Profit, Profit, Profit; 0 ->
+ {id({Profit})}
+ end.
+
+maps() ->
+ ok = evidence(#{0 => 42}).
+
+%% Cover handling of put_map in in split_block_label_used/2.
+evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} ->
+ ok.
+
+cover_beam_dead(_Config) ->
+ Mod = ?FUNCTION_NAME,
+ Attr = [],
+ Fs = [{function,test,1,2,
+ [{label,1},
+ {line,[]},
+ {func_info,{atom,Mod},{atom,test},1},
+ {label,2},
+ %% Cover beam_dead:turn_op/1 using swapped operand order.
+ {test,is_ne_exact,{f,3},[{integer,1},{x,0}]},
+ {test,is_eq_exact,{f,1},[{atom,a},{x,0}]},
+ {label,3},
+ {move,{atom,ok},{x,0}},
+ return]}],
+ Exp = [{test,1}],
+ Asm = {Mod,Exp,Attr,Fs,3},
+ {ok,Mod,Beam} = compile:forms(Asm, [from_asm,binary,report]),
+ {module,Mod} = code:load_binary(Mod, Mod, Beam),
+ ok = Mod:test(1),
+ ok = Mod:test(a),
+ {'EXIT',_} = (catch Mod:test(other)),
+ true = code:delete(Mod),
+ _ = code:purge(Mod),
+
+ ok.
%% Call this function to turn off constant propagation.
id(I) -> I.
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index ae59cc8026..dcc703c3e1 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -32,7 +32,6 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -42,6 +41,7 @@ groups() ->
coverage]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Pa = "-pa " ++ filename:dirname(code:which(?MODULE)),
{ok,Node} = start_node(compiler, Pa),
[{testing_node,Node}|Config].
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index adb96fb87d..c80b7cc59e 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -33,7 +33,6 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -48,6 +47,7 @@ groups() ->
]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -107,6 +107,31 @@ basic(Config) when is_list(Config) ->
[] = [X || X <- L1, X+1 < 2],
{'EXIT',_} = (catch [X || X <- L1, odd(X)]),
fc([x], catch [E || E <- id(x)]),
+
+ %% Make sure that line numbers point out the generator.
+ case ?MODULE of
+ lc_inline_SUITE ->
+ ok;
+ _ ->
+ {'EXIT',{function_clause,
+ [{?MODULE,_,_,
+ [{file,"bad_lc.erl"},{line,4}]}|_]}} =
+ (catch bad_generator(a)),
+ {'EXIT',{function_clause,
+ [{?MODULE,_,_,
+ [{file,"bad_lc.erl"},{line,4}]}|_]}} =
+ (catch bad_generator([a|b])),
+ {'EXIT',{badarg,
+ [{erlang,length,_,_},
+ {?MODULE,bad_generator_bc,1,
+ [{file,"bad_lc.erl"},{line,7}]}|_]}} =
+ (catch bad_generator_bc(a)),
+ {'EXIT',{badarg,
+ [{erlang,length,_,_},
+ {?MODULE,bad_generator_bc,1,
+ [{file,"bad_lc.erl"},{line,7}]}|_]}} =
+ (catch bad_generator_bc([a|b]))
+ end,
ok.
tuple_list() ->
@@ -227,7 +252,7 @@ effect(Config) when is_list(Config) ->
lc_SUITE ->
_ = [{'EXIT',{badarg,_}} =
(catch binary_to_atom(<<C/utf8>>, utf8)) ||
- C <- lists:seq(16#10000, 16#FFFFF)];
+ C <- lists:seq(16#FF10000, 16#FFFFFFF)];
_ ->
ok
end,
@@ -249,3 +274,11 @@ fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}})
fc(Args, {'EXIT',{{case_clause,ActualArgs},_}})
when ?MODULE =:= lc_inline_SUITE ->
Args = tuple_to_list(ActualArgs).
+
+-file("bad_lc.erl", 1).
+bad_generator(List) -> %Line 2
+ [I || %Line 3
+ I <- List]. %Line 4
+bad_generator_bc(List) -> %Line 5
+ << <<I:4>> || %Line 6
+ I <- List>>. %Line 7
diff --git a/lib/compiler/test/lfe-core.patch b/lib/compiler/test/lfe-core.patch
new file mode 100644
index 0000000000..756d131e2c
--- /dev/null
+++ b/lib/compiler/test/lfe-core.patch
@@ -0,0 +1,97 @@
+Date: Sun, 13 Nov 2016 10:11:11 +0100
+Subject: [PATCH] Fix invalid variable names
+
+---
+ test/lfe_andor_SUITE.core | 16 ++++++++--------
+ test/lfe_guard_SUITE.core | 14 +++++++-------
+ 2 files changed, 15 insertions(+), 15 deletions(-)
+
+diff --git a/test/lfe_andor_SUITE.core b/test/lfe_andor_SUITE.core
+index 96ff765..df58b39 100644
+--- a/test/lfe_andor_SUITE.core
++++ b/test/lfe_andor_SUITE.core
+@@ -288,19 +288,19 @@ module 'lfe_andor_SUITE' ['$handle_undefined_function'/2,
+ 'lc$^0'/1 =
+ fun (_2) ->
+ case <_2> of
+- <[_x|_|-0-|]> when 'true' ->
++ <[_x|_lfe0]> when 'true' ->
+ letrec
+ 'lc$^1'/1 =
+ fun (_3) ->
+ case <_3> of
+- <[_y|_|-1-|]> when 'true' ->
++ <[_y|_lfe1]> when 'true' ->
+ let <_4> =
+ apply 'lc$^1'/1
+- (_|-1-|)
++ (_lfe1)
+ in [{_x,_y}|_4]
+ <[]> when 'true' ->
+ apply 'lc$^0'/1
+- (_|-0-|)
++ (_lfe0)
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+@@ -455,19 +455,19 @@ module 'lfe_andor_SUITE' ['$handle_undefined_function'/2,
+ 'lc$^2'/1 =
+ fun (_2) ->
+ case <_2> of
+- <[_x|_|-2-|]> when 'true' ->
++ <[_x|_lfe2]> when 'true' ->
+ letrec
+ 'lc$^3'/1 =
+ fun (_3) ->
+ case <_3> of
+- <[_y|_|-3-|]> when 'true' ->
++ <[_y|_lfe3]> when 'true' ->
+ let <_4> =
+ apply 'lc$^3'/1
+- (_|-3-|)
++ (_lfe3)
+ in [{_x,_y}|_4]
+ <[]> when 'true' ->
+ apply 'lc$^2'/1
+- (_|-2-|)
++ (_lfe2)
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+diff --git a/test/lfe_guard_SUITE.core b/test/lfe_guard_SUITE.core
+index 38f1d99..920be82 100644
+--- a/test/lfe_guard_SUITE.core
++++ b/test/lfe_guard_SUITE.core
+@@ -2857,22 +2857,22 @@ module 'lfe_guard_SUITE' ['$handle_undefined_function'/2,
+ 'false' ->
+ case <_t> of
+ <{_a,_b,_c,_d}> when 'true' ->
+- let <_|-0-|> =
++ let <_lfe0> =
+ <_a>
+- in let <_|-1-|> =
++ in let <_lfe1> =
+ <_b>
+- in let <_|-2-|> =
++ in let <_lfe2> =
+ <_c>
+- in let <_|-3-|> =
++ in let <_lfe3> =
+ <_d>
+ in let <_4> =
+ let <_3> =
+ call 'erlang':'+'
+- (_|-0-|, _|-1-|)
++ (_lfe0, _lfe1)
+ in call 'erlang':'+'
+- (_3, _|-2-|)
++ (_3, _lfe2)
+ in call 'erlang':'+'
+- (_4, _|-3-|)
++ (_4, _lfe3)
+ ( <_5> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_5}})
+--
+2.7.4 (Apple Git-66)
+
diff --git a/lib/compiler/test/lfe-source.patch b/lib/compiler/test/lfe-source.patch
new file mode 100644
index 0000000000..cbd6748bc9
--- /dev/null
+++ b/lib/compiler/test/lfe-source.patch
@@ -0,0 +1,117 @@
+Date: Sun, 13 Nov 2016 09:40:36 +0100
+Subject: [PATCH] Rename and fix up LFE test suites
+
+---
+ test/{andor_SUITE.lfe => lfe_andor_SUITE.lfe} | 16 ++++++++--------
+ test/{guard_SUITE.lfe => lfe_guard_SUITE.lfe} | 8 ++++----
+ 2 files changed, 12 insertions(+), 12 deletions(-)
+ rename test/{andor_SUITE.lfe => lfe_andor_SUITE.lfe} (97%)
+ rename test/{guard_SUITE.lfe => lfe_guard_SUITE.lfe} (99%)
+
+diff --git a/test/andor_SUITE.lfe b/test/lfe_andor_SUITE.lfe
+similarity index 97%
+rename from test/andor_SUITE.lfe
+rename to test/lfe_andor_SUITE.lfe
+index 64feddd..1802b3f 100644
+--- a/test/andor_SUITE.lfe
++++ b/test/lfe_andor_SUITE.lfe
+@@ -26,14 +26,14 @@
+
+ (include-file "test_server.lfe")
+
+-(defmodule andor_SUITE
++(defmodule lfe_andor_SUITE
+ (export (all 0) (suite 0) (groups 0) (init_per_suite 1) (end_per_suite 1)
+ (init_per_group 2) (end_per_group 2)
+ (t_case 1) (t_and_or 1) (t_andalso 1) (t_orelse 1) (inside 1)
+ (overlap 1) (combined 1) (in_case 1) (before_and_inside_if 1)
+ ))
+
+-(defmacro MODULE () `'andor_SUITE)
++(defmacro MODULE () `'lfe_andor_SUITE)
+
+ (defun all ()
+ ;; (: test_lib recompile (MODULE))
+@@ -206,7 +206,7 @@
+
+ (defun t-andalso-1
+ ([(tuple x y)]
+- (: lfe_io format '"(andalso ~w ~w): " (list x y))
++ (: io format '"(andalso ~w ~w): " (list x y))
+ (let* ((v0 (andalso (echo x) (echo y)))
+ (v1 (when (=:= v0 v1))
+ (eif (andalso x y) 'true 'true 'false)))
+@@ -248,7 +248,7 @@
+
+ (defun t-orelse-1
+ ([(tuple x y)]
+- (: lfe_io format '"(orelse ~w ~w): " (list x y))
++ (: io format '"(orelse ~w ~w): " (list x y))
+ (let* ((v0 (orelse (echo x) (echo y)))
+ (v1 (when (=:= v0 v1))
+ (eif (orelse x y) 'true 'true 'false)))
+@@ -289,7 +289,7 @@
+ (when (=:= r1 r2) (=:= xm xm2) (=:= ym ym2) (=:= x x2)
+ (=:= y y2) (=:= w w2) (=:= h h2))
+ (inside-guard xm ym x y w h)))
+- (: lfe_io fwrite
++ (: io fwrite
+ '"(andalso (=< ~p ~p) (< ~p ~p) (=< ~p ~p) (< ~p ~p)) ==> ~p\n"
+ (list x xm xm (+ x w) y ym ym (+ y h) r1)))
+ r1))
+@@ -499,12 +499,12 @@
+ ;; Utilities
+
+ (defun check (v1 v0)
+- (eif (/= v1 v0) (progn (: lfe_io fwrite '"error: ~w.\n" (list v1))
++ (eif (/= v1 v0) (progn (: io fwrite '"error: ~w.\n" (list v1))
+ (exit 'suite_failed))
+- 'true (: lfe_io fwrite '"ok: ~w.\n" (list v1))))
++ 'true (: io fwrite '"ok: ~w.\n" (list v1))))
+
+ (defun echo (x)
+- (: lfe_io fwrite '"(eval ~w); " (list x))
++ (: io fwrite '"(eval ~w); " (list x))
+ x)
+
+ ;; Call this function to turn off constant propagation.
+diff --git a/test/guard_SUITE.lfe b/test/lfe_guard_SUITE.lfe
+similarity index 99%
+rename from test/guard_SUITE.lfe
+rename to test/lfe_guard_SUITE.lfe
+index 33b1344..2eeb1a6 100644
+--- a/test/guard_SUITE.lfe
++++ b/test/lfe_guard_SUITE.lfe
+@@ -26,7 +26,7 @@
+
+ (include-file "test_server.lfe")
+
+-(defmodule guard_SUITE
++(defmodule lfe_guard_SUITE
+ (export (all 0) (suite 0) (groups 0) (init_per_suite 1) (end_per_suite 1)
+ (init_per_group 2) (end_per_group 2)
+ (misc 1) (const_cond 1) (basic_not 1) (complex_not 1) (nested_nots 1)
+@@ -42,7 +42,7 @@
+ (check_qlc_hrl 1) (andalso_semi 1) (t_tuple_size 1) (binary_part 1)
+ ))
+
+-(defmacro MODULE () `'guard_SUITE)
++(defmacro MODULE () `'lfe_guard_SUITE)
+
+ (defun all ()
+ ;; (: test_lib recompile (MODULE))
+@@ -764,9 +764,9 @@
+
+ (defun is_function_2
+ ([config] (when (is_list config))
+- (line (test-pat 'true (is_function (id (function guard_SUITE all 1)) 1)))
++ (line (test-pat 'true (is_function (id (function lfe_guard_SUITE all 1)) 1)))
+ (line (test-pat 'true (is_function (id (lambda () 'ok)) 0)))
+- (line (test-pat 'false (is_function (id (function guard_SUITE all 1)) 0)))
++ (line (test-pat 'false (is_function (id (function lfe_guard_SUITE all 1)) 0)))
+ (line (test-pat 'false (is_function (id (lambda () 'ok)) 1)))
+
+ (let ((F (lambda (_) 'ok)))
+--
+2.7.4 (Apple Git-66)
+
diff --git a/lib/compiler/test/lfe.readme b/lib/compiler/test/lfe.readme
new file mode 100644
index 0000000000..2fc88e0252
--- /dev/null
+++ b/lib/compiler/test/lfe.readme
@@ -0,0 +1,31 @@
+Creating the LFE-derived test suites
+====================================
+
+Here is how to create `lfe_andor_SUITE.core` and `lfe_guard_SUITE.core`
+files.
+
+First clone and build LFE.
+
+ git clone https://github.com/rvirding/lfe.git
+ cd lfe
+ git checkout v1.2.0
+ MAKEFLAGS='' make compile
+ export PATH=$(pwd)/bin:$PATH
+
+Apply the source patch to rename and fix up the LFE source code:
+
+ cd test
+ git apply $ERL_TOP/lib/compiler/test/lfe-source.patch
+ git reset --hard HEAD
+
+Compile the modules to Core Erlang:
+
+ lfec +to-core0 lfe*.lfe
+
+Apply the core patch to correct some invalid variable names:
+
+ git apply $ERL_TOP/lib/compiler/test/lfe-core.patch
+
+Copy the patched .core file to the test suite:
+
+ cp lfe*.core $ERL_TOP/lib/compiler/test
diff --git a/lib/compiler/test/lfe_andor_SUITE.core b/lib/compiler/test/lfe_andor_SUITE.core
new file mode 100644
index 0000000000..df58b39ae6
--- /dev/null
+++ b/lib/compiler/test/lfe_andor_SUITE.core
@@ -0,0 +1,2014 @@
+module 'lfe_andor_SUITE' ['$handle_undefined_function'/2,
+ 'LFE-EXPAND-EXPORTED-MACRO'/3,
+ 'all'/0,
+ 'before_and_inside_if'/1,
+ 'combined'/1,
+ 'end_per_group'/2,
+ 'end_per_suite'/1,
+ 'groups'/0,
+ 'in_case'/1,
+ 'init_per_group'/2,
+ 'init_per_suite'/1,
+ 'inside'/1,
+ 'module_info'/0,
+ 'module_info'/1,
+ 'overlap'/1,
+ 'suite'/0,
+ 't_and_or'/1,
+ 't_andalso'/1,
+ 't_case'/1,
+ 't_orelse'/1]
+ attributes []
+'all'/0 =
+ %% Line 38
+ fun () ->
+ ['t_case'|['t_and_or'|['t_andalso'|['t_orelse'|['inside'|['overlap'|['combined'|['in_case'|['before_and_inside_if']]]]]]]]]
+'suite'/0 =
+ %% Line 44
+ fun () ->
+ []
+'groups'/0 =
+ %% Line 46
+ fun () ->
+ []
+'init_per_suite'/1 =
+ %% Line 48
+ fun (_config) ->
+ _config
+'end_per_suite'/1 =
+ %% Line 50
+ fun (_config) ->
+ 'ok'
+'init_per_group'/2 =
+ %% Line 52
+ fun (_name,_config) ->
+ _config
+'end_per_group'/2 =
+ %% Line 54
+ fun (_name,_config) ->
+ _config
+'t_case'/1 =
+ %% Line 56
+ fun (_0) ->
+ case <_0> of
+ <'suite'> when 'true' ->
+ []
+ <'doc'> when 'true' ->
+ [84|[101|[115|[116|[32|[105|[110|[32|[99|[97|[115|[101|[46]]]]]]]]]]]]]
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['less']]|[['t-case-a'|[1|[2]]]]]]})
+ let <_val> =
+ <apply 't-case-a'/2
+ (1, 2)>
+ in case <_val> of
+ <'less'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_25> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_25})
+ -| [{'function_name',{'t_case',1}}] )
+ -| ['compiler_generated'] )
+ end
+'t-case-a'/2 =
+ %% Line 94
+ fun (_a,_b) ->
+ case call 'erlang':'<'
+ (_a, _b) of
+ <[_0|_1]> when 'true' ->
+ 'ok'
+ <'true'> when 'true' ->
+ 'less'
+ <'false'> when 'true' ->
+ 'not_less'
+ <{'a','b','c'}> when 'true' ->
+ 'ok'
+ <_2> when 'true' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'t-case-b'/2 =
+ %% Line 102
+ fun (_a,_b) ->
+ case call 'erlang':'=:='
+ (_a, _b) of
+ <'blurf'> when 'true' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'t-case-c'/2 =
+ %% Line 106
+ fun (_a,_b) ->
+ case let <_0> =
+ call 'erlang':'=:='
+ (_a, _b)
+ in call 'erlang':'not'
+ (_0) of
+ <'true'> when 'true' ->
+ 'ne'
+ <'false'> when 'true' ->
+ 'eq'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'t-case-d'/3 =
+ %% Line 111
+ fun (_a,_b,_x) ->
+ case let <_0> =
+ call 'erlang':'=:='
+ (_a, _b)
+ in call 'erlang':'and'
+ (_0, _x) of
+ <'true'> when 'true' ->
+ 't'
+ <'false'> when 'true' ->
+ 'f'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'t-case-e'/2 =
+ %% Line 116
+ fun (_a,_b) ->
+ case call 'erlang':'=:='
+ (_a, _b) of
+ <_bool>
+ when try
+ let <_0> =
+ call 'erlang':'is_tuple'
+ (_a)
+ in _0
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ apply 'id'/1
+ (_bool)
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'t-case-xy'/3 =
+ %% Line 120
+ fun (_x,_y,_z) ->
+ let <_r0> =
+ <apply 't-case-x'/3
+ (_x, _y, _z)>
+ in case <apply 't-case-y'/3
+ (_x, _y, _z)> of
+ <_res>
+ when try
+ let <_0> =
+ call 'erlang':'=:='
+ (_res, _r0)
+ in _0
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ _res
+ ( <_1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_1}})
+ -| ['compiler_generated'] )
+ end
+'t-case-x'/3 =
+ %% Line 125
+ fun (_x,_y,_z) ->
+ case let <_0> =
+ call 'erlang':'abs'
+ (_x)
+ in call 'erlang':'=:='
+ (_0, 42) of
+ <'true'> when 'true' ->
+ call 'erlang':'=:='
+ (_y, 100)
+ <'false'> when 'true' ->
+ call 'erlang':'=:='
+ (_z, 700)
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'t-case-y'/3 =
+ %% Line 130
+ fun (_x,_y,_z) ->
+ case let <_0> =
+ call 'erlang':'abs'
+ (_x)
+ in call 'erlang':'=:='
+ (_0, 42) of
+ <'false'> when 'true' ->
+ call 'erlang':'=:='
+ (_z, 700)
+ <'true'> when 'true' ->
+ call 'erlang':'=:='
+ (_y, 100)
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'t_and_or'/1 =
+ %% Line 135
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['and'|[['quote'|['true']]|[['quote'|['true']]]]]]]]})
+ let <_val> =
+ <call 'erlang':'and'
+ ('true', 'true')>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_42> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_42})
+ -| [{'function_name',{'t_and_or',1}}] )
+ -| ['compiler_generated'] )
+ end
+'t_andalso'/1 =
+ %% Line 172
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do let <_bs> =
+ <['true'|['false']]>
+ in let <_ps> =
+ <letrec
+ 'lc$^0'/1 =
+ fun (_2) ->
+ case <_2> of
+ <[_x|_lfe0]> when 'true' ->
+ letrec
+ 'lc$^1'/1 =
+ fun (_3) ->
+ case <_3> of
+ <[_y|_lfe1]> when 'true' ->
+ let <_4> =
+ apply 'lc$^1'/1
+ (_lfe1)
+ in [{_x,_y}|_4]
+ <[]> when 'true' ->
+ apply 'lc$^0'/1
+ (_lfe0)
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+ -| [{'function_name',{'t_andalso',1}}] )
+ -| ['compiler_generated'] )
+ end
+ in apply 'lc$^1'/1
+ (_bs)
+ <[]> when 'true' ->
+ []
+ ( <_6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_6})
+ -| [{'function_name',{'t_andalso',1}}] )
+ -| ['compiler_generated'] )
+ end
+ in apply 'lc$^0'/1
+ (_bs)>
+ in let <_7> =
+ fun (_p) ->
+ apply 't-andalso-1'/1
+ (_p)
+ in call 'lists':'foreach'
+ (_7, _ps)
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['andalso'|[['quote'|['true']]|[['quote'|['true']]]]]]]]})
+ let <_val> =
+ <case 'true' of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_8> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_8}})
+ -| ['compiler_generated'] )
+ end
+ ( <_57> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_57})
+ -| [{'function_name',{'t_andalso',1}}] )
+ -| ['compiler_generated'] )
+ end
+'t-andalso-1'/1 =
+ %% Line 207
+ fun (_0) ->
+ case <_0> of
+ <{_x,_y}> when 'true' ->
+ do call 'io':'format'
+ ([40|[97|[110|[100|[97|[108|[115|[111|[32|[126|[119|[32|[126|[119|[41|[58|[32]]]]]]]]]]]]]]]]], [_x,_y])
+ let <_v0> =
+ <case apply 'echo'/1
+ (_x) of
+ <'true'> when 'true' ->
+ apply 'echo'/1
+ (_y)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end>
+ in case <case 1 of
+ <_1>
+ when try
+ let <_3> =
+ let <_2> =
+ case _x of
+ <'true'> when 'true' ->
+ _y
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_2, 'true')
+ -| ['compiler_generated'] )
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_4>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_v1>
+ when try
+ let <_5> =
+ call 'erlang':'=:='
+ (_v0, _v1)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_6> =
+ call 'erlang':'and'
+ (_x, _y)
+ in apply 'check'/2
+ (_v1, _6)
+ ( <_7> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_7}})
+ -| ['compiler_generated'] )
+ end
+ ( <_8> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_8})
+ -| [{'function_name',{'t-andalso-1',1}}] )
+ -| ['compiler_generated'] )
+ end
+'t_orelse'/1 =
+ %% Line 215
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do let <_bs> =
+ <['true'|['false']]>
+ in let <_ps> =
+ <letrec
+ 'lc$^2'/1 =
+ fun (_2) ->
+ case <_2> of
+ <[_x|_lfe2]> when 'true' ->
+ letrec
+ 'lc$^3'/1 =
+ fun (_3) ->
+ case <_3> of
+ <[_y|_lfe3]> when 'true' ->
+ let <_4> =
+ apply 'lc$^3'/1
+ (_lfe3)
+ in [{_x,_y}|_4]
+ <[]> when 'true' ->
+ apply 'lc$^2'/1
+ (_lfe2)
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+ -| [{'function_name',{'t_orelse',1}}] )
+ -| ['compiler_generated'] )
+ end
+ in apply 'lc$^3'/1
+ (_bs)
+ <[]> when 'true' ->
+ []
+ ( <_6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_6})
+ -| [{'function_name',{'t_orelse',1}}] )
+ -| ['compiler_generated'] )
+ end
+ in apply 'lc$^2'/1
+ (_bs)>
+ in let <_7> =
+ fun (_p) ->
+ apply 't-orelse-1'/1
+ (_p)
+ in call 'lists':'foreach'
+ (_7, _ps)
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['orelse'|[['quote'|['true']]|[['quote'|['true']]]]]]]]})
+ let <_val> =
+ <case 'true' of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ 'true'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_8> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_8}})
+ -| ['compiler_generated'] )
+ end
+ ( <_57> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_57})
+ -| [{'function_name',{'t_orelse',1}}] )
+ -| ['compiler_generated'] )
+ end
+'t-orelse-1'/1 =
+ %% Line 249
+ fun (_0) ->
+ case <_0> of
+ <{_x,_y}> when 'true' ->
+ do call 'io':'format'
+ ([40|[111|[114|[101|[108|[115|[101|[32|[126|[119|[32|[126|[119|[41|[58|[32]]]]]]]]]]]]]]]], [_x,_y])
+ let <_v0> =
+ <case apply 'echo'/1
+ (_x) of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ apply 'echo'/1
+ (_y)
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end>
+ in case <case 1 of
+ <_1>
+ when try
+ let <_3> =
+ let <_2> =
+ case _x of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ _y
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_2, 'true')
+ -| ['compiler_generated'] )
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_4>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_v1>
+ when try
+ let <_5> =
+ call 'erlang':'=:='
+ (_v0, _v1)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_6> =
+ call 'erlang':'or'
+ (_x, _y)
+ in apply 'check'/2
+ (_v1, _6)
+ ( <_7> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_7}})
+ -| ['compiler_generated'] )
+ end
+ ( <_8> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_8})
+ -| [{'function_name',{'t-orelse-1',1}}] )
+ -| ['compiler_generated'] )
+ end
+'inside'/1 =
+ %% Line 257
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['inside'|[-8|[1]]]]]]})
+ let <_val> =
+ <apply 'inside'/2
+ (-8, 1)>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_12> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_12})
+ -| [{'function_name',{'inside',1}}] )
+ -| ['compiler_generated'] )
+ end
+'inside'/2 =
+ %% Line 272
+ fun (_xm,_ym) ->
+ let <_x> =
+ <-1.00000000000000000000e+01>
+ in let <_y> =
+ <-2.00000000000000000000e+00>
+ in let <_w> =
+ <2.00000000000000000000e+01>
+ in let <_h> =
+ <4.00000000000000000000e+00>
+ in let <_r0> =
+ <apply 'inside'/6
+ (_xm, _ym, _x, _y, _w, _h)>
+ in case <case 1 of
+ <_0>
+ when try
+ let <_4> =
+ let <_3> =
+ case call 'erlang':'=<'
+ (_x, _xm) of
+ <'true'> when 'true' ->
+ case let <_1> =
+ call 'erlang':'+'
+ (_x, _w)
+ in call 'erlang':'<'
+ (_xm, _1) of
+ <'true'> when 'true' ->
+ case call 'erlang':'=<'
+ (_y, _ym) of
+ <'true'> when 'true' ->
+ let <_2> =
+ call 'erlang':'+'
+ (_y, _h)
+ in call 'erlang':'<'
+ (_ym, _2)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_3, 'true')
+ -| ['compiler_generated'] )
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_5>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_r1>
+ when try
+ let <_6> =
+ call 'erlang':'=:='
+ (_r0, _r1)
+ in _6
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do case let <_7> =
+ apply 'id'/1
+ (_r1)
+ in call 'erlang':'not'
+ (_7) of
+ <_o0> when 'true' ->
+ case <case 1 of
+ <_8>
+ when try
+ let <_12> =
+ let <_11> =
+ case call 'erlang':'=<'
+ (_x, _xm) of
+ <'true'> when 'true' ->
+ case let <_9> =
+ call 'erlang':'+'
+ (_x, _w)
+ in call 'erlang':'<'
+ (_xm, _9) of
+ <'true'> when 'true' ->
+ case call 'erlang':'=<'
+ (_y, _ym) of
+ <'true'> when 'true' ->
+ let <_10> =
+ call 'erlang':'+'
+ (_y, _h)
+ in call 'erlang':'<'
+ (_ym, _10)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in call 'erlang':'not'
+ (_11)
+ in _12
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_13>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_o1>
+ when try
+ let <_14> =
+ call 'erlang':'=:='
+ (_o0, _o1)
+ in _14
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ _o1
+ ( <_15> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_15}})
+ -| ['compiler_generated'] )
+ end
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ do case <apply 'inside-guard'/6
+ (_xm, _ym, _x, _y, _w, _h)> of
+ <{_r2,_xm2,_ym2,_x2,_y2,_w2,_h2}>
+ when try
+ let <_16> =
+ call 'erlang':'=:='
+ (_r1, _r2)
+ in let <_17> =
+ call 'erlang':'=:='
+ (_xm, _xm2)
+ in let <_18> =
+ call 'erlang':'=:='
+ (_ym, _ym2)
+ in let <_19> =
+ call 'erlang':'=:='
+ (_x, _x2)
+ in let <_20> =
+ call 'erlang':'=:='
+ (_y, _y2)
+ in let <_21> =
+ call 'erlang':'=:='
+ (_w, _w2)
+ in let <_22> =
+ call 'erlang':'=:='
+ (_h, _h2)
+ in let <_23> =
+ call 'erlang':'and'
+ (_16, _17)
+ in let <_24> =
+ call 'erlang':'and'
+ (_23, _18)
+ in let <_25> =
+ call 'erlang':'and'
+ (_24, _19)
+ in let <_26> =
+ call 'erlang':'and'
+ (_25, _20)
+ in let <_27> =
+ call 'erlang':'and'
+ (_26, _21)
+ in call 'erlang':'and'
+ (_27, _22)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_30> =
+ let <_28> =
+ call 'erlang':'+'
+ (_x, _w)
+ in let <_29> =
+ call 'erlang':'+'
+ (_y, _h)
+ in [_x,_xm,_xm,_28,_y,_ym,_ym,_29,_r1]
+ in call 'io':'fwrite'
+ ([40|[97|[110|[100|[97|[108|[115|[111|[32|[40|[61|[60|[32|[126|[112|[32|[126|[112|[41|[32|[40|[60|[32|[126|[112|[32|[126|[112|[41|[32|[40|[61|[60|[32|[126|[112|[32|[126|[112|[41|[32|[40|[60|[32|[126|[112|[32|[126|[112|[41|[41|[32|[61|[61|[62|[32|[126|[112|[10]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]], _30)
+ ( <_31> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_31}})
+ -| ['compiler_generated'] )
+ end
+ _r1
+ ( <_32> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_32}})
+ -| ['compiler_generated'] )
+ end
+'inside'/6 =
+ %% Line 297
+ fun (_xm,_ym,_x,_y,_w,_h) ->
+ case call 'erlang':'=<'
+ (_x, _xm) of
+ <'true'> when 'true' ->
+ case let <_0> =
+ call 'erlang':'+'
+ (_x, _w)
+ in call 'erlang':'<'
+ (_xm, _0) of
+ <'true'> when 'true' ->
+ case call 'erlang':'=<'
+ (_y, _ym) of
+ <'true'> when 'true' ->
+ let <_1> =
+ call 'erlang':'+'
+ (_y, _h)
+ in call 'erlang':'<'
+ (_ym, _1)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end
+'inside-guard'/6 =
+ %% Line 300
+ fun (_5,_4,_3,_2,_1,_0) ->
+ case <_5,_4,_3,_2,_1,_0> of
+ <_xm,_ym,_x,_y,_w,_h>
+ when try
+ let <_9> =
+ let <_8> =
+ case call 'erlang':'=<'
+ (_x, _xm) of
+ <'true'> when 'true' ->
+ case let <_6> =
+ call 'erlang':'+'
+ (_x, _w)
+ in call 'erlang':'<'
+ (_xm, _6) of
+ <'true'> when 'true' ->
+ case call 'erlang':'=<'
+ (_y, _ym) of
+ <'true'> when 'true' ->
+ let <_7> =
+ call 'erlang':'+'
+ (_y, _h)
+ in call 'erlang':'<'
+ (_ym, _7)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_8, 'true')
+ -| ['compiler_generated'] )
+ in _9
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ {'true',_xm,_ym,_x,_y,_w,_h}
+ <_xm,_ym,_x,_y,_w,_h> when 'true' ->
+ {'false',_xm,_ym,_x,_y,_w,_h}
+ ( <_15,_14,_13,_12,_11,_10> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_15,_14,_13,_12,_11,_10})
+ -| [{'function_name',{'inside-guard',6}}] )
+ -| ['compiler_generated'] )
+ end
+'overlap'/1 =
+ %% Line 307
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['true']]|[['overlap'|[7.00000000000000000000e+00|[2.00000000000000000000e+00|[8.00000000000000000000e+00|[5.00000000000000000000e-01]]]]]]]]})
+ let <_val> =
+ <apply 'overlap'/4
+ (7.00000000000000000000e+00, 2.00000000000000000000e+00, 8.00000000000000000000e+00, 5.00000000000000000000e-01)>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_10> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_10})
+ -| [{'function_name',{'overlap',1}}] )
+ -| ['compiler_generated'] )
+ end
+'overlap'/4 =
+ %% Line 321
+ fun (_pos1,_len1,_pos2,_len2) ->
+ let <_r0> =
+ <case _pos1 of
+ <_pos1>
+ when try
+ let <_3> =
+ let <_2> =
+ case case call 'erlang':'=<'
+ (_pos2, _pos1) of
+ <'true'> when 'true' ->
+ let <_0> =
+ call 'erlang':'+'
+ (_pos2, _len2)
+ in call 'erlang':'<'
+ (_pos1, _0)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ case call 'erlang':'=<'
+ (_pos1, _pos2) of
+ <'true'> when 'true' ->
+ let <_1> =
+ call 'erlang':'+'
+ (_pos1, _len1)
+ in call 'erlang':'<'
+ (_pos2, _1)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_2, 'true')
+ -| ['compiler_generated'] )
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_pos1> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end>
+ in case <case case call 'erlang':'=<'
+ (_pos2, _pos1) of
+ <'true'> when 'true' ->
+ let <_4> =
+ call 'erlang':'+'
+ (_pos2, _len2)
+ in call 'erlang':'<'
+ (_pos1, _4)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ case call 'erlang':'=<'
+ (_pos1, _pos2) of
+ <'true'> when 'true' ->
+ let <_5> =
+ call 'erlang':'+'
+ (_pos1, _len1)
+ in call 'erlang':'<'
+ (_pos2, _5)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end> of
+ <_r1>
+ when try
+ let <_6> =
+ call 'erlang':'=:='
+ (_r0, _r1)
+ in _6
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case <case _pos1 of
+ <_pos1>
+ when try
+ let <_10> =
+ let <_9> =
+ case case call 'erlang':'=<'
+ (_pos2, _pos1) of
+ <'true'> when 'true' ->
+ let <_7> =
+ call 'erlang':'+'
+ (_pos2, _len2)
+ in call 'erlang':'<'
+ (_pos1, _7)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ case call 'erlang':'=<'
+ (_pos1, _pos2) of
+ <'true'> when 'true' ->
+ let <_8> =
+ call 'erlang':'+'
+ (_pos1, _len1)
+ in call 'erlang':'<'
+ (_pos2, _8)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_9, 'true')
+ -| ['compiler_generated'] )
+ in _10
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_pos1> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_r2>
+ when try
+ let <_11> =
+ call 'erlang':'=:='
+ (_r2, _r1)
+ in _11
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ apply 'id'/1
+ (_r2)
+ ( <_12> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_12}})
+ -| ['compiler_generated'] )
+ end
+ ( <_13> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_13}})
+ -| ['compiler_generated'] )
+ end
+'combined'/1 =
+ %% Line 348
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['false']]|[['comb'|[['quote'|['false']]|[['quote'|['false']]|[['quote'|['false']]]]]]]]]})
+ let <_val> =
+ <apply 'comb'/3
+ ('false', 'false', 'false')>
+ in case <_val> of
+ <'false'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_26> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_26})
+ -| [{'function_name',{'combined',1}}] )
+ -| ['compiler_generated'] )
+ end
+'comb'/3 =
+ %% Line 383
+ fun (_a,_b,_c) ->
+ let <_r0> =
+ <case case _a of
+ <'true'> when 'true' ->
+ _b
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ _c
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end>
+ in case <case 1 of
+ <_0>
+ when try
+ let <_2> =
+ let <_1> =
+ case case _a of
+ <'true'> when 'true' ->
+ _b
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ _c
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_1, 'true')
+ -| ['compiler_generated'] )
+ in _2
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_3>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_r1>
+ when try
+ let <_4> =
+ call 'erlang':'=:='
+ (_r0, _r1)
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_n0> =
+ <case 1 of
+ <_5>
+ when try
+ let <_7> =
+ let <_6> =
+ case case _a of
+ <'true'> when 'true' ->
+ _b
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ _c
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in call 'erlang':'not'
+ (_6)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_8>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end>
+ in case <let <_9> =
+ call 'erlang':'not'
+ (_r1)
+ in apply 'id'/1
+ (_9)> of
+ <_n1>
+ when try
+ let <_10> =
+ call 'erlang':'=:='
+ (_n0, _n1)
+ in _10
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case <case case _a of
+ <'true'> when 'true' ->
+ _b
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ _c
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end> of
+ <_r2>
+ when try
+ let <_11> =
+ call 'erlang':'=:='
+ (_r1, _r2)
+ in _11
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case <case 1 of
+ <_12>
+ when try
+ let <_14> =
+ let <_13> =
+ case case _a of
+ <'true'> when 'true' ->
+ _b
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ _c
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_13, 'true')
+ -| ['compiler_generated'] )
+ in _14
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_15>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_r3>
+ when try
+ let <_16> =
+ call 'erlang':'=:='
+ (_r2, _r3)
+ in _16
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case <let <_17> =
+ call 'erlang':'not'
+ (_r3)
+ in apply 'id'/1
+ (_17)> of
+ <_n2>
+ when try
+ let <_18> =
+ call 'erlang':'=:='
+ (_n1, _n2)
+ in _18
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case <case 1 of
+ <_19>
+ when try
+ let <_21> =
+ let <_20> =
+ case case _a of
+ <'true'> when 'true' ->
+ _b
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ _c
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_20, 'true')
+ -| ['compiler_generated'] )
+ in _21
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_22>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <_r4>
+ when try
+ let <_23> =
+ call 'erlang':'=:='
+ (_r3, _r4)
+ in _23
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ apply 'id'/1
+ (_r4)
+ ( <_24> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_24}})
+ -| ['compiler_generated'] )
+ end
+ ( <_25> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_25}})
+ -| ['compiler_generated'] )
+ end
+ ( <_26> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_26}})
+ -| ['compiler_generated'] )
+ end
+ ( <_27> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_27}})
+ -| ['compiler_generated'] )
+ end
+ ( <_28> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_28}})
+ -| ['compiler_generated'] )
+ end
+ ( <_29> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_29}})
+ -| ['compiler_generated'] )
+ end
+'in_case'/1 =
+ %% Line 402
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['edge_rings']]|[['in-case-1'|[1|[1|[1|[1|[1]]]]]]]]]})
+ let <_val> =
+ <apply 'in-case-1'/5
+ (1, 1, 1, 1, 1)>
+ in case <_val> of
+ <'edge_rings'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_13> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_13})
+ -| [{'function_name',{'in_case',1}}] )
+ -| ['compiler_generated'] )
+ end
+'in-case-1'/5 =
+ %% Line 419
+ fun (_lenup,_lendw,_lenn,_rot,_count) ->
+ let <_r0> =
+ <apply 'in-case-1-body'/5
+ (_lenup, _lendw, _lenn, _rot, _count)>
+ in case <apply 'in-case-1-guard'/5
+ (_lenup, _lendw, _lenn, _rot, _count)> of
+ <_res>
+ when try
+ let <_0> =
+ call 'erlang':'=:='
+ (_r0, _res)
+ in _0
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ _res
+ ( <_1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_1}})
+ -| ['compiler_generated'] )
+ end
+'in-case-1-body'/5 =
+ %% Line 425
+ fun (_lenup,_lendw,_lenn,_rot,_count) ->
+ case let <_5> =
+ let <_2> =
+ let <_0> =
+ call 'erlang':'/'
+ (_lenup, _count)
+ in call 'erlang':'>'
+ (_0, 7.06999999999999961808e-01)
+ in let <_3> =
+ let <_1> =
+ call 'erlang':'/'
+ (_lenn, _count)
+ in call 'erlang':'>'
+ (_1, 7.06999999999999961808e-01)
+ in call 'erlang':'and'
+ (_2, _3)
+ in let <_6> =
+ let <_4> =
+ call 'erlang':'abs'
+ (_rot)
+ in call 'erlang':'>'
+ (_4, 7.06999999999999961808e-01)
+ in call 'erlang':'and'
+ (_5, _6) of
+ <'true'> when 'true' ->
+ 'edge_rings'
+ <'false'> when 'true' ->
+ case let <_11> =
+ let <_9> =
+ let <_7> =
+ call 'erlang':'>='
+ (_lenup, 1)
+ in let <_8> =
+ call 'erlang':'>='
+ (_lendw, 1)
+ in call 'erlang':'or'
+ (_7, _8)
+ in let <_10> =
+ call 'erlang':'=<'
+ (_lenn, 1)
+ in call 'erlang':'or'
+ (_9, _10)
+ in let <_12> =
+ call 'erlang':'>'
+ (_count, 4)
+ in call 'erlang':'or'
+ (_11, _12) of
+ <'true'> when 'true' ->
+ 'not_loop'
+ <'false'> when 'true' ->
+ 'loop'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'in-case-1-guard'/5 =
+ %% Line 435
+ fun (_lenup,_lendw,_lenn,_rot,_count) ->
+ case case let <_0> =
+ call 'erlang':'/'
+ (_lenup, _count)
+ in call 'erlang':'>'
+ (_0, 7.06999999999999961808e-01) of
+ <'true'> when 'true' ->
+ case let <_1> =
+ call 'erlang':'/'
+ (_lenn, _count)
+ in call 'erlang':'>'
+ (_1, 7.06999999999999961808e-01) of
+ <'true'> when 'true' ->
+ let <_2> =
+ call 'erlang':'abs'
+ (_rot)
+ in call 'erlang':'>'
+ (_2, 7.06999999999999961808e-01)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ('if_clause')
+ -| ['compiler_generated'] )
+ end of
+ <'true'> when 'true' ->
+ 'edge_rings'
+ <'false'>
+ when try
+ let <_4> =
+ let <_3> =
+ case call 'erlang':'>='
+ (_lenup, 1) of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ case call 'erlang':'>='
+ (_lendw, 1) of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ case call 'erlang':'=<'
+ (_lenn, 1) of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ call 'erlang':'<'
+ (_count, 4)
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_3, 'true')
+ -| ['compiler_generated'] )
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'not_loop'
+ <'false'> when 'true' ->
+ 'loop'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'before_and_inside_if'/1 =
+ %% Line 443
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_andor_SUITE',['test-pat'|[['quote'|['no']]|[['before-and-inside-if'|[['quote'|[['a']]]|[['quote'|[['b']]]|[['quote'|['delete']]]]]]]]]})
+ let <_val> =
+ <apply 'before-and-inside-if'/3
+ (['a'], ['b'], 'delete')>
+ in case <_val> of
+ <'no'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_18> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_18})
+ -| [{'function_name',{'before_and_inside_if',1}}] )
+ -| ['compiler_generated'] )
+ end
+'before-and-inside-if'/3 =
+ %% Line 468
+ fun (XDo1,XDo2,Do3) ->
+ let <Do1> =
+ <call 'erlang':'=/='
+ (XDo1, [])>
+ in let <Do2> =
+ <call 'erlang':'=/='
+ (XDo2, [])>
+ in case 1 of
+ <_0>
+ when try
+ let <_7> =
+ let <_5> =
+ call 'erlang':'=:='
+ (Do1, 'true')
+ in let <_6> =
+ let <_3> =
+ let <_1> =
+ call 'erlang':'=:='
+ (Do1, 'false')
+ in let <_2> =
+ call 'erlang':'=:='
+ (Do2, 'false')
+ in call 'erlang':'and'
+ (_1, _2)
+ in let <_4> =
+ call 'erlang':'=:='
+ (Do3, 'delete')
+ in call 'erlang':'and'
+ (_3, _4)
+ in call 'erlang':'or'
+ (_5, _6)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'no'
+ <_8>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'yes'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'before-and-inside-if-2'/3 =
+ %% Line 484
+ fun (XDo1,XDo2,Do3) ->
+ let <Do1> =
+ <call 'erlang':'=/='
+ (XDo1, [])>
+ in let <Do2> =
+ <call 'erlang':'=/='
+ (XDo2, [])>
+ in let <CH1> =
+ <case 1 of
+ <_0>
+ when try
+ let <_7> =
+ let <_5> =
+ call 'erlang':'=='
+ (Do1, 'true')
+ in let <_6> =
+ let <_3> =
+ let <_1> =
+ call 'erlang':'=='
+ (Do1, 'false')
+ in let <_2> =
+ call 'erlang':'=='
+ (Do2, 'false')
+ in call 'erlang':'and'
+ (_1, _2)
+ in let <_4> =
+ call 'erlang':'=='
+ (Do3, 'blah')
+ in call 'erlang':'and'
+ (_3, _4)
+ in call 'erlang':'or'
+ (_5, _6)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ch1'
+ <_8>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'no'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end>
+ in let <CH2> =
+ <case 1 of
+ <_9>
+ when try
+ let <_16> =
+ let <_14> =
+ call 'erlang':'=='
+ (Do1, 'true')
+ in let <_15> =
+ let <_12> =
+ let <_10> =
+ call 'erlang':'=='
+ (Do1, 'false')
+ in let <_11> =
+ call 'erlang':'=='
+ (Do2, 'false')
+ in call 'erlang':'and'
+ (_10, _11)
+ in let <_13> =
+ call 'erlang':'=='
+ (Do3, 'xx')
+ in call 'erlang':'and'
+ (_12, _13)
+ in call 'erlang':'or'
+ (_14, _15)
+ in _16
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ch2'
+ <_17>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'no'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end>
+ in {CH1,CH2}
+'check'/2 =
+ %% Line 501
+ fun (_v1,_v0) ->
+ case 1 of
+ <_0>
+ when try
+ let <_1> =
+ call 'erlang':'/='
+ (_v1, _v0)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'io':'fwrite'
+ ([101|[114|[114|[111|[114|[58|[32|[126|[119|[46|[10]]]]]]]]]]], [_v1])
+ call 'erlang':'exit'
+ ('suite_failed')
+ <_2>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ call 'io':'fwrite'
+ ([111|[107|[58|[32|[126|[119|[46|[10]]]]]]]], [_v1])
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'echo'/1 =
+ %% Line 506
+ fun (_x) ->
+ do call 'io':'fwrite'
+ ([40|[101|[118|[97|[108|[32|[126|[119|[41|[59|[32]]]]]]]]]]], [_x])
+ _x
+'id'/1 =
+ %% Line 511
+ fun (_i) ->
+ _i
+'$handle_undefined_function'/2 =
+ %% Line 29
+ fun (_f,_as) ->
+ case let <_0> =
+ call 'lfe_env':'new'
+ ()
+ in apply 'LFE-EXPAND-EXPORTED-MACRO'/3
+ (_f, _as, _0) of
+ <{'yes',_exp}> when 'true' ->
+ call 'lfe_eval':'expr'
+ (_exp)
+ <'no'> when 'true' ->
+ let <_a,_b> =
+ <_f,_as>
+ in call 'error_handler':'raise_undef_exception'
+ ('lfe_andor_SUITE', _a, _b)
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'LFE-EXPAND-EXPORTED-MACRO'/3 =
+ %% Line 29
+ fun (_2,_1,_0) ->
+ 'no'
+'module_info'/0 =
+ fun () ->
+ call 'erlang':'get_module_info'
+ ('lfe_andor_SUITE')
+'module_info'/1 =
+ fun (_x) ->
+ call 'erlang':'get_module_info'
+ ('lfe_andor_SUITE', _x)
+end
diff --git a/lib/compiler/test/lfe_guard_SUITE.core b/lib/compiler/test/lfe_guard_SUITE.core
new file mode 100644
index 0000000000..920be82f61
--- /dev/null
+++ b/lib/compiler/test/lfe_guard_SUITE.core
@@ -0,0 +1,3438 @@
+module 'lfe_guard_SUITE' ['$handle_undefined_function'/2,
+ 'LFE-EXPAND-EXPORTED-MACRO'/3,
+ 'all'/0,
+ 'and_guard'/1,
+ 'andalso_semi'/1,
+ 'basic_andalso_orelse'/1,
+ 'basic_not'/1,
+ 'binary_part'/1,
+ 'build_in_guard'/1,
+ 'check_qlc_hrl'/1,
+ 'comma'/1,
+ 'complex_not'/1,
+ 'complex_or_guards'/1,
+ 'complex_semicolon'/1,
+ 'const_cond'/1,
+ 'end_per_group'/2,
+ 'end_per_suite'/1,
+ 'gbif'/1,
+ 'groups'/0,
+ 'init_per_group'/2,
+ 'init_per_suite'/1,
+ 'is_function_2'/1,
+ 'literal_type_tests'/1,
+ 'misc'/1,
+ 'module_info'/0,
+ 'module_info'/1,
+ 'more_or_guards'/1,
+ 'more_xor_guards'/1,
+ 'nested_nots'/1,
+ 'old_guard_tests'/1,
+ 'or_guard'/1,
+ 'rel_ops'/1,
+ 'semicolon'/1,
+ 'suite'/0,
+ 't_is_boolean'/1,
+ 't_tuple_size'/1,
+ 'traverse_dcd'/1,
+ 'tricky'/1,
+ 'xor_guard'/1]
+ attributes []
+'all'/0 =
+ %% Line 47
+ fun () ->
+ ['misc'|['const_cond'|['basic_not'|['complex_not'|['nested_nots'|['semicolon'|['complex_semicolon'|['comma'|['or_guard'|['more_or_guards'|['complex_or_guards'|['and_guard'|['xor_guard'|['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']]]]]]]]]]]]]]]]]]]]]]]]]]]]
+'suite'/0 =
+ %% Line 58
+ fun () ->
+ []
+'groups'/0 =
+ %% Line 60
+ fun () ->
+ []
+'init_per_suite'/1 =
+ %% Line 62
+ fun (_config) ->
+ _config
+'end_per_suite'/1 =
+ %% Line 64
+ fun (_config) ->
+ 'ok'
+'init_per_group'/2 =
+ %% Line 66
+ fun (_name,_config) ->
+ _config
+'end_per_group'/2 =
+ %% Line 68
+ fun (_name,_config) ->
+ _config
+'misc'/1 =
+ %% Line 70
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[42|[['case'|[['id'|[42]]|[['x'|[['when'|[['-'|['x']]]]|[['quote'|['ok']]]]]|[['x'|['x']]]]]]]]]})
+ let <_val> =
+ <case apply 'id'/1
+ (42) of
+ <_x>
+ when try
+ let <_3> =
+ let <_2> =
+ call 'erlang':'-'
+ (_x)
+ in ( call 'erlang':'=:='
+ (_2, 'true')
+ -| ['compiler_generated'] )
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_x> when 'true' ->
+ _x
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end>
+ in case <_val> of
+ <42> when 'true' ->
+ _val
+ ( <_4> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_4}})
+ -| ['compiler_generated'] )
+ end
+ ( <_17> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_17})
+ -| [{'function_name',{'misc',1}}] )
+ -| ['compiler_generated'] )
+ end
+'misc-1'/1 =
+ %% Line 93
+ fun (_0) ->
+ case <_0> of
+ <[{_w},{_x},{_y},{_z}]> when 'true' ->
+ case 1 of
+ <_1>
+ when try
+ let <_4> =
+ let <_3> =
+ case call 'erlang':'>'
+ (_x, _y) of
+ <'true'> when 'true' ->
+ let <_2> =
+ call 'erlang':'abs'
+ (_z)
+ in call 'erlang':'=:='
+ (_2, 2)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_3, 'true')
+ -| ['compiler_generated'] )
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ apply 'id'/1
+ (_w)
+ <_5>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'none'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ ( <_6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_6})
+ -| [{'function_name',{'misc-1',1}}] )
+ -| ['compiler_generated'] )
+ end
+'get-data'/3 =
+ %% Line 99
+ fun (_2,_1,_0) ->
+ case <_2,_1,_0> of
+ <{'o',_active,_raw},_bytes,_buffer>
+ when try
+ let <_5> =
+ let <_3> =
+ call 'erlang':'=:='
+ (_raw, 'raw')
+ in let <_4> =
+ call 'erlang':'=:='
+ (_raw, 0)
+ in call 'erlang':'or'
+ (_3, _4)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case 1 of
+ <_6>
+ when try
+ let <_8> =
+ let <_7> =
+ case call 'erlang':'=/='
+ (_active, 'false') of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ call 'erlang':'=:='
+ (_bytes, 0)
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_7, 'true')
+ -| ['compiler_generated'] )
+ in _8
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ {'ok',_buffer,#{}#}
+ <_9>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ ( <_12,_11,_10> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_12,_11,_10})
+ -| [{'function_name',{'get-data',3}}] )
+ -| ['compiler_generated'] )
+ end
+'const_cond'/1 =
+ %% Line 104
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['const-cond'|[{}|[0]]]]]]})
+ let <_val> =
+ <apply 'const-cond'/2
+ ({}, 0)>
+ in case <_val> of
+ <'ok'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_7> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_7})
+ -| [{'function_name',{'const_cond',1}}] )
+ -| ['compiler_generated'] )
+ end
+'const-cond'/2 =
+ %% Line 113
+ fun (_t,_sz) ->
+ case _t of
+ <_0>
+ when try
+ 'false'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'never'
+ <_1>
+ when try
+ let <_3> =
+ call 'erlang':'is_tuple'
+ (_t)
+ in let <_4> =
+ call 'erlang':'=='
+ ('eq', 'eq')
+ in let <_5> =
+ let <_2> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=='
+ (_2, _sz)
+ in let <_6> =
+ call 'erlang':'and'
+ (_3, _4)
+ in call 'erlang':'and'
+ (_6, _5)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_7>
+ when try
+ let <_9> =
+ call 'erlang':'is_tuple'
+ (_t)
+ in let <_10> =
+ call 'erlang':'=='
+ ('eq', 'leq')
+ in let <_11> =
+ let <_8> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=='
+ (_8, _sz)
+ in let <_12> =
+ call 'erlang':'and'
+ (_9, _10)
+ in call 'erlang':'and'
+ (_12, _11)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_13> when 'true' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'basic_not'/1 =
+ %% Line 120
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_true> =
+ <apply 'id'/1
+ ('true')>
+ in let <_false> =
+ <apply 'id'/1
+ ('false')>
+ in let <_glurf> =
+ <apply 'id'/1
+ ('glurf')>
+ in let <_a> =
+ <apply 'id'/1
+ (5)>
+ in let <_b> =
+ <apply 'id'/1
+ (3.75000000000000000000e+01)>
+ in let <_c> =
+ <apply 'id'/1
+ (-1)>
+ in let <_d> =
+ <apply 'id'/1
+ (5)>
+ in let <_atuple> =
+ <{_false,_true,_glurf}>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['not'|[['quote'|['false']]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['ok']]]]]})
+ let <_5> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_3> =
+ call 'erlang':'not'
+ ('false')
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_4>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_5, 'ok')
+ ( <_128> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_128})
+ -| [{'function_name',{'basic_not',1}}] )
+ -| ['compiler_generated'] )
+ end
+'complex_not'/1 =
+ %% Line 164
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_atuple> =
+ <apply 'id'/1
+ ({'false','true','gurka'})>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['not'|[['element'|[1|['atuple']]]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['ok']]]]]})
+ let <_6> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_4> =
+ let <_3> =
+ call 'erlang':'element'
+ (1, _atuple)
+ in call 'erlang':'not'
+ (_3)
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_5>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_6, 'ok')
+ ( <_50> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_50})
+ -| [{'function_name',{'complex_not',1}}] )
+ -| ['compiler_generated'] )
+ end
+'nested_nots'/1 =
+ %% Line 191
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['true']]|[['nested-not-1'|[0|[0]]]]]]})
+ let <_val> =
+ <apply 'nested-not-1'/2
+ (0, 0)>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_18> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_18})
+ -| [{'function_name',{'nested_nots',1}}] )
+ -| ['compiler_generated'] )
+ end
+'nested-not-1'/2 =
+ %% Line 213
+ fun (_1,_0) ->
+ case <_1,_0> of
+ <_x,_y>
+ when try
+ let <_10> =
+ let <_9> =
+ let <_7> =
+ let <_3> =
+ call 'erlang':'>'
+ (_x, _y)
+ in let <_4> =
+ let <_2> =
+ call 'erlang':'is_atom'
+ (_x)
+ in call 'erlang':'not'
+ (_2)
+ in call 'erlang':'or'
+ (_3, _4)
+ in let <_8> =
+ let <_5> =
+ call 'erlang':'is_atom'
+ (_y)
+ in let <_6> =
+ call 'erlang':'=='
+ (_x, 3.39999999999999991118e+00)
+ in call 'erlang':'or'
+ (_5, _6)
+ in call 'erlang':'and'
+ (_7, _8)
+ in call 'erlang':'not'
+ (_9)
+ in _10
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_11,_12> when 'true' ->
+ 'false'
+ ( <_14,_13> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_14,_13})
+ -| [{'function_name',{'nested-not-1',2}}] )
+ -| ['compiler_generated'] )
+ end
+'nested-not-2'/3 =
+ %% Line 219
+ fun (_x,_y,_z) ->
+ apply 'nested-not-2'/4
+ (_x, _y, _z, 'true')
+'nested-not-2'/4 =
+ %% Line 222
+ fun (_3,_2,_1,_0) ->
+ case <_3,_2,_1,_0> of
+ <_x,_y,_z,_true>
+ when try
+ let <_12> =
+ let <_11> =
+ let <_10> =
+ let <_9> =
+ let <_7> =
+ let <_4> =
+ call 'erlang':'not'
+ (_x)
+ in let <_5> =
+ call 'erlang':'not'
+ (_y)
+ in call 'erlang':'and'
+ (_4, _5)
+ in let <_8> =
+ let <_6> =
+ call 'erlang':'is_atom'
+ (_z)
+ in call 'erlang':'not'
+ (_6)
+ in call 'erlang':'or'
+ (_7, _8)
+ in call 'erlang':'not'
+ (_9)
+ in call 'erlang':'and'
+ (_true, _10)
+ in call 'erlang':'not'
+ (_11)
+ in _12
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_13,_14,_15,_16> when 'true' ->
+ 'false'
+ ( <_20,_19,_18,_17> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_20,_19,_18,_17})
+ -| [{'function_name',{'nested-not-2',4}}] )
+ -| ['compiler_generated'] )
+ end
+'semicolon'/1 =
+ %% Line 228
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_2> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_2})
+ -| [{'function_name',{'semicolon',1}}] )
+ -| ['compiler_generated'] )
+ end
+'complex_semicolon'/1 =
+ %% Line 233
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_2> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_2})
+ -| [{'function_name',{'complex_semicolon',1}}] )
+ -| ['compiler_generated'] )
+ end
+'comma'/1 =
+ %% Line 239
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['progn'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]})
+ let <_6> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_4> =
+ let <_3> =
+ call 'erlang':'and'
+ ('true', 'false')
+ in ( call 'erlang':'=:='
+ (_3, 'true')
+ -| ['compiler_generated'] )
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_5>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_6, 'error')
+ ( <_181> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_181})
+ -| [{'function_name',{'comma',1}}] )
+ -| ['compiler_generated'] )
+ end
+'or_guard'/1 =
+ %% Line 305
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do let <_true,_false,_glurf> =
+ <apply 'id'/1
+ ('true'),apply 'id'/1
+ ('false'),apply 'id'/1
+ ('glurf')>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['or'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]]]]]]]|[['quote'|['ok']]]]]})
+ let <_4> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_3> =
+ call 'erlang':'or'
+ ('true', 'false')
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_4, 'ok')
+ 'ok'
+ ( <_64> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_64})
+ -| [{'function_name',{'or_guard',1}}] )
+ -| ['compiler_generated'] )
+ end
+'more_or_guards'/1 =
+ %% Line 346
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do let <_true> =
+ <apply 'id'/1
+ ('true')>
+ in let <_false> =
+ <apply 'id'/1
+ ('false')>
+ in let <_atuple> =
+ <apply 'id'/1
+ ({'false','true','gurks'})>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['or'|[['element'|[42|['atuple']]]|['false']]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]})
+ let <_6> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_4> =
+ let <_3> =
+ call 'erlang':'element'
+ (42, _atuple)
+ in call 'erlang':'or'
+ (_3, _false)
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_5>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_6, 'error')
+ 'ok'
+ ( <_68> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_68})
+ -| [{'function_name',{'more_or_guards',1}}] )
+ -| ['compiler_generated'] )
+ end
+'complex_or_guards'/1 =
+ %% Line 409
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['complex-or-1'|[{'a','b','c','d'}|[{1,2,3}]]]]]]})
+ let <_val> =
+ <apply 'complex-or-1'/2
+ ({'a','b','c','d'}, {1,2,3})>
+ in case <_val> of
+ <'ok'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_55> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_55})
+ -| [{'function_name',{'complex_or_guards',1}}] )
+ -| ['compiler_generated'] )
+ end
+'complex-or-1'/2 =
+ %% Line 487
+ fun (_a,_b) ->
+ case 1 of
+ <_0>
+ when try
+ let <_11> =
+ let <_9> =
+ let <_3> =
+ let <_1> =
+ call 'erlang':'tuple_size'
+ (_a)
+ in call 'erlang':'<'
+ (3, _1)
+ in let <_4> =
+ let <_2> =
+ call 'erlang':'tuple_size'
+ (_a)
+ in call 'erlang':'<'
+ (_2, 9)
+ in call 'erlang':'and'
+ (_3, _4)
+ in let <_10> =
+ let <_7> =
+ let <_5> =
+ call 'erlang':'tuple_size'
+ (_b)
+ in call 'erlang':'<'
+ (2, _5)
+ in let <_8> =
+ let <_6> =
+ call 'erlang':'tuple_size'
+ (_b)
+ in call 'erlang':'<'
+ (_6, 7)
+ in call 'erlang':'and'
+ (_7, _8)
+ in call 'erlang':'or'
+ (_9, _10)
+ in _11
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_12>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'complex-or-2'/1 =
+ %% Line 492
+ fun (_tuple) ->
+ case 1 of
+ <_0>
+ when try
+ let <_6> =
+ let <_4> =
+ call 'erlang':'element'
+ (1, _tuple)
+ in let <_5> =
+ let <_3> =
+ let <_2> =
+ let <_1> =
+ call 'erlang':'element'
+ (2, _tuple)
+ in call 'erlang':'tuple_size'
+ (_1)
+ in call 'erlang':'>'
+ (_2, 3)
+ in call 'erlang':'not'
+ (_3)
+ in call 'erlang':'or'
+ (_4, _5)
+ in _6
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_7>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'complex-or-3'/2 =
+ %% Line 496
+ fun (_a,_b) ->
+ case 1 of
+ <_0>
+ when try
+ let <_5> =
+ let <_3> =
+ let <_2> =
+ let <_1> =
+ call 'erlang':'size'
+ (_b)
+ in call 'erlang':'>'
+ (_1, 3)
+ in call 'erlang':'not'
+ (_2)
+ in let <_4> =
+ call 'erlang':'element'
+ (1, _a)
+ in call 'erlang':'or'
+ (_3, _4)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_6>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'complex-or-4'/2 =
+ %% Line 499
+ fun (_a,_b) ->
+ case 1 of
+ <_0>
+ when try
+ let <_7> =
+ let <_5> =
+ let <_4> =
+ let <_2> =
+ call 'erlang':'is_tuple'
+ (_a)
+ in let <_3> =
+ let <_1> =
+ call 'erlang':'size'
+ (_a)
+ in call 'erlang':'>'
+ (_1, 3)
+ in call 'erlang':'and'
+ (_2, _3)
+ in call 'erlang':'not'
+ (_4)
+ in let <_6> =
+ call 'erlang':'element'
+ (1, _b)
+ in call 'erlang':'or'
+ (_5, _6)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_8>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'complex-or-5'/2 =
+ %% Line 503
+ fun (_a,_b) ->
+ case 1 of
+ <_0>
+ when try
+ let <_8> =
+ let <_6> =
+ let <_4> =
+ let <_2> =
+ call 'erlang':'is_tuple'
+ (_a)
+ in let <_3> =
+ let <_1> =
+ call 'erlang':'size'
+ (_a)
+ in call 'erlang':'>'
+ (_1, 3)
+ in call 'erlang':'and'
+ (_2, _3)
+ in call 'erlang':'not'
+ (_4)
+ in let <_7> =
+ let <_5> =
+ call 'erlang':'element'
+ (1, _b)
+ in call 'erlang':'not'
+ (_5)
+ in call 'erlang':'or'
+ (_6, _7)
+ in _8
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_9>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'complex-or-6'/2 =
+ %% Line 507
+ fun (_a,_b) ->
+ case 1 of
+ <_0>
+ when try
+ let <_11> =
+ let <_9> =
+ let <_5> =
+ let <_3> =
+ let <_1> =
+ call 'erlang':'element'
+ (1, _a)
+ in call 'erlang':'not'
+ (_1)
+ in let <_4> =
+ let <_2> =
+ call 'erlang':'element'
+ (2, _a)
+ in call 'erlang':'not'
+ (_2)
+ in call 'erlang':'and'
+ (_3, _4)
+ in call 'erlang':'not'
+ (_5)
+ in let <_10> =
+ let <_8> =
+ let <_7> =
+ let <_6> =
+ call 'erlang':'size'
+ (_b)
+ in call 'erlang':'>'
+ (_6, 3)
+ in call 'erlang':'not'
+ (_7)
+ in call 'erlang':'not'
+ (_8)
+ in call 'erlang':'or'
+ (_9, _10)
+ in _11
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_12>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'and_guard'/1 =
+ %% Line 512
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['and'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]})
+ let <_5> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_3> =
+ call 'erlang':'and'
+ ('true', 'false')
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_4>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_5, 'error')
+ ( <_120> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_120})
+ -| [{'function_name',{'and_guard',1}}] )
+ -| ['compiler_generated'] )
+ end
+'relprod'/2 =
+ %% Line 588
+ fun (_1,_0) ->
+ case <_1,_0> of
+ <_r1,_r2>
+ when try
+ let <_10> =
+ let <_4> =
+ let <_2> =
+ call 'erlang':'size'
+ (_r1)
+ in call 'erlang':'=:='
+ (_2, 3)
+ in let <_5> =
+ let <_3> =
+ call 'erlang':'element'
+ (1, _r1)
+ in call 'erlang':'=:='
+ (_3, 'Set')
+ in call 'erlang':'and'
+ (_4, _5)
+ in let <_11> =
+ let <_8> =
+ let <_6> =
+ call 'erlang':'size'
+ (_r2)
+ in call 'erlang':'=:='
+ (_6, 3)
+ in let <_9> =
+ let <_7> =
+ call 'erlang':'element'
+ (1, _r2)
+ in call 'erlang':'=:='
+ (_7, 'Set')
+ in call 'erlang':'and'
+ (_8, _9)
+ in call 'erlang':'and'
+ (_10, _11)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_13,_12> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_13,_12})
+ -| [{'function_name',{'relprod',2}}] )
+ -| ['compiler_generated'] )
+ end
+'xor_guard'/1 =
+ %% Line 595
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['xor'|[['quote'|['true']]|[['quote'|['false']]]]]|[['quote'|['ok']]]]]]]]|[['quote'|['ok']]]]]})
+ let <_4> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_3> =
+ call 'erlang':'xor'
+ ('true', 'false')
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_4, 'ok')
+ ( <_54> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_54})
+ -| [{'function_name',{'xor_guard',1}}] )
+ -| ['compiler_generated'] )
+ end
+'more_xor_guards'/1 =
+ %% Line 636
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_true,_false,_atuple> =
+ <apply 'id'/1
+ ('true'),apply 'id'/1
+ ('false'),apply 'id'/1
+ ({'false','true','gurka'})>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['check'|[['lambda'|[[]|[['eif'|[['xor'|[['element'|[42|['atuple']]]|['false']]]|[['quote'|['ok']]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]|[['quote'|['error']]]]]})
+ let <_6> =
+ fun () ->
+ case 1 of
+ <_2>
+ when try
+ let <_4> =
+ let <_3> =
+ call 'erlang':'element'
+ (42, _atuple)
+ in call 'erlang':'xor'
+ (_3, _false)
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_5>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ in apply 'check'/2
+ (_6, 'error')
+ ( <_29> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_29})
+ -| [{'function_name',{'more_xor_guards',1}}] )
+ -| ['compiler_generated'] )
+ end
+'build_in_guard'/1 =
+ %% Line 666
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_subbin> =
+ <#{#<64>(8,1,'integer',['unsigned'|['big']]),
+ #<20>(8,1,'integer',['unsigned'|['big']]),
+ #<0>(8,1,'integer',['unsigned'|['big']]),
+ #<0>(8,1,'integer',['unsigned'|['big']]),
+ #<0>(8,1,'integer',['unsigned'|['big']]),
+ #<0>(8,1,'integer',['unsigned'|['big']]),
+ #<0>(8,1,'integer',['unsigned'|['big']]),
+ #<0>(8,1,'integer',['unsigned'|['big']])}#>
+ in let <_b> =
+ <#{#<1>(8,1,'integer',['unsigned'|['big']]),
+ #<_subbin>('all',8,'binary',['unsigned'|['big']]),
+ #<3.50000000000000000000e+00>(64,1,'float',['unsigned'|['big']])}#>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['eif'|[['=:='|['b'|[['binary'|[1|[['subbin'|['binary']]|[[3.50000000000000000000e+00|['float']]]]]]]]]|[['quote'|['ok']]]]]]]]})
+ let <_val> =
+ <case 1 of
+ <_2>
+ when try
+ let <_3> =
+ call 'erlang':'=:='
+ (_b, #{#<1>(8,1,'integer',['unsigned'|['big']]),
+ #<_subbin>('all',8,'binary',['unsigned'|['big']]),
+ #<3.50000000000000000000e+00>(64,1,'float',['unsigned'|['big']])}#)
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end>
+ in case <_val> of
+ <'ok'> when 'true' ->
+ _val
+ ( <_4> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_4}})
+ -| ['compiler_generated'] )
+ end
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+ -| [{'function_name',{'build_in_guard',1}}] )
+ -| ['compiler_generated'] )
+ end
+'old_guard_tests'/1 =
+ %% Line 674
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_2> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_2})
+ -| [{'function_name',{'old_guard_tests',1}}] )
+ -| ['compiler_generated'] )
+ end
+'gbif'/1 =
+ %% Line 679
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['error']]|[['gbif-1'|[1|[{'false','true'}]]]]]]})
+ let <_val> =
+ <apply 'gbif-1'/2
+ (1, {'false','true'})>
+ in case <_val> of
+ <'error'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_4> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_4})
+ -| [{'function_name',{'gbif',1}}] )
+ -| ['compiler_generated'] )
+ end
+'gbif-1'/2 =
+ %% Line 685
+ fun (_1,_0) ->
+ case <_1,_0> of
+ <_p,_t>
+ when try
+ let <_3> =
+ let <_2> =
+ call 'erlang':'element'
+ (_p, _t)
+ in ( call 'erlang':'=:='
+ (_2, 'true')
+ -| ['compiler_generated'] )
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_4,_5> when 'true' ->
+ 'error'
+ ( <_7,_6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_7,_6})
+ -| [{'function_name',{'gbif-1',2}}] )
+ -| ['compiler_generated'] )
+ end
+'t_is_boolean'/1 =
+ %% Line 690
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['true']]|[['is_boolean'|[['quote'|['true']]]]]]]})
+ let <_val> =
+ <call 'erlang':'is_boolean'
+ ('true')>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_70> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_70})
+ -| [{'function_name',{'t_is_boolean',1}}] )
+ -| ['compiler_generated'] )
+ end
+'bool'/1 =
+ %% Line 744
+ fun (_0) ->
+ case <_0> of
+ <_x>
+ when try
+ let <_1> =
+ call 'erlang':'is_boolean'
+ (_x)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_2> when 'true' ->
+ 'error'
+ ( <_3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_3})
+ -| [{'function_name',{'bool',1}}] )
+ -| ['compiler_generated'] )
+ end
+'my-is-bool'/1 =
+ %% Line 748
+ fun (_v) ->
+ let <_r0> =
+ <apply 'my-is-bool-a'/1
+ (_v)>
+ in case <apply 'my-is-bool-b'/1
+ (_v)> of
+ <_res>
+ when try
+ let <_0> =
+ call 'erlang':'=:='
+ (_res, _r0)
+ in _0
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ _res
+ ( <_1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_1}})
+ -| ['compiler_generated'] )
+ end
+'my-is-bool-a'/1 =
+ %% Line 753
+ fun (_v) ->
+ case _v of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ 'true'
+ <_0> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'my-is-bool-b'/1 =
+ %% Line 759
+ fun (_v) ->
+ case _v of
+ <'false'> when 'true' ->
+ 'true'
+ <'true'> when 'true' ->
+ 'true'
+ <_0> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'is_function_2'/1 =
+ %% Line 765
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['true']]|[['is_function'|[['id'|[['function'|['lfe_guard_SUITE'|['all'|[1]]]]]]|[1]]]]]]})
+ let <_val> =
+ <let <_3> =
+ let <_2> =
+ call 'erlang':'make_fun'
+ ('lfe_guard_SUITE', 'all', 1)
+ in apply 'id'/1
+ (_2)
+ in call 'erlang':'is_function'
+ (_3, 1)>
+ in case <_val> of
+ <'true'> when 'true' ->
+ _val
+ ( <_4> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_4}})
+ -| ['compiler_generated'] )
+ end
+ ( <_17> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_17})
+ -| [{'function_name',{'is_function_2',1}}] )
+ -| ['compiler_generated'] )
+ end
+'tricky'/1 =
+ %% Line 775
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['not_ok']]|[['tricky-1'|[1|[2]]]]]]})
+ let <_val> =
+ <apply 'tricky-1'/2
+ (1, 2)>
+ in case <_val> of
+ <'not_ok'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_12> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_12})
+ -| [{'function_name',{'tricky',1}}] )
+ -| ['compiler_generated'] )
+ end
+'tricky-1'/2 =
+ %% Line 791
+ fun (_1,_0) ->
+ case <_1,_0> of
+ <_x,_y>
+ when try
+ let <_6> =
+ let <_5> =
+ let <_4> =
+ let <_2> =
+ call 'erlang':'=='
+ (_x, 1)
+ in let <_3> =
+ call 'erlang':'=='
+ (_y, 2)
+ in call 'erlang':'or'
+ (_2, _3)
+ in call 'erlang':'abs'
+ (_4)
+ in ( call 'erlang':'=:='
+ (_5, 'true')
+ -| ['compiler_generated'] )
+ in _6
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_7,_8> when 'true' ->
+ 'not_ok'
+ ( <_10,_9> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_10,_9})
+ -| [{'function_name',{'tricky-1',2}}] )
+ -| ['compiler_generated'] )
+ end
+'tricky-2'/1 =
+ %% Line 795
+ fun (_0) ->
+ case <_0> of
+ <_x>
+ when try
+ let <_3> =
+ let <_1> =
+ call 'erlang':'float'
+ (_x)
+ in let <_2> =
+ call 'erlang':'float'
+ (_x)
+ in call 'erlang':'or'
+ (_1, _2)
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_4> when 'true' ->
+ 'error'
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+ -| [{'function_name',{'tricky-2',1}}] )
+ -| ['compiler_generated'] )
+ end
+'rb'/3 =
+ %% Line 801
+ fun (_2,_1,_0) ->
+ case <_2,_1,_0> of
+ <_size,_toread,_sofar>
+ when try
+ let <_6> =
+ let <_4> =
+ let <_3> =
+ call 'erlang':'+'
+ (_sofar, _size)
+ in call 'erlang':'<'
+ (_3, 81920)
+ in let <_5> =
+ call 'erlang':'=='
+ (_toread, [])
+ in call 'erlang':'or'
+ (_4, _5)
+ in _6
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'true'
+ <_7,_8,_9> when 'true' ->
+ 'false'
+ ( <_12,_11,_10> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_12,_11,_10})
+ -| [{'function_name',{'rb',3}}] )
+ -| ['compiler_generated'] )
+ end
+'rel_ops'/1 =
+ %% Line 830
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['T'|['=/='|[1|[1.00000000000000000000e+00]]]]})
+ case <case 1 of
+ <_2>
+ when try
+ let <_3> =
+ call 'erlang':'=/='
+ (1, 1.00000000000000000000e+00)
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_4>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <'ok'> when 'true' ->
+ case <case 1 of
+ <_5>
+ when try
+ let <_7> =
+ let <_6> =
+ call 'erlang':'=/='
+ (1, 1.00000000000000000000e+00)
+ in call 'erlang':'not'
+ (_6)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ <_8>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <'ok'> when 'true' ->
+ let <_x,_y,_true,_false> =
+ <apply 'id'/1
+ (1),apply 'id'/1
+ (1.00000000000000000000e+00),apply 'id'/1
+ ('true'),apply 'id'/1
+ ('false')>
+ in case <case 1 of
+ <_9>
+ when try
+ let <_10> =
+ call 'erlang':'=/='
+ (_x, _y)
+ in _10
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_11>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <'ok'> when 'true' ->
+ case <case 1 of
+ <_12>
+ when try
+ let <_15> =
+ let <_14> =
+ let <_13> =
+ call 'erlang':'=/='
+ (_x, _y)
+ in call 'erlang':'or'
+ (_false, _13)
+ in call 'erlang':'or'
+ (_14, _false)
+ in _15
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_16>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <'ok'> when 'true' ->
+ case <case 1 of
+ <_17>
+ when try
+ let <_19> =
+ let <_18> =
+ call 'erlang':'=/='
+ (_x, _y)
+ in call 'erlang':'and'
+ (_18, _true)
+ in _19
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_20>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <'ok'> when 'true' ->
+ case <case 1 of
+ <_21>
+ when try
+ let <_23> =
+ let <_22> =
+ call 'erlang':'=/='
+ (_x, _y)
+ in call 'erlang':'not'
+ (_22)
+ in _23
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ <_24>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <'ok'> when 'true' ->
+ case <case 1 of
+ <_25>
+ when try
+ let <_29> =
+ let <_28> =
+ let <_27> =
+ let <_26> =
+ call 'erlang':'=/='
+ (_x, _y)
+ in call 'erlang':'not'
+ (_26)
+ in call 'erlang':'or'
+ (_false, _27)
+ in call 'erlang':'or'
+ (_28, _false)
+ in _29
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ <_30>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end> of
+ <'ok'> when 'true' ->
+ 'ok'
+ ( <_31> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_31}})
+ -| ['compiler_generated'] )
+ end
+ ( <_32> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_32}})
+ -| ['compiler_generated'] )
+ end
+ ( <_33> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_33}})
+ -| ['compiler_generated'] )
+ end
+ ( <_34> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_34}})
+ -| ['compiler_generated'] )
+ end
+ ( <_35> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_35}})
+ -| ['compiler_generated'] )
+ end
+ ( <_36> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_36}})
+ -| ['compiler_generated'] )
+ end
+ ( <_37> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_37}})
+ -| ['compiler_generated'] )
+ end
+ ( <_769> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_769})
+ -| [{'function_name',{'rel_ops',1}}] )
+ -| ['compiler_generated'] )
+ end
+'literal_type_tests'/1 =
+ %% Line 873
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case 'guard_suite' of
+ <'guard_suite'> when 'true' ->
+ apply 'literal-type-tests-1'/1
+ (_config)
+ <_2> when 'true' ->
+ {'skip',[69|[110|[111|[117|[103|[104|[32|[116|[111|[32|[114|[117|[110|[32|[116|[104|[105|[115|[32|[99|[97|[115|[101|[32|[111|[110|[99|[101|[46]]]]]]]]]]]]]]]]]]]]]]]]]]]]]}
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ ( <_3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_3})
+ -| [{'function_name',{'literal_type_tests',1}}] )
+ -| ['compiler_generated'] )
+ end
+'literal-type-tests-1'/1 =
+ %% Line 879
+ fun (_config) ->
+ 'ok'
+'basic_andalso_orelse'/1 =
+ %% Line 967
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_t> =
+ <apply 'id'/1
+ ({'type','integers',23,42})>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[65|[['eif'|[['andalso'|[['=:='|[['element'|[1|['t']]]|[['quote'|['type']]]]]|[['=:='|[['tuple_size'|['t']]|[4]]]|[['=:='|[['element'|[2|['t']]]|[['quote'|['integers']]]]]]]]]|[['+'|[['element'|[3|['t']]]|[['element'|[4|['t']]]]]]|[['quote'|['true']]|[['quote'|['error']]]]]]]]]]})
+ let <_val> =
+ <case 1 of
+ <_2>
+ when try
+ let <_7> =
+ let <_6> =
+ case let <_3> =
+ call 'erlang':'element'
+ (1, _t)
+ in call 'erlang':'=:='
+ (_3, 'type') of
+ <'true'> when 'true' ->
+ case let <_4> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_4, 4) of
+ <'true'> when 'true' ->
+ let <_5> =
+ call 'erlang':'element'
+ (2, _t)
+ in call 'erlang':'=:='
+ (_5, 'integers')
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_6, 'true')
+ -| ['compiler_generated'] )
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_8> =
+ call 'erlang':'element'
+ (3, _t)
+ in let <_9> =
+ call 'erlang':'element'
+ (4, _t)
+ in call 'erlang':'+'
+ (_8, _9)
+ <_10>
+ when try
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'error'
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end>
+ in case <_val> of
+ <65> when 'true' ->
+ _val
+ ( <_11> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_11}})
+ -| ['compiler_generated'] )
+ end
+ ( <_47> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_47})
+ -| [{'function_name',{'basic_andalso_orelse',1}}] )
+ -| ['compiler_generated'] )
+ end
+'basic-rt'/1 =
+ %% Line 1020
+ fun (_0) ->
+ case <_0> of
+ <_t>
+ when try
+ let <_5> =
+ let <_4> =
+ case call 'erlang':'is_tuple'
+ (_t) of
+ <'true'> when 'true' ->
+ case let <_1> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_1, 4) of
+ <'true'> when 'true' ->
+ case let <_2> =
+ call 'erlang':'element'
+ (1, _t)
+ in call 'erlang':'=:='
+ (_2, 'type') of
+ <'true'> when 'true' ->
+ let <_3> =
+ call 'erlang':'element'
+ (2, _t)
+ in call 'erlang':'=='
+ (_3, 'integers')
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_4, 'true')
+ -| ['compiler_generated'] )
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_6> =
+ call 'erlang':'element'
+ (3, _t)
+ in let <_7> =
+ call 'erlang':'element'
+ (4, _t)
+ in call 'erlang':'+'
+ (_6, _7)
+ <_t>
+ when try
+ let <_11> =
+ let <_10> =
+ case call 'erlang':'is_tuple'
+ (_t) of
+ <'true'> when 'true' ->
+ case let <_8> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_8, 2) of
+ <'true'> when 'true' ->
+ let <_9> =
+ call 'erlang':'element'
+ (1, _t)
+ in call 'erlang':'=:='
+ (_9, 'vector')
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_10, 'true')
+ -| ['compiler_generated'] )
+ in _11
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case <call 'erlang':'element'
+ (2, _t)> of
+ <{_x,_y}> when 'true' ->
+ case 1 of
+ <_12>
+ when try
+ let <_16> =
+ let <_15> =
+ let <_13> =
+ call 'erlang':'is_float'
+ (_x)
+ in let <_14> =
+ call 'erlang':'is_float'
+ (_y)
+ in call 'erlang':'and'
+ (_13, _14)
+ in ( call 'erlang':'=:='
+ (_15, 'true')
+ -| ['compiler_generated'] )
+ in _16
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_19> =
+ let <_17> =
+ call 'erlang':'*'
+ (_x, _x)
+ in let <_18> =
+ call 'erlang':'*'
+ (_y, _y)
+ in call 'erlang':'+'
+ (_17, _18)
+ in call 'math':'sqrt'
+ (_19)
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+ ( <_20> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_20}})
+ -| ['compiler_generated'] )
+ end
+ <['+',_a,_b]> when 'true' ->
+ let <_22> =
+ let <_21> =
+ call 'erlang':'+'
+ (_a, _b)
+ in apply 'id'/1
+ (_21)
+ in call 'erlang':'*'
+ (_22, 2)
+ <{_r1,_r2}>
+ when try
+ let <_28> =
+ let <_27> =
+ case let <_23> =
+ call 'erlang':'size'
+ (_r1)
+ in call 'erlang':'=:='
+ (_23, 3) of
+ <'true'> when 'true' ->
+ case let <_24> =
+ call 'erlang':'element'
+ (1, _r1)
+ in call 'erlang':'=:='
+ (_24, 'Set') of
+ <'true'> when 'true' ->
+ case let <_25> =
+ call 'erlang':'size'
+ (_r2)
+ in call 'erlang':'=:='
+ (_25, 3) of
+ <'true'> when 'true' ->
+ let <_26> =
+ call 'erlang':'element'
+ (1, _r2)
+ in call 'erlang':'=:='
+ (_26, 'Set')
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_27, 'true')
+ -| ['compiler_generated'] )
+ in _28
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_r1> =
+ <apply 'id'/1
+ (_r1)>
+ in let <_r2> =
+ <apply 'id'/1
+ (_r2)>
+ in _r1
+ <_t>
+ when try
+ let <_32> =
+ let <_31> =
+ case call 'erlang':'is_tuple'
+ (_t) of
+ <'true'> when 'true' ->
+ case let <_29> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_29, 2) of
+ <'true'> when 'true' ->
+ let <_30> =
+ call 'erlang':'element'
+ (1, _t)
+ in call 'erlang':'=:='
+ (_30, 'klurf')
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_31, 'true')
+ -| ['compiler_generated'] )
+ in _32
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_34> =
+ let <_33> =
+ call 'erlang':'element'
+ (2, _t)
+ in apply 'id'/1
+ (_33)
+ in call 'erlang':'*'
+ (3, _34)
+ <_35> when 'true' ->
+ 'error'
+ ( <_36> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_36})
+ -| [{'function_name',{'basic-rt',1}}] )
+ -| ['compiler_generated'] )
+ end
+'traverse_dcd'/1 =
+ %% Line 1043
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_l0> =
+ <[{'log_header','dcd_log',[49|[46|[48]]],'a','b','c'}|[{'log_header','dcd_log',[50|[46|[48]]],'a','b','c'}|[{'log_header','dcd_log',[48|[46|[48]]],'a','b','c'}|['blurf']]]]>
+ in case <apply 'traverse-dcd'/3
+ ({'cont',_l0}, 'log', 'funny')> of
+ <{'cont',[{'log_header','dcd_log',[48|[46|[48]]],'a','b','c'}|['blurf']],'log','funny'}> when 'true' ->
+ let <_l1> =
+ <[{'log_header','dcd_log',[49|[46|[48]]]}]>
+ in case <apply 'traverse-dcd'/3
+ ({'cont',_l1}, 'log', 'funny')> of
+ <{'cont',_l1,'log','funny'}> when 'true' ->
+ let <_l2> =
+ <[{'a','tuple'}]>
+ in case <apply 'traverse-dcd'/3
+ ({'cont',_l2}, 'log', 'funny')> of
+ <{'cont',_l2,'log','funny'}> when 'true' ->
+ 'ok'
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_3}})
+ -| ['compiler_generated'] )
+ end
+ ( <_4> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_4}})
+ -| ['compiler_generated'] )
+ end
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+ -| [{'function_name',{'traverse_dcd',1}}] )
+ -| ['compiler_generated'] )
+ end
+'traverse-dcd'/3 =
+ %% Line 1066
+ fun (_2,_1,_0) ->
+ case <_2,_1,_0> of
+ <{_cont,[_logh|_rest]},_log,_fun>
+ when try
+ let <_11> =
+ let <_6> =
+ case call 'erlang':'is_tuple'
+ (_logh) of
+ <'true'> when 'true' ->
+ case let <_3> =
+ call 'erlang':'tuple_size'
+ (_logh)
+ in call 'erlang':'=:='
+ (_3, 6) of
+ <'true'> when 'true' ->
+ case let <_4> =
+ call 'erlang':'element'
+ (1, _logh)
+ in call 'erlang':'=:='
+ (_4, 'log_header') of
+ <'true'> when 'true' ->
+ let <_5> =
+ call 'erlang':'element'
+ (2, _logh)
+ in call 'erlang':'=='
+ (_5, 'dcd_log')
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_6, 'true')
+ -| ['compiler_generated'] )
+ in let <_12> =
+ let <_10> =
+ case call 'erlang':'is_tuple'
+ (_logh) of
+ <'true'> when 'true' ->
+ case let <_7> =
+ call 'erlang':'tuple_size'
+ (_logh)
+ in call 'erlang':'=:='
+ (_7, 6) of
+ <'true'> when 'true' ->
+ case let <_8> =
+ call 'erlang':'element'
+ (1, _logh)
+ in call 'erlang':'=:='
+ (_8, 'log_header') of
+ <'true'> when 'true' ->
+ let <_9> =
+ call 'erlang':'element'
+ (3, _logh)
+ in call 'erlang':'>='
+ (_9, [49|[46|[48]]])
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in ( call 'erlang':'=:='
+ (_10, 'true')
+ -| ['compiler_generated'] )
+ in call 'erlang':'and'
+ (_11, _12)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ apply 'traverse-dcd'/3
+ ({_cont,_rest}, _log, _fun)
+ <{_cont,_recs},_log,_fun> when 'true' ->
+ {_cont,_recs,_log,_fun}
+ ( <_15,_14,_13> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_15,_14,_13})
+ -| [{'function_name',{'traverse-dcd',3}}] )
+ -| ['compiler_generated'] )
+ end
+'check_qlc_hrl'/1 =
+ %% Line 1078
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ let <_st> =
+ <{'r1','false','dum'}>
+ in do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['foo']]|[['cqlc'|[['quote'|['qlc']]|[['quote'|['q']]|[['quote'|[[{'lc',1,2,3}]]]|['st']]]]]]]]})
+ let <_val> =
+ <apply 'cqlc'/4
+ ('qlc', 'q', [{'lc',1,2,3}], _st)>
+ in case <_val> of
+ <'foo'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+ -| [{'function_name',{'check_qlc_hrl',1}}] )
+ -| ['compiler_generated'] )
+ end
+'cqlc'/4 =
+ %% Line 1094
+ fun (_m,_f,_as,_st) ->
+ let <_arity> =
+ <call 'erlang':'length'
+ (_as)>
+ in case _as of
+ <[{'lc',_0,_1,_2}|_3]>
+ when try
+ let <_11> =
+ call 'erlang':'=:='
+ (_m, 'qlc')
+ in let <_12> =
+ call 'erlang':'=:='
+ (_f, 'q')
+ in let <_13> =
+ call 'erlang':'<'
+ (_arity, 3)
+ in let <_14> =
+ let <_10> =
+ let <_8> =
+ case let <_4> =
+ call 'erlang':'element'
+ (1, _st)
+ in call 'erlang':'=:='
+ (_4, 'r1') of
+ <'true'> when 'true' ->
+ 'true'
+ <'false'> when 'true' ->
+ 'fail'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in let <_9> =
+ let <_6> =
+ let <_5> =
+ call 'erlang':'tuple_size'
+ (_st)
+ in call 'erlang':'=:='
+ (_5, 3)
+ in let <_7> =
+ call 'erlang':'element'
+ (2, _st)
+ in call 'erlang':'and'
+ (_6, _7)
+ in call 'erlang':'and'
+ (_8, _9)
+ in call 'erlang':'not'
+ (_10)
+ in let <_15> =
+ call 'erlang':'and'
+ (_11, _12)
+ in let <_16> =
+ call 'erlang':'and'
+ (_15, _13)
+ in call 'erlang':'and'
+ (_16, _14)
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'foo'
+ <_17> when 'true' ->
+ _st
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'andalso_semi'/1 =
+ %% Line 1106
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[['quote'|['ok']]|[['andalso-semi-foo'|[0]]]]]})
+ let <_val> =
+ <apply 'andalso-semi-foo'/1
+ (0)>
+ in case <_val> of
+ <'ok'> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_8> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_8})
+ -| [{'function_name',{'andalso_semi',1}}] )
+ -| ['compiler_generated'] )
+ end
+'andalso-semi-foo'/1 =
+ %% Line 1117
+ fun (_0) ->
+ case <_0> of
+ <_bar>
+ when try
+ let <_3> =
+ let <_1> =
+ case call 'erlang':'is_integer'
+ (_bar) of
+ <'true'> when 'true' ->
+ call 'erlang':'=:='
+ (_bar, 0)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in let <_2> =
+ call 'erlang':'=:='
+ (_bar, 1)
+ in call 'erlang':'or'
+ (_1, _2)
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_4> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_4})
+ -| [{'function_name',{'andalso-semi-foo',1}}] )
+ -| ['compiler_generated'] )
+ end
+'andalso-semi-bar'/1 =
+ %% Line 1121
+ fun (_0) ->
+ case <_0> of
+ <_bar>
+ when try
+ let <_4> =
+ let <_2> =
+ case call 'erlang':'is_list'
+ (_bar) of
+ <'true'> when 'true' ->
+ let <_1> =
+ call 'erlang':'length'
+ (_bar)
+ in call 'erlang':'=:='
+ (_1, 3)
+ <'false'> when 'true' ->
+ 'false'
+ ( <_omega> when 'true' ->
+ _omega
+ -| ['compiler_generated'] )
+ end
+ in let <_3> =
+ call 'erlang':'=:='
+ (_bar, 1)
+ in call 'erlang':'or'
+ (_2, _3)
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ ( <_5> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_5})
+ -| [{'function_name',{'andalso-semi-bar',1}}] )
+ -| ['compiler_generated'] )
+ end
+'t_tuple_size'/1 =
+ %% Line 1125
+ fun (_0) ->
+ case <_0> of
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat'|[10|[['do-tuple-size'|[{1,2,3,4}]]]]]})
+ let <_val> =
+ <apply 'do-tuple-size'/1
+ ({1,2,3,4})>
+ in case <_val> of
+ <10> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_7> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_7})
+ -| [{'function_name',{'t_tuple_size',1}}] )
+ -| ['compiler_generated'] )
+ end
+'do-tuple-size'/1 =
+ %% Line 1139
+ fun (_0) ->
+ case <_0> of
+ <_t>
+ when try
+ let <_2> =
+ let <_1> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_1, 4)
+ in _2
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ case <_t> of
+ <{_a,_b,_c,_d}> when 'true' ->
+ let <_lfe0> =
+ <_a>
+ in let <_lfe1> =
+ <_b>
+ in let <_lfe2> =
+ <_c>
+ in let <_lfe3> =
+ <_d>
+ in let <_4> =
+ let <_3> =
+ call 'erlang':'+'
+ (_lfe0, _lfe1)
+ in call 'erlang':'+'
+ (_3, _lfe2)
+ in call 'erlang':'+'
+ (_4, _lfe3)
+ ( <_5> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_5}})
+ -| ['compiler_generated'] )
+ end
+ ( <_6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_6})
+ -| [{'function_name',{'do-tuple-size',1}}] )
+ -| ['compiler_generated'] )
+ end
+'ludicrous-tuple-size'/1 =
+ %% Line 1144
+ fun (_0) ->
+ case <_0> of
+ <_t>
+ when try
+ let <_2> =
+ let <_1> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_1, 40652400101488115101757819767848575661943)
+ in _2
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_t>
+ when try
+ let <_4> =
+ let <_3> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_3, 18446744073709551616)
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_t>
+ when try
+ let <_8> =
+ let <_6> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in let <_7> =
+ let <_5> =
+ call 'erlang':'bsl'
+ (1, 64)
+ in call 'erlang':'-'
+ (_5, 1)
+ in call 'erlang':'=:='
+ (_6, _7)
+ in _8
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_t>
+ when try
+ let <_10> =
+ let <_9> =
+ call 'erlang':'tuple_size'
+ (_t)
+ in call 'erlang':'=:='
+ (_9, 18446744073709551615)
+ in _10
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_11> when 'true' ->
+ 'error'
+ ( <_12> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_12})
+ -| [{'function_name',{'ludicrous-tuple-size',1}}] )
+ -| ['compiler_generated'] )
+ end
+'mask-error'/1 =
+ %% Line 1152
+ fun (_0) ->
+ case <_0> of
+ <{'EXIT',{_err,_1}}> when 'true' ->
+ _err
+ <_else> when 'true' ->
+ _else
+ ( <_2> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_2})
+ -| [{'function_name',{'mask-error',1}}] )
+ -| ['compiler_generated'] )
+ end
+'binary_part'/1 =
+ %% Line 1156
+ fun (_0) ->
+ case <_0> of
+ <'doc'> when 'true' ->
+ [84|[101|[115|[116|[115|[32|[116|[104|[101|[32|[98|[105|[110|[97|[114|[121|[95|[112|[97|[114|[116|[47|[50|[44|[51|[32|[103|[117|[97|[114|[100|[32|[40|[71|[67|[41|[32|[98|[105|[102|[39|[115]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
+ <_config>
+ when try
+ let <_1> =
+ call 'erlang':'is_list'
+ (_config)
+ in _1
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ do call 'erlang':'put'
+ ('test_server_loc', {'lfe_guard_SUITE',['test-pat',1,['bp-test',#{#<1>(8,1,'integer',['unsigned'|['big']]),
+ #<2>(8,1,'integer',['unsigned'|['big']]),
+ #<3>(8,1,'integer',['unsigned'|['big']])}#]]})
+ let <_val> =
+ <apply 'bp-test'/1
+ (#{#<1>(8,1,'integer',['unsigned'|['big']]),
+ #<2>(8,1,'integer',['unsigned'|['big']]),
+ #<3>(8,1,'integer',['unsigned'|['big']])}#)>
+ in case <_val> of
+ <1> when 'true' ->
+ _val
+ ( <_2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',{_2}})
+ -| ['compiler_generated'] )
+ end
+ ( <_53> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_53})
+ -| [{'function_name',{'binary_part',1}}] )
+ -| ['compiler_generated'] )
+ end
+'bp-test'/1 =
+ %% Line 1225
+ fun (_0) ->
+ case <_0> of
+ <_b>
+ when try
+ let <_2> =
+ let <_1> =
+ call 'erlang':'length'
+ (_b)
+ in call 'erlang':'=:='
+ (_1, 137)
+ in _2
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b>
+ when try
+ let <_4> =
+ let <_3> =
+ call 'erlang':'binary_part'
+ (_b, {1,1})
+ in call 'erlang':'=:='
+ (_3, #{#<2>(8,1,'integer',['unsigned'|['big']])}#)
+ in _4
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b>
+ when try
+ let <_6> =
+ let <_5> =
+ call 'erlang':'binary_part'
+ (_b, 1, 1)
+ in call 'erlang':'=:='
+ (_5, #{#<1>(8,1,'integer',['unsigned'|['big']])}#)
+ in _6
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 2
+ <_b>
+ when try
+ let <_8> =
+ let <_7> =
+ call 'erlang':'binary_part'
+ (_b, {1,2})
+ in call 'erlang':'=:='
+ (_7, #{#<3>(8,1,'integer',['unsigned'|['big']]),
+ #<3>(8,1,'integer',['unsigned'|['big']])}#)
+ in _8
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 3
+ <_9> when 'true' ->
+ 'error'
+ ( <_10> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_10})
+ -| [{'function_name',{'bp-test',1}}] )
+ -| ['compiler_generated'] )
+ end
+'bp-test'/2 =
+ %% Line 1232
+ fun (_1,_0) ->
+ case <_1,_0> of
+ <_b,_a>
+ when try
+ let <_3> =
+ let <_2> =
+ call 'erlang':'length'
+ (_b)
+ in call 'erlang':'=:='
+ (_2, _a)
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a>
+ when try
+ let <_5> =
+ let <_4> =
+ call 'erlang':'binary_part'
+ (_b, {_a,1})
+ in call 'erlang':'=:='
+ (_4, #{#<2>(8,1,'integer',['unsigned'|['big']])}#)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a>
+ when try
+ let <_7> =
+ let <_6> =
+ call 'erlang':'binary_part'
+ (_b, _a, 1)
+ in call 'erlang':'=:='
+ (_6, #{#<1>(8,1,'integer',['unsigned'|['big']])}#)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 2
+ <_b,_a>
+ when try
+ let <_9> =
+ let <_8> =
+ call 'erlang':'binary_part'
+ (_b, {_a,2})
+ in call 'erlang':'=:='
+ (_8, #{#<3>(8,1,'integer',['unsigned'|['big']]),
+ #<3>(8,1,'integer',['unsigned'|['big']])}#)
+ in _9
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 3
+ <_10,_11> when 'true' ->
+ 'error'
+ ( <_13,_12> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_13,_12})
+ -| [{'function_name',{'bp-test',2}}] )
+ -| ['compiler_generated'] )
+ end
+'bp-test-x'/2 =
+ %% Line 1239
+ fun (_1,_0) ->
+ case <_1,_0> of
+ <_b,_a>
+ when try
+ let <_3> =
+ let <_2> =
+ call 'erlang':'length'
+ (_b)
+ in call 'erlang':'=:='
+ (_2, _a)
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a>
+ when try
+ let <_5> =
+ let <_4> =
+ call 'erlang':'binary_part'
+ (_b, _a)
+ in call 'erlang':'=:='
+ (_4, #{#<2>(8,1,'integer',['unsigned'|['big']])}#)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a>
+ when try
+ let <_7> =
+ let <_6> =
+ call 'erlang':'binary_part'
+ (_b, _a)
+ in call 'erlang':'=:='
+ (_6, #{#<1>(8,1,'integer',['unsigned'|['big']])}#)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 2
+ <_b,_a>
+ when try
+ let <_9> =
+ let <_8> =
+ call 'erlang':'binary_part'
+ (_b, _a)
+ in call 'erlang':'=:='
+ (_8, #{#<3>(8,1,'integer',['unsigned'|['big']]),
+ #<3>(8,1,'integer',['unsigned'|['big']])}#)
+ in _9
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 3
+ <_10,_11> when 'true' ->
+ 'error'
+ ( <_13,_12> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_13,_12})
+ -| [{'function_name',{'bp-test-x',2}}] )
+ -| ['compiler_generated'] )
+ end
+'bp-test-y'/2 =
+ %% Line 1246
+ fun (_1,_0) ->
+ case <_1,_0> of
+ <_b,_a>
+ when try
+ let <_3> =
+ let <_2> =
+ call 'erlang':'length'
+ (_b)
+ in call 'erlang':'=:='
+ (_2, _a)
+ in _3
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a>
+ when try
+ let <_5> =
+ let <_4> =
+ call 'erlang':'binary_part'
+ (_b, {1,_a})
+ in call 'erlang':'=:='
+ (_4, #{#<2>(8,1,'integer',['unsigned'|['big']])}#)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a>
+ when try
+ let <_7> =
+ let <_6> =
+ call 'erlang':'binary_part'
+ (_b, 1, _a)
+ in call 'erlang':'=:='
+ (_6, #{#<1>(8,1,'integer',['unsigned'|['big']])}#)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 2
+ <_b,_a>
+ when try
+ let <_9> =
+ let <_8> =
+ call 'erlang':'binary_part'
+ (_b, {1,_a})
+ in call 'erlang':'=:='
+ (_8, #{#<3>(8,1,'integer',['unsigned'|['big']]),
+ #<3>(8,1,'integer',['unsigned'|['big']])}#)
+ in _9
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 3
+ <_10,_11> when 'true' ->
+ 'error'
+ ( <_13,_12> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_13,_12})
+ -| [{'function_name',{'bp-test-y',2}}] )
+ -| ['compiler_generated'] )
+ end
+'bp-test'/3 =
+ %% Line 1253
+ fun (_2,_1,_0) ->
+ case <_2,_1,_0> of
+ <_b,_a,_3>
+ when try
+ let <_5> =
+ let <_4> =
+ call 'erlang':'length'
+ (_b)
+ in call 'erlang':'=:='
+ (_4, _a)
+ in _5
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a,_c>
+ when try
+ let <_7> =
+ let <_6> =
+ call 'erlang':'binary_part'
+ (_b, {_a,_c})
+ in call 'erlang':'=:='
+ (_6, #{#<2>(8,1,'integer',['unsigned'|['big']])}#)
+ in _7
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 1
+ <_b,_a,_c>
+ when try
+ let <_9> =
+ let <_8> =
+ call 'erlang':'binary_part'
+ (_b, _a, _c)
+ in call 'erlang':'=:='
+ (_8, #{#<1>(8,1,'integer',['unsigned'|['big']])}#)
+ in _9
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 2
+ <_b,_a,_c>
+ when try
+ let <_11> =
+ let <_10> =
+ call 'erlang':'binary_part'
+ (_b, {_a,_c})
+ in call 'erlang':'=:='
+ (_10, #{#<3>(8,1,'integer',['unsigned'|['big']]),
+ #<3>(8,1,'integer',['unsigned'|['big']])}#)
+ in _11
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 3
+ <_12,_13,_14> when 'true' ->
+ 'error'
+ ( <_17,_16,_15> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_17,_16,_15})
+ -| [{'function_name',{'bp-test',3}}] )
+ -| ['compiler_generated'] )
+ end
+'id'/1 =
+ %% Line 1262
+ fun (_i) ->
+ _i
+'check'/2 =
+ %% Line 1264
+ fun (_f,_result) ->
+ case apply _f
+ () of
+ <_r>
+ when try
+ let <_0> =
+ call 'erlang':'=:='
+ (_r, _result)
+ in _0
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ 'ok'
+ <_other> when 'true' ->
+ do call 'lfe_io':'format'
+ ([69|[120|[112|[101|[99|[116|[101|[100|[58|[32|[126|[112|[10]]]]]]]]]]]]], [_result])
+ do call 'lfe_io':'format'
+ ([32|[32|[32|[32|[32|[71|[111|[116|[58|[32|[126|[112|[10]]]]]]]]]]]]], [_other])
+ call 'test_server':'fail'
+ ()
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'fc'/1 =
+ %% Line 1272
+ fun (_0) ->
+ case <_0> of
+ <{'EXIT',{'function_clause'}}> when 'true' ->
+ 'ok'
+ <{'EXIT',{{'case_clause',_1},_2}}> when 'true' ->
+ 'ok'
+ ( <_3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_3})
+ -| [{'function_name',{'fc',1}}] )
+ -| ['compiler_generated'] )
+ end
+'$handle_undefined_function'/2 =
+ %% Line 29
+ fun (_f,_as) ->
+ case let <_0> =
+ call 'lfe_env':'new'
+ ()
+ in apply 'LFE-EXPAND-EXPORTED-MACRO'/3
+ (_f, _as, _0) of
+ <{'yes',_exp}> when 'true' ->
+ call 'lfe_eval':'expr'
+ (_exp)
+ <'no'> when 'true' ->
+ let <_a,_b> =
+ <_f,_as>
+ in call 'error_handler':'raise_undef_exception'
+ ('lfe_guard_SUITE', _a, _b)
+ ( <_omega> when 'true' ->
+ primop 'match_fail'
+ ({'case_clause',_omega})
+ -| ['compiler_generated'] )
+ end
+'LFE-EXPAND-EXPORTED-MACRO'/3 =
+ %% Line 29
+ fun (_2,_1,_0) ->
+ 'no'
+'module_info'/0 =
+ fun () ->
+ call 'erlang':'get_module_info'
+ ('lfe_guard_SUITE')
+'module_info'/1 =
+ fun (_x) ->
+ call 'erlang':'get_module_info'
+ ('lfe_guard_SUITE', _x)
+end
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index 36e82c1459..3e0ab78390 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -36,7 +36,7 @@
t_guard_fun/1,
t_list_comprehension/1,
t_map_sort_literals/1,
- t_map_size/1,
+ t_map_size/1, t_map_get/1,
t_build_and_match_aliasing/1,
t_is_map/1,
@@ -67,14 +67,15 @@
%% errors in 18
t_register_corruption/1,
- t_bad_update/1
+ t_bad_update/1,
+ %% new in OTP 21
+ t_reused_key_variable/1
]).
suite() -> [].
all() ->
- test_lib:recompile(?MODULE),
[
%% literals
t_build_and_match_literals, t_build_and_match_literals_large,
@@ -89,7 +90,7 @@ all() ->
t_guard_receive, t_guard_receive_large,
t_guard_fun, t_list_comprehension,
t_map_sort_literals,
- t_map_size,
+ t_map_size, t_map_get,
t_build_and_match_aliasing,
t_is_map,
@@ -120,13 +121,20 @@ all() ->
%% errors in 18
t_register_corruption,
- t_bad_update
+ t_bad_update,
+
+ %% new in OTP 21
+ t_reused_key_variable
].
groups() -> [].
-init_per_suite(Config) -> Config.
-end_per_suite(_Config) -> ok.
+init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
init_per_group(_GroupName, Config) -> Config.
end_per_group(_GroupName, Config) -> Config.
@@ -686,6 +694,32 @@ t_map_size(Config) when is_list(Config) ->
map_is_size(M,N) when map_size(M) =:= N -> true;
map_is_size(_,_) -> false.
+t_map_get(Config) when is_list(Config) ->
+ 1 = map_get(a, id(#{a=>1})),
+
+ {'EXIT',{{badkey,a},_}} = (catch map_get(a, #{})),
+ {'EXIT',{{badkey,a},_}} = (catch map_get(a, #{b=>1})),
+
+ M = #{"a"=>1, "b" => 2},
+ true = check_map_value(M, "a", 1),
+ false = check_map_value(M, "b", 1),
+ true = check_map_value(M#{"c"=>2}, "c", 2),
+ false = check_map_value(M#{"a"=>5}, "a", 1),
+
+ {'EXIT',{{badmap,[]},_}} = (catch map_get(a, [])),
+ {'EXIT',{{badmap,<<1,2,3>>},_}} = (catch map_get(a, <<1,2,3>>)),
+ {'EXIT',{{badmap,1},_}} = (catch map_get(a, 1)),
+
+ %% Test that beam_validator understands that NewMap is
+ %% a map after seeing map_get(a, NewMap).
+ NewMap = id(#{a=>b}),
+ b = map_get(a, NewMap),
+ #{a:=z} = NewMap#{a:=z},
+ ok.
+
+check_map_value(Map, Key, Value) when map_get(Key, Map) =:= Value -> true;
+check_map_value(_, _, _) -> false.
+
t_is_map(Config) when is_list(Config) ->
true = is_map(#{}),
true = is_map(#{a=>1}),
@@ -695,8 +729,28 @@ t_is_map(Config) when is_list(Config) ->
if is_map(#{b=>1}) -> ok end,
if not is_map([1,2,3]) -> ok end,
if not is_map(x) -> ok end,
+
+ ok = do_t_is_map(map, #{}),
+ error = do_t_is_map(map, {a,b,c}),
+ ok = do_t_is_map(number, 42),
+ ok = do_t_is_map(number, 42.0),
+ error = do_t_is_map(number, {a,b,c}),
ok.
+do_t_is_map(What, X) ->
+ B = case What of
+ map ->
+ %% Cover conversion of is_map/1 BIF to test instruction
+ %% in beam_utils:bif_to_test/3.
+ is_map(X);
+ number ->
+ is_number(X)
+ end,
+ case B of
+ true -> ok;
+ false -> error
+ end.
+
% test map updates without matching
t_update_literals(Config) when is_list(Config) ->
Map = #{x=>1,y=>2,z=>3,q=>4},
@@ -1158,12 +1212,84 @@ t_guard_bifs(Config) when is_list(Config) ->
true = map_guard_empty_2(),
true = map_guard_head(#{a=>1}),
false = map_guard_head([]),
+
+ true = map_get_head(#{a=>1}),
+ false = map_get_head(#{}),
+ false = map_get_head([]),
+
+ true = map_get_head_not(#{a=>false}),
+ false = map_get_head_not(#{a=>true}),
+ false = map_get_head(#{}),
+ false = map_get_head([]),
+
+ true = map_is_key_head(#{a=>1}),
+ false = map_is_key_head(#{}),
+ false = map_is_key_head(not_a_map),
+
+ false = map_is_key_head_not(#{a=>1}),
+ true = map_is_key_head_not(#{b=>1}),
+ true = map_is_key_head_not(#{}),
+ false = map_is_key_head_not(not_a_map),
+
true = map_guard_body(#{a=>1}),
false = map_guard_body({}),
true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }),
false = map_guard_pattern("list"),
true = map_guard_tautology(),
true = map_guard_ill_map_size(),
+ true = map_field_check_sequence(#{a=>1}),
+ false = map_field_check_sequence(#{}),
+
+ %% The guard BIFs used in a body.
+
+ v = map_get(a, id(#{a=>v})),
+ {'EXIT',{{badkey,a},_}} =
+ (catch map_get(a, id(#{}))),
+ {'EXIT',{{badmap,not_a_map},_}} =
+ (catch map_get(a, id(not_a_map))),
+
+ true = is_map_key(a, id(#{a=>1})),
+ false = is_map_key(b, id(#{a=>1})),
+ false = is_map_key(b, id(#{})),
+ {'EXIT',{{badmap,not_a_map},_}} =
+ (catch is_map_key(b, id(not_a_map))),
+
+ {true,v} = erl_699(#{k=>v}),
+ {'EXIT',{{badkey,k},_}} = (catch erl_699(#{})),
+ {'EXIT',{{badmap,not_a_map},_}} = (catch erl_699(not_a_map)),
+
+ %% Cover optimizations in beam_dead.
+
+ ok = beam_dead_1(#{a=>any,k=>true}),
+ error = beam_dead_1(#{a=>any,k=>false}),
+ error = beam_dead_1(#{a=>any}),
+ error = beam_dead_1(#{}),
+
+ ok = beam_dead_2(#{a=>any,k=>true}),
+ error = beam_dead_2(#{a=>any,k=>false}),
+ error = beam_dead_2(#{a=>any}),
+ error = beam_dead_2(#{}),
+
+ ok = beam_dead_3(#{k=>true}),
+ error = beam_dead_3(#{k=>false}),
+ error = beam_dead_3(#{}),
+
+ ok = beam_dead_4(#{k=>true}),
+ error = beam_dead_4(#{k=>false}),
+ error = beam_dead_4(#{}),
+ error = beam_dead_4(not_a_map),
+
+ ok = beam_dead_5(#{k=>true}),
+ error = beam_dead_5(#{k=>false}),
+ error = beam_dead_3(#{}),
+
+ %% Test is_map_key/2 followed by map update.
+
+ Used0 = map_usage(var, #{other=>value}),
+ Used0 = #{other=>value,var=>dead},
+ Used1 = map_usage(var, #{var=>live}),
+ Used1 = #{var=>live},
+
ok.
map_guard_empty() when is_map(#{}); false -> true.
@@ -1173,6 +1299,18 @@ map_guard_empty_2() when true; #{} andalso false -> true.
map_guard_head(M) when is_map(M) -> true;
map_guard_head(_) -> false.
+map_get_head(M) when map_get(a, M) =:= 1 -> true;
+map_get_head(_) -> false.
+
+map_get_head_not(M) when not map_get(a, M) -> true;
+map_get_head_not(_) -> false.
+
+map_is_key_head(M) when is_map_key(a, M) -> true;
+map_is_key_head(_) -> false.
+
+map_is_key_head_not(M) when not is_map_key(a, M) -> true;
+map_is_key_head_not(_) -> false.
+
map_guard_body(M) -> is_map(M).
map_guard_pattern(#{}) -> true;
@@ -1182,6 +1320,58 @@ map_guard_tautology() when #{} =:= #{}; true -> true.
map_guard_ill_map_size() when true; map_size(0) -> true.
+map_field_check_sequence(M)
+ when is_map(M) andalso is_map_key(a, M) andalso (map_get(a, M) == 1) ->
+ true;
+map_field_check_sequence(_) ->
+ false.
+
+erl_699(M) ->
+ %% Used to cause an internal consistency failure.
+ {is_map_key(k, M),maps:get(k, M)}.
+
+beam_dead_1(#{a:=_,k:=_}=M) when map_get(k, M) ->
+ ok;
+beam_dead_1(#{}) ->
+ error.
+
+beam_dead_2(M) ->
+ case M of
+ #{a:=_,k:=_} when map_get(k, M) ->
+ ok;
+ #{} ->
+ error
+ end.
+
+beam_dead_3(M) ->
+ case M of
+ #{k:=_} when map_get(k, M) ->
+ ok;
+ #{} ->
+ error
+ end.
+
+beam_dead_4(M) ->
+ case M of
+ #{} when map_get(k, M) ->
+ ok;
+ _ ->
+ error
+ end.
+
+beam_dead_5(#{}=M) when map_get(k, M) ->
+ ok;
+beam_dead_5(#{}) ->
+ error.
+
+%% Test is_map_key/2, followed by an update of the map.
+map_usage(Def, Used) ->
+ case is_map_key(Def, Used) of
+ true -> Used;
+ false -> Used#{Def=>dead}
+ end.
+
+
t_guard_sequence(Config) when is_list(Config) ->
{1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}),
{2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}),
@@ -1559,7 +1749,6 @@ t_warn_pair_key_overloaded(Config) when is_list(Config) ->
"hi2" => lists:subtract([1,2],[1]),
"hi3" => +3,
"hi1" => erlang:min(1,2),
- "hi1" => erlang:hash({1,2},35),
"hi1" => erlang:phash({1,2},33),
"hi1" => erlang:phash2({1,2},34),
"hi1" => erlang:integer_to_binary(1337),
@@ -1961,6 +2150,16 @@ properly(Item) ->
increase(Allows) ->
catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}.
+t_reused_key_variable(Config) when is_list(Config) ->
+ Key = id(key),
+ Map1 = id(#{Key=>Config}),
+ Map2 = id(#{Key=>Config}),
+ case {Map1,Map2} of
+ %% core_lint treated Key as pattern variables, not input variables,
+ %% and complained about the variable being duplicated.
+ {#{Key:=Same},#{Key:=Same}} ->
+ ok
+ end.
%% aux
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 127679ba69..e3f842b668 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,27 +23,28 @@
init_per_group/2,end_per_group/2,
pmatch/1,mixed/1,aliases/1,non_matching_aliases/1,
match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1,
- selectify/1,underscore/1,match_map/1,map_vars_used/1,
- coverage/1,grab_bag/1,literal_binary/1]).
+ selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1,
+ coverage/1,grab_bag/1,literal_binary/1,
+ unary_op/1]).
-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
[{p,[parallel],
[pmatch,mixed,aliases,non_matching_aliases,
match_in_call,untuplify,
- shortcut_boolean,letify_guard,selectify,
+ shortcut_boolean,letify_guard,selectify,deselectify,
underscore,match_map,map_vars_used,coverage,
- grab_bag,literal_binary]}].
+ grab_bag,literal_binary,unary_op]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -466,6 +467,66 @@ sel_same_value2(V) when V =:= 42; V =:= 43 ->
sel_same_value2(_) ->
error.
+%% Test deconstruction of select_val instructions in beam_peep into
+%% regular tests with just one possible value left. Hitting proper cases
+%% in beam_peep relies on unification of labels by beam_jump.
+
+deselectify(Config) when is_list(Config) ->
+ one_or_other = desel_tuple_arity({1}),
+ two = desel_tuple_arity({1,1}),
+ one_or_other = desel_tuple_arity({1,1,1}),
+
+ one_or_other = dsel_integer(1),
+ two = dsel_integer(2),
+ one_or_other = dsel_integer(3),
+
+ one_or_other = dsel_integer_typecheck(1),
+ two = dsel_integer_typecheck(2),
+ one_or_other = dsel_integer_typecheck(3),
+
+ one_or_other = dsel_atom(one),
+ two = dsel_atom(two),
+ one_or_other = dsel_atom(three),
+
+ one_or_other = dsel_atom_typecheck(one),
+ two = dsel_atom_typecheck(two),
+ one_or_other = dsel_atom_typecheck(three).
+
+desel_tuple_arity(Tuple) when is_tuple(Tuple) ->
+ case Tuple of
+ {_} -> one_or_other;
+ {_,_} -> two;
+ _ -> one_or_other
+ end.
+
+dsel_integer(Val) ->
+ case Val of
+ 1 -> one_or_other;
+ 2 -> two;
+ _ -> one_or_other
+ end.
+
+dsel_integer_typecheck(Val) when is_integer(Val) ->
+ case Val of
+ 1 -> one_or_other;
+ 2 -> two;
+ _ -> one_or_other
+ end.
+
+dsel_atom(Val) ->
+ case Val of
+ one -> one_or_other;
+ two -> two;
+ _ -> one_or_other
+ end.
+
+dsel_atom_typecheck(Val) when is_atom(Val) ->
+ case Val of
+ one -> one_or_other;
+ two -> two;
+ _ -> one_or_other
+ end.
+
underscore(Config) when is_list(Config) ->
case Config of
[] ->
@@ -557,6 +618,10 @@ grab_bag(_Config) ->
{bad,16#555555555555555555555555555555555555555555555555555}],
ok = grab_bag_remove_failure(L, unit, 0),
+ {42,<<43,44>>} = grab_bag_single_valued(<<42,43,44>>),
+ empty_list = grab_bag_single_valued([]),
+ empty_tuple = grab_bag_single_valued({}),
+
ok.
grab_bag_remove_failure([], _Unit, _MaxFailure) ->
@@ -574,9 +639,23 @@ grab_bag_remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) ->
ok
end.
+%% Cover a line v3_kernel that places binary matching first.
+grab_bag_single_valued(<<H,T/bytes>>) -> {H,T};
+grab_bag_single_valued([]) -> empty_list;
+grab_bag_single_valued({}) -> empty_tuple.
+
+
%% Regression in 19.0, reported by Alexei Sholik
literal_binary(_Config) ->
- 3 = literal_binary_match(bar,<<"y">>),
+ 3 = literal_binary_match(bar, <<"y">>),
+
+ %% While we are at it, also test the remaining code paths
+ %% in literal_binary_match/2.
+ 1 = literal_binary_match(bar, <<"x">>),
+ 2 = literal_binary_match(foo, <<"x">>),
+ 3 = literal_binary_match(foo, <<"y">>),
+ fail = literal_binary_match(bar, <<"z">>),
+ fail = literal_binary_match(foo, <<"z">>),
ok.
literal_binary_match(bar, <<"x">>) -> 1;
@@ -584,5 +663,74 @@ literal_binary_match(_, <<"x">>) -> 2;
literal_binary_match(_, <<"y">>) -> 3;
literal_binary_match(_, _) -> fail.
+unary_op(Config) ->
+ %% ERL-514. This test case only verifies that the code
+ %% calculates the correct result, not that the generated
+ %% code is optimial.
+
+ {non_associative,30} = unary_op_1('&'),
+ {non_associative,300} = unary_op_1('^'),
+ {non_associative,300} = unary_op_1('not'),
+ {non_associative,300} = unary_op_1('+'),
+ {non_associative,300} = unary_op_1('-'),
+ {non_associative,300} = unary_op_1('~~~'),
+ {non_associative,300} = unary_op_1('!'),
+ {non_associative,320} = unary_op_1('@'),
+
+ error = unary_op_1(Config),
+ error = unary_op_1(abc),
+ error = unary_op_1(42),
+
+ ok.
+
+unary_op_1(Vop@1) ->
+ %% If all optimizations are working as they should, there should
+ %% be no stack frame and all '=:=' tests should be coalesced into
+ %% a single select_val instruction.
+
+ case Vop@1 =:= '&' of
+ true ->
+ {non_associative,30};
+ false ->
+ case
+ case Vop@1 =:= '^' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= 'not' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= '+' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= '-' of
+ true ->
+ true;
+ false ->
+ case Vop@1 =:= '~~~' of
+ true ->
+ true;
+ false ->
+ Vop@1 =:= '!'
+ end
+ end
+ end
+ end
+ end
+ of
+ true ->
+ {non_associative,300};
+ false ->
+ case Vop@1 =:= '@' of
+ true ->
+ {non_associative,320};
+ false ->
+ error
+ end
+ end
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index f543f0d4de..a1d931b994 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -61,7 +61,6 @@ suite() ->
-spec all() -> misc_SUITE_test_cases().
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -70,6 +69,7 @@ groups() ->
confused_literals,integer_encoding,override_bif]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -161,15 +161,17 @@ md5_1(Beam) ->
%% Cover some code that handles internal errors.
silly_coverage(Config) when is_list(Config) ->
- %% sys_core_fold, sys_core_setel, v3_kernel
+ %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel
BadCoreErlang = {c_module,[],
name,[],[],
[{{c_var,[],{foo,2}},seriously_bad_body}]},
expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end),
+ expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end),
+ expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),
expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end),
- %% v3_life
+ %% v3_codegen
BadKernel = {k_mdef,[],?MODULE,
[{foo,0}],
[],
@@ -177,11 +179,7 @@ silly_coverage(Config) when is_list(Config) ->
{k,[],[],[]},
f,0,[],
seriously_bad_body}]},
- expect_error(fun() -> v3_life:module(BadKernel, []) end),
-
- %% v3_codegen
- CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]},
- expect_error(fun() -> v3_codegen:module(CodegenInput, []) end),
+ expect_error(fun() -> v3_codegen:module(BadKernel, []) end),
%% beam_a
BeamAInput = {?MODULE,[{foo,0}],[],
@@ -229,14 +227,6 @@ silly_coverage(Config) when is_list(Config) ->
{label,2}|non_proper_list]}],99},
expect_error(fun() -> beam_except:module(ExceptInput, []) end),
- %% beam_bool
- BoolInput = {?MODULE,[{foo,0}],[],
- [{function,foo,0,2,
- [{label,1},
- {func_info,{atom,?MODULE},{atom,foo},0},
- {label,2}|non_proper_list]}],99},
- expect_error(fun() -> beam_bool:module(BoolInput, []) end),
-
%% beam_dead. This is tricky. Our function must look OK to
%% beam_utils:clean_labels/1, but must crash beam_dead.
DeadInput = {?MODULE,[{foo,0}],[],
@@ -288,6 +278,23 @@ silly_coverage(Config) when is_list(Config) ->
{block,[a|b]}]}],0},
expect_error(fun() -> beam_receive:module(ReceiveInput, []) end),
+ %% beam_record.
+ RecordInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,1,2,
+ [{label,1},
+ {func_info,{atom,?MODULE},{atom,foo},1},
+ {label,2},
+ {test,is_tuple,{f,1},[{x,0}]},
+ {test,test_arity,{f,1},[{x,0},3]},
+ {block,[{set,[{x,1}],[{x,0}],{get_tuple_element,0}}]},
+ {test,is_eq_exact,{f,1},[{x,1},{atom,bar}]},
+ {block,[{set,[{x,2}],[{x,0}],{get_tuple_element,1}}|a]},
+ {test,is_eq_exact,{f,1},[{x,2},{integer,1}]},
+ {block,[{set,[{x,0}],[{atom,ok}],move}]},
+ return]}],0},
+
+ expect_error(fun() -> beam_record:module(RecordInput, []) end),
+
BeamZInput = {?MODULE,[{foo,0}],[],
[{function,foo,0,2,
[{label,1},
@@ -311,8 +318,7 @@ expect_error(Fun) ->
io:format("~p", [Any]),
ct:fail(call_was_supposed_to_fail)
catch
- Class:Reason ->
- Stk = erlang:get_stacktrace(),
+ Class:Reason:Stk ->
io:format("~p:~p\n~p\n", [Class,Reason,Stk]),
case {Class,Reason} of
{error,undef} ->
@@ -353,9 +359,7 @@ integer_encoding_1(Config) ->
io:put_chars(Src, "t(Last) ->[\n"),
io:put_chars(Data, "[\n"),
- do_integer_encoding(-(id(1) bsl 10000), Src, Data),
- do_integer_encoding(id(1) bsl 10000, Src, Data),
- do_integer_encoding(1024, 0, Src, Data),
+ do_integer_encoding(137, 0, Src, Data),
_ = [begin
B = 1 bsl I,
do_integer_encoding(-B-1, Src, Data),
@@ -364,7 +368,7 @@ integer_encoding_1(Config) ->
do_integer_encoding(B-1, Src, Data),
do_integer_encoding(B, Src, Data),
do_integer_encoding(B+1, Src, Data)
- end || I <- lists:seq(1, 128)],
+ end || I <- lists:seq(1, 130)],
io:put_chars(Src, "Last].\n\n"),
ok = file:close(Src),
io:put_chars(Data, "0].\n\n"),
@@ -378,8 +382,6 @@ integer_encoding_1(Config) ->
%% Compare lists.
List = Mod:t(0),
{ok,[List]} = file:consult(DataFile),
- OneBsl10000 = id(1) bsl 10000,
- [-(1 bsl 10000),OneBsl10000|_] = List,
%% Cleanup.
file:delete(SrcFile),
@@ -398,7 +400,3 @@ do_integer_encoding(I, Src, Data) ->
Str = integer_to_list(I),
io:put_chars(Src, [Str,",\n"]),
io:put_chars(Data, [Str,",\n"]).
-
-
-id(I) -> I.
-
diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl
deleted file mode 100644
index 7eac90bac3..0000000000
--- a/lib/compiler/test/num_bif_SUITE.erl
+++ /dev/null
@@ -1,285 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(num_bif_SUITE).
-
--include_lib("common_test/include/ct.hrl").
-
-%% Tests optimization of the BIFs:
-%% abs/1
-%% float/1
-%% float_to_list/1
-%% integer_to_list/1
-%% list_to_float/1
-%% list_to_integer/1
-%% round/1
-%% trunc/1
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, t_abs/1, t_float/1,
- t_float_to_list/1, t_integer_to_list/1,
- t_list_to_integer/1,
- t_list_to_float_safe/1, t_list_to_float_risky/1,
- t_round/1, t_trunc/1]).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- test_lib:recompile(?MODULE),
- [t_abs, t_float, t_float_to_list, t_integer_to_list,
- {group, t_list_to_float}, t_list_to_integer, t_round,
- t_trunc].
-
-groups() ->
- [{t_list_to_float, [],
- [t_list_to_float_safe, t_list_to_float_risky]}].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-t_abs(Config) when is_list(Config) ->
- %% Floats.
- 5.5 = abs(5.5),
- 0.0 = abs(0.0),
- 100.0 = abs(-100.0),
-
- %% Integers.
- 5 = abs(5),
- 0 = abs(0),
- 100 = abs(-100),
-
- %% The largest smallnum. OTP-3190.
- X = (1 bsl 27) - 1,
- X = abs(X),
- X = abs(X-1)+1,
- X = abs(X+1)-1,
- X = abs(-X),
- X = abs(-X-1)-1,
- X = abs(-X+1)+1,
-
- %% Bignums.
- BigNum = 13984792374983749,
- BigNum = abs(BigNum),
- BigNum = abs(-BigNum),
- ok.
-
-t_float(Config) when is_list(Config) ->
- 0.0 = float(0),
- 2.5 = float(2.5),
- 0.0 = float(0.0),
- -100.55 = float(-100.55),
- 42.0 = float(42),
- -100.0 = float(-100),
-
- %% Bignums.
- 4294967305.0 = float(4294967305),
- -4294967305.0 = float(-4294967305),
-
- %% Extremly big bignums.
- Big = list_to_integer(lists:duplicate(2000, $1)),
- {'EXIT', {badarg, _}} = (catch float(Big)),
-
- %% Invalid types and lists.
- {'EXIT', {badarg, _}} = (catch list_to_integer(atom)),
- {'EXIT', {badarg, _}} = (catch list_to_integer(123)),
- {'EXIT', {badarg, _}} = (catch list_to_integer([$1, [$2]])),
- {'EXIT', {badarg, _}} = (catch list_to_integer("1.2")),
- {'EXIT', {badarg, _}} = (catch list_to_integer("a")),
- {'EXIT', {badarg, _}} = (catch list_to_integer("")),
- ok.
-
-
-%% Tests float_to_list/1.
-
-t_float_to_list(Config) when is_list(Config) ->
- test_ftl("0.0e+0", 0.0),
- test_ftl("2.5e+1", 25.0),
- test_ftl("2.5e+0", 2.5),
- test_ftl("2.5e-1", 0.25),
- test_ftl("-3.5e+17", -350.0e15),
- ok.
-
-test_ftl(Expect, Float) ->
- %% No on the next line -- we want the line number from t_float_to_list.
- Expect = remove_zeros(lists:reverse(float_to_list(Float)), []).
-
-%% Removes any non-significant zeros in a floating point number.
-%% Example: 2.500000e+01 -> 2.5e+1
-
-remove_zeros([$+, $e|Rest], [$0, X|Result]) ->
- remove_zeros([$+, $e|Rest], [X|Result]);
-remove_zeros([$-, $e|Rest], [$0, X|Result]) ->
- remove_zeros([$-, $e|Rest], [X|Result]);
-remove_zeros([$0, $.|Rest], [$e|Result]) ->
- remove_zeros(Rest, [$., $0, $e|Result]);
-remove_zeros([$0|Rest], [$e|Result]) ->
- remove_zeros(Rest, [$e|Result]);
-remove_zeros([Char|Rest], Result) ->
- remove_zeros(Rest, [Char|Result]);
-remove_zeros([], Result) ->
- Result.
-
-%% Tests integer_to_list/1.
-
-t_integer_to_list(Config) when is_list(Config) ->
- "0" = integer_to_list(0),
- "42" = integer_to_list(42),
- "-42" = integer_to_list(-42),
- "-42" = integer_to_list(-42),
- "32768" = integer_to_list(32768),
- "268435455" = integer_to_list(268435455),
- "-268435455" = integer_to_list(-268435455),
- "123456932798748738738" = integer_to_list(123456932798748738738),
- Big_List = lists:duplicate(2000, $1),
- Big = list_to_integer(Big_List),
- Big_List = integer_to_list(Big),
- ok.
-
-%% Tests list_to_float/1.
-
-
-t_list_to_float_safe(Config) when is_list(Config) ->
- 0.0 = list_to_float("0.0"),
- 0.0 = list_to_float("-0.0"),
- 0.5 = list_to_float("0.5"),
- -0.5 = list_to_float("-0.5"),
- 100.0 = list_to_float("1.0e2"),
- 127.5 = list_to_float("127.5"),
- -199.5 = list_to_float("-199.5"),
-
- {'EXIT', {badarg, _}} = (catch list_to_float("0")),
- {'EXIT', {badarg, _}} = (catch list_to_float("0..0")),
- {'EXIT', {badarg, _}} = (catch list_to_float("0e12")),
- {'EXIT', {badarg, _}} = (catch list_to_float("--0.0")),
-%% {'EXIT', {badarg, _}} = (catch list_to_float("0.0e+99999999")),
-
- ok.
-
-%% This might crash the emulator...
-%% (Known to crash the Unix version of Erlang 4.4.1)
-
-t_list_to_float_risky(Config) when is_list(Config) ->
- Many_Ones = lists:duplicate(25000, $1),
- _ = list_to_float("2."++Many_Ones),
- {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)),
- ok.
-
-%% Tests list_to_integer/1.
-
-t_list_to_integer(Config) when is_list(Config) ->
- 0 = list_to_integer("0"),
- 0 = list_to_integer("00"),
- 0 = list_to_integer("-0"),
- 1 = list_to_integer("1"),
- -1 = list_to_integer("-1"),
- 42 = list_to_integer("42"),
- -12 = list_to_integer("-12"),
- 32768 = list_to_integer("32768"),
- 268435455 = list_to_integer("268435455"),
- -268435455 = list_to_integer("-268435455"),
-
- %% Bignums.
- 123456932798748738738 = list_to_integer("123456932798748738738"),
- _ = list_to_integer(lists:duplicate(2000, $1)),
- ok.
-
-%% Tests round/1.
-
-t_round(Config) when is_list(Config) ->
- 0 = round(0.0),
- 0 = round(0.4),
- 1 = round(0.5),
- 0 = round(-0.4),
- -1 = round(-0.5),
- 255 = round(255.3),
- 256 = round(255.6),
- -1033 = round(-1033.3),
- -1034 = round(-1033.6),
-
- % OTP-3722:
- X = (1 bsl 27) - 1,
- MX = -X,
- MXm1 = -X-1,
- MXp1 = -X+1,
- F = X + 0.0,
- X = round(F),
- X = round(F+1)-1,
- X = round(F-1)+1,
- MX = round(-F),
- MXm1 = round(-F-1),
- MXp1 = round(-F+1),
-
- X = round(F+0.1),
- X = round(F+1+0.1)-1,
- X = round(F-1+0.1)+1,
- MX = round(-F+0.1),
- MXm1 = round(-F-1+0.1),
- MXp1 = round(-F+1+0.1),
-
- X = round(F-0.1),
- X = round(F+1-0.1)-1,
- X = round(F-1-0.1)+1,
- MX = round(-F-0.1),
- MXm1 = round(-F-1-0.1),
- MXp1 = round(-F+1-0.1),
-
- 0.5 = abs(round(F+0.5)-(F+0.5)),
- 0.5 = abs(round(F-0.5)-(F-0.5)),
- 0.5 = abs(round(-F-0.5)-(-F-0.5)),
- 0.5 = abs(round(-F+0.5)-(-F+0.5)),
-
- %% Bignums.
- 4294967296 = round(4294967296.1),
- 4294967297 = round(4294967296.9),
- -4294967296 = -round(4294967296.1),
- -4294967297 = -round(4294967296.9),
- ok.
-
-t_trunc(Config) when is_list(Config) ->
- 0 = trunc(0.0),
- 5 = trunc(5.3333),
- -10 = trunc(-10.978987),
- % The largest smallnum, converted to float (OTP-3722):
- X = (1 bsl 27) - 1,
- F = X + 0.0,
- io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n",
- [X, X, binary_to_list(term_to_binary(X)),
- F, F, binary_to_list(term_to_binary(F)),
- trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]),
- X = trunc(F),
- X = trunc(F+1)-1,
- X = trunc(F-1)+1,
- X = -trunc(-F),
- X = -trunc(-F-1)-1,
- X = -trunc(-F+1)+1,
-
- %% Bignums.
- 4294967305 = trunc(4294967305.7),
- -4294967305 = trunc(-4294967305.7),
- ok.
diff --git a/lib/compiler/test/overridden_bif_SUITE.erl b/lib/compiler/test/overridden_bif_SUITE.erl
new file mode 100644
index 0000000000..6b8a9591c9
--- /dev/null
+++ b/lib/compiler/test/overridden_bif_SUITE.erl
@@ -0,0 +1,101 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(overridden_bif_SUITE).
+-compile({no_auto_import,[is_reference/1,size/1]}).
+
+-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,
+ overridden_bif/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+%% Used by overridden_bif/1.
+-import(gb_sets, [size/1]).
+-import(test_lib, [binary/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,1}}].
+
+all() ->
+ [{group,p}].
+
+groups() ->
+ [{p,test_lib:parallel(),
+ [overridden_bif
+ ]}].
+
+init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+ Config.
+
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+ ok.
+
+overridden_bif(_Config) ->
+ L = [-3,-2,-1,0,1,2,3,4],
+ [-3,0,3] = do_overridden_bif_1(L),
+ [-2,0,2,4] = do_overridden_bif_2(L),
+ [3] = do_overridden_bif_3(L),
+ [2,4] = do_overridden_bif_4(L),
+
+ Set = gb_sets:from_list(L),
+ [Set] = do_overridden_bif_5([gb_sets:singleton(42),Set]),
+
+ [100,0] = do_overridden_bif_6([100|L]),
+ ok.
+
+do_overridden_bif_1(L) ->
+ [E || E <- L, is_reference(E)].
+
+do_overridden_bif_2(L) ->
+ [E || E <- L, port(E)].
+
+do_overridden_bif_3(L) ->
+ [E || E <- L, (is_reference(E) andalso E > 0)].
+
+do_overridden_bif_4(L) ->
+ [E || E <- L, (port(E) andalso E > 0)].
+
+do_overridden_bif_5(L) ->
+ [E || E <- L, size(E) > 1].
+
+do_overridden_bif_6(L) ->
+ [E || E <- L, binary(E)].
+
+is_reference(N) ->
+ N rem 3 =:= 0.
+
+port(N) ->
+ N rem 2 =:= 0.
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 8304672558..4219768d6f 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -25,7 +25,7 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1,
- wait/1]).
+ wait/1,recv_in_try/1,double_recv/1]).
-include_lib("common_test/include/ct.hrl").
@@ -40,15 +40,16 @@ suite() ->
{timetrap,{minutes,2}}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
[{p,test_lib:parallel(),
- [recv,coverage,otp_7980,ref_opt,export,wait]}].
+ [recv,coverage,otp_7980,ref_opt,export,wait,
+ recv_in_try,double_recv]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -222,9 +223,8 @@ do_ref_opt(Source, PrivDir) ->
collect_recv_opt_instrs(Code)
end,
ok
- catch Class:Error ->
- io:format("~s: ~p ~p\n~p\n",
- [Source,Class,Error,erlang:get_stacktrace()]),
+ catch Class:Error:Stk ->
+ io:format("~s: ~p ~p\n~p\n", [Source,Class,Error,Stk]),
error
end.
@@ -265,6 +265,10 @@ export(Config) when is_list(Config) ->
self() ! {result,Ref,42},
42 = export_1(Ref),
{error,timeout} = export_1(Ref),
+
+ self() ! {result,Ref},
+ {ok,Ref} = export_2(),
+
ok.
export_1(Reference) ->
@@ -281,6 +285,10 @@ export_1(Reference) ->
id({build,self()}),
Result.
+export_2() ->
+ receive {result,Result} -> ok end,
+ {ok,Result}.
+
wait(Config) when is_list(Config) ->
self() ! <<42>>,
<<42>> = wait_1(r, 1, 2),
@@ -298,4 +306,76 @@ wait_1(r, _, _) ->
wait_1(A, B, C) ->
{A,B,C}.
+recv_in_try(_Config) ->
+ self() ! {ok,fh}, {ok,fh} = recv_in_try(infinity, native),
+ self() ! {ok,ignored}, {ok,42} = recv_in_try(infinity, plain),
+ self() ! {error,ignored}, nok = recv_in_try(infinity, plain),
+ timeout = recv_in_try(1, plain),
+ ok.
+
+recv_in_try(Timeout, Format) ->
+ try
+ receive
+ {Status,History} ->
+ %% {test,is_tuple,{f,148},[{x,0}]}.
+ %% {test,test_arity,{f,148},[{x,0},2]}.
+ %% {get_tuple_element,{x,0},0,{y,1}}. %y1 is fragile.
+ %%
+ %% %% Here the fragility of y1 would be be progated to
+ %% %% the 'catch' below. Incorrect, since get_tuple_element
+ %% %% can't fail.
+ %% {get_tuple_element,{x,0},1,{x,2}}.
+ %%
+ %% remove_message. %y1 fragility cleared.
+ FH = case Format of
+ native ->
+ id(History);
+ plain ->
+ id(42)
+ end,
+ case Status of
+ ok ->
+ {ok,FH};
+ error ->
+ nok
+ end
+ after Timeout ->
+ timeout
+ end
+ catch
+ %% The fragility of y1 incorrectly propagated to here.
+ %% beam_validator would complain.
+ throw:{error,Reason} ->
+ {nok,Reason}
+ end.
+
+%% ERL-703. The compiler would crash because beam_utils:anno_defs/1
+%% failed to take into account that code after loop_rec_end is
+%% unreachable.
+
+double_recv(_Config) ->
+ self() ! {more,{a,term}},
+ ok = do_double_recv({more,{a,term}}, any),
+ self() ! message,
+ ok = do_double_recv(whatever, message),
+
+ error = do_double_recv({more,42}, whatever),
+ error = do_double_recv(whatever, whatever),
+ ok.
+
+do_double_recv({more, Rest}, _Msg) ->
+ receive
+ {more, Rest} ->
+ ok
+ after 0 ->
+ error
+ end;
+do_double_recv(_, Msg) ->
+ receive
+ Msg ->
+ ok
+ after 0 ->
+ error
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl
index 5546765f26..4ed7f39780 100644
--- a/lib/compiler/test/record_SUITE.erl
+++ b/lib/compiler/test/record_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -41,7 +41,6 @@ suite() ->
{timetrap,{minutes,2}}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -52,6 +51,7 @@ groups() ->
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
diff --git a/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl b/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl
index 9b72432246..dbd2419ad2 100644
--- a/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl
+++ b/lib/compiler/test/record_SUITE_data/record_access_in_guards.erl
@@ -27,12 +27,12 @@
-record(r3, {a = fun(_) -> #r1{} end(1), b}).
t() ->
- foo = fun(A) when A#r1.a > A#r1.b -> foo end(#r1{b = 2}),
- 0 = fun(A) when A#r2.a -> 0 end(#r2{a = true}),
+ foo = rec_call(fun(A) when A#r1.a > A#r1.b -> foo end, #r1{b = 2}),
+ 0 = rec_call(fun(A) when A#r2.a -> 0 end, #r2{a = true}),
1 = fun(A) when (#r1{a = A})#r1.a > 2 -> 1 end(3),
2 = fun(N) when ((#r2{a = #r{a = 4}, b = length([a,b,c])})#r2.a)#r.a > N ->
- 2 end(2),
- 3 = fun(A) when (A#r2.a)#r1.a =:= 3 -> 3 end(#r2{a = #r1{a = 3}}),
+ 2 end(2),
+ 3 = rec_call(fun(A) when (A#r2.a)#r1.a =:= 3 -> 3 end, #r2{a = #r1{a = 3}}),
ok = fun() ->
F = fun(A) when record(A#r.a, r1) -> 4;
(A) when record(A#r1.a, r1) -> 5
@@ -41,9 +41,9 @@ t() ->
4 = F(#r{a = #r1{}}),
ok
end(),
- 3 = fun(A) when record(A#r1.a, r),
- (A#r1.a)#r.a > 3 -> 3
- end(#r1{a = #r{a = 4}}),
+ 3 = rec_call(fun(A) when record(A#r1.a, r),
+ (A#r1.a)#r.a > 3 -> 3
+ end, #r1{a = #r{a = 4}}),
7 = fun(A) when record(A#r3.a, r1) -> 7 end(#r3{}),
[#r1{a = 2,b = 1}] =
fun() ->
@@ -71,9 +71,10 @@ t() ->
(_) -> p
end(#r1{a = 2}),
- 3 = fun(A) when A#r1.a > 3,
- record(A, r1) -> 3
- end(#r1{a = 5}),
+ o = rec_call(fun(A) when (A#r1.a =:= 2) orelse (A#r2.a =:= 1) -> o end, #r1{a = 2}),
+ o = rec_call(fun(A) when A#r1.a =:= 2; A#r2.a =:= 1 -> o end, #r2{a = 1}),
+
+ 3 = rec_call(fun(A) when A#r1.a > 3, record(A, r1) -> 3 end, #r1{a = 5}),
ok = fun() ->
F = fun(A) when (A#r2.a =:= 1) orelse (A#r2.a) -> 2;
@@ -93,6 +94,8 @@ t() ->
(_) -> b
end(#r1{a = 1}),
+ a = rec_call(fun(A) when not (A#r.a =:= 1) or false -> a end, #r{a = 42}),
+
ok = fun() ->
F = fun(A) when not (A#r.a =:= 1) -> yes;
(_) -> no
@@ -103,14 +106,14 @@ t() ->
ok
end(),
- a = fun(A) when record(A, r),
- A#r.a =:= 1,
- A#r.b =:= 2 ->a
- end(#r{a = 1, b = 2}),
- a = fun(A) when erlang:is_record(A, r),
- A#r.a =:= 1,
- A#r.b =:= 2 -> a
- end(#r{a = 1, b = 2}),
+ a = rec_call(fun(A) when record(A, r),
+ A#r.a =:= 1,
+ A#r.b =:= 2 -> a
+ end, #r{a = 1, b = 2}),
+ a = rec_call(fun(A) when erlang:is_record(A, r),
+ A#r.a =:= 1,
+ A#r.b =:= 2 -> a
+ end, #r{a = 1, b = 2}),
a = fun(A) when is_record(A, r),
A#r.a =:= 1,
A#r.b =:= 2 -> a
@@ -144,8 +147,7 @@ t() ->
ok
end(),
- both = fun(A) when A#r.a, A#r.b -> both
- end(#r{a = true, b = true}),
+ both = rec_call(fun(A) when A#r.a, A#r.b -> both end, #r{a = true, b = true}),
ok = fun() ->
F = fun(A, B) when ((A#r1.a) orelse (B#r2.a))
@@ -176,3 +178,24 @@ t() ->
ok.
+rec_call(F, Rec) ->
+ Corrupted1 = setelement(1, Rec, wrong),
+ Corrupted2 = erlang:append_element(Rec, extra),
+ Corrupted3 = erlang:append_element(Corrupted1, extra),
+ fc(F, Corrupted1),
+ fc(F, Corrupted2),
+ fc(F, Corrupted3),
+ F(Rec).
+
+fc(F, Term) ->
+ try
+ F(Term),
+ error(expected_to_fail)
+ catch
+ error:function_clause ->
+ ok;
+ error:{case_clause,_} ->
+ Comp = ?MODULE:module_info(compile),
+ {_,Opts} = lists:keyfind(options, 1, Comp),
+ true = lists:member(inline, Opts)
+ end.
diff --git a/lib/compiler/test/regressions_SUITE.erl b/lib/compiler/test/regressions_SUITE.erl
index 7d2c2ac974..9b0b9b0c38 100644
--- a/lib/compiler/test/regressions_SUITE.erl
+++ b/lib/compiler/test/regressions_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,13 +21,29 @@
-module(regressions_SUITE).
-include_lib("common_test/include/ct.hrl").
--export([all/0,groups/0,init_per_testcase/2,end_per_testcase/2,suite/0]).
+-export([all/0,groups/0,init_per_testcase/2,end_per_testcase/2,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2,end_per_testcase/2,
+ suite/0]).
-export([maps/1]).
-groups() ->
+groups() ->
[{p,test_lib:parallel(),
[maps]}].
+init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(_Case, Config) ->
Config.
@@ -38,8 +54,7 @@ suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,2}}].
-all() ->
- test_lib:recompile(?MODULE),
+all() ->
[{group,p}].
%%% test cases
@@ -48,7 +63,18 @@ maps(Config) when is_list(Config) ->
Ts = [{beam_bool_get_elements,
<<"century(#{ron := operator}, _century) ->
if 0.0; _century, _century, _century -> _century end.
- ">>}],
+ ">>},
+ {empty_map_clauses,
+ <<"politics(#{}, researchers) -> concerned;
+ politics(#{[] := _}, workers) -> dot;
+ politics(#{[] := ct}, counsel) -> calls.
+ ">>},
+ {empty_map_clauses_variable,
+ <<"georgia(#{a := effectively}, ratio, is, eventually) -> teens;
+ georgia(#{a := government}, knowledge, poker, partly) -> signed;
+ georgia(#{}, recording, bring, vital) -> divided;
+ georgia(#{0 := 0}, articles, brought, #{true := true, a := There}) -> There.
+ ">>}],
ok = run(Config, Ts),
ok.
@@ -58,7 +84,7 @@ run(Config, Tests) ->
F = fun({N,P}) ->
io:format("Compiling test for: ~w~n", [N]),
case catch run_test(Config, P) of
- {'EXIT', Reason} ->
+ {'EXIT', Reason} ->
io:format("~nTest ~p failed.~nReason: ~p~n",
[N, Reason]),
fail();
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index d5b79e2357..8954a9f5fb 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -22,7 +22,10 @@
-include_lib("common_test/include/ct.hrl").
-compile({no_auto_import,[binary_part/2]}).
-export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1,
- is_cloned_mod/1,smoke_disasm/1,p_run/2,binary_part/2]).
+ is_cloned_mod/1,smoke_disasm/1,p_run/2]).
+
+%% Used by test case that override BIFs.
+-export([binary_part/2,binary/1]).
id(I) -> I.
@@ -151,3 +154,7 @@ p_run_loop(Test, List, N, Refs0, Errors0, Ws0) ->
%% This is for the misc_SUITE:override_bif testcase
binary_part(_A,_B) ->
dummy.
+
+%% This is for overridden_bif_SUITE.
+binary(N) ->
+ N rem 10 =:= 0.
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index a591d6cc93..1b7ef4ddb0 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,14 +26,14 @@
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,get_in_try/1,
- hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1]).
+ hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1,
+ stacktrace/1,nested_stacktrace/1,raise/1]).
-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -42,10 +42,12 @@ groups() ->
after_oops,eclectic,rethrow,nested_of,nested_catch,
nested_after,nested_horrid,last_call_optimization,
bool,plain_catch_coverage,andalso_orelse,get_in_try,
- hockey,handle_info,catch_in_catch,grab_bag]}].
+ hockey,handle_info,catch_in_catch,grab_bag,
+ stacktrace,nested_stacktrace,raise]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -115,6 +117,16 @@ basic(Conf) when is_list(Conf) ->
catch nisse -> erro
end,
+ %% Unmatchable clauses.
+ try
+ throw(thrown)
+ catch
+ {a,b}={a,b,c} -> %Intentionally no match.
+ ok;
+ thrown ->
+ ok
+ end,
+
ok.
after_call() ->
@@ -324,11 +336,11 @@ eclectic(Conf) when is_list(Conf) ->
{{error,{exit,V},{'EXIT',V}},V} =
eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),
{{value,{value,V},V},
- {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} =
+ {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} =
eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),
{{'EXIT',V},V} =
eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}),
- {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}},
+ {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}},
{'EXIT',V}} =
eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),
{{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},
@@ -345,7 +357,7 @@ eclectic(Conf) when is_list(Conf) ->
eclectic_2({error,{value,V}}, throw, {error,V}),
{{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =
eclectic_2({value,{'abs',V}}, undefined, {value,V}),
- {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} =
+ {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} =
eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),
{{caught,{'EXIT',V}},undefined} =
eclectic_2({value,{error,V}}, undefined, {exit,V}),
@@ -1039,5 +1051,217 @@ grab_bag(_Config) ->
ok.
+stacktrace(_Config) ->
+ V = [make_ref()|self()],
+ case ?MODULE:module_info(native) of
+ false ->
+ {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]}} =
+ stacktrace_1({'abs',V}, error, {value,V}),
+ {caught2,{error,badarith},[{erlang,'+',[0,a],_},
+ {?MODULE,my_add,2,_}|_]} =
+ stacktrace_1({'div',{1,0}}, error, {'add',{0,a}});
+ true ->
+ {value2,{caught1,badarg,[{?MODULE,my_abs,1,_}|_]}} =
+ stacktrace_1({'abs',V}, error, {value,V}),
+ {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]} =
+ stacktrace_1({'div',{1,0}}, error, {'add',{0,a}})
+ end,
+ {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]} =
+ stacktrace_1({value,V}, error, {value,V}),
+ {caught2,{throw,V},[{?MODULE,foo,1,_}|_]} =
+ stacktrace_1({value,V}, error, {throw,V}),
+
+ try
+ stacktrace_2()
+ catch
+ error:{badmatch,_}:Stk2 ->
+ [{?MODULE,stacktrace_2,0,_},
+ {?MODULE,stacktrace,1,_}|_] = Stk2,
+ Stk2 = erlang:get_stacktrace(),
+ ok
+ end,
+
+ try
+ stacktrace_3(a, b)
+ catch
+ error:function_clause:Stk3 ->
+ Stk3 = erlang:get_stacktrace(),
+ case lists:module_info(native) of
+ false ->
+ [{lists,prefix,[a,b],_}|_] = Stk3;
+ true ->
+ [{lists,prefix,2,_}|_] = Stk3
+ end
+ end,
+
+ try
+ throw(x)
+ catch
+ throw:x:IntentionallyUnused ->
+ ok
+ end.
+
+stacktrace_1(X, C1, Y) ->
+ try try foo(X) of
+ C1 -> value1
+ catch
+ C1:D1:Stk1 ->
+ Stk1 = erlang:get_stacktrace(),
+ {caught1,D1,Stk1}
+ after
+ foo(Y)
+ end of
+ V2 -> {value2,V2}
+ catch
+ C2:D2:Stk2 -> {caught2,{C2,D2},Stk2=erlang:get_stacktrace()}
+ end.
+
+stacktrace_2() ->
+ ok = erlang:process_info(self(), current_function),
+ ok.
+
+stacktrace_3(A, B) ->
+ {ok,lists:prefix(A, B)}.
+
+nested_stacktrace(_Config) ->
+ V = [{make_ref()}|[self()]],
+ value1 = nested_stacktrace_1({{value,{V,x1}},void,{V,x1}},
+ {void,void,void}),
+ case ?MODULE:module_info(native) of
+ false ->
+ {caught1,
+ [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_],
+ value2} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{value,{V,x2}},void,{V,x2}}),
+ {caught1,
+ [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_],
+ {caught2,[{erlang,abs,[V],_}|_]}} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{'abs',V},error,badarg});
+ true ->
+ {caught1,
+ [{?MODULE,my_add,2,_}|_],
+ value2} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{value,{V,x2}},void,{V,x2}}),
+ {caught1,
+ [{?MODULE,my_add,2,_}|_],
+ {caught2,[{?MODULE,my_abs,1,_}|_]}} =
+ nested_stacktrace_1({{'add',{V,x1}},error,badarith},
+ {{'abs',V},error,badarg})
+ end,
+ ok.
+
+nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) ->
+ try foo(X1) of
+ V1 -> value1
+ catch
+ C1:V1:S1 ->
+ S1 = erlang:get_stacktrace(),
+ T2 = try foo(X2) of
+ V2 -> value2
+ catch
+ C2:V2:S2 ->
+ S2 = erlang:get_stacktrace(),
+ {caught2,S2}
+ end,
+ {caught1,S1,T2}
+ end.
+
+raise(_Config) ->
+ test_raise(fun() -> exit({exit,tuple}) end),
+ test_raise(fun() -> abs(id(x)) end),
+ test_raise(fun() -> throw({was,thrown}) end),
+
+ badarg = bad_raise(fun() -> abs(id(x)) end),
+
+ ok.
+
+bad_raise(Expr) ->
+ try
+ Expr()
+ catch
+ _:E:Stk ->
+ erlang:raise(bad_class, E, Stk)
+ end.
+
+test_raise(Expr) ->
+ test_raise_1(Expr),
+ test_raise_2(Expr),
+ test_raise_3(Expr).
+
+test_raise_1(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_1(Expr)
+ catch
+ C:E:Stk ->
+ {C,E,Stk} = erase(exception)
+ end.
+
+do_test_raise_1(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here the stacktrace must be built.
+ put(exception, {C,E,Stk}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_2(Expr) ->
+ erase(exception),
+ try
+ do_test_raise_2(Expr)
+ catch
+ C:E:Stk ->
+ {C,E} = erase(exception),
+ try
+ Expr()
+ catch
+ _:_:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_2(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ put(exception, {C,E}),
+ erlang:raise(C, E, Stk)
+ end.
+
+test_raise_3(Expr) ->
+ try
+ do_test_raise_3(Expr)
+ catch
+ exit:{exception,C,E}:Stk ->
+ try
+ Expr()
+ catch
+ C:E:S ->
+ [StkTop|_] = S,
+ [StkTop|_] = Stk
+ end
+ end.
+
+do_test_raise_3(Expr) ->
+ try
+ Expr()
+ catch
+ C:E:Stk ->
+ %% Here it is possible to replace erlang:raise/3 with
+ %% the raw_raise/3 instruction since the stacktrace is
+ %% not actually used.
+ erlang:raise(exit, {exception,C,E}, Stk)
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index ff9bddc1e2..33d55996ad 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -55,7 +55,6 @@ suite() ->
{timetrap,{minutes,2}}].
all() ->
- test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
@@ -68,6 +67,7 @@ groups() ->
underscore,no_warnings,bit_syntax,inlining]}].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -281,7 +281,6 @@ bad_arith(Config) when is_list(Config) ->
{3,sys_core_fold,{eval_failure,badarith}},
{9,sys_core_fold,nomatch_guard},
{9,sys_core_fold,{eval_failure,badarith}},
- {9,sys_core_fold,{no_effect,{erlang,is_integer,1}}},
{10,sys_core_fold,nomatch_guard},
{10,sys_core_fold,{eval_failure,badarith}},
{15,sys_core_fold,{eval_failure,badarith}}
@@ -530,7 +529,7 @@ bin_opt_info(Config) when is_list(Config) ->
Code,
[bin_opt_info],
{warnings,
- [{4,sys_core_fold,orig_bin_var_used_in_guard},
+ [{4,sys_core_bsm,orig_bin_var_used_in_guard},
{5,beam_bsm,{no_bin_opt,{{t1,1},no_suitable_bs_start_match}}},
{9,beam_bsm,{no_bin_opt,
{binary_used_in,{extfunc,erlang,split_binary,2}}}} ]}}],
@@ -629,7 +628,112 @@ maps(Config) when is_list(Config) ->
id(I) -> I.
">>,
[],
- []}],
+ []},
+ {repeated_keys1,
+ <<"
+ foo1() ->
+ #{a=>1,
+ b=> 2,
+ a=>3}.
+
+ bar1(M) ->
+ M#{a=>1, b=> 2, a:=3}.
+
+ baz1(M) ->
+ M#{a=>1, b=> 2, a:=3}.
+
+ foo2() ->
+ #{\"a\"=>1, \"b\"=> 2, \"a\"=>3}.
+
+ bar2(M) ->
+ M#{\"a\"=>1, \"b\"=> 2, \"a\":=3}.
+
+ baz2(M) ->
+ M#{\"a\"=>1, \"b\"=> 2, \"a\":=3}.
+
+ foo3() ->
+ #{\"a\"=>1,
+ \"b\"=> 2,
+ \"a\"=>3}.
+
+ bar3(M) ->
+ M#{\"a\"=>1, \"b\"=> 2, \"a\":=3}.
+
+ baz3(M) ->
+ M#{<<\"a\">>=>1, <<\"b\">>=> 2, <<\"a\">>:=3}.
+ ">>,
+ [],
+ {warnings,[{3,v3_core,{map_key_repeated,a}},
+ {8,v3_core,{map_key_repeated,a}},
+ {11,v3_core,{map_key_repeated,a}},
+ {14,v3_core,{map_key_repeated,"a"}},
+ {17,v3_core,{map_key_repeated,"a"}},
+ {20,v3_core,{map_key_repeated,"a"}},
+ {23,v3_core,{map_key_repeated,"a"}},
+ {28,v3_core,{map_key_repeated,"a"}},
+ {31,v3_core,{map_key_repeated,<<"a">>}}]}},
+ {repeated_keys2,
+ <<"
+ foo4(K) ->
+ #{\"a\"=>1, K => 1, \"b\"=> 2, \"a\"=>3, K=>2}.
+
+ bar4(M,K) ->
+ M#{a=>1, K =>1, b=> 2, a:=3, K=>2}.
+
+ baz4(M,K) ->
+ M#{<<\"a\">>=>1,
+ K => 1, <<\"b\">>=> 2,
+ <<\"a\">>:=3, K=>2}.
+
+ foo5(K) ->
+ #{{\"a\",1}=>1, K => 1, \"b\"=> 2, {\"a\",1}=>3, K=>2}.
+
+ bar5(M,K) ->
+ M#{{\"a\",<<\"b\">>}=>1, K =>1,
+ \"b\"=> 2, {\"a\",<<\"b\">>}:=3, K=>2}.
+
+ baz5(M,K) ->
+ M#{{<<\"a\">>,1}=>1, K => 1,
+ <<\"b\">>=> 2, {<<\"a\">>,1}:=3,K=>2}.
+
+ foo6(K) ->
+ #{#{\"a\"=>1}=>1, K => 1, \"b\"=> 2, #{\"a\"=>1}=>3, K=>2}.
+
+ bar6(M,K) ->
+ M#{#{\"a\"=><<\"b\">>}=>1, K =>1,
+ \"b\"=> 2, #{\"a\"=><<\"b\">>}:=3, K=>2}.
+
+ baz6(M,K) ->
+ M#{#{<<\"a\">>=>1}=>1,
+ K => 1,
+ <<\"b\">>=> 2,
+ #{<<\"a\">>=>1}:=3,K=>2}.
+
+ foo7(K) ->
+ M1 = #{#{\"a\"=>1}=>1, K => 1, \"b\"=> 2},
+ M1#{#{\"a\"=>1}=>3, K=>2}.
+
+ bar7(M,K) ->
+ M1 = M#{#{\"a\"=><<\"b\">>}=>1, K =>1, \"b\"=> 2},
+ M1#{#{\"a\"=><<\"b\">>}:=3, K=>2}.
+
+ baz7(M,K) ->
+ M1 = M#{#{<<\"a\">>=>1}=>1,
+ K => 1,
+ <<\"b\">>=> 2},
+ M1#{#{<<\"a\">>=>1}:=3,K=>2}.
+ ">>,
+ [],
+ {warnings,[{3,v3_core,{map_key_repeated,"a"}},
+ {6,v3_core,{map_key_repeated,a}},
+ {9,v3_core,{map_key_repeated,<<"a">>}},
+ {14,v3_core,{map_key_repeated,{"a",1}}},
+ {17,v3_core,{map_key_repeated,{"a",<<"b">>}}},
+ {21,v3_core,{map_key_repeated,{<<"a">>,1}}},
+ {25,v3_core,{map_key_repeated,#{"a" => 1}}},
+ {28,v3_core,{map_key_repeated,#{"a" => <<"b">>}}},
+ {32,v3_core,{map_key_repeated,#{<<"a">> => 1}}}]}}
+ ],
run(Config, Ts),
ok.
diff --git a/lib/compiler/test/z_SUITE.erl b/lib/compiler/test/z_SUITE.erl
index d864184f4c..bfa8e279e8 100644
--- a/lib/compiler/test/z_SUITE.erl
+++ b/lib/compiler/test/z_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -26,13 +26,13 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(?MODULE),
[loaded].
groups() ->
[].
init_per_suite(Config) ->
+ test_lib:recompile(?MODULE),
Config.
end_per_suite(_Config) ->
@@ -54,8 +54,7 @@ do_loaded([{M,_}|Ms], E0) ->
_ = M:module_info(functions),
E0
catch
- C:Error ->
- Stk = erlang:get_stacktrace(),
+ C:Error:Stk ->
io:format("~p:~p\n~p\n", [C,Error,Stk]),
E0 + 1
end,
diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk
index f3b9d3e9fd..ab707885f4 100644
--- a/lib/compiler/vsn.mk
+++ b/lib/compiler/vsn.mk
@@ -1 +1 @@
-COMPILER_VSN = 7.0.4.1
+COMPILER_VSN = 7.2.6