diff options
Diffstat (limited to 'lib/compiler')
126 files changed, 17582 insertions, 5547 deletions
diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile index c6864cb835..661415899f 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-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,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..1a71c83521 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,14 @@ <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>. + 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 +233,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 @@ -410,7 +451,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 +472,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 +548,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 +620,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 Binary files differdeleted file mode 100644 index 6fffe30419..0000000000 --- a/lib/compiler/doc/src/note.gif +++ /dev/null diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index db50cba094..440b50d509 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,640 @@ <p>This document describes the changes made to the Compiler application.</p> +<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}) -> {ok, + Val}.</c> a tuple would be built. The compiler will now + automatically rewrite the code to + <c>example({ok,Val}=Tuple) -> 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 +882,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 Binary files differdeleted file mode 100644 index e6275a803d..0000000000 --- a/lib/compiler/doc/src/user_guide.gif +++ /dev/null diff --git a/lib/compiler/doc/src/warning.gif b/lib/compiler/doc/src/warning.gif Binary files differdeleted file mode 100644 index 96af52360e..0000000000 --- a/lib/compiler/doc/src/warning.gif +++ /dev/null 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..abc6e96c85 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 @@ -298,7 +310,18 @@ btb_reaches_match_2([{test,bs_start_match2,{f,F},Live,[Bin,_],Ctx}|Is], end; btb_reaches_match_2([{test,_,{f,F},Ss}=I|Is], Regs, D0) -> btb_ensure_not_used(Ss, I, Regs), - D = btb_follow_branch(F, Regs, D0), + D1 = btb_follow_branch(F, Regs, D0), + D = case Is of + [{bs_context_to_binary,_}|_] -> + %% bs_context_to_binary following a test instruction + %% probably needs the current position to be saved as + %% the new start position, but we can't be sure. + %% Therefore, conservatively disable the optimization + %% (instead of forcing a saving of the position). + D1#btb{must_save=true,must_not_save=true}; + _ -> + D1 + end, btb_reaches_match_1(Is, Regs, D); btb_reaches_match_2([{test,_,{f,F},_,Ss,_}=I|Is], Regs, D0) -> btb_ensure_not_used(Ss, I, Regs), 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..5580d2f123 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,224 @@ 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([{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..562d57a6ef 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}} @@ -877,13 +941,13 @@ do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> 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 +966,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 +974,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 +988,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 +1021,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 +1059,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 +1117,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 +1180,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 +1200,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 +1266,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 +1308,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 +1325,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 +1379,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 +1431,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 +1480,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 +1534,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 +1554,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 +1568,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 +1593,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 +1625,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 +1732,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 +1775,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 +1884,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 +1894,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 +1903,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 +1912,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 +1963,6 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, - beam_bool, beam_bs, beam_bsm, beam_clean, @@ -1807,6 +1974,7 @@ pre_load() -> beam_opcodes, beam_peep, beam_receive, + beam_record, beam_reorder, beam_split, beam_trim, @@ -1825,12 +1993,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..d7b26c3a56 --- /dev/null +++ b/lib/compiler/src/sys_core_bsm.erl @@ -0,0 +1,293 @@ +%% +%% %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 + 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) -> + 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_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..721f77f0f6 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -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..be49cff9b9 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -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..1eb07c8c85 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -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..488c30919b 100644 --- a/lib/compiler/test/beam_jump_SUITE.erl +++ b/lib/compiler/test/beam_jump_SUITE.erl @@ -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..33b27b9f9f 100644 --- a/lib/compiler/test/beam_reorder_SUITE.erl +++ b/lib/compiler/test/beam_reorder_SUITE.erl @@ -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..c4c709eb3a 100644 --- a/lib/compiler/test/bif_SUITE.erl +++ b/lib/compiler/test/bif_SUITE.erl @@ -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..a5d49020a9 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -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..17faa012bc 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -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..7814738449 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,9 @@ 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]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -52,7 +53,6 @@ suite() -> {timetrap,{minutes,1}}]. all() -> - test_lib:recompile(?MODULE), [{group,p}]. groups() -> @@ -70,10 +70,13 @@ 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]}]. init_per_suite(Config) -> + test_lib:recompile(?MODULE), Config. end_per_suite(_Config) -> @@ -327,6 +330,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 +362,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 +688,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 +782,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 +819,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 +908,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 +1509,213 @@ 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(<<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_2(_, <<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. 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..4330677260 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -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..3ba3ce7cdf 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-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. @@ -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..1ecae06128 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 ]). 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]. 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,67 @@ 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. + %%% %%% Utilities. %%% @@ -1127,8 +1548,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..4f96576621 --- /dev/null +++ b/lib/compiler/test/core_alias_SUITE.erl @@ -0,0 +1,195 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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(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..da291bdc8b 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -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..39867021cb 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -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..99dc06b525 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-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. @@ -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..fdf2fe88b4 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -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..a46abe8dcf --- /dev/null +++ b/lib/compiler/test/overridden_bif_SUITE.erl @@ -0,0 +1,101 @@ +%% +%% %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 +%% +%% 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..118e0a241c 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -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..f448d54933 100644 --- a/lib/compiler/test/regressions_SUITE.erl +++ b/lib/compiler/test/regressions_SUITE.erl @@ -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..42ff4f6133 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-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. @@ -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..bb6ee00cd7 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.0.4.1 +COMPILER_VSN = 7.2.4 |
