diff options
Diffstat (limited to 'lib/compiler')
102 files changed, 21813 insertions, 11647 deletions
diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile index 32f150eef8..2fb163b9e7 100644 --- a/lib/compiler/doc/src/Makefile +++ b/lib/compiler/doc/src/Makefile @@ -31,6 +31,7 @@ APPLICATION=compiler # Release directory specification # ---------------------------------------------------- RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) +COMPILER_DIR = $(ERL_TOP)/lib/compiler/src # ---------------------------------------------------- # Target Specs @@ -38,7 +39,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = compile.xml -XML_PART_FILES = +XML_PART_FILES = internal.xml XML_CHAPTER_FILES = notes.xml BOOK_FILES = book.xml @@ -49,6 +50,9 @@ XML_FILES = \ $(BOOK_FILES) $(XML_CHAPTER_FILES) \ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) +XML_INTERNAL_FILES = \ + cerl.xml cerl_trees.xml cerl_clauses.xml + # ---------------------------------------------------- HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ @@ -62,6 +66,8 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf +XML_GEN_FILES = $(XML_INTERNAL_FILES:%=$(XMLDIR)/%) + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -85,6 +91,9 @@ man: $(MAN3_FILES) gifs: $(GIF_FILES:%=$(HTMLDIR)/%) +$(XML_INTERNAL_FILES:%=$(XMLDIR)/%): $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) + $(gen_verbose)escript $(DOCGEN)/priv/bin/xml_from_edoc.escript -def vsn $(COMPILER_VSN) -dir $(XMLDIR) $(COMPILER_DIR)/$(@:$(XMLDIR)/%.xml=%.erl) + debug opt: clean clean_docs: diff --git a/lib/compiler/doc/src/book.xml b/lib/compiler/doc/src/book.xml index af6b4cf47a..d101d40cb4 100644 --- a/lib/compiler/doc/src/book.xml +++ b/lib/compiler/doc/src/book.xml @@ -38,6 +38,9 @@ <applications> <xi:include href="ref_man.xml"/> </applications> + <internals> + <xi:include href="internal.xml"/> + </internals> <releasenotes> <xi:include href="notes.xml"/> </releasenotes> diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 7f3d6aa60e..549b1049d8 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -416,6 +416,17 @@ module.beam: module.erl \ is not documented, and can change between releases.</p> </item> + <tag><c>no_spawn_compiler_process</c></tag> + <item> + <p>By default, all code is compiled in a separate process + which is terminated at the end of compilation. However, + some tools, like Dialyzer or compilers for other BEAM languages, + may already manage their own worker processes and spawning + an extra process may slow the compilation down. + In such scenarios, you can pass this option to stop the + compiler from spawning an additional process.</p> + </item> + <tag><c>no_strict_record_tests</c></tag> <item> <p>This option is not recommended.</p> @@ -621,6 +632,22 @@ module.beam: module.erl \ to be deprecated.</p> </item> + <tag><c>nowarn_removed</c></tag> + <item> + <p>Turns off warnings for calls to functions that have + been removed. Default is to emit warnings for every call + to a function known by the compiler to have been recently + removed from Erlang/OTP.</p> + </item> + + <tag><c>{nowarn_removed, ModulesOrMFAs}</c></tag> + <item> + <p>Turns off warnings for calls to modules or functions + that have been removed. Default is to emit warnings for + every call to a function known by the compiler to have + been recently removed from Erlang/OTP.</p> + </item> + <tag><c>nowarn_obsolete_guard</c></tag> <item> <p>Turns off warnings for calls to old type testing BIFs, @@ -684,12 +711,13 @@ module.beam: module.erl \ </note> <note> - <p>The options <c>{nowarn_unused_function, FAs}</c>, - <c>{nowarn_bif_clash, FAs}</c>, and - <c>{nowarn_deprecated_function, MFAs}</c> are only - recognized when given in files. They are not affected by - options <c>warn_unused_function</c>, <c>warn_bif_clash</c>, or - <c>warn_deprecated_function</c>.</p> + <p>Before OTP 22, the option <c>{nowarn_deprecated_function, + MFAs}</c> was only recognized when given in the file with + attribute <c>-compile()</c>. (The option + <c>{nowarn_unused_function,FAs}</c> was incorrectly documented + to only work in a file, but it also worked when given in the + option list.) Starting from OTP 22, all options that can be + given in the file can also be given in the option list.</p> </note> <p>For debugging of the compiler, or for pure curiosity, diff --git a/lib/compiler/doc/src/internal.xml b/lib/compiler/doc/src/internal.xml new file mode 100644 index 0000000000..f24b363c1c --- /dev/null +++ b/lib/compiler/doc/src/internal.xml @@ -0,0 +1,38 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE part SYSTEM "part.dtd"> + +<internal xmlns:xi="http://www.w3.org/2001/XInclude"> + <header> + <copyright> + <year>2018</year><year>2018</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 Internal Documentation</title> + <prepared>Lukas Larsson</prepared> + <docno></docno> + <date>2018-07-07</date> + <rev>1.0.0</rev> + <file>internal.xml</file> + </header> + <description> + </description> + <xi:include href="cerl.xml"/> + <xi:include href="cerl_trees.xml"/> + <xi:include href="cerl_clauses.xml"/> +</internal> + diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index d45dfef8f3..f11444137d 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,220 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.4.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a compiler crash introduced in <c>22.0.6</c> + (OTP-15952).</p> + <p> + Own Id: OTP-15953 Aux Id: ERL-999 </p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 7.4.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed an unsafe optimization when matching + <c>tuple_size/1</c> outside of guards, which could crash + the emulator if the argument was not a tuple.</p> + <p> + Own Id: OTP-15945</p> + </item> + <item> + <p>Fixed a rare bug that could cause the wrong kind of + exception to be thrown when a BIF failed in a function + that matched bitstrings.</p> + <p> + Own Id: OTP-15946</p> + </item> + <item> + <p>Fixed a bug where receive statements inside try/catch + blocks could return incorrect results.</p> + <p> + Own Id: OTP-15952</p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 7.4.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed an incorrect type determination for constructed + binaries, which could cause <c>is_binary</c> checks to + succeed when they shouldn't have.</p> + <p> + Own Id: OTP-15872</p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 7.4.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>The type optimization pass of the compiler could hang + or loop for a long time when analyzing a + <c>setelement/3</c> call with a varible position.</p> + <p> + Own Id: OTP-15828 Aux Id: ERL-948 </p> + </item> + <item> + <p>Certain complex receive statements would result in an + internal compiler failure.</p> + <p> + Own Id: OTP-15832 Aux Id: ERL-950 </p> + </item> + <item> + <p>Fixed an unsafe type optimization.</p> + <p> + Own Id: OTP-15838</p> + </item> + <item> + <p>Fixed a crash when optimizing compiler-generated + exceptions (like badmatch) whose offending term was a + constructed binary.</p> + <p> + Own Id: OTP-15839 Aux Id: ERL-954 </p> + </item> + <item> + <p>Fixed a bad optimization related to the <c>++/2</c> + operator, where the compiler assumed that it always + produced a list (<c>[] ++ RHS</c> returns <c>RHS</c> + verbatim, even if it's not a list).</p> + <p> + Own Id: OTP-15841</p> + </item> + <item> + <p>An <c>is_binary/1</c> test followed by + <c>is_bitstring/1</c> (or vice versa) could fail because + of an usafe optimization.</p> + <p> + Own Id: OTP-15845</p> + </item> + <item> + <p>A Core Erlang module where the last clause in a + <c>case</c> matched a map would fail to load.</p> + <p> + Own Id: OTP-15846 Aux Id: ERL-955 </p> + </item> + <item> + <p>Fixed a bug that could cause the compiler to crash + when compiling complex nested case expressions.</p> + <p> + Own Id: OTP-15848 Aux Id: ERL-956 </p> + </item> + </list> + </section> + +</section> + +<section><title>Compiler 7.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p><c>record_info/2</c> is a pseudo-function that + requires literal arguments known at compile time. + Therefore, the following usage is illegal: <c>fun + record/info/2</c>. The compiler would crash when during + compilation of that kind of code. Corrected to issue a + compilation error.</p> + <p> + Own Id: OTP-15760 Aux Id: ERL-907 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The compiler has been rewritten to internally use an + intermediate representation based on Static Single + Assignment (SSA). The new intermediate representation + makes more optimizations possible.</p> + <p> + Most noticeable is that the binary matching optimizations + are now applicable in many more circumstances than + before.</p> + <p> + Another noticeable change is that type optimizations are + now applied across local function calls, and will remove + a lot more redundant type tests than before.</p> + <p> + Own Id: OTP-14894 Aux Id: ERL-714 </p> + </item> + <item> + <p>Funs are no longer created when they are only used + locally, greatly improving the performance of named funs + and "fun-wrapped" macros.</p> + <p> + Own Id: OTP-15273 Aux Id: ERL-639 </p> + </item> + <item> + <p>All compiler options that can be given in the source + file can now also be given in the option list or from the + command line for <c>erlc</c>.</p> + <p>Specifically, the option + <c>{nowarn_deprecated_function,MFAs}</c> was only + recognized when given in the file with the attribute + <c>-compile()</c>. The option + <c>{nowarn_unused_function,FAs}</c> was incorrectly + documented to only work in a file, but it also worked + when given in the option list.</p> + <p> + Own Id: OTP-15456</p> + </item> + <item> + <p> Do not allow function specifications for functions + residing in other modules. </p> + <p> + *** POTENTIAL INCOMPATIBILITY ***</p> + <p> + Own Id: OTP-15563 Aux Id: ERL-845, OTP-15562 </p> + </item> + <item> + <p>Internal documentation has now been added to the + <em>Erts</em> and <em>Compiler</em> applications.</p> + <p>The internal documents for <em>Erts</em> describe + miscellaneous interesting implementation details. Those + details can change at any time.</p> + <p>The internal documentation for <em>Compiler</em> + documents the API for the Core Erlang modules. While we + will not change those APIs without good reason, we don't + give the same guarantees about backward compatibility as + for the rest of the APIs in OTP.</p> + <p> + Own Id: OTP-15715</p> + </item> + <item> + <p> There are new compiler options <c>nowarn_removed</c> + and <c>{nowarn_removed,Items}</c> to suppress warnings + for functions and modules that have been removed from + OTP.</p> + <p> + Own Id: OTP-15749 Aux Id: ERL-904 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.3.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/scripts/.gitignore b/lib/compiler/scripts/.gitignore new file mode 100644 index 0000000000..4e4eba766d --- /dev/null +++ b/lib/compiler/scripts/.gitignore @@ -0,0 +1 @@ +/smoke-build diff --git a/lib/compiler/scripts/smoke b/lib/compiler/scripts/smoke new file mode 100755 index 0000000000..ae31c923b8 --- /dev/null +++ b/lib/compiler/scripts/smoke @@ -0,0 +1,123 @@ +#!/usr/bin/env escript +%% -*- erlang -*- +-mode(compile). + +main(_Args) -> + setup(), + clone_elixir(), + build_elixir(), + test_elixir(), + setup_mix(), + smoke(main), + smoke(rabbitmq), + halt(0). + +setup() -> + ScriptsDir = scripts_dir(), + SmokeBuildDir = filename:join(ScriptsDir, "smoke-build"), + _ = file:make_dir(SmokeBuildDir), + ok = file:set_cwd(SmokeBuildDir), + ok. + +clone_elixir() -> + {ok,SmokeDir} = file:get_cwd(), + DotGitDir = filename:join([SmokeDir,"elixir",".git"]), + ElixirRepo = "[email protected]:elixir-lang/elixir.git", + case filelib:is_dir(DotGitDir) of + false -> + cmd("git clone " ++ ElixirRepo); + true -> + GetHeadSHA1 = "cd elixir && git rev-parse --verify HEAD", + Before = os:cmd(GetHeadSHA1), + cmd("cd elixir && git pull --ff-only origin master"), + case os:cmd(GetHeadSHA1) of + Before -> + ok; + _After -> + %% There were some changes. Clean to force a re-build. + cmd("cd elixir && make clean") + end + end. + +build_elixir() -> + cmd("cd elixir && make compile"). + +test_elixir() -> + cmd("cd elixir && make test_stdlib"). + +setup_mix() -> + MixExsFile = filename:join(scripts_dir(), "smoke-mix.exs"), + {ok,MixExs} = file:read_file(MixExsFile), + ok = file:write_file("mix.exs", MixExs), + + {ok,SmokeDir} = file:get_cwd(), + ElixirBin = filename:join([SmokeDir,"elixir","bin"]), + PATH = ElixirBin ++ ":" ++ os:getenv("PATH"), + os:putenv("PATH", PATH), + mix("local.hex --force"), + mix("local.rebar --force"), + ok. + +smoke(Set) -> + os:putenv("SMOKE_DEPS_SET", atom_to_list(Set)), + _ = file:delete("mix.lock"), + cmd("touch mix.exs"), + mix("deps.clean --all"), + mix("deps.get"), + mix("deps.compile"), + ok. + +scripts_dir() -> + Root = code:lib_dir(compiler), + filename:join(Root, "scripts"). + +mix(Cmd) -> + cmd("mix " ++ Cmd). + +cmd(Cmd) -> + run("sh", ["-c",Cmd]). + +run(Program0, Args) -> + Program = case os:find_executable(Program0) of + Path when is_list(Path) -> + Path; + false -> + abort("Unable to find program: ~s\n", [Program0]) + end, + Cmd = case {Program0,Args} of + {"sh",["-c"|ShCmd]} -> + ShCmd; + {_,_} -> + lists:join(" ", [Program0|Args]) + end, + io:format("\n# ~s\n", [Cmd]), + Options = [{args,Args},binary,exit_status,stderr_to_stdout], + try open_port({spawn_executable,Program}, Options) of + Port -> + case run_loop(Port, <<>>) of + 0 -> + ok; + ExitCode -> + abort("*** Failed with exit code: ~p\n", + [ExitCode]) + end + catch + error:_ -> + abort("Failed to execute ~s\n", [Program0]) + end. + +run_loop(Port, Output) -> + receive + {Port,{exit_status,Status}} -> + Status; + {Port,{data,Bin}} -> + io:put_chars(Bin), + run_loop(Port, <<Output/binary,Bin/binary>>); + Msg -> + io:format("L: ~p~n", [Msg]), + run_loop(Port, Output) + end. + +abort(Format, Args) -> + io:format(Format, Args), + halt(1). diff --git a/lib/compiler/scripts/smoke-mix.exs b/lib/compiler/scripts/smoke-mix.exs new file mode 100644 index 0000000000..ba0815e465 --- /dev/null +++ b/lib/compiler/scripts/smoke-mix.exs @@ -0,0 +1,103 @@ +defmodule Smoke.MixProject do + use Mix.Project + + def project do + [ + app: :smoke, + version: "0.1.0", + elixir: "~> 1.8", + start_permanent: Mix.env() == :prod, + deps: deps() + ] + end + + # Run "mix help compile.app" to learn about applications. + def application do + [ + extra_applications: [:logger] + ] + end + + # Run "mix help deps" to learn about dependencies. + defp deps do + case :os.getenv('SMOKE_DEPS_SET') do + 'main' -> + [ + {:bear, "~> 0.8.7"}, + {:cloudi_core, "~> 1.7"}, + {:cloudi_service_monitoring, "~> 1.7"}, + {:cloudi_service_tcp, "~> 1.7"}, + {:cloudi_service_queue, "~> 1.7"}, + {:cloudi_service_udp, "~> 1.7"}, + {:cloudi_service_map_reduce, "~> 1.7"}, + {:cloudi_service_api_requests, "~> 1.7"}, + {:cloudi_service_router, "~> 1.7"}, + {:cloudi_service_request_rate, "~> 1.7"}, + {:concuerror, "~> 0.20.0"}, + {:cowboy, "~> 2.6.1"}, + {:ecto, "~> 3.0.6"}, + {:ex_doc, "~> 0.19.3"}, + {:distillery, "~> 2.0.12"}, + {:erlydtl, "~> 0.12.1"}, + {:gen_smtp, "~> 0.13.0"}, + {:getopt, "~> 1.0.1"}, + {:gettext, "~> 0.16.1"}, + {:gpb, "~> 4.6"}, + {:gproc, "~> 0.8.0"}, + {:graphql, "~> 0.15.0", hex: :graphql_erl}, + {:hackney, "~> 1.15.0"}, + {:ibrowse, "~> 4.4.1"}, + {:jose, "~> 1.9.0"}, + {:lager, "~> 3.6"}, + {:locus, "~> 1.6"}, + {:nimble_parsec, "~> 0.5.0"}, + {:phoenix, "~> 1.4.0"}, + {:riak_pb, "~> 2.3"}, + {:scalaris, git: "https://github.com/scalaris-team/scalaris", + compile: build_scalaris()}, + {:tdiff, "~> 0.1.2"}, + {:webmachine, "~> 1.11"}, + {:wings, git: "https://github.com/dgud/wings.git", + compile: build_wings()}, + {:zotonic_stdlib, "~> 1.0"}, + ] + 'rabbitmq' -> + [{:rabbit_common, "~> 3.7"}] + _ -> + [] + end + end + + defp build_scalaris do + # Only compile the Erlang code. + + """ + echo '-include("rt_simple.hrl").' >include/rt.hrl + (cd src && erlc -W0 -I ../include -I ../contrib/log4erl/include -I ../contrib/yaws/include *.erl) + (cd src/comm_layer && erlc -W0 -I ../../include -I *.erl) + (cd src/cp && erlc -W0 -I ../../include -I *.erl) + (cd src/crdt && erlc -W0 -I ../../include -I *.erl) + (cd src/json && erlc -W0 -I ../../include -I *.erl) + (cd src/paxos && erlc -W0 -I ../../include -I *.erl) + (cd src/rbr && erlc -W0 -I ../../include -I *.erl) + (cd src/rrepair && erlc -W0 -I ../../include -I *.erl) + (cd src/time && erlc -W0 -I ../../include -I *.erl) + (cd src/transactions && erlc -W0 -I ../../include -I *.erl) + (cd src/tx && erlc -W0 -I ../../include -I *.erl) + """ + end + + defp build_wings do + # If the Erlang system is not installed, the build will + # crash in plugins_src/accel when attempting to build + # the accel driver. Since there is very little Erlang code in + # the directory, skip the entire directory. + + """ + echo "all:\n\t" >plugins_src/accel/Makefile + git commit -a -m'Disable for smoke testing' + git tag -a -m'Smoke test' vsmoke_test + make + """ + end +end diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 2408c76b48..87b0d345f2 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,10 +49,7 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ - beam_bs \ - beam_bsm \ beam_clean \ - beam_dead \ beam_dict \ beam_disasm \ beam_except \ @@ -61,12 +58,20 @@ MODULES = \ beam_listing \ beam_opcodes \ beam_peep \ - beam_receive \ - beam_reorder \ - beam_record \ - beam_split \ + beam_ssa \ + beam_ssa_bsm \ + beam_ssa_codegen \ + beam_ssa_dead \ + beam_ssa_funs \ + beam_ssa_lint \ + beam_ssa_opt \ + beam_ssa_pp \ + beam_ssa_pre_codegen \ + beam_ssa_recv \ + beam_ssa_share \ + beam_ssa_type \ + beam_kernel_to_ssa \ beam_trim \ - beam_type \ beam_utils \ beam_validator \ beam_z \ @@ -85,12 +90,10 @@ MODULES = \ rec_env \ sys_core_alias \ sys_core_bsm \ - sys_core_dsetel \ sys_core_fold \ sys_core_fold_lists \ sys_core_inline \ sys_pre_attributes \ - v3_codegen \ v3_core \ v3_kernel \ v3_kernel_pp @@ -99,6 +102,8 @@ BEAM_H = $(wildcard ../priv/beam_h/*.h) HRL_FILES= \ beam_disasm.hrl \ + beam_ssa_opt.hrl \ + beam_ssa.hrl \ core_parse.hrl \ v3_kernel.hrl @@ -124,9 +129,10 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native +else +ERL_COMPILE_FLAGS += -Werror endif ERL_COMPILE_FLAGS += +inline +warn_unused_import \ - -Werror \ -I../../stdlib/include -I$(EGEN) -W +warn_missing_spec # ---------------------------------------------------- @@ -185,7 +191,20 @@ release_docs_spec: # ---------------------------------------------------- $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl -$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl +$(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl beam_ssa.hrl +$(EBIN)/beam_kernel_to_ssa.beam: v3_kernel.hrl beam_ssa.hrl +$(EBIN)/beam_ssa.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_bsm.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_codegen.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_dead.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_funs.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_lint.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_opt.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_pp.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_pre_codegen.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_recv.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_share.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_type.beam: beam_ssa.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 @@ -193,11 +212,9 @@ $(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)/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 diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 6fd4ace540..0bccad1ecd 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -39,14 +39,29 @@ function({function,Name,Arity,CLabel,Is0}) -> %% Remove unusued labels for cleanliness and to help %% optimization passes and HiPE. - Is = beam_jump:remove_unused_labels(Is1), - {function,Name,Arity,CLabel,Is} + Is2 = beam_jump:remove_unused_labels(Is1), + + %% Some optimization passes can't handle consecutive labels. + %% Coalesce multiple consecutive labels. + Is = coalesce_consecutive_labels(Is2, [], []), + + {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [Name,Arity]), erlang:raise(Class, Error, Stack) end. +rename_instrs([{test,is_eq_exact,_,[Dst,Src]}=Test, + {move,Src,Dst}|Is]) -> + %% The move instruction is not needed. + rename_instrs([Test|Is]); +rename_instrs([{test,is_eq_exact,_,[Same,Same]}|Is]) -> + %% Same literal or same register. Will always succeed. + rename_instrs(Is); +rename_instrs([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_},{label,Fail}|Is]) -> + %% This instruction sequence does nothing. + rename_instrs(Is); rename_instrs([{apply_last,A,N}|Is]) -> [{apply,A},{deallocate,N},return|rename_instrs(Is)]; rename_instrs([{call_last,A,F,N}|Is]) -> @@ -85,8 +100,12 @@ rename_instr({bs_put_utf16=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; rename_instr({bs_put_utf32=I,F,Fl,Src}) -> {bs_put,F,{I,Fl},[Src]}; -rename_instr({bs_put_string,_,_}=I) -> - {bs_put,{f,0},I,[]}; +rename_instr({bs_put_string,_,{string,String}}) -> + %% Only happens when compiling from .S files. In old + %% .S files, String is a list. In .S in OTP 22 and later, + %% String is a binary. + {bs_put,{f,0},{bs_put_binary,8,{field_flags,[unsigned,big]}}, + [{atom,all},{literal,iolist_to_binary([String])}]}; rename_instr({bs_add=I,F,[Src1,Src2,U],Dst}) when is_integer(U) -> {bif,I,F,[Src1,Src2,{integer,U}],Dst}; rename_instr({bs_utf8_size=I,F,Src,Dst}) -> @@ -103,16 +122,14 @@ rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; rename_instr(bs_init_writable=I) -> {bs_init,{f,0},I,1,[{x,0}],{x,0}}; -rename_instr({test,Op,F,[Ctx,Bits,{string,Str}]}) -> - %% When compiling from a .S file. - <<Bs:Bits/bits,_/bits>> = list_to_binary(Str), - {test,Op,F,[Ctx,Bs]}; rename_instr({put_map_assoc,Fail,S,D,R,L}) -> {put_map,Fail,assoc,S,D,R,L}; rename_instr({put_map_exact,Fail,S,D,R,L}) -> {put_map,Fail,exact,S,D,R,L}; rename_instr({test,has_map_fields,Fail,Src,{list,List}}) -> {test,has_map_fields,Fail,[Src|List]}; +rename_instr({test,is_nil,Fail,[Src]}) -> + {test,is_eq_exact,Fail,[Src,nil]}; rename_instr({select_val=I,Reg,Fail,{list,List}}) -> {select,I,Reg,Fail,List}; rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> @@ -120,3 +137,11 @@ rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> rename_instr(send) -> {call_ext,2,send}; rename_instr(I) -> I. + +coalesce_consecutive_labels([{label,L}=Lbl,{label,Alias}|Is], Replace, Acc) -> + coalesce_consecutive_labels([Lbl|Is], [{Alias,L}|Replace], Acc); +coalesce_consecutive_labels([I|Is], Replace, Acc) -> + coalesce_consecutive_labels(Is, Replace, [I|Acc]); +coalesce_consecutive_labels([], Replace, Acc) -> + D = maps:from_list(Replace), + beam_utils:replace_labels(Acc, [], D, fun(L) -> L end). diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index df0321e85a..df09dcb06c 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -407,14 +407,14 @@ 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) -> - %% Conservatily assume that all integers whose absolute + %% Conservatively 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); + encode_literal(N, Dict); N =< -(1 bsl 128) -> - encode_arg({literal, N}, Dict); + encode_literal(N, Dict); true -> {encode(?tag_i, N), Dict} end; @@ -424,8 +424,8 @@ encode_arg({f, W}, Dict) -> {encode(?tag_f, W), Dict}; %% encode_arg({'char', C}, Dict) -> %% {encode(?tag_h, C), Dict}; -encode_arg({string, String}, Dict0) -> - {Offset, Dict} = beam_dict:string(String, Dict0), +encode_arg({string, BinString}, Dict0) when is_binary(BinString) -> + {Offset, Dict} = beam_dict:string(BinString, Dict0), {encode(?tag_u, Offset), Dict}; encode_arg({extfunc, M, F, A}, Dict0) -> {Index, Dict} = beam_dict:import(M, F, A, Dict0), @@ -434,7 +434,7 @@ encode_arg({list, List}, Dict0) -> {L, Dict} = encode_list(List, Dict0, []), {[encode(?tag_z, 1), encode(?tag_u, length(List))|L], Dict}; encode_arg({float, Float}, Dict) when is_float(Float) -> - encode_arg({literal,Float}, Dict); + encode_literal(Float, Dict); encode_arg({fr,Fr}, Dict) -> {[encode(?tag_z, 2),encode(?tag_u, Fr)], Dict}; encode_arg({field_flags,Flags0}, Dict) -> @@ -442,12 +442,24 @@ encode_arg({field_flags,Flags0}, Dict) -> {encode(?tag_u, Flags), Dict}; encode_arg({alloc,List}, Dict) -> encode_alloc_list(List, Dict); -encode_arg({literal,Lit}, Dict0) -> - {Index,Dict} = beam_dict:literal(Lit, Dict0), - {[encode(?tag_z, 4),encode(?tag_u, Index)],Dict}; +encode_arg({literal,Lit}, Dict) -> + if + Lit =:= [] -> + encode_arg(nil, Dict); + is_atom(Lit) -> + encode_arg({atom,Lit}, Dict); + is_integer(Lit) -> + encode_arg({integer,Lit}, Dict); + true -> + encode_literal(Lit, Dict) + end; encode_arg(Int, Dict) when is_integer(Int) -> {encode(?tag_u, Int),Dict}. +encode_literal(Literal, Dict0) -> + {Index,Dict} = beam_dict:literal(Literal, Dict0), + {[encode(?tag_z, 4),encode(?tag_u, Index)],Dict}. + %%flag_to_bit(aligned) -> 16#01; %% No longer useful. flag_to_bit(little) -> 16#02; flag_to_bit(big) -> 16#00; diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index fe43163455..707974b2c1 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -17,39 +17,24 @@ %% %% %CopyrightEnd% %% -%% Purpose : Partitions assembly instructions into basic blocks and -%% optimizes them. +%% Purpose: Partition BEAM instructions into basic blocks. -module(beam_block). -export([module/2]). --import(lists, [reverse/1,reverse/2,member/2]). +-import(lists, [keysort/2,reverse/1,splitwith/2]). -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], +module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> + Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -function({function,Name,Arity,CLabel,Is0}, Blockify) -> +function({function,Name,Arity,CLabel,Is0}) -> try - %% Collect basic blocks and optimize them. - 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. + Is1 = blockify(Is0), + Is = embed_lines(Is1), {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> @@ -64,14 +49,12 @@ function({function,Name,Arity,CLabel,Is0}, Blockify) -> blockify(Is) -> blockify(Is, []). -blockify([{loop_rec,{f,Fail},{x,0}},{loop_rec_end,_Lbl},{label,Fail}|Is], Acc) -> - %% Useless instruction sequence. - blockify(Is, Acc); blockify([I|Is0]=IsAll, Acc) -> case collect(I) of error -> blockify(Is0, [I|Acc]); Instr when is_tuple(Instr) -> - {Block,Is} = collect_block(IsAll), + {Block0,Is} = collect_block(IsAll), + Block = sort_moves(Block0), blockify(Is, [{block,Block}|Acc]) end; blockify([], Acc) -> reverse(Acc). @@ -80,12 +63,10 @@ collect_block(Is) -> collect_block(Is, []). collect_block([{allocate,N,R}|Is0], Acc) -> - {Inits,Is} = lists:splitwith(fun ({init,{y,_}}) -> true; - (_) -> false - end, Is0), + {Inits,Is} = splitwith(fun ({init,{y,_}}) -> true; + (_) -> false + end, Is0), collect_block(Is, [{set,[],[],{alloc,R,{nozero,N,0,Inits}}}|Acc]); -collect_block([{allocate_zero,Ns,R},{test_heap,Nh,R}|Is], Acc) -> - collect_block(Is, [{set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}|Acc]); collect_block([I|Is]=Is0, Acc) -> case collect(I) of error -> {reverse(Acc),Is0}; @@ -100,23 +81,20 @@ collect({allocate_heap,Ns,Nh,R}) -> {set,[],[],{alloc,R,{nozero,Ns,Nh,[]}}}; collect({allocate_heap_zero,Ns,Nh,R}) -> {set,[],[],{alloc,R,{zero,Ns,Nh,[]}}}; collect({init,D}) -> {set,[D],[],init}; collect({test_heap,N,R}) -> {set,[],[],{alloc,R,{nozero,nostack,N,[]}}}; -collect({bif,N,F,As,D}) -> {set,[D],As,{bif,N,F}}; -collect({gc_bif,N,F,R,As,D}) -> {set,[D],As,{alloc,R,{gc_bif,N,F}}}; +collect({bif,N,{f,0},As,D}) -> {set,[D],As,{bif,N,{f,0}}}; +collect({gc_bif,N,{f,0},R,As,D}) -> {set,[D],As,{alloc,R,{gc_bif,N,{f,0}}}}; collect({move,S,D}) -> {set,[D],[S],move}; collect({put_list,S1,S2,D}) -> {set,[D],[S1,S2],put_list}; collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}}; collect({put,S}) -> {set,[],[S],put}; +collect({put_tuple2,D,{list,Els}}) -> {set,[D],Els,put_tuple2}; 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_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}}}; -collect({'catch'=Op,R,L}) -> - {set,[R],[],{try_catch,Op,L}}; -collect({'try'=Op,R,L}) -> - {set,[R],[],{try_catch,Op,L}}; +collect({put_map,{f,0},Op,S,D,R,{list,Puts}}) -> + {set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,0}}}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; collect({fmove,S,D}) -> {set,[D],[S],fmove}; @@ -137,557 +115,39 @@ 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. - [{'%anno',_}|Bl] = Bl0, - [{block,opt_block(Bl)}|opt_blocks(Is)]; -opt_blocks([I|Is]) -> - [I|opt_blocks(Is)]; -opt_blocks([]) -> []. - -opt_block(Is0) -> - find_fixpoint(fun(Is) -> - opt_tuple_element(opt(Is)) - end, Is0). - -find_fixpoint(OptFun, Is0) -> - case OptFun(Is0) of - Is0 -> Is0; - Is1 -> find_fixpoint(OptFun, Is1) - end. - -%% move_allocates(Is0) -> Is -%% Move allocate instructions upwards in the instruction stream -%% (within the same block), in the hope of getting more possibilities -%% for optimizing away moves later. -%% -%% For example, we can transform the following instructions: -%% -%% get_tuple_element x(1) Element => x(2) -%% allocate_zero StackSize 3 %% x(0), x(1), x(2) are live -%% -%% to the following instructions: -%% -%% allocate_zero StackSize 2 %% x(0) and x(1) are live -%% get_tuple_element x(1) Element => x(2) -%% -%% NOTE: Since the beam_reorder pass has been run, it is no longer -%% safe to assume that if x(N) is initialized, then all lower-numbered -%% x registers are also initialized. -%% -%% For example, we must be careful when transforming the following -%% instructions: -%% -%% get_tuple_element x(0) Element => x(1) -%% allocate_zero StackSize 3 %x(0), x(1), x(2) are live -%% -%% to the following instructions: -%% -%% allocate_zero StackSize 3 -%% get_tuple_element x(0) Element => x(1) -%% -%% The transformation is safe if and only if x(1) has been -%% 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), []), - [{block,Bl}|move_allocates(Is)]; -move_allocates([I|Is]) -> - [I|move_allocates(Is)]; -move_allocates([]) -> []. - -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([{'%anno',_}=I|Is]) -> - [I|opt(Is)]; -opt([]) -> []. - -%% opt_moves([Dest], [Instruction]) -> {[Dest],[Instruction]} -%% For each Dest, does the optimization described in opt_move/2. - -opt_moves([], Is0) -> {[],Is0}; -opt_moves([D0]=Ds, Is0) -> - case opt_move(D0, Is0) of - not_possible -> {Ds,Is0}; - {D1,Is} -> {[D1],Is} - end. - -%% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible -%% If there is a {move,Dest,FinalDest} instruction -%% in the instruction stream, remove the move instruction -%% and let FinalDest be the destination. - -opt_move(Dest, Is) -> - opt_move_1(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 - {yes,Is} -> opt_move_rev(D, Acc, Is); - no -> not_possible - end; -opt_move_1(_R, [{set,_,_,{alloc,_,_}}|_], _) -> - %% The optimization is either not possible or not safe. - %% - %% If R is an X register killed by allocation, the optimization is - %% not safe. On the other hand, if the X register is killed, there - %% will not follow a 'move' instruction with this X register as - %% the source. - %% - %% If R is a Y register, the optimization is still not safe - %% because the new target register is an X register that cannot - %% safely pass the alloc instruction. - not_possible; -opt_move_1(R, [{set,_,_,_}=I|Is], Acc) -> - %% If the source register is either killed or used by this - %% instruction, the optimimization is not possible. - case is_killed_or_used(R, I) of - true -> not_possible; - false -> opt_move_1(R, Is, [I|Acc]) - end; -opt_move_1(_, _, _) -> - not_possible. - -%% opt_tuple_element([Instruction]) -> [Instruction] -%% If possible, move get_tuple_element instructions forward -%% in the instruction stream to a move instruction, eliminating -%% the move instruction. Example: -%% -%% get_tuple_element Tuple Pos Dst1 -%% ... -%% move Dst1 Dst2 -%% -%% This code may be possible to rewrite to: -%% -%% %%(Moved get_tuple_element instruction) -%% ... -%% get_tuple_element Tuple Pos Dst2 -%% - -opt_tuple_element([{set,[D],[S],{get_tuple_element,_}}=I|Is0]) -> - case opt_tuple_element_1(Is0, I, {S,D}, []) of - no -> - [I|opt_tuple_element(Is0)]; - {yes,Is} -> - opt_tuple_element(Is) - end; -opt_tuple_element([I|Is]) -> - [I|opt_tuple_element(Is)]; -opt_tuple_element([]) -> []. - -opt_tuple_element_1([{set,_,_,{alloc,_,_}}|_], _, _, _) -> - no; -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 - no -> - no; - {yes,Is1} -> - {set,[S],Ss,Op} = I0, - I = {set,[D],Ss,Op}, - 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 - true -> - no; - false -> - opt_tuple_element_1(Is, MovedI, Regs, [I|Acc]) - end; -opt_tuple_element_1(_, _, _, _) -> no. - -%% Reverse the instructions, while checking that there are no -%% instructions that would interfere with using the new destination -%% register (D). - -opt_move_rev(D, [I|Is], Acc) -> - case is_killed_or_used(D, I) of - true -> not_possible; - false -> opt_move_rev(D, Is, [I|Acc]) - end; -opt_move_rev(D, [], Acc) -> {D,Acc}. - -%% is_killed_or_used(Register, {set,_,_,_}) -> bool() -%% Test whether the register is used by the instruction. - -is_killed_or_used(R, {set,Ss,Ds,_}) -> - member(R, Ds) orelse member(R, Ss). - -%% eliminate_use_of_from_reg([Instruction], FromRegister, ToRegister, Acc) -> -%% {yes,Is} | no -%% Eliminate any use of FromRegister in the instruction sequence -%% by replacing uses of FromRegister with ToRegister. If FromRegister -%% is referenced by an allocation instruction, return 'no' to indicate -%% 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 -> - no; - true -> - {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, - case member(From, Ds) of - 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 - true -> - {yes,reverse(Acc, Is)}; - false -> - 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], D) -> - Live = Live0, %Assertion. - Alloc = combine_alloc(Info0, Info), - I = {set,[],[],{alloc,Live,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, _D, nostack, Nh, LivingRegs) -> - {alloc,LivingRegs,{nozero,nostack,Nh,[]}}; -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)}}; - _ -> - {alloc,LivingRegs,{zero,Ns,Nh,[]}} - end. - -gen_init(Fs, Regs) -> gen_init(Fs, Regs, 0, []). - -gen_init(SameFs, _Regs, SameFs, Acc) -> reverse(Acc); -gen_init(Fs, Regs, Y, Acc) when Regs band 1 =:= 0 -> - gen_init(Fs, Regs bsr 1, Y+1, [{init,{y,Y}}|Acc]); -gen_init(Fs, Regs, Y, Acc) -> - gen_init(Fs, Regs bsr 1, Y+1, Acc). - -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; -count_ones(Bits, Acc) -> - count_ones(Bits bsr 1, Acc + (Bits band 1)). - -%% Calculate the new number of live registers when we move an allocate -%% instruction upwards, passing a 'set' instruction. - -alloc_live_regs({set,Ds,Ss,_}, Is, Regs0) -> - Rset = x_live(Ss, x_dead(Ds, (1 bsl Regs0)-1)), - 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) -> - 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); -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 +%% sort_moves([Instruction]) -> [Instruction]. +%% Sort move instructions on the Y register to give the loader +%% more opportunities for combining instructions. + +sort_moves([{set,[{x,_}],[{y,_}],move}=I|Is0]) -> + {Moves,Is} = sort_moves_1(Is0, x, y, [I]), + Moves ++ sort_moves(Is); +sort_moves([{set,[{y,_}],[{x,_}],move}=I|Is0]) -> + {Moves,Is} = sort_moves_1(Is0, y, x, [I]), + Moves ++ sort_moves(Is); +sort_moves([I|Is]) -> + [I|sort_moves(Is)]; +sort_moves([]) -> []. + +sort_moves_1([{set,[{x,0}],[_],move}=I|Is], _DTag, _STag, Acc) -> + %% The loader sometimes combines a move to x0 with the + %% instruction that follows, producing, for example, a move_call + %% instruction. Therefore, we don't want include this move + %% instruction in the sorting. + {sort_on_yreg(Acc)++[I],Is}; +sort_moves_1([{set,[{DTag,_}],[{STag,_}],move}=I|Is], DTag, STag, Acc) -> + sort_moves_1(Is, DTag, STag, [I|Acc]); +sort_moves_1(Is, _DTag, _STag, Acc) -> + {sort_on_yreg(Acc),Is}. + +sort_on_yreg([{set,[Dst],[Src],move}|_]=Moves) -> + case {Dst,Src} of + {{y,_},{x,_}} -> + keysort(2, Moves); + {{x,_},{y,_}} -> + keysort(3, Moves) end. diff --git a/lib/compiler/src/beam_bs.erl b/lib/compiler/src/beam_bs.erl deleted file mode 100644 index 5f1b9ed488..0000000000 --- a/lib/compiler/src/beam_bs.erl +++ /dev/null @@ -1,280 +0,0 @@ -%% -%% %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 : Partitions assembly instructions into basic blocks and -%% optimizes them. - --module(beam_bs). - --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}}. - -function({function,Name,Arity,CLabel,Is0}, Lc0) -> - try - Is1 = bs_put_opt(Is0), - {Is,Lc} = bsm_opt(Is1, Lc0), - {{function,Name,Arity,CLabel,Is},Lc} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%%% -%%% Evaluation of constant bit fields. -%%% - -bs_put_opt([{bs_put,_,_,_}=I|Is0]) -> - {BsPuts0,Is} = collect_bs_puts(Is0, [I]), - BsPuts = opt_bs_puts(BsPuts0), - BsPuts ++ bs_put_opt(Is); -bs_put_opt([I|Is]) -> - [I|bs_put_opt(Is)]; -bs_put_opt([]) -> []. - -collect_bs_puts([{bs_put,_,_,_}=I|Is], Acc) -> - collect_bs_puts(Is, [I|Acc]); -collect_bs_puts([_|_]=Is, Acc) -> - {reverse(Acc),Is}. - -opt_bs_puts(Is) -> - opt_bs_1(Is, []). - -opt_bs_1([{bs_put,Fail, - {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> - try eval_put_float(Src, Sz, Flags0) of - <<Int:Sz>> -> - Flags = force_big(Flags0), - I = {bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}, - opt_bs_1([I|Is], Acc) - catch - error:_ -> - opt_bs_1(Is, [I0|Acc]) - end; -opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, - Acc0) -> - {Is,Acc} = bs_collect_string(IsAll, Acc0), - opt_bs_1(Is, Acc); -opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], - Acc) when Sz > 8 -> - case field_endian(F) of - big -> - %% We can do this optimization for any field size without - %% risk for code explosion. - case bs_split_int(N, Sz, Fail, Is0) of - no_split -> opt_bs_1(Is0, [I|Acc]); - Is -> opt_bs_1(Is, Acc) - end; - little when Sz < 128 -> - %% We only try to optimize relatively small fields, to - %% avoid an explosion in code size. - <<Int:Sz>> = <<N:Sz/little>>, - Flags = force_big(F), - Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, - [{integer,Sz},{integer,Int}]}|Is0], - opt_bs_1(Is, Acc); - _ -> %native or too wide little field - opt_bs_1(Is0, [I|Acc]) - end; -opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> - opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); -opt_bs_1([I|Is], Acc) -> - opt_bs_1(Is, [I|Acc]); -opt_bs_1([], Acc) -> reverse(Acc). - -eval_put_float(Src, Sz, Flags) when Sz =< 256 -> - %%Only evaluate if Sz is reasonable. - Val = value(Src), - case field_endian(Flags) of - little -> <<Val:Sz/little-float-unit:1>>; - big -> <<Val:Sz/big-float-unit:1>> - %% native intentionally not handled here - we can't optimize - %% it. - end. - -value({integer,I}) -> I; -value({float,F}) -> F. - -bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> - bs_coll_str_1(Is, Len, reverse(Str), Acc); -bs_collect_string(Is, Acc) -> - bs_coll_str_1(Is, 0, [], Acc). - -bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], - Len, StrAcc, IsAcc) when U*Sz =:= 8 -> - Byte = V band 16#FF, - bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); -bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> - {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. - -field_endian({field_flags,F}) -> field_endian_1(F). - -field_endian_1([big=E|_]) -> E; -field_endian_1([little=E|_]) -> E; -field_endian_1([native=E|_]) -> E; -field_endian_1([_|Fs]) -> field_endian_1(Fs). - -force_big({field_flags,F}) -> - {field_flags,force_big_1(F)}. - -force_big_1([big|_]=Fs) -> Fs; -force_big_1([little|Fs]) -> [big|Fs]; -force_big_1([F|Fs]) -> [F|force_big_1(Fs)]. - -bs_split_int(0, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only zeroes. - no_split; -bs_split_int(-1, Sz, _, _) when Sz > 64 -> - %% We don't want to split in this case because the - %% string will consist of only 255 bytes. - no_split; -bs_split_int(N, Sz, Fail, Acc) -> - FirstByteSz = case Sz rem 8 of - 0 -> 8; - Rem -> Rem - end, - bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). - -bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,-1}]}, - [I|Acc]; -bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,Sz},{integer,0}]}, - [I|Acc]; -bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> - Mask = (1 bsl ByteSz) - 1, - I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, - [{integer,ByteSz},{integer,N band Mask}]}, - bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); -bs_split_int_1(_, _, _, _, Acc) -> Acc. - -%%% -%%% Optimization of bit syntax matching: get rid -%%% of redundant bs_restore2/2 instructions across select_val -%%% instructions, as well as a few other simple peep-hole -%%% optimizations. -%%% - -bsm_opt(Is0, Lc0) -> - {Is1,D0,Lc} = bsm_scan(Is0, [], Lc0, []), - Is2 = case D0 of - [] -> - %% No bit syntax matching in this function. - Is1; - [_|_] -> - %% Optimize the bit syntax matching. - D = gb_trees:from_orddict(orddict:from_list(D0)), - bsm_reroute(Is1, D, none, []) - end, - Is = beam_clean:bs_clean_saves(Is2), - {bsm_opt_2(Is, []),Lc}. - -bsm_scan([{label,L}=Lbl,{bs_restore2,_,Save}=R|Is], D0, Lc, Acc0) -> - D = [{{L,Save},Lc}|D0], - Acc = [{label,Lc},R,Lbl|Acc0], - bsm_scan(Is, D, Lc+1, Acc); -bsm_scan([I|Is], D, Lc, Acc) -> - bsm_scan(Is, D, Lc, [I|Acc]); -bsm_scan([], D, Lc, Acc) -> - {reverse(Acc),D,Lc}. - -bsm_reroute([{bs_save2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) -> - bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); -bsm_reroute([{label,_}=I|Is], D, S, Acc) -> - bsm_reroute(Is, D, S, [I|Acc]); -bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) -> - [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D), - Acc = [{select,select_val,Reg,F,Lbls}|Acc0], - bsm_reroute(Is, D, S, Acc); -bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,TestArgs}|Acc0], - case bsm_not_bs_test(I) of - true -> - %% The test instruction will not update the bit offset for - %% the binary being matched. Therefore the save position - %% can be kept. - bsm_reroute(Is, D, S, Acc); - false -> - %% The test instruction might update the bit offset. Kill - %% our remembered Save position. - bsm_reroute(Is, D, none, Acc) - end; -bsm_reroute([{test,TestOp,F0,Live,TestArgs,Dst}|Is], D, {_,Save}, Acc0) -> - F = bsm_subst_label(F0, Save, D), - Acc = [{test,TestOp,F,Live,TestArgs,Dst}|Acc0], - %% The test instruction will update the bit offset. Kill our - %% remembered Save position. - bsm_reroute(Is, D, none, Acc); -bsm_reroute([{block,[{set,[],[],{alloc,_,_}}]}=Bl, - {bs_context_to_binary,_}=I|Is], D, S, Acc) -> - %% To help further bit syntax optimizations. - bsm_reroute([I,Bl|Is], D, S, Acc); -bsm_reroute([I|Is], D, _, Acc) -> - bsm_reroute(Is, D, none, [I|Acc]); -bsm_reroute([], _, _, Acc) -> reverse(Acc). - -bsm_opt_2([{test,bs_test_tail2,F,[Ctx,Bits]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I},Unit,_Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_test_tail2,F,[Ctx,Bits+I*Unit]}|Acc]); -bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is], - [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) -> - bsm_opt_2(Is, [{test,bs_skip_bits2,F, - [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); -bsm_opt_2([I|Is], Acc) -> - bsm_opt_2(Is, [I|Acc]); -bsm_opt_2([], Acc) -> reverse(Acc). - -%% bsm_not_bs_test({test,Name,_,Operands}) -> true|false. -%% Test whether is the test is a "safe", i.e. does not move the -%% bit offset for a binary. -%% -%% 'true' means that the test is safe, 'false' that we don't know or -%% that the test moves the offset (e.g. bs_get_integer2). - -bsm_not_bs_test({test,bs_test_tail2,_,[_,_]}) -> true; -bsm_not_bs_test(Test) -> beam_utils:is_pure_test(Test). - -bsm_subst_labels(Fs, Save, D) -> - bsm_subst_labels_1(Fs, Save, D, []). - -bsm_subst_labels_1([F|Fs], Save, D, Acc) -> - bsm_subst_labels_1(Fs, Save, D, [bsm_subst_label(F, Save, D)|Acc]); -bsm_subst_labels_1([], _, _, Acc) -> - reverse(Acc). - -bsm_subst_label({f,Lbl0}=F, Save, D) -> - case gb_trees:lookup({Lbl0,Save}, D) of - {value,Lbl} -> {f,Lbl}; - none -> F - end; -bsm_subst_label(Other, _, _) -> Other. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl deleted file mode 100644 index 1c8e0e9854..0000000000 --- a/lib/compiler/src/beam_bsm.erl +++ /dev/null @@ -1,708 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(beam_bsm). --export([module/2,format_error/1]). - --import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2]). - -%%% -%%% We optimize bit syntax matching where the tail end of a binary is -%%% matched out and immediately passed on to a bs_start_match2 instruction, -%%% such as in this code sequence: -%%% -%%% func_info ... -%%% L1 test bs_start_match2 {f,...} {x,0} Live SavePositions {x,0} -%%% . . . -%%% test bs_get_binary2 {f,...} {x,0} all 1 Flags {x,0} -%%% . . . -%%% call_only 2 L1 -%%% -%%% The sequence can be optimized simply by removing the bs_get_binary2 -%%% instruction. Another example: -%%% -%%% func_info ... -%%% L1 test bs_start_match2 {f,...} {x,0} Live SavePositions {x,0} -%%% . . . -%%% test bs_get_binary2 {f,...} {x,0} all 8 Flags {x,1} -%%% . . . -%%% move {x,1} {x,0} -%%% call_only 2 L1 -%%% -%%% In this case, the bs_get_binary2 instruction must be replaced by -%%% -%%% test bs_unit {x,1} 8 -%%% -%%% to ensure that the match fail if the length of the binary in bits -%%% is not evenly divisible by 8. -%%% -%%% Note that the bs_start_match2 instruction doesn't need to be in the same -%%% function as the caller. It can be in the beginning of any function, or -%%% follow the bs_get_binary2 instruction in the same function. The important -%%% thing is that the match context register is not copied or built into -%%% data structures or passed to BIFs. -%%% - --type label() :: beam_asm:label(). --type func_info() :: {beam_asm:reg(),boolean()}. - --record(btb, - {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) -> - 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 -> - {ok,Code,collect_warnings(Fs)}; - false -> - {ok,Code} - end. - --spec format_error('bin_opt' | {'no_bin_opt', term()}) -> nonempty_string(). - -format_error(bin_opt) -> - "OPTIMIZED: creation of sub binary delayed"; -format_error({no_bin_opt,Reason}) -> - lists:flatten(["NOT OPTIMIZED: "|format_error_1(Reason)]). - -%%% -%%% Local functions. -%%% - -function({function,Name,Arity,Entry,Is}, FIndex) -> - try - Index = beam_utils:index_labels(Is), - D = #btb{f=FIndex,index=Index}, - {function,Name,Arity,Entry,btb_opt_1(Is, D, [])} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -btb_opt_1([{test,bs_get_binary2,F,_,[Reg,{atom,all},U,Fs],Reg}=I0|Is], D, Acc0) -> - case btb_reaches_match(Is, [Reg], D) of - {error,Reason} -> - Comment = btb_comment_no_opt(Reason, Fs), - btb_opt_1(Is, D, [Comment,I0|Acc0]); - {ok,MustSave} -> - Comment = btb_comment_opt(Fs), - Acc1 = btb_gen_save(MustSave, Reg, [Comment|Acc0]), - Acc = case U of - 1 -> Acc1; - _ -> [{test,bs_test_unit,F,[Reg,U]}|Acc1] - end, - btb_opt_1(Is, D, Acc) - end; -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(Is0, D, [Comment,I0|Acc0]); - {ok,MustSave} when U =:= 1 -> - Comment = btb_comment_opt(Fs), - 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 = [{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) -> - %%io:format("~p\n", [I]), - btb_opt_1(Is, D, [I|Acc]); -btb_opt_1([], _, Acc) -> - reverse(Acc). - -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} -%% -%% The list of Registers should be a list of registers referencing a -%% match context. The Register may contain one element if the -%% bs_get_binary2 instruction looks like -%% -%% test bs_get_binary2 {f,...} Ctx all _ _ Ctx -%% -%% or two elements if the instruction looks like -%% -%% test bs_get_binary2 {f,...} Ctx all _ _ Dst -%% -%% This function determines whether the bs_get_binary2 instruction -%% can be omitted (retaining the match context instead of creating -%% a sub binary). -%% -%% The rule is that the match context ultimately must end up at a -%% bs_start_match2 instruction and nowhere else. That it, it must not -%% be passed to BIFs, or copied or put into data structures. There -%% must only be one copy alive when the match context reaches the -%% bs_start_match2 instruction. -%% -%% At a branch, we must follow all branches and make sure that the above -%% rule is followed (or that the branch kills the match context). -%% -%% The MustSave return value will be true if control may end up at -%% bs_context_to_binary instruction. Since that instruction uses the -%% saved start position, we must use "bs_save2 Ctx start" to -%% update the saved start position. An additional complication is that -%% "bs_save2 Ctx start" must not be used if Dst and Ctx are -%% different registers and both registers may be passed to -%% a bs_context_to_binary instruction. -%% - -btb_reaches_match(Is, RegList, D) -> - try - Regs = btb_regs_from_list(RegList), - #btb{must_not_save=MustNotSave,must_save=MustSave} = - btb_reaches_match_1(Is, Regs, D), - case MustNotSave andalso MustSave of - true -> btb_error(must_and_must_not_save); - false -> {ok,MustSave} - end - catch - throw:{error,_}=Error -> Error - end. - -btb_reaches_match_1(Is, Regs, D) -> - case btb_are_registers_empty(Regs) of - false -> - btb_reaches_match_2(Is, Regs, D); - true -> - %% The context was killed, which is OK. - D - end. - -btb_reaches_match_2([{block,Bl}|Is], Regs0, D) -> - Regs = btb_reaches_match_block(Bl, Regs0), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{call,Arity,{f,Lbl}}|Is], Regs0, D) -> - case is_tail_call(Is) of - true -> - Regs1 = btb_kill_not_live(Arity, Regs0), - Regs = btb_kill_yregs(Regs1), - btb_tail_call(Lbl, Regs, D); - false -> - btb_call(Arity, Lbl, Regs0, Is, D) - end; -btb_reaches_match_2([{apply,Arity}|Is], Regs, D) -> - btb_call(Arity+2, apply, Regs, Is, D); -btb_reaches_match_2([{call_fun,Live}=I|Is], Regs, D) -> - btb_ensure_not_used([{x,Live}], I, Regs), - btb_call(Live, I, Regs, Is, D); -btb_reaches_match_2([{make_fun2,_,_,_,Live}|Is], Regs, D) -> - btb_call(Live, make_fun2, Regs, Is, D); -btb_reaches_match_2([{call_ext,Arity,Func}=I|Is], Regs0, D) -> - %% Allow us scanning beyond the call in case the match - %% context is saved on the stack. - case beam_jump:is_exit_instruction(I) of - false -> - btb_call(Arity, Func, Regs0, Is, D); - true -> - Regs = btb_kill_not_live(Arity, Regs0), - btb_tail_call(Func, Regs, D) - end; -btb_reaches_match_2([{kill,Y}|Is], Regs, D) -> - btb_reaches_match_1(Is, btb_kill([Y], Regs), D); -btb_reaches_match_2([{deallocate,_}|Is], Regs0, D) -> - Regs = btb_kill_yregs(Regs0), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([return=I|_], Regs0, D) -> - btb_ensure_not_used([{x,0}], I, Regs0), - D; -btb_reaches_match_2([{gc_bif,_,{f,F},Live,Ss,Dst}=I|Is], Regs0, D0) -> - btb_ensure_not_used(Ss, I, Regs0), - Regs1 = btb_kill_not_live(Live, Regs0), - Regs = btb_kill([Dst], Regs1), - D = btb_follow_branch(F, Regs, D0), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bif,_,{f,F},Ss,Dst}=I|Is], Regs0, D0) -> - btb_ensure_not_used(Ss, I, Regs0), - Regs = btb_kill([Dst], Regs0), - D = btb_follow_branch(F, Regs, D0), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{get_map_elements,{f,F},Src,{list,Ls}}=I|Is], Regs0, D0) -> - {Ss,Ds} = beam_utils:split_even(Ls), - btb_ensure_not_used([Src|Ss], I, Regs0), - Regs = btb_kill(Ds, Regs0), - D = btb_follow_branch(F, Regs, D0), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{test,bs_start_match2,{f,F},Live,[Ctx,_],Ctx}=I|Is], - Regs0, D0) -> - CtxRegs = btb_context_regs(Regs0), - case member(Ctx, CtxRegs) of - false -> - %% This bs_start_match2 instruction does not use "our" - %% match state. Therefore we can continue the search - %% for another bs_start_match2 instruction. - D = btb_follow_branch(F, Regs0, D0), - Regs = btb_kill_not_live(Live, Regs0), - btb_reaches_match_2(Is, Regs, D); - true -> - %% OK. This instruction will use "our" match state, - %% but we must make sure that all other copies of the - %% match state are killed in the code that follows - %% the instruction. (We know that the fail branch cannot - %% be taken in this case.) - OtherCtxRegs = CtxRegs -- [Ctx], - case btb_are_all_unused(OtherCtxRegs, Is, D0) of - false -> btb_error({OtherCtxRegs,not_all_unused_after,I}); - true -> D0 - end - end; -btb_reaches_match_2([{test,bs_start_match2,{f,F},Live,[Bin,_],Ctx}|Is], - Regs0, D0) -> - CtxRegs = btb_context_regs(Regs0), - case member(Bin, CtxRegs) orelse member(Ctx, CtxRegs) of - false -> - %% This bs_start_match2 does not reference any copy of the - %% match state. Therefore it can safely be passed on the - %% way to another (perhaps more suitable) bs_start_match2 - %% instruction. - D = btb_follow_branch(F, Regs0, D0), - Regs = btb_kill_not_live(Live, Regs0), - btb_reaches_match_2(Is, Regs, D); - true -> - %% This variant of the bs_start_match2 instruction does - %% not accept a match state as source. - btb_error(unsuitable_bs_start_match) - 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), - 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), - D = btb_follow_branch(F, Regs, D0), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{select,_,Src,{f,F},Conds}=I|Is], Regs, D0) -> - btb_ensure_not_used([Src], I, Regs), - D1 = btb_follow_branch(F, Regs, D0), - D = btb_follow_branches(Conds, Regs, D1), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{jump,{f,Lbl}}|_], Regs, #btb{index=Li}=D) -> - Is = fetch_code_at(Lbl, Li), - btb_reaches_match_2(Is, Regs, D); -btb_reaches_match_2([{label,_}|Is], Regs, D) -> - btb_reaches_match_2(Is, Regs, D); -btb_reaches_match_2([{bs_init,{f,0},_,_,Ss,Dst}=I|Is], Regs, D) -> - btb_ensure_not_used(Ss, I, Regs), - btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([{bs_put,{f,0},_,Ss}=I|Is], Regs, D) -> - btb_ensure_not_used(Ss, I, Regs), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_restore2,Src,_}=I|Is], Regs0, D) -> - case btb_contains_context(Src, Regs0) of - false -> - btb_reaches_match_1(Is, Regs0, D); - true -> - %% Check that all other copies of the context registers - %% are unused by the following instructions. - Regs = btb_kill([Src], Regs0), - CtxRegs = btb_context_regs(Regs), - case btb_are_all_unused(CtxRegs, Is, D) of - false -> btb_error({CtxRegs,not_all_unused_after,I}); - true -> D#btb{must_not_save=true} - end - end; -btb_reaches_match_2([{bs_context_to_binary,Src}=I|Is], Regs0, D) -> - case btb_contains_context(Src, Regs0) of - false -> - btb_reaches_match_1(Is, Regs0, D); - true -> - %% Check that all other copies of the context registers - %% are unused by the following instructions. - Regs = btb_kill([Src], Regs0), - CtxRegs = btb_context_regs(Regs), - case btb_are_all_unused(CtxRegs, Is, D) of - false -> btb_error({CtxRegs,not_all_unused_after,I}); - true -> D#btb{must_not_save=true} - end - end; -btb_reaches_match_2([{badmatch,Src}=I|_], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - D; -btb_reaches_match_2([{case_end,Src}=I|_], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - D; -btb_reaches_match_2([if_end|_], _Regs, D) -> - D; -btb_reaches_match_2([{func_info,_,_,Arity}=I|_], Regs0, D) -> - Regs = btb_kill_yregs(btb_kill_not_live(Arity, Regs0)), - case btb_context_regs(Regs) of - [] -> D; - _ -> {binary_used_in,I} - end; -btb_reaches_match_2([{line,_}|Is], Regs, D) -> - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([I|_], Regs, _) -> - btb_error({btb_context_regs(Regs),I,not_handled}). - -is_tail_call([{deallocate,_}|_]) -> true; -is_tail_call([return|_]) -> true; -is_tail_call(_) -> false. - -btb_call(Arity, Lbl, Regs0, Is, D0) -> - Regs = btb_kill_not_live(Arity, Regs0), - case btb_are_x_registers_empty(Regs) of - false -> - %% There is a match context in one of the x registers. - %% First handle the call as if it were a tail call. - D = btb_tail_call(Lbl, Regs, D0), - - %% No problem so far (the called function can handle a - %% match context). Now we must make sure that we don't - %% have any copies of the match context tucked away in an - %% y register. - RegList = btb_context_regs(Regs), - case [R || {y,_}=R <- RegList] of - [] -> - D; - [_|_] -> - btb_error({multiple_uses,RegList}) - end; - true -> - %% No match context in any x register. It could have been - %% saved to an y register, so continue to scan the code following - %% the call. - btb_reaches_match_1(Is, Regs, D0) - end. - -btb_tail_call(Lbl, Regs, #btb{f=Ftree,must_save=MustSave0}=D) -> - %% Ignore any y registers here. - case [R || {x,_}=R <- btb_context_regs(Regs)] of - [] -> - D; - [{x,_}=Reg] -> - case gb_trees:lookup(Lbl, Ftree) of - {value,{Reg,MustSave}} -> - D#btb{must_save=MustSave0 or MustSave}; - _ when is_integer(Lbl) -> - btb_error({{label,Lbl},no_suitable_bs_start_match}); - _ -> - btb_error({binary_used_in,Lbl}) - end; - [_|_] when not is_integer(Lbl) -> - btb_error({binary_used_in,Lbl}); - [_|_]=RegList -> - btb_error({multiple_uses,RegList}) - end. - -%% btb_follow_branches([Cond], Regs, D) -> D' -%% Recursively follow all the branches. - -btb_follow_branches([{f,Lbl}|T], Regs, D0) -> - D = btb_follow_branch(Lbl, Regs, D0), - btb_follow_branches(T, Regs, D); -btb_follow_branches([_|T], Regs, D) -> - btb_follow_branches(T, Regs, D); -btb_follow_branches([], _, D) -> D. - -%% btb_follow_branch(Lbl, Regs, D) -> D' -%% Recursively follow the branch. - -btb_follow_branch(0, _Regs, D) -> D; -btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> - Key = {Lbl,Regs}, - case gb_sets:is_member(Key, Br0) of - true -> - %% We have already followed this branch and it was OK. - D; - false -> - %% New branch. Try it. - Is = fetch_code_at(Lbl, Li), - #btb{ok_br=Br,must_not_save=MustNotSave,must_save=MustSave} = - btb_reaches_match_1(Is, Regs, D), - - %% Since we got back, this branch is OK. - D#btb{ok_br=gb_sets:insert(Key, Br),must_not_save=MustNotSave, - must_save=MustSave} - end. - -btb_reaches_match_block([{set,Ds,Ss,{alloc,Live,_}}=I|Is], Regs0) -> - %% An allocation instruction or a GC bif. We'll kill all registers - %% if any copy of the context is used as the source to the BIF. - btb_ensure_not_used(Ss, I, Regs0), - Regs1 = btb_kill_not_live(Live, Regs0), - Regs = btb_kill(Ds, Regs1), - btb_reaches_match_block(Is, Regs); -btb_reaches_match_block([{set,[Dst]=Ds,[Src],move}|Is], Regs0) -> - Regs1 = btb_kill(Ds, Regs0), - Regs = case btb_contains_context(Src, Regs1) of - false -> Regs1; - true -> btb_set_context(Dst, Regs1) - end, - btb_reaches_match_block(Is, Regs); -btb_reaches_match_block([{set,Ds,Ss,_}=I|Is], Regs0) -> - btb_ensure_not_used(Ss, I, Regs0), - Regs = btb_kill(Ds, Regs0), - btb_reaches_match_block(Is, Regs); -btb_reaches_match_block([], Regs) -> - Regs. - -%% btb_are_all_killed([Register], [Instruction], D) -> true|false -%% Test whether all of the register are unused in the instruction stream. - -btb_are_all_unused(RegList, Is, #btb{index=Li}) -> - all(fun(R) -> - beam_utils:is_not_used(R, Is, Li) - end, RegList). - -%% btp_regs_from_list([Register]) -> RegisterSet. -%% Create a register set from a list of registers. - -btb_regs_from_list(L) -> - foldl(fun(R, Regs) -> - btb_set_context(R, Regs) - end, {0,0}, L). - -%% btb_set_context(Register, RegisterSet) -> RegisterSet' -%% Update RegisterSet to indicate that Register contains the matching context. - -btb_set_context({x,N}, {Xregs,Yregs}) -> - {Xregs bor (1 bsl N),Yregs}; -btb_set_context({y,N}, {Xregs,Yregs}) -> - {Xregs,Yregs bor (1 bsl N)}. - -%% btb_ensure_not_used([Register], Instruction, RegisterSet) -> ok -%% If any register in RegisterSet (the register(s) known to contain -%% the match context) is used in the list of registers, generate an error. - -btb_ensure_not_used(Rs, I, Regs) -> - case lists:any(fun(R) -> btb_contains_context(R, Regs) end, Rs) of - true -> btb_error({binary_used_in,I}); - false -> ok - end. - -%% btb_kill([Register], RegisterSet) -> RegisterSet' -%% Kill all registers mentioned in the list of registers. - -btb_kill([{x,N}|Rs], {Xregs,Yregs}) -> - btb_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs}); -btb_kill([{y,N}|Rs], {Xregs,Yregs}) -> - btb_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))}); -btb_kill([{fr,_}|Rs], Regs) -> - btb_kill(Rs, Regs); -btb_kill([], Regs) -> Regs. - -%% btb_kill_not_live(Live, RegisterSet) -> RegisterSet' -%% Kill all registers indicated not live by Live. - -btb_kill_not_live(Live, {Xregs,Yregs}) -> - {Xregs band ((1 bsl Live)-1),Yregs}. - -%% btb_kill(Regs0) -> Regs -%% Kill all y registers. - -btb_kill_yregs({Xregs,_}) -> {Xregs,0}. - -%% btb_are_registers_empty(RegisterSet) -> true|false -%% Test whether the register set is empty. - -btb_are_registers_empty({0,0}) -> true; -btb_are_registers_empty({_,_}) -> false. - -%% btb_are_x_registers_empty(Regs) -> true|false -%% Test whether the x registers are empty. - -btb_are_x_registers_empty({0,_}) -> true; -btb_are_x_registers_empty({_,_}) -> false. - -%% btb_contains_context(Register, RegisterSet) -> true|false -%% Test whether Register contains the context. - -btb_contains_context({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0; -btb_contains_context({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0; -btb_contains_context(_, _) -> false. - -%% btb_context_regs(RegisterSet) -> [Register] -%% Convert the register set to an explicit list of registers. -btb_context_regs({Xregs,Yregs}) -> - btb_context_regs_1(Xregs, 0, x, btb_context_regs_1(Yregs, 0, y, [])). - -btb_context_regs_1(0, _, _, Acc) -> - Acc; -btb_context_regs_1(Regs, N, Tag, Acc) when (Regs band 1) =:= 1 -> - btb_context_regs_1(Regs bsr 1, N+1, Tag, [{Tag,N}|Acc]); -btb_context_regs_1(Regs, N, Tag, Acc) -> - btb_context_regs_1(Regs bsr 1, N+1, Tag, Acc). - -%% btb_index([Function]) -> GbTree({EntryLabel,{Register,MustSave}}) -%% Build an index of functions that accept a match context instead of -%% a binary. MustSave is true if the function may pass the match -%% context to the bs_context_to_binary instruction (in which case -%% the current position in the binary must have saved into the -%% start position using "bs_save_2 Ctx start"). - -btb_index(Fs) -> - btb_index_1(Fs, []). - -btb_index_1([{function,_,_,Entry,Is0}|Fs], Acc0) -> - Is = drop_to_label(Is0, Entry), - Acc = btb_index_2(Is, Entry, false, Acc0), - btb_index_1(Fs, Acc); -btb_index_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). - -btb_index_2([{test,bs_start_match2,{f,_},_,[Reg,_],Reg}|_], - Entry, MustSave, Acc) -> - [{Entry,{Reg,MustSave}}|Acc]; -btb_index_2(Is0, Entry, _, Acc) -> - try btb_index_find_start_match(Is0) of - Is -> btb_index_2(Is, Entry, true, Acc) - catch - throw:none -> Acc - end. - -drop_to_label([{label,L}|Is], L) -> Is; -drop_to_label([_|Is], L) -> drop_to_label(Is, L). - -btb_index_find_start_match([{test,_,{f,F},_},{bs_context_to_binary,_}|Is]) -> - btb_index_find_label(Is, F); -btb_index_find_start_match(_) -> - throw(none). - -btb_index_find_label([{label,L}|Is], L) -> Is; -btb_index_find_label([_|Is], L) -> btb_index_find_label(Is, L). - -btb_error(Error) -> - throw({error,Error}). - -fetch_code_at(Lbl, Li) -> - case beam_utils:code_at(Lbl, Li) of - Is when is_list(Is) -> Is - end. - -%%% -%%% Compilation information warnings. -%%% - -btb_comment_opt({field_flags,[{anno,A}|_]}) -> - {'%',{bin_opt,A}}; -btb_comment_opt(_) -> - {'%',{bin_opt,[]}}. - -btb_comment_no_opt(Reason, {field_flags,[{anno,A}|_]}) -> - {'%',{no_bin_opt,Reason,A}}; -btb_comment_no_opt(Reason, _) -> - {'%',{no_bin_opt,Reason,[]}}. - -collect_warnings(Fs) -> - D = warning_index_functions(Fs), - foldl(fun(F, A) -> collect_warnings_fun(F, D, A) end, [], Fs). - -collect_warnings_fun({function,_,_,_,Is}, D, A) -> - collect_warnings_instr(Is, D, A). - -collect_warnings_instr([{'%',{bin_opt,Where}}|Is], D, Acc0) -> - Acc = add_warning(bin_opt, Where, Acc0), - collect_warnings_instr(Is, D, Acc); -collect_warnings_instr([{'%',{no_bin_opt,Reason0,Where}}|Is], D, Acc0) -> - Reason = warning_translate_label(Reason0, D), - Acc = add_warning({no_bin_opt,Reason}, Where, Acc0), - collect_warnings_instr(Is, D, Acc); -collect_warnings_instr([_|Is], D, Acc) -> - collect_warnings_instr(Is, D, Acc); -collect_warnings_instr([], _, Acc) -> Acc. - -add_warning(Term, Anno, Ws) -> - Line = get_line(Anno), - File = get_file(Anno), - [{File,[{Line,?MODULE,Term}]}|Ws]. - -warning_translate_label(Term, D) when is_tuple(Term) -> - case element(1, Term) of - {label,F} -> - FA = gb_trees:get(F, D), - setelement(1, Term, FA); - _ -> Term - end; -warning_translate_label(Term, _) -> Term. - -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 - -warning_index_functions(Fs) -> - D = [{Entry,{F,A}} || {function,F,A,Entry,_} <- Fs], - gb_trees:from_orddict(sort(D)). - -format_error_1({binary_used_in,{extfunc,M,F,A}}) -> - [io_lib:format("sub binary used by ~p:~p/~p", [M,F,A])| - case {M,F,A} of - {erlang,split_binary,2} -> - "; SUGGEST using binary matching instead of split_binary/2"; - _ -> - "" - end]; -format_error_1({binary_used_in,_}) -> - "sub binary is used or returned"; -format_error_1({multiple_uses,_}) -> - "sub binary is matched or used in more than one place"; -format_error_1(unsuitable_bs_start_match) -> - "the binary matching instruction that follows in the same function " - "have problems that prevent delayed sub binary optimization " - "(probably indicated by INFO warnings)"; -format_error_1({{F,A},no_suitable_bs_start_match}) -> - io_lib:format("called function ~p/~p does not begin with a suitable " - "binary matching instruction", [F,A]); -format_error_1(must_and_must_not_save) -> - "different control paths use different positions in the binary"; -format_error_1({_,I,not_handled}) -> - case I of - {'catch',_,_} -> - "the compiler currently does not attempt the delayed sub binary " - "optimization when catch is used"; - {'try',_,_} -> - "the compiler currently does not attempt the delayed sub binary " - "optimization when try/catch is used"; - _ -> - io_lib:format("compiler limitation: instruction ~p prevents " - "delayed sub binary optimization", [I]) - end; -format_error_1(Term) -> - io_lib:format("~w", [Term]). diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 207f1c4deb..7299654476 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -22,34 +22,21 @@ -module(beam_clean). -export([module/2]). --export([bs_clean_saves/1]). -export([clean_labels/1]). --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], - All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end, - dict:new(), Fs0), + All = maps:from_list([{Lbl,Func} || {function,_,_,Lbl,_}=Func <- Fs0]), WorkList = rootset(Fs0, Exp, Attr), - Used = find_all_used(WorkList, All, sets:from_list(WorkList)), + Used = find_all_used(WorkList, All, cerl_sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs3 = bs_fix(Fs2), - Fs = maybe_remove_lines(Fs3, Opts), + Fs = maybe_remove_lines(Fs2, 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), []). - %% Determine the rootset, i.e. exported functions and %% the on_load function (if any). @@ -66,16 +53,16 @@ rootset(Fs, Root0, Attr) -> %% Remove the unused functions. remove_unused([F|Fs], Used, All) -> - case sets:is_element(F, Used) of + case cerl_sets:is_element(F, Used) of false -> remove_unused(Fs, Used, All); - true -> [dict:fetch(F, All)|remove_unused(Fs, Used, All)] + true -> [map_get(F, All)|remove_unused(Fs, Used, All)] end; remove_unused([], _, _) -> []. - + %% Find all used functions. find_all_used([F|Fs0], All, Used0) -> - {function,_,_,_,Code} = dict:fetch(F, All), + {function,_,_,_,Code} = map_get(F, All), {Fs,Used} = update_work_list(Code, {Fs0,Used0}), find_all_used(Fs, All, Used); find_all_used([], _All, Used) -> Used. @@ -89,20 +76,16 @@ update_work_list([_|Is], Sets) -> update_work_list([], Sets) -> Sets. add_to_work_list(F, {Fs,Used}=Sets) -> - case sets:is_element(F, Used) of + case cerl_sets:is_element(F, Used) of true -> Sets; - false -> {[F|Fs],sets:add_element(F, Used)} + false -> {[F|Fs],cerl_sets:add_element(F, Used)} end. %%% %%% Coalesce adjacent labels. Renumber all labels to eliminate gaps. -%%% This cleanup will slightly reduce file size and slightly speed up loading. -%%% -%%% We also expand is_record/3 to a sequence of instructions. It is done -%%% here merely because this module will always be called even if optimization -%%% is turned off. We don't want to do the expansion in beam_asm because we -%%% want to see the expanded code in a .S file. +%%% This cleanup will slightly reduce file size and slightly speed up +%%% loading. %%% -type label() :: beam_asm:label(). @@ -127,45 +110,6 @@ function_renumber([{function,Name,Arity,_Entry,Asm0}|Fs], St0, Acc) -> function_renumber(Fs, St, [{function,Name,Arity,St#st.entry,Asm}|Acc]); function_renumber([], St, Acc) -> {Acc,St}. -renumber_labels([{bif,is_record,{f,_}, - [Term,{atom,Tag}=TagAtom,{integer,Arity}],Dst}|Is0], Acc, St) -> - ContLabel = 900000000+2*St#st.lc, - FailLabel = ContLabel+1, - Fail = {f,FailLabel}, - Tmp = Dst, - Is = case is_record_tuple(Term, Tag, Arity) of - yes -> - [{move,{atom,true},Dst}|Is0]; - no -> - [{move,{atom,false},Dst}|Is0]; - maybe -> - [{test,is_tuple,Fail,[Term]}, - {test,test_arity,Fail,[Term,Arity]}, - {get_tuple_element,Term,0,Tmp}, - {test,is_eq_exact,Fail,[Tmp,TagAtom]}, - {move,{atom,true},Dst}, - {jump,{f,ContLabel}}, - {label,FailLabel}, - {move,{atom,false},Dst}, - {jump,{f,ContLabel}}, %Improves optimization by beam_dead. - {label,ContLabel}|Is0] - end, - renumber_labels(Is, Acc, St); -renumber_labels([{test,is_record,{f,_}=Fail, - [Term,{atom,Tag}=TagAtom,{integer,Arity}]}|Is0], Acc, St) -> - Tmp = {x,1022}, - Is = case is_record_tuple(Term, Tag, Arity) of - yes -> - Is0; - no -> - [{jump,Fail}|Is0]; - maybe -> - [{test,is_tuple,Fail,[Term]}, - {test,test_arity,Fail,[Term,Arity]}, - {get_tuple_element,Term,0,Tmp}, - {test,is_eq_exact,Fail,[Tmp,TagAtom]}|Is0] - end, - renumber_labels(Is, Acc, St); renumber_labels([{label,Old}|Is], [{label,New}|_]=Acc, #st{lmap=D0}=St) -> D = [{Old,New}|D0], renumber_labels(Is, Acc, St#st{lmap=D}); @@ -179,12 +123,6 @@ renumber_labels([I|Is], Acc, St0) -> renumber_labels(Is, [I|Acc], St0); renumber_labels([], Acc, St) -> {Acc,St}. -is_record_tuple({x,_}, _, _) -> maybe; -is_record_tuple({y,_}, _, _) -> maybe; -is_record_tuple({literal,Tuple}, Tag, Arity) - when element(1, Tuple) =:= Tag, tuple_size(Tuple) =:= Arity -> yes; -is_record_tuple(_, _, _) -> no. - function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> Asm = try Fb = fun(Old) -> throw({error,{undefined_label,Old}}) end, @@ -199,100 +137,6 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace([], _, Acc) -> Acc. %%% -%%% Final fixup of bs_start_match2/5,bs_save2/bs_restore2 instructions for -%%% new bit syntax matching (introduced in R11B). -%%% -%%% Pass 1: Scan the code, looking for bs_restore2/2 instructions. -%%% -%%% Pass 2: Update bs_save2/2 and bs_restore/2 instructions. Remove -%%% any bs_save2/2 instruction whose save position are never referenced -%%% by any bs_restore2/2 instruction. -%%% -%%% Note this module can be invoked several times, so we must be careful -%%% not to touch instructions that have already been fixed up. -%%% - -bs_fix(Fs) -> - bs_fix(Fs, []). - -bs_fix([{function,Name,Arity,Entry,Asm0}|Fs], Acc) -> - Asm = bs_function(Asm0), - bs_fix(Fs, [{function,Name,Arity,Entry,Asm}|Acc]); -bs_fix([], Acc) -> reverse(Acc). - -bs_function(Is) -> - Dict0 = bs_restores(Is, []), - S0 = sofs:relation(Dict0, [{context,save_point}]), - S1 = sofs:relation_to_family(S0), - S = sofs:to_external(S1), - Dict = make_save_point_dict(S, []), - bs_replace(Is, Dict, []). - -make_save_point_dict([{Ctx,Pts}|T], Acc0) -> - Acc = make_save_point_dict_1(Pts, Ctx, 0, Acc0), - make_save_point_dict(T, Acc); -make_save_point_dict([], Acc) -> - gb_trees:from_orddict(ordsets:from_list(Acc)). - -make_save_point_dict_1([H|T], Ctx, I, Acc) -> - make_save_point_dict_1(T, Ctx, I+1, [{{Ctx,H},I}|Acc]); -make_save_point_dict_1([], Ctx, I, Acc) -> - [{Ctx,I}|Acc]. - -%% Pass 1. -bs_restores([{bs_restore2,_,{Same,Same}}|Is], Dict) -> - %% This save point is special. No explicit save is needed. - bs_restores(Is, Dict); -bs_restores([{bs_restore2,_,{atom,start}}|Is], Dict) -> - %% This instruction can occur if "compilation" - %% started from a .S file. - bs_restores(Is, Dict); -bs_restores([{bs_restore2,_,{_,_}=SavePoint}|Is], Dict) -> - bs_restores(Is, [SavePoint|Dict]); -bs_restores([_|Is], Dict) -> - bs_restores(Is, Dict); -bs_restores([], Dict) -> Dict. - -%% Pass 2. -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 - end, - I = {test,bs_start_match2,F,Live,[Src,Slots],CtxR}, - bs_replace(T, Dict, [I|Acc]); -bs_replace([{bs_save2,CtxR,{_,_}=SavePoint}|T], Dict, Acc) -> - case gb_trees:lookup(SavePoint, Dict) of - {value,N} -> - bs_replace(T, Dict, [{bs_save2,CtxR,N}|Acc]); - none -> - bs_replace(T, Dict, Acc) - end; -bs_replace([{bs_restore2,_,{atom,start}}=I|T], Dict, Acc) -> - %% This instruction can occur if "compilation" - %% started from a .S file. - bs_replace(T, Dict, [I|Acc]); -bs_replace([{bs_restore2,CtxR,{Same,Same}}|T], Dict, Acc) -> - %% This save point refers to the point in the binary where the match - %% started. It has a special name. - bs_replace(T, Dict, [{bs_restore2,CtxR,{atom,start}}|Acc]); -bs_replace([{bs_restore2,CtxR,{_,_}=SavePoint}|T], Dict, Acc) -> - N = gb_trees:get(SavePoint, Dict), - bs_replace(T, Dict, [{bs_restore2,CtxR,N}|Acc]); -bs_replace([I|Is], Dict, Acc) -> - bs_replace(Is, Dict, [I|Acc]); -bs_replace([], _, Acc) -> reverse(Acc). - -bs_clean_saves_1([{bs_save2,_,{_,_}=SavePoint}=I|Is], Needed, Acc) -> - case gb_sets:is_member(SavePoint, Needed) of - false -> bs_clean_saves_1(Is, Needed, Acc); - true -> bs_clean_saves_1(Is, Needed, [I|Acc]) - end; -bs_clean_saves_1([I|Is], Needed, Acc) -> - bs_clean_saves_1(Is, Needed, [I|Acc]); -bs_clean_saves_1([], _, Acc) -> reverse(Acc). - -%%% %%% Remove line instructions if requested. %%% diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl deleted file mode 100644 index efad082152..0000000000 --- a/lib/compiler/src/beam_dead.erl +++ /dev/null @@ -1,971 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% 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. -%% 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_dead). - --export([module/2]). - -%%% Dead code is code that is executed but has no effect. This -%%% optimization pass either removes dead code or jumps around it, -%%% potentially making it unreachable and a target for the -%%% the beam_jump pass. - --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), - %%{Fs,Lc} = {Fs1,Lc1}, - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}, Lc0) -> - try - Is1 = beam_jump:remove_unused_labels(Is0), - - %% Initialize label information with the code - %% for the func_info label. Without it, a register - %% may seem to be live when it is not. - [{label,L}|FiIs] = Is1, - D0 = beam_utils:empty_label_index(), - D = beam_utils:index_label(L, FiIs, D0), - - %% Optimize away dead code. - {Is2,Lc} = forward(Is1, Lc0), - Is3 = backward(Is2, D), - Is = move_move_into_block(Is3, []), - {{function,Name,Arity,CLabel,Is},Lc} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% 'move' instructions outside of blocks may thwart the jump optimizer. -%% Move them back into the block. - -move_move_into_block([{block,Bl0},{move,S,D}|Is], Acc) -> - Bl = Bl0 ++ [{set,[D],[S],move}], - move_move_into_block([{block,Bl}|Is], Acc); -move_move_into_block([{move,S,D}|Is], Acc) -> - Bl = [{set,[D],[S],move}], - move_move_into_block([{block,Bl}|Is], Acc); -move_move_into_block([I|Is], Acc) -> - move_move_into_block(Is, [I|Acc]); -move_move_into_block([], Acc) -> reverse(Acc). - -%%% -%%% Scan instructions in execution order and remove redundant 'move' -%%% instructions. 'move' instructions are redundant if we know that -%%% the register already contains the value being assigned, as in the -%%% following code: -%%% -%%% test is_eq_exact SomeLabel Src Dst -%%% move Src Dst -%%% -%%% or in: -%%% -%%% test is_nil SomeLabel Dst -%%% move nil Dst -%%% -%%% or in: -%%% -%%% select_val Register FailLabel [... Literal => L1...] -%%% . -%%% . -%%% . -%%% L1: move Literal Register -%%% -%%% Also add extra labels to help the second backward pass. -%%% - -forward(Is, Lc) -> - forward(Is, #{}, Lc, []). - -forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) -> - %% move/2 followed by jump/1 is optimized by backward/3. - forward([Move,{jump,{f,L}}|Is], D, Lc, Acc); -forward([{bif,_,_,_,_}=Bif|[{label,L}|_]=Is], D, Lc, Acc) -> - %% bif/4 followed by jump/1 is optimized by backward/3. - forward([Bif,{jump,{f,L}}|Is], D, Lc, Acc); -forward([{block,[]}|Is], D, Lc, Acc) -> - %% Empty blocks can prevent optimizations. - forward(Is, D, Lc, Acc); -forward([{select,select_val,Reg,_,List}=I|Is], D0, Lc, Acc) -> - D = update_value_dict(List, Reg, D0), - forward(Is, D, Lc, [I|Acc]); -forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) -> - %% Assumption: The target labels in a select_val/3 instruction - %% cannot be reached in any other way than through the select_val/3 - %% instruction (i.e. there can be no fallthrough to such label and - %% it cannot be referenced by, for example, a jump/1 instruction). - Key = {Lbl,Dst}, - Block = case D of - #{Key := Lit} -> {block,BlkIs}; %Safe to remove move instruction. - _ -> Blk %Must keep move instruction. - end, - forward([Block|Is], D, Lc, [LblI|Acc]); -forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> - %% Assumption: The target labels in a select_val/3 instruction - %% cannot be reached in any other way than through the select_val/3 - %% instruction (i.e. there can be no fallthrough to such label and - %% it cannot be referenced by, for example, a jump/1 instruction). - Is = case maps:find({Lbl,Dst}, D) of - {ok,Lit} -> Is1; %Safe to remove move instruction. - _ -> Is0 %Keep move instruction. - end, - forward(Is, D, Lc, [LblI|Acc]); -forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) -> - forward(Is, D, Lc, Acc); -forward([{test,is_eq_exact,_,[Dst,Src]}=I, - {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> - forward([I,{block,Bl}|Is], D, Lc, Acc); -forward([{test,is_nil,_,[Dst]}=I, - {block,[{set,[Dst],[nil],move}|Bl]}|Is], D, Lc, Acc) -> - forward([I,{block,Bl}|Is], D, Lc, Acc); -forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) -> - forward([I|Is], D, Lc, Acc); -forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) -> - forward([I|Is], D, Lc, Acc); -forward([{test,_,_,_}=I|Is]=Is0, D, Lc, Acc) -> - %% Help the second, backward pass to by inserting labels after - %% relational operators so that they can be skipped if they are - %% known to be true. - case useful_to_insert_label(Is0) of - false -> forward(Is, D, Lc, [I|Acc]); - true -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) - end; -forward([I|Is], D, Lc, Acc) -> - forward(Is, D, Lc, [I|Acc]); -forward([], _, Lc, Acc) -> {Acc,Lc}. - -update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> - Key = {Lbl,Reg}, - D = case D0 of - #{Key := inconsistent} -> D0; - #{Key := _} -> D0#{Key := inconsistent}; - _ -> D0#{Key => Lit} - end, - update_value_dict(T, Reg, D); -update_value_dict([], _, D) -> D. - -useful_to_insert_label([_,{label,_}|_]) -> - false; -useful_to_insert_label([{test,Op,_,_}|_]) -> - case Op of - is_lt -> true; - is_ge -> true; - is_eq_exact -> true; - is_ne_exact -> true; - _ -> false - end. - -%%% -%%% Scan instructions in reverse execution order and try to -%%% shortcut branch instructions. -%%% -%%% For example, in this code: -%%% -%%% move Literal Register -%%% jump L1 -%%% . -%%% . -%%% . -%%% L1: test is_{integer,atom} FailLabel Register -%%% select_val {x,0} FailLabel [... Literal => L2...] -%%% . -%%% . -%%% . -%%% L2: ... -%%% -%%% the 'selectval' instruction will always transfer control to L2, -%%% so we can just as well jump to L2 directly by rewriting the -%%% first part of the sequence like this: -%%% -%%% move Literal Register -%%% jump L2 -%%% -%%% If register Register is killed at label L2, we can remove the -%%% 'move' instruction, leaving just the 'jump' instruction: -%%% -%%% jump L2 -%%% -%%% These transformations may leave parts of the code unreachable. -%%% The beam_jump pass will remove the unreachable code. - -backward(Is, D) -> - backward(Is, D, []). - -backward([{test,is_eq_exact,Fail,[Dst,{integer,Arity}]}=I| - [{bif,tuple_size,Fail,[Reg],Dst}|Is]=Is0], D, Acc) -> - %% Provided that Dst is killed following this sequence, - %% we can rewrite the instructions like this: - %% - %% bif tuple_size Fail Reg Dst ==> is_tuple Fail Reg - %% is_eq_exact Fail Dst Integer test_arity Fail Reg Integer - %% - %% (still two instructions, but they they will be combined to - %% one by the loader). - case beam_utils:is_killed(Dst, Acc, D) andalso (Arity bsr 32) =:= 0 of - false -> - %% Not safe because the register Dst is not killed - %% (probably cannot not happen in practice) or the arity - %% does not fit in 32 bits (the loader will fail to load - %% the module). We must move the first instruction to the - %% accumulator to avoid an infinite loop. - backward(Is0, D, [I|Acc]); - true -> - %% Safe. - backward([{test,test_arity,Fail,[Reg,Arity]}, - {test,is_tuple,Fail,[Reg]}|Is], D, Acc) - end; -backward([{label,Lbl}=L|Is], D, Acc) -> - backward(Is, beam_utils:index_label(Lbl, Acc, D), [L|Acc]); -backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> - List1 = shortcut_select_list(List0, Reg, D, []), - Fail1 = shortcut_label(Fail0, D), - Fail = shortcut_bs_test(Fail1, Is, D), - List = prune_redundant(List1, Fail), - case List of - [] -> - Jump = {jump,{f,Fail}}, - backward([Jump|Is], D, Acc); - [V,F] -> - Test = {test,is_eq_exact,{f,Fail},[Reg,V]}, - Jump = {jump,F}, - backward([Jump,Test|Is], D, Acc); - [{atom,B1},F,{atom,B2},F] when B1 =:= not B2 -> - Test = {test,is_boolean,{f,Fail},[Reg]}, - Jump = {jump,F}, - backward([Jump,Test|Is], D, Acc); - [_|_] -> - Sel = {select,select_val,Reg,{f,Fail},List}, - backward(Is, D, [Sel|Acc]) - end; -backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> - To = shortcut_select_label(To0, Reg, Src, D), - Jump = {jump,{f,To}}, - case is_killed_at(Reg, To, D) of - false -> backward([Move|Is], D, [Jump|Acc]); - true -> backward([Jump|Is], D, Acc) - end; -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 - {Test,Jump} -> - backward([Jump,Test|Is], D, Acc) - catch - 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([{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,Op,{f,To0},Ops0}|Is], D, Acc) -> - To1 = shortcut_bs_test(To0, Is, D), - To2 = shortcut_label(To1, D), - To3 = shortcut_rel_op(To2, Op, Ops0, D), - - %% Try to shortcut a repeated test: - %% - %% test Op {f,Fail1} Operands test Op {f,Fail2} Operands - %% . . . ==> ... - %% Fail1: test Op {f,Fail2} Operands Fail1: test Op {f,Fail2} Operands - %% - To = case beam_utils:code_at(To3, D) of - [{test,Op,{f,To4},Ops}|_] -> - case equal_ops(Ops0, Ops) of - true -> To4; - false -> To3 - end; - _Code -> - To3 - end, - I = case Op of - is_eq_exact -> combine_eqs(To, Ops0, D, Acc); - _ -> {test,Op,{f,To},Ops0} - end, - case {I,Acc} of - {{test,is_atom,Fail,Ops0},[{test,is_boolean,Fail,Ops0}|_]} -> - %% An is_atom test before an is_boolean test (with the - %% same failure label) is redundant. - backward(Is, D, Acc); - {{test,is_atom,Fail,[R]}, - [{test,is_eq_exact,Fail,[R,{atom,_}]}|_]} -> - %% An is_atom test before a comparison with an atom (with - %% the same failure label) is redundant. - backward(Is, D, Acc); - {{test,is_integer,Fail,[R]}, - [{test,is_eq_exact,Fail,[R,{integer,_}]}|_]} -> - %% An is_integer test before a comparison with an integer - %% (with the same failure label) is redundant. - backward(Is, D, Acc); - {{test,_,_,_},_} -> - %% Still a test instruction. Done. - backward(Is, D, [I|Acc]); - {_,_} -> - %% Rewritten to a select_val. Rescan. - backward([I|Is], D, Acc) - end; -backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> - To1 = shortcut_bs_test(To0, Is, D), - To2 = shortcut_label(To1, D), - %% Try to shortcut a repeated test: - %% - %% test Op {f,Fail1} _ Ops _ test Op {f,Fail2} _ Ops _ - %% . . . ==> ... - %% Fail1: test Op {f,Fail2} _ Ops _ Fail1: test Op {f,Fail2} _ Ops _ - %% - To = case beam_utils:code_at(To2, D) of - [{test,Op,{f,To3},_,Ops,_}|_] -> - case equal_ops(Ops0, Ops) of - true -> To3; - false -> To2 - end; - _Code -> - To2 - end, - I = {test,Op,{f,To},Live,Ops0,Dst}, - backward(Is, D, [I|Acc]); -backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) -> - case beam_jump:is_exit_instruction(Exit) of - false -> backward(Is, D, [I|Acc]); - true -> backward(Is, D, Acc) - 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. - -equal_ops([{field_flags,FlA0}|T0], [{field_flags,FlB0}|T1]) -> - FlA = lists:keydelete(anno, 1, FlA0), - FlB = lists:keydelete(anno, 1, FlB0), - FlA =:= FlB andalso equal_ops(T0, T1); -equal_ops([Op|T0], [Op|T1]) -> - equal_ops(T0, T1); -equal_ops([], []) -> true; -equal_ops(_, _) -> false. - -shortcut_select_list([Lit,{f,To0}|T], Reg, D, Acc) -> - To = shortcut_select_label(To0, Reg, Lit, D), - 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); - _ -> To0 - end. - -shortcut_select_label(To, Reg, Lit, D) -> - shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). - -prune_redundant([_,{f,Fail}|T], Fail) -> - prune_redundant(T, Fail); -prune_redundant([V,F|T], Fail) -> - [V,F|prune_redundant(T, Fail)]; -prune_redundant([], _) -> []. - -%% Replace a comparison operator with a test instruction and a jump. -%% For example, if we have this code: -%% -%% bif '=:=' Fail Src1 Src2 {x,0} -%% jump L1 -%% . -%% . -%% . -%% L1: select_val {x,0} FailLabel [... true => L2..., ...false => L3...] -%% -%% the first two instructions can be replaced with -%% -%% test is_eq_exact L3 Src1 Src2 -%% jump L2 -%% -%% provided that {x,0} is killed at both L2 and L3. - -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}}}. - -comp_op_find_shortcut(To0, Reg, Val, D) -> - case shortcut_select_label(To0, Reg, Val, D) of - To0 -> - not_possible(); - To -> - case is_killed_at(Reg, To, D) of - false -> not_possible(); - true -> To - end - end. - -bif_to_test(Name, Args, Fail) -> - try - beam_utils:bif_to_test(Name, Args, {f,Fail}) - catch - error:_ -> not_possible() - end. - -not_possible() -> throw(not_possible). - -%% combine_eqs(To, Operands, Acc) -> Instruction. -%% Combine two is_eq_exact instructions or (an is_eq_exact -%% instruction and a select_val instruction) to a select_val -%% instruction if possible. -%% -%% Example: -%% -%% is_eq_exact F1 Reg Lit1 select_val Reg F2 [ Lit1 L1 -%% L1: . Lit2 L2 ] -%% . -%% . ==> -%% . -%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2 -%% L2: .... L2: -%% -combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, 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,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,Next}|List]}; - _Is -> - {test,is_eq_exact,{f,To},Ops} - end; -combine_eqs(To, Ops, _D, _Acc) -> - {test,is_eq_exact,{f,To},Ops}. - -remove_from_list(Lit, [Lit,{f,_}|T]) -> - T; -remove_from_list(Lit, [Val,{f,_}=Fail|T]) -> - [Val,Fail|remove_from_list(Lit, T)]; -remove_from_list(_, []) -> []. - - -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. - -shortcut_bs_test(To, Is, D) -> - shortcut_bs_test_1(beam_utils:code_at(To, D), Is, To, D). - -shortcut_bs_test_1([{bs_restore2,Reg,SavePoint}, - {label,_}, - {test,bs_test_tail2,{f,To},[_,TailBits]}|_], - PrevIs, To0, D) -> - case count_bits_matched(PrevIs, {Reg,SavePoint}, 0) of - Bits when Bits > TailBits -> - %% This instruction will fail. We know because a restore has been - %% done from the previous point SavePoint in the binary, and we - %% also know that the binary contains at least Bits bits from - %% SavePoint. - %% - %% Since we will skip a bs_restore2 if we shortcut to label To, - %% we must now make sure that code at To does not depend on - %% the position in the context in any way. - case shortcut_bs_pos_used(To, Reg, D) of - false -> To; - true -> To0 - end; - _Bits -> - To0 - end; -shortcut_bs_test_1([_|_], _, To, _) -> To. - -%% counts_bits_matched(ReversedInstructions, SavePoint, Bits) -> Bits' -%% Given a reversed instruction stream, determine the minimum number -%% of bits that will be matched by bit syntax instructions up to the -%% given save point. - -count_bits_matched([{test,bs_get_utf8,{f,_},_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+8); -count_bits_matched([{test,bs_get_utf16,{f,_},_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+16); -count_bits_matched([{test,bs_get_utf32,{f,_},_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+32); -count_bits_matched([{test,_,_,_,[_,Sz,U,{field_flags,_}],_}|Is], SavePoint, Bits) -> - case Sz of - {integer,N} -> count_bits_matched(Is, SavePoint, Bits+N*U); - _ -> count_bits_matched(Is, SavePoint, Bits) - end; -count_bits_matched([{test,bs_match_string,_,[_,Bs]}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits+bit_size(Bs)); -count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> - count_bits_matched(Is, SavePoint, Bits); -count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> - %% The save point we are looking for - we are done. - Bits; -count_bits_matched([_|_], _, Bits) -> Bits. - -shortcut_bs_pos_used(To, Reg, D) -> - shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D). - -shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) -> - false; -shortcut_bs_pos_used_1(Is, Reg, D) -> - not beam_utils:is_killed(Reg, Is, D). - -%% shortcut_bs_start_match(TargetLabel, Reg) -> TargetLabel -%% A failing bs_start_match2 instruction means that the source (Reg) -%% cannot be a binary. That means that it is safe to skip -%% bs_context_to_binary instructions operating on Reg, and -%% bs_start_match2 instructions operating on Reg. - -shortcut_bs_start_match(To, Reg, D) -> - shortcut_bs_start_match_1(beam_utils:code_at(To, D), Reg, To, D). - -shortcut_bs_start_match_1([{bs_context_to_binary,Reg}|Is], Reg, To, D) -> - shortcut_bs_start_match_1(Is, Reg, To, D); -shortcut_bs_start_match_1([{jump,{f,To}}|_], Reg, _, D) -> - Code = beam_utils:code_at(To, D), - shortcut_bs_start_match_1(Code, Reg, To, D); -shortcut_bs_start_match_1([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_], - Reg, _, D) -> - Code = beam_utils:code_at(To, D), - shortcut_bs_start_match_1(Code, Reg, To, D); -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: -%% -%% is_ge L1 {x,0} 48 -%% . -%% . -%% . -%% L1: is_ge L2 {x,0} 65 -%% -%% The first test instruction can be rewritten to "is_ge L2 {x,0} 48" -%% since the instruction at L1 will also fail. -%% -%% If there are instructions between L1 and the other test instruction -%% it may still be possible to do the shortcut. For example: -%% -%% L1: is_eq_exact L3 {x,0} 92 -%% is_ge L2 {x,0} 65 -%% -%% Since the first test instruction failed, we know that {x,0} must -%% be less than 48; therefore, we know that {x,0} cannot be equal to -%% 92 and the jump to L3 cannot happen. - -shortcut_rel_op(To, Op, Ops, D) -> - case normalize_op({test,Op,{f,To},Ops}) of - {{NormOp,A,B},_} -> - Normalized = {negate_op(NormOp),A,B}, - shortcut_rel_op_fp(To, Normalized, D); - {_,_} -> - To; - error -> - To - end. - -shortcut_rel_op_fp(To0, Normalized, D) -> - Code = beam_utils:code_at(To0, D), - case shortcut_any_label(Code, Normalized) of - error -> - To0; - To -> - shortcut_rel_op_fp(To, Normalized, D) - end. - -%% shortcut_any_label([Instruction], PrevCondition) -> FailLabel | error -%% Using PrevCondition (a previous condition known to be true), -%% try to shortcut to another failure label. - -shortcut_any_label([{jump,{f,Lbl}}|_], _Prev) -> - Lbl; -shortcut_any_label([{label,Lbl}|_], _Prev) -> - Lbl; -shortcut_any_label([{select,select_val,R,{f,Fail},L}|_], Prev) -> - shortcut_selectval(L, R, Fail, Prev); -shortcut_any_label([I|Is], Prev) -> - case normalize_op(I) of - error -> - error; - {Normalized,Fail} -> - %% We have a relational operator. - case will_succeed(Prev, Normalized) of - no -> - %% This test instruction will always branch - %% to Fail. - Fail; - yes -> - %% This test instruction will never branch, - %% so we will look at the next instruction. - shortcut_any_label(Is, Prev); - maybe -> - %% May or may not branch. From now on, we can only - %% shortcut to the this specific failure label - %% Fail. - shortcut_specific_label(Is, Fail, Prev) - end - end. - -%% shortcut_specific_label([Instruction], FailLabel, PrevCondition) -> -%% FailLabel | error -%% We have previously encountered a test instruction that may or -%% may not branch to FailLabel. Therefore we are only allowed -%% to do the shortcut to the same fail label (FailLabel). - -shortcut_specific_label([{label,_}|Is], Fail, Prev) -> - shortcut_specific_label(Is, Fail, Prev); -shortcut_specific_label([{select,select_val,R,{f,F},L}|_], Fail, Prev) -> - case shortcut_selectval(L, R, F, Prev) of - Fail -> Fail; - _ -> error - end; -shortcut_specific_label([I|Is], Fail, Prev) -> - case normalize_op(I) of - error -> - error; - {Normalized,Fail} -> - case will_succeed(Prev, Normalized) of - no -> - %% Will branch to FailLabel. - Fail; - yes -> - %% Will definitely never branch. - shortcut_specific_label(Is, Fail, Prev); - maybe -> - %% May branch, but still OK since it will branch - %% to FailLabel. - shortcut_specific_label(Is, Fail, Prev) - end; - {Normalized,_} -> - %% This test instruction will branch to a different - %% fail label, if it branches at all. - case will_succeed(Prev, Normalized) of - yes -> - %% Still OK, since the branch will never be - %% taken. - shortcut_specific_label(Is, Fail, Prev); - no -> - %% Give up. The branch will definitely be taken - %% to a different fail label. - error; - maybe -> - %% Give up. If the branch is taken, it will be - %% to a different fail label. - error - end - end. - - -%% shortcut_selectval(List, Reg, Fail, PrevCond) -> FailLabel | error -%% Try to shortcut a selectval instruction. A selectval instruction -%% is equivalent to the following instruction sequence: -%% -%% is_ne_exact L1 Reg Value1 -%% . -%% . -%% . -%% is_ne_exact LN Reg ValueN -%% jump DefaultFailLabel -%% -shortcut_selectval([Val,{f,Lbl}|T], R, Fail, Prev) -> - case will_succeed(Prev, {'=/=',R,get_literal(Val)}) of - yes -> shortcut_selectval(T, R, Fail, Prev); - no -> Lbl; - maybe -> error - end; -shortcut_selectval([], _, Fail, _) -> Fail. - -%% will_succeed(PrevCondition, Condition) -> yes | no | maybe -%% PrevCondition is a condition known to be true. This function -%% will tell whether Condition will succeed. - -will_succeed({Op1,Reg,A}, {Op2,Reg,B}) -> - will_succeed_1(Op1, A, Op2, B); -will_succeed({'=:=',Reg,{literal,A}}, {TypeTest,Reg}) -> - case erlang:TypeTest(A) of - false -> no; - true -> yes - end; -will_succeed({_,_,_}, maybe) -> - maybe; -will_succeed({_,_,_}, Test) when is_tuple(Test) -> - maybe. - -will_succeed_1('=:=', A, '<', B) -> - if - B =< A -> no; - true -> yes - end; -will_succeed_1('=:=', A, '=<', B) -> - if - B < A -> no; - true -> yes - end; -will_succeed_1('=:=', A, '=:=', B) -> - if - A =:= B -> yes; - true -> no - end; -will_succeed_1('=:=', A, '=/=', B) -> - if - A =:= B -> no; - true -> yes - end; -will_succeed_1('=:=', A, '>=', B) -> - if - B > A -> no; - true -> yes - end; -will_succeed_1('=:=', A, '>', B) -> - if - B >= A -> no; - true -> yes - end; - -will_succeed_1('=/=', A, '=/=', B) when A =:= B -> yes; -will_succeed_1('=/=', A, '=:=', B) when A =:= B -> no; - -will_succeed_1('<', A, '=:=', B) when B >= A -> no; -will_succeed_1('<', A, '=/=', B) when B >= A -> yes; -will_succeed_1('<', A, '<', B) when B >= A -> yes; -will_succeed_1('<', A, '=<', B) when B > A -> yes; -will_succeed_1('<', A, '>=', B) when B > A -> no; -will_succeed_1('<', A, '>', B) when B >= A -> no; - -will_succeed_1('=<', A, '=:=', B) when B > A -> no; -will_succeed_1('=<', A, '=/=', B) when B > A -> yes; -will_succeed_1('=<', A, '<', B) when B > A -> yes; -will_succeed_1('=<', A, '=<', B) when B >= A -> yes; -will_succeed_1('=<', A, '>=', B) when B > A -> no; -will_succeed_1('=<', A, '>', B) when B >= A -> no; - -will_succeed_1('>=', A, '=:=', B) when B < A -> no; -will_succeed_1('>=', A, '=/=', B) when B < A -> yes; -will_succeed_1('>=', A, '<', B) when B =< A -> no; -will_succeed_1('>=', A, '=<', B) when B < A -> no; -will_succeed_1('>=', A, '>=', B) when B =< A -> yes; -will_succeed_1('>=', A, '>', B) when B < A -> yes; - -will_succeed_1('>', A, '=:=', B) when B =< A -> no; -will_succeed_1('>', A, '=/=', B) when B =< A -> yes; -will_succeed_1('>', A, '<', B) when B =< A -> no; -will_succeed_1('>', A, '=<', B) when B < A -> no; -will_succeed_1('>', A, '>=', B) when B =< A -> yes; -will_succeed_1('>', A, '>', B) when B < A -> yes; - -will_succeed_1(_, _, _, _) -> maybe. - -%% normalize_op(Instruction) -> {Normalized,FailLabel} | error -%% Normalized = {Operator,Register,Literal} | -%% {TypeTest,Register} | -%% maybe -%% Operation = '<' | '=<' | '=:=' | '=/=' | '>=' | '>' -%% TypeTest = is_atom | is_integer ... -%% Literal = {literal,Term} -%% -%% Normalize a relational operator to facilitate further -%% comparisons between operators. Always make the register -%% operand the first operand. Thus the following instruction: -%% -%% {test,is_ge,{f,99},{integer,13},{x,0}} -%% -%% will be normalized to: -%% -%% {'=<',{x,0},{literal,13}} -%% -%% NOTE: Bit syntax test instructions are scary. They may change the -%% state of match contexts and update registers, so we don't dare -%% mess with them. - -normalize_op({test,is_ge,{f,Fail},Ops}) -> - normalize_op_1('>=', Ops, Fail); -normalize_op({test,is_lt,{f,Fail},Ops}) -> - normalize_op_1('<', Ops, Fail); -normalize_op({test,is_eq_exact,{f,Fail},Ops}) -> - normalize_op_1('=:=', Ops, Fail); -normalize_op({test,is_ne_exact,{f,Fail},Ops}) -> - normalize_op_1('=/=', Ops, Fail); -normalize_op({test,is_nil,{f,Fail},[R]}) -> - normalize_op_1('=:=', [R,nil], Fail); -normalize_op({test,Op,{f,Fail},[R]}) -> - case erl_internal:new_type_test(Op, 1) of - true -> {{Op,R},Fail}; - false -> {maybe,Fail} - end; -normalize_op({test,_,{f,Fail},_}=I) -> - case beam_utils:is_pure_test(I) of - true -> {maybe,Fail}; - false -> error - end; -normalize_op(_) -> - error. - -normalize_op_1(Op, [Op1,Op2], Fail) -> - case {get_literal(Op1),get_literal(Op2)} of - {error,error} -> - %% Both operands are registers. - {maybe,Fail}; - {error,Lit} -> - {{Op,Op1,Lit},Fail}; - {Lit,error} -> - {{turn_op(Op),Op2,Lit},Fail}; - {_,_} -> - %% Both operands are literals. Can probably only - %% happen if the Core Erlang optimizations passes were - %% turned off, so don't bother trying to do something - %% smart here. - {maybe,Fail} - end. - -turn_op('<') -> '>'; -turn_op('>=') -> '=<'; -turn_op('=:='=Op) -> Op; -turn_op('=/='=Op) -> Op. - -negate_op('>=') -> '<'; -negate_op('<') -> '>='; -negate_op('=<') -> '>'; -negate_op('>') -> '=<'; -negate_op('=:=') -> '=/='; -negate_op('=/=') -> '=:='. - -get_literal({atom,Val}) -> - {literal,Val}; -get_literal({integer,Val}) -> - {literal,Val}; -get_literal({float,Val}) -> - {literal,Val}; -get_literal(nil) -> - {literal,[]}; -get_literal({literal,_}=Lit) -> - Lit; -get_literal({_,_}) -> error. - - -%%% -%%% Removing stores to Y registers is not always safe -%%% if there is an instruction that causes an exception -%%% within a catch. In practice, there are few or no -%%% opportunities for removing stores to Y registers anyway -%%% if sys_core_fold has been run. -%%% - -is_killed_at({x,_}=Reg, Lbl, D) -> - beam_utils:is_killed_at(Reg, Lbl, D); -is_killed_at({y,_}, _, _) -> - false. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 990e86062a..b2056332e6 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -126,18 +126,17 @@ import(Mod0, Name0, Arity, #asm{imports=Imp0,next_import=NextIndex}=D0) {NextIndex,D2#asm{imports=Imp,next_import=NextIndex+1}} end. -%% Returns the index for a string in the string table (adding the string to the -%% table if necessary). +%% Returns the index for a binary string in the string table (adding +%% the string to the table if necessary). %% string(String, Dict) -> {Offset, Dict'} --spec string(string(), bdict()) -> {non_neg_integer(), bdict()}. +-spec string(binary(), bdict()) -> {non_neg_integer(), bdict()}. -string(Str, Dict) when is_list(Str) -> +string(BinString, Dict) when is_binary(BinString) -> #asm{strings=Strings,string_offset=NextOffset} = Dict, - StrBin = list_to_binary(Str), - case old_string(StrBin, Strings) of + case old_string(BinString, Strings) of none -> - NewDict = Dict#asm{strings = <<Strings/binary,StrBin/binary>>, - string_offset=NextOffset+byte_size(StrBin)}, + NewDict = Dict#asm{strings = <<Strings/binary,BinString/binary>>, + string_offset=NextOffset+byte_size(BinString)}, {NextOffset,NewDict}; Offset when is_integer(Offset) -> {NextOffset-Offset,Dict} diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 6cee9acae4..7d048716e4 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -373,6 +373,8 @@ disasm_instr(B, Bs, Atoms, Literals) -> disasm_map_inst(get_map_elements, Arity, Bs, Atoms, Literals); has_map_fields -> disasm_map_inst(has_map_fields, Arity, Bs, Atoms, Literals); + put_tuple2 -> + disasm_put_tuple2(Bs, Atoms, Literals); _ -> try decode_n_args(Arity, Bs, Atoms, Literals) of {Args, RestBs} -> @@ -413,6 +415,14 @@ disasm_map_inst(Inst, Arity, Bs0, Atoms, Literals) -> {List, RestBs} = decode_n_args(Len, Bs2, Atoms, Literals), {{Inst, Args ++ [{Z,U,List}]}, RestBs}. +disasm_put_tuple2(Bs, Atoms, Literals) -> + {X, Bs1} = decode_arg(Bs, Atoms, Literals), + {Z, Bs2} = decode_arg(Bs1, Atoms, Literals), + {U, Bs3} = decode_arg(Bs2, Atoms, Literals), + {u, Len} = U, + {List, RestBs} = decode_n_args(Len, Bs3, Atoms, Literals), + {{put_tuple2, [X,{Z,U,List}]}, RestBs}. + %%----------------------------------------------------------------------- %% decode_arg([Byte]) -> {Arg, [Byte]} %% @@ -1095,6 +1105,23 @@ resolve_inst({get_hd,[Src,Dst]},_,_,_) -> resolve_inst({get_tl,[Src,Dst]},_,_,_) -> {get_tl,Src,Dst}; +%% OTP 22 +resolve_inst({bs_start_match3,[Fail,Bin,Live,Dst]},_,_,_) -> + {bs_start_match3,Fail,Bin,Live,Dst}; +resolve_inst({bs_get_tail,[Src,Dst,Live]},_,_,_) -> + {bs_get_tail,Src,Dst,Live}; +resolve_inst({bs_get_position,[Src,Dst,Live]},_,_,_) -> + {bs_get_position,Src,Dst,Live}; +resolve_inst({bs_set_position,[Src,Dst]},_,_,_) -> + {bs_set_position,Src,Dst}; + +%% +%% OTP 22. +%% +resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) -> + List = resolve_args(List0), + {put_tuple2,Dst,{list,List}}; + %% %% Catches instructions that are not yet handled. %% diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 05c0f4fbc7..2b9c1b0cf5 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -31,7 +31,7 @@ %%% erlang:error(function_clause, Args) => jump FuncInfoLabel %%% --import(lists, [reverse/1]). +-import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -53,7 +53,7 @@ function({function,Name,Arity,CLabel,Is0}) -> -record(st, {lbl :: beam_asm:label(), %func_info label loc :: [_], %location for func_info - arity :: arity() %arity for function + arity :: arity() %arity for function }). function_1(Is0) -> @@ -74,27 +74,33 @@ translate([I|Is], St, Acc) -> translate([], _, Acc) -> reverse(Acc). -translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) -> - case dig_out(Ar, Acc1) of +translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> + case dig_out(Ar, Arity, Acc1) of no -> translate(Is, St, [I|Acc0]); - {yes,{function_clause,Arity},Acc2} -> - case {Line,St} of - {{line,Loc},#st{lbl=Fi,loc=Loc,arity=Arity}} -> + {yes,function_clause,Acc2} -> + case {Is,Line,St} of + {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} -> Instr = {jump,{f,Fi}}, translate(Is, St, [Instr|Acc2]); - {_,_} -> - %% This must be "error(function_clause, Args)" in - %% the Erlang source code or a fun. Don't translate. + {_,_,_} -> + %% Not a call_only instruction, or not the same + %% location information as in in the line instruction + %% before the func_info instruction. Not safe + %% to translate to a jump. translate(Is, St, [I|Acc0]) end; {yes,Instr,Acc2} -> translate(Is, St, [Instr,Line|Acc2]) end. -dig_out(Ar, [{kill,_}|Is]) -> - dig_out(Ar, Is); -dig_out(1, [{block,Bl0}|Is]) -> +dig_out(1, _Arity, Is) -> + dig_out(Is); +dig_out(2, Arity, Is) -> + dig_out_fc(Arity, Is); +dig_out(_, _, _) -> no. + +dig_out([{block,Bl0}|Is]) -> case dig_out_block(reverse(Bl0)) of no -> no; {yes,What,[]} -> @@ -102,25 +108,13 @@ dig_out(1, [{block,Bl0}|Is]) -> {yes,What,Bl} -> {yes,What,[{block,Bl}|Is]} end; -dig_out(2, [{block,Bl}|Is]) -> - case dig_out_block_fc(Bl) of - no -> no; - {yes,What} -> {yes,What,Is} - end; -dig_out(_, _) -> no. +dig_out(_) -> no. dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> {yes,if_end,[]}; dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> translate_exception(Exc, {literal,Value}, Is, 0); -dig_out_block([{set,[{x,0}],[Tuple],move}, - {set,[],[Value],put}, - {set,[],[{atom,Exc}],put}, - {set,[Tuple],[],{put_tuple,2}}|Is]) -> - translate_exception(Exc, Value, Is, 3); -dig_out_block([{set,[],[Value],put}, - {set,[],[{atom,Exc}],put}, - {set,[{x,0}],[],{put_tuple,2}}|Is]) -> +dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) -> translate_exception(Exc, Value, Is, 3); dig_out_block(_) -> no. @@ -138,23 +132,124 @@ fix_block(Is, Words) -> reverse(fix_block_1(Is, Words)). fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) -> - Needed = Needed0 - Words, - true = Needed >= 0, %Assertion. - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is]; + case Needed0 - Words of + 0 -> + Is; + Needed -> + true = Needed >= 0, %Assertion. + [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] + end; fix_block_1([I|Is], Words) -> - [I|fix_block_1(Is, Words)]. + [I|fix_block_1(Is, Words)]; +fix_block_1([], _Words) -> + %% Rare. The heap allocation was probably done by a binary + %% construction instruction. + []. + +dig_out_fc(Arity, Is0) -> + Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]), + {Is,Acc0} = splitwith(fun({label,_}) -> false; + ({test,_,_,_}) -> false; + (_) -> true + end, Is0), + {Regs,Acc} = dig_out_fc_1(reverse(Is), Arity, Regs0, Acc0), + case Regs of + #{{x,0}:={atom,function_clause},{x,1}:=Args} -> + case moves_from_stack(Args, 0, []) of + {Moves,Arity} -> + {yes,function_clause,reverse(Moves, Acc)}; + {_,_} -> + no + end; + #{} -> + no + end. -dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> - case dig_out_fc(Bl, Live-1, nil) of - no -> - no; - yes -> - {yes,{function_clause,Live}} +dig_out_fc_1([{block,Bl}|Is], Arity, Regs0, Acc) -> + Regs = dig_out_fc_block(Bl, Regs0), + dig_out_fc_1(Is, Arity, Regs, Acc); +dig_out_fc_1([{bs_set_position,_,_}=I|Is], Arity, Regs, Acc) -> + dig_out_fc_1(Is, Arity, Regs, [I|Acc]); +dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Arity, Regs0, Acc) -> + case Src of + {x,X} when X < Arity -> + %% The heuristic for determining the number of live + %% registers is likely to give an incorrect result. + %% Give up. + {#{},[]}; + _ -> + Regs = prune_xregs(Live0, Regs0), + Live = dig_out_stack_live(Regs, Live0), + I = {bs_get_tail,Src,Dst,Live}, + dig_out_fc_1(Is, Arity, Regs, [I|Acc]) end; -dig_out_block_fc(_) -> no. +dig_out_fc_1([_|_], _Arity, _Regs, _Acc) -> + {#{},[]}; +dig_out_fc_1([], _Arity, Regs, Acc) -> + {Regs,Acc}. + +dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) -> + Regs = prune_xregs(Live, Regs0), + dig_out_fc_block(Is, Regs); +dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> + Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, + dig_out_fc_block(Is, Regs); +dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) -> + Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, + dig_out_fc_block(Is, Regs); +dig_out_fc_block([{set,_,_,_}|_], _Regs) -> + %% Unknown instruction. Fail. + #{}; +dig_out_fc_block([], Regs) -> Regs. + +dig_out_stack_live(Regs, Default) -> + Reg = {x,2}, + case Regs of + #{Reg:=List} -> + dig_out_stack_live_1(List, Default); + #{} -> + Default + end. + +dig_out_stack_live_1({cons,{arg,N},T}, Live) -> + dig_out_stack_live_1(T, max(N + 1, Live)); +dig_out_stack_live_1({cons,_,T}, Live) -> + dig_out_stack_live_1(T, Live); +dig_out_stack_live_1(nil, Live) -> + Live; +dig_out_stack_live_1(_, Live) -> Live. + +prune_xregs(Live, Regs) -> + maps:filter(fun({x,X}, _) -> X < Live end, Regs). + +moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> + %% Wrong argument. Give up. + {[],-1}; +moves_from_stack({cons,H,T}, I, Acc) -> + case H of + {arg,I} -> + moves_from_stack(T, I+1, Acc); + _ -> + moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) + end; +moves_from_stack(nil, I, Acc) -> + {reverse(Acc),I}; +moves_from_stack({literal,[H|T]}, I, Acc) -> + Cons = {cons,tag_literal(H),tag_literal(T)}, + moves_from_stack(Cons, I, Acc); +moves_from_stack(_, _, _) -> + %% Not understood. Give up. + {[],-1}. + + +get_reg(R, Regs) -> + case Regs of + #{R:=Val} -> Val; + #{} -> R + end. -dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) -> - dig_out_fc(Is, Reg-1, Dst); -dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) -> - yes; -dig_out_fc(_, _, _) -> no. +tag_literal([]) -> nil; +tag_literal(T) when is_atom(T) -> {atom,T}; +tag_literal(T) when is_float(T) -> {float,T}; +tag_literal(T) when is_integer(T) -> {integer,T}; +tag_literal(T) -> {literal,T}. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 20bd23a912..3e6bc1b1ed 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -32,8 +32,7 @@ module({Mod,Exp,Attr,Fs,Lc}, _Opt) -> {ok,{Mod,Exp,Attr,[function(F) || F <- Fs],Lc}}. function({function,Name,Arity,CLabel,Is0}) -> - Is1 = block(Is0), - Is = opt(Is1), + Is = block(Is0), {function,Name,Arity,CLabel,Is}. block(Is) -> @@ -44,18 +43,11 @@ block([I|Is], Acc) -> block(Is, [I|Acc]); block([], Acc) -> reverse(Acc). norm_block([{set,[],[],{alloc,R,Alloc}}|Is], Acc0) -> - case insert_alloc_in_bs_init(Acc0, Alloc) of - impossible -> - norm_block(Is, reverse(norm_allocate(Alloc, R), 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(Is, reverse(norm_allocate(Alloc, R), Acc0)); +norm_block([I|Is], Acc) -> + norm_block(Is, [norm(I)|Acc]); norm_block([], Acc) -> Acc. - + norm({set,[D],As,{bif,N,F}}) -> {bif,N,F,As,D}; norm({set,[D],As,{alloc,R,{gc_bif,N,F}}}) -> {gc_bif,N,F,R,As,D}; norm({set,[D],[],init}) -> {init,D}; @@ -63,6 +55,7 @@ norm({set,[D],[S],move}) -> {move,S,D}; norm({set,[D],[S],fmove}) -> {fmove,S,D}; norm({set,[D],[S],fconv}) -> {fconv,S,D}; norm({set,[D],[S1,S2],put_list}) -> {put_list,S1,S2,D}; +norm({set,[D],Els,put_tuple2}) -> {put_tuple2,D,{list,Els}}; 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}; @@ -88,57 +81,3 @@ norm_allocate({nozero,Ns,0,Inits}, Regs) -> [{allocate,Ns,Regs}|Inits]; norm_allocate({nozero,Ns,Nh,Inits}, Regs) -> [{allocate_heap,Ns,Nh,Regs}|Inits]. - -%% insert_alloc_in_bs_init(ReverseInstructionStream, AllocationInfo) -> -%% impossible | ReverseInstructionStream' -%% A bs_init/6 instruction should not be followed by a test heap instruction. -%% Given the AllocationInfo from a test heap instruction, merge the -%% allocation amounts into the previous bs_init/6 instruction (if any). -%% -insert_alloc_in_bs_init([{bs_put,_,_,_}=I|Is], Alloc) -> - %% The instruction sequence ends with an bs_put/4 instruction. - %% We'll need to search backwards for the bs_init/6 instruction. - insert_alloc_1(Is, Alloc, [I]); -insert_alloc_in_bs_init(_, _) -> impossible. - -insert_alloc_1([{bs_init=Op,Fail,Info0,Live,Ss,Dst}|Is], - {_,nostack,Ws2,[]}, Acc) when is_integer(Live) -> - %% The number of extra heap words is always in the second position - %% in the Info tuple. - Ws1 = element(2, Info0), - Al = beam_utils:combine_heap_needs(Ws1, Ws2), - Info = setelement(2, Info0, Al), - I = {Op,Fail,Info,Live,Ss,Dst}, - reverse(Acc, [I|Is]); -insert_alloc_1([{bs_put,_,_,_}=I|Is], Alloc, Acc) -> - insert_alloc_1(Is, Alloc, [I|Acc]). - -%% opt(Is0) -> Is -%% Simple peep-hole optimization to move a {move,Any,{x,0}} past -%% any kill up to the next call instruction. (To give the loader -%% an opportunity to combine the 'move' and the 'call' instructions.) -%% -opt(Is) -> - opt_1(Is, []). - -opt_1([{move,_,{x,0}}=I|Is0], Acc0) -> - case move_past_kill(Is0, I, Acc0) of - impossible -> opt_1(Is0, [I|Acc0]); - {Is,Acc} -> opt_1(Is, Acc) - end; -opt_1([I|Is], Acc) -> - opt_1(Is, [I|Acc]); -opt_1([], Acc) -> reverse(Acc). - -move_past_kill([{kill,Src}|_], {move,Src,_}, _) -> - impossible; -move_past_kill([{kill,_}=I|Is], Move, Acc) -> - move_past_kill(Is, Move, [I|Acc]); -move_past_kill([{trim,N,_}=I|Is], {move,Src,Dst}=Move, Acc) -> - case Src of - {y,Y} when Y < N-> impossible; - {y,Y} -> {Is,[{move,{y,Y-N},Dst},I|Acc]}; - _ -> {Is,[Move,I|Acc]} - end; -move_past_kill(Is, Move, Acc) -> - {Is,[Move|Acc]}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 22974da398..74f80ca70e 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -22,7 +22,7 @@ -module(beam_jump). -export([module/2, - is_unreachable_after/1,is_exit_instruction/1, + is_exit_instruction/1, remove_unused_labels/1]). %%% The following optimisations are done: @@ -101,6 +101,10 @@ %%% always keep the label. (beam_clean will remove any unused %%% labels.) %%% +%%% (7) Replace a jump to a return instruction with a return instruction. +%%% Similarly, replace a jump to deallocate + return with those +%%% instructions. +%%% %%% Note: This modules depends on (almost) all branches and jumps only %%% going forward, so that we can remove instructions (including definition %%% of labels) after any label that has not been referenced by the code @@ -128,27 +132,136 @@ %%% on the program state. %%% --import(lists, [dropwhile/2,reverse/1,reverse/2,foldl/3]). +-import(lists, [foldl/3,mapfoldl/3,reverse/1,reverse/2]). -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], +module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> + {Fs,Lc} = mapfoldl(fun function/2, Lc0, Fs0), {ok,{Mod,Exp,Attr,Fs,Lc}}. %% function(Function) -> Function' %% Optimize jumps and branches. %% %% NOTE: This function assumes that there are no labels inside blocks. -function({function,Name,Arity,CLabel,Asm0}) -> - Asm1 = share(Asm0), - Asm2 = move(Asm1), - Asm3 = opt(Asm2, CLabel), - Asm = remove_unused_labels(Asm3), - {function,Name,Arity,CLabel,Asm}. +function({function,Name,Arity,CLabel,Asm0}, Lc0) -> + try + Asm1 = eliminate_moves(Asm0), + {Asm2,Lc} = insert_labels(Asm1, Lc0, []), + Asm3 = share(Asm2), + Asm4 = move(Asm3), + Asm5 = opt(Asm4, CLabel), + Asm6 = unshare(Asm5), + Asm = remove_unused_labels(Asm6), + {{function,Name,Arity,CLabel,Asm},Lc} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%%% +%%% Scan instructions in execution order and remove redundant 'move' +%%% instructions. 'move' instructions are redundant if we know that +%%% the register already contains the value being assigned, as in the +%%% following code: +%%% +%%% select_val Register FailLabel [... Literal => L1...] +%%% . +%%% . +%%% . +%%% L1: move Literal Register +%%% + +eliminate_moves(Is) -> + eliminate_moves(Is, #{}, []). + +eliminate_moves([{select,select_val,Reg,{f,Fail},List}=I|Is], D0, Acc) -> + D1 = add_unsafe_label(Fail, D0), + D = update_value_dict(List, Reg, D1), + eliminate_moves(Is, D, [I|Acc]); +eliminate_moves([{test,is_eq_exact,_,[Reg,Val]}=I, + {block,BlkIs0}|Is], D0, Acc) -> + D = update_unsafe_labels(I, D0), + RegVal = {Reg,Val}, + BlkIs = eliminate_moves_blk(BlkIs0, RegVal), + eliminate_moves([{block,BlkIs}|Is], D, [I|Acc]); +eliminate_moves([{label,Lbl},{block,BlkIs0}=Blk|Is], D, Acc0) -> + Acc = [{label,Lbl}|Acc0], + case {no_fallthrough(Acc0),D} of + {true,#{Lbl:={_,_}=RegVal}} -> + BlkIs = eliminate_moves_blk(BlkIs0, RegVal), + eliminate_moves([{block,BlkIs}|Is], D, Acc); + {_,_} -> + eliminate_moves([Blk|Is], D, Acc) + end; +eliminate_moves([{block,[]}|Is], D, Acc) -> + %% Empty blocks can prevent further jump optimizations. + eliminate_moves(Is, D, Acc); +eliminate_moves([I|Is], D0, Acc) -> + D = update_unsafe_labels(I, D0), + eliminate_moves(Is, D, [I|Acc]); +eliminate_moves([], _, Acc) -> reverse(Acc). + +eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {_,Dst}) -> + Is; +eliminate_moves_blk([{set,[Dst],[Lit],move}|Is], {Dst,Lit}) -> + %% Remove redundant 'move' instruction. + Is; +eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {Dst,_}) -> + Is; +eliminate_moves_blk([{set,[_],[_],move}=I|Is], {_,_}=RegVal) -> + [I|eliminate_moves_blk(Is, RegVal)]; +eliminate_moves_blk(Is, _) -> Is. + +no_fallthrough([I|_]) -> + is_unreachable_after(I). + +update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> + D = case D0 of + #{Lbl:=unsafe} -> D0; + #{Lbl:={Reg,Lit}} -> D0; + #{Lbl:=_} -> D0#{Lbl:=unsafe}; + #{} -> D0#{Lbl=>{Reg,Lit}} + end, + update_value_dict(T, Reg, D); +update_value_dict([], _, D) -> D. + +add_unsafe_label(L, D) -> + D#{L=>unsafe}. + +update_unsafe_labels(I, D) -> + Ls = instr_labels(I), + update_unsafe_labels_1(Ls, D). + +update_unsafe_labels_1([L|Ls], D) -> + update_unsafe_labels_1(Ls, D#{L=>unsafe}); +update_unsafe_labels_1([], D) -> D. + +%%% +%%% It seems to be useful to insert extra labels after certain +%%% test instructions. This used to be done by beam_dead. +%%% + +insert_labels([{test,Op,_,_}=I|Is], Lc, Acc) -> + Useful = case Op of + is_lt -> true; + is_ge -> true; + is_eq_exact -> true; + is_ne_exact -> true; + _ -> false + end, + case Useful of + false -> insert_labels(Is, Lc, [I|Acc]); + true -> insert_labels(Is, Lc+1, [{label,Lc},I|Acc]) + end; +insert_labels([I|Is], Lc, Acc) -> + insert_labels(Is, Lc, [I|Acc]); +insert_labels([], Lc, Acc) -> + {reverse(Acc),Lc}. %%% %%% (1) We try to share the code for identical code segments by replacing all @@ -156,41 +269,51 @@ function({function,Name,Arity,CLabel,Asm0}) -> %%% share(Is0) -> - %% We will get more sharing if we never fall through to a label. - Is = eliminate_fallthroughs(Is0, []), - share_1(Is, #{}, [], []). + Is1 = eliminate_fallthroughs(Is0, []), + Is2 = find_fixpoint(fun(Is) -> + share_1(Is, #{}, #{}, [], []) + end, Is1), + reverse(Is2). -share_1([{label,L}=Lbl|Is], Dict0, [_|_]=Seq, Acc) -> +share_1([{label,L}=Lbl|Is], Dict0, Lbls0, [_|_]=Seq, Acc) -> case maps:find(Seq, Dict0) of - error -> - Dict = maps:put(Seq, L, Dict0), - share_1(Is, Dict, [], [Lbl|Seq ++ Acc]); - {ok,Label} -> - share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) + error -> + Dict = maps:put(Seq, L, Dict0), + share_1(Is, Dict, Lbls0, [], [[Lbl|Seq]|Acc]); + {ok,Label} -> + Lbls = maps:put(L, Label, Lbls0), + share_1(Is, Dict0, Lbls, [], [[Lbl,{jump,{f,Label}}]|Acc]) end; -share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> - reverse(Is, [I|Acc]); -share_1([{'catch',_,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([{catch_end,_}=I|Is], Dict0, Seq, Acc) -> - Dict = clean_non_sharable(Dict0), - share_1(Is, Dict, [I|Seq], Acc); -share_1([I|Is], Dict, Seq, Acc) -> +share_1([{func_info,_,_,_}|_]=Is0, _, Lbls, [], Acc0) when Lbls =/= #{} -> + lists:foldl(fun(Is, Acc) -> + beam_utils:replace_labels(Is, Acc, Lbls, fun(Old) -> Old end) + end, Is0, Acc0); +share_1([{func_info,_,_,_}|_]=Is, _, Lbls, [], Acc) when Lbls =:= #{} -> + lists:foldl(fun lists:reverse/2, Is, Acc); +share_1([{'catch',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{'try',_,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{try_case,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{catch_end,_}=I|Is], Dict0, Lbls0, Seq, Acc) -> + {Dict,Lbls} = clean_non_sharable(Dict0, Lbls0), + share_1(Is, Dict, Lbls, [I|Seq], Acc); +share_1([{jump,{f,To}}=I,{label,L}=Lbl|Is], Dict0, Lbls0, _Seq, Acc) -> + Lbls = maps:put(L, To, Lbls0), + share_1(Is, Dict0, Lbls, [], [[Lbl,I]|Acc]); +share_1([I|Is], Dict, Lbls, Seq, Acc) -> case is_unreachable_after(I) of false -> - share_1(Is, Dict, [I|Seq], Acc); + share_1(Is, Dict, Lbls, [I|Seq], Acc); true -> - share_1(Is, Dict, [I], Acc) + share_1(Is, Dict, Lbls, [I], Acc) end. -clean_non_sharable(Dict) -> +clean_non_sharable(Dict0, Lbls0) -> %% We are passing in or out of a 'catch' or 'try' block. Remove %% sequences that should not be shared over the boundaries of the %% block. Since the end of the sequence must match, the only @@ -198,7 +321,17 @@ clean_non_sharable(Dict) -> %% the 'catch'/'try' block is a sequence that ends with an %% instruction that causes an exception. Any sequence that causes %% an exception must contain a line/1 instruction. - maps:filter(fun(K, _V) -> sharable_with_try(K) end, Dict). + Dict1 = maps:to_list(Dict0), + Lbls1 = maps:to_list(Lbls0), + {Dict2,Lbls2} = foldl(fun({K, V}, {Dict,Lbls}) -> + case sharable_with_try(K) of + true -> + {[{K,V}|Dict],lists:keydelete(V, 2, Lbls)}; + false -> + {Dict,Lbls} + end + end, {[],Lbls1}, Dict1), + {maps:from_list(Dict2),maps:from_list(Lbls2)}. sharable_with_try([{line,_}|_]) -> %% This sequence may cause an exception and may potentially @@ -251,8 +384,6 @@ extract_seq([{line,_}=Line|Is], Acc) -> extract_seq(Is, [Line|Acc]); extract_seq([{block,_}=Bl|Is], Acc) -> extract_seq_1(Is, [Bl|Acc]); -extract_seq([{bs_context_to_binary,_}=I|Is], Acc) -> - extract_seq_1(Is, [I|Acc]); extract_seq([{label,_}|_]=Is, Acc) -> extract_seq_1(Is, Acc); extract_seq(_, _) -> no. @@ -276,14 +407,13 @@ extract_seq_1(_, _) -> no. { 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 + labels :: cerl_sets:set() %Set of referenced labels. }). opt(Is0, CLabel) -> find_fixpoint(fun(Is) -> Lbls = initial_labels(Is), - St = #st{entry=CLabel,replace=#{},labels=Lbls,index={lazy,Is}}, + St = #st{entry=CLabel,replace=#{},labels=Lbls}, opt(Is, [], St) end, Is0). @@ -293,7 +423,7 @@ find_fixpoint(OptFun, Is0) -> Is -> find_fixpoint(OptFun, Is) end. -opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) -> +opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) -> %% We have %% Test Label Ops %% jump Label @@ -302,23 +432,10 @@ opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) -> case beam_utils:is_pure_test(I) of false -> %% Test is not pure; we must keep it. - opt(Is, [I|Acc0], label_used(Lbl, St0)); + opt(Is, [I|Acc], label_used(Lbl, St)); 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) -> @@ -385,51 +502,6 @@ normalize_replace([{From,To0}|Rest], Replace, Acc) -> 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|Is0], L, Index) -> - BlockJump = [{block,Is0},{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. - %% Remove any `put` instructions in case we just - %% removed a `put_tuple` instruction. - Is = dropwhile(fun({set,_,_,put}) -> true; - (_) -> false - end, Is0), - opt_useless_block_loads(Is, L, Index); - false -> - [I|opt_useless_block_loads(Is0, 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, Label, #st{entry=Entry,replace=Replace} = St) -> collect_labels_1(Is, Label, Entry, Replace, St). @@ -556,52 +628,109 @@ drop_upto_label([{label,_}|_]=Is) -> Is; drop_upto_label([_|Is]) -> drop_upto_label(Is); drop_upto_label([]) -> []. -%% ulbl(Instruction, UsedGbSet) -> UsedGbSet' -%% Update the gb_set UsedGbSet with any function-local labels +%% unshare([Instruction]) -> [Instruction]. +%% Replace a jump to a return sequence (a `return` instruction +%% optionally preced by a `deallocate` instruction) with the return +%% sequence. This always saves execution time and may also save code +%% space (depending on the architecture). Eliminating `jump` +%% instructions also gives beam_trim more opportunities to trim the +%% stack. + +unshare(Is) -> + Short = unshare_collect_short(Is, #{}), + unshare_short(Is, Short). + +unshare_collect_short([{label,L},return|Is], Map) -> + unshare_collect_short(Is, Map#{L=>[return]}); +unshare_collect_short([{label,L},{deallocate,_}=D,return|Is], Map) -> + %% `deallocate` and `return` are combined into one instruction by + %% the loader. + unshare_collect_short(Is, Map#{L=>[D,return]}); +unshare_collect_short([_|Is], Map) -> + unshare_collect_short(Is, Map); +unshare_collect_short([], Map) -> Map. + +unshare_short([{jump,{f,F}}=I|Is], Map) -> + case Map of + #{F:=Seq} -> + Seq ++ unshare_short(Is, Map); + #{} -> + [I|unshare_short(Is, Map)] + end; +unshare_short([I|Is], Map) -> + [I|unshare_short(Is, Map)]; +unshare_short([], _Map) -> []. + +%% ulbl(Instruction, UsedCerlSet) -> UsedCerlSet' +%% Update the cerl_set UsedCerlSet with any function-local labels %% (i.e. not with labels in call instructions) referenced by %% the instruction Instruction. %% %% NOTE: This function does NOT look for labels inside blocks. -ulbl({test,_,Fail,_}, Used) -> - mark_used(Fail, Used); -ulbl({test,_,Fail,_,_,_}, Used) -> - mark_used(Fail, Used); -ulbl({select,_,_,Fail,Vls}, Used) -> - mark_used_list(Vls, mark_used(Fail, Used)); -ulbl({'try',_,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({'catch',_,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({jump,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({loop_rec,Lbl,_}, Used) -> - mark_used(Lbl, Used); -ulbl({loop_rec_end,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({wait,Lbl}, Used) -> - mark_used(Lbl, Used); -ulbl({wait_timeout,Lbl,_To}, Used) -> - mark_used(Lbl, Used); -ulbl({bif,_Name,Lbl,_As,_R}, Used) -> - mark_used(Lbl, Used); -ulbl({gc_bif,_Name,Lbl,_Live,_As,_R}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_init,Lbl,_,_,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put,Lbl,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}, Used) -> - mark_used(Lbl, Used); -ulbl({get_map_elements,Lbl,_Src,_List}, Used) -> - mark_used(Lbl, Used); -ulbl(_, Used) -> Used. - -mark_used({f,0}, Used) -> Used; -mark_used({f,L}, Used) -> cerl_sets:add_element(L, Used). - -mark_used_list([{f,L}|T], Used) -> - mark_used_list(T, cerl_sets:add_element(L, Used)); -mark_used_list([_|T], Used) -> - mark_used_list(T, Used); -mark_used_list([], Used) -> Used. +ulbl(I, Used) -> + case instr_labels(I) of + [] -> + Used; + [Lbl] -> + cerl_sets:add_element(Lbl, Used); + [_|_]=L -> + ulbl_list(L, Used) + end. + +ulbl_list([L|Ls], Used) -> + ulbl_list(Ls, cerl_sets:add_element(L, Used)); +ulbl_list([], Used) -> Used. + +-spec instr_labels(Instruction) -> Labels when + Instruction :: instruction(), + Labels :: [beam_asm:label()]. + +instr_labels({test,_,Fail,_}) -> + do_instr_labels(Fail); +instr_labels({test,_,Fail,_,_,_}) -> + do_instr_labels(Fail); +instr_labels({select,_,_,Fail,Vls}) -> + do_instr_labels_list(Vls, do_instr_labels(Fail)); +instr_labels({'try',_,Lbl}) -> + do_instr_labels(Lbl); +instr_labels({'catch',_,Lbl}) -> + do_instr_labels(Lbl); +instr_labels({jump,Lbl}) -> + do_instr_labels(Lbl); +instr_labels({loop_rec,Lbl,_}) -> + do_instr_labels(Lbl); +instr_labels({loop_rec_end,Lbl}) -> + do_instr_labels(Lbl); +instr_labels({wait,Lbl}) -> + do_instr_labels(Lbl); +instr_labels({wait_timeout,Lbl,_To}) -> + do_instr_labels(Lbl); +instr_labels({bif,_Name,Lbl,_As,_R}) -> + do_instr_labels(Lbl); +instr_labels({gc_bif,_Name,Lbl,_Live,_As,_R}) -> + do_instr_labels(Lbl); +instr_labels({bs_init,Lbl,_,_,_,_}) -> + do_instr_labels(Lbl); +instr_labels({bs_put,Lbl,_,_}) -> + do_instr_labels(Lbl); +instr_labels({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}) -> + do_instr_labels(Lbl); +instr_labels({get_map_elements,Lbl,_Src,_List}) -> + do_instr_labels(Lbl); +instr_labels({recv_mark,Lbl}) -> + do_instr_labels(Lbl); +instr_labels({recv_set,Lbl}) -> + do_instr_labels(Lbl); +instr_labels({fcheckerror,Lbl}) -> + do_instr_labels(Lbl); +instr_labels(_) -> []. + +do_instr_labels({f,0}) -> []; +do_instr_labels({f,F}) -> [F]. + +do_instr_labels_list([{f,F}|T], Acc) -> + do_instr_labels_list(T, [F|Acc]); +do_instr_labels_list([_|T], Acc) -> + do_instr_labels_list(T, Acc); +do_instr_labels_list([], Acc) -> Acc. diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl new file mode 100644 index 0000000000..df95749fb3 --- /dev/null +++ b/lib/compiler/src/beam_kernel_to_ssa.erl @@ -0,0 +1,1312 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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: Convert the Kernel Erlang format to the SSA format. + +-module(beam_kernel_to_ssa). + +%% The main interface. +-export([module/2]). + +-import(lists, [append/1,duplicate/2,flatmap/2,foldl/3, + keysort/2,mapfoldl/3,map/2,member/2, + reverse/1,reverse/2,sort/1]). + +-include("v3_kernel.hrl"). +-include("beam_ssa.hrl"). + +-type label() :: beam_ssa:label(). + +%% Main codegen structure. +-record(cg, {lcount=1 :: label(), %Label counter + bfail=1 :: label(), + catch_label=none :: 'none' | label(), + vars=#{} :: map(), %Defined variables. + break=0 :: label(), %Break label + recv=0 :: label(), %Receive label + ultimate_failure=0 :: label() %Label for ultimate match failure. + }). + +%% Internal records. +-record(cg_break, {args :: [beam_ssa:value()], + phi :: label() + }). +-record(cg_phi, {vars :: [beam_ssa:b_var()] + }). +-record(cg_unreachable, {}). + +-spec module(#k_mdef{}, [compile:option()]) -> {'ok',#b_module{}}. + +module(#k_mdef{name=Mod,exports=Es,attributes=Attr,body=Forms}, _Opts) -> + Body = functions(Forms, Mod), + Module = #b_module{name=Mod,exports=Es,attributes=Attr,body=Body}, + {ok,Module}. + +functions(Forms, Mod) -> + [function(F, Mod) || F <- Forms]. + +function(#k_fdef{anno=Anno0,func=Name,arity=Arity, + vars=As0,body=Kb}, Mod) -> + try + #k_match{} = Kb, %Assertion. + + %% Generate the SSA form immediate format. + St0 = #cg{}, + {As,St1} = new_ssa_vars(As0, St0), + {Asm,St} = cg_fun(Kb, St1), + Anno1 = line_anno(Anno0), + Anno = Anno1#{func_info=>{Mod,Name,Arity}}, + #b_function{anno=Anno,args=As,bs=Asm,cnt=St#cg.lcount} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +%% cg_fun([Lkexpr], [HeadVar], State) -> {[Ainstr],State} + +cg_fun(Ke, St0) -> + {UltimateFail,FailIs,St1} = make_failure(badarg, St0), + St2 = St1#cg{bfail=UltimateFail,ultimate_failure=UltimateFail}, + {B,St} = cg(Ke, St2), + Asm = [{label,0}|B++FailIs], + finalize(Asm, St). + +make_failure(Reason, St0) -> + {Lbl,St1} = new_label(St0), + {Dst,St} = new_ssa_var('@ssa_ret', St1), + Is = [{label,Lbl}, + #b_set{op=call,dst=Dst, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}, + arity=1}, + #b_literal{val=Reason}]}, + #b_ret{arg=Dst}], + {Lbl,Is,St}. + +%% cg(Lkexpr, State) -> {[Ainstr],State}. +%% Generate code for a kexpr. + +cg(#k_match{body=M,ret=Rs}, St) -> + do_match_cg(M, Rs, St); +cg(#k_guard_match{body=M,ret=Rs}, St) -> + do_match_cg(M, Rs, St); +cg(#k_seq{arg=Arg,body=Body}, St0) -> + {ArgIs,St1} = cg(Arg, St0), + {BodyIs,St} = cg(Body, St1), + {ArgIs++BodyIs,St}; +cg(#k_call{anno=Le,op=Func,args=As,ret=Rs}, St) -> + call_cg(Func, As, Rs, Le, St); +cg(#k_enter{anno=Le,op=Func,args=As}, St) -> + enter_cg(Func, As, Le, St); +cg(#k_bif{anno=Le}=Bif, St) -> + bif_cg(Bif, Le, St); +cg(#k_try{arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th,ret=Rs}, St) -> + try_cg(Ta, Vs, Tb, Evs, Th, Rs, St); +cg(#k_try_enter{arg=Ta,vars=Vs,body=Tb,evars=Evs,handler=Th}, St) -> + try_enter_cg(Ta, Vs, Tb, Evs, Th, St); +cg(#k_catch{body=Cb,ret=[R]}, St) -> + do_catch_cg(Cb, R, St); +cg(#k_receive{anno=Le,timeout=Te,var=Rvar,body=Rm,action=Tes,ret=Rs}, St) -> + recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St); +cg(#k_receive_next{}, #cg{recv=Recv}=St) -> + Is = [#b_set{op=recv_next},make_uncond_branch(Recv)], + {Is,St}; +cg(#k_receive_accept{}, St) -> + Remove = #b_set{op=remove_message}, + {[Remove],St}; +cg(#k_put{anno=Le,arg=Con,ret=Var}, St) -> + put_cg(Var, Con, Le, St); +cg(#k_return{args=[Ret0]}, St) -> + Ret = ssa_arg(Ret0, St), + {[#b_ret{arg=Ret}],St}; +cg(#k_break{args=Bs}, #cg{break=Br}=St) -> + Args = ssa_args(Bs, St), + {[#cg_break{args=Args,phi=Br}],St}; +cg(#k_guard_break{args=Bs}, St) -> + cg(#k_break{args=Bs}, St). + +%% match_cg(Matc, [Ret], State) -> {[Ainstr],State}. +%% Generate code for a match. + +do_match_cg(M, Rs, St0) -> + {B,St1} = new_label(St0), + {Mis,St2} = match_cg(M, St1#cg.bfail, St1#cg{break=B}), + {BreakVars,St} = new_ssa_vars(Rs, St2), + {Mis ++ [{label,B},#cg_phi{vars=BreakVars}], + St#cg{bfail=St0#cg.bfail,break=St1#cg.break}}. + +%% match_cg(Match, Fail, State) -> {[Ainstr],State}. +%% Generate code for a match tree. + +match_cg(#k_alt{first=F,then=S}, Fail, St0) -> + {Tf,St1} = new_label(St0), + {Fis,St2} = match_cg(F, Tf, St1), + {Sis,St3} = match_cg(S, Fail, St2), + {Fis ++ [{label,Tf}] ++ Sis,St3}; +match_cg(#k_select{var=#k_var{}=V,types=Scs}, Fail, St) -> + match_fmf(fun (S, F, Sta) -> + select_cg(S, V, F, Fail, Sta) + end, Fail, St, Scs); +match_cg(#k_guard{clauses=Gcs}, Fail, St) -> + match_fmf(fun (G, F, Sta) -> + guard_clause_cg(G, F, Sta) + end, Fail, St, Gcs); +match_cg(Ke, _Fail, St0) -> + cg(Ke, St0). + +%% select_cg(Sclause, V, TypeFail, ValueFail, State) -> {Is,State}. +%% Selecting type and value needs two failure labels, TypeFail is the +%% label to jump to of the next type test when this type fails, and +%% ValueFail is the label when this type is correct but the value is +%% wrong. These are different as in the second case there is no need +%% to try the next type, it will always fail. + +select_cg(#k_type_clause{type=k_binary,values=[S]}, Var, Tf, Vf, St) -> + select_binary(S, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_bin_seg,values=Vs}, Var, Tf, _Vf, St) -> + select_bin_segs(Vs, Var, Tf, St); +select_cg(#k_type_clause{type=k_bin_int,values=Vs}, Var, Tf, _Vf, St) -> + select_bin_segs(Vs, Var, Tf, St); +select_cg(#k_type_clause{type=k_bin_end,values=[S]}, Var, Tf, _Vf, St) -> + select_bin_end(S, Var, Tf, St); +select_cg(#k_type_clause{type=k_map,values=Vs}, Var, Tf, Vf, St) -> + select_map(Vs, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_cons,values=[S]}, Var, Tf, Vf, St) -> + select_cons(S, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_nil,values=[S]}, Var, Tf, Vf, St) -> + select_nil(S, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=k_literal,values=Vs}, Var, Tf, Vf, St) -> + select_literal(Vs, Var, Tf, Vf, St); +select_cg(#k_type_clause{type=Type,values=Scs}, Var, Tf, Vf, St0) -> + {Vis,St1} = + mapfoldl(fun (S, Sta) -> + {Val,Is,Stb} = select_val(S, Var, Vf, Sta), + {{Is,[Val]},Stb} + end, St0, Scs), + OptVls = combine(lists:sort(combine(Vis))), + {Vls,Sis,St2} = select_labels(OptVls, St1, [], []), + Arg = ssa_arg(Var, St2), + {Is,St} = select_val_cg(Type, Arg, Vls, Tf, Vf, Sis, St2), + {Is,St}. + +select_val_cg(k_tuple, Tuple, Vls, Tf, Vf, Sis, St0) -> + {Is0,St1} = make_cond_branch({bif,is_tuple}, [Tuple], Tf, St0), + {Arity,St2} = new_ssa_var('@ssa_arity', St1), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is,St} = select_val_cg(k_int, Arity, Vls, Vf, Vf, Sis, St2), + {Is0++[GetArity]++Is,St}; +select_val_cg(Type, R, Vls, Tf, Vf, Sis, St0) -> + {TypeIs,St1} = if + Tf =:= Vf -> + %% The type and value failure labels are the same; + %% we don't need a type test. + {[],St0}; + true -> + %% Different labels for type failure and + %% label failure; we need a type test. + Test = select_type_test(Type), + make_cond_branch(Test, [R], Tf, St0) + end, + case Vls of + [{Val,Succ}] -> + {Is,St} = make_cond({bif,'=:='}, [R,Val], Vf, Succ, St1), + {TypeIs++Is++Sis,St}; + [_|_] -> + {TypeIs++[#b_switch{arg=R,fail=Vf,list=Vls}|Sis],St1} + end. + +select_type_test(k_int) -> {bif,is_integer}; +select_type_test(k_atom) -> {bif,is_atom}; +select_type_test(k_float) -> {bif,is_float}. + +combine([{Is,Vs1},{Is,Vs2}|Vis]) -> combine([{Is,Vs1 ++ Vs2}|Vis]); +combine([V|Vis]) -> [V|combine(Vis)]; +combine([]) -> []. + +select_labels([{Is,Vs}|Vis], St0, Vls, Sis) -> + {Lbl,St1} = new_label(St0), + select_labels(Vis, St1, add_vls(Vs, Lbl, Vls), [[{label,Lbl}|Is]|Sis]); +select_labels([], St, Vls, Sis) -> + {Vls,append(Sis),St}. + +add_vls([V|Vs], Lbl, Acc) -> + add_vls(Vs, Lbl, [{#b_literal{val=V},Lbl}|Acc]); +add_vls([], _, Acc) -> Acc. + +select_literal(S, V, Tf, Vf, St) -> + Src = ssa_arg(V, St), + F = fun(ValClause, Fail, St0) -> + {Val,ValIs,St1} = select_val(ValClause, V, Vf, St0), + Args = [Src,#b_literal{val=Val}], + {Is,St2} = make_cond_branch({bif,'=:='}, Args, Fail, St1), + {Is++ValIs,St2} + end, + match_fmf(F, Tf, St, S). + +select_cons(#k_val_clause{val=#k_cons{hd=Hd,tl=Tl},body=B}, + V, Tf, Vf, St0) -> + Es = [Hd,Tl], + {Eis,St1} = select_extract_cons(V, Es, St0), + {Bis,St2} = match_cg(B, Vf, St1), + Src = ssa_arg(V, St2), + {Is,St} = make_cond_branch(is_nonempty_list, [Src], Tf, St2), + {Is ++ Eis ++ Bis,St}. + +select_nil(#k_val_clause{val=#k_nil{},body=B}, V, Tf, Vf, St0) -> + {Bis,St1} = match_cg(B, Vf, St0), + Src = ssa_arg(V, St1), + {Is,St} = make_cond_branch({bif,'=:='}, [Src,#b_literal{val=[]}], Tf, St1), + {Is ++ Bis,St}. + +select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ctx0}},body=B}, + #k_var{}=Src, Tf, Vf, St0) -> + {Ctx,St1} = new_ssa_var(Ctx0, St0), + {Bis0,St2} = match_cg(B, Vf, St1), + {TestIs,St} = make_cond_branch(succeeded, [Ctx], Tf, St2), + Bis1 = [#b_set{op=bs_start_match,dst=Ctx, + args=[ssa_arg(Src, St)]}] ++ TestIs ++ Bis0, + Bis = finish_bs_matching(Bis1), + {Bis,St}. + +finish_bs_matching([#b_set{op=bs_match, + args=[#b_literal{val=string},Ctx,#b_literal{val=BinList}]}=Set|Is]) + when is_list(BinList) -> + I = Set#b_set{args=[#b_literal{val=string},Ctx, + #b_literal{val=list_to_bitstring(BinList)}]}, + finish_bs_matching([I|Is]); +finish_bs_matching([I|Is]) -> + [I|finish_bs_matching(Is)]; +finish_bs_matching([]) -> []. + +make_cond(Cond, Args, Fail, Succ, St0) -> + {Bool,St} = new_ssa_var('@ssa_bool', St0), + Bif = #b_set{op=Cond,dst=Bool,args=Args}, + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + {[Bif,Br],St}. + +make_cond_branch(Cond, Args, Fail, St0) -> + {Bool,St1} = new_ssa_var('@ssa_bool', St0), + {Succ,St} = new_label(St1), + Bif = #b_set{op=Cond,dst=Bool,args=Args}, + Br = #b_br{bool=Bool,succ=Succ,fail=Fail}, + {[Bif,Br,{label,Succ}],St}. + +make_uncond_branch(Fail) -> + #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}. + +%% Instructions for selection of binary segments. + +select_bin_segs(Scs, Ivar, Tf, St) -> + match_fmf(fun(S, Fail, Sta) -> + select_bin_seg(S, Ivar, Fail, Sta) + end, Tf, St, Scs). + +select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T, + seg=Seg,flags=Fs,next=Next}, + body=B,anno=Anno}, + #k_var{}=Src, Fail, St0) -> + LineAnno = line_anno(Anno), + Ctx = get_context(Src, St0), + {Mis,St1} = select_extract_bin(Next, Size, U, T, Fs, Fail, + Ctx, LineAnno, St0), + {Extracted,St2} = new_ssa_var(Seg#k_var.name, St1), + {Bis,St} = match_cg(B, Fail, St2), + BsGet = #b_set{op=bs_extract,dst=Extracted,args=[ssa_arg(Next, St)]}, + Is = Mis ++ [BsGet] ++ Bis, + {Is,St}; +select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs, + val=Val,next=Next}, + body=B}, + #k_var{}=Src, Fail, St0) -> + Ctx = get_context(Src, St0), + {Mis,St1} = select_extract_int(Next, Val, Sz, U, Fs, Fail, + Ctx, St0), + {Bis,St} = match_cg(B, Fail, St1), + Is = case Mis ++ Bis of + [#b_set{op=bs_match,args=[#b_literal{val=string},OtherCtx1,Bin1]}, + #b_set{op=succeeded,dst=Bool1}, + #b_br{bool=Bool1,succ=Succ,fail=Fail}, + {label,Succ}, + #b_set{op=bs_match,dst=Dst,args=[#b_literal{val=string},_OtherCtx2,Bin2]}| + [#b_set{op=succeeded,dst=Bool2}, + #b_br{bool=Bool2,fail=Fail}|_]=Is0] -> + %% We used to do this optimization later, but it + %% turns out that in huge functions with many + %% string matching instructions, it's a huge win + %% to do the combination now. To avoid copying the + %% binary data again and again, we'll combine bitstrings + %% in a list and convert all of it to a bitstring later. + {#b_literal{val=B1},#b_literal{val=B2}} = {Bin1,Bin2}, + Bin = #b_literal{val=[B1,B2]}, + Set = #b_set{op=bs_match,dst=Dst,args=[#b_literal{val=string},OtherCtx1,Bin]}, + [Set|Is0]; + Is0 -> + Is0 + end, + {Is,St}. + +get_context(#k_var{}=Var, St) -> + ssa_arg(Var, St). + +select_bin_end(#k_val_clause{val=#k_bin_end{},body=B}, Src, Tf, St0) -> + Ctx = get_context(Src, St0), + {Bis,St1} = match_cg(B, Tf, St0), + {TestIs,St} = make_cond_branch(bs_test_tail, [Ctx,#b_literal{val=0}], Tf, St1), + Is = TestIs++Bis, + {Is,St}. + +select_extract_bin(#k_var{name=Hd}, Size0, Unit, Type, Flags, Vf, + Ctx, Anno, St0) -> + {Dst,St1} = new_ssa_var(Hd, St0), + Size = ssa_arg(Size0, St0), + build_bs_instr(Anno, Type, Vf, Ctx, Size, Unit, Flags, Dst, St1). + +select_extract_int(#k_var{name=Tl}, 0, #k_int{val=0}, _U, _Fs, _Vf, + Ctx, St0) -> + St = set_ssa_var(Tl, Ctx, St0), + {[],St}; +select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, + Ctx, St0) -> + {Dst,St1} = new_ssa_var(Tl, St0), + Bits = U*Sz, + Bin = case member(big, Fs) of + true -> + <<Val:Bits>>; + false -> + true = member(little, Fs), %Assertion. + <<Val:Bits/little>> + end, + Bits = bit_size(Bin), %Assertion. + {TestIs,St} = make_cond_branch(succeeded, [Dst], Vf, St1), + Set = #b_set{op=bs_match,dst=Dst, + args=[#b_literal{val=string},Ctx,#b_literal{val=Bin}]}, + {[Set|TestIs],St}. + +build_bs_instr(Anno, Type, Fail, Ctx, Size, Unit0, Flags0, Dst, St0) -> + Unit = #b_literal{val=Unit0}, + Flags = #b_literal{val=Flags0}, + NeedSize = bs_need_size(Type), + TypeArg = #b_literal{val=Type}, + Get = case NeedSize of + true -> + #b_set{anno=Anno,op=bs_match,dst=Dst, + args=[TypeArg,Ctx,Flags,Size,Unit]}; + false -> + #b_set{anno=Anno,op=bs_match,dst=Dst, + args=[TypeArg,Ctx,Flags]} + end, + {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + {[Get|Is],St}. + +select_val(#k_val_clause{val=#k_tuple{es=Es},body=B}, V, Vf, St0) -> + #k{us=Used} = k_get_anno(B), + {Eis,St1} = select_extract_tuple(V, Es, Used, St0), + {Bis,St2} = match_cg(B, Vf, St1), + {length(Es),Eis ++ Bis,St2}; +select_val(#k_val_clause{val=Val0,body=B}, _V, Vf, 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,St1} = match_cg(B, Vf, St0), + {Val,Bis,St1}. + +%% select_extract_tuple(Src, [V], State) -> {[E],State}. +%% Extract tuple elements, but only if they are actually used. +%% +%% Not extracting tuple elements that are not used is an +%% optimization for compile time and memory use during compilation. +%% It is probably worthwhile because it is common to extract only a +%% few elements from a huge record. + +select_extract_tuple(Src, Vs, Used, St0) -> + Tuple = ssa_arg(Src, St0), + F = fun (#k_var{name=V}, {Elem,S0}) -> + case member(V, Used) of + true -> + Args = [Tuple,#b_literal{val=Elem}], + {Dst,S} = new_ssa_var(V, S0), + Get = #b_set{op=get_tuple_element,dst=Dst,args=Args}, + {[Get],{Elem+1,S}}; + false -> + {[],{Elem+1,S0}} + end + end, + {Es,{_,St}} = flatmapfoldl(F, {0,St0}, Vs), + {Es,St}. + +select_map(Scs, V, Tf, Vf, St0) -> + MapSrc = ssa_arg(V, St0), + {Is,St1} = + match_fmf(fun(#k_val_clause{val=#k_map{op=exact,es=Es}, + body=B}, Fail, St1) -> + select_map_val(V, Es, B, Fail, St1) + end, Vf, St0, Scs), + {TestIs,St} = make_cond_branch({bif,is_map}, [MapSrc], Tf, St1), + {TestIs++Is,St}. + +select_map_val(V, Es, B, Fail, St0) -> + {Eis,St1} = select_extract_map(Es, V, Fail, St0), + {Bis,St2} = match_cg(B, Fail, St1), + {Eis++Bis,St2}. + +select_extract_map([P|Ps], Src, Fail, St0) -> + MapSrc = ssa_arg(Src, St0), + #k_map_pair{key=Key0,val=#k_var{name=Dst0}} = P, + Key = ssa_arg(Key0, St0), + {Dst,St1} = new_ssa_var(Dst0, St0), + Set = #b_set{op=get_map_element,dst=Dst,args=[MapSrc,Key]}, + {TestIs,St2} = make_cond_branch(succeeded, [Dst], Fail, St1), + {Is,St} = select_extract_map(Ps, Src, Fail, St2), + {[Set|TestIs]++Is,St}; +select_extract_map([], _, _, St) -> + {[],St}. + +select_extract_cons(Src0, [#k_var{name=Hd},#k_var{name=Tl}], St0) -> + Src = ssa_arg(Src0, St0), + {HdDst,St1} = new_ssa_var(Hd, St0), + {TlDst,St2} = new_ssa_var(Tl, St1), + GetHd = #b_set{op=get_hd,dst=HdDst,args=[Src]}, + GetTl = #b_set{op=get_tl,dst=TlDst,args=[Src]}, + {[GetHd,GetTl],St2}. + +guard_clause_cg(#k_guard_clause{guard=G,body=B}, Fail, St0) -> + {Gis,St1} = guard_cg(G, Fail, St0), + {Bis,St} = match_cg(B, Fail, St1), + {Gis ++ Bis,St}. + +%% guard_cg(Guard, Fail, State) -> {[Ainstr],State}. +%% A guard is a boolean expression of tests. Tests return true or +%% false. A fault in a test causes the test to return false. Tests +%% never return the boolean, instead we generate jump code to go to +%% the correct exit point. Primops and tests all go to the next +%% instruction on success or jump to a failure label. + +guard_cg(#k_protected{arg=Ts,ret=Rs,inner=Inner}, Fail, St) -> + protected_cg(Ts, Rs, Inner, Fail, St); +guard_cg(#k_test{op=Test0,args=As,inverted=Inverted}, Fail, St0) -> + #k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Test}} = Test0, + test_cg(Test, Inverted, As, Fail, St0); +guard_cg(#k_seq{arg=Arg,body=Body}, Fail, St0) -> + {ArgIs,St1} = guard_cg(Arg, Fail, St0), + {BodyIs,St} = guard_cg(Body, Fail, St1), + {ArgIs++BodyIs,St}; +guard_cg(G, _Fail, St) -> + cg(G, St). + +test_cg('=/=', Inverted, As, Fail, St) -> + test_cg('=:=', not Inverted, As, Fail, St); +test_cg('/=', Inverted, As, Fail, St) -> + test_cg('==', not Inverted, As, Fail, St); +test_cg(Test, Inverted, As0, Fail, St0) -> + As = ssa_args(As0, St0), + case {Test,ssa_args(As0, St0)} of + {is_record,[Tuple,#b_literal{val=Atom}=Tag,#b_literal{val=Int}=Arity]} + when is_atom(Atom), is_integer(Int) -> + test_is_record_cg(Inverted, Fail, Tuple, Tag, Arity, St0); + {_,As} -> + {Bool,St1} = new_ssa_var('@ssa_bool', St0), + {Succ,St} = new_label(St1), + Bif = #b_set{op={bif,Test},dst=Bool,args=As}, + Br = case Inverted of + false -> #b_br{bool=Bool,succ=Succ,fail=Fail}; + true -> #b_br{bool=Bool,succ=Fail,fail=Succ} + end, + {[Bif,Br,{label,Succ}],St} + end. + +test_is_record_cg(false, Fail, Tuple, TagVal, ArityVal, St0) -> + {Arity,St1} = new_ssa_var('@ssa_arity', St0), + {Tag,St2} = new_ssa_var('@ssa_tag', St1), + {Is0,St3} = make_cond_branch({bif,is_tuple}, [Tuple], Fail, St2), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is1,St4} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], Fail, St3), + GetTag = #b_set{op=get_tuple_element,dst=Tag, + args=[Tuple,#b_literal{val=0}]}, + {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Fail, St4), + Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2, + {Is,St}; +test_is_record_cg(true, Fail, Tuple, TagVal, ArityVal, St0) -> + {Succ,St1} = new_label(St0), + {Arity,St2} = new_ssa_var('@ssa_arity', St1), + {Tag,St3} = new_ssa_var('@ssa_tag', St2), + {Is0,St4} = make_cond_branch({bif,is_tuple}, [Tuple], Succ, St3), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is1,St5} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], Succ, St4), + GetTag = #b_set{op=get_tuple_element,dst=Tag, + args=[Tuple,#b_literal{val=0}]}, + {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], Succ, St5), + Is3 = [make_uncond_branch(Fail),{label,Succ}], + Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, + {Is,St}. + +%% protected_cg([Kexpr], [Ret], Fail, St) -> {[Ainstr],St}. +%% Do a protected. Protecteds without return values are just done +%% for effect, the return value is not checked, success passes on to +%% the next instruction and failure jumps to Fail. If there are +%% return values then these must be set to 'false' on failure, +%% control always passes to the next instruction. + +protected_cg(Ts, [], _, Fail, St0) -> + %% Protect these calls, revert when done. + {Tis,St1} = guard_cg(Ts, Fail, St0#cg{bfail=Fail}), + {Tis,St1#cg{bfail=St0#cg.bfail}}; +protected_cg(Ts, Rs, Inner0, _Fail, St0) -> + {Pfail,St1} = new_label(St0), + {Br,St2} = new_label(St1), + Prot = duplicate(length(Rs), #b_literal{val=false}), + {Tis,St3} = guard_cg(Ts, Pfail, St2#cg{break=Pfail,bfail=Pfail}), + Inner = ssa_args(Inner0, St3), + {BreakVars,St} = new_ssa_vars(Rs, St3), + Is = Tis ++ [#cg_break{args=Inner,phi=Br}, + {label,Pfail},#cg_break{args=Prot,phi=Br}, + {label,Br},#cg_phi{vars=BreakVars}], + {Is,St#cg{break=St0#cg.break,bfail=St0#cg.bfail}}. + +%% match_fmf(Fun, LastFail, State, [Clause]) -> {Is,State}. +%% This is a special flatmapfoldl for match code gen where we +%% generate a "failure" label for each clause. The last clause uses +%% an externally generated failure label, LastFail. N.B. We do not +%% know or care how the failure labels are used. + +match_fmf(F, LastFail, St, [H]) -> + F(H, LastFail, St); +match_fmf(F, LastFail, St0, [H|T]) -> + {Fail,St1} = new_label(St0), + {R,St2} = F(H, Fail, St1), + {Rs,St3} = match_fmf(F, LastFail, St2, T), + {R ++ [{label,Fail}] ++ Rs,St3}. + +%% fail_label(State) -> {Where,FailureLabel}. +%% Where = guard | no_catch | in_catch +%% Return an indication of which part of a function code is +%% being generated for and the appropriate failure label to +%% use. +%% +%% Where has the following meaning: +%% +%% guard - Inside a guard. +%% no_catch - In a function body, not in the scope of +%% a try/catch or catch. +%% in_catch - In the scope of a try/catch or catch. + +fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> + if + Fail =/= Ult -> + {guard,Fail}; + Catch =:= none -> + {no_catch,Fail}; + is_integer(Catch) -> + {in_catch,Catch} + end. + +%% bif_fail_label(State) -> FailureLabel. +%% Return the appropriate failure label for a guard BIF call or +%% primop that fails. + +bif_fail_label(St) -> + {_,Fail} = fail_label(St), + Fail. + +%% call_cg(Func, [Arg], [Ret], Le, State) -> +%% {[Ainstr],State}. +%% enter_cg(Func, [Arg], Le, St) -> {[Ainstr],St}. +%% Generate code for call and enter. + +call_cg(Func, As, [], Le, St) -> + call_cg(Func, As, [#k_var{name='@ssa_ignored'}], Le, St); +call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> + case fail_label(St0) of + {guard,Fail} -> + %% Inside a guard. The only allowed function call is to + %% erlang:error/1,2. We will generate a branch to the + %% failure branch. + #k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=error}} = Func0, %Assertion. + [#k_var{name=DestVar}] = Rs, + St = set_ssa_var(DestVar, #b_literal{val=unused}, St0), + {[make_uncond_branch(Fail),#cg_unreachable{}],St}; + {Catch,Fail} -> + %% Ordinary function call in a function body. + Args = ssa_args(As, St0), + {Ret,St1} = new_ssa_var(R, St0), + Func = call_target(Func0, Args, St0), + Call = #b_set{anno=line_anno(Le),op=call,dst=Ret,args=[Func|Args]}, + + %% If this is a call to erlang:error(), MoreRs could be a + %% nonempty list of variables that each need a value. + St2 = foldl(fun(#k_var{name=Dummy}, S) -> + set_ssa_var(Dummy, #b_literal{val=unused}, S) + end, St1, MoreRs), + case Catch of + no_catch -> + {[Call],St2}; + in_catch -> + {TestIs,St} = make_cond_branch(succeeded, [Ret], Fail, St2), + {[Call|TestIs],St} + end + end. + +enter_cg(Func0, As0, Le, St0) -> + Anno = line_anno(Le), + Func = call_target(Func0, As0, St0), + As = ssa_args(As0, St0), + {Ret,St} = new_ssa_var('@ssa_ret', St0), + Call = #b_set{anno=Anno,op=call,dst=Ret,args=[Func|As]}, + {[Call,#b_ret{arg=Ret}],St}. + +call_target(Func, As, St) -> + Arity = length(As), + case Func of + #k_remote{mod=Mod0,name=Name0} -> + Mod = ssa_arg(Mod0, St), + Name = ssa_arg(Name0, St), + #b_remote{mod=Mod,name=Name,arity=Arity}; + #k_local{name=Name} when is_atom(Name) -> + #b_local{name=#b_literal{val=Name},arity=Arity}; + #k_var{}=Var -> + ssa_arg(Var, St) + end. + +%% bif_cg(#k_bif{}, Le,State) -> {[Ainstr],State}. +%% Generate code for a guard BIF or primop. + +bif_cg(#k_bif{op=#k_internal{name=Name},args=As,ret=Rs}, Le, St) -> + internal_cg(Name, As, Rs, Le, St); +bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}}, + args=As,ret=Rs}, Le, St) -> + bif_cg(Name, As, Rs, Le, St). + +%% internal_cg(Bif, [Arg], [Ret], Le, State) -> +%% {[Ainstr],State}. + +internal_cg(make_fun, [Name0,Arity0|As], Rs, _Le, St0) -> + #k_atom{val=Name} = Name0, + #k_int{val=Arity} = Arity0, + [#k_var{name=Dst0}] = Rs, + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Local = #b_local{name=#b_literal{val=Name},arity=Arity}, + MakeFun = #b_set{op=make_fun,dst=Dst,args=[Local|Args]}, + {[MakeFun],St}; +internal_cg(bs_init_writable=I, As, [#k_var{name=Dst0}], _Le, St0) -> + %% This behaves like a function call. + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Set = #b_set{op=I,dst=Dst,args=Args}, + {[Set],St}; +internal_cg(build_stacktrace=I, As, [#k_var{name=Dst0}], _Le, St0) -> + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Set = #b_set{op=I,dst=Dst,args=Args}, + {[Set],St}; +internal_cg(raise, As, [#k_var{name=Dst0}], _Le, St0) -> + Args = ssa_args(As, St0), + {Dst,St} = new_ssa_var(Dst0, St0), + Resume = #b_set{op=resume,dst=Dst,args=Args}, + case St of + #cg{catch_label=none} -> + {[Resume],St}; + #cg{catch_label=Catch} when is_integer(Catch) -> + Is = [Resume,make_uncond_branch(Catch),#cg_unreachable{}], + {Is,St} + end; +internal_cg(raw_raise=I, As, [#k_var{name=Dst0}], _Le, St0) -> + %% This behaves like a function call. + {Dst,St} = new_ssa_var(Dst0, St0), + Args = ssa_args(As, St), + Set = #b_set{op=I,dst=Dst,args=Args}, + {[Set],St}. + +bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) -> + {Dst,St1} = new_ssa_var(Dst0, St0), + case {Bif,ssa_args(As0, St0)} of + {is_record,[Tuple,#b_literal{val=Atom}=Tag, + #b_literal{val=Int}=Arity]} + when is_atom(Atom), is_integer(Int) -> + bif_is_record_cg(Dst, Tuple, Tag, Arity, St1); + {_,As} -> + I = #b_set{anno=line_anno(Le),op={bif,Bif},dst=Dst,args=As}, + case erl_bifs:is_safe(erlang, Bif, length(As)) of + false -> + Fail = bif_fail_label(St1), + {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {[I|Is],St}; + true-> + {[I],St1} + end + end. + +bif_is_record_cg(Dst, Tuple, TagVal, ArityVal, St0) -> + {Arity,St1} = new_ssa_var('@ssa_arity', St0), + {Tag,St2} = new_ssa_var('@ssa_tag', St1), + {Phi,St3} = new_label(St2), + {False,St4} = new_label(St3), + {Is0,St5} = make_cond_branch({bif,is_tuple}, [Tuple], False, St4), + GetArity = #b_set{op={bif,tuple_size},dst=Arity,args=[Tuple]}, + {Is1,St6} = make_cond_branch({bif,'=:='}, [Arity,ArityVal], False, St5), + GetTag = #b_set{op=get_tuple_element,dst=Tag, + args=[Tuple,#b_literal{val=0}]}, + {Is2,St} = make_cond_branch({bif,'=:='}, [Tag,TagVal], False, St6), + Is3 = [#cg_break{args=[#b_literal{val=true}],phi=Phi}, + {label,False}, + #cg_break{args=[#b_literal{val=false}],phi=Phi}, + {label,Phi}, + #cg_phi{vars=[Dst]}], + Is = Is0 ++ [GetArity] ++ Is1 ++ [GetTag] ++ Is2 ++ Is3, + {Is,St}. + +%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, +%% [Ret], Le, St) -> {[Ainstr],St}. + +recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, St0) -> + %% Get labels. + {Rl,St1} = new_label(St0), + {Tl,St2} = new_label(St1), + {Bl,St3} = new_label(St2), + St4 = St3#cg{break=Bl,recv=Rl}, + {Ris,St5} = cg_recv_mesg(Rvar, Rm, Tl, Le, St4), + {Wis,St6} = cg_recv_wait(Te, Tes, St5), + {BreakVars,St} = new_ssa_vars(Rs, St6), + {Ris ++ [{label,Tl}] ++ Wis ++ + [{label,Bl},#cg_phi{vars=BreakVars}], + St#cg{break=St0#cg.break,recv=St0#cg.recv}}. + +%% cg_recv_mesg( ) -> {[Ainstr],St}. + +cg_recv_mesg(#k_var{name=R}, Rm, Tl, Le, St0) -> + {Dst,St1} = new_ssa_var(R, St0), + {Mis,St2} = match_cg(Rm, none, St1), + RecvLbl = St1#cg.recv, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Tl, St2), + Is = [#b_br{anno=line_anno(Le),bool=#b_literal{val=true}, + succ=RecvLbl,fail=RecvLbl}, + {label,RecvLbl}, + #b_set{op=peek_message,dst=Dst}|TestIs], + {Is++Mis,St}. + +%% cg_recv_wait(Te, Tes, St) -> {[Ainstr],St}. + +cg_recv_wait(#k_int{val=0}, Es, St0) -> + {Tis,St} = cg(Es, St0), + {[#b_set{op=timeout}|Tis],St}; +cg_recv_wait(Te, Es, St0) -> + {Tis,St1} = cg(Es, St0), + Args = [ssa_arg(Te, St1)], + {WaitDst,St2} = new_ssa_var('@ssa_wait', St1), + {WaitIs,St} = make_cond_branch(succeeded, [WaitDst], St1#cg.recv, St2), + %% Infinite timeout will be optimized later. + Is = [#b_set{op=wait_timeout,dst=WaitDst,args=Args}] ++ WaitIs ++ + [#b_set{op=timeout}] ++ Tis, + {Is,St}. + +%% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret], St) -> +%% {[Ainstr],St}. + +try_cg(Ta, Vs, Tb, Evs, Th, Rs, St0) -> + {B,St1} = new_label(St0), %Body label + {H,St2} = new_label(St1), %Handler label + {E,St3} = new_label(St2), %End label + {Next,St4} = new_label(St3), + {TryTag,St5} = new_ssa_var('@ssa_catch_tag', St4), + {SsaVs,St6} = new_ssa_vars(Vs, St5), + {SsaEvs,St7} = new_ssa_vars(Evs, St6), + {Ais,St8} = cg(Ta, St7#cg{break=B,catch_label=H}), + St9 = St8#cg{break=E,catch_label=St7#cg.catch_label}, + {Bis,St10} = cg(Tb, St9), + {His,St11} = cg(Th, St10), + {BreakVars,St12} = new_ssa_vars(Rs, St11), + {CatchedAgg,St} = new_ssa_var('@ssa_agg', St12), + ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), + KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, + Args = [#b_literal{val='try'},TryTag], + Handler = [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ + ExtractVs ++ [KillTryTag], + {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, + #b_br{bool=TryTag,succ=Next,fail=H}, + {label,Next}] ++ Ais ++ + [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ + Handler ++ His ++ + [{label,E},#cg_phi{vars=BreakVars}], + St#cg{break=St0#cg.break}}. + +try_enter_cg(Ta, Vs, Tb, Evs, Th, St0) -> + {B,St1} = new_label(St0), %Body label + {H,St2} = new_label(St1), %Handler label + {Next,St3} = new_label(St2), + {TryTag,St4} = new_ssa_var('@ssa_catch_tag', St3), + {SsaVs,St5} = new_ssa_vars(Vs, St4), + {SsaEvs,St6} = new_ssa_vars(Evs, St5), + {Ais,St7} = cg(Ta, St6#cg{break=B,catch_label=H}), + St8 = St7#cg{catch_label=St6#cg.catch_label}, + {Bis,St9} = cg(Tb, St8), + {His,St10} = cg(Th, St9), + {CatchedAgg,St} = new_ssa_var('@ssa_agg', St10), + ExtractVs = extract_vars(SsaEvs, CatchedAgg, 0), + KillTryTag = #b_set{op=kill_try_tag,args=[TryTag]}, + Args = [#b_literal{val='try'},TryTag], + Handler = [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}] ++ + ExtractVs ++ [KillTryTag], + {[#b_set{op=new_try_tag,dst=TryTag,args=[#b_literal{val='try'}]}, + #b_br{bool=TryTag,succ=Next,fail=H}, + {label,Next}] ++ Ais ++ + [{label,B},#cg_phi{vars=SsaVs},KillTryTag] ++ Bis ++ + Handler ++ His, + St#cg{break=St0#cg.break}}. + +extract_vars([V|Vs], Agg, N) -> + I = #b_set{op=extract,dst=V,args=[Agg,#b_literal{val=N}]}, + [I|extract_vars(Vs, Agg, N+1)]; +extract_vars([], _, _) -> []. + +%% do_catch_cg(CatchBlock, Ret, St) -> {[Ainstr],St}. + +do_catch_cg(Block, #k_var{name=R}, St0) -> + {B,St1} = new_label(St0), + {Next,St2} = new_label(St1), + {H,St3} = new_label(St2), + {CatchReg,St4} = new_ssa_var('@ssa_catch_tag', St3), + {Dst,St5} = new_ssa_var(R, St4), + {Succ,St6} = new_label(St5), + {Cis,St7} = cg(Block, St6#cg{break=Succ,catch_label=H}), + {CatchedVal,St8} = new_ssa_var('@catched_val', St7), + {SuccVal,St9} = new_ssa_var('@success_val', St8), + {CatchedAgg,St10} = new_ssa_var('@ssa_agg', St9), + {CatchEndVal,St} = new_ssa_var('@catch_end_val', St10), + Args = [#b_literal{val='catch'},CatchReg], + {[#b_set{op=new_try_tag,dst=CatchReg,args=[#b_literal{val='catch'}]}, + #b_br{bool=CatchReg,succ=Next,fail=H}, + {label,Next}] ++ Cis ++ + [{label,H}, + #b_set{op=landingpad,dst=CatchedAgg,args=Args}, + #b_set{op=extract,dst=CatchedVal, + args=[CatchedAgg,#b_literal{val=0}]}, + #cg_break{args=[CatchedVal],phi=B}, + {label,Succ}, + #cg_phi{vars=[SuccVal]}, + #cg_break{args=[SuccVal],phi=B}, + {label,B},#cg_phi{vars=[CatchEndVal]}, + #b_set{op=catch_end,dst=Dst,args=[CatchReg,CatchEndVal]}], + St#cg{break=St1#cg.break,catch_label=St1#cg.catch_label}}. + +%% put_cg([Var], Constr, Le, Vdb, Bef, St) -> {[Ainstr],St}. +%% Generate code for constructing terms. + +put_cg([#k_var{name=R}], #k_cons{hd=Hd,tl=Tl}, _Le, St0) -> + Args = ssa_args([Hd,Tl], St0), + {Dst,St} = new_ssa_var(R, St0), + PutList = #b_set{op=put_list,dst=Dst,args=Args}, + {[PutList],St}; +put_cg([#k_var{name=R}], #k_tuple{es=Es}, _Le, St0) -> + {Ret,St} = new_ssa_var(R, St0), + Args = ssa_args(Es, St), + PutTuple = #b_set{op=put_tuple,dst=Ret,args=Args}, + {[PutTuple],St}; +put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, St0) -> + Fail = bif_fail_label(St0), + {Dst,St1} = new_ssa_var(R, St0), + cg_binary(Dst, Segs, Fail, Le, St1); +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, + es=[#k_map_pair{key=#k_var{}=K,val=V}]}, + Le, St0) -> + %% Map: single variable key. + SrcMap = ssa_arg(Map, St0), + LineAnno = line_anno(Le), + List = [ssa_arg(K, St0),ssa_arg(V, St0)], + {Dst,St1} = new_ssa_var(R, St0), + {Is,St} = put_cg_map(LineAnno, Op, SrcMap, Dst, List, St1), + {Is,St}; +put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, St0) -> + %% Map: one or more literal keys. + [] = [Var || #k_map_pair{key=#k_var{}=Var} <- Es], %Assertion + SrcMap = ssa_arg(Map, St0), + LineAnno = line_anno(Le), + List = flatmap(fun(#k_map_pair{key=K,val=V}) -> + [ssa_arg(K, St0),ssa_arg(V, St0)] + end, Es), + {Dst,St1} = new_ssa_var(R, St0), + {Is,St} = put_cg_map(LineAnno, Op, SrcMap, Dst, List, St1), + {Is,St}; +put_cg([#k_var{name=R}], Con0, _Le, St0) -> + %% Create an alias for a variable or literal. + Con = ssa_arg(Con0, St0), + St = set_ssa_var(R, Con, St0), + {[],St}. + +put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> + Fail = bif_fail_label(St0), + Args = [#b_literal{val=Op},SrcMap|List], + PutMap = #b_set{anno=LineAnno,op=put_map,dst=Dst,args=Args}, + if + Op =:= assoc -> + {[PutMap],St0}; + true -> + {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + {[PutMap|Is],St} + end. + +%%% +%%% Code generation for constructing binaries. +%%% + +cg_binary(Dst, Segs0, Fail, Le, St0) -> + {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, Fail, St0), + LineAnno = line_anno(Le), + Anno = Le#k.a, + case PutCode0 of + [#b_set{op=bs_put,dst=Bool,args=[_,_,Src,#b_literal{val=all}|_]}, + #b_br{bool=Bool}, + {label,_}|_] -> + #k_bin_seg{unit=Unit0,next=Segs} = Segs0, + Unit = #b_literal{val=Unit0}, + {PutCode,SzCalc1,St2} = cg_bin_put(Segs, Fail, St1), + {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, Fail, St2), + SzCode = cg_bin_anno(SzCode0, LineAnno), + Args = case member(single_use, Anno) of + true -> + [#b_literal{val=private_append},Src,SzVar,Unit]; + false -> + [#b_literal{val=append},Src,SzVar,Unit] + end, + BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St3), + {SzCode ++ [BsInit] ++ TestIs ++ PutCode,St}; + [#b_set{op=bs_put}|_] -> + {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, Fail, St1), + SzCode = cg_bin_anno(SzCode0, LineAnno), + Args = [#b_literal{val=new},SzVar,Unit], + BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St2), + {SzCode ++ [BsInit] ++ TestIs ++ PutCode0,St} + end. + +cg_bin_anno([Set|Sets], Anno) -> + [Set#b_set{anno=Anno}|Sets]; +cg_bin_anno([], _) -> []. + +%% cg_size_calc(PreferredUnit, SzCalc, Fail, St0) -> +%% {ActualUnit,SizeVariable,SizeCode,St}. +%% Generate size calculation code. + +cg_size_calc(Unit, error, _Fail, St) -> + {#b_literal{val=Unit},#b_literal{val=badarg},[],St}; +cg_size_calc(8, [{1,_}|_]=SzCalc, Fail, St) -> + cg_size_calc(1, SzCalc, Fail, St); +cg_size_calc(8, SzCalc, Fail, St0) -> + {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), + {#b_literal{val=8},Var,Pre,St}; +cg_size_calc(1, SzCalc0, Fail, St0) -> + SzCalc = map(fun({8,#b_literal{val=Size}}) -> + {1,#b_literal{val=8*Size}}; + ({8,{{bif,byte_size},Src}}) -> + {1,{{bif,bit_size},Src}}; + ({8,{_,_}=UtfCalc}) -> + {1,{'*',#b_literal{val=8},UtfCalc}}; + ({_,_}=Pair) -> + Pair + end, SzCalc0), + {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), + {#b_literal{val=1},Var,Pre,St}. + +cg_size_calc_1(SzCalc, Fail, St0) -> + cg_size_calc_2(SzCalc, #b_literal{val=0}, Fail, St0). + +cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, Fail, St2), + {Sum,Pre0++Pre1++Pre2,St}; +cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), + {Sum,Pre0++Pre,St}; +cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), + {Sum,Pre0++Pre,St}; +cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, Fail, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, Fail, St2), + {Sum,Pre0++Pre1++Pre2,St}; +cg_size_calc_2([], Sum, _Fail, St) -> + {Sum,[],St}. + +cg_size_bif(#b_var{}=Var, _Fail, St) -> + {Var,[],St}; +cg_size_bif({Name,Src}, Fail, St0) -> + {Dst,St1} = new_ssa_var('@ssa_bif', St0), + Bif = #b_set{op=Name,dst=Dst,args=[Src]}, + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {Dst,[Bif|TestIs],St}. + +cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _Fail, St) -> + {Val,[],St}; +cg_size_add(A, B, Unit, Fail, St0) -> + {Dst,St1} = new_ssa_var('@ssa_sum', St0), + {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + BsAdd = #b_set{op=bs_add,dst=Dst,args=[A,B,Unit]}, + {Dst,[BsAdd|TestIs],St}. + +cg_bin_put(Seg, Fail, St) -> + cg_bin_put_1(Seg, Fail, [], [], St). + +cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, + Fail, Acc, SzCalcAcc, St0) -> + [Src,Size] = ssa_args([Src0,Size0], St0), + NeedSize = bs_need_size(T), + TypeArg = #b_literal{val=T}, + Flags = #b_literal{val=Fs}, + Unit = #b_literal{val=U}, + Args = case NeedSize of + true -> [TypeArg,Flags,Src,Size,Unit]; + false -> [TypeArg,Flags,Src] + end, + {Is,St} = make_cond_branch(bs_put, Args, Fail, St0), + SzCalc = bin_size_calc(T, Src, Size, U), + cg_bin_put_1(Next, Fail, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); +cg_bin_put_1(#k_bin_end{}, _, Acc, SzCalcAcc, St) -> + SzCalc = fold_size_calc(SzCalcAcc, 0, []), + {reverse(Acc),SzCalc,St}. + +bs_need_size(utf8) -> false; +bs_need_size(utf16) -> false; +bs_need_size(utf32) -> false; +bs_need_size(_) -> true. + +bin_size_calc(utf8, Src, _Size, _Unit) -> + {8,{bs_utf8_size,Src}}; +bin_size_calc(utf16, Src, _Size, _Unit) -> + {8,{bs_utf16_size,Src}}; +bin_size_calc(utf32, _Src, _Size, _Unit) -> + {8,#b_literal{val=4}}; +bin_size_calc(binary, Src, #b_literal{val=all}, Unit) -> + case Unit rem 8 of + 0 -> {8,{{bif,byte_size},Src}}; + _ -> {1,{{bif,bit_size},Src}} + end; +bin_size_calc(_Type, _Src, Size, Unit) -> + {Unit,Size}. + +fold_size_calc([{Unit,#b_literal{val=Size}}|T], Bits, Acc) -> + if + is_integer(Size) -> + fold_size_calc(T, Bits + Unit*Size, Acc); + true -> + error + end; +fold_size_calc([{U,#b_var{}}=H|T], Bits, Acc) when U =:= 1; U =:= 8 -> + fold_size_calc(T, Bits, [H|Acc]); +fold_size_calc([{U,#b_var{}=Var}|T], Bits, Acc) -> + fold_size_calc(T, Bits, [{1,{'*',#b_literal{val=U},Var}}|Acc]); +fold_size_calc([{_,_}=H|T], Bits, Acc) -> + fold_size_calc(T, Bits, [H|Acc]); +fold_size_calc([], Bits, Acc) -> + Bytes = Bits div 8, + RemBits = Bits rem 8, + Sizes = sort([{1,#b_literal{val=RemBits}},{8,#b_literal{val=Bytes}}|Acc]), + [Pair || {_,Sz}=Pair <- Sizes, Sz =/= #b_literal{val=0}]. + +%%% +%%% Utilities for creating the SSA types. +%%% + +ssa_args(As, St) -> + [ssa_arg(A, St) || A <- As]. + +ssa_arg(#k_var{name=V}, #cg{vars=Vars}) -> maps:get(V, Vars); +ssa_arg(#k_literal{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_atom{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_float{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_int{val=V}, _) -> #b_literal{val=V}; +ssa_arg(#k_nil{}, _) -> #b_literal{val=[]}. + +new_ssa_vars(Vs, St) -> + mapfoldl(fun(#k_var{name=V}, S) -> + new_ssa_var(V, S) + end, St, Vs). + +new_ssa_var(VarBase, #cg{lcount=Uniq,vars=Vars}=St0) + when is_atom(VarBase); is_integer(VarBase) -> + case Vars of + #{VarBase:=_} -> + Var = #b_var{name={VarBase,Uniq}}, + St = St0#cg{lcount=Uniq+1,vars=Vars#{VarBase=>Var}}, + {Var,St}; + #{} -> + Var = #b_var{name=VarBase}, + St = St0#cg{vars=Vars#{VarBase=>Var}}, + {Var,St} + end. + +set_ssa_var(VarBase, Val, #cg{vars=Vars}=St) + when is_atom(VarBase); is_integer(VarBase) -> + St#cg{vars=Vars#{VarBase=>Val}}. + +%% new_label(St) -> {L,St}. + +new_label(#cg{lcount=Next}=St) -> + {Next,St#cg{lcount=Next+1}}. + +%% line_anno(Le) -> #{} | #{location:={File,Line}}. +%% Create a location annotation, containing information about the +%% current filename and line number. The annotation should be +%% included in any operation that could cause an exception. + +line_anno(#k{a=Anno}) -> + line_anno_1(Anno). + +line_anno_1([Line,{file,Name}]) when is_integer(Line) -> + line_anno_2(Name, Line); +line_anno_1([_|_]=A) -> + {Name,Line} = find_loc(A, no_file, 0), + line_anno_2(Name, Line); +line_anno_1([]) -> + #{}. + +line_anno_2(no_file, _) -> + #{}; +line_anno_2(_, 0) -> + %% Missing line number or line number 0. + #{}; +line_anno_2(Name, Line) -> + #{location=>{Name,Line}}. + +find_loc([Line|T], File, _) when is_integer(Line) -> + find_loc(T, File, Line); +find_loc([{file,File}|T], _, Line) -> + find_loc(T, File, Line); +find_loc([_|T], File, Line) -> + find_loc(T, File, Line); +find_loc([], File, Line) -> {File,Line}. + +flatmapfoldl(F, Accu0, [Hd|Tail]) -> + {R,Accu1} = F(Hd, Accu0), + {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), + {R++Rs,Accu2}; +flatmapfoldl(_, Accu, []) -> {[],Accu}. + +%%% +%%% Finalize the code. +%%% + +finalize(Asm0, St0) -> + Asm1 = fix_phis(Asm0), + {Asm,St} = fix_sets(Asm1, [], St0), + {build_map(Asm),St}. + +fix_phis(Is) -> + fix_phis_1(Is, none, #{}). + +fix_phis_1([{label,L},#cg_phi{vars=[]}=Phi|Is0], _Lbl, Map0) -> + case maps:is_key(L, Map0) of + false -> + %% No #cg_break{} references this label. Nothing else can + %% reference it, so it can be safely be removed. + {Is,Map} = drop_upto_label(Is0, Map0), + fix_phis_1(Is, none, Map); + true -> + %% There is a break referencing this label; probably caused + %% by a try/catch whose return value is ignored. + [{label,L}|fix_phis_1([Phi|Is0], L, Map0)] + end; +fix_phis_1([{label,L}=I|Is], _Lbl, Map) -> + [I|fix_phis_1(Is, L, Map)]; +fix_phis_1([#cg_unreachable{}|Is0], _Lbl, Map0) -> + {Is,Map} = drop_upto_label(Is0, Map0), + fix_phis_1(Is, none, Map); +fix_phis_1([#cg_break{args=Args,phi=Target}|Is], Lbl, Map) when is_integer(Lbl) -> + Pairs1 = case Map of + #{Target:=Pairs0} -> Pairs0; + #{} -> [] + end, + Pairs = [[{Arg,Lbl} || Arg <- Args]|Pairs1], + I = make_uncond_branch(Target), + [I|fix_phis_1(Is, none, Map#{Target=>Pairs})]; +fix_phis_1([#cg_phi{vars=Vars}|Is0], Lbl, Map0) -> + Pairs = maps:get(Lbl, Map0), + Map1 = maps:remove(Lbl, Map0), + case gen_phis(Vars, Pairs) of + [#b_set{op=phi,args=[]}] -> + {Is,Map} = drop_upto_label(Is0, Map1), + Ret = #b_ret{arg=#b_literal{val=unreachable}}, + [Ret|fix_phis_1(Is, none, Map)]; + Phis -> + Phis ++ fix_phis_1(Is0, Lbl, Map1) + end; +fix_phis_1([I|Is], Lbl, Map) -> + [I|fix_phis_1(Is, Lbl, Map)]; +fix_phis_1([], _, Map) -> + [] = maps:to_list(Map), %Assertion. + []. + +gen_phis([V|Vs], Preds0) -> + {Pairs,Preds} = collect_preds(Preds0, [], []), + [#b_set{op=phi,dst=V,args=Pairs}|gen_phis(Vs, Preds)]; +gen_phis([], _) -> []. + +collect_preds([[First|Rest]|T], ColAcc, RestAcc) -> + collect_preds(T, [First|ColAcc], [Rest|RestAcc]); +collect_preds([], ColAcc, RestAcc) -> + {keysort(2, ColAcc),RestAcc}. + +fix_sets([#b_set{dst=none}=Set|Is], Acc, St0) -> + {Dst,St} = new_ssa_var('@ssa_ignored', St0), + I = Set#b_set{dst=Dst}, + fix_sets(Is, [I|Acc], St); +fix_sets([I|Is], Acc, St) -> + fix_sets(Is, [I|Acc], St); +fix_sets([], Acc, St) -> + {reverse(Acc),St}. + +build_map(Is) -> + Blocks = build_graph_1(Is, [], []), + maps:from_list(Blocks). + +build_graph_1([{label,L}|Is], Lbls, []) -> + build_graph_1(Is, [L|Lbls], []); +build_graph_1([{label,L}|Is], Lbls, [_|_]=BlockAcc) -> + make_blocks(Lbls, BlockAcc) ++ build_graph_1(Is, [L], []); +build_graph_1([I|Is], Lbls, BlockAcc) -> + build_graph_1(Is, Lbls, [I|BlockAcc]); +build_graph_1([], Lbls, BlockAcc) -> + make_blocks(Lbls, BlockAcc). + +make_blocks(Lbls, [Last|Is0]) -> + Is = reverse(Is0), + Block = #b_blk{is=Is,last=Last}, + [{L,Block} || L <- Lbls]. + +drop_upto_label([{label,_}|_]=Is, Map) -> + {Is,Map}; +drop_upto_label([#cg_break{phi=Target}|Is], Map) -> + Pairs = case Map of + #{Target:=Pairs0} -> Pairs0; + #{} -> [] + end, + drop_upto_label(Is, Map#{Target=>Pairs}); +drop_upto_label([_|Is], Map) -> + drop_upto_label(Is, Map). + +k_get_anno(Thing) -> element(2, Thing). diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 518b958794..6121593b11 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -23,6 +23,7 @@ -include("core_parse.hrl"). -include("v3_kernel.hrl"). +-include("beam_ssa.hrl"). -include("beam_disasm.hrl"). -import(lists, [foreach/2]). @@ -41,6 +42,12 @@ 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, #b_module{name=Mod,exports=Exp,attributes=Attr,body=Fs}) -> + io:format(File, "module ~p.\n", [Mod]), + io:format(File, "exports ~p.\n", [Exp]), + io:format(File, "attributes ~p.\n\n", [Attr]), + PP = [beam_ssa_pp:format_function(F) || F <- Fs], + io:put_chars(File, lists:join($\n, PP)); module(Stream, {Mod,Exp,Attr,Code,NumLabels}) -> %% This is output from v3_codegen. io:format(Stream, "{module, ~p}. %% version = ~w\n", @@ -59,7 +66,7 @@ module(Stream, [_|_]=Fs) -> foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). format_asm([{label,L}|Is]) -> - [" {label,",integer_to_list(L),"}.\n"|format_asm(Is)]; + [io_lib:format(" {label,~p}.\n", [L])|format_asm(Is)]; format_asm([I|Is]) -> [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)]; format_asm([]) -> []. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 2b8dd40e29..5730e9704e 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -94,38 +94,43 @@ 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], SeenTests0, Acc0) -> +peep([{select,select_val,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([I|Is], gb_sets:empty(), Acc0); - [{atom,_}=Value,Lbl] when Op =:= select_val -> - %% Single value left. Convert to regular test and pop redundant tests. + [{atom,_}=Value,Lbl] -> + %% Single value left. Convert to regular test. 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. + peep(Is1, SeenTests0, Acc0); + [{integer,_}=Value,Lbl] -> + %% Single value left. Convert to regular test. 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); + [{atom,B1},Lbl,{atom,B2},Lbl] when B1 =:= not B2 -> + %% Replace with is_boolean test. + Is1 = [{test,is_boolean,F,[R]},{jump,Lbl}|Is], peep(Is1, SeenTests0, Acc0); [_|_]=Vls -> - I = {select,Op,R,F,Vls}, + I = {select,select_val,R,F,Vls}, peep(Is, gb_sets:empty(), [I|Acc0]) end; +peep([{get_map_elements,Fail,Src,List}=I|Is], _SeenTests, Acc0) -> + SeenTests = gb_sets:empty(), + case simplify_get_map_elements(Fail, Src, List, Acc0) of + {ok,Acc} -> + peep(Is, SeenTests, Acc); + error -> + peep(Is, SeenTests, [I|Acc0]) + end; +peep([{test,has_map_fields,Fail,Ops}=I|Is], SeenTests, Acc0) -> + case simplify_has_map_fields(Fail, Ops, Acc0) of + {ok,Acc} -> + peep(Is, SeenTests, Acc); + error -> + peep(Is, SeenTests, [I|Acc0]) + end; peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> case beam_utils:is_pure_test(I) of false -> @@ -176,3 +181,39 @@ prune_redundant_values([_Val,F|Vls], F) -> prune_redundant_values([Val,Lbl|Vls], F) -> [Val,Lbl|prune_redundant_values(Vls, F)]; prune_redundant_values([], _) -> []. + +simplify_get_map_elements(Fail, Src, {list,[Key,Dst]}, + [{get_map_elements,Fail,Src,{list,List1}}|Acc]) -> + case are_keys_literals([Key]) andalso are_keys_literals(List1) of + true -> + case member(Key, List1) of + true -> + %% The key is already in the other list. That is + %% very unusual, because there are optimizations to get + %% rid of duplicate keys. Therefore, don't try to + %% do anything smart here; just keep the + %% get_map_elements instructions separate. + error; + false -> + List = [Key,Dst|List1], + {ok,[{get_map_elements,Fail,Src,{list,List}}|Acc]} + end; + false -> + error + end; +simplify_get_map_elements(_, _, _, _) -> error. + +simplify_has_map_fields(Fail, [Src|Keys0], + [{test,has_map_fields,Fail,[Src|Keys1]}|Acc]) -> + case are_keys_literals(Keys0) andalso are_keys_literals(Keys1) of + true -> + Keys = Keys0 ++ Keys1, + {ok,[{test,has_map_fields,Fail,[Src|Keys]}|Acc]}; + false -> + error + end; +simplify_has_map_fields(_, _, _) -> error. + +are_keys_literals([{x,_}|_]) -> false; +are_keys_literals([{y,_}|_]) -> false; +are_keys_literals([_|_]) -> true. diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl deleted file mode 100644 index ddbe67605a..0000000000 --- a/lib/compiler/src/beam_receive.erl +++ /dev/null @@ -1,416 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% 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. -%% 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_receive). --export([module/2]). --import(lists, [foldl/3,reverse/1,reverse/2]). - -%%% -%%% In code such as: -%%% -%%% Ref = make_ref(), %Or erlang:monitor(process, Pid) -%%% . -%%% . -%%% . -%%% receive -%%% {Ref,Reply} -> Reply -%%% end. -%%% -%%% we know that none of the messages that exist in the message queue -%%% before the call to make_ref/0 can be matched out in the receive -%%% statement. Therefore we can avoid going through the entire message -%%% queue if we introduce two new instructions (here written as -%%% BIFs in pseudo-Erlang): -%%% -%%% recv_mark(SomeUniqInteger), -%%% Ref = make_ref(), -%%% . -%%% . -%%% . -%%% recv_set(SomeUniqInteger), -%%% receive -%%% {Ref,Reply} -> Reply -%%% end. -%%% -%%% The recv_mark/1 instruction will save the current position and -%%% SomeUniqInteger in the process context. The recv_set -%%% instruction will verify that SomeUniqInteger is still stored -%%% in the process context. If it is, it will set the current pointer -%%% for the message queue (the next message to be read out) to the -%%% position that was saved by recv_mark/1. -%%% -%%% The remove_message instruction must be modified to invalidate -%%% the information stored by the previous recv_mark/1, in case there -%%% is another receive executed between the calls to recv_mark/1 and -%%% recv_set/1. -%%% -%%% We use a reference to a label (i.e. a position in the loaded code) -%%% as the SomeUniqInteger. -%%% - --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}, - {ok,Code}. - -%%% -%%% Local functions. -%%% - -function({function,Name,Arity,Entry,Is}) -> - try - D = beam_utils:index_labels(Is), - {function,Name,Arity,Entry,opt(Is, D, [])} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -opt([{call_ext,A,{extfunc,erlang,spawn_monitor,A}}=I0|Is0], D, Acc) - when A =:= 1; A =:= 3 -> - case ref_in_tuple(Is0) of - no -> - opt(Is0, D, [I0|Acc]); - {yes,Regs,Is1,MatchReversed} -> - %% The call creates a brand new reference. Now - %% search for a receive statement in the same - %% function that will match against the reference. - case opt_recv(Is1, Regs, D) of - no -> - opt(Is0, D, [I0|Acc]); - {yes,Is,Lbl} -> - opt(Is, D, MatchReversed++[I0,{recv_mark,{f,Lbl}}|Acc]) - end - end; -opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) -> - case creates_new_ref(Name, Arity) of - true -> - %% The call creates a brand new reference. Now - %% search for a receive statement in the same - %% function that will match against the reference. - case opt_recv(Is0, regs_init_x0(), D) of - no -> - opt(Is0, D, [I|Acc]); - {yes,Is,Lbl} -> - opt(Is, D, [I,{recv_mark,{f,Lbl}}|Acc]) - end; - false -> - opt(Is0, D, [I|Acc]) - end; -opt([I|Is], D, Acc) -> - opt(Is, D, [I|Acc]); -opt([], _, Acc) -> - reverse(Acc). - -ref_in_tuple([{test,is_tuple,_,[{x,0}]}=I1, - {test,test_arity,_,[{x,0},2]}=I2, - {block,[{set,[_],[{x,0}],{get_tuple_element,0}}, - {set,[Dst],[{x,0}],{get_tuple_element,1}}|Bl]}=I3|Is]) -> - ref_in_tuple_1(Bl, Dst, Is, [I3,I2,I1]); -ref_in_tuple([{test,is_tuple,_,[{x,0}]}=I1, - {test,test_arity,_,[{x,0},2]}=I2, - {block,[{set,[Dst],[{x,0}],{get_tuple_element,1}}|Bl]}=I3|Is]) -> - ref_in_tuple_1(Bl, Dst, Is, [I3,I2,I1]); -ref_in_tuple(_) -> no. - -ref_in_tuple_1(Bl, Dst, Is, MatchReversed) -> - Regs0 = regs_init_singleton(Dst), - Regs = opt_update_regs_bl(Bl, Regs0), - {yes,Regs,Is,MatchReversed}. - -%% creates_new_ref(Name, Arity) -> true|false. -%% Return 'true' if the BIF Name/Arity will create a new reference. -creates_new_ref(monitor, 2) -> true; -creates_new_ref(make_ref, 0) -> true; -creates_new_ref(_, _) -> false. - -%% opt_recv([Instruction], Regs, LabelIndex) -> no|{yes,[Instruction]} -%% Search for a receive statement that will only retrieve messages -%% that contain the newly created reference (which is currently in {x,0}). -opt_recv(Is, Regs, D) -> - L = gb_sets:empty(), - opt_recv(Is, D, Regs, L, []). - -opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) -> - R = regs_kill_not_live(0, R0), - case regs_empty(R) of - false -> - %% We now have the new reference in Y registers - %% and the current instruction is the beginning of a - %% receive statement. We must now verify that only messages - %% that contain the reference will be matched. - case opt_ref_used(Is, R, Fail, D) of - false -> - no; - true -> - RecvSet = {recv_set,{f,L}}, - {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L} - end; - true -> - no - end; -opt_recv([I|Is], D, R0, L0, Acc) -> - {R,L} = opt_update_regs(I, R0, L0), - case regs_empty(R) of - true -> - %% The reference is no longer alive. There is no - %% point in continuing the search. - no; - false -> - opt_recv(Is, D, R, L, [I|Acc]) - end; -opt_recv([], _, _, _, _) -> no. - -opt_update_regs({block,Bl}, R, L) -> - {opt_update_regs_bl(Bl, R),L}; -opt_update_regs({call,_,_}, R, L) -> - {regs_kill_not_live(0, R),L}; -opt_update_regs({call_ext,_,_}, R, L) -> - {regs_kill_not_live(0, R),L}; -opt_update_regs({call_fun,_}, R, L) -> - {regs_kill_not_live(0, R),L}; -opt_update_regs({kill,Y}, R, L) -> - {regs_kill([Y], R),L}; -opt_update_regs({'catch',_,{f,Lbl}}, R, L) -> - {R,gb_sets:add(Lbl, L)}; -opt_update_regs({catch_end,_}, R, L) -> - {R,L}; -opt_update_regs({label,Lbl}, R, L) -> - case gb_sets:is_member(Lbl, L) of - false -> - %% We can't allow arbitrary labels (since the receive - %% could be entered without first creating the reference). - {regs_init(),L}; - true -> - %% A catch label for a previously seen catch instruction is OK. - {R,L} - end; -opt_update_regs({'try',_,{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) -> - {R,L}; -opt_update_regs(_I, _R, L) -> - %% Unrecognized instruction. Abort the search. - {regs_init(),L}. - -opt_update_regs_bl([{set,Ds,_,{alloc,Live,_}}|Is], Regs0) -> - Regs1 = regs_kill_not_live(Live, Regs0), - Regs = regs_kill(Ds, Regs1), - opt_update_regs_bl(Is, Regs); -opt_update_regs_bl([{set,[Dst]=Ds,[Src],move}|Is], Regs0) -> - Regs1 = regs_kill(Ds, Regs0), - Regs = case regs_is_member(Src, Regs1) of - false -> Regs1; - true -> regs_add(Dst, Regs1) - end, - opt_update_regs_bl(Is, Regs); -opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) -> - Regs = regs_kill(Ds, Regs0), - opt_update_regs_bl(Is, Regs); -opt_update_regs_bl([], Regs) -> Regs. - -%% opt_ref_used([Instruction], RefRegs, FailLabel, LabelIndex) -> true|false -%% Return 'true' if it is certain that only messages that contain the same -%% reference as in RefRegs can be matched out. Otherwise return 'false'. -%% -%% Basically, we follow all possible paths through the receive statement. -%% If all paths are safe, we return 'true'. -%% -%% A branch to FailLabel is safe, because it exits the receive statement -%% and no further message may be matched out. -%% -%% If a path hits an comparision between RefRegs and part of the message, -%% that path is safe (any messages that may be matched further down the -%% path is guaranteed to contain the reference). -%% -%% Otherwise, if we hit a 'remove_message' instruction, we give up -%% and return 'false' (the optimization is definitely unsafe). If -%% we hit an unrecognized instruction, we also give up and return -%% 'false' (the optimization may be unsafe). - -opt_ref_used(Is, RefRegs, Fail, D) -> - Done = gb_sets:singleton(Fail), - Regs = regs_init_x0(), - try - _ = opt_ref_used_1(Is, RefRegs, D, Done, Regs), - true - catch - throw:not_used -> - false - end. - -%% This functions only returns if all paths through the receive -%% statement are safe, and throws an 'not_used' term otherwise. -opt_ref_used_1([{block,Bl}|Is], RefRegs, D, Done, Regs0) -> - Regs = opt_ref_used_bl(Bl, Regs0), - opt_ref_used_1(Is, RefRegs, D, Done, Regs); -opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], - RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_at(Fail, RefRegs, D, Done0, Regs), - case is_ref_msg_comparison(Args, RefRegs, Regs) of - false -> - opt_ref_used_1(Is, RefRegs, D, Done, Regs); - true -> - %% The instructions that follow (Is) can only be executed - %% if the message contains the same reference as in RefRegs. - Done - end; -opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], - RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_1(Is, RefRegs, D, Done0, Regs), - case is_ref_msg_comparison(Args, RefRegs, Regs) of - false -> - opt_ref_used_at(Fail, RefRegs, D, Done, Regs); - true -> - Done - end; -opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_at(Fail, RefRegs, D, Done0, Regs), - opt_ref_used_1(Is, RefRegs, D, Done, Regs); -opt_ref_used_1([{select,_,_,{f,Fail},List}|_], RefRegs, D, Done, Regs) -> - Lbls = [F || {f,F} <- List] ++ [Fail], - opt_ref_used_in_all(Lbls, RefRegs, D, Done, Regs); -opt_ref_used_1([{label,Lbl}|Is], RefRegs, D, Done, Regs) -> - case gb_sets:is_member(Lbl, Done) of - true -> Done; - false -> opt_ref_used_1(Is, RefRegs, D, Done, Regs) - end; -opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) -> - Done; -opt_ref_used_1([_I|_], _RefReg, _D, _Done, _Regs) -> - %% The optimization may be unsafe. - throw(not_used). - -%% is_ref_msg_comparison(Args, RefRegs, RegisterSet) -> true|false. -%% Return 'true' if Args denotes a comparison between the -%% reference and message or part of the message. -is_ref_msg_comparison([R1,R2], RefRegs, Regs) -> - (regs_is_member(R2, RefRegs) andalso regs_is_member(R1, Regs)) orelse - (regs_is_member(R1, RefRegs) andalso regs_is_member(R2, Regs)). - -opt_ref_used_in_all([L|Ls], RefRegs, D, Done0, Regs) -> - Done = opt_ref_used_at(L, RefRegs, D, Done0, Regs), - opt_ref_used_in_all(Ls, RefRegs, D, Done, Regs); -opt_ref_used_in_all([], _, _, Done, _) -> Done. - -opt_ref_used_at(Fail, RefRegs, D, Done0, Regs) -> - case gb_sets:is_member(Fail, Done0) of - true -> - Done0; - false -> - Is = beam_utils:code_at(Fail, D), - Done = opt_ref_used_1(Is, RefRegs, D, Done0, Regs), - gb_sets:add(Fail, Done) - end. - -opt_ref_used_bl([{set,[],[],remove_message}|_], _) -> - %% We have proved that a message that does not depend on the - %% reference can be matched out. - throw(not_used); -opt_ref_used_bl([{set,Ds,Ss,_}|Is], Regs0) -> - case regs_all_members(Ss, Regs0) of - false -> - %% The destination registers may be assigned values that - %% are not dependent on the message being matched. - Regs = regs_kill(Ds, Regs0), - opt_ref_used_bl(Is, Regs); - true -> - %% All the sources depend on the message directly or - %% indirectly. - Regs = regs_add_list(Ds, Regs0), - opt_ref_used_bl(Is, Regs) - end; -opt_ref_used_bl([], Regs) -> Regs. - -%%% -%%% Functions for keeping track of a set of registers. -%%% - -%% regs_init() -> RegisterSet -%% Return an empty set of registers. - -regs_init() -> - {0,0}. - -%% regs_init_singleton(Register) -> RegisterSet -%% Return a set that only contains one register. - -regs_init_singleton(Reg) -> - regs_add(Reg, regs_init()). - -%% regs_init_x0() -> RegisterSet -%% Return a set that only contains the {x,0} register. - -regs_init_x0() -> - {1 bsl 0,0}. - -%% regs_empty(Register) -> true|false -%% Test whether the register set is empty. - -regs_empty(R) -> - R =:= {0,0}. - -%% regs_kill_not_live(Live, RegisterSet) -> RegisterSet' -%% Kill all registers indicated not live by Live. - -regs_kill_not_live(Live, {Xregs,Yregs}) -> - {Xregs band ((1 bsl Live)-1),Yregs}. - -%% regs_kill([Register], RegisterSet) -> RegisterSet' -%% Kill all registers mentioned in the list of registers. - -regs_kill([{x,N}|Rs], {Xregs,Yregs}) -> - regs_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs}); -regs_kill([{y,N}|Rs], {Xregs,Yregs}) -> - regs_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))}); -regs_kill([{fr,_}|Rs], Regs) -> - regs_kill(Rs, Regs); -regs_kill([], Regs) -> Regs. - -regs_add_list(List, Regs) -> - foldl(fun(R, A) -> regs_add(R, A) end, Regs, List). - -%% regs_add(Register, RegisterSet) -> RegisterSet' -%% Add a new register to the set of registers. - -regs_add({x,N}, {Xregs,Yregs}) -> - {Xregs bor (1 bsl N),Yregs}; -regs_add({y,N}, {Xregs,Yregs}) -> - {Xregs,Yregs bor (1 bsl N)}. - -%% regs_all_members([Register], RegisterSet) -> true|false -%% Test whether all of the registers are part of the register set. - -regs_all_members([R|Rs], Regs) -> - regs_is_member(R, Regs) andalso regs_all_members(Rs, Regs); -regs_all_members([], _) -> true. - -%% regs_is_member(Register, RegisterSet) -> true|false -%% Test whether Register is part of the register set. - -regs_is_member({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0; -regs_is_member({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0; -regs_is_member(_, _) -> false. diff --git a/lib/compiler/src/beam_record.erl b/lib/compiler/src/beam_record.erl deleted file mode 100644 index 58a6de6775..0000000000 --- a/lib/compiler/src/beam_record.erl +++ /dev/null @@ -1,131 +0,0 @@ -%% %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 deleted file mode 100644 index 8d2ef5a431..0000000000 --- a/lib/compiler/src/beam_reorder.erl +++ /dev/null @@ -1,150 +0,0 @@ -%% -%% %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% -%% - --module(beam_reorder). - --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}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is = reorder(Is0), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% reorder(Instructions0) -> Instructions -%% Reorder instructions before the beam_block pass, because reordering -%% will be more cumbersome when the blocks are in place. -%% -%% Execution of get_tuple_element instructions can be delayed until -%% they are actually needed. Consider the sequence: -%% -%% get_tuple_element Tuple Pos Dst -%% test Test Fail Operands -%% -%% If Dst is killed at label Fail (and not referenced in Operands), -%% we can can swap the instructions: -%% -%% test Test Fail Operands -%% get_tuple_element Tuple Pos Dst -%% -%% That can be beneficial in two ways: Firstly, if the branch is taken -%% we have avoided execution of the get_tuple_element instruction. -%% Secondly, even if the branch is not taken, subsequent optimization -%% (opt_blocks/1) may be able to change Dst to the final destination -%% register and eliminate a 'move' instruction. - -reorder(Is) -> - D = beam_utils:index_labels(Is), - reorder_1(Is, D, []). - -reorder_1([{Op,_,_}=TryCatch|[I|Is]=Is0], D, Acc) - when Op =:= 'catch'; Op =:= 'try' -> - %% Don't allow 'try' or 'catch' instructions to split blocks if - %% it can be avoided. - case is_safe(I) of - false -> - reorder_1(Is0, D, [TryCatch|Acc]); - true -> - reorder_1([TryCatch|Is], D, [I|Acc]) - end; -reorder_1([{label,L}=I|_], D, Acc) -> - Is = beam_utils:code_at(L, D), - reorder_1(Is, D, [I|Acc]); -reorder_1([{test,is_nonempty_list,_,_}=I|Is], D, Acc) -> - %% The run-time system may combine the is_nonempty_list test with - %% the following get_list instruction. - reorder_1(Is, D, [I|Acc]); -reorder_1([{test,_,_,_}=I, - {select,_,_,_,_}=S|Is], D, Acc) -> - %% There is nothing to gain by inserting a get_tuple_element - %% instruction between the test instruction and the select - %% instruction. - reorder_1(Is, D, [S,I|Acc]); -reorder_1([{test,_,{f,_},[Src|_]}=I|Is], D, - [{get_tuple_element,Src,_,_}|_]=Acc) -> - %% We want to avoid code that can confuse beam_validator such as: - %% is_tuple Fail Src - %% test_arity Fail Src Arity - %% is_map Fail Src - %% get_tuple_element Src Pos Dst - %% Therefore, don't reorder the instructions in such cases. - reorder_1(Is, D, [I|Acc]); -reorder_1([{test,_,{f,L},Ss}=I|Is0], D0, - [{get_tuple_element,_,_,El}=G|Acc0]=Acc) -> - case member(El, Ss) of - true -> - reorder_1(Is0, D0, [I|Acc]); - false -> - case beam_utils:is_killed_at(El, L, D0) of - true -> - Is = [I,G|Is0], - reorder_1(Is, D0, Acc0); - false -> - case beam_utils:is_killed(El, Is0, D0) of - true -> - Code0 = beam_utils:code_at(L, D0), - Code = [G|Code0], - D = beam_utils:index_label(L, Code, D0), - Is = [I|Is0], - reorder_1(Is, D, Acc0); - false -> - reorder_1(Is0, D0, [I|Acc]) - end - end - end; -reorder_1([{allocate_zero,N,Live}=I0|Is], D, - [{get_tuple_element,{x,Tup},_,{x,Dst}}=G|Acc]=Acc0) -> - case Tup < Dst andalso Dst+1 =:= Live of - true -> - %% Move allocation instruction upwards past - %% get_tuple_element instructions to create more - %% opportunities for moving get_tuple_element - %% instructions. - I = {allocate_zero,N,Dst}, - reorder_1([I,G|Is], D, Acc); - false -> - reorder_1(Is, D, [I0|Acc0]) - end; -reorder_1([I|Is], D, Acc) -> - reorder_1(Is, D, [I|Acc]); -reorder_1([], _, Acc) -> reverse(Acc). - -%% is_safe(Instruction) -> true|false -%% Test whether an instruction is safe (cannot cause an exception). - -is_safe({kill,_}) -> true; -is_safe({move,_,_}) -> true; -is_safe({put,_}) -> true; -is_safe({put_list,_,_,_}) -> true; -is_safe({put_tuple,_,_}) -> true; -is_safe({test_heap,_,_}) -> true; -is_safe(_) -> false. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl deleted file mode 100644 index 809e49b3d0..0000000000 --- a/lib/compiler/src/beam_split.erl +++ /dev/null @@ -1,94 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% 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. -%% 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_split). --export([module/2]). - --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}}. - -%% We must split the basic block when we encounter instructions with labels, -%% such as catches and BIFs. All labels must be visible outside the blocks. - -split_blocks({function,Name,Arity,CLabel,Is0}) -> - Is = split_blocks(Is0, []), - {function,Name,Arity,CLabel,Is}. - -split_blocks([{block,Bl}|Is], Acc0) -> - Acc = split_block(Bl, [], Acc0), - split_blocks(Is, Acc); -split_blocks([I|Is], Acc) -> - split_blocks(Is, [I|Acc]); -split_blocks([], Acc) -> reverse(Acc). - -split_block([{set,[R],[_,_,_]=As,{bif,is_record,{f,Lbl}}}|Is], Bl, Acc) -> - %% is_record/3 must be translated by beam_clean; therefore, - %% it must be outside of any block. - split_block(Is, [], [{bif,is_record,{f,Lbl},As,R}|make_block(Bl, Acc)]); -split_block([{set,[R],As,{bif,N,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> - split_block(Is, [], [{bif,N,Fail,As,R}|make_block(Bl, Acc)]); -split_block([{set,[],[],{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)]); -split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], - Bl, Acc) when Lbl =/= 0 -> - split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}| - 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([I|Is], Bl, Acc) -> - split_block(Is, [I|Bl], Acc); -split_block([], Bl, Acc) -> make_block(Bl, Acc). - -make_block([], Acc) -> Acc; -make_block([{set,[D],Ss,{bif,Op,Fail}}|Bl]=Bl0, Acc) -> - %% If the last instruction in the block is a comparison or boolean operator - %% (such as '=:='), move it out of the block to facilitate further - %% optimizations. - Arity = length(Ss), - case erl_internal:comp_op(Op, Arity) orelse - erl_internal:new_type_test(Op, Arity) orelse - erl_internal:bool_op(Op, Arity) of - false -> - [{block,reverse(Bl0)}|Acc]; - true -> - I = {bif,Op,Fail,Ss,D}, - case Bl =:= [] of - true -> [I|Acc]; - false -> [I,{block,reverse(Bl)}|Acc] - end - end; -make_block([{set,[Dst],[Src],move}|Bl], Acc) -> - %% Make optimization of {move,Src,Dst}, {jump,...} possible. - I = {move,Src,Dst}, - case Bl =:= [] of - true -> [I|Acc]; - false -> [I,{block,reverse(Bl)}|Acc] - end; -make_block(Bl, Acc) -> [{block,reverse(Bl)}|Acc]. diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl new file mode 100644 index 0000000000..6492d1e1bf --- /dev/null +++ b/lib/compiler/src/beam_ssa.erl @@ -0,0 +1,898 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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: Type definitions and utilities for the SSA format. + +-module(beam_ssa). +-export([add_anno/3,get_anno/2,get_anno/3, + clobbers_xregs/1,def/2,def_used/2, + definitions/1, + dominators/1,common_dominators/3, + flatmapfold_instrs_rpo/4, + fold_po/3,fold_po/4,fold_rpo/3,fold_rpo/4, + fold_instrs_rpo/4, + linearize/1, + mapfold_blocks_rpo/4, + mapfold_instrs_rpo/4, + normalize/1, + no_side_effect/1, + predecessors/1, + rename_vars/3, + rpo/1,rpo/2, + split_blocks/3, + successors/1,successors/2, + trim_unreachable/1, + update_phi_labels/4,used/1, + uses/1,uses/2]). + +-export_type([b_module/0,b_function/0,b_blk/0,b_set/0, + b_ret/0,b_br/0,b_switch/0,terminator/0, + b_var/0,b_literal/0,b_remote/0,b_local/0, + value/0,argument/0,label/0, + var_name/0,var_base/0,literal_value/0, + op/0,anno/0,block_map/0,dominator_map/0, + rename_map/0,rename_proplist/0,usage_map/0, + definition_map/0]). + +-include("beam_ssa.hrl"). + +-type b_module() :: #b_module{}. +-type b_function() :: #b_function{}. +-type b_blk() :: #b_blk{}. +-type b_set() :: #b_set{}. + +-type b_br() :: #b_br{}. +-type b_ret() :: #b_ret{}. +-type b_switch() :: #b_switch{}. +-type terminator() :: b_br() | b_ret() | b_switch(). + +-type construct() :: b_module() | b_function() | b_blk() | b_set() | + terminator(). + +-type b_var() :: #b_var{}. +-type b_literal() :: #b_literal{}. +-type b_remote() :: #b_remote{}. +-type b_local() :: #b_local{}. + +-type value() :: b_var() | b_literal(). +-type phi_value() :: {value(),label()}. +-type argument() :: value() | b_remote() | b_local() | phi_value(). +-type label() :: non_neg_integer(). + +-type var_name() :: var_base() | {var_base(),non_neg_integer()}. +-type var_base() :: atom() | non_neg_integer(). + +-type literal_value() :: atom() | integer() | float() | list() | + nil() | tuple() | map() | binary(). + +-type op() :: {'bif',atom()} | {'float',float_op()} | prim_op() | cg_prim_op(). +-type anno() :: #{atom() := any()}. + +-type block_map() :: #{label():=b_blk()}. +-type dominator_map() :: #{label():=[label()]}. +-type numbering_map() :: #{label():=non_neg_integer()}. +-type usage_map() :: #{b_var():=[{label(),b_set() | terminator()}]}. +-type definition_map() :: #{b_var():=b_set()}. +-type rename_map() :: #{b_var():=value()}. +-type rename_proplist() :: [{b_var(),value()}]. + +%% Note: By default, dialyzer will collapse this type to atom(). +%% To avoid the collapsing, change the value of SET_LIMIT to 50 in the +%% file erl_types.erl in the hipe application. + +-type prim_op() :: 'bs_add' | 'bs_extract' | 'bs_get_tail' | + 'bs_init' | 'bs_init_writable' | + 'bs_match' | 'bs_put' | 'bs_start_match' | 'bs_test_tail' | + 'bs_utf16_size' | 'bs_utf8_size' | 'build_stacktrace' | + 'call' | 'catch_end' | + 'extract' | + 'get_hd' | 'get_map_element' | 'get_tl' | 'get_tuple_element' | + 'has_map_field' | + 'is_nonempty_list' | 'is_tagged_tuple' | + 'kill_try_tag' | + 'landingpad' | + 'make_fun' | 'new_try_tag' | + 'peek_message' | 'phi' | 'put_list' | 'put_map' | 'put_tuple' | + 'raw_raise' | 'recv_next' | 'remove_message' | 'resume' | + 'succeeded' | + 'timeout' | + 'wait' | 'wait_timeout'. + +-type float_op() :: 'checkerror' | 'clearerror' | 'convert' | 'get' | 'put' | + '+' | '-' | '*' | '/'. + +%% Primops only used internally during code generation. +-type cg_prim_op() :: 'bs_get' | 'bs_get_position' | 'bs_match_string' | + 'bs_restore' | 'bs_save' | 'bs_set_position' | 'bs_skip' | + 'copy' | 'put_tuple_arity' | 'put_tuple_element' | + 'put_tuple_elements' | 'set_tuple_element'. + +-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1,umerge/1]). + +-spec add_anno(Key, Value, Construct) -> Construct when + Key :: atom(), + Value :: any(), + Construct :: construct(). + +add_anno(Key, Val, #b_function{anno=Anno}=Bl) -> + Bl#b_function{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_blk{anno=Anno}=Bl) -> + Bl#b_blk{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_set{anno=Anno}=Bl) -> + Bl#b_set{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_br{anno=Anno}=Bl) -> + Bl#b_br{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_ret{anno=Anno}=Bl) -> + Bl#b_ret{anno=Anno#{Key=>Val}}; +add_anno(Key, Val, #b_switch{anno=Anno}=Bl) -> + Bl#b_switch{anno=Anno#{Key=>Val}}. + +-spec get_anno(atom(), construct()) -> any(). + +get_anno(Key, Construct) -> + map_get(Key, get_anno(Construct)). + +-spec get_anno(atom(), construct(),any()) -> any(). + +get_anno(Key, Construct, Default) -> + maps:get(Key, get_anno(Construct), Default). + +get_anno(#b_function{anno=Anno}) -> Anno; +get_anno(#b_blk{anno=Anno}) -> Anno; +get_anno(#b_set{anno=Anno}) -> Anno; +get_anno(#b_br{anno=Anno}) -> Anno; +get_anno(#b_ret{anno=Anno}) -> Anno; +get_anno(#b_switch{anno=Anno}) -> Anno. + +%% clobbers_xregs(#b_set{}) -> true|false. +%% Test whether the instruction invalidates all X registers. + +-spec clobbers_xregs(b_set()) -> boolean(). + +clobbers_xregs(#b_set{op=Op}) -> + case Op of + bs_init_writable -> true; + build_stacktrace -> true; + call -> true; + landingpad -> true; + make_fun -> true; + peek_message -> true; + raw_raise -> true; + _ -> false + end. + +%% no_side_effect(#b_set{}) -> true|false. +%% Test whether this instruction has no side effect and thus is safe +%% not to execute if its value is not used. Note that even if `true` +%% is returned, the instruction could still be impure (e.g. bif:get). + +-spec no_side_effect(b_set()) -> boolean(). + +no_side_effect(#b_set{op=Op}) -> + case Op of + {bif,_} -> true; + {float,get} -> true; + bs_init -> true; + bs_extract -> true; + bs_match -> true; + bs_start_match -> true; + bs_test_tail -> true; + bs_get_tail -> true; + bs_put -> true; + extract -> true; + get_hd -> true; + get_tl -> true; + get_map_element -> true; + get_tuple_element -> true; + has_map_field -> true; + is_nonempty_list -> true; + is_tagged_tuple -> true; + make_fun -> true; + put_map -> true; + put_list -> true; + put_tuple -> true; + succeeded -> true; + _ -> false + end. + +-spec predecessors(Blocks) -> #{BlockNumber:=[Predecessor]} when + Blocks :: block_map(), + BlockNumber :: label(), + Predecessor :: label(). + +predecessors(Blocks) -> + P0 = [{S,L} || {L,Blk} <- maps:to_list(Blocks), + S <- successors(Blk)], + P1 = sofs:relation(P0), + P2 = sofs:rel2fam(P1), + P3 = sofs:to_external(P2), + P = [{0,[]}|P3], + maps:from_list(P). + +-spec successors(b_blk()) -> [label()]. + +successors(#b_blk{last=Terminator}) -> + case Terminator of + #b_br{bool=#b_literal{val=true},succ=Succ} -> + [Succ]; + #b_br{bool=#b_literal{val=false},fail=Fail} -> + [Fail]; + #b_br{succ=Succ,fail=Fail} -> + [Fail,Succ]; + #b_switch{fail=Fail,list=List} -> + [Fail|[L || {_,L} <- List]]; + #b_ret{} -> + [] + end. + +%% normalize(Instr0) -> Instr. +%% Normalize instructions to help optimizations. +%% +%% For commutative operators (such as '+' and 'or'), always +%% place a variable operand before a literal operand. +%% +%% Normalize #b_br{} to one of the following forms: +%% +%% #b_br{b_literal{val=true},succ=Label,fail=Label} +%% #b_br{b_var{},succ=Label1,fail=Label2} where Label1 =/= Label2 +%% +%% Simplify a #b_switch{} with a literal argument to a #b_br{}. +%% +%% Simplify a #b_switch{} with a variable argument and an empty +%% switch list to a #b_br{}. + +-spec normalize(b_set() | terminator()) -> + b_set() | terminator(). + +normalize(#b_set{op={bif,Bif},args=Args}=Set) -> + case {is_commutative(Bif),Args} of + {false,_} -> + Set; + {true,[#b_literal{}=Lit,#b_var{}=Var]} -> + Set#b_set{args=[Var,Lit]}; + {true,_} -> + Set + end; +normalize(#b_set{}=Set) -> + Set; +normalize(#b_br{}=Br) -> + case Br of + #b_br{bool=Bool,succ=Same,fail=Same} -> + case Bool of + #b_literal{val=true} -> + Br; + _ -> + Br#b_br{bool=#b_literal{val=true}} + end; + #b_br{bool=#b_literal{val=true},succ=Succ} -> + Br#b_br{fail=Succ}; + #b_br{bool=#b_literal{val=false},fail=Fail} -> + Br#b_br{bool=#b_literal{val=true},succ=Fail}; + #b_br{} -> + Br + end; +normalize(#b_switch{arg=Arg,fail=Fail,list=List}=Sw) -> + case Arg of + #b_literal{} -> + case keyfind(Arg, 1, List) of + false -> + #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}; + {Arg,L} -> + #b_br{bool=#b_literal{val=true},succ=L,fail=L} + end; + #b_var{} when List =:= [] -> + #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}; + #b_var{} -> + Sw + end; +normalize(#b_ret{}=Ret) -> + Ret. + +-spec successors(label(), block_map()) -> [label()]. + +successors(L, Blocks) -> + successors(map_get(L, Blocks)). + +-spec def(Ls, Blocks) -> Def when + Ls :: [label()], + Blocks :: block_map(), + Def :: ordsets:ordset(var_name()). + +def(Ls, Blocks) -> + Top = rpo(Ls, Blocks), + Blks = [map_get(L, Blocks) || L <- Top], + def_1(Blks, []). + +-spec def_used(Ls, Blocks) -> {Def,Used} when + Ls :: [label()], + Blocks :: block_map(), + Def :: ordsets:ordset(var_name()), + Used :: ordsets:ordset(var_name()). + +def_used(Ls, Blocks) -> + Top = rpo(Ls, Blocks), + Blks = [map_get(L, Blocks) || L <- Top], + Preds = cerl_sets:from_list(Top), + def_used_1(Blks, Preds, [], []). + +%% dominators(BlockMap) -> {Dominators,Numbering}. +%% Calculate the dominator tree, returning a map where each entry +%% in the map is a list that gives the path from that block to +%% the top of the dominator tree. (Note that the suffixes of the +%% paths are shared with each other, which make the representation +%% of the dominator tree highly memory-efficient.) +%% +%% The implementation is based on: +%% +%% http://www.hipersoft.rice.edu/grads/publications/dom14.pdf +%% Cooper, Keith D.; Harvey, Timothy J; Kennedy, Ken (2001). +%% A Simple, Fast Dominance Algorithm. + +-spec dominators(Blocks) -> Result when + Blocks :: block_map(), + Result :: {dominator_map(), numbering_map()}. +dominators(Blocks) -> + Preds = predecessors(Blocks), + Top0 = rpo(Blocks), + Df = maps:from_list(number(Top0, 0)), + [{0,[]}|Top] = [{L,map_get(L, Preds)} || L <- Top0], + + %% The flow graph for an Erlang function is reducible, and + %% therefore one traversal in reverse postorder is sufficient. + Acc = #{0=>[0]}, + {dominators_1(Top, Df, Acc),Df}. + +%% common_dominators([Label], Dominators, Numbering) -> [Label]. +%% Calculate the common dominators for the given list of blocks +%% and Dominators and Numbering as returned from dominators/1. + +-spec common_dominators([label()], dominator_map(), numbering_map()) -> [label()]. +common_dominators(Ls, Dom, Numbering) -> + Doms = [map_get(L, Dom) || L <- Ls], + dom_intersection(Doms, Numbering). + +-spec fold_instrs_rpo(Fun, From, Acc0, Blocks) -> any() when + Fun :: fun((b_blk()|terminator(), any()) -> any()), + From :: [label()], + Acc0 :: any(), + Blocks :: block_map(). + +fold_instrs_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + fold_instrs_rpo_1(Top, Fun, Blocks, Acc0). + +%% Like mapfold_instrs_rpo but at the block level to support lookahead and +%% scope-dependent transformations. +-spec mapfold_blocks_rpo(Fun, From, Acc, Blocks) -> Result when + Fun :: fun((label(), b_blk(), any()) -> {b_blk(), any()}), + From :: [label()], + Acc :: any(), + Blocks :: block_map(), + Result :: {block_map(), any()}. +mapfold_blocks_rpo(Fun, From, Acc, Blocks) -> + Successors = rpo(From, Blocks), + foldl(fun(Lbl, A) -> + mapfold_blocks_rpo_1(Fun, Lbl, A) + end, {Blocks, Acc}, Successors). + +mapfold_blocks_rpo_1(Fun, Lbl, {Blocks0, Acc0}) -> + Block0 = map_get(Lbl, Blocks0), + {Block, Acc} = Fun(Lbl, Block0, Acc0), + Blocks = Blocks0#{Lbl:=Block}, + {Blocks, Acc}. + +-spec mapfold_instrs_rpo(Fun, From, Acc0, Blocks0) -> {Blocks,Acc} when + Fun :: fun((b_blk()|terminator(), any()) -> any()), + From :: [label()], + Acc0 :: any(), + Acc :: any(), + Blocks0 :: block_map(), + Blocks :: block_map(). + +mapfold_instrs_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + mapfold_instrs_rpo_1(Top, Fun, Blocks, Acc0). + +-spec flatmapfold_instrs_rpo(Fun, From, Acc0, Blocks0) -> {Blocks,Acc} when + Fun :: fun((b_blk()|terminator(), any()) -> any()), + From :: [label()], + Acc0 :: any(), + Acc :: any(), + Blocks0 :: block_map(), + Blocks :: block_map(). + +flatmapfold_instrs_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + flatmapfold_instrs_rpo_1(Top, Fun, Blocks, Acc0). + +-type fold_fun() :: fun((label(), b_blk(), any()) -> any()). + +%% fold_rpo(Fun, [Label], Acc0, Blocks) -> Acc. +%% Fold over all blocks a reverse postorder traversal of the block +%% graph; that is, first visit a block, then visit its successors. + +-spec fold_rpo(Fun, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Acc0 :: any(), + Blocks :: #{label():=b_blk()}. + +fold_rpo(Fun, Acc0, Blocks) -> + fold_rpo(Fun, [0], Acc0, Blocks). + +%% fold_rpo(Fun, [Label], Acc0, Blocks) -> Acc. Fold over all blocks +%% reachable from a given set of labels in a reverse postorder +%% traversal of the block graph; that is, first visit a block, then +%% visit its successors. + +-spec fold_rpo(Fun, Labels, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Labels :: [label()], + Acc0 :: any(), + Blocks :: #{label():=b_blk()}. + +fold_rpo(Fun, From, Acc0, Blocks) -> + Top = rpo(From, Blocks), + fold_rpo_1(Top, Fun, Blocks, Acc0). + +%% fold_po(Fun, Acc0, Blocks) -> Acc. +%% Fold over all blocks in a postorder traversal of the block graph; +%% that is, first visit all successors of block, then the block +%% itself. + +-spec fold_po(Fun, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Acc0 :: any(), + Blocks :: #{label():=b_blk()}. + +%% fold_po(Fun, From, Acc0, Blocks) -> Acc. +%% Fold over the blocks reachable from the block numbers given +%% by From in a postorder traversal of the block graph. + +fold_po(Fun, Acc0, Blocks) -> + fold_po(Fun, [0], Acc0, Blocks). + +-spec fold_po(Fun, Labels, Acc0, Blocks) -> any() when + Fun :: fold_fun(), + Labels :: [label()], + Acc0 :: any(), + Blocks :: block_map(). + +fold_po(Fun, From, Acc0, Blocks) -> + Top = reverse(rpo(From, Blocks)), + fold_rpo_1(Top, Fun, Blocks, Acc0). + +%% linearize(Blocks) -> [{BlockLabel,#b_blk{}}]. +%% Linearize the intermediate representation of the code. +%% Unreachable blocks will be discarded, and phi nodes will +%% be adjusted so that they no longer refers to discarded +%% blocks or to blocks that no longer are predecessors of +%% the phi node block. + +-spec linearize(Blocks) -> Linear when + Blocks :: block_map(), + Linear :: [{label(),b_blk()}]. + +linearize(Blocks) -> + Seen = cerl_sets:new(), + {Linear0,_} = linearize_1([0], Blocks, Seen, []), + Linear = fix_phis(Linear0, #{}), + Linear. + +-spec rpo(Blocks) -> [Label] when + Blocks :: block_map(), + Label :: label(). + +rpo(Blocks) -> + rpo([0], Blocks). + +-spec rpo(From, Blocks) -> Labels when + From :: [label()], + Blocks :: block_map(), + Labels :: [label()]. + +rpo(From, Blocks) -> + Seen = cerl_sets:new(), + {Ls,_} = rpo_1(From, Blocks, Seen, []), + Ls. + +-spec rename_vars(Rename, [label()], block_map()) -> block_map() when + Rename :: rename_map() | rename_proplist(). + +rename_vars(Rename, From, Blocks) when is_list(Rename) -> + rename_vars(maps:from_list(Rename), From, Blocks); +rename_vars(Rename, From, Blocks) when is_map(Rename)-> + Top = rpo(From, Blocks), + Preds = cerl_sets:from_list(Top), + F = fun(#b_set{op=phi,args=Args0}=Set) -> + Args = rename_phi_vars(Args0, Preds, Rename), + Set#b_set{args=Args}; + (#b_set{args=Args0}=Set) -> + Args = [rename_var(A, Rename) || A <- Args0], + Set#b_set{args=Args}; + (#b_switch{arg=Bool}=Sw) -> + Sw#b_switch{arg=rename_var(Bool, Rename)}; + (#b_br{bool=Bool}=Br) -> + Br#b_br{bool=rename_var(Bool, Rename)}; + (#b_ret{arg=Arg}=Ret) -> + Ret#b_ret{arg=rename_var(Arg, Rename)} + end, + map_instrs_1(Top, F, Blocks). + +%% split_blocks(Predicate, Blocks0, Count0) -> {Blocks,Count}. +%% Call Predicate(Instruction) for each instruction in all +%% blocks. If Predicate/1 returns true, split the block +%% before this instruction. + +-spec split_blocks(Pred, Blocks0, Count0) -> {Blocks,Count} when + Pred :: fun((b_set()) -> boolean()), + Blocks :: block_map(), + Count0 :: beam_ssa:label(), + Blocks0 :: block_map(), + Blocks :: block_map(), + Count :: beam_ssa:label(). + +split_blocks(P, Blocks, Count) -> + Ls = beam_ssa:rpo(Blocks), + split_blocks_1(Ls, P, Blocks, Count). + +-spec trim_unreachable(Blocks0) -> Blocks when + Blocks0 :: block_map(), + Blocks :: block_map(). + +%% trim_unreachable(Blocks0) -> Blocks. +%% Remove all unreachable blocks. Adjust all phi nodes so +%% they don't refer to blocks that has been removed or no +%% no longer branch to the phi node in question. + +trim_unreachable(Blocks) -> + %% Could perhaps be optimized if there is any need. + maps:from_list(linearize(Blocks)). + +%% update_phi_labels([BlockLabel], Old, New, Blocks0) -> Blocks. +%% In the given blocks, replace label Old in with New in all +%% phi nodes. This is useful after merging or splitting +%% blocks. + +-spec update_phi_labels(From, Old, New, Blocks0) -> Blocks when + From :: [label()], + Old :: label(), + New :: label(), + Blocks0 :: block_map(), + Blocks :: block_map(). + +update_phi_labels([L|Ls], Old, New, Blocks0) -> + case Blocks0 of + #{L:=#b_blk{is=[#b_set{op=phi}|_]=Is0}=Blk0} -> + Is = update_phi_labels_is(Is0, Old, New), + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks0#{L:=Blk}, + update_phi_labels(Ls, Old, New, Blocks); + #{L:=#b_blk{}} -> + %% No phi nodes in this block. + update_phi_labels(Ls, Old, New, Blocks0) + end; +update_phi_labels([], _, _, Blocks) -> Blocks. + +-spec used(b_blk() | b_set() | terminator()) -> [var_name()]. + +used(#b_blk{is=Is,last=Last}) -> + used_1([Last|Is], ordsets:new()); +used(#b_br{bool=#b_var{}=V}) -> + [V]; +used(#b_ret{arg=#b_var{}=V}) -> + [V]; +used(#b_set{op=phi,args=Args}) -> + ordsets:from_list([V || {#b_var{}=V,_} <- Args]); +used(#b_set{args=Args}) -> + ordsets:from_list(used_args(Args)); +used(#b_switch{arg=#b_var{}=V}) -> + [V]; +used(_) -> []. + +-spec definitions(Blocks :: block_map()) -> definition_map(). +definitions(Blocks) -> + fold_instrs_rpo(fun(#b_set{ dst = Var }=I, Acc) -> + Acc#{Var => I}; + (_Terminator, Acc) -> + Acc + end, [0], #{}, Blocks). + +-spec uses(Blocks :: block_map()) -> usage_map(). +uses(Blocks) -> + uses([0], Blocks). + +-spec uses(From, Blocks) -> usage_map() when + From :: [label()], + Blocks :: block_map(). +uses(From, Blocks) -> + fold_rpo(fun fold_uses_block/3, From, #{}, Blocks). + +fold_uses_block(Lbl, #b_blk{is=Is,last=Last}, UseMap0) -> + F = fun(I, UseMap) -> + foldl(fun(Var, Acc) -> + Uses0 = maps:get(Var, Acc, []), + Uses = [{Lbl, I} | Uses0], + maps:put(Var, Uses, Acc) + end, UseMap, used(I)) + end, + F(Last, foldl(F, UseMap0, Is)). + +%%% +%%% Internal functions. +%%% + +is_commutative('and') -> true; +is_commutative('or') -> true; +is_commutative('xor') -> true; +is_commutative('band') -> true; +is_commutative('bor') -> true; +is_commutative('bxor') -> true; +is_commutative('+') -> true; +is_commutative('*') -> true; +is_commutative('=:=') -> true; +is_commutative('==') -> true; +is_commutative('=/=') -> true; +is_commutative('/=') -> true; +is_commutative(_) -> false. + +def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, UsedAcc) -> + {Def,Used} = def_used_is(Is, Preds, Def0, used(Last)), + case Used of + [] -> + def_used_1(Bs, Preds, Def, UsedAcc); + [_|_] -> + def_used_1(Bs, Preds, Def, [Used|UsedAcc]) + end; +def_used_1([], _Preds, Def0, UsedAcc) -> + Def = ordsets:from_list(Def0), + Used = umerge(UsedAcc), + {Def,Used}. + +def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is], + Preds, Def0, Used0) -> + Def = [Dst|Def0], + %% We must be careful to only include variables that will + %% be used when arriving from one of the predecessor blocks + %% in Preds. + Used1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], + Used = ordsets:union(ordsets:from_list(Used1), Used0), + def_used_is(Is, Preds, Def, Used); +def_used_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Used0) -> + Def = [Dst|Def0], + Used = ordsets:union(used(I), Used0), + def_used_is(Is, Preds, Def, Used); +def_used_is([], _Preds, Def, Used) -> + {Def,Used}. + +def_1([#b_blk{is=Is}|Bs], Def0) -> + Def = def_is(Is, Def0), + def_1(Bs, Def); +def_1([], Def) -> + ordsets:from_list(Def). + +def_is([#b_set{dst=Dst}|Is], Def) -> + def_is(Is, [Dst|Def]); +def_is([], Def) -> Def. + +dominators_1([{L,Preds}|Ls], Df, Doms) -> + DomPreds = [map_get(P, Doms) || P <- Preds, is_map_key(P, Doms)], + Dom = [L|dom_intersection(DomPreds, Df)], + dominators_1(Ls, Df, Doms#{L=>Dom}); +dominators_1([], _Df, Doms) -> Doms. + +dom_intersection([S], _Df) -> + S; +dom_intersection([S|Ss], Df) -> + dom_intersection(S, Ss, Df). + +dom_intersection(S1, [S2|Ss], Df) -> + dom_intersection(dom_intersection_1(S1, S2, Df), Ss, Df); +dom_intersection(S, [], _Df) -> S. + +dom_intersection_1([E1|Es1]=Set1, [E2|Es2]=Set2, Df) -> + %% Blocks are numbered in the order they are found in + %% reverse postorder. + #{E1:=Df1,E2:=Df2} = Df, + if Df1 > Df2 -> + dom_intersection_1(Es1, Set2, Df); + Df2 > Df1 -> + dom_intersection_1(Es2, Set1, Df); %switch arguments! + true -> %Set1 == Set2 + %% The common suffix of the sets is the intersection. + Set1 + end. + +number([L|Ls], N) -> + [{L,N}|number(Ls, N+1)]; +number([], _) -> []. + +fold_rpo_1([L|Ls], Fun, Blocks, Acc0) -> + Block = map_get(L, Blocks), + Acc = Fun(L, Block, Acc0), + fold_rpo_1(Ls, Fun, Blocks, Acc); +fold_rpo_1([], _, _, Acc) -> Acc. + +fold_instrs_rpo_1([L|Ls], Fun, Blocks, Acc0) -> + #b_blk{is=Is,last=Last} = map_get(L, Blocks), + Acc1 = foldl(Fun, Acc0, Is), + Acc = Fun(Last, Acc1), + fold_instrs_rpo_1(Ls, Fun, Blocks, Acc); +fold_instrs_rpo_1([], _, _, Acc) -> Acc. + +mapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) -> + #b_blk{is=Is0,last=Last0} = Block0 = map_get(L, Blocks0), + {Is,Acc1} = mapfoldl(Fun, Acc0, Is0), + {Last,Acc} = Fun(Last0, Acc1), + Block = Block0#b_blk{is=Is,last=Last}, + Blocks = Blocks0#{L:=Block}, + mapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc); +mapfold_instrs_rpo_1([], _, Blocks, Acc) -> + {Blocks,Acc}. + +flatmapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) -> + #b_blk{is=Is0,last=Last0} = Block0 = map_get(L, Blocks0), + {Is,Acc1} = flatmapfoldl(Fun, Acc0, Is0), + {[Last],Acc} = Fun(Last0, Acc1), + Block = Block0#b_blk{is=Is,last=Last}, + Blocks = Blocks0#{L:=Block}, + flatmapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc); +flatmapfold_instrs_rpo_1([], _, Blocks, Acc) -> + {Blocks,Acc}. + +linearize_1([L|Ls], Blocks, Seen0, Acc0) -> + case cerl_sets:is_element(L, Seen0) of + true -> + linearize_1(Ls, Blocks, Seen0, Acc0); + false -> + Seen1 = cerl_sets:add_element(L, Seen0), + Block = map_get(L, Blocks), + Successors = successors(Block), + {Acc,Seen} = linearize_1(Successors, Blocks, Seen1, Acc0), + linearize_1(Ls, Blocks, Seen, [{L,Block}|Acc]) + end; +linearize_1([], _, Seen, Acc) -> + {Acc,Seen}. + +fix_phis([{L,Blk0}|Bs], S) -> + Blk = case Blk0 of + #b_blk{is=[#b_set{op=phi}|_]=Is0} -> + Is = fix_phis_1(Is0, L, S), + Blk0#b_blk{is=Is}; + #b_blk{} -> + Blk0 + end, + Successors = successors(Blk), + [{L,Blk}|fix_phis(Bs, S#{L=>Successors})]; +fix_phis([], _) -> []. + +fix_phis_1([#b_set{op=phi,args=Args0}=I|Is], L, S) -> + Args = [{Val,Pred} || {Val,Pred} <- Args0, + is_successor(L, Pred, S)], + [I#b_set{args=Args}|fix_phis_1(Is, L, S)]; +fix_phis_1(Is, _, _) -> Is. + +is_successor(L, Pred, S) -> + case S of + #{Pred:=Successors} -> + member(L, Successors); + #{} -> + %% This block has been removed. + false + end. + +rpo_1([L|Ls], Blocks, Seen0, Acc0) -> + case cerl_sets:is_element(L, Seen0) of + true -> + rpo_1(Ls, Blocks, Seen0, Acc0); + false -> + Block = map_get(L, Blocks), + Seen1 = cerl_sets:add_element(L, Seen0), + Successors = successors(Block), + {Acc,Seen} = rpo_1(Successors, Blocks, Seen1, Acc0), + rpo_1(Ls, Blocks, Seen, [L|Acc]) + end; +rpo_1([], _, Seen, Acc) -> + {Acc,Seen}. + +rename_var(#b_var{}=Old, Rename) -> + case Rename of + #{Old:=New} -> New; + #{} -> Old + end; +rename_var(#b_remote{mod=Mod0,name=Name0}=Remote, Rename) -> + Mod = rename_var(Mod0, Rename), + Name = rename_var(Name0, Rename), + Remote#b_remote{mod=Mod,name=Name}; +rename_var(Old, _) -> Old. + +rename_phi_vars([{Var,L}|As], Preds, Ren) -> + case cerl_sets:is_element(L, Preds) of + true -> + [{rename_var(Var, Ren),L}|rename_phi_vars(As, Preds, Ren)]; + false -> + [{Var,L}|rename_phi_vars(As, Preds, Ren)] + end; +rename_phi_vars([], _, _) -> []. + +map_instrs_1([L|Ls], Fun, Blocks0) -> + #b_blk{is=Is0,last=Last0} = Blk0 = map_get(L, Blocks0), + Is = [Fun(I) || I <- Is0], + Last = Fun(Last0), + Blk = Blk0#b_blk{is=Is,last=Last}, + Blocks = Blocks0#{L:=Blk}, + map_instrs_1(Ls, Fun, Blocks); +map_instrs_1([], _, Blocks) -> Blocks. + +flatmapfoldl(F, Accu0, [Hd|Tail]) -> + {R,Accu1} = F(Hd, Accu0), + {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), + {R++Rs,Accu2}; +flatmapfoldl(_, Accu, []) -> {[],Accu}. + +split_blocks_1([L|Ls], P, Blocks0, Count0) -> + #b_blk{is=Is0} = Blk = map_get(L, Blocks0), + case split_blocks_is(Is0, P, []) of + {yes,Bef,Aft} -> + NewLbl = Count0, + Count = Count0 + 1, + Br = #b_br{bool=#b_literal{val=true},succ=NewLbl,fail=NewLbl}, + BefBlk = Blk#b_blk{is=Bef,last=Br}, + NewBlk = Blk#b_blk{is=Aft}, + Blocks1 = Blocks0#{L:=BefBlk,NewLbl=>NewBlk}, + Successors = successors(NewBlk), + Blocks = update_phi_labels(Successors, L, NewLbl, Blocks1), + split_blocks_1([NewLbl|Ls], P, Blocks, Count); + no -> + split_blocks_1(Ls, P, Blocks0, Count0) + end; +split_blocks_1([], _, Blocks, Count) -> + {Blocks,Count}. + +split_blocks_is([I|Is], P, []) -> + split_blocks_is(Is, P, [I]); +split_blocks_is([I|Is], P, Acc) -> + case P(I) of + true -> + {yes,reverse(Acc),[I|Is]}; + false -> + split_blocks_is(Is, P, [I|Acc]) + end; +split_blocks_is([], _, _) -> no. + +update_phi_labels_is([#b_set{op=phi,args=Args0}=I0|Is], Old, New) -> + Args = [{Arg,rename_label(Lbl, Old, New)} || {Arg,Lbl} <- Args0], + I = I0#b_set{args=Args}, + [I|update_phi_labels_is(Is, Old, New)]; +update_phi_labels_is(Is, _, _) -> Is. + +rename_label(Old, Old, New) -> New; +rename_label(Lbl, _Old, _New) -> Lbl. + +used_args([#b_var{}=V|As]) -> + [V|used_args(As)]; +used_args([#b_remote{mod=Mod,name=Name}|As]) -> + used_args([Mod,Name|As]); +used_args([_|As]) -> + used_args(As); +used_args([]) -> []. + +used_1([H|T], Used0) -> + Used = ordsets:union(used(H), Used0), + used_1(T, Used); +used_1([], Used) -> Used. diff --git a/lib/compiler/src/beam_ssa.hrl b/lib/compiler/src/beam_ssa.hrl new file mode 100644 index 0000000000..fa76b08453 --- /dev/null +++ b/lib/compiler/src/beam_ssa.hrl @@ -0,0 +1,66 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +-record(b_module, {anno=#{} :: beam_ssa:anno(), + name :: module(), + exports :: [{atom(),arity()}], + attributes :: list(), + body :: [beam_ssa:b_function()]}). +-record(b_function, {anno=#{} :: beam_ssa:anno(), + args :: [beam_ssa:b_var()], + bs :: #{beam_ssa:label():=beam_ssa:b_blk()}, + cnt :: beam_ssa:label()}). + +-record(b_blk, {anno=#{} :: beam_ssa:anno(), + is :: [beam_ssa:b_set()], + last :: beam_ssa:terminator()}). +-record(b_set, {anno=#{} :: beam_ssa:anno(), + dst=none :: 'none'|beam_ssa:b_var(), + op :: beam_ssa:op(), + args=[] :: [beam_ssa:argument()]}). + +%% Terminators. +-record(b_ret, {anno=#{} :: beam_ssa:anno(), + arg :: beam_ssa:value()}). + +-record(b_br, {anno=#{}, + bool :: beam_ssa:value(), + succ :: beam_ssa:label(), + fail :: beam_ssa:label()}). + +-record(b_switch, {anno=#{} :: beam_ssa:anno(), + arg :: beam_ssa:value(), + fail :: beam_ssa:label(), + list :: [{beam_ssa:b_literal(),beam_ssa:label()}]}). + +%% Values. +-record(b_var, {name :: beam_ssa:var_name()}). + +-record(b_literal, {val :: beam_ssa:literal_value()}). + +-record(b_remote, {mod :: beam_ssa:value(), + name :: beam_ssa:value(), + arity :: non_neg_integer()}). + +-record(b_local, {name :: beam_ssa:b_literal(), + arity :: non_neg_integer()}). + +%% If this block exists, it calls erlang:error(badarg). +-define(BADARG_BLOCK, 1). diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl new file mode 100644 index 0000000000..1ac9e6a3bb --- /dev/null +++ b/lib/compiler/src/beam_ssa_bsm.erl @@ -0,0 +1,1050 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +%%% +%%% This pass optimizes bit syntax matching, and is centered around the concept +%%% of "match context reuse" which is best explained through example. To put it +%%% shortly we attempt to turn this: +%%% +%%% <<0,B/bits>> = A, +%%% <<1,C/bits>> = B, +%%% <<D,_/bits>> = C, +%%% D. +%%% +%%% ... Into this: +%%% +%%% <<0,1,D,_/bits>>=A, +%%% D. +%%% +%%% Which is much faster as it avoids the creation of intermediate terms. This +%%% is especially noticeable in loops where such garbage is generated on each +%%% iteration. +%%% +%%% The optimization itself is very simple and can be applied whenever there's +%%% matching on the tail end of a binary; instead of creating a new binary and +%%% starting a new match context on it, we reuse the match context used to +%%% extract the tail and avoid the creation of both objects. +%%% +%%% The catch is that a match context isn't a proper type and nothing outside +%%% of bit syntax match operations can handle them. We therefore need to make +%%% sure that they never "leak" into other instructions, and most of the pass +%%% revolves around getting around that limitation. +%%% +%%% Unlike most other passes we look at the whole module so we can combine +%%% matches across function boundaries, greatly increasing the performance of +%%% complex matches and loops. +%%% + +-module(beam_ssa_bsm). + +-export([module/2, format_error/1]). + +-include("beam_ssa.hrl"). + +-import(lists, [member/2, reverse/1, splitwith/2, map/2, foldl/3, mapfoldl/3, + nth/2, max/1, unzip/1]). + +-spec format_error(term()) -> nonempty_string(). + +format_error(OptInfo) -> + format_opt_info(OptInfo). + +-spec module(Module, Options) -> Result when + Module :: beam_ssa:b_module(), + Options :: [compile:option()], + Result :: {ok, beam_ssa:b_module(), list()}. + +-define(PASS(N), {N,fun N/1}). + +module(#b_module{body=Fs0}=Module, Opts) -> + ModInfo = analyze_module(Module), + + %% combine_matches is repeated after accept_context_args as the control + %% flow changes can enable further optimizations, as in the example below: + %% + %% a(<<0,X/binary>>) -> a(X); + %% a(A) when bit_size(A) =:= 52 -> bar; + %% a(<<1,X/binary>>) -> X. %% Match context will be reused here when + %% %% when repeated. + + {Fs, _} = compile:run_sub_passes( + [?PASS(combine_matches), + ?PASS(accept_context_args), + ?PASS(combine_matches), + ?PASS(allow_context_passthrough), + ?PASS(skip_outgoing_tail_extraction), + ?PASS(annotate_context_parameters)], + {Fs0, ModInfo}), + + Ws = case proplists:get_bool(bin_opt_info, Opts) of + true -> collect_opt_info(Fs); + false -> [] + end, + + {ok, Module#b_module{body=Fs}, Ws}. + +-type module_info() :: #{ func_id() => func_info() }. + +-type func_id() :: {Name :: atom(), Arity :: non_neg_integer()}. + +-type func_info() :: #{ has_bsm_ops => boolean(), + parameters => [#b_var{}], + parameter_info => #{ #b_var{} => param_info() } }. + +-type param_info() :: suitable_for_reuse | + {Problem :: atom(), Where :: term()}. + +-spec analyze_module(#b_module{}) -> module_info(). + +analyze_module(#b_module{body=Fs}) -> + foldl(fun(#b_function{args=Parameters}=F, I) -> + FuncInfo = #{ has_bsm_ops => has_bsm_ops(F), + parameters => Parameters, + parameter_info => #{} }, + FuncId = get_fa(F), + I#{ FuncId => FuncInfo } + end, #{}, Fs). + +has_bsm_ops(#b_function{bs=Blocks}) -> + hbo_blocks(maps:to_list(Blocks)). + +hbo_blocks([{_,#b_blk{is=Is}} | Blocks]) -> + case hbo_is(Is) of + false -> hbo_blocks(Blocks); + true -> true + end; +hbo_blocks([]) -> + false. + +hbo_is([#b_set{op=bs_start_match} | _]) -> true; +hbo_is([_I | Is]) -> hbo_is(Is); +hbo_is([]) -> false. + +%% Checks whether it's legal to make a call with the given argument as a match +%% context, returning the param_info() of the relevant parameter. +-spec check_context_call(#b_set{}, Arg, CtxChain, ModInfo) -> param_info() when + Arg :: #b_var{}, + CtxChain :: [#b_var{}], + ModInfo :: module_info(). +check_context_call(#b_set{args=Args}, Arg, CtxChain, ModInfo) -> + Aliases = [Arg | CtxChain], + ccc_1(Args, Arg, Aliases, ModInfo). + +ccc_1([#b_local{}=Call | Args], Ctx, Aliases, ModInfo) -> + %% Matching operations assume that their context isn't aliased (as in + %% pointer aliasing), so we must reject calls whose arguments contain more + %% than one reference to the context. + %% + %% TODO: Try to fall back to passing binaries in these cases. Partial reuse + %% is better than nothing. + UseCount = foldl(fun(Arg, C) -> + case member(Arg, Aliases) of + true -> C + 1; + false -> C + end + end, 0, Args), + if + UseCount =:= 1 -> + #b_local{name=#b_literal{val=Name},arity=Arity} = Call, + Callee = {Name, Arity}, + + ParamInfo = funcinfo_get(Callee, parameter_info, ModInfo), + Parameters = funcinfo_get(Callee, parameters, ModInfo), + Parameter = nth(1 + arg_index(Ctx, Args), Parameters), + + case maps:find(Parameter, ParamInfo) of + {ok, suitable_for_reuse} -> + suitable_for_reuse; + {ok, Other} -> + {unsuitable_call, {Call, Other}}; + error -> + {no_match_on_entry, Call} + end; + UseCount > 1 -> + {multiple_uses_in_call, Call} + end; +ccc_1([#b_remote{}=Call | _Args], _Ctx, _CtxChain, _ModInfo) -> + {remote_call, Call}; +ccc_1([Fun | _Args], _Ctx, _CtxChain, _ModInfo) -> + %% TODO: It may be possible to support this in the future for locally + %% defined funs, including ones with free variables. + {fun_call, Fun}. + +%% Returns the index of Var in Args. +arg_index(Var, Args) -> arg_index_1(Var, Args, 0). + +arg_index_1(Var, [Var | _Args], Index) -> Index; +arg_index_1(Var, [_Arg | Args], Index) -> arg_index_1(Var, Args, Index + 1). + +is_tail_binary(#b_set{op=bs_match,args=[#b_literal{val=binary} | Rest]}) -> + member(#b_literal{val=all}, Rest); +is_tail_binary(#b_set{op=bs_get_tail}) -> + true; +is_tail_binary(_) -> + false. + +is_tail_binary(#b_var{}=Var, Defs) -> + case find_match_definition(Var, Defs) of + {ok, Def} -> is_tail_binary(Def); + _ -> false + end; +is_tail_binary(_Literal, _Defs) -> + false. + +assert_match_context(#b_var{}=Var, Defs) -> + case maps:find(Var, Defs) of + {ok, #b_set{op=bs_match,args=[_,#b_var{}=Ctx|_]}} -> + assert_match_context(Ctx, Defs); + {ok, #b_set{op=bs_start_match}} -> + ok + end. + +find_match_definition(#b_var{}=Var, Defs) -> + case maps:find(Var, Defs) of + {ok, #b_set{op=bs_extract,args=[Ctx]}} -> maps:find(Ctx, Defs); + {ok, #b_set{op=bs_get_tail}=Def} -> {ok, Def}; + _ -> error + end. + +%% Returns a list of all contexts that were used to extract Var. +context_chain_of(#b_var{}=Var, Defs) -> + case maps:find(Var, Defs) of + {ok, #b_set{op=bs_match,args=[_,#b_var{}=Ctx|_]}} -> + [Ctx | context_chain_of(Ctx, Defs)]; + {ok, #b_set{op=bs_get_tail,args=[Ctx]}} -> + [Ctx | context_chain_of(Ctx, Defs)]; + {ok, #b_set{op=bs_extract,args=[Ctx]}} -> + [Ctx | context_chain_of(Ctx, Defs)]; + _ -> + [] + end. + +%% Grabs the match context used to produce the given variable. +match_context_of(#b_var{}=Var, Defs) -> + Ctx = match_context_of_1(Var, Defs), + assert_match_context(Ctx, Defs), + Ctx. + +match_context_of_1(Var, Defs) -> + case maps:get(Var, Defs) of + #b_set{op=bs_extract,args=[#b_var{}=Ctx0]} -> + #b_set{op=bs_match, + args=[_,#b_var{}=Ctx|_]} = maps:get(Ctx0, Defs), + Ctx; + #b_set{op=bs_get_tail,args=[#b_var{}=Ctx]} -> + Ctx + end. + +funcinfo_get(#b_function{}=F, Attribute, ModInfo) -> + funcinfo_get(get_fa(F), Attribute, ModInfo); +funcinfo_get({_,_}=Key, Attribute, ModInfo) -> + FuncInfo = maps:get(Key, ModInfo), + maps:get(Attribute, FuncInfo). + +funcinfo_set(#b_function{}=F, Attribute, Value, ModInfo) -> + funcinfo_set(get_fa(F), Attribute, Value, ModInfo); +funcinfo_set(Key, Attribute, Value, ModInfo) -> + FuncInfo = maps:put(Attribute, Value, maps:get(Key, ModInfo, #{})), + maps:put(Key, FuncInfo, ModInfo). + +get_fa(#b_function{ anno = Anno }) -> + {_,Name,Arity} = maps:get(func_info, Anno), + {Name,Arity}. + +%% Replaces matched-out binaries with aliases that are lazily converted to +%% binary form when used, allowing us to keep the "match path" free of binary +%% creation. + +-spec alias_matched_binaries(Blocks, Counter, AliasMap) -> Result when + Blocks :: beam_ssa:block_map(), + Counter :: non_neg_integer(), + AliasMap :: match_alias_map(), + Result :: {Blocks, Counter}. + +-type match_alias_map() :: + #{ Binary :: #b_var{} => + { %% Replace all uses of Binary with an alias after this + %% label. + AliasAfter :: beam_ssa:label(), + %% The match context whose tail is equal to Binary. + Context :: #b_var{} } }. + +%% Keeps track of the promotions we need to insert. They're partially keyed by +%% location because they may not be valid on all execution paths and we may +%% need to add redundant promotions in some cases. +-type promotion_map() :: + #{ { PromoteAt :: beam_ssa:label(), + Variable :: #b_var{} } => + Instruction :: #b_set{} }. + +-record(amb, { dominators :: beam_ssa:dominator_map(), + match_aliases :: match_alias_map(), + cnt :: non_neg_integer(), + promotions = #{} :: promotion_map() }). + +alias_matched_binaries(Blocks0, Counter, AliasMap) when AliasMap =/= #{} -> + {Dominators, _} = beam_ssa:dominators(Blocks0), + State0 = #amb{ dominators = Dominators, + match_aliases = AliasMap, + cnt = Counter }, + {Blocks, State} = beam_ssa:mapfold_blocks_rpo(fun amb_1/3, [0], State0, + Blocks0), + {amb_insert_promotions(Blocks, State), State#amb.cnt}; +alias_matched_binaries(Blocks, Counter, _AliasMap) -> + {Blocks, Counter}. + +amb_1(Lbl, #b_blk{is=Is0,last=Last0}=Block, State0) -> + {Is, State1} = mapfoldl(fun(I, State) -> + amb_assign_set(I, Lbl, State) + end, State0, Is0), + {Last, State} = amb_assign_last(Last0, Lbl, State1), + {Block#b_blk{is=Is,last=Last}, State}. + +amb_assign_set(#b_set{op=phi,args=Args0}=I, _Lbl, State0) -> + %% Phi node aliases are relative to their source block, not their + %% containing block. + {Args, State} = + mapfoldl(fun({Arg0, Lbl}, Acc) -> + {Arg, State} = amb_get_alias(Arg0, Lbl, Acc), + {{Arg, Lbl}, State} + end, State0, Args0), + {I#b_set{args=Args}, State}; +amb_assign_set(#b_set{args=Args0}=I, Lbl, State0) -> + {Args, State} = mapfoldl(fun(Arg0, Acc) -> + amb_get_alias(Arg0, Lbl, Acc) + end, State0, Args0), + {I#b_set{args=Args}, State}. + +amb_assign_last(#b_ret{arg=Arg0}=T, Lbl, State0) -> + {Arg, State} = amb_get_alias(Arg0, Lbl, State0), + {T#b_ret{arg=Arg}, State}; +amb_assign_last(#b_switch{arg=Arg0}=T, Lbl, State0) -> + {Arg, State} = amb_get_alias(Arg0, Lbl, State0), + {T#b_switch{arg=Arg}, State}; +amb_assign_last(#b_br{bool=Arg0}=T, Lbl, State0) -> + {Arg, State} = amb_get_alias(Arg0, Lbl, State0), + {T#b_br{bool=Arg}, State}. + +amb_get_alias(#b_var{}=Arg, Lbl, State) -> + case maps:find(Arg, State#amb.match_aliases) of + {ok, {AliasAfter, Context}} -> + %% Our context may not have been created yet, so we skip assigning + %% an alias unless the given block is among our dominators. + Dominators = maps:get(Lbl, State#amb.dominators), + case member(AliasAfter, Dominators) of + true -> amb_create_alias(Arg, Context, Lbl, State); + false -> {Arg, State} + end; + error -> + {Arg, State} + end; +amb_get_alias(#b_remote{mod=Mod0,name=Name0}=Arg0, Lbl, State0) -> + {Mod, State1} = amb_get_alias(Mod0, Lbl, State0), + {Name, State} = amb_get_alias(Name0, Lbl, State1), + Arg = Arg0#b_remote{mod=Mod,name=Name}, + {Arg, State}; +amb_get_alias(Arg, _Lbl, State) -> + {Arg, State}. + +amb_create_alias(#b_var{}=Arg0, Context, Lbl, State0) -> + Dominators = maps:get(Lbl, State0#amb.dominators), + Promotions0 = State0#amb.promotions, + + PrevPromotions = + [maps:get({Dom, Arg0}, Promotions0) + || Dom <- Dominators, is_map_key({Dom, Arg0}, Promotions0)], + + case PrevPromotions of + [_|_] -> + %% We've already created an alias prior to this block, so we'll + %% grab the most recent one to minimize stack use. + + #b_set{dst=Alias} = max(PrevPromotions), + {Alias, State0}; + [] -> + %% If we haven't created an alias we need to do so now. The + %% promotion will be inserted later by amb_insert_promotions/2. + + Counter = State0#amb.cnt, + Alias = #b_var{name={'@ssa_bsm_alias', Counter}}, + Promotion = #b_set{op=bs_get_tail,dst=Alias,args=[Context]}, + + Promotions = maps:put({Lbl, Arg0}, Promotion, Promotions0), + State = State0#amb{ promotions=Promotions, cnt=Counter+1 }, + + {Alias, State} + end. + +amb_insert_promotions(Blocks0, State) -> + F = fun({Lbl, #b_var{}}, Promotion, Blocks) -> + Block = maps:get(Lbl, Blocks), + + Alias = Promotion#b_set.dst, + {Before, After} = splitwith( + fun(#b_set{args=Args}) -> + not is_var_in_args(Alias, Args) + end, Block#b_blk.is), + Is = Before ++ [Promotion | After], + + maps:put(Lbl, Block#b_blk{is=Is}, Blocks) + end, + maps:fold(F, Blocks0, State#amb.promotions). + +is_var_in_args(Var, [Var | _]) -> true; +is_var_in_args(Var, [#b_remote{name=Var} | _]) -> true; +is_var_in_args(Var, [#b_remote{mod=Var} | _]) -> true; +is_var_in_args(Var, [_ | Args]) -> is_var_in_args(Var, Args); +is_var_in_args(_Var, []) -> false. + +%%% +%%% Subpasses +%%% + +%% Removes superflous chained bs_start_match instructions in the same +%% function. When matching on an extracted tail binary, or on a binary we've +%% already matched on, we reuse the original match context. +%% +%% This pass runs first since it makes subsequent optimizations more effective +%% by removing spots where promotion would be required. + +-type prior_match_map() :: + #{ Binary :: #b_var{} => + [{ %% The context and success label of a previous + %% bs_start_match made on this binary. + ValidAfter :: beam_ssa:label(), + Context :: #b_var{} }] }. + +-record(cm, { definitions :: beam_ssa:definition_map(), + dominators :: beam_ssa:dominator_map(), + blocks :: beam_ssa:block_map(), + match_aliases = #{} :: match_alias_map(), + prior_matches = #{} :: prior_match_map(), + renames = #{} :: beam_ssa:rename_map() }). + +combine_matches({Fs0, ModInfo}) -> + Fs = map(fun(F) -> combine_matches(F, ModInfo) end, Fs0), + {Fs, ModInfo}. + +combine_matches(#b_function{bs=Blocks0,cnt=Counter0}=F, ModInfo) -> + case funcinfo_get(F, has_bsm_ops, ModInfo) of + true -> + {Dominators, _} = beam_ssa:dominators(Blocks0), + {Blocks1, State} = + beam_ssa:mapfold_blocks_rpo( + fun(Lbl, #b_blk{is=Is0}=Block0, State0) -> + {Is, State} = cm_1(Is0, [], Lbl, State0), + {Block0#b_blk{is=Is}, State} + end, [0], + #cm{ definitions = beam_ssa:definitions(Blocks0), + dominators = Dominators, + blocks = Blocks0 }, + Blocks0), + + Blocks2 = beam_ssa:rename_vars(State#cm.renames, [0], Blocks1), + + {Blocks, Counter} = alias_matched_binaries(Blocks2, Counter0, + State#cm.match_aliases), + + F#b_function{ bs=Blocks, cnt=Counter }; + false -> + F + end. + +cm_1([#b_set{ op=bs_start_match, + dst=Ctx, + args=[Src] }, + #b_set{ op=succeeded, + dst=Bool, + args=[Ctx] }]=MatchSeq, Acc0, Lbl, State0) -> + Acc = reverse(Acc0), + case is_tail_binary(Src, State0#cm.definitions) of + true -> cm_combine_tail(Src, Ctx, Bool, Acc, State0); + false -> cm_handle_priors(Src, Ctx, Bool, Acc, MatchSeq, Lbl, State0) + end; +cm_1([I | Is], Acc, Lbl, State) -> + cm_1(Is, [I | Acc], Lbl, State); +cm_1([], Acc, _Lbl, State) -> + {reverse(Acc), State}. + +%% If we're dominated by at least one match on the same source, we can reuse +%% the context created by that match. +cm_handle_priors(Src, DstCtx, Bool, Acc, MatchSeq, Lbl, State0) -> + PriorCtxs = case maps:find(Src, State0#cm.prior_matches) of + {ok, Priors} -> + %% We've seen other match contexts on this source, but + %% we can only consider the ones whose success path + %% dominate us. + Dominators = maps:get(Lbl, State0#cm.dominators, []), + [Ctx || {ValidAfter, Ctx} <- Priors, + member(ValidAfter, Dominators)]; + error -> + [] + end, + case PriorCtxs of + [Ctx|_] -> + Renames0 = State0#cm.renames, + Renames = Renames0#{ Bool => #b_literal{val=true}, DstCtx => Ctx }, + {Acc, State0#cm{ renames = Renames }}; + [] -> + %% Since we lack a prior match, we need to register this one in + %% case we dominate another. + State = cm_register_prior(Src, DstCtx, Lbl, State0), + {Acc ++ MatchSeq, State} + end. + +cm_register_prior(Src, DstCtx, Lbl, State) -> + Block = maps:get(Lbl, State#cm.blocks), + #b_br{succ=ValidAfter} = Block#b_blk.last, + + Priors0 = maps:get(Src, State#cm.prior_matches, []), + Priors = [{ValidAfter, DstCtx} | Priors0], + + PriorMatches = maps:put(Src, Priors, State#cm.prior_matches), + State#cm{ prior_matches = PriorMatches }. + +cm_combine_tail(Src, DstCtx, Bool, Acc, State0) -> + SrcCtx = match_context_of(Src, State0#cm.definitions), + + %% We replace the source with a context alias as it normally won't be used + %% on the happy path after being matched, and the added cost of conversion + %% is negligible if it is. + Aliases = maps:put(Src, {0, SrcCtx}, State0#cm.match_aliases), + + Renames0 = State0#cm.renames, + Renames = Renames0#{ Bool => #b_literal{val=true}, DstCtx => SrcCtx }, + + State = State0#cm{ match_aliases = Aliases, renames = Renames }, + + {Acc, State}. + +%% Lets functions accept match contexts as arguments. The parameter must be +%% unused before the bs_start_match instruction, and it must be matched in the +%% first block. + +-record(aca, { unused_parameters :: ordsets:ordset(#b_var{}), + counter :: non_neg_integer(), + parameter_info = #{} :: #{ #b_var{} => param_info() }, + match_aliases = #{} :: match_alias_map() }). + +accept_context_args({Fs, ModInfo}) -> + mapfoldl(fun accept_context_args/2, ModInfo, Fs). + +accept_context_args(#b_function{bs=Blocks0}=F, ModInfo0) -> + case funcinfo_get(F, has_bsm_ops, ModInfo0) of + true -> + Parameters = ordsets:from_list(funcinfo_get(F, parameters, ModInfo0)), + State0 = #aca{ unused_parameters = Parameters, + counter = F#b_function.cnt }, + + {Blocks1, State} = aca_1(Blocks0, State0), + {Blocks, Counter} = alias_matched_binaries(Blocks1, + State#aca.counter, + State#aca.match_aliases), + + ModInfo = funcinfo_set(F, parameter_info, State#aca.parameter_info, + ModInfo0), + + {F#b_function{bs=Blocks,cnt=Counter}, ModInfo}; + false -> + {F, ModInfo0} + end. + +aca_1(Blocks, State) -> + %% We only handle block 0 as we don't yet support starting a match after a + %% test. This is generally good enough as the sys_core_bsm pass makes the + %% match instruction come first if possible, and it's rare for a function + %% to binary-match several parameters at once. + EntryBlock = maps:get(0, Blocks), + aca_enable_reuse(EntryBlock#b_blk.is, EntryBlock, Blocks, [], State). + +aca_enable_reuse([#b_set{op=bs_start_match,args=[Src]}=I0 | Rest], + EntryBlock, Blocks0, Acc, State0) -> + case aca_is_reuse_safe(Src, State0) of + true -> + {I, Last, Blocks1, State} = + aca_reuse_context(I0, EntryBlock, Blocks0, State0), + + Is = reverse([I|Acc]) ++ Rest, + Blocks = maps:put(0, EntryBlock#b_blk{is=Is,last=Last}, Blocks1), + + {Blocks, State}; + false -> + {Blocks0, State0} + end; +aca_enable_reuse([I | Is], EntryBlock, Blocks, Acc, State0) -> + UnusedParams0 = State0#aca.unused_parameters, + case ordsets:intersection(UnusedParams0, beam_ssa:used(I)) of + [] -> + aca_enable_reuse(Is, EntryBlock, Blocks, [I | Acc], State0); + PrematureUses -> + UnusedParams = ordsets:subtract(UnusedParams0, PrematureUses), + + %% Mark the offending parameters as unsuitable for context reuse. + ParamInfo = foldl(fun(A, Ps) -> + maps:put(A, {used_before_match, I}, Ps) + end, State0#aca.parameter_info, PrematureUses), + + State = State0#aca{ unused_parameters = UnusedParams, + parameter_info = ParamInfo }, + aca_enable_reuse(Is, EntryBlock, Blocks, [I | Acc], State) + end; +aca_enable_reuse([], _EntryBlock, Blocks, _Acc, State) -> + {Blocks, State}. + +aca_is_reuse_safe(Src, State) -> + %% Context reuse is unsafe unless all uses are dominated by the start_match + %% instruction. Since we only process block 0 it's enough to check if + %% they're unused so far. + ordsets:is_element(Src, State#aca.unused_parameters). + +aca_reuse_context(#b_set{dst=Dst, args=[Src]}=I0, Block, Blocks0, State0) -> + %% When matching fails on a reused context it needs to be converted back + %% to a binary. We only need to do this on the success path since it can't + %% be a context on the type failure path, but it's very common for these + %% to converge which requires special handling. + {State1, Last, Blocks} = + aca_handle_convergence(Src, State0, Block#b_blk.last, Blocks0), + + Aliases = maps:put(Src, {Last#b_br.succ, Dst}, State1#aca.match_aliases), + ParamInfo = maps:put(Src, suitable_for_reuse, State1#aca.parameter_info), + + State = State1#aca{ match_aliases = Aliases, + parameter_info = ParamInfo }, + + I = beam_ssa:add_anno(accepts_match_contexts, true, I0), + + {I, Last, Blocks, State}. + +aca_handle_convergence(Src, State0, Last0, Blocks0) -> + #b_br{fail=Fail0,succ=Succ0} = Last0, + + SuccPath = beam_ssa:rpo([Succ0], Blocks0), + FailPath = beam_ssa:rpo([Fail0], Blocks0), + + %% The promotion logic in alias_matched_binaries breaks down if the source + %% is used after the fail/success paths converge, as we have no way to tell + %% whether the source is a match context or something else past that point. + %% + %% We could handle this through clever insertion of phi nodes but it's + %% far simpler to copy either branch in its entirety. It doesn't matter + %% which one as long as they become disjoint. + ConvergedPaths = ordsets:intersection( + ordsets:from_list(SuccPath), + ordsets:from_list(FailPath)), + + case maps:is_key(Src, beam_ssa:uses(ConvergedPaths, Blocks0)) of + true -> + case shortest(SuccPath, FailPath) of + left -> + {Succ, Blocks, Counter} = + aca_copy_successors(Succ0, Blocks0, State0#aca.counter), + State = State0#aca{ counter = Counter }, + {State, Last0#b_br{succ=Succ}, Blocks}; + right -> + {Fail, Blocks, Counter} = + aca_copy_successors(Fail0, Blocks0, State0#aca.counter), + State = State0#aca{ counter = Counter }, + {State, Last0#b_br{fail=Fail}, Blocks} + end; + false -> + {State0, Last0, Blocks0} + end. + +shortest([_|As], [_|Bs]) -> shortest(As, Bs); +shortest([], _) -> left; +shortest(_, []) -> right. + +%% Copies all successor blocks of Lbl, returning the label to the entry block +%% of this copy. Since the copied blocks aren't referenced anywhere else, they +%% are all guaranteed to be dominated by Lbl. +aca_copy_successors(Lbl0, Blocks0, Counter0) -> + %% Building the block rename map up front greatly simplifies phi node + %% handling. + Path = beam_ssa:rpo([Lbl0], Blocks0), + {BRs, Counter1} = aca_cs_build_brs(Path, Counter0, #{}), + {Blocks, Counter} = aca_cs_1(Path, Blocks0, Counter1, #{}, BRs, #{}), + Lbl = maps:get(Lbl0, BRs), + {Lbl, Blocks, Counter}. + +aca_cs_build_brs([?BADARG_BLOCK=Lbl | Path], Counter, Acc) -> + %% ?BADARG_BLOCK is a marker and not an actual block, so renaming it will + %% break exception handling. + aca_cs_build_brs(Path, Counter, Acc#{ Lbl => Lbl }); +aca_cs_build_brs([Lbl | Path], Counter0, Acc) -> + aca_cs_build_brs(Path, Counter0 + 1, Acc#{ Lbl => Counter0 }); +aca_cs_build_brs([], Counter, Acc) -> + {Acc, Counter}. + +aca_cs_1([Lbl0 | Path], Blocks, Counter0, VRs0, BRs, Acc0) -> + Block0 = maps:get(Lbl0, Blocks), + Lbl = maps:get(Lbl0, BRs), + {VRs, Block, Counter} = aca_cs_block(Block0, Counter0, VRs0, BRs), + Acc = maps:put(Lbl, Block, Acc0), + aca_cs_1(Path, Blocks, Counter, VRs, BRs, Acc); +aca_cs_1([], Blocks, Counter, _VRs, _BRs, Acc) -> + {maps:merge(Blocks, Acc), Counter}. + +aca_cs_block(#b_blk{is=Is0,last=Last0}=Block0, Counter0, VRs0, BRs) -> + {VRs, Is, Counter} = aca_cs_is(Is0, Counter0, VRs0, BRs, []), + Last = aca_cs_last(Last0, VRs, BRs), + Block = Block0#b_blk{is=Is,last=Last}, + {VRs, Block, Counter}. + +aca_cs_is([#b_set{op=Op, + dst=Dst0, + args=Args0}=I0 | Is], + Counter0, VRs0, BRs, Acc) -> + Args = case Op of + phi -> aca_cs_args_phi(Args0, VRs0, BRs); + _ -> aca_cs_args(Args0, VRs0) + end, + Counter = Counter0 + 1, + Dst = #b_var{name={'@ssa_bsm_aca',Counter}}, + I = I0#b_set{dst=Dst,args=Args}, + VRs = maps:put(Dst0, Dst, VRs0), + aca_cs_is(Is, Counter, VRs, BRs, [I | Acc]); +aca_cs_is([], Counter, VRs, _BRs, Acc) -> + {VRs, reverse(Acc), Counter}. + +aca_cs_last(#b_switch{arg=Arg0,list=Switch0,fail=Fail0}=Sw, VRs, BRs) -> + Switch = [{Literal, maps:get(Lbl, BRs)} || {Literal, Lbl} <- Switch0], + Sw#b_switch{arg=aca_cs_arg(Arg0, VRs), + fail=maps:get(Fail0, BRs), + list=Switch}; +aca_cs_last(#b_br{bool=Arg0,succ=Succ0,fail=Fail0}=Br, VRs, BRs) -> + Br#b_br{bool=aca_cs_arg(Arg0, VRs), + succ=maps:get(Succ0, BRs), + fail=maps:get(Fail0, BRs)}; +aca_cs_last(#b_ret{arg=Arg0}=Ret, VRs, _BRs) -> + Ret#b_ret{arg=aca_cs_arg(Arg0, VRs)}. + +aca_cs_args_phi([{Arg, Lbl} | Args], VRs, BRs) -> + case BRs of + #{ Lbl := New } -> + [{aca_cs_arg(Arg, VRs), New} | aca_cs_args_phi(Args, VRs, BRs)]; + #{} -> + aca_cs_args_phi(Args, VRs, BRs) + end; +aca_cs_args_phi([], _VRs, _BRs) -> + []. + +aca_cs_args([Arg | Args], VRs) -> + [aca_cs_arg(Arg, VRs) | aca_cs_args(Args, VRs)]; +aca_cs_args([], _VRs) -> + []. + +aca_cs_arg(#b_remote{mod=Mod0,name=Name0}=Rem, VRs) -> + Mod = aca_cs_arg(Mod0, VRs), + Name = aca_cs_arg(Name0, VRs), + Rem#b_remote{mod=Mod,name=Name}; +aca_cs_arg(Arg, VRs) -> + case VRs of + #{ Arg := New } -> New; + #{} -> Arg + end. + +%% Allows contexts to pass through "wrapper functions" where the context is +%% passed directly to a function that accepts match contexts (including other +%% wrappers). +%% +%% This does not alter the function in any way, it only changes parameter info +%% so that skip_outgoing_tail_extraction is aware that it's safe to pass +%% contexts to us. + +allow_context_passthrough({Fs, ModInfo0}) -> + ModInfo = + acp_forward_params([{F, beam_ssa:uses(F#b_function.bs)} || F <- Fs], + ModInfo0), + {Fs, ModInfo}. + +acp_forward_params(FsUses, ModInfo0) -> + F = fun({#b_function{args=Parameters}=Func, UseMap}, ModInfo) -> + ParamInfo = + foldl(fun(Param, ParamInfo) -> + Uses = maps:get(Param, UseMap, []), + acp_1(Param, Uses, ModInfo, ParamInfo) + end, + funcinfo_get(Func, parameter_info, ModInfo), + Parameters), + funcinfo_set(Func, parameter_info, ParamInfo, ModInfo) + end, + %% Allowing context passthrough on one function may make it possible to + %% enable it on another, so it needs to be repeated for maximum effect. + case foldl(F, ModInfo0, FsUses) of + ModInfo0 -> ModInfo0; + Changed -> acp_forward_params(FsUses, Changed) + end. + +%% We have no way to know if an argument is a context, so it's only safe to +%% forward them if they're passed exactly once in the first block. Any other +%% uses are unsafe, including function_clause errors. +acp_1(Param, [{0, #b_set{op=call}=I}], ModInfo, ParamInfo) -> + %% We don't need to provide a context chain as our callers make sure that + %% multiple arguments never reference the same context. + case check_context_call(I, Param, [], ModInfo) of + {no_match_on_entry, _} -> ParamInfo; + Other -> maps:put(Param, Other, ParamInfo) + end; +acp_1(_Param, _Uses, _ModInfo, ParamInfo) -> + ParamInfo. + +%% This is conceptually similar to combine_matches but operates across +%% functions. Whenever a tail binary is passed to a parameter that accepts +%% match contexts we'll pass the context instead, improving performance by +%% avoiding the creation of a new match context in the callee. +%% +%% We also create an alias to delay extraction until it's needed as an actual +%% binary, which is often rare on the happy path. The cost of being wrong is +%% negligible (`bs_test_unit + bs_get_tail` vs `bs_get_binary`) so we're +%% applying it unconditionally to keep things simple. + +-record(sote, { definitions :: beam_ssa:definition_map(), + mod_info :: module_info(), + match_aliases = #{} :: match_alias_map() }). + +skip_outgoing_tail_extraction({Fs0, ModInfo}) -> + Fs = map(fun(F) -> skip_outgoing_tail_extraction(F, ModInfo) end, Fs0), + {Fs, ModInfo}. + +skip_outgoing_tail_extraction(#b_function{bs=Blocks0}=F, ModInfo) -> + case funcinfo_get(F, has_bsm_ops, ModInfo) of + true -> + State0 = #sote{ definitions = beam_ssa:definitions(Blocks0), + mod_info = ModInfo }, + + {Blocks1, State} = beam_ssa:mapfold_instrs_rpo( + fun sote_rewrite_calls/2, [0], State0, Blocks0), + + {Blocks, Counter} = alias_matched_binaries(Blocks1, + F#b_function.cnt, + State#sote.match_aliases), + + F#b_function{bs=Blocks,cnt=Counter}; + false -> + F + end. + +sote_rewrite_calls(#b_set{op=call,args=Args}=Call, State) -> + sote_rewrite_call(Call, Args, [], State); +sote_rewrite_calls(I, State) -> + {I, State}. + +sote_rewrite_call(Call, [], ArgsOut, State) -> + {Call#b_set{args=reverse(ArgsOut)}, State}; +sote_rewrite_call(Call0, [Arg | ArgsIn], ArgsOut, State0) -> + case is_tail_binary(Arg, State0#sote.definitions) of + true -> + CtxChain = context_chain_of(Arg, State0#sote.definitions), + case check_context_call(Call0, Arg, CtxChain, State0#sote.mod_info) of + suitable_for_reuse -> + Ctx = match_context_of(Arg, State0#sote.definitions), + + MatchAliases0 = State0#sote.match_aliases, + MatchAliases = maps:put(Arg, {0, Ctx}, MatchAliases0), + State = State0#sote{ match_aliases = MatchAliases }, + + Call = beam_ssa:add_anno(bsm_info, context_reused, Call0), + sote_rewrite_call(Call, ArgsIn, [Ctx | ArgsOut], State); + Other -> + Call = beam_ssa:add_anno(bsm_info, Other, Call0), + sote_rewrite_call(Call, ArgsIn, [Arg | ArgsOut], State0) + end; + false -> + sote_rewrite_call(Call0, ArgsIn, [Arg | ArgsOut], State0) + end. + +%% Adds parameter_type_info annotations to help the validator determine whether +%% our optimizations were safe. + +annotate_context_parameters({Fs, ModInfo}) -> + mapfoldl(fun annotate_context_parameters/2, ModInfo, Fs). + +annotate_context_parameters(F, ModInfo) -> + ParamInfo = funcinfo_get(F, parameter_info, ModInfo), + TypeAnno0 = beam_ssa:get_anno(parameter_type_info, F, #{}), + TypeAnno = maps:fold(fun(K, _V, Acc) when is_map_key(K, Acc) -> + %% Assertion. + error(conflicting_parameter_types); + (K, suitable_for_reuse, Acc) -> + T = beam_validator:type_anno(match_context), + Acc#{ K => T }; + (_K, _V, Acc) -> + Acc + end, TypeAnno0, ParamInfo), + {beam_ssa:add_anno(parameter_type_info, TypeAnno, F), ModInfo}. + +%%% +%%% +bin_opt_info +%%% + +collect_opt_info(Fs) -> + foldl(fun(#b_function{bs=Blocks}=F, Acc0) -> + UseMap = beam_ssa:uses(Blocks), + Where = beam_ssa:get_anno(location, F, []), + beam_ssa:fold_instrs_rpo( + fun(I, Acc) -> + collect_opt_info_1(I, Where, UseMap, Acc) + end, [0], Acc0, Blocks) + end, [], Fs). + +collect_opt_info_1(#b_set{op=Op,anno=Anno,dst=Dst}=I, Where, UseMap, Acc0) -> + case is_tail_binary(I) of + true when Op =:= bs_match -> + %% The uses include when the context is passed raw, so we discard + %% everything but the bs_extract instruction to limit warnings to + %% unoptimized uses. + Uses0 = maps:get(Dst, UseMap, []), + case [E || {_, #b_set{op=bs_extract}=E} <- Uses0] of + [Use] -> add_unopt_binary_info(Use, false, Where, UseMap, Acc0); + [] -> Acc0 + end; + true -> + %% Add a warning for each use. Note that we don't do anything + %% special if unused as a later pass will remove this instruction + %% anyway. + Uses = maps:get(Dst, UseMap, []), + foldl(fun({_Lbl, Use}, Acc) -> + add_unopt_binary_info(Use, false, Where, UseMap, Acc) + end, Acc0, Uses); + false -> + add_opt_info(Anno, Where, Acc0) + end; +collect_opt_info_1(#b_ret{anno=Anno}, Where, _UseMap, Acc) -> + add_opt_info(Anno, Where, Acc); +collect_opt_info_1(_I, _Where, _Uses, Acc) -> + Acc. + +add_opt_info(Anno, Where, Acc) -> + case maps:find(bsm_info, Anno) of + {ok, Term} -> [make_warning(Term, Anno, Where) | Acc]; + error -> Acc + end. + +%% When an alias is promoted we need to figure out where it goes to ignore +%% warnings for compiler-generated things, and provide more useful warnings in +%% general. +%% +%% We track whether the binary has been used to build another term because it +%% can be helpful when there's no line information. + +add_unopt_binary_info(#b_set{op=Follow,dst=Dst}, _Nested, Where, UseMap, Acc0) + when Follow =:= put_tuple; + Follow =:= put_list; + Follow =:= put_map -> + %% Term-building instructions. + {_, Uses} = unzip(maps:get(Dst, UseMap, [])), + foldl(fun(Use, Acc) -> + add_unopt_binary_info(Use, true, Where, UseMap, Acc) + end, Acc0, Uses); +add_unopt_binary_info(#b_set{op=Follow,dst=Dst}, Nested, Where, UseMap, Acc0) + when Follow =:= bs_extract; + Follow =:= phi -> + %% Non-building instructions that need to be followed. + {_, Uses} = unzip(maps:get(Dst, UseMap, [])), + foldl(fun(Use, Acc) -> + add_unopt_binary_info(Use, Nested, Where, UseMap, Acc) + end, Acc0, Uses); +add_unopt_binary_info(#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}} | + _Ignored]}, + _Nested, _Where, _UseMap, Acc) -> + %% There's no nice way to tell compiler-generated exceptions apart from + %% user ones so we ignore them all. I doubt anyone cares. + Acc; +add_unopt_binary_info(#b_switch{anno=Anno}=I, Nested, Where, _UseMap, Acc) -> + [make_promotion_warning(I, Nested, Anno, Where) | Acc]; +add_unopt_binary_info(#b_set{anno=Anno}=I, Nested, Where, _UseMap, Acc) -> + [make_promotion_warning(I, Nested, Anno, Where) | Acc]; +add_unopt_binary_info(#b_ret{anno=Anno}=I, Nested, Where, _UseMap, Acc) -> + [make_promotion_warning(I, Nested, Anno, Where) | Acc]; +add_unopt_binary_info(#b_br{anno=Anno}=I, Nested, Where, _UseMap, Acc) -> + [make_promotion_warning(I, Nested, Anno, Where) | Acc]. + +make_promotion_warning(I, Nested, Anno, Where) -> + make_warning({binary_created, I, Nested}, Anno, Where). + +make_warning(Term, Anno, Where) -> + {File, Line} = maps:get(location, Anno, Where), + {File,[{Line,?MODULE,Term}]}. + +format_opt_info(context_reused) -> + "OPTIMIZED: match context reused"; +format_opt_info({binary_created, _, _}=Promotion) -> + io_lib:format("BINARY CREATED: ~s", [format_opt_info_1(Promotion)]); +format_opt_info(Other) -> + io_lib:format("NOT OPTIMIZED: ~s", [format_opt_info_1(Other)]). + +format_opt_info_1({binary_created, #b_set{op=call,args=[Call|_]}, false}) -> + io_lib:format("binary is used in call to ~s which doesn't support " + "context reuse", [format_call(Call)]); +format_opt_info_1({binary_created, #b_set{op=call,args=[Call|_]}, true}) -> + io_lib:format("binary is used in term passed to ~s", + [format_call(Call)]); +format_opt_info_1({binary_created, #b_set{op={bif, BIF},args=Args}, false}) -> + io_lib:format("binary is used in ~p/~p which doesn't support context " + "reuse", [BIF, length(Args)]); +format_opt_info_1({binary_created, #b_set{op={bif, BIF},args=Args}, true}) -> + io_lib:format("binary is used in term passed to ~p/~p", + [BIF, length(Args)]); +format_opt_info_1({binary_created, #b_set{op=Op}, false}) -> + io_lib:format("binary is used in '~p' which doesn't support context " + "reuse", [Op]); +format_opt_info_1({binary_created, #b_set{op=Op}, true}) -> + io_lib:format("binary is used in term passed to '~p'", [Op]); +format_opt_info_1({binary_created, #b_ret{}, false}) -> + io_lib:format("binary is returned from the function", []); +format_opt_info_1({binary_created, #b_ret{}, true}) -> + io_lib:format("binary is used in a term that is returned from the " + "function", []); +format_opt_info_1({unsuitable_call, {Call, Inner}}) -> + io_lib:format("binary used in call to ~s, where ~s", + [format_call(Call), format_opt_info_1(Inner)]); +format_opt_info_1({remote_call, Call}) -> + io_lib:format("binary is used in remote call to ~s", [format_call(Call)]); +format_opt_info_1({fun_call, Call}) -> + io_lib:format("binary is used in fun call (~s)", + [format_call(Call)]); +format_opt_info_1({multiple_uses_in_call, Call}) -> + io_lib:format("binary is passed as multiple arguments to ~s", + [format_call(Call)]); +format_opt_info_1({no_match_on_entry, Call}) -> + io_lib:format("binary is used in call to ~s which does not begin with a " + "suitable binary match", [format_call(Call)]); +format_opt_info_1({used_before_match, #b_set{op=call,args=[Call|_]}}) -> + io_lib:format("binary is used in call to ~s before being matched", + [format_call(Call)]); +format_opt_info_1({used_before_match, #b_set{op={bif, BIF},args=Args}}) -> + io_lib:format("binary is used in ~p/~p before being matched", + [BIF, length(Args)]); +format_opt_info_1({used_before_match, #b_set{op=phi}}) -> + io_lib:format("binary is returned from an expression before being " + "matched", []); +format_opt_info_1({used_before_match, #b_set{op=Op}}) -> + io_lib:format("binary is used in '~p' before being matched",[Op]); +format_opt_info_1(Term) -> + io_lib:format("~w", [Term]). + +format_call(#b_local{name=#b_literal{val=F},arity=A}) -> + io_lib:format("~p/~p", [F, A]); +format_call(#b_remote{mod=#b_literal{val=M},name=#b_literal{val=F},arity=A}) -> + io_lib:format("~p:~p/~p", [M, F, A]); +format_call(Fun) -> + io_lib:format("~p", [Fun]). diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl new file mode 100644 index 0000000000..08641e2abc --- /dev/null +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -0,0 +1,2098 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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: Generate BEAM assembly code from the SSA format. + +-module(beam_ssa_codegen). + +-export([module/2]). +-export([classify_heap_need/2]). %Called from beam_ssa_pre_codegen. + +-export_type([ssa_register/0]). + +-include("beam_ssa.hrl"). + +-import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3, + reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]). + +-record(cg, {lcount=1 :: beam_label(), %Label counter + functable=#{} :: #{fa()=>beam_label()}, + labels=#{} :: #{ssa_label()=>0|beam_label()}, + used_labels=gb_sets:empty() :: gb_sets:set(ssa_label()), + regs=#{} :: #{beam_ssa:var_name()=>ssa_register()}, + ultimate_fail=1 :: beam_label(), + catches=gb_sets:empty() :: gb_sets:set(ssa_label()) + }). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_asm:module_code()}. + +module(#b_module{name=Mod,exports=Es,attributes=Attrs,body=Fs}, _Opts) -> + {Asm,St} = functions(Fs, {atom,Mod}), + {ok,{Mod,Es,Attrs,Asm,St#cg.lcount}}. + +-record(need, {h=0 :: non_neg_integer(), + f=0 :: non_neg_integer()}). + +-record(cg_blk, {anno=#{} :: anno(), + is=[] :: [instruction()], + last :: terminator()}). + +-record(cg_set, {anno=#{} :: anno(), + dst :: b_var(), + op :: beam_ssa:op(), + args :: [beam_ssa:argument() | xreg()]}). + +-record(cg_alloc, {anno=#{} :: anno(), + stack=none :: 'none' | pos_integer(), + words=#need{} :: #need{}, + live :: 'undefined' | pos_integer(), + def_yregs=[] :: [yreg()] + }). + +-record(cg_br, {bool :: beam_ssa:value(), + succ :: ssa_label(), + fail :: ssa_label() + }). +-record(cg_ret, {arg :: cg_value(), + dealloc=none :: 'none' | pos_integer() + }). +-record(cg_switch, {arg :: cg_value(), + fail :: ssa_label(), + list :: [sw_list_item()] + }). + +-type fa() :: {beam_asm:function_name(),arity()}. +-type ssa_label() :: beam_ssa:label(). +-type beam_label() :: beam_asm:label(). + +-type anno() :: beam_ssa:anno(). + +-type b_var() :: beam_ssa:b_var(). +-type b_literal() :: beam_ssa:b_literal(). + +-type cg_value() :: beam_ssa:value() | xreg(). + +-type cg_set() :: #cg_set{}. +-type cg_alloc() :: #cg_alloc{}. + +-type instruction() :: cg_set() | cg_alloc(). + +-type cg_br() :: #cg_br{}. +-type cg_ret() :: #cg_ret{}. +-type cg_switch() :: #cg_switch{}. +-type terminator() :: cg_br() | cg_ret() | cg_switch(). + +-type sw_list_item() :: {b_literal(),ssa_label()}. + +-type reg_num() :: beam_asm:reg_num(). +-type xreg() :: {'x',reg_num()}. +-type yreg() :: {'y',reg_num()}. + +-type ssa_register() :: xreg() | yreg() | {'fr',reg_num()} | {'z',reg_num()}. + +functions(Forms, AtomMod) -> + mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, + #cg{lcount=1}, Forms). + +function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> + #{func_info:={_,Name,Arity}} = Anno, + try + assert_badarg_block(Blocks), %Assertion. + Regs = maps:get(registers, Anno), + St1 = St0#cg{labels=#{},used_labels=gb_sets:empty(), + regs=Regs}, + {Fi,St2} = new_label(St1), %FuncInfo label + {Entry,St3} = local_func_label(Name, Arity, St2), + {Ult,St4} = new_label(St3), %Ultimate failure + Labels = (St4#cg.labels)#{0=>Entry,?BADARG_BLOCK=>0}, + St5 = St4#cg{labels=Labels,used_labels=gb_sets:singleton(Entry), + ultimate_fail=Ult}, + {Body,St} = cg_fun(Blocks, St5), + Asm = [{label,Fi},line(Anno), + {func_info,AtomMod,{atom,Name},Arity}] ++ + add_parameter_annos(Body, Anno) ++ + [{label,Ult},if_end], + Func = {function,Name,Arity,Entry,Asm}, + {Func,St} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +assert_badarg_block(Blocks) -> + %% Assertion: ?BADARG_BLOCK must be the call erlang:error(badarg). + case Blocks of + #{?BADARG_BLOCK:=Blk} -> + #b_blk{is=[#b_set{op=call,dst=Ret, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=badarg}]}], + last=#b_ret{arg=Ret}} = Blk, + ok; + #{} -> + %% ?BADARG_BLOCK has been removed because it was never used. + ok + end. + +add_parameter_annos([{label, _}=Entry | Body], Anno) -> + ParamInfo = maps:get(parameter_type_info, Anno, #{}), + Annos = maps:fold( + fun(K, V, Acc) when is_map_key(K, ParamInfo) -> + TypeInfo = maps:get(K, ParamInfo), + [{'%', {type_info, V, TypeInfo}} | Acc]; + (_K, _V, Acc) -> + Acc + end, [], maps:get(registers, Anno)), + [Entry | sort(Annos)] ++ Body. + +cg_fun(Blocks, St0) -> + Linear0 = linearize(Blocks), + St = collect_catch_labels(Linear0, St0), + Linear1 = need_heap(Linear0), + Linear2 = prefer_xregs(Linear1, St), + Linear3 = liveness(Linear2, St), + Linear4 = defined(Linear3, St), + Linear = opt_allocate(Linear4, St), + cg_linear(Linear, St). + +%% collect_catch_labels(Linear, St) -> St. +%% Collect all catch labels (labels for blocks that begin +%% with 'landingpad' instructions) for later use. + +collect_catch_labels(Linear, St) -> + Labels = collect_catch_labels_1(Linear), + St#cg{catches=gb_sets:from_list(Labels)}. + +collect_catch_labels_1([{L,#cg_blk{is=[#cg_set{op=landingpad}|_]}}|Bs]) -> + [L|collect_catch_labels_1(Bs)]; +collect_catch_labels_1([_|Bs]) -> + collect_catch_labels_1(Bs); +collect_catch_labels_1([]) -> []. + +%% need_heap([{BlockLabel,Block]) -> [{BlockLabel,Block}]. +%% Insert need_heap instructions in the instruction list. Try to be smart and +%% collect them together as much as possible. + +need_heap(Bs0) -> + Bs1 = need_heap_allocs(Bs0, #{}), + {Bs,#need{h=0,f=0}} = need_heap_blks(reverse(Bs1), #need{}, []), + Bs. + +need_heap_allocs([{L,#cg_blk{is=Is0,last=Terminator}=Blk0}|Bs], Counts0) -> + Next = next_block(Bs), + Successors = successors(Terminator), + Counts = foldl(fun(S, Cnts) -> + case Cnts of + #{S:=C} -> Cnts#{S:=C+1}; + #{} when S =:= Next -> Cnts#{S=>1}; + #{} -> Cnts#{S=>42} + end + end, Counts0, Successors), + case Counts of + #{L:=1} -> + [{L,Blk0}|need_heap_allocs(Bs, Counts)]; + #{L:=_} -> + %% This block has multiple predecessors. Force an allocation + %% in this block so that the predecessors don't need to do + %% an allocation on behalf of this block. + Is = case need_heap_never(Is0) of + true -> Is0; + false -> [#cg_alloc{}|Is0] + end, + Blk = Blk0#cg_blk{is=Is}, + [{L,Blk}|need_heap_allocs(Bs, Counts)]; + #{} -> + [{L,Blk0}|need_heap_allocs(Bs, Counts)] + end; +need_heap_allocs([], _) -> []. + +need_heap_never([#cg_alloc{}|_]) -> true; +need_heap_never([#cg_set{op=recv_next}|_]) -> true; +need_heap_never([#cg_set{op=wait}|_]) -> true; +need_heap_never(_) -> false. + +need_heap_blks([{L,#cg_blk{is=Is0}=Blk0}|Bs], H0, Acc) -> + {Is1,H1} = need_heap_is(reverse(Is0), H0, []), + {Ns,H} = need_heap_terminator(Bs, L, H1), + Is = Ns ++ Is1, + Blk = Blk0#cg_blk{is=Is}, + need_heap_blks(Bs, H, [{L,Blk}|Acc]); +need_heap_blks([], H, Acc) -> + {Acc,H}. + +need_heap_is([#cg_alloc{words=Words}=Alloc0|Is], N, Acc) -> + Alloc = Alloc0#cg_alloc{words=add_heap_words(N, Words)}, + need_heap_is(Is, #need{}, [Alloc|Acc]); +need_heap_is([#cg_set{anno=Anno,op=bs_init}=I0|Is], N, Acc) -> + Alloc = case need_heap_need(N) of + [#cg_alloc{words=Need}] -> alloc(Need); + [] -> 0 + end, + I = I0#cg_set{anno=Anno#{alloc=>Alloc}}, + need_heap_is(Is, #need{}, [I|Acc]); +need_heap_is([#cg_set{op=Op,args=Args}=I|Is], N, Acc) -> + case classify_heap_need(Op, Args) of + {put,Words} -> + %% Pass through adding to needed heap. + need_heap_is(Is, add_heap_words(N, Words), [I|Acc]); + put_float -> + need_heap_is(Is, add_heap_float(N), [I|Acc]); + neutral -> + need_heap_is(Is, N, [I|Acc]); + gc -> + need_heap_is(Is, #need{}, [I]++need_heap_need(N)++Acc) + end; +need_heap_is([], N, Acc) -> + {Acc,N}. + +need_heap_terminator([{_,#cg_blk{last=#cg_br{succ=L,fail=L}}}|_], L, N) -> + %% Fallthrough. + {[],N}; +need_heap_terminator([{_,#cg_blk{is=Is,last=#cg_br{succ=L}}}|_], L, N) -> + case need_heap_need(N) of + [] -> + {[],#need{}}; + [_|_]=Alloc -> + %% If the preceding instructions are a binary construction, + %% hoist the allocation and incorporate into the bs_init + %% instruction. + case reverse(Is) of + [#cg_set{op=succeeded},#cg_set{op=bs_init}|_] -> + {[],N}; + [#cg_set{op=bs_put}|_] -> + {[],N}; + _ -> + %% Not binary construction. Must emit an allocation + %% instruction in this block. + {Alloc,#need{}} + end + end; +need_heap_terminator([{_,#cg_blk{}}|_], _, N) -> + {need_heap_need(N),#need{}}; +need_heap_terminator([], _, H) -> + {need_heap_need(H),#need{}}. + +need_heap_need(#need{h=0,f=0}) -> []; +need_heap_need(#need{}=N) -> [#cg_alloc{words=N}]. + +add_heap_words(#need{h=H1,f=F1}, #need{h=H2,f=F2}) -> + #need{h=H1+H2,f=F1+F2}; +add_heap_words(#need{h=Heap}=N, Words) when is_integer(Words) -> + N#need{h=Heap+Words}. + +add_heap_float(#need{f=F}=N) -> + N#need{f=F+1}. + +%% classify_heap_need(Operation, Arguments) -> +%% gc | neutral | {put,Words} | put_float. +%% Classify the heap need for this instruction. The return +%% values have the following meaning. +%% +%% {put,Words} means that the instruction will use Words words to build +%% something on the heap. +%% +%% 'put_float' means that the instruction will build one floating point +%% number on the heap. +%% +%% 'gc' means that that the instruction can potentially do a GC or throw an +%% exception. That means that an allocation instruction for any building +%% must be placed after this instruction. +%% +%% 'neutral' means that the instruction does nothing to disturb the heap. + +-spec classify_heap_need(beam_ssa:op(), [beam_ssa:value()]) -> + 'gc' | 'neutral' | + {'put',non_neg_integer()} | 'put_float'. + +classify_heap_need(put_list, _) -> + {put,2}; +classify_heap_need(put_tuple_arity, [#b_literal{val=Words}]) -> + {put,Words+1}; +classify_heap_need(put_tuple, Elements) -> + {put,length(Elements)+1}; +classify_heap_need({bif,Name}, Args) -> + case is_gc_bif(Name, Args) of + false -> neutral; + true -> gc + end; +classify_heap_need({float,Op}, _Args) -> + case Op of + get -> put_float; + _ -> neutral + end; +classify_heap_need(Name, _Args) -> + classify_heap_need(Name). + +%% classify_heap_need(Operation) -> gc | neutral. +%% Return either 'gc' or 'neutral'. +%% +%% 'gc' means that that the instruction can potentially do a GC or throw an +%% exception. That means that an allocation instruction for any building +%% must be placed after this instruction. +%% +%% 'neutral' means that the instruction does nothing to disturb the heap. +%% +%% Note: Only handle operations in this function that are not handled +%% by classify_heap_need/2. + +classify_heap_need(bs_add) -> gc; +classify_heap_need(bs_get) -> gc; +classify_heap_need(bs_get_tail) -> gc; +classify_heap_need(bs_init) -> gc; +classify_heap_need(bs_init_writable) -> gc; +classify_heap_need(bs_match_string) -> gc; +classify_heap_need(bs_put) -> neutral; +classify_heap_need(bs_restore) -> neutral; +classify_heap_need(bs_save) -> neutral; +classify_heap_need(bs_get_position) -> gc; +classify_heap_need(bs_set_position) -> neutral; +classify_heap_need(bs_skip) -> gc; +classify_heap_need(bs_start_match) -> neutral; +classify_heap_need(bs_test_tail) -> neutral; +classify_heap_need(bs_utf16_size) -> neutral; +classify_heap_need(bs_utf8_size) -> neutral; +classify_heap_need(build_stacktrace) -> gc; +classify_heap_need(call) -> gc; +classify_heap_need(catch_end) -> gc; +classify_heap_need(copy) -> neutral; +classify_heap_need(extract) -> gc; +classify_heap_need(get_hd) -> neutral; +classify_heap_need(get_map_element) -> neutral; +classify_heap_need(get_tl) -> neutral; +classify_heap_need(get_tuple_element) -> neutral; +classify_heap_need(has_map_field) -> neutral; +classify_heap_need(is_nonempty_list) -> neutral; +classify_heap_need(is_tagged_tuple) -> neutral; +classify_heap_need(kill_try_tag) -> gc; +classify_heap_need(landingpad) -> gc; +classify_heap_need(make_fun) -> gc; +classify_heap_need(new_try_tag) -> gc; +classify_heap_need(peek_message) -> gc; +classify_heap_need(put_map) -> gc; +classify_heap_need(put_tuple_elements) -> neutral; +classify_heap_need(raw_raise) -> gc; +classify_heap_need(recv_next) -> gc; +classify_heap_need(remove_message) -> neutral; +classify_heap_need(resume) -> gc; +classify_heap_need(set_tuple_element) -> gc; +classify_heap_need(succeeded) -> neutral; +classify_heap_need(timeout) -> gc; +classify_heap_need(wait) -> gc; +classify_heap_need(wait_timeout) -> gc. + +%%% +%%% Because beam_ssa_pre_codegen has inserted 'copy' instructions to copy +%%% variables that must be saved on the stack, a value can for some time +%%% be in both an X register and a Y register. +%%% +%%% Here we will keep track of variables that have the same value and +%%% rewrite instructions to use the variable that refers to the X +%%% register instead of the Y register. That could improve performance, +%%% since the BEAM interpreter have more optimized instructions +%%% operating on X registers than on Y registers. +%%% +%%% 'call' and 'make_fun' are handled somewhat specially. If a value +%%% already is in the correct X register, the X register will always +%%% be used instead of the Y register. However, if there are one or more +%%% values in the wrong X registers, the X registers variables will be +%%% used only if that does not cause more 'move' instructions to be +%%% be emitted than if the Y register variables were used. +%%% +%%% Here are some examples. The first example shows how a 'move' from +%%% an Y register is eliminated: +%%% +%%% move x0 y1 +%%% move y1 x0 %%Will be eliminated. +%%% +%%% call f/1 +%%% +%%% Here is an example when x0 and x1 must be swapped to load the argument +%%% registers. Here the 'call' instruction will use the Y registers to +%%% avoid introducing an extra 'move' insruction: +%%% +%%% move x0 y0 +%%% move x1 y1 +%%% +%%% move y0 x1 +%%% move y1 x0 +%%% +%%% call f/2 +%%% +%%% Using the X register to load the argument registers would need +%%% an extra 'move' instruction like this: +%%% +%%% move x0 y0 +%%% move x1 y1 +%%% +%%% move x1 x2 +%%% move x0 x1 +%%% move x2 x0 +%%% +%%% call f/2 +%%% + +prefer_xregs(Linear, St) -> + prefer_xregs(Linear, St, #{0=>#{}}). + +prefer_xregs([{L,#cg_blk{is=Is0,last=Last0}=Blk0}|Bs], St, Map0) -> + Copies0 = maps:get(L, Map0), + {Is,Copies} = prefer_xregs_is(Is0, St, Copies0, []), + Last = prefer_xregs_terminator(Last0, Copies, St), + Blk = Blk0#cg_blk{is=Is,last=Last}, + Successors = successors(Last), + Map = prefer_xregs_successors(Successors, Copies, Map0), + [{L,Blk}|prefer_xregs(Bs, St, Map)]; +prefer_xregs([], _St, _Map) -> []. + +prefer_xregs_successors([L|Ls], Copies0, Map0) -> + case Map0 of + #{L:=Copies1} -> + Copies = merge_copies(Copies0, Copies1), + Map = Map0#{L:=Copies}, + prefer_xregs_successors(Ls, Copies0, Map); + #{} -> + Map = Map0#{L=>Copies0}, + prefer_xregs_successors(Ls, Copies0, Map) + end; +prefer_xregs_successors([], _, Map) -> Map. + +prefer_xregs_is([#cg_alloc{}=I|Is], St, Copies0, Acc) -> + Copies = case I of + #cg_alloc{stack=none,words=#need{h=0,f=0}} -> + Copies0; + #cg_alloc{} -> + #{} + end, + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([#cg_set{op=copy,dst=Dst,args=[Src]}=I|Is], St, Copies0, Acc) -> + Copies1 = prefer_xregs_prune(I, Copies0, St), + Copies = case beam_args([Src,Dst], St) of + [Same,Same] -> Copies1; + [_,_] -> Copies1#{Dst=>Src} + end, + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([#cg_set{op=call,dst=Dst}=I0|Is], St, Copies, Acc) -> + I = prefer_xregs_call(I0, Copies, St), + prefer_xregs_is(Is, St, #{Dst=>{x,0}}, [I|Acc]); +prefer_xregs_is([#cg_set{op=make_fun,dst=Dst}=I0|Is], St, Copies, Acc) -> + I = prefer_xregs_call(I0, Copies, St), + prefer_xregs_is(Is, St, #{Dst=>{x,0}}, [I|Acc]); +prefer_xregs_is([#cg_set{op=set_tuple_element}=I|Is], St, Copies, Acc) -> + %% FIXME: HiPE translates the following code segment incorrectly: + %% {call_ext,3,{extfunc,erlang,setelement,3}}. + %% {move,{x,0},{y,3}}. + %% {set_tuple_element,{y,1},{y,3},1}. + %% Therefore, skip the translation of the arguments for set_tuple_element. + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([#cg_set{args=Args0}=I0|Is], St, Copies0, Acc) -> + Args = [do_prefer_xreg(A, Copies0, St) || A <- Args0], + I = I0#cg_set{args=Args}, + Copies = prefer_xregs_prune(I, Copies0, St), + prefer_xregs_is(Is, St, Copies, [I|Acc]); +prefer_xregs_is([], _St, Copies, Acc) -> + {reverse(Acc),Copies}. + +prefer_xregs_terminator(#cg_br{bool=Arg0}=I, Copies, St) -> + Arg = do_prefer_xreg(Arg0, Copies, St), + I#cg_br{bool=Arg}; +prefer_xregs_terminator(#cg_ret{arg=Arg0}=I, Copies, St) -> + Arg = do_prefer_xreg(Arg0, Copies, St), + I#cg_ret{arg=Arg}; +prefer_xregs_terminator(#cg_switch{arg=Arg0}=I, Copies, St) -> + Arg = do_prefer_xreg(Arg0, Copies, St), + I#cg_switch{arg=Arg}. + +prefer_xregs_prune(#cg_set{anno=#{clobbers:=true}}, _, _) -> + #{}; +prefer_xregs_prune(#cg_set{dst=Dst}, Copies, St) -> + DstReg = beam_arg(Dst, St), + F = fun(_, Alias) -> + beam_arg(Alias, St) =/= DstReg + end, + maps:filter(F, Copies). + +%% prefer_xregs_call(Instruction, Copies, St) -> Instruction. +%% Given a 'call' or 'make_fun' instruction, minimize the number +%% of 'move' instructions to set up the argument registers. +%% Prefer using X registers over Y registers, unless that will +%% result in more 'move' instructions. + +prefer_xregs_call(#cg_set{args=[_]}=I, _Copies, _St) -> + I; +prefer_xregs_call(#cg_set{args=[F|Args0]}=I, Copies, St) -> + case Args0 of + [A0] -> + %% Only one argument. Always prefer the X register + %% if available. + A = do_prefer_xreg(A0, Copies, St), + I#cg_set{args=[F,A]}; + [_|_] -> + %% Two or more arguments. Try rewriting arguments in + %% two ways and see which way produces the least + %% number of 'move' instructions. + Args1 = prefer_xregs_call_1(Args0, Copies, 0, St), + Args2 = [do_prefer_xreg(A, Copies, St) || A <- Args0], + case {count_moves(Args1, St),count_moves(Args2, St)} of + {N1,N2} when N1 < N2 -> + %% There will be fewer 'move' instructions if + %% we keep using Y registers. + I#cg_set{args=[F|Args1]}; + {_,_} -> + %% Always use the values in X registers. + I#cg_set{args=[F|Args2]} + end + end. + +count_moves(Args, St) -> + length(setup_args(beam_args(Args, St))). + +prefer_xregs_call_1([#b_var{}=A|As], Copies, X, St) -> + case {beam_arg(A, St),Copies} of + {{y,_},#{A:=Other}} -> + case beam_arg(Other, St) of + {x,X} -> + %% This value is already in the correct X register. + %% It is always benefical to use the X register variable. + [Other|prefer_xregs_call_1(As, Copies, X+1, St)]; + _ -> + %% This value is another X register. Keep using + %% the Y register variable. + [A|prefer_xregs_call_1(As, Copies, X+1, St)] + end; + {_,_} -> + %% The value is not available in an X register. + [A|prefer_xregs_call_1(As, Copies, X+1, St)] + end; +prefer_xregs_call_1([A|As], Copies, X, St) -> + [A|prefer_xregs_call_1(As, Copies, X+1, St)]; +prefer_xregs_call_1([], _, _, _) -> []. + +do_prefer_xreg(#b_var{}=A, Copies, St) -> + case {beam_arg(A, St),Copies} of + {{y,_},#{A:=Copy}} -> + Copy; + {_,_} -> + A + end; +do_prefer_xreg(A, _, _) -> A. + +merge_copies(Copies0, Copies1) when map_size(Copies0) =< map_size(Copies1) -> + maps:filter(fun(K, V) -> + case Copies1 of + #{K:=V} -> true; + #{} -> false + end + end, Copies0); +merge_copies(Copies0, Copies1) -> + merge_copies(Copies1, Copies0). + + +%%% +%%% Add annotations for the number of live registers. +%%% + +liveness(Linear, #cg{regs=Regs}) -> + liveness(reverse(Linear), #{}, Regs, []). + +liveness([{L,#cg_blk{is=Is0,last=Last0}=Blk0}|Bs], LiveMap0, Regs, Acc) -> + Successors = liveness_successors(Last0), + Live0 = ordsets:union([liveness_get(S, LiveMap0) || S <- Successors]), + Live1 = liveness_terminator(Last0, Live0), + {Is,Live} = liveness_is(reverse(Is0), Regs, Live1, []), + LiveMap = LiveMap0#{L=>Live}, + Blk = Blk0#cg_blk{is=Is}, + liveness(Bs, LiveMap, Regs, [{L,Blk}|Acc]); +liveness([], _LiveMap, _Regs, Acc) -> Acc. + +liveness_get(S, LiveMap) -> + case LiveMap of + #{S:=Live} -> Live; + #{} -> [] + end. + +liveness_successors(Terminator) -> + successors(Terminator) -- [?BADARG_BLOCK]. + +liveness_is([#cg_alloc{}=I0|Is], Regs, Live, Acc) -> + I = I0#cg_alloc{live=num_live(Live, Regs)}, + liveness_is(Is, Regs, Live, [I|Acc]); +liveness_is([#cg_set{dst=Dst,args=Args}=I0|Is], Regs, Live0, Acc) -> + Live1 = liveness_clobber(I0, Live0, Regs), + I1 = liveness_yregs_anno(I0, Live1, Regs), + Live2 = liveness_args(Args, Live1), + Live = ordsets:del_element(Dst, Live2), + I = liveness_anno(I1, Live, Regs), + liveness_is(Is, Regs, Live, [I|Acc]); +liveness_is([], _, Live, Acc) -> + {Acc,Live}. + +liveness_terminator(#cg_br{bool=Arg}, Live) -> + liveness_terminator_1(Arg, Live); +liveness_terminator(#cg_switch{arg=Arg}, Live) -> + liveness_terminator_1(Arg, Live); +liveness_terminator(#cg_ret{arg=Arg}, Live) -> + liveness_terminator_1(Arg, Live). + +liveness_terminator_1(#b_var{}=V, Live) -> + ordsets:add_element(V, Live); +liveness_terminator_1(#b_literal{}, Live) -> + Live; +liveness_terminator_1(Reg, Live) -> + _ = verify_beam_register(Reg), + ordsets:add_element(Reg, Live). + +liveness_args([#b_var{}=V|As], Live) -> + liveness_args(As, ordsets:add_element(V, Live)); +liveness_args([#b_remote{mod=Mod,name=Name}|As], Live) -> + liveness_args([Mod,Name|As], Live); +liveness_args([A|As], Live) -> + case is_beam_register(A) of + true -> + liveness_args(As, ordsets:add_element(A, Live)); + false -> + liveness_args(As, Live) + end; +liveness_args([], Live) -> Live. + +liveness_anno(#cg_set{op=Op}=I, Live, Regs) -> + case need_live_anno(Op) of + true -> + NumLive = num_live(Live, Regs), + Anno = (I#cg_set.anno)#{live=>NumLive}, + I#cg_set{anno=Anno}; + false -> + I + end. + +liveness_yregs_anno(#cg_set{op=Op,dst=Dst}=I, Live0, Regs) -> + case need_live_anno(Op) of + true -> + Live = ordsets:del_element(Dst, Live0), + LiveYregs = [V || V <- Live, is_yreg(V, Regs)], + Anno = (I#cg_set.anno)#{live_yregs=>LiveYregs}, + I#cg_set{anno=Anno}; + false -> + I + end. + +liveness_clobber(#cg_set{anno=Anno}, Live, Regs) -> + case Anno of + #{clobbers:=true} -> + [R || R <- Live, is_yreg(R, Regs)]; + _ -> + Live + end. + +is_yreg(R, Regs) -> + case Regs of + #{R:={y,_}} -> true; + #{} -> false + end. + +num_live(Live, Regs) -> + Rs = ordsets:from_list([get_register(V, Regs) || V <- Live]), + num_live_1(Rs, 0). + +num_live_1([{x,X}|T], X) -> + num_live_1(T, X+1); +num_live_1([{x,_}|_]=T, X) -> + %% error({hole,{x,X},expected,Next}); + num_live_1(T, X+1); +num_live_1([{y,_}|_], X) -> + X; +num_live_1([{z,_}|_], X) -> + X; +num_live_1([{fr,_}|T], X) -> + num_live_1(T, X); +num_live_1([], X) -> + X. + +get_live(#cg_set{anno=#{live:=Live}}) -> + Live. + +%% need_live_anno(Operation) -> true|false. +%% Return 'true' if the instruction needs a 'live' annotation with +%% the number live X registers, or 'false' otherwise. + +need_live_anno(Op) -> + case Op of + {bif,_} -> true; + bs_get -> true; + bs_init -> true; + bs_get_position -> true; + bs_get_tail -> true; + bs_start_match -> true; + bs_skip -> true; + call -> true; + put_map -> true; + _ -> false + end. + +%%% +%%% Add the following annotations for Y registers: +%%% +%%% def_yregs An ordset with variables that refer to live Y registers. +%%% That is, Y registers that that have been killed +%%% are not included. This annotation is added to all +%%% instructions that require Y registers to be initialized. +%%% +%%% kill_yregs This annotation is added to call instructions. It is +%%% an ordset containing variables referring to Y registers +%%% that will no longer be used after the call instruction. +%%% + +defined(Linear, #cg{regs=Regs}) -> + def(Linear, #{}, Regs). + +def([{L,#cg_blk{is=Is0,last=Last}=Blk0}|Bs], DefMap0, Regs) -> + Def0 = def_get(L, DefMap0), + {Is,Def,MaybeDef} = def_is(Is0, Regs, Def0, []), + DefMap = def_successors(Last, Def, MaybeDef, DefMap0), + Blk = Blk0#cg_blk{is=Is}, + [{L,Blk}|def(Bs, DefMap, Regs)]; +def([], _, _) -> []. + +def_get(L, DefMap) -> + case DefMap of + #{L:=Def} -> Def; + #{} -> [] + end. + +def_is([#cg_alloc{anno=Anno0}=I0|Is], Regs, Def, Acc) -> + I = I0#cg_alloc{anno=Anno0#{def_yregs=>Def}}, + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{op=succeeded,args=[Var]}=I], Regs, Def, Acc) -> + %% Var will only be defined on the success branch of the `br` + %% for this block. + MaybeDef = def_add_yreg(Var, [], Regs), + {reverse(Acc, [I]),Def,MaybeDef}; +def_is([#cg_set{op=kill_try_tag,args=[#b_var{}=Tag]}=I|Is], Regs, Def0, Acc) -> + Def = ordsets:del_element(Tag, Def0), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{op=catch_end,args=[#b_var{}=Tag|_]}=I|Is], Regs, Def0, Acc) -> + Def = ordsets:del_element(Tag, Def0), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{anno=Anno0,op=call,dst=Dst}=I0|Is], + Regs, Def0, Acc) -> + #{live_yregs:=LiveYregVars} = Anno0, + LiveRegs = gb_sets:from_list([maps:get(V, Regs) || V <- LiveYregVars]), + Kill0 = ordsets:subtract(Def0, LiveYregVars), + + %% Kill0 is the set of variables that have just died. However, the registers + %% used for killed variables may have been reused, so we must check that the + %% registers to be killed are not used by other variables. + Kill = [K || K <- Kill0, not gb_sets:is_element(maps:get(K, Regs), LiveRegs)], + Anno = Anno0#{def_yregs=>Def0,kill_yregs=>Kill}, + I = I0#cg_set{anno=Anno}, + Def1 = ordsets:subtract(Def0, Kill), + Def = def_add_yreg(Dst, Def1, Regs), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{anno=Anno0,op={bif,Bif},dst=Dst,args=Args}=I0|Is], + Regs, Def0, Acc) -> + Arity = length(Args), + I = case is_gc_bif(Bif, Args) orelse not erl_bifs:is_safe(erlang, Bif, Arity) of + true -> + I0#cg_set{anno=Anno0#{def_yregs=>Def0}}; + false -> + I0 + end, + Def = def_add_yreg(Dst, Def0, Regs), + def_is(Is, Regs, Def, [I|Acc]); +def_is([#cg_set{anno=Anno0,dst=Dst}=I0|Is], Regs, Def0, Acc) -> + I = case need_y_init(I0) of + true -> + I0#cg_set{anno=Anno0#{def_yregs=>Def0}}; + false -> + I0 + end, + Def = def_add_yreg(Dst, Def0, Regs), + def_is(Is, Regs, Def, [I|Acc]); +def_is([], _, Def, Acc) -> + {reverse(Acc),Def,[]}. + +def_add_yreg(Dst, Def, Regs) -> + case is_yreg(Dst, Regs) of + true -> ordsets:add_element(Dst, Def); + false -> Def + end. + +def_successors(#cg_br{bool=#b_var{},succ=Succ,fail=Fail}, Def, MaybeDef, DefMap0) -> + DefMap = def_successors([Fail], ordsets:subtract(Def, MaybeDef), DefMap0), + def_successors([Succ], Def, DefMap); +def_successors(Last, Def, [], DefMap) -> + def_successors(successors(Last), Def, DefMap). + +def_successors([S|Ss], Def0, DefMap) -> + case DefMap of + #{S:=Def1} -> + Def = ordsets:intersection(Def0, Def1), + def_successors(Ss, Def0, DefMap#{S:=Def}); + #{} -> + def_successors(Ss, Def0, DefMap#{S=>Def0}) + end; +def_successors([], _, DefMap) -> DefMap. + +%% need_y_init(#cg_set{}) -> true|false. +%% Return true if this instructions needs initialized Y registers +%% (because the instruction may do a GC or cause an exception +%% so that the stack will be scanned), or false otherwise. + +need_y_init(#cg_set{anno=#{clobbers:=Clobbers}}) -> Clobbers; +need_y_init(#cg_set{op=bs_get}) -> true; +need_y_init(#cg_set{op=bs_get_position}) -> true; +need_y_init(#cg_set{op=bs_get_tail}) -> true; +need_y_init(#cg_set{op=bs_init}) -> true; +need_y_init(#cg_set{op=bs_skip,args=[#b_literal{val=Type}|_]}) -> + case Type of + utf8 -> true; + utf16 -> true; + utf32 -> true; + _ -> false + end; +need_y_init(#cg_set{op=bs_start_match}) -> true; +need_y_init(#cg_set{op=put_map}) -> true; +need_y_init(#cg_set{}) -> false. + +%% opt_allocate([{BlockLabel,Block}], #st{}) -> [BeamInstruction]. +%% Update the def_yregs field of each #cg_alloc{} that allocates +%% a stack frame. #cg_alloc.def_yregs will list all Y registers +%% that will be initialized by the subsequent code (thus, the +%% listed Y registers don't require init/1 instructions). + +opt_allocate(Linear, #cg{regs=Regs}) -> + opt_allocate_1(Linear, Regs). + +opt_allocate_1([{L,#cg_blk{is=[#cg_alloc{stack=Stk}=I0|Is]}=Blk0}|Bs]=Bs0, Regs) + when is_integer(Stk) -> + %% Collect the variables that are initialized by copy + %% instruction in this block. + case ordsets:from_list(opt_allocate_defs(Is, Regs)) of + Yregs when length(Yregs) =:= Stk -> + %% Those copy instructions are sufficient to fully + %% initialize the stack frame. + I = I0#cg_alloc{def_yregs=Yregs}, + [{L,Blk0#cg_blk{is=[I|Is]}}|opt_allocate_1(Bs, Regs)]; + Yregs0 -> + %% Determine a conservative approximation of the Y + %% registers that are guaranteed to be initialized by all + %% successors of this block, and to it add the variables + %% initialized by copy instructions in this block. + Yregs1 = opt_alloc_def(Bs0, gb_sets:singleton(L), []), + Yregs = ordsets:union(Yregs0, Yregs1), + I = I0#cg_alloc{def_yregs=Yregs}, + [{L,Blk0#cg_blk{is=[I|Is]}}|opt_allocate_1(Bs, Regs)] + end; +opt_allocate_1([B|Bs], Regs) -> + [B|opt_allocate_1(Bs, Regs)]; +opt_allocate_1([], _) -> []. + +opt_allocate_defs([#cg_set{op=copy,dst=Dst}|Is], Regs) -> + case is_yreg(Dst, Regs) of + true -> [Dst|opt_allocate_defs(Is, Regs)]; + false -> [] + end; +opt_allocate_defs(_, _Regs) -> []. + +opt_alloc_def([{L,#cg_blk{is=Is,last=Last}}|Bs], Ws0, Def0) -> + case gb_sets:is_member(L, Ws0) of + false -> + opt_alloc_def(Bs, Ws0, Def0); + true -> + case opt_allocate_is(Is) of + none -> + Succ = successors(Last), + Ws = gb_sets:union(Ws0, gb_sets:from_list(Succ)), + opt_alloc_def(Bs, Ws, Def0); + Def1 when is_list(Def1) -> + Def = [Def1|Def0], + opt_alloc_def(Bs, Ws0, Def) + end + end; +opt_alloc_def([], _, Def) -> + ordsets:intersection(Def). + +opt_allocate_is([#cg_set{anno=Anno}|Is]) -> + case Anno of + #{def_yregs:=Yregs} -> + Yregs; + #{} -> + opt_allocate_is(Is) + end; +opt_allocate_is([#cg_alloc{anno=#{def_yregs:=Yregs},stack=none}|_]) -> + Yregs; +opt_allocate_is([#cg_alloc{}|Is]) -> + opt_allocate_is(Is); +opt_allocate_is([]) -> none. + +%%% +%%% Here follows the main code generation functions. +%%% + +%% cg_linear([{BlockLabel,Block}]) -> [BeamInstruction]. +%% Generate BEAM instructions. + +cg_linear([{L,#cg_blk{anno=#{recv_set:=L}=Anno0}=B0}|Bs], St0) -> + Anno = maps:remove(recv_set, Anno0), + B = B0#cg_blk{anno=Anno}, + {Is,St1} = cg_linear([{L,B}|Bs], St0), + {Fail,St} = use_block_label(L, St1), + {[{recv_set,Fail}|Is],St}; +cg_linear([{L,#cg_blk{is=Is0,last=Last}}|Bs], St0) -> + Next = next_block(Bs), + St1 = new_block_label(L, St0), + {Is1,St2} = cg_block(Is0, Last, Next, St1), + {Is2,St} = cg_linear(Bs, St2), + {def_block_label(L, St)++Is1++Is2,St}; +cg_linear([], St) -> {[],St}. + +cg_block([#cg_set{op=recv_next}], #cg_br{succ=Lr0}, _Next, St0) -> + {Lr,St} = use_block_label(Lr0, St0), + {[{loop_rec_end,Lr}],St}; +cg_block([#cg_set{op=wait}], #cg_br{succ=Lr0}, _Next, St0) -> + {Lr,St} = use_block_label(Lr0, St0), + {[{wait,Lr}],St}; +cg_block(Is0, Last, Next, St0) -> + case Last of + #cg_br{succ=Next,fail=Next} -> + cg_block(Is0, none, St0); + #cg_br{succ=Same,fail=Same} -> + {Fail,St1} = use_block_label(Same, St0), + {Is,St} = cg_block(Is0, none, St1), + {Is++[jump(Fail)],St}; + #cg_br{bool=Bool,succ=Next,fail=Fail0} -> + {Fail,St1} = use_block_label(Fail0, St0), + {Is,St} = cg_block(Is0, {Bool,Fail}, St1), + {Is,St}; + #cg_br{bool=Bool,succ=Succ0,fail=Fail0} -> + {[Succ,Fail],St1} = use_block_labels([Succ0,Fail0], St0), + {Is,St} = cg_block(Is0, {Bool,Fail}, St1), + {Is++[jump(Succ)],St}; + #cg_ret{arg=Src0,dealloc=N} -> + Src = beam_arg(Src0, St0), + cg_block(Is0, {return,Src,N}, St0); + #cg_switch{} -> + cg_switch(Is0, Last, St0) + end. + +cg_switch(Is0, Last, St0) -> + #cg_switch{arg=Src0,fail=Fail0,list=List0} = Last, + Src = beam_arg(Src0, St0), + {Fail1,St1} = use_block_label(Fail0, St0), + Fail = ensure_label(Fail1, St1), + {List1,St2} = + flatmapfoldl(fun({V,L}, S0) -> + {Lbl,S} = use_block_label(L, S0), + {[beam_arg(V, S),Lbl],S} + end, St1, List0), + {Is1,St} = cg_block(Is0, none, St2), + case reverse(Is1) of + [{bif,tuple_size,_,[Tuple],{z,_}=Src}|More] -> + List = map(fun({integer,Arity}) -> Arity; + ({f,_}=F) -> F + end, List1), + Is = reverse(More, [{select_tuple_arity,Tuple,Fail,{list,List}}]), + {Is,St}; + _ -> + SelectVal = {select_val,Src,Fail,{list,List1}}, + {Is1 ++ [SelectVal],St} + end. + +jump({f,_}=Fail) -> + {jump,Fail}; +jump({catch_tag,Fail}) -> + {jump,Fail}. + +bif_fail({f,_}=Fail) -> Fail; +bif_fail({catch_tag,_}) -> {f,0}. + +next_block([]) -> none; +next_block([{Next,_}|_]) -> Next. + +%% Certain instructions (such as get_map_element or is_nonempty_list) +%% are only used in guards and **must** have a non-zero label; +%% otherwise, the loader will refuse to load the +%% module. ensure_label/2 replaces a zero label with the "ultimate +%% failure" label to make the module loadable. The instruction that +%% have had the zero label replaced is **not** supposed to ever fail +%% and actually jump to the label. + +ensure_label(Fail0, #cg{ultimate_fail=Lbl}) -> + case bif_fail(Fail0) of + {f,0} -> {f,Lbl}; + {f,_}=Fail -> Fail + end. + +cg_block([#cg_set{anno=#{recv_mark:=L}=Anno0}=I0|T], Context, St0) -> + Anno = maps:remove(recv_mark, Anno0), + I = I0#cg_set{anno=Anno}, + {Is,St1} = cg_block([I|T], Context, St0), + {Fail,St} = use_block_label(L, St1), + {[{recv_mark,Fail}|Is],St}; +cg_block([#cg_set{op=new_try_tag,dst=Tag,args=Args}], {Tag,Fail0}, St) -> + {catch_tag,Fail} = Fail0, + [Reg,{atom,Kind}] = beam_args([Tag|Args], St), + {[{Kind,Reg,Fail}],St}; +cg_block([#cg_set{anno=Anno,op={bif,Name},dst=Dst0,args=Args0}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + Line0 = call_line(body, {extfunc,erlang,Name,length(Args)}, Anno), + Fail = bif_fail(Fail0), + Line = case Fail of + {f,0} -> Line0; + {f,_} -> [] + end, + case is_gc_bif(Name, Args) of + true -> + Live = get_live(I), + Kill = kill_yregs(Anno, St), + {Kill++Line++[{gc_bif,Name,Fail,Live,Args,Dst}],St}; + false -> + {Line++[{bif,Name,Fail,Args,Dst}],St} + end; +cg_block([#cg_set{op={bif,tuple_size},dst=Arity0,args=[Tuple0]}, + #cg_set{op={bif,'=:='},dst=Bool,args=[Arity0,#b_literal{val=Ar}]}=Eq], + {Bool,Fail}=Context, St0) -> + Tuple = beam_arg(Tuple0, St0), + case beam_arg(Arity0, St0) of + {z,_} -> + %% The size will only be used once. Combine to a test_arity instruction. + Test = {test,test_arity,ensure_label(Fail, St0),[Tuple,Ar]}, + {[Test],St0}; + Arity -> + %% The size will be used more than once. Must do an explicit + %% BIF call followed by the '==' test. + TupleSize = {bif,tuple_size,{f,0},[Tuple],Arity}, + {Is,St} = cg_block([Eq], Context, St0), + {[TupleSize|Is],St} + end; +cg_block([#cg_set{op={bif,Name},dst=Dst0,args=Args0}]=Is0, {Dst0,Fail}, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + case Dst of + {z,_} -> + %% The result of the BIF call will only be used once. Convert to + %% a test instruction. + {Test,St1} = bif_to_test(Name, Args, ensure_label(Fail, St0), St0), + {Test,St1}; + _ -> + %% Must explicitly call the BIF since the result will be used + %% more than once. + {Is1,St1} = cg_block(Is0, none, St0), + {Is2,St} = cg_block([], {Dst0,Fail}, St1), + {Is1++Is2,St} + end; +cg_block([#cg_set{anno=Anno,op={bif,Name},dst=Dst0,args=Args0}=I|T], + Context, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + {Is0,St} = cg_block(T, Context, St0), + case is_gc_bif(Name, Args) of + true -> + Line = call_line(body, {extfunc,erlang,Name,length(Args)}, Anno), + Live = get_live(I), + Kill = kill_yregs(Anno, St), + Is = Kill++Line++[{gc_bif,Name,{f,0},Live,Args,Dst}|Is0], + {Is,St}; + false -> + Is = [{bif,Name,{f,0},Args,Dst}|Is0], + {Is,St} + end; +cg_block([#cg_set{op=bs_init,dst=Dst0,args=Args0,anno=Anno}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> + Fail = bif_fail(Fail0), + Line = line(Anno), + Alloc = map_get(alloc, Anno), + [#b_literal{val=Kind}|Args1] = Args0, + case Kind of + new -> + [Dst,Size,{integer,Unit}] = beam_args([Dst0|Args1], St), + Live = get_live(I), + {[Line|cg_bs_init(Dst, Size, Alloc, Unit, Live, Fail)],St}; + private_append -> + [Dst,Src,Bits,{integer,Unit}] = beam_args([Dst0|Args1], St), + Flags = {field_flags,[]}, + Is = [Line,{bs_private_append,Fail,Bits,Unit,Src,Flags,Dst}], + {Is,St}; + append -> + [Dst,Src,Bits,{integer,Unit}] = beam_args([Dst0|Args1], St), + Flags = {field_flags,[]}, + Live = get_live(I), + Is = [Line,{bs_append,Fail,Bits,Alloc,Live,Unit,Src,Flags,Dst}], + {Is,St} + end; +cg_block([#cg_set{anno=Anno,op=bs_start_match,dst=Ctx0,args=[Bin0]}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + [Dst,Bin1] = beam_args([Ctx0,Bin0], St), + {Bin,Pre} = force_reg(Bin1, Dst), + Live = get_live(I), + %% num_slots is only set when using the old instructions. + case maps:find(num_slots, Anno) of + {ok, Slots} -> + Is = Pre ++ [{test,bs_start_match2,Fail,Live,[Bin,Slots],Dst}], + {Is,St}; + error -> + Is = Pre ++ [{test,bs_start_match3,Fail,Live,[Bin],Dst}], + {Is,St} + end; +cg_block([#cg_set{op=bs_get}=Set, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + {cg_bs_get(Fail, Set, St),St}; +cg_block([#cg_set{op=bs_match_string,args=[CtxVar,#b_literal{val=String}]}, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + CtxReg = beam_arg(CtxVar, St), + Is = [{test,bs_match_string,Fail,[CtxReg,String]}], + {Is,St}; +cg_block([#cg_set{dst=Dst0,op=landingpad,args=Args0}|T], Context, St0) -> + [Dst,{atom,Kind},Tag] = beam_args([Dst0|Args0], St0), + case Kind of + 'catch' -> + cg_catch(Dst, T, Context, St0); + 'try' -> + cg_try(Dst, Tag, T, Context, St0) + end; +cg_block([#cg_set{op=kill_try_tag,args=Args0}|Is], Context, St0) -> + [Reg] = beam_args(Args0, St0), + {Is0,St} = cg_block(Is, Context, St0), + {[{try_end,Reg}|Is0],St}; +cg_block([#cg_set{op=catch_end,dst=Dst0,args=Args0}|Is], Context, St0) -> + [Dst,Reg,{x,0}] = beam_args([Dst0|Args0], St0), + {Is0,St} = cg_block(Is, Context, St0), + {[{catch_end,Reg}|copy({x,0}, Dst)++Is0],St}; +cg_block([#cg_set{op=call}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> + %% A call in try/catch block. + cg_block([I], none, St); +cg_block([#cg_set{op=get_map_element,dst=Dst0,args=Args0}, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> + [Dst,Map,Key] = beam_args([Dst0|Args0], St), + Fail = ensure_label(Fail0, St), + {[{get_map_elements,Fail,Map,{list,[Key,Dst]}}],St}; +cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,Fail}, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + {cg_test(Op, bif_fail(Fail), Args, Dst, I),St}; +cg_block([#cg_set{op=bs_put,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + Args = beam_args(Args0, St), + {cg_bs_put(bif_fail(Fail), Args),St}; +cg_block([#cg_set{op=bs_test_tail,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + [Ctx,{integer,Bits}] = beam_args(Args0, St), + {[{test,bs_test_tail2,bif_fail(Fail),[Ctx,Bits]}],St}; +cg_block([#cg_set{op={float,checkerror},dst=Bool}], {Bool,Fail}, St) -> + {[{fcheckerror,bif_fail(Fail)}],St}; +cg_block([#cg_set{op=is_tagged_tuple,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + [Src,{integer,Arity},Tag] = beam_args(Args0, St), + {[{test,is_tagged_tuple,ensure_label(Fail, St),[Src,Arity,Tag]}],St}; +cg_block([#cg_set{op=is_nonempty_list,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + Args = beam_args(Args0, St), + {[{test,is_nonempty_list,ensure_label(Fail, St),Args}],St}; +cg_block([#cg_set{op=has_map_field,dst=Bool,args=Args0}], {Bool,Fail}, St) -> + [Src,Key] = beam_args(Args0, St), + {[{test,has_map_fields,Fail,Src,{list,[Key]}}],St}; +cg_block([#cg_set{op=call}=Call], {_Bool,_Fail}=Context, St0) -> + {Is0,St1} = cg_call(Call, body, none, St0), + {Is1,St} = cg_block([], Context, St1), + {Is0++Is1,St}; +cg_block([#cg_set{op=call,dst=Dst0}=Call], Context, St) -> + Dst = beam_arg(Dst0, St), + case Context of + {return,Dst,_} -> + cg_call(Call, tail, Context, St); + _ -> + cg_call(Call, body, Context, St) + end; +cg_block([#cg_set{op=call}=Call|T], Context, St0) -> + {Is0,St1} = cg_call(Call, body, none, St0), + {Is1,St} = cg_block(T, Context, St1), + {Is0++Is1,St}; +cg_block([#cg_set{op=make_fun,dst=Dst0,args=[Local|Args0]}|T], + Context, St0) -> + #b_local{name=#b_literal{val=Func},arity=Arity} = Local, + [Dst|Args] = beam_args([Dst0|Args0], St0), + {FuncLbl,St1} = local_func_label(Func, Arity, St0), + Is0 = setup_args(Args) ++ + [{make_fun2,{f,FuncLbl},0,0,length(Args)}|copy({x,0}, Dst)], + {Is1,St} = cg_block(T, Context, St1), + {Is0++Is1,St}; +cg_block([#cg_set{op=copy}|_]=T0, Context, St0) -> + {Is0,T} = cg_copy(T0, St0), + {Is1,St} = cg_block(T, Context, St0), + Is = Is0 ++ Is1, + case is_call(T) of + {yes,Arity} -> + {opt_call_moves(Is, Arity),St}; + no -> + {Is,St} + end; +cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set], none, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + Is = cg_instr(Op, Args, Dst, Set), + {Is,St}; +cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set|T], Context, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + Is0 = cg_instr(Op, Args, Dst, Set), + {Is1,St} = cg_block(T, Context, St0), + {Is0++Is1,St}; +cg_block([#cg_alloc{}=Alloc|T], Context, St0) -> + Is0 = cg_alloc(Alloc, St0), + {Is1,St} = cg_block(T, Context, St0), + {Is0++Is1,St}; +cg_block([], {return,Arg,none}, St) -> + Is = copy(Arg, {x,0}) ++ [return], + {Is,St}; +cg_block([], {return,Arg,N}, St) -> + Is = copy(Arg, {x,0}) ++ [{deallocate,N},return], + {Is,St}; +cg_block([], none, St) -> + {[],St}; +cg_block([], {Bool0,Fail}, St) -> + [Bool] = beam_args([Bool0], St), + {[{test,is_eq_exact,Fail,[Bool,{atom,true}]}],St}. + +cg_copy(T0, St) -> + {Copies,T} = splitwith(fun(#cg_set{op=copy}) -> true; + (_) -> false + end, T0), + Moves0 = cg_copy_1(Copies, St), + Moves1 = [Move || {move,Src,Dst}=Move <- Moves0, Src =/= Dst], + Scratch = {x,1022}, + Moves = order_moves(Moves1, Scratch), + {Moves,T}. + +cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) -> + [Dst,Src] = beam_args([Dst0|Args], St), + Copies = cg_copy_1(T, St), + case keymember(Dst, 3, Copies) of + true -> + %% Will be overwritten. Don't generate a move instruction. + Copies; + false -> + [{move,Src,Dst}|Copies] + end; +cg_copy_1([], _St) -> []. + +-define(IS_LITERAL(Val), (Val =:= nil orelse + element(1, Val) =:= integer orelse + element(1, Val) =:= float orelse + element(1, Val) =:= atom orelse + element(1, Val) =:= literal)). + +bif_to_test('or', [V1,V2], {f,Lbl}=Fail, St0) when Lbl =/= 0 -> + {SuccLabel,St} = new_label(St0), + {[{test,is_eq_exact,{f,SuccLabel},[V1,{atom,false}]}, + {test,is_eq_exact,Fail,[V2,{atom,true}]}, + {label,SuccLabel}],St}; +bif_to_test(Op, Args, Fail, St) -> + {bif_to_test(Op, Args, Fail),St}. + +bif_to_test('and', [V1,V2], Fail) -> + [{test,is_eq_exact,Fail,[V1,{atom,true}]}, + {test,is_eq_exact,Fail,[V2,{atom,true}]}]; +bif_to_test('not', [Var], Fail) -> + [{test,is_eq_exact,Fail,[Var,{atom,false}]}]; +bif_to_test(Name, Args, Fail) -> + [bif_to_test_1(Name, Args, Fail)]. + +bif_to_test_1(is_atom, [_]=Ops, Fail) -> + {test,is_atom,Fail,Ops}; +bif_to_test_1(is_boolean, [_]=Ops, Fail) -> + {test,is_boolean,Fail,Ops}; +bif_to_test_1(is_binary, [_]=Ops, Fail) -> + {test,is_binary,Fail,Ops}; +bif_to_test_1(is_bitstring,[_]=Ops, Fail) -> + {test,is_bitstr,Fail,Ops}; +bif_to_test_1(is_float, [_]=Ops, Fail) -> + {test,is_float,Fail,Ops}; +bif_to_test_1(is_function, [_]=Ops, Fail) -> + {test,is_function,Fail,Ops}; +bif_to_test_1(is_function, [_,_]=Ops, Fail) -> + {test,is_function2,Fail,Ops}; +bif_to_test_1(is_integer, [_]=Ops, Fail) -> + {test,is_integer,Fail,Ops}; +bif_to_test_1(is_list, [_]=Ops, Fail) -> + {test,is_list,Fail,Ops}; +bif_to_test_1(is_map, [_]=Ops, Fail) -> + {test,is_map,Fail,Ops}; +bif_to_test_1(is_number, [_]=Ops, Fail) -> + {test,is_number,Fail,Ops}; +bif_to_test_1(is_pid, [_]=Ops, Fail) -> + {test,is_pid,Fail,Ops}; +bif_to_test_1(is_port, [_]=Ops, Fail) -> + {test,is_port,Fail,Ops}; +bif_to_test_1(is_reference, [_]=Ops, Fail) -> + {test,is_reference,Fail,Ops}; +bif_to_test_1(is_tuple, [_]=Ops, Fail) -> + {test,is_tuple,Fail,Ops}; +bif_to_test_1('=<', [A,B], Fail) -> + {test,is_ge,Fail,[B,A]}; +bif_to_test_1('>', [A,B], Fail) -> + {test,is_lt,Fail,[B,A]}; +bif_to_test_1('<', [_,_]=Ops, Fail) -> + {test,is_lt,Fail,Ops}; +bif_to_test_1('>=', [_,_]=Ops, Fail) -> + {test,is_ge,Fail,Ops}; +bif_to_test_1('==', [C,A], Fail) when ?IS_LITERAL(C) -> + {test,is_eq,Fail,[A,C]}; +bif_to_test_1('==', [_,_]=Ops, Fail) -> + {test,is_eq,Fail,Ops}; +bif_to_test_1('/=', [C,A], Fail) when ?IS_LITERAL(C) -> + {test,is_ne,Fail,[A,C]}; +bif_to_test_1('/=', [_,_]=Ops, Fail) -> + {test,is_ne,Fail,Ops}; +bif_to_test_1('=:=', [C,A], Fail) when ?IS_LITERAL(C) -> + {test,is_eq_exact,Fail,[A,C]}; +bif_to_test_1('=:=', [_,_]=Ops, Fail) -> + {test,is_eq_exact,Fail,Ops}; +bif_to_test_1('=/=', [C,A], Fail) when ?IS_LITERAL(C) -> + {test,is_ne_exact,Fail,[A,C]}; +bif_to_test_1('=/=', [_,_]=Ops, Fail) -> + {test,is_ne_exact,Fail,Ops}. + +opt_call_moves(Is0, Arity) -> + {Moves0,Is} = splitwith(fun({move,_,_}) -> true; + ({kill,_}) -> true; + (_) -> false + end, Is0), + Moves = opt_call_moves_1(Moves0, Arity), + Moves ++ Is. + +opt_call_moves_1([{move,Src,{x,_}=Tmp}=M1|[{kill,_}|_]=Is], Arity) -> + %% There could be a {move,Tmp,{x,0}} instruction after the + %% kill/1 instructions (moved to there by opt_move_to_x0/1). + case splitwith(fun({kill,_}) -> true; + (_) -> false + end, Is) of + {Kills,[{move,{x,_}=Tmp,{x,0}}=M2]} -> + %% The two move/2 instructions (M1 and M2) can be combined + %% to one. The question is, though, is it safe to place + %% them after the kill/1 instructions? + case is_killed(Src, Kills, Arity) of + true -> + %% Src (a Y register) is killed by one of the + %% kill/1 instructions. Thus M1 and M2 + %% must be placed before the kill/1 instructions + %% (essentially undoing what opt_move_to_x0/1 + %% did, which turned out to be a pessimization + %% in this case). + opt_call_moves_1([M1,M2|Kills], Arity); + false -> + %% Src is not killed by any of the kill/1 + %% instructions. Thus it is safe to place + %% M1 and M2 after the kill/1 instructions. + opt_call_moves_1(Kills++[M1,M2], Arity) + end; + {_,_} -> + [M1|Is] + end; +opt_call_moves_1([{move,Src,{x,_}=Tmp}=M1,{move,Tmp,Dst}=M2|Is], Arity) -> + case is_killed(Tmp, Is, Arity) of + true -> + %% The X register Tmp is never used again. We can collapse + %% the two move instruction into one. + [{move,Src,Dst}|opt_call_moves_1(Is, Arity)]; + false -> + [M1|opt_call_moves_1([M2|Is], Arity)] + end; +opt_call_moves_1([M|Ms], Arity) -> + [M|opt_call_moves_1(Ms, Arity)]; +opt_call_moves_1([], _Arity) -> []. + +is_killed(Y, [{kill,Y}|_], _) -> + true; +is_killed(R, [{kill,_}|Is], Arity) -> + is_killed(R, Is, Arity); +is_killed(R, [{move,R,_}|_], _) -> + false; +is_killed(R, [{move,_,R}|_], _) -> + true; +is_killed(R, [{move,_,_}|Is], Arity) -> + is_killed(R, Is, Arity); +is_killed({x,X}, [], Arity) -> + X >= Arity; +is_killed({y,_}, [], _) -> + false. + +cg_alloc(#cg_alloc{stack=none,words=#need{h=0,f=0}}, _St) -> + []; +cg_alloc(#cg_alloc{stack=none,words=Need,live=Live}, _St) -> + [{test_heap,alloc(Need),Live}]; +cg_alloc(#cg_alloc{stack=Stk,words=Need,live=Live,def_yregs=DefYregs}, + #cg{regs=Regs}) when is_integer(Stk) -> + Alloc = alloc(Need), + All = [{y,Y} || Y <- lists:seq(0, Stk-1)], + Def = ordsets:from_list([maps:get(V, Regs) || V <- DefYregs]), + NeedInit = ordsets:subtract(All, Def), + NoZero = length(Def)*2 > Stk, + I = case {NoZero,Alloc} of + {true,0} -> {allocate,Stk,Live}; + {true,_} -> {allocate_heap,Stk,Alloc,Live}; + {false,0} -> {allocate_zero,Stk,Live}; + {false,_} -> {allocate_heap_zero,Stk,Alloc,Live} + end, + [I|case NoZero of + true -> [{init,Y} || Y <- NeedInit]; + false -> [] + end]. + +alloc(#need{h=Words,f=0}) -> + Words; +alloc(#need{h=Words,f=Floats}) -> + {alloc,[{words,Words},{floats,Floats}]}. + +is_call([#cg_set{op=call,args=[#b_var{}|Args]}|_]) -> + {yes,1+length(Args)}; +is_call([#cg_set{op=call,args=[_|Args]}|_]) -> + {yes,length(Args)}; +is_call([#cg_set{op=make_fun,args=[_|Args]}|_]) -> + {yes,length(Args)}; +is_call(_) -> + no. + +cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=[#b_local{}=Func0|Args0]}, + Where, Context, St0) -> + [Dst|Args] = beam_args([Dst0|Args0], St0), + #b_local{name=Name0,arity=Arity} = Func0, + {atom,Name} = beam_arg(Name0, St0), + {FuncLbl,St} = local_func_label(Name, Arity, St0), + Line = call_line(Where, local, Anno), + Call = build_call(call, Arity, {f,FuncLbl}, Context, Dst), + Is = setup_args(Args, Anno, Context, St) ++ Line ++ Call, + case Anno of + #{ result_type := Info } -> + {Is ++ [{'%', {type_info, Dst, Info}}], St}; + #{} -> + {Is, St} + end; +cg_call(#cg_set{anno=Anno0,op=call,dst=Dst0,args=[#b_remote{}=Func0|Args0]}, + Where, Context, St) -> + [Dst|Args] = beam_args([Dst0|Args0], St), + #b_remote{mod=Mod0,name=Name0,arity=Arity} = Func0, + case {beam_arg(Mod0, St),beam_arg(Name0, St)} of + {{atom,Mod},{atom,Name}} -> + Func = {extfunc,Mod,Name,Arity}, + Line = call_line(Where, Func, Anno0), + Call = build_call(call_ext, Arity, Func, Context, Dst), + Anno = case erl_bifs:is_exit_bif(Mod, Name, Arity) of + true -> + %% There is no need to kill Y registers + %% before calling an exit BIF. + maps:remove(kill_yregs, Anno0); + false -> + Anno0 + end, + Is = setup_args(Args, Anno, Context, St) ++ Line ++ Call, + {Is,St}; + {Mod,Name} -> + Apply = build_apply(Arity, Context, Dst), + Is = setup_args(Args++[Mod,Name], Anno0, Context, St) ++ + [line(Anno0)] ++ Apply, + {Is,St} + end; +cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=Args0}, + Where, Context, St) -> + [Dst,Func|Args] = beam_args([Dst0|Args0], St), + Line = call_line(Where, Func, Anno), + Arity = length(Args), + Call = build_call(call_fun, Arity, Func, Context, Dst), + Is = setup_args(Args++[Func], Anno, Context, St) ++ Line ++ Call, + {Is,St}. + +build_call(call_fun, Arity, _Func, none, Dst) -> + [{call_fun,Arity}|copy({x,0}, Dst)]; +build_call(call_fun, Arity, _Func, {return,Dst,N}, Dst) when is_integer(N) -> + [{call_fun,Arity},{deallocate,N},return]; +build_call(call_fun, Arity, _Func, {return,Val,N}, _Dst) when is_integer(N) -> + [{call_fun,Arity},{move,Val,{x,0}},{deallocate,N},return]; +build_call(call_ext, 2, {extfunc,erlang,'!',2}, none, Dst) -> + [send|copy({x,0}, Dst)]; +build_call(call_ext, 2, {extfunc,erlang,'!',2}, {return,Dst,N}, Dst) + when is_integer(N) -> + [send,{deallocate,N},return]; +build_call(Prefix, Arity, Func, {return,Dst,none}, Dst) -> + I = case Prefix of + call -> call_only; + call_ext -> call_ext_only + end, + [{I,Arity,Func}]; +build_call(call_ext, Arity, {extfunc,Mod,Name,Arity}=Func, {return,_,none}, _Dst) -> + true = erl_bifs:is_exit_bif(Mod, Name, Arity), %Assertion. + [{call_ext_only,Arity,Func}]; +build_call(Prefix, Arity, Func, {return,Dst,N}, Dst) when is_integer(N) -> + I = case Prefix of + call -> call_last; + call_ext -> call_ext_last + end, + [{I,Arity,Func,N}]; +build_call(I, Arity, Func, {return,Val,N}, _Dst) when is_integer(N) -> + [{I,Arity,Func}|copy(Val, {x,0})++[{deallocate,N},return]]; +build_call(I, Arity, Func, none, Dst) -> + [{I,Arity,Func}|copy({x,0}, Dst)]. + +build_apply(Arity, {return,Dst,N}, Dst) when is_integer(N) -> + [{apply_last,Arity,N}]; +build_apply(Arity, {return,Val,N}, _Dst) when is_integer(N) -> + [{apply,Arity}|copy(Val, {x,0})++[{deallocate,N},return]]; +build_apply(Arity, none, Dst) -> + [{apply,Arity}|copy({x,0}, Dst)]. + +cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> + Live = get_live(Set), + [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; +cg_instr(bs_get_tail, [Src], Dst, Set) -> + Live = get_live(Set), + [{bs_get_tail,Src,Dst,Live}]; +cg_instr(bs_get_position, [Ctx], Dst, Set) -> + Live = get_live(Set), + [{bs_get_position,Ctx,Dst,Live}]; +cg_instr(Op, Args, Dst, _Set) -> + cg_instr(Op, Args, Dst). + +cg_instr(bs_init_writable, Args, Dst) -> + setup_args(Args) ++ [bs_init_writable|copy({x,0}, Dst)]; +cg_instr(bs_restore, [Ctx,Slot], _Dst) -> + case Slot of + {integer,N} -> + [{bs_restore2,Ctx,N}]; + {atom,start} -> + [{bs_restore2,Ctx,Slot}] + end; +cg_instr(bs_save, [Ctx,Slot], _Dst) -> + {integer,N} = Slot, + [{bs_save2,Ctx,N}]; +cg_instr(bs_set_position, [Ctx,Pos], _Dst) -> + [{bs_set_position,Ctx,Pos}]; +cg_instr(build_stacktrace, Args, Dst) -> + setup_args(Args) ++ [build_stacktrace|copy({x,0}, Dst)]; +cg_instr(set_tuple_element=Op, [New,Tuple,{integer,Index}], _Dst) -> + [{Op,New,Tuple,Index}]; +cg_instr({float,clearerror}, [], _Dst) -> + [fclearerror]; +cg_instr({float,get}, [Src], Dst) -> + [{fmove,Src,Dst}]; +cg_instr({float,put}, [Src], Dst) -> + [{fmove,Src,Dst}]; +cg_instr(get_hd=Op, [Src], Dst) -> + [{Op,Src,Dst}]; +cg_instr(get_tl=Op, [Src], Dst) -> + [{Op,Src,Dst}]; +cg_instr(get_tuple_element=Op, [Src,{integer,N}], Dst) -> + [{Op,Src,N,Dst}]; +cg_instr(put_list=Op, [Hd,Tl], Dst) -> + [{Op,Hd,Tl,Dst}]; +cg_instr(put_tuple, Elements, Dst) -> + [{put_tuple2,Dst,{list,Elements}}]; +cg_instr(put_tuple_arity, [{integer,Arity}], Dst) -> + [{put_tuple,Arity,Dst}]; +cg_instr(put_tuple_elements, Elements, _Dst) -> + [{put,E} || E <- Elements]; +cg_instr(raw_raise, Args, Dst) -> + setup_args(Args) ++ [raw_raise|copy({x,0}, Dst)]; +cg_instr(remove_message, [], _Dst) -> + [remove_message]; +cg_instr(resume, [A,B], _Dst) -> + [{bif,raise,{f,0},[A,B],{x,0}}]; +cg_instr(timeout, [], _Dst) -> + [timeout]. + +cg_test(bs_add=Op, Fail, [Src1,Src2,{integer,Unit}], Dst, _I) -> + [{Op,Fail,[Src1,Src2,Unit],Dst}]; +cg_test(bs_skip, Fail, Args, _Dst, I) -> + cg_bs_skip(Fail, Args, I); +cg_test(bs_utf8_size=Op, Fail, [Src], Dst, _I) -> + [{Op,Fail,Src,Dst}]; +cg_test(bs_utf16_size=Op, Fail, [Src], Dst, _I) -> + [{Op,Fail,Src,Dst}]; +cg_test({float,convert}, Fail, [Src], Dst, _I) -> + {f,0} = Fail, %Assertion. + [{fconv,Src,Dst}]; +cg_test({float,Op0}, Fail, Args, Dst, #cg_set{anno=Anno}) -> + Op = case Op0 of + '+' -> fadd; + '-' when length(Args) =:= 2 -> fsub; + '-' -> fnegate; + '*' -> fmul; + '/' -> fdiv + end, + [line(Anno),{bif,Op,Fail,Args,Dst}]; +cg_test(peek_message, Fail, [], Dst, _I) -> + [{loop_rec,Fail,{x,0}}|copy({x,0}, Dst)]; +cg_test(put_map, Fail, [{atom,exact},SrcMap|Ss], Dst, Set) -> + Live = get_live(Set), + [{put_map_exact,Fail,SrcMap,Dst,Live,{list,Ss}}]; +cg_test(wait_timeout, Fail, [Timeout], _Dst, _) -> + case Timeout of + {atom,infinity} -> + [{wait,Fail}]; + _ -> + [{wait_timeout,Fail,Timeout}] + end. + +cg_bs_get(Fail, #cg_set{dst=Dst0,args=[#b_literal{val=Type}|Ss0]}=Set, St) -> + Op = case Type of + integer -> bs_get_integer2; + float -> bs_get_float2; + binary -> bs_get_binary2; + utf8 -> bs_get_utf8; + utf16 -> bs_get_utf16; + utf32 -> bs_get_utf32 + end, + [Dst|Ss1] = beam_args([Dst0|Ss0], St), + Ss = case Ss1 of + [Ctx,{literal,Flags},Size,{integer,Unit}] -> + %% Plain integer/float/binary. + [Ctx,Size,Unit,field_flags(Flags, Set)]; + [Ctx,{literal,Flags}] -> + %% Utf8/16/32. + [Ctx,field_flags(Flags, Set)] + end, + Live = get_live(Set), + [{test,Op,Fail,Live,Ss,Dst}]. + +cg_bs_skip(Fail, [{atom,Type}|Ss0], Set) -> + Op = case Type of + utf8 -> bs_skip_utf8; + utf16 -> bs_skip_utf16; + utf32 -> bs_skip_utf32; + _ -> bs_skip_bits2 + end, + Live = get_live(Set), + Ss = case Ss0 of + [Ctx,{literal,Flags},Size,{integer,Unit}] -> + %% Plain integer/float/binary. + [Ctx,Size,Unit,field_flags(Flags, Set)]; + [Ctx,{literal,Flags}] -> + %% Utf8/16/32. + [Ctx,Live,field_flags(Flags, Set)] + end, + case {Type,Ss} of + {binary,[_,{atom,all},1,_]} -> + []; + {binary,[R,{atom,all},U,_]} -> + [{test,bs_test_unit,Fail,[R,U]}]; + {_,_} -> + [{test,Op,Fail,Ss}] + end. + +field_flags(Flags, #cg_set{anno=#{location:={File,Line}}}) -> + {field_flags,[{anno,[Line,{file,File}]}|Flags]}; +field_flags(Flags, _) -> + {field_flags,Flags}. + +cg_bs_put(Fail, [{atom,Type},{literal,Flags}|Args]) -> + Op = case Type of + integer -> bs_put_integer; + float -> bs_put_float; + binary -> bs_put_binary; + utf8 -> bs_put_utf8; + utf16 -> bs_put_utf16; + utf32 -> bs_put_utf32 + end, + case Args of + [Src,Size,{integer,Unit}] -> + [{Op,Fail,Size,Unit,{field_flags,Flags},Src}]; + [Src] -> + [{Op,Fail,{field_flags,Flags},Src}] + end. + +cg_bs_init(Dst, Size0, Alloc, Unit, Live, Fail) -> + Op = case Unit of + 1 -> bs_init_bits; + 8 -> bs_init2 + end, + Size = cg_bs_init_size(Size0), + [{Op,Fail,Size,Alloc,Live,{field_flags,[]},Dst}]. + +cg_bs_init_size({x,_}=R) -> R; +cg_bs_init_size({y,_}=R) -> R; +cg_bs_init_size({integer,Int}) -> Int. + +cg_catch(Agg, T0, Context, St0) -> + {Moves,T1} = cg_extract(T0, Agg, St0), + {T,St} = cg_block(T1, Context, St0), + {Moves++T,St}. + +cg_try(Agg, Tag, T0, Context, St0) -> + {Moves0,T1} = cg_extract(T0, Agg, St0), + Moves = order_moves(Moves0, {x,3}), + [#cg_set{op=kill_try_tag}|T2] = T1, + {T,St} = cg_block(T2, Context, St0), + {[{try_case,Tag}|Moves++T],St}. + +cg_extract([#cg_set{op=extract,dst=Dst0,args=Args0}|Is0], Agg, St) -> + [Dst,Agg,{integer,X}] = beam_args([Dst0|Args0], St), + {Ds,Is} = cg_extract(Is0, Agg, St), + case keymember(Dst, 3, Ds) of + true -> + %% This destination will be overwritten. + {Ds,Is}; + false -> + {copy({x,X}, Dst)++Ds,Is} + end; +cg_extract(Is, _, _) -> + {[],Is}. + +copy(Src, Src) -> []; +copy(Src, Dst) -> [{move,Src,Dst}]. + +force_reg({literal,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg({integer,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg({atom,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg({float,_}=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg(nil=Lit, Reg) -> + {Reg,[{move,Lit,Reg}]}; +force_reg({Kind,_}=R, _) when Kind =:= x; Kind =:= y -> + {R,[]}. + +%% successors(Terminator) -> [Successor]. +%% Return an ordset of all successors for the given terminator. + +successors(#cg_br{succ=Succ,fail=Fail}) -> + ordsets:from_list([Succ,Fail]); +successors(#cg_switch{fail=Fail,list=List}) -> + ordsets:from_list([Fail|[Lbl || {_,Lbl} <- List]]); +successors(#cg_ret{}) -> []. + +%% linearize(Blocks) -> [{BlockLabel,#cg_blk{}}]. +%% Linearize the intermediate representation of the code. Also +%% translate blocks from the SSA records to internal record types +%% used only in this module. + +linearize(Blocks) -> + Linear = beam_ssa:linearize(Blocks), + linearize_1(Linear, Blocks). + +linearize_1([{?BADARG_BLOCK,_}|Ls], Blocks) -> + linearize_1(Ls, Blocks); +linearize_1([{L,Block0}|Ls], Blocks) -> + Block = translate_block(L, Block0, Blocks), + [{L,Block}|linearize_1(Ls, Blocks)]; +linearize_1([], _Blocks) -> []. + +%% translate_block(BlockLabel, #b_blk{}, Blocks) -> #cg_blk{}. +%% Translate a block to the internal records used in this module. +%% Also eliminate phi nodes, replacing them with 'copy' instructions +%% in the predecessor blocks. + +translate_block(L, #b_blk{anno=Anno,is=Is0,last=Last0}, Blocks) -> + Last = translate_terminator(Last0), + PhiCopies = translate_phis(L, Last, Blocks), + Is1 = translate_is(Is0, PhiCopies), + Is = case Anno of + #{frame_size:=Size} -> + Alloc = #cg_alloc{stack=Size}, + [Alloc|Is1]; + #{} -> Is1 + end, + #cg_blk{anno=Anno,is=Is,last=Last}. + +translate_is([#b_set{op=phi}|Is], Tail) -> + translate_is(Is, Tail); +translate_is([#b_set{anno=Anno0,op=Op,dst=Dst,args=Args}=I|Is], Tail) -> + Anno = case beam_ssa:clobbers_xregs(I) of + true -> Anno0#{clobbers=>true}; + false -> Anno0 + end, + [#cg_set{anno=Anno,op=Op,dst=Dst,args=Args}|translate_is(Is, Tail)]; +translate_is([], Tail) -> Tail. + +translate_terminator(#b_ret{anno=Anno,arg=Arg}) -> + Dealloc = case Anno of + #{deallocate:=N} -> N; + #{} -> none + end, + #cg_ret{arg=Arg,dealloc=Dealloc}; +translate_terminator(#b_br{bool=#b_literal{val=true},succ=Succ}) -> + #cg_br{bool=#b_literal{val=true},succ=Succ,fail=Succ}; +translate_terminator(#b_br{bool=#b_literal{val=false},fail=Fail}) -> + #cg_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}; +translate_terminator(#b_br{bool=Bool,succ=Succ,fail=Fail}) -> + #cg_br{bool=Bool,succ=Succ,fail=Fail}; +translate_terminator(#b_switch{arg=Bool,fail=Fail,list=List}) -> + #cg_switch{arg=Bool,fail=Fail,list=List}. + +translate_phis(L, #cg_br{succ=Target,fail=Target}, Blocks) -> + #b_blk{is=Is} = maps:get(Target, Blocks), + Phis = takewhile(fun(#b_set{op=phi}) -> true; + (#b_set{}) -> false + end, Is), + phi_copies(Phis, L); +translate_phis(_, _, _) -> []. + +phi_copies([#b_set{dst=Dst,args=PhiArgs}|Sets], L) -> + CopyArgs = [V || {V,Target} <- PhiArgs, Target =:= L], + [#cg_set{op=copy,dst=Dst,args=CopyArgs}|phi_copies(Sets, L)]; +phi_copies([], _) -> []. + +%% opt_move_to_x0([Instruction]) -> [Instruction]. +%% Simple peep-hole optimization to move a {move,Any,{x,0}} past +%% any kill up to the next call instruction. (To give the loader +%% an opportunity to combine the 'move' and the 'call' instructions.) + +opt_move_to_x0(Moves) -> + opt_move_to_x0(Moves, []). + +opt_move_to_x0([{move,_,{x,0}}=I|Is0], Acc0) -> + case move_past_kill(Is0, I, Acc0) of + impossible -> opt_move_to_x0(Is0, [I|Acc0]); + {Is,Acc} -> opt_move_to_x0(Is, Acc) + end; +opt_move_to_x0([I|Is], Acc) -> + opt_move_to_x0(Is, [I|Acc]); +opt_move_to_x0([], Acc) -> reverse(Acc). + +move_past_kill([{kill,Src}|_], {move,Src,_}, _) -> + impossible; +move_past_kill([{kill,_}=I|Is], Move, Acc) -> + move_past_kill(Is, Move, [I|Acc]); +move_past_kill(Is, Move, Acc) -> + {Is,[Move|Acc]}. + +%% setup_args(Args, Anno, Context) -> [Instruction]. +%% setup_args(Args) -> [Instruction]. +%% Set up X registers for a call. + +setup_args(Args, Anno, none, St) -> + case {setup_args(Args),kill_yregs(Anno, St)} of + {Moves,[]} -> + Moves; + {Moves,Kills} -> + opt_move_to_x0(Moves ++ Kills) + end; +setup_args(Args, _, _, _) -> + setup_args(Args). + +setup_args([]) -> + []; +setup_args([_|_]=Args) -> + Moves = gen_moves(Args, 0, []), + Scratch = {x,1+last(sort([length(Args)-1|[X || {x,X} <- Args]]))}, + order_moves(Moves, Scratch). + +%% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}]. +%% Kill Y registers that will not be used again. + +kill_yregs(#{kill_yregs:=Kill}, #cg{regs=Regs}) -> + ordsets:from_list([{kill,maps:get(V, Regs)} || V <- Kill]); +kill_yregs(#{}, #cg{}) -> []. + +%% gen_moves(As, I, Acc) +%% Generate the basic move instruction to move the arguments +%% to their proper registers. The list will be sorted on +%% destinations. (I.e. the move to {x,0} will be first -- +%% see the comment to order_moves/2.) + +gen_moves([A|As], I, Acc) -> + gen_moves(As, I+1, copy(A, {x,I}) ++ Acc); +gen_moves([], _, Acc) -> + keysort(3, Acc). + +%% order_moves([Move], ScratchReg) -> [Move] +%% Orders move instruction so that source registers are not +%% destroyed before they are used. If there are cycles +%% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), +%% the scratch register is used to break up the cycle. +%% If possible, the first move of the input list is placed +%% last in the result list (to make the move to {x,0} occur +%% just before the call to allow the Beam loader to coalesce +%% the instructions). + +order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). + +order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> + {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), + Acc = reverse(Chain, Acc0), + order_moves(Ms, ScrReg, Acc); +order_moves([], _, Acc) -> Acc. + +collect_chain(Ms, Path, ScrReg) -> + collect_chain(Ms, Path, [], ScrReg). + +collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> + case keymember(Src, 3, Path) of + false -> + collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg); + true -> + %% There is a cycle, which we must break up. + {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)} + end; +collect_chain([M|Ms], Path, Others, ScrReg) -> + collect_chain(Ms, Path, [M|Others], ScrReg); +collect_chain([], Path, Others, _) -> + {Path,Others}. + +break_up_cycle({move,Src,_}=M, Path, ScrReg) -> + [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. + +break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> + [{move,Src,ScrReg}|Path]; +break_up_cycle1(Dst, [M|Path], LastMove) -> + [M|break_up_cycle1(Dst, Path, LastMove)]. + +%%% +%%% General utility functions. +%%% + +verify_beam_register({x,_}=Reg) -> Reg. + +is_beam_register({x,_}) -> true; +is_beam_register(_) -> false. + +get_register(V, Regs) -> + case is_beam_register(V) of + true -> V; + false -> maps:get(V, Regs) + end. + +beam_args(As, St) -> + [beam_arg(A, St) || A <- As]. + +beam_arg(#b_var{}=Name, #cg{regs=Regs}) -> + maps:get(Name, Regs); +beam_arg(#b_literal{val=Val}, _) -> + if + is_atom(Val) -> {atom,Val}; + is_float(Val) -> {float,Val}; + is_integer(Val) -> {integer,Val}; + Val =:= [] -> nil; + true -> {literal,Val} + end; +beam_arg(Reg, _) -> + verify_beam_register(Reg). + +new_block_label(L, St0) -> + {_Lbl,St} = label_for_block(L, St0), + St. + +def_block_label(L, #cg{labels=Labels,used_labels=Used}) -> + Lbl = maps:get(L, Labels), + case gb_sets:is_member(Lbl, Used) of + false -> []; + true -> [{label,Lbl}] + end. + +use_block_labels(Ls, St) -> + mapfoldl(fun use_block_label/2, St, Ls). + +use_block_label(L, #cg{used_labels=Used,catches=Catches}=St0) -> + {Lbl,St} = label_for_block(L, St0), + case gb_sets:is_member(L, Catches) of + true -> + {{catch_tag,{f,Lbl}}, + St#cg{used_labels=gb_sets:add(Lbl, Used)}}; + false -> + {{f,Lbl},St#cg{used_labels=gb_sets:add(Lbl, Used)}} + end. + +label_for_block(L, #cg{labels=Labels0}=St0) -> + case Labels0 of + #{L:=Lbl} -> + {Lbl,St0}; + #{} -> + {Lbl,St} = new_label(St0), + Labels = Labels0#{L=>Lbl}, + {Lbl,St#cg{labels=Labels}} + end. + +%% local_func_label(Name, Arity, State) -> {Label,State'} +%% local_func_label({Name,Arity}, State) -> {Label,State'} +%% Get the function entry label for a local function. + +local_func_label(Name, Arity, St) -> + local_func_label({Name,Arity}, St). + +local_func_label(Key, #cg{functable=Map}=St0) -> + case Map of + #{Key := Label} -> + {Label,St0}; + _ -> + {Label,St} = new_label(St0), + {Label,St#cg{functable=Map#{Key => Label}}} + end. + +%% is_gc_bif(Name, Args) -> true|false. +%% Determines whether the BIF Name/Arity might do a GC. + +-spec is_gc_bif(atom(), [beam_ssa:value()]) -> boolean(). + +is_gc_bif(hd, [_]) -> false; +is_gc_bif(tl, [_]) -> false; +is_gc_bif(self, []) -> false; +is_gc_bif(node, []) -> false; +is_gc_bif(node, [_]) -> false; +is_gc_bif(element, [_,_]) -> false; +is_gc_bif(get, [_]) -> false; +is_gc_bif(is_map_key, [_,_]) -> false; +is_gc_bif(map_get, [_,_]) -> false; +is_gc_bif(tuple_size, [_]) -> false; +is_gc_bif(Bif, Args) -> + Arity = length(Args), + not (erl_internal:bool_op(Bif, Arity) orelse + erl_internal:new_type_test(Bif, Arity) orelse + erl_internal:comp_op(Bif, Arity)). + +%% new_label(St) -> {L,St}. + +new_label(#cg{lcount=Next}=St) -> + {Next,St#cg{lcount=Next+1}}. + +%% call_line(tail|body, Func, Anno) -> [] | [{line,...}]. +%% Produce a line instruction if it will be needed by the +%% call to Func. + +call_line(_Context, {extfunc,Mod,Name,Arity}, Anno) -> + case erl_bifs:is_safe(Mod, Name, Arity) of + false -> + %% The call could be to a BIF. + %% We'll need a line instruction in case the + %% BIF call fails. + [line(Anno)]; + true -> + %% Call to a safe BIF. Since it cannot fail, + %% we don't need any line instruction here. + [] + end; +call_line(body, _, Anno) -> + [line(Anno)]; +call_line(tail, local, _) -> + %% Tail-recursive call to a local function. A line + %% instruction will not be useful. + []; +call_line(tail, _, Anno) -> + %% Call to a fun. + [line(Anno)]. + +%% line(Le) -> {line,[] | {location,File,Line}} +%% Create a line instruction, containing information about +%% the current filename and line number. A line information +%% instruction should be placed before any operation that could +%% cause an exception. + +line(#{location:={File,Line}}) -> + {line,[{location,File,Line}]}; +line(#{}) -> + {line,[]}. + +flatmapfoldl(F, Accu0, [Hd|Tail]) -> + {R,Accu1} = F(Hd, Accu0), + {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), + {R++Rs,Accu2}; +flatmapfoldl(_, Accu, []) -> {[],Accu}. diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl new file mode 100644 index 0000000000..e78e4647a8 --- /dev/null +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -0,0 +1,1113 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% +%% Dead code is code that is executed but has no effect. This +%% optimization pass either removes dead code or jumps around it, +%% potentially making it unreachable so that it can be dropped +%% the next time beam_ssa:linearize/1 is called. +%% + +-module(beam_ssa_dead). +-export([opt/1]). + +-include("beam_ssa.hrl"). +-import(lists, [append/1,keymember/3,last/1,member/2, + takewhile/2,reverse/1]). + +-type used_vars() :: #{beam_ssa:label():=cerl_sets:set(beam_ssa:var_name())}. + +-type basic_type_test() :: atom() | {'is_tagged_tuple',pos_integer(),atom()}. +-type type_test() :: basic_type_test() | {'not',basic_type_test()}. +-type op_name() :: atom(). +-type basic_rel_op() :: {op_name(),beam_ssa:b_var(),beam_ssa:value()} | + {basic_type_test(),beam_ssa:value()}. +-type rel_op() :: {op_name(),beam_ssa:b_var(),beam_ssa:value()} | + {type_test(),beam_ssa:value()}. + +-record(st, + {bs :: beam_ssa:block_map(), + us :: used_vars(), + skippable :: #{beam_ssa:label():='true'}, + rel_op=none :: 'none' | rel_op(), + target=any :: 'any' | 'one_way' | beam_ssa:label() + }). + +-spec opt([{Label0,Block0}]) -> [{Label,Block}] when + Label0 :: beam_ssa:label(), + Block0 :: beam_ssa:b_blk(), + Label :: beam_ssa:label(), + Block :: beam_ssa:b_blk(). + +opt(Linear) -> + {Used,Skippable} = used_vars(Linear), + Blocks0 = maps:from_list(Linear), + St0 = #st{bs=Blocks0,us=Used,skippable=Skippable}, + St = shortcut_opt(St0), + #st{bs=Blocks} = combine_eqs(St#st{us=#{}}), + beam_ssa:linearize(Blocks). + +%%% +%%% Shortcut br/switch targets. +%%% +%%% A br/switch may branch to another br/switch that in turn always +%%% branches to another target. Rewrite br/switch to refer to the +%%% ultimate targets directly. That will save execution time, but +%%% could also reduce the size of the code if some of the original +%%% targets become unreachable and be deleted. +%%% +%%% When rewriting branches, we must be careful not to skip instructions +%%% that have side effects or that bind variables that will be used +%%% at the new target. +%%% +%%% We must also avoid branching to phi nodes. The reason is +%%% twofold. First, we might create a critical edge which is strictly +%%% forbidden. Second, there will be a branch from a block that is not +%%% listed in the list of predecessors in the phi node. Those +%%% limitations could probably be overcome, but it is not clear how +%%% much that would improve the code. +%%% + +shortcut_opt(#st{bs=Blocks}=St) -> + %% Processing the blocks in reverse post order seems to give more + %% opportunities for optimizations compared to post order. (Based on + %% running scripts/diffable with both PO and RPO and looking at + %% the diff.) + %% + %% Unfortunately, processing the blocks in reverse post order + %% potentially makes the time complexity quadratic, instead of + %% linear for post order processing. We avoid drastic slowdowns by + %% limiting how far we search forward to a common block that + %% both the success and failure label will reach (see the comment + %% in the first clause of shortcut_2/5). + + Ls = beam_ssa:rpo(Blocks), + shortcut_opt(Ls, #{}, St). + +shortcut_opt([L|Ls], Bs, #st{bs=Blocks0}=St) -> + #b_blk{is=Is,last=Last0} = Blk0 = get_block(L, St), + case shortcut_terminator(Last0, Is, L, Bs, St) of + Last0 -> + %% No change. No need to update the block. + shortcut_opt(Ls, Bs, St); + Last -> + %% The terminator was simplified in some way. + %% Update the block. + Blk = Blk0#b_blk{last=Last}, + Blocks = Blocks0#{L=>Blk}, + shortcut_opt(Ls, Bs, St#st{bs=Blocks}) + end; +shortcut_opt([], _, St) -> St. + +shortcut_terminator(#b_br{bool=#b_literal{val=true},succ=Succ0}, + _Is, From, Bs, St0) -> + St = St0#st{rel_op=none}, + shortcut(Succ0, From, Bs, St); +shortcut_terminator(#b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0}=Br, + Is, From, Bs, St0) -> + St = St0#st{target=one_way}, + RelOp = get_rel_op(Bool, Is), + + %% The boolean in a `br` is seldom used by the successors. By + %% not binding its value unless it is actually used we might be able + %% to skip some work in shortcut/4 and sub/2. + SuccBs = bind_var_if_used(Succ0, Bool, #b_literal{val=true}, Bs, St), + BrSucc = shortcut(Succ0, From, SuccBs, St#st{rel_op=RelOp}), + FailBs = bind_var_if_used(Fail0, Bool, #b_literal{val=false}, Bs, St), + BrFail = shortcut(Fail0, From, FailBs, St#st{rel_op=invert_op(RelOp)}), + + case {BrSucc,BrFail} of + {#b_br{bool=#b_literal{val=true},succ=Succ}, + #b_br{bool=#b_literal{val=true},succ=Fail}} + when Succ =/= Succ0; Fail =/= Fail0 -> + %% One or both of the targets were cut short. + beam_ssa:normalize(Br#b_br{succ=Succ,fail=Fail}); + {_,_} -> + %% No change. + Br + end; +shortcut_terminator(#b_switch{arg=Bool,list=List0}=Sw, _Is, From, Bs, St) -> + List = shortcut_switch(List0, Bool, From, Bs, St), + beam_ssa:normalize(Sw#b_switch{list=List}); +shortcut_terminator(Last, _Is, _Bs, _From, _St) -> + Last. + +shortcut_switch([{Lit,L0}|T], Bool, From, Bs, St0) -> + RelOp = {'=:=',Bool,Lit}, + St = St0#st{rel_op=RelOp}, + #b_br{bool=#b_literal{val=true},succ=L} = + shortcut(L0, From, bind_var(Bool, Lit, Bs), St#st{target=one_way}), + [{Lit,L}|shortcut_switch(T, Bool, From, Bs, St0)]; +shortcut_switch([], _, _, _, _) -> []. + +shortcut(L, _From, Bs, #st{rel_op=none,target=one_way}) when map_size(Bs) =:= 0 -> + %% There is no way that we can find a suitable branch, because there is no + %% relational operator stored, there are no bindings, and the block L can't + %% have any phi nodes from which we could pick bindings because when the target + %% is `one_way`, it implies the From block has a two-way `br` terminator. + #b_br{bool=#b_literal{val=true},succ=L,fail=L}; +shortcut(L, From, Bs, St) -> + shortcut_1(L, From, Bs, cerl_sets:new(), St). + +shortcut_1(L, From, Bs0, UnsetVars0, St) -> + case shortcut_2(L, From, Bs0, UnsetVars0, St) of + none -> + %% No more shortcuts found. Package up the previous + %% label in an unconditional branch. + #b_br{bool=#b_literal{val=true},succ=L,fail=L}; + {#b_br{bool=#b_var{}}=Br,_,_} -> + %% This is a two-way branch. We can't do any better. + Br; + {#b_br{bool=#b_literal{val=true},succ=Succ},Bs,UnsetVars} -> + %% This is a safe `br`, but try to find a better one. + shortcut_1(Succ, L, Bs, UnsetVars, St) + end. + +%% Try to shortcut this block, branching to a successor. +shortcut_2(L, From, Bs, UnsetVars, St) -> + case cerl_sets:size(UnsetVars) of + SetSize when SetSize > 128 -> + %% This is an heuristic to limit the search for a forced label + %% before it drastically slows down the compiler. Experiments + %% with scripts/diffable showed that limits larger than 31 did not + %% find any more opportunities for optimization. + none; + _SetSize -> + shortcut_3(L, From, Bs, UnsetVars, St) + end. + +shortcut_3(L, From, Bs0, UnsetVars0, St) -> + #b_blk{is=Is,last=Last} = get_block(L, St), + case eval_is(Is, From, Bs0, St) of + none -> + %% It is not safe to avoid this block because it + %% has instructions with potential side effects. + none; + Bs -> + %% The instructions in the block (if any) don't + %% have any side effects and can be skipped. + %% Evaluate the terminator. + case eval_terminator(Last, Bs, St) of + none -> + %% The terminator is not suitable (could be + %% because it is a switch that can't be simplified + %% or it is a ret instruction). + none; + #b_br{}=Br -> + %% We have a potentially suitable br. + %% Now update the set of variables that will never + %% be set if this block will be skipped. + case update_unset_vars(L, Is, Br, UnsetVars0, St) of + unsafe -> + %% It is unsafe to use this br, + %% because it refers to a variable defined + %% in this block. + shortcut_unsafe_br(Br, L, Bs, UnsetVars0, St); + UnsetVars -> + %% Continue checking whether this br is + %% suitable. + shortcut_test_br(Br, L, Bs, UnsetVars, St) + end + end + end. + +shortcut_test_br(Br, From, Bs, UnsetVars, St) -> + case is_br_safe(UnsetVars, Br, St) of + false -> + shortcut_unsafe_br(Br, From, Bs, UnsetVars, St); + true -> + shortcut_safe_br(Br, From, Bs, UnsetVars, St) + end. + +shortcut_unsafe_br(Br, From, Bs, UnsetVars, #st{target=Target}=St) -> + %% Branching using this `br` is unsafe, either because it + %% is an unconditional branch to a phi node, or because + %% one or more of the variables that are not set will be + %% used. Try to follow branches of this `br`, to find a + %% safe `br`. + case Br of + #b_br{bool=#b_literal{val=true},succ=L} -> + case Target of + L -> + %% We have reached the forced target, and it + %% is unsafe. Give up. + none; + _ -> + %% Try following this branch to see whether it + %% leads to a safe `br`. + shortcut_2(L, From, Bs, UnsetVars, St) + end; + #b_br{bool=#b_var{},succ=Succ,fail=Fail} -> + case {Succ,Fail} of + {L,Target} -> + %% The failure label is the forced target. + %% Try following the success label to see + %% whether it also ultimately ends up at the + %% forced target. + shortcut_2(L, From, Bs, UnsetVars, St); + {Target,L} -> + %% The success label is the forced target. + %% Try following the failure label to see + %% whether it also ultimately ends up at the + %% forced target. + shortcut_2(L, From, Bs, UnsetVars, St); + {_,_} -> + case Target of + any -> + %% This two-way branch is unsafe. Try + %% reducing it to a one-way branch. + shortcut_two_way(Br, From, Bs, UnsetVars, St); + one_way -> + %% This two-way branch is unsafe. Try + %% reducing it to a one-way branch. + shortcut_two_way(Br, From, Bs, UnsetVars, St); + _ when is_integer(Target) -> + %% This two-way branch is unsafe, and + %% there already is a forced target. + %% Give up. + none + end + end + end. + +shortcut_safe_br(Br, From, Bs, UnsetVars, #st{target=Target}=St) -> + %% This `br` instruction is safe. It does not branch to a phi + %% node, and all variables that will be used are guaranteed to be + %% defined. + case Br of + #b_br{bool=#b_literal{val=true},succ=L} -> + %% This is a one-way branch. + case Target of + any -> + %% No forced target. Success! + {Br,Bs,UnsetVars}; + one_way -> + %% The target must be a one-way branch, which this + %% `br` is. Success! + {Br,Bs,UnsetVars}; + L when is_integer(Target) -> + %% The forced target is L. Success! + {Br,Bs,UnsetVars}; + _ when is_integer(Target) -> + %% Wrong forced target. Try following this branch + %% to see if it ultimately ends up at the forced + %% target. + shortcut_2(L, From, Bs, UnsetVars, St) + end; + #b_br{bool=#b_var{}} -> + %% This is a two-way branch. + if + Target =:= any; Target =:= one_way -> + %% No specific forced target. Try to reduce the + %% two-way branch to an one-way branch. + case shortcut_two_way(Br, From, Bs, UnsetVars, St) of + none when Target =:= any -> + %% This `br` can't be reduced to a one-way + %% branch. Return the `br` as-is. + {Br,Bs,UnsetVars}; + none when Target =:= one_way -> + %% This `br` can't be reduced to a one-way + %% branch. The caller wants a one-way + %% branch. Give up. + none; + {_,_,_}=Res -> + %% This `br` was successfully reduced to a + %% one-way branch. + Res + end; + is_integer(Target) -> + %% There is a forced target, which can't + %% be reached because this `br` is a two-way + %% branch. Give up. + none + end + end. + +update_unset_vars(L, Is, Br, UnsetVars, #st{skippable=Skippable}) -> + case is_map_key(L, Skippable) of + true -> + %% None of the variables used in this block are used in + %% the successors. Thus, there is no need to add the + %% variables to the set of unset variables. + case Br of + #b_br{bool=#b_var{}=Bool} -> + case keymember(Bool, #b_set.dst, Is) of + true -> + %% Bool is a variable defined in this + %% block. Using the br instruction from + %% this block (and skipping the body of + %% the block) is unsafe. + unsafe; + false -> + %% Bool is either a variable not defined + %% in this block or a literal. Adding it + %% to the UnsetVars set would not change + %% the outcome of the tests in + %% is_br_safe/2. + UnsetVars + end; + #b_br{} -> + UnsetVars + end; + false -> + %% Some variables defined in this block are used by + %% successors. We must update the set of unset variables. + SetInThisBlock = [V || #b_set{dst=V} <- Is], + cerl_sets:union(UnsetVars, cerl_sets:from_list(SetInThisBlock)) + end. + +shortcut_two_way(#b_br{succ=Succ,fail=Fail}, From, Bs0, UnsetVars0, St0) -> + case shortcut_2(Succ, From, Bs0, UnsetVars0, St0#st{target=Fail}) of + {#b_br{bool=#b_literal{},succ=Fail},_,_}=Res -> + Res; + none -> + St = St0#st{target=Succ}, + case shortcut_2(Fail, From, Bs0, UnsetVars0, St) of + {#b_br{bool=#b_literal{},succ=Succ},_,_}=Res -> + Res; + none -> + none + end + end. + +get_block(L, St) -> + #st{bs=#{L:=Blk}} = St, + Blk. + +is_br_safe(UnsetVars, Br, #st{us=Us}=St) -> + %% Check that none of the unset variables will be used. + case Br of + #b_br{bool=#b_var{}=V,succ=Succ,fail=Fail} -> + #{Succ:=Used0,Fail:=Used1} = Us, + + %% A two-way branch never branches to a phi node, so there + %% is no need to check for phi nodes here. + not cerl_sets:is_element(V, UnsetVars) andalso + cerl_sets:is_disjoint(Used0, UnsetVars) andalso + cerl_sets:is_disjoint(Used1, UnsetVars); + #b_br{succ=Same,fail=Same} -> + %% An unconditional branch must not jump to + %% a phi node. + not is_forbidden(Same, St) andalso + cerl_sets:is_disjoint(map_get(Same, Us), UnsetVars) + end. + +is_forbidden(L, St) -> + case get_block(L, St) of + #b_blk{is=[#b_set{op=phi}|_]} -> true; + #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + #b_blk{} -> false + end. + + +%% Evaluate the instructions in the block. +%% Return the updated bindings, or 'none' if there is +%% any instruction with potential side effects. + +eval_is([#b_set{op=phi,dst=Dst,args=Args}|Is], From, Bs0, St) -> + Val = get_phi_arg(Args, From), + Bs = bind_var(Dst, Val, Bs0), + eval_is(Is, From, Bs, St); +eval_is([#b_set{op={bif,_},dst=Dst}=I0|Is], From, Bs, St) -> + I = sub(I0, Bs), + case eval_bif(I, St) of + #b_literal{}=Val -> + eval_is(Is, From, bind_var(Dst, Val, Bs), St); + none -> + eval_is(Is, From, Bs, St) + end; +eval_is([#b_set{op=Op,dst=Dst}=I|Is], From, Bs, St) + when Op =:= is_tagged_tuple; Op =:= is_nonempty_list -> + #b_set{args=Args} = sub(I, Bs), + case eval_rel_op(Op, Args, St) of + #b_literal{}=Val -> + eval_is(Is, From, bind_var(Dst, Val, Bs), St); + none -> + eval_is(Is, From, Bs, St) + end; +eval_is([#b_set{}=I|Is], From, Bs, St) -> + case beam_ssa:no_side_effect(I) of + true -> + %% This instruction has no side effects. It can + %% safely be omitted. + eval_is(Is, From, Bs, St); + false -> + %% This instruction may have some side effect. + %% It is not safe to avoid this instruction. + none + end; +eval_is([], _From, Bs, _St) -> Bs. + +get_phi_arg([{Val,From}|_], From) -> Val; +get_phi_arg([_|As], From) -> get_phi_arg(As, From). + +eval_terminator(#b_br{bool=#b_var{}=Bool}=Br, Bs, _St) -> + case get_value(Bool, Bs) of + #b_literal{val=Val}=Lit -> + case is_boolean(Val) of + true -> + beam_ssa:normalize(Br#b_br{bool=Lit}); + false -> + %% Non-boolean literal. This means that this `br` + %% terminator will never actually be reached with + %% these bindings. (There must be a previous two-way + %% branch that branches the other way when Bool + %% is bound to a non-boolean literal.) + none + end; + #b_var{}=Var -> + beam_ssa:normalize(Br#b_br{bool=Var}) + end; +eval_terminator(#b_br{bool=#b_literal{}}=Br, _Bs, _St) -> + beam_ssa:normalize(Br); +eval_terminator(#b_switch{arg=Arg,fail=Fail,list=List}=Sw, Bs, St) -> + case get_value(Arg, Bs) of + #b_literal{}=Val -> + %% Literal argument. Simplify to a `br`. + beam_ssa:normalize(Sw#b_switch{arg=Val}); + #b_var{} -> + %% Try optimizing the switch. + case eval_switch(List, Arg, St, Fail) of + none -> + none; + To when is_integer(To) -> + %% Either one of the values in the switch + %% matched a previous value in a '=:=' test, or + %% none of the values matched a previous test. + #b_br{bool=#b_literal{val=true},succ=To,fail=To} + end + end; +eval_terminator(#b_ret{}, _Bs, _St) -> + none. + +eval_switch(List, Arg, #st{rel_op={_,Arg,_}=PrevOp}, Fail) -> + %% There is a previous relational operator testing the same variable. + %% Optimization may be possible. + eval_switch_1(List, Arg, PrevOp, Fail); +eval_switch(_, _, _, _) -> + %% There is either no previous relational operator, or it tests + %% a different variable. Nothing to optimize. + none. + +eval_switch_1([{Lit,Lbl}|T], Arg, PrevOp, Fail) -> + RelOp = {'=:=',Arg,Lit}, + case will_succeed(PrevOp, RelOp) of + yes -> + %% Success. This branch will always be taken. + Lbl; + no -> + %% This branch will never be taken. + eval_switch_1(T, Arg, PrevOp, Fail); + maybe -> + %% This label could be reached. + eval_switch_1(T, Arg, PrevOp, none) + end; +eval_switch_1([], _Arg, _PrevOp, Fail) -> + %% Fail is now either the failure label or 'none'. + Fail. + +bind_var_if_used(L, Var, Val0, Bs, #st{us=Us}) -> + case cerl_sets:is_element(Var, map_get(L, Us)) of + true -> + Val = get_value(Val0, Bs), + Bs#{Var=>Val}; + false -> + Bs + end. + +bind_var(Var, Val0, Bs) -> + Val = get_value(Val0, Bs), + Bs#{Var=>Val}. + +get_value(#b_var{}=Var, Bs) -> + case Bs of + #{Var:=Val} -> get_value(Val, Bs); + #{} -> Var + end; +get_value(#b_literal{}=Lit, _Bs) -> Lit. + +eval_bif(#b_set{op={bif,Bif},args=Args}, St) -> + Arity = length(Args), + case erl_bifs:is_pure(erlang, Bif, Arity) of + false -> + none; + true -> + case get_lit_args(Args) of + none -> + %% Not literal arguments. Try to evaluate + %% it based on a previous relational operator. + eval_rel_op({bif,Bif}, Args, St); + LitArgs -> + try apply(erlang, Bif, LitArgs) of + Val -> #b_literal{val=Val} + catch + error:_ -> none + end + end + end. + +get_lit_args([#b_literal{val=Lit1}]) -> + [Lit1]; +get_lit_args([#b_literal{val=Lit1}, + #b_literal{val=Lit2}]) -> + [Lit1,Lit2]; +get_lit_args([#b_literal{val=Lit1}, + #b_literal{val=Lit2}, + #b_literal{val=Lit3}]) -> + [Lit1,Lit2,Lit3]; +get_lit_args(_) -> none. + +%%% +%%% Handling of relational operators. +%%% + +get_rel_op(Bool, [_|_]=Is) -> + case last(Is) of + #b_set{op=Op,dst=Bool,args=Args} -> + normalize_op(Op, Args); + #b_set{} -> + none + end; +get_rel_op(_, []) -> none. + +%% normalize_op(Instruction) -> {Normalized,FailLabel} | error +%% Normalized = {Operator,Variable,Variable|Literal} | +%% {TypeTest,Variable} +%% Operation = '<' | '=<' | '=:=' | '=/=' | '>=' | '>' +%% TypeTest = is_atom | is_integer ... +%% Variable = #b_var{} +%% Literal = #b_literal{} +%% +%% Normalize a relational operator to facilitate further +%% comparisons between operators. Always make the register +%% operand the first operand. If there are two registers, +%% order the registers in lexical order. +%% +%% For example, this instruction: +%% +%% #b_set{op={bif,=<},args=[#b_literal{}, #b_var{}} +%% +%% will be normalized to: +%% +%% {'=<',#b_var{},#b_literal{}} + +-spec normalize_op(Op, Args) -> NormalizedOp | 'none' when + Op :: beam_ssa:op(), + Args :: [beam_ssa:value()], + NormalizedOp :: basic_rel_op(). + +normalize_op(is_tagged_tuple, [Arg,#b_literal{val=Size},#b_literal{val=Tag}]) + when is_integer(Size), is_atom(Tag) -> + {{is_tagged_tuple,Size,Tag},Arg}; +normalize_op(is_nonempty_list, [Arg]) -> + {is_nonempty_list,Arg}; +normalize_op({bif,Bif}, [Arg]) -> + case erl_internal:new_type_test(Bif, 1) of + true -> {Bif,Arg}; + false -> none + end; +normalize_op({bif,Bif}, [_,_]=Args) -> + case erl_internal:comp_op(Bif, 2) of + true -> + normalize_op_1(Bif, Args); + false -> + none + end; +normalize_op(_, _) -> none. + +normalize_op_1(Bif, Args) -> + case Args of + [#b_literal{}=Arg1,#b_var{}=Arg2] -> + {turn_op(Bif),Arg2,Arg1}; + [#b_var{}=Arg1,#b_literal{}=Arg2] -> + {Bif,Arg1,Arg2}; + [#b_var{}=A,#b_var{}=B] -> + if A < B -> {Bif,A,B}; + true -> {turn_op(Bif),B,A} + end; + [#b_literal{},#b_literal{}] -> + none + end. + +-spec invert_op(basic_rel_op() | 'none') -> rel_op() | 'none'. + +invert_op({Op,Arg1,Arg2}) -> + {invert_op_1(Op),Arg1,Arg2}; +invert_op({TypeTest,Arg}) -> + {{'not',TypeTest},Arg}; +invert_op(none) -> none. + +invert_op_1('>=') -> '<'; +invert_op_1('<') -> '>='; +invert_op_1('=<') -> '>'; +invert_op_1('>') -> '=<'; +invert_op_1('=:=') -> '=/='; +invert_op_1('=/=') -> '=:='; +invert_op_1('==') -> '/='; +invert_op_1('/=') -> '=='. + +turn_op('<') -> '>'; +turn_op('=<') -> '>='; +turn_op('>') -> '<'; +turn_op('>=') -> '=<'; +turn_op('=:='=Op) -> Op; +turn_op('=/='=Op) -> Op; +turn_op('=='=Op) -> Op; +turn_op('/='=Op) -> Op. + +eval_rel_op(_Bif, _Args, #st{rel_op=none}) -> + none; +eval_rel_op(Bif, Args, #st{rel_op=Prev}) -> + case normalize_op(Bif, Args) of + none -> + none; + RelOp -> + case will_succeed(Prev, RelOp) of + yes -> #b_literal{val=true}; + no -> #b_literal{val=false}; + maybe -> none + end + end. + +%% will_succeed(PrevCondition, Condition) -> yes | no | maybe +%% PrevCondition is a condition known to be true. This function +%% will tell whether Condition will succeed. + +will_succeed({_Op,_Var,_Value}=Same, {_Op,_Var,_Value}=Same) -> + %% Repeated test. + yes; +will_succeed({Op1,Var,#b_literal{val=A}}, {Op2,Var,#b_literal{val=B}}) -> + will_succeed_1(Op1, A, Op2, B); +will_succeed({Op1,Var,#b_var{}=A}, {Op2,Var,#b_var{}=B}) -> + will_succeed_vars(Op1, A, Op2, B); +will_succeed({'=:=',Var,#b_literal{val=A}}, {TypeTest,Var}) -> + eval_type_test(TypeTest, A); +will_succeed({_,_}=Same, {_,_}=Same) -> + %% Repeated type test. + yes; +will_succeed({Test1,Var}, {Test2,Var}) -> + will_succeed_test(Test1, Test2); +will_succeed({_,_}, {_,_}) -> + maybe; +will_succeed({_,_}, {_,_,_}) -> + maybe; +will_succeed({_,_,_}, {_,_}) -> + maybe; +will_succeed({_,_,_}, {_,_,_}) -> + maybe. + +will_succeed_test({'not',Test1}, Test2) -> + case Test1 =:= Test2 of + true -> no; + false -> maybe + end; +will_succeed_test(is_tuple, {is_tagged_tuple,_,_}) -> + maybe; +will_succeed_test({is_tagged_tuple,_,_}, is_tuple) -> + yes; +will_succeed_test(is_list, is_nonempty_list) -> + maybe; +will_succeed_test(is_nonempty_list, is_list) -> + yes; +will_succeed_test(_T1, _T2) -> + maybe. + +will_succeed_1('=:=', A, '<', B) -> + if + B =< A -> no; + true -> yes + end; +will_succeed_1('=:=', A, '=<', B) -> + if + B < A -> no; + true -> yes + end; +will_succeed_1('=:=', A, '=:=', B) when A =/= B -> + no; +will_succeed_1('=:=', A, '=/=', B) -> + if + A =:= B -> no; + true -> yes + end; +will_succeed_1('=:=', A, '>=', B) -> + if + B > A -> no; + true -> yes + end; +will_succeed_1('=:=', A, '>', B) -> + if + B >= A -> no; + true -> yes + end; + +will_succeed_1('=/=', A, '=:=', B) when A =:= B -> no; + +will_succeed_1('<', A, '=:=', B) when B >= A -> no; +will_succeed_1('<', A, '=/=', B) when B >= A -> yes; +will_succeed_1('<', A, '<', B) when B >= A -> yes; +will_succeed_1('<', A, '=<', B) when B > A -> yes; +will_succeed_1('<', A, '>=', B) when B > A -> no; +will_succeed_1('<', A, '>', B) when B >= A -> no; + +will_succeed_1('=<', A, '=:=', B) when B > A -> no; +will_succeed_1('=<', A, '=/=', B) when B > A -> yes; +will_succeed_1('=<', A, '<', B) when B > A -> yes; +will_succeed_1('=<', A, '=<', B) when B >= A -> yes; +will_succeed_1('=<', A, '>=', B) when B > A -> no; +will_succeed_1('=<', A, '>', B) when B >= A -> no; + +will_succeed_1('>=', A, '=:=', B) when B < A -> no; +will_succeed_1('>=', A, '=/=', B) when B < A -> yes; +will_succeed_1('>=', A, '<', B) when B =< A -> no; +will_succeed_1('>=', A, '=<', B) when B < A -> no; +will_succeed_1('>=', A, '>=', B) when B =< A -> yes; +will_succeed_1('>=', A, '>', B) when B < A -> yes; + +will_succeed_1('>', A, '=:=', B) when B =< A -> no; +will_succeed_1('>', A, '=/=', B) when B =< A -> yes; +will_succeed_1('>', A, '<', B) when B =< A -> no; +will_succeed_1('>', A, '=<', B) when B < A -> no; +will_succeed_1('>', A, '>=', B) when B =< A -> yes; +will_succeed_1('>', A, '>', B) when B < A -> yes; + +will_succeed_1('==', A, '==', B) -> + if + A == B -> yes; + true -> no + end; +will_succeed_1('==', A, '/=', B) -> + if + A == B -> no; + true -> yes + end; +will_succeed_1('/=', A, '/=', B) when A == B -> yes; +will_succeed_1('/=', A, '==', B) when A == B -> no; + +will_succeed_1(_, _, _, _) -> maybe. + +will_succeed_vars('=/=', Val, '=:=', Val) -> no; +will_succeed_vars('=:=', Val, '=/=', Val) -> no; +will_succeed_vars('=:=', Val, '>=', Val) -> yes; +will_succeed_vars('=:=', Val, '=<', Val) -> yes; + +will_succeed_vars('/=', Val1, '==', Val2) when Val1 == Val2 -> no; +will_succeed_vars('==', Val1, '/=', Val2) when Val1 == Val2 -> no; + +will_succeed_vars(_, _, _, _) -> maybe. + +eval_type_test(Test, Arg) -> + case eval_type_test_1(Test, Arg) of + true -> yes; + false -> no + end. + +eval_type_test_1(is_nonempty_list, Arg) -> + case Arg of + [_|_] -> true; + _ -> false + end; +eval_type_test_1({is_tagged_tuple,Sz,Tag}, Arg) -> + if + tuple_size(Arg) =:= Sz, element(1, Arg) =:= Tag -> + true; + true -> + false + end; +eval_type_test_1(Test, Arg) -> + erlang:Test(Arg). + +%%% +%%% Combine bif:'=:=' and switch instructions +%%% to switch instructions. +%%% +%%% Consider this code: +%%% +%%% 0: +%%% @ssa_bool = bif:'=:=' Var, literal 1 +%%% br @ssa_bool, label 2, label 3 +%%% +%%% 2: +%%% ret literal a +%%% +%%% 3: +%%% @ssa_bool:7 = bif:'=:=' Var, literal 2 +%%% br @ssa_bool:7, label 4, label 999 +%%% +%%% 4: +%%% ret literal b +%%% +%%% 999: +%%% . +%%% . +%%% . +%%% +%%% The two bif:'=:=' instructions can be combined +%%% to a switch: +%%% +%%% 0: +%%% switch Var, label 999, [ { literal 1, label 2 }, +%%% { literal 2, label 3 } ] +%%% +%%% 2: +%%% ret literal a +%%% +%%% 4: +%%% ret literal b +%%% +%%% 999: +%%% . +%%% . +%%% . +%%% + +combine_eqs(#st{bs=Blocks}=St) -> + Ls = reverse(beam_ssa:rpo(Blocks)), + combine_eqs_1(Ls, St). + +combine_eqs_1([L|Ls], #st{bs=Blocks0}=St0) -> + case comb_get_sw(L, St0) of + none -> + combine_eqs_1(Ls, St0); + {_,Arg,_,Fail0,List0} -> + case comb_get_sw(Fail0, St0) of + {true,Arg,Fail1,Fail,List1} -> + %% Another switch/br with the same arguments was + %% found. Try combining them. + case combine_lists(Fail1, List0, List1, Blocks0) of + none -> + %% Different types of literals in the lists, + %% or the success cases in the first switch + %% could branch to the second switch + %% (increasing code size and repeating tests). + combine_eqs_1(Ls, St0); + List -> + %% Everything OK! Combine the lists. + Sw0 = #b_switch{arg=Arg,fail=Fail,list=List}, + Sw = beam_ssa:normalize(Sw0), + Blk0 = map_get(L, Blocks0), + Blk = Blk0#b_blk{last=Sw}, + Blocks = Blocks0#{L:=Blk}, + St = St0#st{bs=Blocks}, + combine_eqs_1(Ls, St) + end; + {true,_OtherArg,_,_,_} -> + %% The other switch/br uses a different Arg. + combine_eqs_1(Ls, St0); + {false,_,_,_,_} -> + %% Not safe: Bindings of variables that will be used + %% or execution of instructions with potential + %% side effects will be skipped. + combine_eqs_1(Ls, St0); + none -> + %% No switch/br at this label. + combine_eqs_1(Ls, St0) + end + end; +combine_eqs_1([], St) -> St. + +comb_get_sw(L, Blocks) -> + comb_get_sw(L, true, Blocks). + +comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}) -> + #b_blk{is=Is,last=Last} = map_get(L, Blocks), + Safe1 = Safe0 andalso is_map_key(L, Skippable), + case Last of + #b_ret{} -> + none; + #b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail} -> + case comb_is(Is, Bool, Safe1) of + {none,_} -> + none; + {#b_set{op={bif,'=:='},args=[#b_var{}=Arg,#b_literal{}=Lit]},Safe} -> + {Safe,Arg,L,Fail,[{Lit,Succ}]}; + {#b_set{},_} -> + none + end; + #b_br{} -> + none; + #b_switch{arg=#b_var{}=Arg,fail=Fail,list=List} -> + {none,Safe} = comb_is(Is, none, Safe1), + {Safe,Arg,L,Fail,List} + end. + +comb_is([#b_set{dst=#b_var{}=Bool}=I], Bool, Safe) -> + {I,Safe}; +comb_is([#b_set{}=I|Is], Bool, Safe0) -> + Safe = Safe0 andalso beam_ssa:no_side_effect(I), + comb_is(Is, Bool, Safe); +comb_is([], _Bool, Safe) -> + {none,Safe}. + +%% combine_list(Fail, List1, List2, Blocks) -> List|none. +%% Try to combine two switch lists, returning the combined +%% list or 'none' if not possible. +%% +%% The values in the two lists must be all of the same type. +%% +%% The code reached from the labels in the first list must +%% not reach the failure label (if they do, tests could +%% be repeated). +%% + +combine_lists(Fail, L1, L2, Blocks) -> + Ls = beam_ssa:rpo([Lbl || {_,Lbl} <- L1], Blocks), + case member(Fail, Ls) of + true -> + %% One or more of labels in the first list + %% could reach the failure label. That + %% means that the second switch/br instruction + %% will be retained, increasing code size and + %% potentially also execution time. + none; + false -> + %% The combined switch will replace both original + %% br/switch instructions, leading to a reduction in code + %% size and potentially also in execution time. + combine_lists_1(L1, L2) + end. + +combine_lists_1(List0, List1) -> + case are_lists_compatible(List0, List1) of + true -> + First = maps:from_list(List0), + List0 ++ [{Val,Lbl} || {Val,Lbl} <- List1, + not is_map_key(Val, First)]; + false -> + none + end. + +are_lists_compatible([{#b_literal{val=Val1},_}|_], + [{#b_literal{val=Val2},_}|_]) -> + case lit_type(Val1) of + none -> false; + Type -> Type =:= lit_type(Val2) + end. + +lit_type(Val) -> + if + is_atom(Val) -> atom; + is_float(Val) -> float; + is_integer(Val) -> integer; + true -> none + end. + +%%% +%%% Calculate used variables for each block. +%%% + +used_vars(Linear) -> + used_vars(reverse(Linear), #{}, #{}). + +used_vars([{L,#b_blk{is=Is}=Blk}|Bs], UsedVars0, Skip0) -> + %% Calculate the variables used by each block and its + %% successors. This information is used by + %% shortcut_opt/1. + + Successors = beam_ssa:successors(Blk), + Used0 = used_vars_succ(Successors, L, UsedVars0, cerl_sets:new()), + Used = used_vars_blk(Blk, Used0), + UsedVars = used_vars_phis(Is, L, Used, UsedVars0), + + %% combine_eqs/1 needs different variable usage information than + %% shortcut_opt/1. The Skip map will have an entry for each block + %% that can be skipped (does not bind any variable used in + %% successor). This information is also useful for speeding up + %% shortcut_opt/1. + + Defined0 = [Def || #b_set{dst=Def} <- Is], + Defined = cerl_sets:from_list(Defined0), + MaySkip = cerl_sets:is_disjoint(Defined, Used0), + case MaySkip of + true -> + Skip = Skip0#{L=>true}, + used_vars(Bs, UsedVars, Skip); + false -> + used_vars(Bs, UsedVars, Skip0) + end; +used_vars([], UsedVars, Skip) -> + {UsedVars,Skip}. + +used_vars_succ([S|Ss], L, LiveMap, Live0) -> + Key = {S,L}, + case LiveMap of + #{Key:=Live} -> + %% The successor has a phi node, and the value for + %% this block in the phi node is a variable. + used_vars_succ(Ss, L, LiveMap, cerl_sets:union(Live, Live0)); + #{S:=Live} -> + %% No phi node in the successor, or the value for + %% this block in the phi node is a literal. + used_vars_succ(Ss, L, LiveMap, cerl_sets:union(Live, Live0)); + #{} -> + %% A peek_message block which has not been processed yet. + used_vars_succ(Ss, L, LiveMap, Live0) + end; +used_vars_succ([], _, _, Acc) -> Acc. + +used_vars_phis(Is, L, Live0, UsedVars0) -> + UsedVars = UsedVars0#{L=>Live0}, + Phis = takewhile(fun(#b_set{op=Op}) -> Op =:= phi end, Is), + case Phis of + [] -> + UsedVars; + [_|_] -> + PhiArgs = append([Args || #b_set{args=Args} <- Phis]), + case [{P,V} || {#b_var{}=V,P} <- PhiArgs] of + [_|_]=PhiVars -> + PhiLive0 = rel2fam(PhiVars), + PhiLive = [{{L,P},cerl_sets:union(cerl_sets:from_list(Vs), Live0)} || + {P,Vs} <- PhiLive0], + maps:merge(UsedVars, maps:from_list(PhiLive)); + [] -> + %% There were only literals in the phi node(s). + UsedVars + end + end. + +used_vars_blk(#b_blk{is=Is,last=Last}, Used0) -> + Used = cerl_sets:union(Used0, cerl_sets:from_list(beam_ssa:used(Last))), + used_vars_is(reverse(Is), Used). + +used_vars_is([#b_set{op=phi}|Is], Used) -> + used_vars_is(Is, Used); +used_vars_is([#b_set{dst=Dst}=I|Is], Used0) -> + Used1 = cerl_sets:union(Used0, cerl_sets:from_list(beam_ssa:used(I))), + Used = cerl_sets:del_element(Dst, Used1), + used_vars_is(Is, Used); +used_vars_is([], Used) -> + Used. + +%%% +%%% Common utilities. +%%% + +sub(#b_set{args=Args}=I, Sub) when map_size(Sub) =/= 0 -> + I#b_set{args=[sub_arg(A, Sub) || A <- Args]}; +sub(I, _Sub) -> I. + +sub_arg(#b_var{}=Old, Sub) -> + case Sub of + #{Old:=New} -> New; + #{} -> Old + end; +sub_arg(Old, _Sub) -> Old. + +rel2fam(S0) -> + S1 = sofs:relation(S0), + S = sofs:rel2fam(S1), + sofs:to_external(S). diff --git a/lib/compiler/src/beam_ssa_funs.erl b/lib/compiler/src/beam_ssa_funs.erl new file mode 100644 index 0000000000..e77c00fa89 --- /dev/null +++ b/lib/compiler/src/beam_ssa_funs.erl @@ -0,0 +1,149 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +%%% +%%% If a fun is defined locally and only used for calls, it can be replaced +%%% with direct calls to the relevant function. This greatly speeds up "named +%%% functions" (which rely on make_fun to recreate themselves) and macros that +%%% wrap their body in a fun. +%%% + +-module(beam_ssa_funs). + +-export([module/2]). + +-include("beam_ssa.hrl"). + +-import(lists, [foldl/3]). + +-spec module(Module, Options) -> Result when + Module :: beam_ssa:b_module(), + Options :: [compile:option()], + Result :: {ok, beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, _Opts) -> + Trampolines = foldl(fun find_trampolines/2, #{}, Fs0), + Fs = [lfo(F, Trampolines) || F <- Fs0], + {ok, Module#b_module{body=Fs}}. + +%% If a function does absolutely nothing beyond calling another function with +%% the same arguments in the same order, we can shave off a call by short- +%% circuiting it. +find_trampolines(#b_function{args=Args,bs=Blocks}=F, Trampolines) -> + case map_get(0, Blocks) of + #b_blk{is=[#b_set{op=call, + args=[#b_local{}=Actual | Args], + dst=Dst}], + last=#b_ret{arg=Dst}} -> + {_, Name, Arity} = beam_ssa:get_anno(func_info, F), + Trampoline = #b_local{name=#b_literal{val=Name},arity=Arity}, + Trampolines#{Trampoline => Actual}; + _ -> + Trampolines + end. + +lfo(#b_function{bs=Blocks0}=F, Trampolines) -> + Linear0 = beam_ssa:linearize(Blocks0), + Linear = lfo_optimize(Linear0, lfo_analyze(Linear0, #{}), Trampolines), + F#b_function{bs=maps:from_list(Linear)}. + +%% Gather a map of the locally defined funs that are only used for calls. +lfo_analyze([{_L,#b_blk{is=Is,last=Last}}|Bs], LFuns0) -> + LFuns = lfo_analyze_last(Last, lfo_analyze_is(Is, LFuns0)), + lfo_analyze(Bs, LFuns); +lfo_analyze([], LFuns) -> + LFuns. + +lfo_analyze_is([#b_set{op=make_fun, + dst=Dst, + args=[#b_local{} | FreeVars]}=Def | Is], + LFuns0) -> + LFuns = maps:put(Dst, Def, maps:without(FreeVars, LFuns0)), + lfo_analyze_is(Is, LFuns); +lfo_analyze_is([#b_set{op=call, + args=[Fun | CallArgs]} | Is], + LFuns) when is_map_key(Fun, LFuns) -> + #b_set{args=[#b_local{arity=Arity} | FreeVars]} = map_get(Fun, LFuns), + case length(CallArgs) + length(FreeVars) of + Arity -> + lfo_analyze_is(Is, maps:without(CallArgs, LFuns)); + _ -> + %% This will `badarity` at runtime, and it's easier to disable the + %% optimization than to simulate it. + lfo_analyze_is(Is, maps:without([Fun | CallArgs], LFuns)) + end; +lfo_analyze_is([#b_set{args=Args} | Is], LFuns) when map_size(LFuns) =/= 0 -> + %% We disqualify funs that are used outside calls because this forces them + %% to be created anyway, and the slight performance gain from direct calls + %% is not enough to offset the potential increase in stack frame size (the + %% free variables need to be kept alive until the call). + %% + %% This is also a kludge to make HiPE work, as the latter will generate + %% code with the assumption that the functions referenced in a make_fun + %% will only be used by funs, which will not be the case if we mix it with + %% direct calls. See cerl_cconv.erl for details. + %% + %% Future optimizations like delaying fun creation until use may require us + %% to copy affected functions so that HiPE gets its own to play with (until + %% HiPE is fixed anyway). + lfo_analyze_is(Is, maps:without(Args, LFuns)); +lfo_analyze_is([_ | Is], LFuns) -> + lfo_analyze_is(Is, LFuns); +lfo_analyze_is([], LFuns) -> + LFuns. + +lfo_analyze_last(#b_switch{arg=Arg}, LFuns) -> + maps:remove(Arg, LFuns); +lfo_analyze_last(#b_ret{arg=Arg}, LFuns) -> + maps:remove(Arg, LFuns); +lfo_analyze_last(_, LFuns) -> + LFuns. + +%% Replace all calls of suitable funs with a direct call to their +%% implementation. Liveness optimization will get rid of the make_fun +%% instruction. +lfo_optimize(Linear, LFuns, _Trampolines) when map_size(LFuns) =:= 0 -> + Linear; +lfo_optimize(Linear, LFuns, Trampolines) -> + lfo_optimize_1(Linear, LFuns, Trampolines). + +lfo_optimize_1([{L,#b_blk{is=Is0}=Blk}|Bs], LFuns, Trampolines) -> + Is = lfo_optimize_is(Is0, LFuns, Trampolines), + [{L,Blk#b_blk{is=Is}} | lfo_optimize_1(Bs, LFuns, Trampolines)]; +lfo_optimize_1([], _LFuns, _Trampolines) -> + []. + +lfo_optimize_is([#b_set{op=call, + args=[Fun | CallArgs]}=Call0 | Is], + LFuns, Trampolines) when is_map_key(Fun, LFuns) -> + #b_set{args=[Local | FreeVars]} = map_get(Fun, LFuns), + Args = [lfo_short_circuit(Local, Trampolines) | CallArgs ++ FreeVars], + Call = beam_ssa:add_anno(local_fun_opt, Fun, Call0#b_set{args=Args}), + [Call | lfo_optimize_is(Is, LFuns, Trampolines)]; +lfo_optimize_is([I | Is], LFuns, Trampolines) -> + [I | lfo_optimize_is(Is, LFuns, Trampolines)]; +lfo_optimize_is([], _LFuns, _Trampolines) -> + []. + +lfo_short_circuit(Call, Trampolines) -> + case maps:find(Call, Trampolines) of + {ok, Other} -> lfo_short_circuit(Other, Trampolines); + error -> Call + end. diff --git a/lib/compiler/src/beam_ssa_lint.erl b/lib/compiler/src/beam_ssa_lint.erl new file mode 100644 index 0000000000..a003607dab --- /dev/null +++ b/lib/compiler/src/beam_ssa_lint.erl @@ -0,0 +1,349 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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: Internal consistency checks for the beam_ssa format. + +-module(beam_ssa_lint). + +-export([module/2, format_error/1]). + +-import(lists, [append/1, foldl/3, foreach/2]). + +-include("beam_ssa.hrl"). + +-spec module(#b_module{}, [compile:option()]) -> + {'ok',#b_module{}} | {'error',list()}. +module(#b_module{body=Fs,name=Name}=Mod0, _Options) -> + Es0 = append([validate_function(F) || F <- Fs]), + case [{?MODULE,E} || E <- Es0] of + [] -> + {ok, Mod0}; + [_|_]=Es -> + {error,[{atom_to_list(Name), Es}]} + end. + +-spec format_error(term()) -> iolist(). +format_error({{_M,F,A},{redefined_variable, Name, Old, I}}) -> + io_lib:format("~p/~p: Variable ~ts (~ts) redefined by ~ts", + [F, A, format_var(Name), format_instr(Old), format_instr(I)]); +format_error({{_M,F,A},{missing_phi_paths, Paths, I}}) -> + io_lib:format("~p/~p: Phi node ~ts doesn't define a value for these " + "branches: ~w", + [F, A, format_instr(I), Paths]); +format_error({{_M,F,A},{garbage_phi_paths, Paths, I}}) -> + io_lib:format("~p/~p: Phi node ~ts defines a value for these unreachable " + "or non-existent branches: ~w", + [F, A, format_instr(I), Paths]); +format_error({{_M,F,A},{unknown_phi_variable, Name, {From, _To}, I}}) -> + io_lib:format("~p/~p: Variable ~ts used in phi node ~ts is undefined on " + "branch ~w", + [F, A, format_var(Name), format_instr(I), From]); +format_error({{_M,F,A},{unknown_block, Label, I}}) -> + io_lib:format("~p/~p: Unknown block ~p referenced in ~ts", + [F, A, Label, I]); +format_error({{_M,F,A},{unknown_variable, Name, I}}) -> + io_lib:format("~p/~p: Unbound variable ~ts used in ~ts", + [F, A, format_var(Name), format_instr(I)]); +format_error({{_M,F,A},{phi_inside_block, Name, Id}}) -> + io_lib:format("~p/~p: Phi node defining ~ts is not at start of block ~p", + [F, A, format_var(Name), Id]); +format_error({{_M,F,A},{undefined_label_in_phi, Label, I}}) -> + io_lib:format("~p/~p: Unknown block label ~p in phi node ~ts", + [F, A, Label, format_instr(I)]). + +format_instr(I) -> + [$',beam_ssa_pp:format_instr(I),$']. + +format_var(V) -> + beam_ssa_pp:format_var(#b_var{name=V}). + +validate_function(F) -> + try + validate_variables(F), + [] + catch + throw:Reason -> + #{func_info:=MFA} = F#b_function.anno, + [{MFA,Reason}]; + Class:Error:Stack -> + io:fwrite("Function: ~p\n", [F#b_function.anno]), + erlang:raise(Class, Error, Stack) + end. + +-type defined_vars() :: gb_sets:set(beam_ssa:var_name()). + +-record(vvars, + {blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }, + branch_def_vars :: #{ + %% Describes the variable state at the time of this exact branch (phi + %% node validation). + {From :: beam_ssa:label(), To :: beam_ssa:label()} => defined_vars(), + %% Describes the variable state common to all branches leading to this + %% label (un/redefined variable validation). + beam_ssa:label() => defined_vars() }, + defined_vars :: defined_vars()}). + +-spec validate_variables(beam_ssa:b_function()) -> ok. +validate_variables(#b_function{ args = Args, bs = Blocks }) -> + %% Prefill the mapping with function arguments. + ArgNames = vvars_get_varnames(Args), + DefVars = gb_sets:from_list(ArgNames), + Entry = 0, + + State = #vvars{blocks = Blocks, + branch_def_vars = #{ Entry => DefVars }, + defined_vars = DefVars}, + ok = vvars_assert_unique(Blocks, ArgNames), + vvars_phi_nodes(vvars_block(Entry, State)). + +%% Checks the uniqueness of all variables across all blocks. +-spec vvars_assert_unique(Blocks, [beam_ssa:var_name()]) -> ok when + Blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }. +vvars_assert_unique(Blocks, Args) -> + BlockIs = [Is || #b_blk{is=Is} <- maps:values(Blocks)], + Defined0 = maps:from_list([{V,argument} || V <- Args]), + _ = foldl(fun(Is, Defined) -> + vvars_assert_unique_1(Is, Defined) + end, Defined0, BlockIs), + ok. + +-spec vvars_assert_unique_1(Is, Defined) -> ok when + Is :: list(beam_ssa:b_set()), + Defined :: #{ beam_ssa:var_name() => beam_ssa:b_set() }. +vvars_assert_unique_1([#b_set{dst=#b_var{name=DstName}}=I|Is], Defined) -> + case Defined of + #{DstName:=Old} -> throw({redefined_variable, DstName, Old, I}); + _ -> vvars_assert_unique_1(Is, Defined#{DstName=>I}) + end; +vvars_assert_unique_1([], Defined) -> + Defined. + +-spec vvars_phi_nodes(State :: #vvars{}) -> ok. +vvars_phi_nodes(#vvars{ blocks = Blocks }=State) -> + _ = [vvars_phi_nodes_1(Is, Id, State) || + {Id, #b_blk{ is = Is }} <- maps:to_list(Blocks)], + ok. + +-spec vvars_phi_nodes_1(Is, Id, State) -> ok when + Is :: list(beam_ssa:b_set()), + Id :: beam_ssa:label(), + State :: #vvars{}. +vvars_phi_nodes_1([#b_set{ op = phi, args = Phis }=I | Is], Id, State) -> + ok = vvars_assert_phi_paths(Phis, I, Id, State), + ok = vvars_assert_phi_vars(Phis, I, Id, State), + vvars_phi_nodes_1(Is, Id, State); +vvars_phi_nodes_1([_ | Is], Id, _State) -> + case [Dst || #b_set{op=phi,dst=#b_var{name=Dst}} <- Is] of + [Name|_] -> + throw({phi_inside_block, Name, Id}); + [] -> + ok + end; +vvars_phi_nodes_1([], _Id, _State) -> + ok. + +%% Checks whether all paths leading to this phi node are represented, and that +%% it doesn't reference any non-existent paths. +-spec vvars_assert_phi_paths(Phis, I, Id, State) -> ok when + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. +vvars_assert_phi_paths(Phis, I, Id, State) -> + BranchKeys = maps:keys(State#vvars.branch_def_vars), + RequiredPaths = ordsets:from_list([From || {From, To} <- BranchKeys, To =:= Id]), + ProvidedPaths = ordsets:from_list([From || {_Value, From} <- Phis]), + case ordsets:subtract(RequiredPaths, ProvidedPaths) of + [_|_]=MissingPaths -> throw({missing_phi_paths, MissingPaths, I}); + [] -> ok + end. + %% %% The following test is sometimes useful to find missing optimizations. + %% %% It is commented out, though, because it can be triggered by + %% %% by weird but legal code. + %% case ordsets:subtract(ProvidedPaths, RequiredPaths) of + %% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); + %% [] -> ok + %% end. + +%% Checks whether all variables used in this phi node are defined in the branch +%% they arrived on. +-spec vvars_assert_phi_vars(Phis, I, Id, State) -> ok when + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. +vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, + branch_def_vars=BranchDefVars}) -> + Vars = [{Var, From} || {#b_var{}=Var, From} <- Phis], + foreach(fun({#b_var{name=VarName}, From}) -> + BranchKey = {From, Id}, + case BranchDefVars of + #{BranchKey:=DefVars} -> + case gb_sets:is_member(VarName, DefVars) of + true -> ok; + false -> throw({unknown_variable, VarName, I}) + end; + #{} -> + throw({unknown_phi_variable, VarName, BranchKey, I}) + end + end, Vars), + Labels = [From || {#b_literal{},From} <- Phis], + foreach(fun(Label) -> + case Blocks of + #{Label:=_} -> + ok; + #{} -> + throw({undefined_label_in_phi, Label, I}) + end + end, Labels). + +-spec vvars_block(Id, State) -> #vvars{} when + Id :: beam_ssa:label(), + State :: #vvars{}. +vvars_block(Id, State0) -> + #{ Id := #b_blk{ is = Is, last = Terminator} } = State0#vvars.blocks, + #{ Id := DefVars } = State0#vvars.branch_def_vars, + State = State0#vvars{ defined_vars = DefVars }, + vvars_terminator(Terminator, Id, vvars_block_1(Is, State)). + +-spec vvars_block_1(Blocks, State) -> #vvars{} when + Blocks :: list(beam_ssa:b_blk()), + State :: #vvars{}. +vvars_block_1([], State) -> + State; +vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, op = phi } | Is], State0) -> + %% We don't check phi node arguments at this point since we may not have + %% visited their definition yet. They'll be handled later on in + %% vvars_phi_nodes/1 after all blocks are processed. + vvars_block_1(Is, vvars_save_var(DstName, State0)); +vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, args = Args }=I | Is], State0) -> + ok = vvars_assert_args(Args, I, State0), + vvars_block_1(Is, vvars_save_var(DstName, State0)). + +-spec vvars_terminator(Terminator, From, State) -> #vvars{} when + Terminator :: beam_ssa:terminator(), + From :: beam_ssa:label(), + State :: #vvars{}. +vvars_terminator(#b_ret{ arg = Arg }=I, _From, State) -> + ok = vvars_assert_args([Arg], I, State), + State; +vvars_terminator(#b_switch{arg=Arg,fail=Fail,list=Switch}=I, From, State) -> + ok = vvars_assert_args([Arg], I, State), + ok = vvars_assert_args([A || {A,_Lbl} <- Switch], I, State), + Labels = [Fail | [Lbl || {_Arg, Lbl} <- Switch]], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State); +vvars_terminator(#b_br{bool=#b_literal{val=true},succ=Succ}=I, From, State) -> + Labels = [Succ], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State); +vvars_terminator(#b_br{bool=#b_literal{val=false},fail=Fail}=I, From, State) -> + Labels = [Fail], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State); +vvars_terminator(#b_br{ bool = Arg, succ = Succ, fail = Fail }=I, From, State) -> + ok = vvars_assert_args([Arg], I, State), + Labels = [Fail, Succ], + ok = vvars_assert_labels(Labels, I, State), + vvars_terminator_1(Labels, From, State). + +-spec vvars_terminator_1(Labels, From, State) -> #vvars{} when + Labels :: list(beam_ssa:label()), + From :: beam_ssa:label(), + State :: #vvars{}. +vvars_terminator_1(Labels0, From, State0) -> + %% Filter out all branches that have already been taken. This should result + %% in either all of Labels0 or an empty list. + Labels = [To || To <- Labels0, + not maps:is_key({From, To}, State0#vvars.branch_def_vars)], + true = Labels =:= Labels0 orelse Labels =:= [], %Assertion + State1 = foldl(fun(To, State) -> + vvars_save_branch(From, To, State) + end, State0, Labels), + foldl(fun(To, State) -> + vvars_block(To, State) + end, State1, Labels). + +%% Gets all variable names in args, ignoring literals etc +-spec vvars_get_varnames(Args) -> list(beam_ssa:var_name()) when + Args :: list(beam_ssa:argument()). +vvars_get_varnames(Args) -> + [Name || #b_var{ name = Name } <- Args]. + +%% Checks that all variables in Args are defined in all paths leading to the +%% current State. +-spec vvars_assert_args(Args, I, State) -> ok when + Args :: list(beam_ssa:argument()), + I :: beam_ssa:terminator() | beam_ssa:b_set(), + State :: #vvars{}. +vvars_assert_args(Args, I, #vvars{defined_vars=DefVars}=State) -> + foreach(fun(#b_remote{mod=Mod,name=Name}) -> + vvars_assert_args([Mod,Name], I, State); + (#b_var{name=Name}) -> + case gb_sets:is_member(Name, DefVars) of + true -> ok; + false -> throw({unknown_variable,Name,I}) + end; + (_) -> ok + end, Args). + +%% Checks that all given labels are defined in State. +-spec vvars_assert_labels(Labels, I, State) -> ok when + Labels :: list(beam_ssa:label()), + I :: beam_ssa:terminator(), + State :: #vvars{}. +vvars_assert_labels(Labels, I, #vvars{blocks=Blocks}) -> + foreach(fun(Label) -> + case maps:is_key(Label, Blocks) of + false -> throw({unknown_block, Label, I}); + true -> ok + end + end, Labels). + +-spec vvars_save_branch(From, To, State) -> #vvars{} when + From :: beam_ssa:label(), + To :: beam_ssa:label(), + State :: #vvars{}. +vvars_save_branch(From, To, State) -> + DefVars = State#vvars.defined_vars, + Branches0 = State#vvars.branch_def_vars, + case Branches0 of + #{ To := LblDefVars } -> + MergedVars = vvars_merge_branches(DefVars, LblDefVars), + + Branches = Branches0#{ To => MergedVars, {From, To} => DefVars }, + State#vvars { branch_def_vars = Branches }; + _ -> + Branches = Branches0#{ To => DefVars, {From, To} => DefVars }, + State#vvars { branch_def_vars = Branches } + end. + +-spec vvars_merge_branches(New, Existing) -> defined_vars() when + New :: defined_vars(), + Existing :: defined_vars(). +vvars_merge_branches(New, Existing) -> + gb_sets:intersection(New, Existing). + +-spec vvars_save_var(VarName, State) -> #vvars{} when + VarName :: beam_ssa:var_name(), + State :: #vvars{}. +vvars_save_var(VarName, State0) -> + %% vvars_assert_unique guarantees that variables are never set twice. + DefVars = gb_sets:insert(VarName, State0#vvars.defined_vars), + State0#vvars{ defined_vars = DefVars }. diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl new file mode 100644 index 0000000000..d87c66c272 --- /dev/null +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -0,0 +1,2303 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +%%% +%%% This is a collection of various optimizations that don't need a separate +%%% pass by themselves and/or are mutually beneficial to other passes. +%%% +%%% The optimizations are applied in "phases," each with a list of sub-passes +%%% to run. These sub-passes are applied on all functions in a module before +%%% moving on to the next phase, which lets us gather module-level information +%%% in one phase and then apply it in the next without having to risk working +%%% with incomplete information. +%%% +%%% Each sub-pass operates on a #st{} record and a func_info_db(), where the +%%% former is just a #b_function{} whose blocks can be represented either in +%%% linear or map form, and the latter is a map with information about all +%%% functions in the module (see beam_ssa_opt.hrl for more details). +%%% + +-module(beam_ssa_opt). +-export([module/2]). + +-include("beam_ssa_opt.hrl"). + +-import(lists, [all/2,append/1,duplicate/2,foldl/3,keyfind/3,member/2, + reverse/1,reverse/2, + splitwith/2,sort/1,takewhile/2,unzip/1]). + +-define(DEFAULT_REPETITIONS, 2). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +-record(st, {ssa :: [{beam_ssa:label(),beam_ssa:b_blk()}] | + beam_ssa:block_map(), + args :: [beam_ssa:b_var()], + cnt :: beam_ssa:label(), + anno :: beam_ssa:anno()}). +-type st_map() :: #{ func_id() => #st{} }. + +module(Module, Opts) -> + FuncDb0 = case proplists:get_value(no_module_opt, Opts, false) of + false -> build_func_db(Module); + true -> #{} + end, + + %% Passes that perform module-level optimizations are often aided by + %% optimizing callers before callees and vice versa, so we optimize all + %% functions in call order, flipping it as required. + StMap0 = build_st_map(Module), + Order = get_call_order_po(StMap0, FuncDb0), + + Phases = + [{Order, prologue_passes(Opts)}] ++ + repeat(Opts, repeated_passes(Opts), Order) ++ + [{Order, epilogue_passes(Opts)}], + + {StMap, _FuncDb} = foldl(fun({FuncIds, Ps}, {StMap, FuncDb}) -> + phase(FuncIds, Ps, StMap, FuncDb) + end, {StMap0, FuncDb0}, Phases), + + {ok, finish(Module, StMap)}. + +phase([FuncId | Ids], Ps, StMap, FuncDb0) -> + try compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}) of + {St, FuncDb} -> + phase(Ids, Ps, StMap#{ FuncId => St }, FuncDb) + catch + Class:Error:Stack -> + #b_local{name=#b_literal{val=Name},arity=Arity} = FuncId, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end; +phase([], _Ps, StMap, FuncDb) -> + {StMap, FuncDb}. + +%% Repeats the given passes, alternating the order between runs to make the +%% type pass more efficient. +repeat(Opts, Ps, OrderA) -> + Repeat = proplists:get_value(ssa_opt_repeat, Opts, ?DEFAULT_REPETITIONS), + OrderB = reverse(OrderA), + repeat_1(Repeat, Ps, OrderA, OrderB). + +repeat_1(0, _Opts, _OrderA, _OrderB) -> + []; +repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 0 -> + [{OrderA, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]; +repeat_1(N, Ps, OrderA, OrderB) when N > 0, N rem 2 =:= 1 -> + [{OrderB, Ps} | repeat_1(N - 1, Ps, OrderA, OrderB)]. + +%% + +get_func_id(F) -> + {_Mod, Name, Arity} = beam_ssa:get_anno(func_info, F), + #b_local{name=#b_literal{val=Name}, arity=Arity}. + +-spec build_st_map(#b_module{}) -> st_map(). +build_st_map(#b_module{body=Fs}) -> + build_st_map_1(Fs, #{}). + +build_st_map_1([F | Fs], Map) -> + #b_function{anno=Anno,args=Args,cnt=Counter,bs=Bs} = F, + St = #st{anno=Anno,args=Args,cnt=Counter,ssa=Bs}, + build_st_map_1(Fs, Map#{ get_func_id(F) => St }); +build_st_map_1([], Map) -> + Map. + +-spec finish(#b_module{}, st_map()) -> #b_module{}. +finish(#b_module{body=Fs0}=Module, StMap) -> + Module#b_module{body=finish_1(Fs0, StMap)}. + +finish_1([F0 | Fs], StMap) -> + #st{anno=Anno,cnt=Counter,ssa=Blocks} = map_get(get_func_id(F0), StMap), + F = F0#b_function{anno=Anno,bs=Blocks,cnt=Counter}, + [F | finish_1(Fs, StMap)]; +finish_1([], _StMap) -> + []. + +%% + +-define(PASS(N), {N,fun N/1}). + +prologue_passes(Opts) -> + Ps = [?PASS(ssa_opt_split_blocks), + ?PASS(ssa_opt_coalesce_phis), + ?PASS(ssa_opt_tail_phis), + ?PASS(ssa_opt_element), + ?PASS(ssa_opt_linearize), + ?PASS(ssa_opt_tuple_size), + ?PASS(ssa_opt_record), + ?PASS(ssa_opt_cse), %Helps the first type pass. + ?PASS(ssa_opt_type_start)], + passes_1(Ps, Opts). + +%% These passes all benefit from each other (in roughly this order), so they +%% are repeated as required. +repeated_passes(Opts) -> + Ps = [?PASS(ssa_opt_live), + ?PASS(ssa_opt_bs_puts), + ?PASS(ssa_opt_dead), + ?PASS(ssa_opt_cse), + ?PASS(ssa_opt_tail_phis), + ?PASS(ssa_opt_type_continue)], %Must run after ssa_opt_dead to + %clean up phi nodes. + passes_1(Ps, Opts). + +epilogue_passes(Opts) -> + Ps = [?PASS(ssa_opt_type_finish), + ?PASS(ssa_opt_float), + ?PASS(ssa_opt_sw), + + %% Run live one more time to clean up after the float and sw + %% passes. + ?PASS(ssa_opt_live), + ?PASS(ssa_opt_bsm), + ?PASS(ssa_opt_bsm_units), + ?PASS(ssa_opt_bsm_shortcut), + ?PASS(ssa_opt_blockify), + ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_merge_blocks), + ?PASS(ssa_opt_get_tuple_element), + ?PASS(ssa_opt_trim_unreachable)], + passes_1(Ps, Opts). + +passes_1(Ps, Opts0) -> + Negations = [{list_to_atom("no_"++atom_to_list(N)),N} || + {N,_} <- Ps], + Opts = proplists:substitute_negations(Negations, Opts0), + [case proplists:get_value(Name, Opts, true) of + true -> + P; + false -> + {NoName,Name} = keyfind(Name, 2, Negations), + {NoName,fun(S) -> S end} + end || {Name,_}=P <- Ps]. + +%% Builds a function information map with basic information about incoming and +%% outgoing local calls, as well as whether the function is exported. +-spec build_func_db(#b_module{}) -> func_info_db(). +build_func_db(#b_module{body=Fs,exports=Exports}) -> + try + fdb_1(Fs, gb_sets:from_list(Exports), #{}) + catch + %% All module-level optimizations are invalid when a NIF can override a + %% function, so we have to bail out. + throw:load_nif -> #{} + end. + +fdb_1([#b_function{ args=Args,bs=Bs }=F | Fs], Exports, FuncDb0) -> + Id = get_func_id(F), + + #b_local{name=#b_literal{val=Name}, arity=Arity} = Id, + Exported = gb_sets:is_element({Name, Arity}, Exports), + ArgTypes = duplicate(length(Args), #{}), + + FuncDb1 = case FuncDb0 of + %% We may have an entry already if someone's called us. + #{ Id := Info } -> + FuncDb0#{ Id := Info#func_info{ exported=Exported, + arg_types=ArgTypes }}; + #{} -> + FuncDb0#{ Id => #func_info{ exported=Exported, + arg_types=ArgTypes }} + end, + + FuncDb = beam_ssa:fold_rpo(fun(_L, #b_blk{is=Is}, FuncDb) -> + fdb_is(Is, Id, FuncDb) + end, FuncDb1, Bs), + + fdb_1(Fs, Exports, FuncDb); +fdb_1([], _Exports, FuncDb) -> + FuncDb. + +fdb_is([#b_set{op=call, + args=[#b_local{}=Callee | _]} | Is], + Caller, FuncDb) -> + fdb_is(Is, Caller, fdb_update(Caller, Callee, FuncDb)); +fdb_is([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=load_nif}}, + _Path, _LoadInfo]} | _Is], _Caller, _FuncDb) -> + throw(load_nif); +fdb_is([_ | Is], Caller, FuncDb) -> + fdb_is(Is, Caller, FuncDb); +fdb_is([], _Caller, FuncDb) -> + FuncDb. + +fdb_update(Caller, Callee, FuncDb) -> + CallerVertex = maps:get(Caller, FuncDb, #func_info{}), + CalleeVertex = maps:get(Callee, FuncDb, #func_info{}), + + Calls = ordsets:add_element(Callee, CallerVertex#func_info.out), + CalledBy = ordsets:add_element(Caller, CalleeVertex#func_info.in), + + FuncDb#{ Caller => CallerVertex#func_info{out=Calls}, + Callee => CalleeVertex#func_info{in=CalledBy} }. + +%% Returns the post-order of all local calls in this module. That is, +%% called functions will be ordered before the functions calling them. +%% +%% Functions where module-level optimization is disabled are added last in +%% arbitrary order. + +get_call_order_po(StMap, FuncDb) -> + Order = gco_po(FuncDb), + Order ++ maps:fold(fun(K, _V, Acc) -> + case is_map_key(K, FuncDb) of + false -> [K | Acc]; + true -> Acc + end + end, [], StMap). + +gco_po(FuncDb) -> + All = sort(maps:keys(FuncDb)), + {RPO,_} = gco_rpo(All, FuncDb, cerl_sets:new(), []), + reverse(RPO). + +gco_rpo([Id|Ids], FuncDb, Seen0, Acc0) -> + case cerl_sets:is_element(Id, Seen0) of + true -> + gco_rpo(Ids, FuncDb, Seen0, Acc0); + false -> + #func_info{out=Successors} = map_get(Id, FuncDb), + Seen1 = cerl_sets:add_element(Id, Seen0), + {Acc,Seen} = gco_rpo(Successors, FuncDb, Seen1, Acc0), + gco_rpo(Ids, FuncDb, Seen, [Id|Acc]) + end; +gco_rpo([], _, Seen, Acc) -> + {Acc,Seen}. + +%%% +%%% Trivial sub passes. +%%% + +ssa_opt_dead({#st{ssa=Linear}=St, FuncDb}) -> + {St#st{ssa=beam_ssa_dead:opt(Linear)}, FuncDb}. + +ssa_opt_linearize({#st{ssa=Blocks}=St, FuncDb}) -> + {St#st{ssa=beam_ssa:linearize(Blocks)}, FuncDb}. + +ssa_opt_type_start({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> + {Linear, FuncDb} = beam_ssa_type:opt_start(Linear0, Args, Anno, FuncDb0), + {St0#st{ssa=Linear}, FuncDb}. + +ssa_opt_type_continue({#st{ssa=Linear0,args=Args,anno=Anno}=St0, FuncDb0}) -> + {Linear, FuncDb} = beam_ssa_type:opt_continue(Linear0, Args, Anno, FuncDb0), + {St0#st{ssa=Linear}, FuncDb}. + +ssa_opt_type_finish({#st{args=Args,anno=Anno0}=St0, FuncDb0}) -> + {Anno, FuncDb} = beam_ssa_type:opt_finish(Args, Anno0, FuncDb0), + {St0#st{anno=Anno}, FuncDb}. + +ssa_opt_blockify({#st{ssa=Linear}=St, FuncDb}) -> + {St#st{ssa=maps:from_list(Linear)}, FuncDb}. + +ssa_opt_trim_unreachable({#st{ssa=Blocks}=St, FuncDb}) -> + {St#st{ssa=beam_ssa:trim_unreachable(Blocks)}, FuncDb}. + +%%% +%%% Split blocks before certain instructions to enable more optimizations. +%%% +%%% Splitting before element/2 enables the optimization that swaps +%%% element/2 instructions. +%%% +%%% Splitting before call and make_fun instructions gives more opportunities +%%% for sinking get_tuple_element instructions. +%%% + +ssa_opt_split_blocks({#st{ssa=Blocks0,cnt=Count0}=St, FuncDb}) -> + P = fun(#b_set{op={bif,element}}) -> true; + (#b_set{op=call}) -> true; + (#b_set{op=make_fun}) -> true; + (_) -> false + end, + {Blocks,Count} = beam_ssa:split_blocks(P, Blocks0, Count0), + {St#st{ssa=Blocks,cnt=Count}, FuncDb}. + +%%% +%%% Coalesce phi nodes. +%%% +%%% Nested cases can led to code such as this: +%%% +%%% 10: +%%% _1 = phi {literal value1, label 8}, {Var, label 9} +%%% br 11 +%%% +%%% 11: +%%% _2 = phi {_1, label 10}, {literal false, label 3} +%%% +%%% The phi nodes can be coalesced like this: +%%% +%%% 11: +%%% _2 = phi {literal value1, label 8}, {Var, label 9}, {literal false, label 3} +%%% +%%% Coalescing can help other optimizations, and can in some cases reduce register +%%% shuffling (if the phi variables for two phi nodes happens to be allocated to +%%% different registers). +%%% + +ssa_opt_coalesce_phis({#st{ssa=Blocks0}=St, FuncDb}) -> + Ls = beam_ssa:rpo(Blocks0), + Blocks = c_phis_1(Ls, Blocks0), + {St#st{ssa=Blocks}, FuncDb}. + +c_phis_1([L|Ls], Blocks0) -> + case map_get(L, Blocks0) of + #b_blk{is=[#b_set{op=phi}|_]}=Blk -> + Blocks = c_phis_2(L, Blk, Blocks0), + c_phis_1(Ls, Blocks); + #b_blk{} -> + c_phis_1(Ls, Blocks0) + end; +c_phis_1([], Blocks) -> Blocks. + +c_phis_2(L, #b_blk{is=Is0}=Blk0, Blocks0) -> + case c_phis_args(Is0, Blocks0) of + none -> + Blocks0; + {_,_,Preds}=Info -> + Is = c_rewrite_phis(Is0, Info), + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks0#{L:=Blk}, + c_fix_branches(Preds, L, Blocks) + end. + +c_phis_args([#b_set{op=phi,args=Args0}|Is], Blocks) -> + case c_phis_args_1(Args0, Blocks) of + none -> + c_phis_args(Is, Blocks); + Res -> + Res + end; +c_phis_args(_, _Blocks) -> none. + +c_phis_args_1([{Var,Pred}|As], Blocks) -> + case c_get_pred_vars(Var, Pred, Blocks) of + none -> + c_phis_args_1(As, Blocks); + Result -> + Result + end; +c_phis_args_1([], _Blocks) -> none. + +c_get_pred_vars(Var, Pred, Blocks) -> + case map_get(Pred, Blocks) of + #b_blk{is=[#b_set{op=phi,dst=Var,args=Args}]} -> + {Var,Pred,Args}; + #b_blk{} -> + none + end. + +c_rewrite_phis([#b_set{op=phi,args=Args0}=I|Is], Info) -> + Args = c_rewrite_phi(Args0, Info), + [I#b_set{args=Args}|c_rewrite_phis(Is, Info)]; +c_rewrite_phis(Is, _Info) -> Is. + +c_rewrite_phi([{Var,Pred}|As], {Var,Pred,Values}) -> + Values ++ As; +c_rewrite_phi([{Value,Pred}|As], {_,Pred,Values}) -> + [{Value,P} || {_,P} <- Values] ++ As; +c_rewrite_phi([A|As], Info) -> + [A|c_rewrite_phi(As, Info)]; +c_rewrite_phi([], _Info) -> []. + +c_fix_branches([{_,Pred}|As], L, Blocks0) -> + #b_blk{last=Last0} = Blk0 = map_get(Pred, Blocks0), + #b_br{bool=#b_literal{val=true}} = Last0, %Assertion. + Last = Last0#b_br{bool=#b_literal{val=true},succ=L,fail=L}, + Blk = Blk0#b_blk{last=Last}, + Blocks = Blocks0#{Pred:=Blk}, + c_fix_branches(As, L, Blocks); +c_fix_branches([], _, Blocks) -> Blocks. + +%%% +%%% Eliminate phi nodes in the tail of a function. +%%% +%%% Try to eliminate short blocks that starts with a phi node +%%% and end in a return. For example: +%%% +%%% Result = phi { Res1, 4 }, { literal true, 5 } +%%% Ret = put_tuple literal ok, Result +%%% ret Ret +%%% +%%% The code in this block can be inserted at the end blocks 4 and +%%% 5. Thus, the following code can be inserted into block 4: +%%% +%%% Ret:1 = put_tuple literal ok, Res1 +%%% ret Ret:1 +%%% +%%% And the following code into block 5: +%%% +%%% Ret:2 = put_tuple literal ok, literal true +%%% ret Ret:2 +%%% +%%% Which can be further simplified to: +%%% +%%% ret literal {ok, true} +%%% +%%% This transformation may lead to more code improvements: +%%% +%%% - Stack trimming +%%% - Fewer test_heap instructions +%%% - Smaller stack frames +%%% + +ssa_opt_tail_phis({#st{ssa=SSA0,cnt=Count0}=St, FuncDb}) -> + {SSA,Count} = opt_tail_phis(SSA0, Count0), + {St#st{ssa=SSA,cnt=Count}, FuncDb}. + +opt_tail_phis(Blocks, Count) when is_map(Blocks) -> + opt_tail_phis(maps:values(Blocks), Blocks, Count); +opt_tail_phis(Linear0, Count0) when is_list(Linear0) -> + Blocks0 = maps:from_list(Linear0), + {Blocks,Count} = opt_tail_phis(Blocks0, Count0), + {beam_ssa:linearize(Blocks),Count}. + +opt_tail_phis([#b_blk{is=Is0,last=Last}|Bs], Blocks0, Count0) -> + case {Is0,Last} of + {[#b_set{op=phi,args=[_,_|_]}|_],#b_ret{arg=#b_var{}}=Ret} -> + {Phis,Is} = splitwith(fun(#b_set{op=Op}) -> Op =:= phi end, Is0), + case suitable_tail_ops(Is) of + true -> + {Blocks,Count} = opt_tail_phi(Phis, Is, Ret, + Blocks0, Count0), + opt_tail_phis(Bs, Blocks, Count); + false -> + opt_tail_phis(Bs, Blocks0, Count0) + end; + {_,_} -> + opt_tail_phis(Bs, Blocks0, Count0) + end; +opt_tail_phis([], Blocks, Count) -> + {Blocks,Count}. + +opt_tail_phi(Phis0, Is, Ret, Blocks0, Count0) -> + Phis = rel2fam(reduce_phis(Phis0)), + {Blocks,Count,Cost} = + foldl(fun(PhiArg, Acc) -> + opt_tail_phi_arg(PhiArg, Is, Ret, Acc) + end, {Blocks0,Count0,0}, Phis), + MaxCost = length(Phis) * 3 + 2, + if + Cost =< MaxCost -> + %% The transformation would cause at most a slight + %% increase in code size if no more optimizations + %% can be applied. + {Blocks,Count}; + true -> + %% The code size would be increased too much. + {Blocks0,Count0} + end. + +reduce_phis([#b_set{dst=PhiDst,args=PhiArgs}|Is]) -> + [{L,{PhiDst,Val}} || {Val,L} <- PhiArgs] ++ reduce_phis(Is); +reduce_phis([]) -> []. + +opt_tail_phi_arg({PredL,Sub0}, Is0, Ret0, {Blocks0,Count0,Cost0}) -> + Blk0 = map_get(PredL, Blocks0), + #b_blk{is=IsPrefix,last=#b_br{succ=Next,fail=Next}} = Blk0, + case is_exit_bif(IsPrefix) of + false -> + Sub1 = maps:from_list(Sub0), + {Is1,Count,Sub} = new_names(Is0, Sub1, Count0, []), + Is2 = [sub(I, Sub) || I <- Is1], + Cost = build_cost(Is2, Cost0), + Is = IsPrefix ++ Is2, + Ret = sub(Ret0, Sub), + Blk = Blk0#b_blk{is=Is,last=Ret}, + Blocks = Blocks0#{PredL:=Blk}, + {Blocks,Count,Cost}; + true -> + %% The block ends in a call to a function that + %% will cause an exception. + {Blocks0,Count0,Cost0+3} + end. + +is_exit_bif([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}}|Args]}]) -> + erl_bifs:is_exit_bif(Mod, Name, length(Args)); +is_exit_bif(_) -> false. + +new_names([#b_set{dst=Dst}=I|Is], Sub0, Count0, Acc) -> + {NewDst,Count} = new_var(Dst, Count0), + Sub = Sub0#{Dst=>NewDst}, + new_names(Is, Sub, Count, [I#b_set{dst=NewDst}|Acc]); +new_names([], Sub, Count, Acc) -> + {reverse(Acc),Count,Sub}. + +suitable_tail_ops(Is) -> + all(fun(#b_set{op=Op}) -> + is_suitable_tail_op(Op) + end, Is). + +is_suitable_tail_op({bif,_}) -> true; +is_suitable_tail_op(put_list) -> true; +is_suitable_tail_op(put_tuple) -> true; +is_suitable_tail_op(_) -> false. + +build_cost([#b_set{op=put_list,args=Args}|Is], Cost) -> + case are_all_literals(Args) of + true -> + build_cost(Is, Cost); + false -> + build_cost(Is, Cost + 1) + end; +build_cost([#b_set{op=put_tuple,args=Args}|Is], Cost) -> + case are_all_literals(Args) of + true -> + build_cost(Is, Cost); + false -> + build_cost(Is, Cost + length(Args) + 1) + end; +build_cost([#b_set{op={bif,_},args=Args}|Is], Cost) -> + case are_all_literals(Args) of + true -> + build_cost(Is, Cost); + false -> + build_cost(Is, Cost + 1) + end; +build_cost([], Cost) -> Cost. + +are_all_literals(Args) -> + all(fun(#b_literal{}) -> true; + (_) -> false + end, Args). + +%%% +%%% Order element/2 calls. +%%% +%%% Order an unbroken chain of element/2 calls for the same tuple +%%% with the same failure label so that the highest element is +%%% retrieved first. That will allow the other element/2 calls to +%%% be replaced with get_tuple_element/3 instructions. +%%% + +ssa_opt_element({#st{ssa=Blocks}=St, FuncDb}) -> + %% Collect the information about element instructions in this + %% function. + GetEls = collect_element_calls(beam_ssa:linearize(Blocks)), + + %% Collect the element instructions into chains. The + %% element calls in each chain are ordered in reverse + %% execution order. + Chains = collect_chains(GetEls, []), + + %% For each chain, swap the first element call with the + %% element call with the highest index. + {St#st{ssa=swap_element_calls(Chains, Blocks)}, FuncDb}. + +collect_element_calls([{L,#b_blk{is=Is0,last=Last}}|Bs]) -> + case {Is0,Last} of + {[#b_set{op={bif,element},dst=Element, + args=[#b_literal{val=N},#b_var{}=Tuple]}, + #b_set{op=succeeded,dst=Bool,args=[Element]}], + #b_br{bool=Bool,succ=Succ,fail=Fail}} -> + Info = {L,Succ,{Tuple,Fail},N}, + [Info|collect_element_calls(Bs)]; + {_,_} -> + collect_element_calls(Bs) + end; +collect_element_calls([]) -> []. + +collect_chains([{This,_,V,_}=El|Els], [{_,This,V,_}|_]=Chain) -> + %% Add to the previous chain. + collect_chains(Els, [El|Chain]); +collect_chains([El|Els], [_,_|_]=Chain) -> + %% Save the previous chain and start a new chain. + [Chain|collect_chains(Els, [El])]; +collect_chains([El|Els], _Chain) -> + %% The previous chain is too short; discard it and start a new. + collect_chains(Els, [El]); +collect_chains([], [_,_|_]=Chain) -> + %% Save the last chain. + [Chain]; +collect_chains([], _) -> []. + +swap_element_calls([[{L,_,_,N}|_]=Chain|Chains], Blocks0) -> + Blocks = swap_element_calls_1(Chain, {N,L}, Blocks0), + swap_element_calls(Chains, Blocks); +swap_element_calls([], Blocks) -> Blocks. + +swap_element_calls_1([{L1,_,_,N1}], {N2,L2}, Blocks) when N2 > N1 -> + %% We have reached the end of the chain, and the first + %% element instrution to be executed. Its index is lower + %% than the maximum index found while traversing the chain, + %% so we will need to swap the instructions. + #{L1:=Blk1,L2:=Blk2} = Blocks, + [#b_set{dst=Dst1}=GetEl1,Succ1] = Blk1#b_blk.is, + [#b_set{dst=Dst2}=GetEl2,Succ2] = Blk2#b_blk.is, + Is1 = [GetEl2,Succ1#b_set{args=[Dst2]}], + Is2 = [GetEl1,Succ2#b_set{args=[Dst1]}], + Blocks#{L1:=Blk1#b_blk{is=Is1},L2:=Blk2#b_blk{is=Is2}}; +swap_element_calls_1([{L,_,_,N1}|Els], {N2,_}, Blocks) when N1 > N2 -> + swap_element_calls_1(Els, {N2,L}, Blocks); +swap_element_calls_1([_|Els], Highest, Blocks) -> + swap_element_calls_1(Els, Highest, Blocks); +swap_element_calls_1([], _, Blocks) -> + %% Nothing to do. The element call with highest index + %% is already the first one to be executed. + Blocks. + +%%% +%%% Record optimization. +%%% +%%% Replace tuple matching with an is_tagged_tuple instruction +%%% when applicable. +%%% + +ssa_opt_record({#st{ssa=Linear}=St, FuncDb}) -> + Blocks = maps:from_list(Linear), + {St#st{ssa=record_opt(Linear, Blocks)}, FuncDb}. + +record_opt([{L,#b_blk{is=Is0,last=Last}=Blk0}|Bs], Blocks) -> + Is = record_opt_is(Is0, Last, Blocks), + Blk = Blk0#b_blk{is=Is}, + [{L,Blk}|record_opt(Bs, Blocks)]; +record_opt([], _Blocks) -> []. + +record_opt_is([#b_set{op={bif,is_tuple},dst=Bool,args=[Tuple]}=Set], + Last, Blocks) -> + case is_tagged_tuple(Tuple, Bool, Last, Blocks) of + {yes,Size,Tag} -> + Args = [Tuple,Size,Tag], + [Set#b_set{op=is_tagged_tuple,args=Args}]; + no -> + [Set] + end; +record_opt_is([I|Is]=Is0, #b_br{bool=Bool}=Last, Blocks) -> + case is_tagged_tuple_1(Is0, Last, Blocks) of + {yes,_Fail,Tuple,Arity,Tag} -> + Args = [Tuple,Arity,Tag], + [I#b_set{op=is_tagged_tuple,dst=Bool,args=Args}]; + no -> + [I|record_opt_is(Is, Last, Blocks)] + end; +record_opt_is([I|Is], Last, Blocks) -> + [I|record_opt_is(Is, Last, Blocks)]; +record_opt_is([], _Last, _Blocks) -> []. + +is_tagged_tuple(#b_var{}=Tuple, Bool, + #b_br{bool=Bool,succ=Succ,fail=Fail}, + Blocks) -> + #b_blk{is=Is,last=Last} = map_get(Succ, Blocks), + case is_tagged_tuple_1(Is, Last, Blocks) of + {yes,Fail,Tuple,Arity,Tag} -> + {yes,Arity,Tag}; + _ -> + no + end; +is_tagged_tuple(_, _, _, _) -> no. + +is_tagged_tuple_1(Is, Last, Blocks) -> + case {Is,Last} of + {[#b_set{op={bif,tuple_size},dst=ArityVar, + args=[#b_var{}=Tuple]}, + #b_set{op={bif,'=:='}, + dst=Bool, + args=[ArityVar, #b_literal{val=ArityVal}=Arity]}], + #b_br{bool=Bool,succ=Succ,fail=Fail}} + when is_integer(ArityVal) -> + SuccBlk = map_get(Succ, Blocks), + case is_tagged_tuple_2(SuccBlk, Tuple, Fail) of + no -> + no; + {yes,Tag} -> + {yes,Fail,Tuple,Arity,Tag} + end; + _ -> + no + end. + +is_tagged_tuple_2(#b_blk{is=Is, + last=#b_br{bool=#b_var{}=Bool,fail=Fail}}, + Tuple, Fail) -> + is_tagged_tuple_3(Is, Bool, Tuple); +is_tagged_tuple_2(#b_blk{}, _, _) -> no. + +is_tagged_tuple_3([#b_set{op=get_tuple_element, + dst=TagVar, + args=[#b_var{}=Tuple,#b_literal{val=0}]}|Is], + Bool, Tuple) -> + is_tagged_tuple_4(Is, Bool, TagVar); +is_tagged_tuple_3([_|Is], Bool, Tuple) -> + is_tagged_tuple_3(Is, Bool, Tuple); +is_tagged_tuple_3([], _, _) -> no. + +is_tagged_tuple_4([#b_set{op={bif,'=:='},dst=Bool, + args=[#b_var{}=TagVar, + #b_literal{val=TagVal}=Tag]}], + Bool, TagVar) when is_atom(TagVal) -> + {yes,Tag}; +is_tagged_tuple_4([_|Is], Bool, TagVar) -> + is_tagged_tuple_4(Is, Bool, TagVar); +is_tagged_tuple_4([], _, _) -> no. + +%%% +%%% Common subexpression elimination (CSE). +%%% +%%% Eliminate repeated evaluation of identical expressions. To avoid +%%% increasing the size of the stack frame, we don't eliminate +%%% subexpressions across instructions that clobber the X registers. +%%% + +ssa_opt_cse({#st{ssa=Linear}=St, FuncDb}) -> + M = #{0=>#{}}, + {St#st{ssa=cse(Linear, #{}, M)}, FuncDb}. + +cse([{L,#b_blk{is=Is0,last=Last0}=Blk}|Bs], Sub0, M0) -> + Es0 = map_get(L, M0), + {Is1,Es,Sub} = cse_is(Is0, Es0, Sub0, []), + Last = sub(Last0, Sub), + M = cse_successors(Is1, Blk, Es, M0), + Is = reverse(Is1), + [{L,Blk#b_blk{is=Is,last=Last}}|cse(Bs, Sub, M)]; +cse([], _, _) -> []. + +cse_successors([#b_set{op=succeeded,args=[Src]},Bif|_], Blk, EsSucc, M0) -> + case cse_suitable(Bif) of + true -> + %% The previous instruction only has a valid value at the success branch. + %% We must remove the substitution for Src from the failure branch. + #b_blk{last=#b_br{succ=Succ,fail=Fail}} = Blk, + M = cse_successors_1([Succ], EsSucc, M0), + EsFail = maps:filter(fun(_, Val) -> Val =/= Src end, EsSucc), + cse_successors_1([Fail], EsFail, M); + false -> + %% There can't be any replacement for Src in EsSucc. No need for + %% any special handling. + cse_successors_1(beam_ssa:successors(Blk), EsSucc, M0) + end; +cse_successors(_Is, Blk, Es, M) -> + cse_successors_1(beam_ssa:successors(Blk), Es, M). + +cse_successors_1([L|Ls], Es0, M) -> + case M of + #{L:=Es1} when map_size(Es1) =:= 0 -> + %% The map is already empty. No need to do anything + %% since the intersection will be empty. + cse_successors_1(Ls, Es0, M); + #{L:=Es1} -> + %% Calculate the intersection of the two maps. + %% Both keys and values must match. + Es = maps:filter(fun(Key, Value) -> + case Es1 of + #{Key:=Value} -> true; + #{} -> false + end + end, Es0), + cse_successors_1(Ls, Es0, M#{L:=Es}); + #{} -> + cse_successors_1(Ls, Es0, M#{L=>Es0}) + end; +cse_successors_1([], _, M) -> M. + +cse_is([#b_set{op=succeeded,dst=Bool,args=[Src]}=I0|Is], Es, Sub0, Acc) -> + I = sub(I0, Sub0), + case I of + #b_set{args=[Src]} -> + cse_is(Is, Es, Sub0, [I|Acc]); + #b_set{} -> + %% The previous instruction has been eliminated. Eliminate the + %% 'succeeded' instruction too. + Sub = Sub0#{Bool=>#b_literal{val=true}}, + cse_is(Is, Es, Sub, Acc) + end; +cse_is([#b_set{dst=Dst}=I0|Is], Es0, Sub0, Acc) -> + I = sub(I0, Sub0), + case beam_ssa:clobbers_xregs(I) of + true -> + %% Retaining the expressions map across calls and other + %% clobbering instructions would work, but it would cause + %% the common subexpressions to be saved to Y registers, + %% which would probably increase the size of the stack + %% frame. + cse_is(Is, #{}, Sub0, [I|Acc]); + false -> + case cse_expr(I) of + none -> + %% Not suitable for CSE. + cse_is(Is, Es0, Sub0, [I|Acc]); + {ok,ExprKey} -> + case Es0 of + #{ExprKey:=Src} -> + Sub = Sub0#{Dst=>Src}, + cse_is(Is, Es0, Sub, Acc); + #{} -> + Es = Es0#{ExprKey=>Dst}, + cse_is(Is, Es, Sub0, [I|Acc]) + end + end + end; +cse_is([], Es, Sub, Acc) -> + {Acc,Es,Sub}. + +cse_expr(#b_set{op=Op,args=Args}=I) -> + case cse_suitable(I) of + true -> {ok,{Op,Args}}; + false -> none + end. + +cse_suitable(#b_set{op=get_hd}) -> true; +cse_suitable(#b_set{op=get_tl}) -> true; +cse_suitable(#b_set{op=put_list}) -> true; +cse_suitable(#b_set{op=get_tuple_element}) -> true; +cse_suitable(#b_set{op=put_tuple}) -> true; +cse_suitable(#b_set{op={bif,tuple_size}}) -> + %% Doing CSE for tuple_size/1 can prevent the + %% creation of test_arity and select_tuple_arity + %% instructions. That could decrease performance + %% and beam_validator could fail to understand + %% that tuple operations that follow are safe. + false; +cse_suitable(#b_set{anno=Anno,op={bif,Name},args=Args}) -> + %% Doing CSE for floating point operators is unsafe. + %% Doing CSE for comparison operators would prevent + %% creation of 'test' instructions. + Arity = length(Args), + not (is_map_key(float_op, Anno) orelse + erl_internal:new_type_test(Name, Arity) orelse + erl_internal:comp_op(Name, Arity) orelse + erl_internal:bool_op(Name, Arity)); +cse_suitable(#b_set{}) -> false. + +%%% +%%% Using floating point instructions. +%%% +%%% Use the special floating points version of arithmetic +%%% instructions, if the operands are known to be floats or the result +%%% of the operation will be a float. +%%% +%%% The float instructions were never used in guards before, so we +%%% will take special care to keep not using them in guards. Using +%%% them in guards would require a new version of the 'fconv' +%%% instruction that would take a failure label. Since it is unlikely +%%% that using float instructions in guards would be benefical, why +%%% bother implementing a new instruction? Also, implementing float +%%% instructions in guards in HiPE could turn out to be a lot of work. +%%% + +-record(fs, + {s=undefined :: 'undefined' | 'cleared', + regs=#{} :: #{beam_ssa:b_var():=beam_ssa:b_var()}, + fail=none :: 'none' | beam_ssa:label(), + non_guards :: gb_sets:set(beam_ssa:label()), + bs :: beam_ssa:block_map() + }). + +ssa_opt_float({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> + NonGuards = non_guards(Linear0), + Blocks = maps:from_list(Linear0), + Fs = #fs{non_guards=NonGuards,bs=Blocks}, + {Linear,Count} = float_opt(Linear0, Count0, Fs), + {St#st{ssa=Linear,cnt=Count}, FuncDb}. + +float_blk_is_in_guard(#b_blk{last=#b_br{fail=F}}, #fs{non_guards=NonGuards}) -> + not gb_sets:is_member(F, NonGuards); +float_blk_is_in_guard(#b_blk{}, #fs{}) -> + false. + +float_opt([{L,Blk}|Bs0], Count0, Fs) -> + case float_blk_is_in_guard(Blk, Fs) of + true -> + %% This block is inside a guard. Don't do + %% any floating point optimizations. + {Bs,Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count}; + false -> + %% This block is not inside a guard. + %% We can do the optimization. + float_opt_1(L, Blk, Bs0, Count0, Fs) + end; +float_opt([], Count, _Fs) -> + {[],Count}. + +float_opt_1(L, #b_blk{is=Is0}=Blk0, Bs0, Count0, Fs0) -> + case float_opt_is(Is0, Fs0, Count0, []) of + {Is1,Fs1,Count1} -> + Fs2 = float_fail_label(Blk0, Fs1), + Fail = Fs2#fs.fail, + {Flush,Blk,Fs,Count2} = float_maybe_flush(Blk0, Fs2, Count1), + Split = float_split_conv(Is1, Blk), + {Blks0,Count3} = float_number(Split, L, Count2), + {Blks,Count4} = float_conv(Blks0, Fail, Count3), + {Bs,Count} = float_opt(Bs0, Count4, Fs), + {Blks++Flush++Bs,Count}; + none -> + {Bs,Count} = float_opt(Bs0, Count0, Fs0), + {[{L,Blk0}|Bs],Count} + end. + +%% Split {float,convert} instructions into individual blocks. +float_split_conv(Is0, Blk) -> + Br = #b_br{bool=#b_literal{val=true},succ=0,fail=0}, + case splitwith(fun(#b_set{op=Op}) -> + Op =/= {float,convert} + end, Is0) of + {Is,[]} -> + [Blk#b_blk{is=Is}]; + {[_|_]=Is1,[#b_set{op={float,convert}}=Conv|Is2]} -> + [#b_blk{is=Is1,last=Br}, + #b_blk{is=[Conv],last=Br}|float_split_conv(Is2, Blk)]; + {[],[#b_set{op={float,convert}}=Conv|Is1]} -> + [#b_blk{is=[Conv],last=Br}|float_split_conv(Is1, Blk)] + end. + +%% Number the blocks that were split. +float_number([B|Bs0], FirstL, Count0) -> + {Bs,Count} = float_number(Bs0, Count0), + {[{FirstL,B}|Bs],Count}. + +float_number([B|Bs0], Count0) -> + {Bs,Count} = float_number(Bs0, Count0+1), + {[{Count0,B}|Bs],Count}; +float_number([], Count) -> + {[],Count}. + +%% Insert 'succeeded' instructions after each {float,convert} +%% instruction. +float_conv([{L,#b_blk{is=Is0}=Blk0}|Bs0], Fail, Count0) -> + case Is0 of + [#b_set{op={float,convert}}=Conv] -> + {Bool0,Count1} = new_reg('@ssa_bool', Count0), + Bool = #b_var{name=Bool0}, + Succeeded = #b_set{op=succeeded,dst=Bool, + args=[Conv#b_set.dst]}, + Is = [Conv,Succeeded], + [{NextL,_}|_] = Bs0, + Br = #b_br{bool=Bool,succ=NextL,fail=Fail}, + Blk = Blk0#b_blk{is=Is,last=Br}, + {Bs,Count} = float_conv(Bs0, Fail, Count1), + {[{L,Blk}|Bs],Count}; + [_|_] -> + case Bs0 of + [{NextL,_}|_] -> + Br = #b_br{bool=#b_literal{val=true}, + succ=NextL,fail=NextL}, + Blk = Blk0#b_blk{last=Br}, + {Bs,Count} = float_conv(Bs0, Fail, Count0), + {[{L,Blk}|Bs],Count}; + [] -> + {[{L,Blk0}],Count0} + end + end. + +float_maybe_flush(Blk0, #fs{s=cleared,fail=Fail,bs=Blocks}=Fs0, Count0) -> + #b_blk{last=#b_br{bool=#b_var{},succ=Succ}=Br} = Blk0, + + %% If the success block starts with a floating point operation, we can + %% defer flushing to that block as long as it isn't a guard. + #b_blk{is=Is} = SuccBlk = map_get(Succ, Blocks), + SuccIsGuard = float_blk_is_in_guard(SuccBlk, Fs0), + + case Is of + [#b_set{anno=#{float_op:=_}}|_] when not SuccIsGuard -> + %% No flush needed. + {[],Blk0,Fs0,Count0}; + _ -> + %% Flush needed. + {Bool0,Count1} = new_reg('@ssa_bool', Count0), + Bool = #b_var{name=Bool0}, + + %% Allocate block numbers. + CheckL = Count1, %For checkerror. + FlushL = Count1 + 1, %For flushing of float regs. + Count = Count1 + 2, + Blk = Blk0#b_blk{last=Br#b_br{succ=CheckL}}, + + %% Build the block with the checkerror instruction. + CheckIs = [#b_set{op={float,checkerror},dst=Bool}], + CheckBr = #b_br{bool=Bool,succ=FlushL,fail=Fail}, + CheckBlk = #b_blk{is=CheckIs,last=CheckBr}, + + %% Build the block that flushes all registers. + FlushIs = float_flush_regs(Fs0), + FlushBr = #b_br{bool=#b_literal{val=true},succ=Succ,fail=Succ}, + FlushBlk = #b_blk{is=FlushIs,last=FlushBr}, + + %% Update state and blocks. + Fs = Fs0#fs{s=undefined,regs=#{},fail=none}, + FlushBs = [{CheckL,CheckBlk},{FlushL,FlushBlk}], + {FlushBs,Blk,Fs,Count} + end; +float_maybe_flush(Blk, Fs, Count) -> + {[],Blk,Fs,Count}. + +float_opt_is([#b_set{op=succeeded,args=[Src]}=I0], + #fs{regs=Rs}=Fs, Count, Acc) -> + case Rs of + #{Src:=Fr} -> + I = I0#b_set{args=[Fr]}, + {reverse(Acc, [I]),Fs,Count}; + #{} -> + {reverse(Acc, [I0]),Fs,Count} + end; +float_opt_is([#b_set{anno=Anno0}=I0|Is0], Fs0, Count0, Acc) -> + case Anno0 of + #{float_op:=FTypes} -> + Anno = maps:remove(float_op, Anno0), + I1 = I0#b_set{anno=Anno}, + {Is,Fs,Count} = float_make_op(I1, FTypes, Fs0, Count0), + float_opt_is(Is0, Fs, Count, reverse(Is, Acc)); + #{} -> + float_opt_is(Is0, Fs0#fs{regs=#{}}, Count0, [I0|Acc]) + end; +float_opt_is([], Fs, _Count, _Acc) -> + #fs{s=undefined} = Fs, %Assertion. + none. + +float_make_op(#b_set{op={bif,Op},dst=Dst,args=As0}=I0, + Ts, #fs{s=S,regs=Rs0}=Fs, Count0) -> + {As1,Rs1,Count1} = float_load(As0, Ts, Rs0, Count0, []), + {As,Is0} = unzip(As1), + {Fr,Count2} = new_reg('@fr', Count1), + FrDst = #b_var{name=Fr}, + I = I0#b_set{op={float,Op},dst=FrDst,args=As}, + Rs = Rs1#{Dst=>FrDst}, + Is = append(Is0) ++ [I], + case S of + undefined -> + {Ignore,Count} = new_reg('@ssa_ignore', Count2), + C = #b_set{op={float,clearerror},dst=#b_var{name=Ignore}}, + {[C|Is],Fs#fs{s=cleared,regs=Rs},Count}; + cleared -> + {Is,Fs#fs{regs=Rs},Count2} + end. + +float_load([A|As], [T|Ts], Rs0, Count0, Acc) -> + {Load,Rs,Count} = float_reg_arg(A, T, Rs0, Count0), + float_load(As, Ts, Rs, Count, [Load|Acc]); +float_load([], [], Rs, Count, Acc) -> + {reverse(Acc),Rs,Count}. + +float_reg_arg(A, T, Rs, Count0) -> + case Rs of + #{A:=Fr} -> + {{Fr,[]},Rs,Count0}; + #{} -> + {Fr,Count} = new_float_copy_reg(Count0), + Dst = #b_var{name=Fr}, + I = float_load_reg(T, A, Dst), + {{Dst,[I]},Rs#{A=>Dst},Count} + end. + +float_load_reg(convert, #b_var{}=Src, Dst) -> + #b_set{op={float,convert},dst=Dst,args=[Src]}; +float_load_reg(convert, #b_literal{val=Val}=Src, Dst) -> + try float(Val) of + F -> + #b_set{op={float,put},dst=Dst,args=[#b_literal{val=F}]} + catch + error:_ -> + %% Let the exception happen at runtime. + #b_set{op={float,convert},dst=Dst,args=[Src]} + end; +float_load_reg(float, Src, Dst) -> + #b_set{op={float,put},dst=Dst,args=[Src]}. + +new_float_copy_reg(Count) -> + new_reg('@fr_copy', Count). + +new_reg(Base, Count) -> + Fr = {Base,Count}, + {Fr,Count+1}. + +float_fail_label(#b_blk{last=Last}, Fs) -> + case Last of + #b_br{bool=#b_var{},fail=Fail} -> + Fs#fs{fail=Fail}; + _ -> + Fs + end. + +float_flush_regs(#fs{regs=Rs}) -> + maps:fold(fun(_, #b_var{name={'@fr_copy',_}}, Acc) -> + Acc; + (Dst, Fr, Acc) -> + [#b_set{op={float,get},dst=Dst,args=[Fr]}|Acc] + end, [], Rs). + +%%% +%%% Live optimization. +%%% +%%% Optimize instructions whose values are not used. They could be +%%% removed if they have no side effects, or in a few cases replaced +%%% with a cheaper instructions +%%% + +ssa_opt_live({#st{ssa=Linear0}=St, FuncDb}) -> + RevLinear = reverse(Linear0), + Blocks0 = maps:from_list(RevLinear), + Blocks = live_opt(RevLinear, #{}, Blocks0), + Linear = beam_ssa:linearize(Blocks), + {St#st{ssa=Linear}, FuncDb}. + +live_opt([{L,Blk0}|Bs], LiveMap0, Blocks) -> + Blk1 = beam_ssa_share:block(Blk0, Blocks), + Successors = beam_ssa:successors(Blk1), + Live0 = live_opt_succ(Successors, L, LiveMap0, gb_sets:empty()), + {Blk,Live} = live_opt_blk(Blk1, Live0), + LiveMap = live_opt_phis(Blk#b_blk.is, L, Live, LiveMap0), + live_opt(Bs, LiveMap, Blocks#{L:=Blk}); +live_opt([], _, Acc) -> Acc. + +live_opt_succ([S|Ss], L, LiveMap, Live0) -> + Key = {S,L}, + case LiveMap of + #{Key:=Live} -> + %% The successor has a phi node, and the value for + %% this block in the phi node is a variable. + live_opt_succ(Ss, L, LiveMap, gb_sets:union(Live, Live0)); + #{S:=Live} -> + %% No phi node in the successor, or the value for + %% this block in the phi node is a literal. + live_opt_succ(Ss, L, LiveMap, gb_sets:union(Live, Live0)); + #{} -> + %% A peek_message block which has not been processed yet. + live_opt_succ(Ss, L, LiveMap, Live0) + end; +live_opt_succ([], _, _, Acc) -> Acc. + +live_opt_phis(Is, L, Live0, LiveMap0) -> + LiveMap = LiveMap0#{L=>Live0}, + Phis = takewhile(fun(#b_set{op=Op}) -> Op =:= phi end, Is), + case Phis of + [] -> + LiveMap; + [_|_] -> + PhiArgs = append([Args || #b_set{args=Args} <- Phis]), + case [{P,V} || {#b_var{}=V,P} <- PhiArgs] of + [_|_]=PhiVars -> + PhiLive0 = rel2fam(PhiVars), + PhiLive = [{{L,P},gb_sets:union(gb_sets:from_list(Vs), Live0)} || + {P,Vs} <- PhiLive0], + maps:merge(LiveMap, maps:from_list(PhiLive)); + [] -> + %% There were only literals in the phi node(s). + LiveMap + end + end. + +live_opt_blk(#b_blk{is=Is0,last=Last}=Blk, Live0) -> + Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(Last))), + {Is,Live} = live_opt_is(reverse(Is0), Live1, []), + {Blk#b_blk{is=Is},Live}. + +live_opt_is([#b_set{op=phi,dst=Dst}=I|Is], Live, Acc) -> + case gb_sets:is_member(Dst, Live) of + true -> + live_opt_is(Is, Live, [I|Acc]); + false -> + live_opt_is(Is, Live, Acc) + end; +live_opt_is([#b_set{op=succeeded,dst=SuccDst=SuccDstVar, + args=[Dst]}=SuccI, + #b_set{dst=Dst}=I|Is], Live0, Acc) -> + case gb_sets:is_member(Dst, Live0) of + true -> + Live1 = gb_sets:add(Dst, Live0), + Live = gb_sets:delete_any(SuccDst, Live1), + live_opt_is([I|Is], Live, [SuccI|Acc]); + false -> + case live_opt_unused(I) of + {replace,NewI0} -> + NewI = NewI0#b_set{dst=SuccDstVar}, + live_opt_is([NewI|Is], Live0, Acc); + keep -> + case gb_sets:is_member(SuccDst, Live0) of + true -> + Live1 = gb_sets:add(Dst, Live0), + Live = gb_sets:delete(SuccDst, Live1), + live_opt_is([I|Is], Live, [SuccI|Acc]); + false -> + live_opt_is([I|Is], Live0, Acc) + end + end + end; +live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> + case gb_sets:is_member(Dst, Live0) of + true -> + Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + Live = gb_sets:delete(Dst, Live1), + live_opt_is(Is, Live, [I|Acc]); + false -> + case beam_ssa:no_side_effect(I) of + true -> + live_opt_is(Is, Live0, Acc); + false -> + Live = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + live_opt_is(Is, Live, [I|Acc]) + end + end; +live_opt_is([], Live, Acc) -> + {Acc,Live}. + +live_opt_unused(#b_set{op=get_map_element}=Set) -> + {replace,Set#b_set{op=has_map_field}}; +live_opt_unused(_) -> keep. + +%%% +%%% Optimize binary matching. +%%% +%%% * If the value of segment is never extracted, rewrite +%%% to a bs_skip instruction. +%%% +%%% * Coalesce adjacent bs_skip instructions and skip instructions +%%% with bs_test_tail. +%%% + +ssa_opt_bsm({#st{ssa=Linear}=St, FuncDb}) -> + Extracted0 = bsm_extracted(Linear), + Extracted = cerl_sets:from_list(Extracted0), + {St#st{ssa=bsm_skip(Linear, Extracted)}, FuncDb}. + +bsm_skip([{L,#b_blk{is=Is0}=Blk}|Bs0], Extracted) -> + Bs = bsm_skip(Bs0, Extracted), + Is = bsm_skip_is(Is0, Extracted), + coalesce_skips({L,Blk#b_blk{is=Is}}, Bs); +bsm_skip([], _) -> []. + +bsm_skip_is([I0|Is], Extracted) -> + case I0 of + #b_set{op=bs_match, + dst=Ctx, + args=[#b_literal{val=T}=Type,PrevCtx|Args0]} + when T =/= string, T =/= skip -> + I = case cerl_sets:is_element(Ctx, Extracted) of + true -> + I0; + false -> + %% The value is never extracted. + Args = [#b_literal{val=skip},PrevCtx,Type|Args0], + I0#b_set{args=Args} + end, + [I|Is]; + #b_set{} -> + [I0|bsm_skip_is(Is, Extracted)] + end; +bsm_skip_is([], _) -> []. + +bsm_extracted([{_,#b_blk{is=Is}}|Bs]) -> + case Is of + [#b_set{op=bs_extract,args=[Ctx]}|_] -> + [Ctx|bsm_extracted(Bs)]; + _ -> + bsm_extracted(Bs) + end; +bsm_extracted([]) -> []. + +coalesce_skips({L,#b_blk{is=[#b_set{op=bs_extract}=Extract|Is0], + last=Last0}=Blk0}, Bs0) -> + case coalesce_skips_is(Is0, Last0, Bs0) of + not_possible -> + [{L,Blk0}|Bs0]; + {Is,Last,Bs} -> + Blk = Blk0#b_blk{is=[Extract|Is],last=Last}, + [{L,Blk}|Bs] + end; +coalesce_skips({L,#b_blk{is=Is0,last=Last0}=Blk0}, Bs0) -> + case coalesce_skips_is(Is0, Last0, Bs0) of + not_possible -> + [{L,Blk0}|Bs0]; + {Is,Last,Bs} -> + Blk = Blk0#b_blk{is=Is,last=Last}, + [{L,Blk}|Bs] + end. + +coalesce_skips_is([#b_set{op=bs_match, + args=[#b_literal{val=skip}, + Ctx0,Type,Flags, + #b_literal{val=Size0}, + #b_literal{val=Unit0}]}=Skip0, + #b_set{op=succeeded}], + #b_br{succ=L2,fail=Fail}=Br0, + Bs0) when is_integer(Size0) -> + case Bs0 of + [{L2,#b_blk{is=[#b_set{op=bs_match, + dst=SkipDst, + args=[#b_literal{val=skip},_,_,_, + #b_literal{val=Size1}, + #b_literal{val=Unit1}]}, + #b_set{op=succeeded}=Succeeded], + last=#b_br{fail=Fail}=Br}}|Bs] when is_integer(Size1) -> + SkipBits = Size0 * Unit0 + Size1 * Unit1, + Skip = Skip0#b_set{dst=SkipDst, + args=[#b_literal{val=skip},Ctx0, + Type,Flags, + #b_literal{val=SkipBits}, + #b_literal{val=1}]}, + Is = [Skip,Succeeded], + {Is,Br,Bs}; + [{L2,#b_blk{is=[#b_set{op=bs_test_tail, + args=[_Ctx,#b_literal{val=TailSkip}]}], + last=#b_br{succ=NextSucc,fail=Fail}}}|Bs] -> + SkipBits = Size0 * Unit0, + TestTail = Skip0#b_set{op=bs_test_tail, + args=[Ctx0,#b_literal{val=SkipBits+TailSkip}]}, + Br = Br0#b_br{bool=TestTail#b_set.dst,succ=NextSucc}, + Is = [TestTail], + {Is,Br,Bs}; + _ -> + not_possible + end; +coalesce_skips_is(_, _, _) -> + not_possible. + +%%% +%%% Short-cutting binary matching instructions. +%%% + +ssa_opt_bsm_shortcut({#st{ssa=Linear}=St, FuncDb}) -> + Positions = bsm_positions(Linear, #{}), + case map_size(Positions) of + 0 -> + %% No binary matching instructions. + {St, FuncDb}; + _ -> + {St#st{ssa=bsm_shortcut(Linear, Positions)}, FuncDb} + end. + +bsm_positions([{L,#b_blk{is=Is,last=Last}}|Bs], PosMap0) -> + PosMap = bsm_positions_is(Is, PosMap0), + case {Is,Last} of + {[#b_set{op=bs_test_tail,dst=Bool,args=[Ctx,#b_literal{val=Bits0}]}], + #b_br{bool=Bool,fail=Fail}} -> + Bits = Bits0 + map_get(Ctx, PosMap0), + bsm_positions(Bs, PosMap#{L=>{Bits,Fail}}); + {_,_} -> + bsm_positions(Bs, PosMap) + end; +bsm_positions([], PosMap) -> PosMap. + +bsm_positions_is([#b_set{op=bs_start_match,dst=New}|Is], PosMap0) -> + PosMap = PosMap0#{New=>0}, + bsm_positions_is(Is, PosMap); +bsm_positions_is([#b_set{op=bs_match,dst=New,args=Args}|Is], PosMap0) -> + [_,Old|_] = Args, + #{Old:=Bits0} = PosMap0, + Bits = bsm_update_bits(Args, Bits0), + PosMap = PosMap0#{New=>Bits}, + bsm_positions_is(Is, PosMap); +bsm_positions_is([_|Is], PosMap) -> + bsm_positions_is(Is, PosMap); +bsm_positions_is([], PosMap) -> PosMap. + +bsm_update_bits([#b_literal{val=string},_,#b_literal{val=String}], Bits) -> + Bits + bit_size(String); +bsm_update_bits([#b_literal{val=utf8}|_], Bits) -> + Bits + 8; +bsm_update_bits([#b_literal{val=utf16}|_], Bits) -> + Bits + 16; +bsm_update_bits([#b_literal{val=utf32}|_], Bits) -> + Bits + 32; +bsm_update_bits([_,_,_,#b_literal{val=Sz},#b_literal{val=U}], Bits) + when is_integer(Sz) -> + Bits + Sz*U; +bsm_update_bits(_, Bits) -> Bits. + +bsm_shortcut([{L,#b_blk{is=Is,last=Last0}=Blk}|Bs], PosMap) -> + case {Is,Last0} of + {[#b_set{op=bs_match,dst=New,args=[_,Old|_]}, + #b_set{op=succeeded,dst=Bool,args=[New]}], + #b_br{bool=Bool,fail=Fail}} -> + case PosMap of + #{Old:=Bits,Fail:={TailBits,NextFail}} when Bits > TailBits -> + Last = Last0#b_br{fail=NextFail}, + [{L,Blk#b_blk{last=Last}}|bsm_shortcut(Bs, PosMap)]; + #{} -> + [{L,Blk}|bsm_shortcut(Bs, PosMap)] + end; + {_,_} -> + [{L,Blk}|bsm_shortcut(Bs, PosMap)] + end; +bsm_shortcut([], _PosMap) -> []. + +%%% +%%% Eliminate redundant bs_test_unit2 instructions. +%%% + +ssa_opt_bsm_units({#st{ssa=Linear}=St, FuncDb}) -> + {St#st{ssa=bsm_units(Linear, #{})}, FuncDb}. + +bsm_units([{L,#b_blk{last=#b_br{succ=Succ,fail=Fail}}=Block0} | Bs], UnitMaps0) -> + UnitsIn = maps:get(L, UnitMaps0, #{}), + {Block, UnitsOut} = bsm_units_skip(Block0, UnitsIn), + UnitMaps1 = bsm_units_join(Succ, UnitsOut, UnitMaps0), + UnitMaps = bsm_units_join(Fail, UnitsIn, UnitMaps1), + [{L, Block} | bsm_units(Bs, UnitMaps)]; +bsm_units([{L,#b_blk{last=#b_switch{fail=Fail,list=Switch}}=Block} | Bs], UnitMaps0) -> + UnitsIn = maps:get(L, UnitMaps0, #{}), + Labels = [Fail | [Lbl || {_Arg, Lbl} <- Switch]], + UnitMaps = foldl(fun(Lbl, UnitMaps) -> + bsm_units_join(Lbl, UnitsIn, UnitMaps) + end, UnitMaps0, Labels), + [{L, Block} | bsm_units(Bs, UnitMaps)]; +bsm_units([{L, Block} | Bs], UnitMaps) -> + [{L, Block} | bsm_units(Bs, UnitMaps)]; +bsm_units([], _UnitMaps) -> + []. + +bsm_units_skip(Block, Units) -> + bsm_units_skip_1(Block#b_blk.is, Block, Units). + +bsm_units_skip_1([#b_set{op=bs_start_match,dst=New}|_], Block, Units) -> + %% We bail early since there can't be more than one match per block. + {Block, Units#{ New => 1 }}; +bsm_units_skip_1([#b_set{op=bs_match, + dst=New, + args=[#b_literal{val=skip}, + Ctx, + #b_literal{val=binary}, + _Flags, + #b_literal{val=all}, + #b_literal{val=OpUnit}]}=Skip | Test], + Block0, Units) -> + [#b_set{op=succeeded,dst=Bool,args=[New]}] = Test, %Assertion. + #b_br{bool=Bool} = Last0 = Block0#b_blk.last, %Assertion. + CtxUnit = map_get(Ctx, Units), + if + CtxUnit rem OpUnit =:= 0 -> + Is = takewhile(fun(I) -> I =/= Skip end, Block0#b_blk.is), + Last = Last0#b_br{bool=#b_literal{val=true}}, + Block = Block0#b_blk{is=Is,last=Last}, + {Block, Units#{ New => CtxUnit }}; + CtxUnit rem OpUnit =/= 0 -> + {Block0, Units#{ New => OpUnit, Ctx => OpUnit }} + end; +bsm_units_skip_1([#b_set{op=bs_match,dst=New,args=Args}|_], Block, Units) -> + [_,Ctx|_] = Args, + CtxUnit = map_get(Ctx, Units), + OpUnit = bsm_op_unit(Args), + {Block, Units#{ New => gcd(OpUnit, CtxUnit) }}; +bsm_units_skip_1([_I | Is], Block, Units) -> + bsm_units_skip_1(Is, Block, Units); +bsm_units_skip_1([], Block, Units) -> + {Block, Units}. + +bsm_op_unit([_,_,_,Size,#b_literal{val=U}]) -> + case Size of + #b_literal{val=Sz} when is_integer(Sz) -> Sz*U; + _ -> U + end; +bsm_op_unit([#b_literal{val=string},_,#b_literal{val=String}]) -> + bit_size(String); +bsm_op_unit([#b_literal{val=utf8}|_]) -> + 8; +bsm_op_unit([#b_literal{val=utf16}|_]) -> + 16; +bsm_op_unit([#b_literal{val=utf32}|_]) -> + 32; +bsm_op_unit(_) -> + 1. + +%% Several paths can lead to the same match instruction and the inferred units +%% may differ between them, so we can only keep the information that is common +%% to all paths. +bsm_units_join(Lbl, MapA, UnitMaps0) when is_map_key(Lbl, UnitMaps0) -> + MapB = map_get(Lbl, UnitMaps0), + Merged = if + map_size(MapB) =< map_size(MapA) -> + bsm_units_join_1(maps:keys(MapB), MapA, MapB); + map_size(MapB) > map_size(MapA) -> + bsm_units_join_1(maps:keys(MapA), MapB, MapA) + end, + UnitMaps0#{Lbl := Merged}; +bsm_units_join(Lbl, MapA, UnitMaps0) when MapA =/= #{} -> + UnitMaps0#{Lbl => MapA}; +bsm_units_join(_Lbl, _MapA, UnitMaps0) -> + UnitMaps0. + +bsm_units_join_1([Key | Keys], Left, Right) when is_map_key(Key, Left) -> + UnitA = map_get(Key, Left), + UnitB = map_get(Key, Right), + bsm_units_join_1(Keys, Left, Right#{Key := gcd(UnitA, UnitB)}); +bsm_units_join_1([Key | Keys], Left, Right) -> + bsm_units_join_1(Keys, Left, maps:remove(Key, Right)); +bsm_units_join_1([], _MapA, Right) -> + Right. + +%%% +%%% Optimize binary construction. +%%% +%%% If an integer segment or a float segment has a literal size and +%%% a literal value, convert to a binary segment. Coalesce adjacent +%%% literal binary segments. Literal binary segments will be converted +%%% to bs_put_string instructions in later pass. +%%% + +ssa_opt_bs_puts({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> + {Linear,Count} = opt_bs_puts(Linear0, Count0, []), + {St#st{ssa=Linear,cnt=Count}, FuncDb}. + +opt_bs_puts([{L,#b_blk{is=Is}=Blk0}|Bs], Count0, Acc0) -> + case Is of + [#b_set{op=bs_put}=I0] -> + case opt_bs_put(L, I0, Blk0, Count0, Acc0) of + not_possible -> + opt_bs_puts(Bs, Count0, [{L,Blk0}|Acc0]); + {Count,Acc1} -> + Acc = opt_bs_puts_merge(Acc1), + opt_bs_puts(Bs, Count, Acc) + end; + _ -> + opt_bs_puts(Bs, Count0, [{L,Blk0}|Acc0]) + end; +opt_bs_puts([], Count, Acc) -> + {reverse(Acc),Count}. + +opt_bs_puts_merge([{L1,#b_blk{is=Is}=Blk0},{L2,#b_blk{is=AccIs}}=BAcc|Acc]) -> + case {AccIs,Is} of + {[#b_set{op=bs_put, + args=[#b_literal{val=binary}, + #b_literal{}, + #b_literal{val=Bin0}, + #b_literal{val=all}, + #b_literal{val=1}]}], + [#b_set{op=bs_put, + args=[#b_literal{val=binary}, + #b_literal{}, + #b_literal{val=Bin1}, + #b_literal{val=all}, + #b_literal{val=1}]}=I0]} -> + %% Coalesce the two segments to one. + Bin = <<Bin0/bitstring,Bin1/bitstring>>, + I = I0#b_set{args=bs_put_args(binary, Bin, all)}, + Blk = Blk0#b_blk{is=[I]}, + [{L2,Blk}|Acc]; + {_,_} -> + [{L1,Blk0},BAcc|Acc] + end. + +opt_bs_put(L, I0, #b_blk{last=Br0}=Blk0, Count0, Acc) -> + case opt_bs_put(I0) of + [Bin] when is_bitstring(Bin) -> + Args = bs_put_args(binary, Bin, all), + I = I0#b_set{args=Args}, + Blk = Blk0#b_blk{is=[I]}, + {Count0,[{L,Blk}|Acc]}; + [{int,Int,Size},Bin] when is_bitstring(Bin) -> + %% Construct a bs_put_integer instruction following + %% by a bs_put_binary instruction. + IntArgs = bs_put_args(integer, Int, Size), + BinArgs = bs_put_args(binary, Bin, all), + {BinL,BinVarNum} = {Count0,Count0+1}, + Count = Count0 + 2, + BinVar = #b_var{name={'@ssa_bool',BinVarNum}}, + BinI = I0#b_set{dst=BinVar,args=BinArgs}, + BinBlk = Blk0#b_blk{is=[BinI],last=Br0#b_br{bool=BinVar}}, + IntI = I0#b_set{args=IntArgs}, + IntBlk = Blk0#b_blk{is=[IntI],last=Br0#b_br{succ=BinL}}, + {Count,[{BinL,BinBlk},{L,IntBlk}|Acc]}; + not_possible -> + not_possible + end. + +opt_bs_put(#b_set{args=[#b_literal{val=binary},_,#b_literal{val=Val}, + #b_literal{val=all},#b_literal{val=Unit}]}) + when is_bitstring(Val) -> + if + bit_size(Val) rem Unit =:= 0 -> + [Val]; + true -> + not_possible + end; +opt_bs_put(#b_set{args=[#b_literal{val=Type},#b_literal{val=Flags}, + #b_literal{val=Val},#b_literal{val=Size}, + #b_literal{val=Unit}]}=I0) when is_integer(Size) -> + EffectiveSize = Size * Unit, + if + EffectiveSize > 0 -> + case {Type,opt_bs_put_endian(Flags)} of + {integer,big} when is_integer(Val) -> + if + EffectiveSize < 64 -> + [<<Val:EffectiveSize>>]; + true -> + opt_bs_put_split_int(Val, EffectiveSize) + end; + {integer,little} when is_integer(Val), EffectiveSize < 128 -> + %% To avoid an explosion in code size, we only try + %% to optimize relatively small fields. + <<Int:EffectiveSize>> = <<Val:EffectiveSize/little>>, + Args = bs_put_args(Type, Int, EffectiveSize), + I = I0#b_set{args=Args}, + opt_bs_put(I); + {binary,_} when is_bitstring(Val) -> + <<Bitstring:EffectiveSize/bits,_/bits>> = Val, + [Bitstring]; + {float,Endian} -> + try + [opt_bs_put_float(Val, EffectiveSize, Endian)] + catch error:_ -> + not_possible + end; + {_,_} -> + not_possible + end; + true -> + not_possible + end; +opt_bs_put(#b_set{}) -> not_possible. + +opt_bs_put_float(N, Sz, Endian) -> + case Endian of + big -> <<N:Sz/big-float-unit:1>>; + little -> <<N:Sz/little-float-unit:1>> + end. + +bs_put_args(Type, Val, Size) -> + [#b_literal{val=Type}, + #b_literal{val=[unsigned,big]}, + #b_literal{val=Val}, + #b_literal{val=Size}, + #b_literal{val=1}]. + +opt_bs_put_endian([big=E|_]) -> E; +opt_bs_put_endian([little=E|_]) -> E; +opt_bs_put_endian([native=E|_]) -> E; +opt_bs_put_endian([_|Fs]) -> opt_bs_put_endian(Fs). + +opt_bs_put_split_int(Int, Size) -> + Pos = opt_bs_put_split_int_1(Int, 0, Size - 1), + UpperSize = Size - Pos, + if + Pos =:= 0 -> + %% Value is 0 or -1 -- keep the original instruction. + not_possible; + UpperSize < 64 -> + %% No or few leading zeroes or ones. + [<<Int:Size>>]; + true -> + %% There are 64 or more leading ones or zeroes in + %% the resulting binary. Split into two separate + %% segments to avoid an explosion in code size. + [{int,Int bsr Pos,UpperSize},<<Int:Pos>>] + end. + +opt_bs_put_split_int_1(_Int, L, R) when L > R -> + 8 * ((L + 7) div 8); +opt_bs_put_split_int_1(Int, L, R) -> + Mid = (L + R) div 2, + case Int bsr Mid of + Upper when Upper =:= 0; Upper =:= -1 -> + opt_bs_put_split_int_1(Int, L, Mid - 1); + _ -> + opt_bs_put_split_int_1(Int, Mid + 1, R) + end. + +%%% +%%% Optimize expressions such as "tuple_size(Var) =:= 2". +%%% +%%% Consider this code: +%%% +%%% 0: +%%% . +%%% . +%%% . +%%% Size = bif:tuple_size Var +%%% BoolVar1 = succeeded Size +%%% br BoolVar1, label 4, label 3 +%%% +%%% 4: +%%% BoolVar2 = bif:'=:=' Size, literal 2 +%%% br BoolVar2, label 6, label 3 +%%% +%%% 6: ... %% OK +%%% +%%% 3: ... %% Not a tuple of size 2 +%%% +%%% The BEAM code will look this: +%%% +%%% {bif,tuple_size,{f,3},[{x,0}],{x,0}}. +%%% {test,is_eq_exact,{f,3},[{x,0},{integer,2}]}. +%%% +%%% Better BEAM code will be produced if we transform the +%%% code like this: +%%% +%%% 0: +%%% . +%%% . +%%% . +%%% br label 10 +%%% +%%% 10: +%%% NewBoolVar = bif:is_tuple Var +%%% br NewBoolVar, label 11, label 3 +%%% +%%% 11: +%%% Size = bif:tuple_size Var +%%% br label 4 +%%% +%%% 4: +%%% BoolVar2 = bif:'=:=' Size, literal 2 +%%% br BoolVar2, label 6, label 3 +%%% +%%% (The key part of the transformation is the removal of +%%% the 'succeeded' instruction to signal to the code generator +%%% that the call to tuple_size/1 can't fail.) +%%% +%%% The BEAM code will look like: +%%% +%%% {test,is_tuple,{f,3},[{x,0}]}. +%%% {test_arity,{f,3},[{x,0},2]}. +%%% +%%% Those two instructions will be combined into a single +%%% is_tuple_of_arity instruction by the loader. +%%% + +ssa_opt_tuple_size({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> + %% This optimization is only safe in guards, as prefixing tuple_size with + %% an is_tuple check prevents it from throwing an exception. + NonGuards = non_guards(Linear0), + {Linear,Count} = opt_tup_size(Linear0, NonGuards, Count0, []), + {St#st{ssa=Linear,cnt=Count}, FuncDb}. + +opt_tup_size([{L,#b_blk{is=Is,last=Last}=Blk}|Bs], NonGuards, Count0, Acc0) -> + case {Is,Last} of + {[#b_set{op={bif,'=:='},dst=Bool,args=[#b_var{}=Tup,#b_literal{val=Arity}]}], + #b_br{bool=Bool}} when is_integer(Arity), Arity >= 0 -> + {Acc,Count} = opt_tup_size_1(Tup, L, NonGuards, Count0, Acc0), + opt_tup_size(Bs, NonGuards, Count, [{L,Blk}|Acc]); + {_,_} -> + opt_tup_size(Bs, NonGuards, Count0, [{L,Blk}|Acc0]) + end; +opt_tup_size([], _NonGuards, Count, Acc) -> + {reverse(Acc),Count}. + +opt_tup_size_1(Size, EqL, NonGuards, Count0, [{L,Blk0}|Acc]) -> + #b_blk{is=Is0,last=Last} = Blk0, + case Last of + #b_br{bool=Bool,succ=EqL,fail=Fail} -> + case gb_sets:is_member(Fail, NonGuards) of + true -> + {[{L,Blk0}|Acc],Count0}; + false -> + case opt_tup_size_is(Is0, Bool, Size, []) of + none -> + {[{L,Blk0}|Acc],Count0}; + {PreIs,TupleSizeIs,Tuple} -> + opt_tup_size_2(PreIs, TupleSizeIs, L, EqL, + Tuple, Fail, Count0, Acc) + end + end; + _ -> + {[{L,Blk0}|Acc],Count0} + end; +opt_tup_size_1(_, _, _, Count, Acc) -> + {Acc,Count}. + +opt_tup_size_2(PreIs, TupleSizeIs, PreL, EqL, Tuple, Fail, Count0, Acc) -> + IsTupleL = Count0, + TupleSizeL = Count0 + 1, + Bool = #b_var{name={'@ssa_bool',Count0+2}}, + Count = Count0 + 3, + + True = #b_literal{val=true}, + PreBr = #b_br{bool=True,succ=IsTupleL,fail=IsTupleL}, + PreBlk = #b_blk{is=PreIs,last=PreBr}, + + IsTupleIs = [#b_set{op={bif,is_tuple},dst=Bool,args=[Tuple]}], + IsTupleBr = #b_br{bool=Bool,succ=TupleSizeL,fail=Fail}, + IsTupleBlk = #b_blk{is=IsTupleIs,last=IsTupleBr}, + + TupleSizeBr = #b_br{bool=True,succ=EqL,fail=EqL}, + TupleSizeBlk = #b_blk{is=TupleSizeIs,last=TupleSizeBr}, + {[{TupleSizeL,TupleSizeBlk}, + {IsTupleL,IsTupleBlk}, + {PreL,PreBlk}|Acc],Count}. + +opt_tup_size_is([#b_set{op={bif,tuple_size},dst=Size,args=[Tuple]}=I, + #b_set{op=succeeded,dst=Bool,args=[Size]}], + Bool, Size, Acc) -> + {reverse(Acc),[I],Tuple}; +opt_tup_size_is([I|Is], Bool, Size, Acc) -> + opt_tup_size_is(Is, Bool, Size, [I|Acc]); +opt_tup_size_is([], _, _, _Acc) -> none. + +%%% +%%% Optimize #b_switch{} instructions. +%%% +%%% If the argument for a #b_switch{} comes from a phi node with all +%%% literals, any values in the switch list which are not in the phi +%%% node can be removed. +%%% +%%% If the values in the phi node and switch list are the same, +%%% the failure label can't be reached and be eliminated. +%%% +%%% A #b_switch{} with only one value can be rewritten to +%%% a #b_br{}. A switch that only verifies that the argument +%%% is 'true' or 'false' can be rewritten to a is_boolean test. +%%% + +ssa_opt_sw({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> + {Linear,Count} = opt_sw(Linear0, Count0, []), + {St#st{ssa=Linear,cnt=Count}, FuncDb}. + +opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) -> + %% Ensure that no label in the switch list is the same + %% as the failure label. + #b_switch{fail=Fail,list=List0} = Sw0, + List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail], + Sw1 = beam_ssa:normalize(Sw0#b_switch{list=List}), + case Sw1 of + #b_switch{arg=Arg,fail=Fail,list=[{Lit,Lbl}]} -> + %% Rewrite a single value switch to a br. + Bool = #b_var{name={'@ssa_bool',Count0}}, + Count = Count0 + 1, + IsEq = #b_set{op={bif,'=:='},dst=Bool,args=[Arg,Lit]}, + Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, + Blk = Blk0#b_blk{is=Is++[IsEq],last=Br}, + opt_sw(Bs, Count, [{L,Blk}|Acc]); + #b_switch{arg=Arg,fail=Fail, + list=[{#b_literal{val=B1},Lbl},{#b_literal{val=B2},Lbl}]} + when B1 =:= not B2 -> + %% Replace with is_boolean test. + Bool = #b_var{name={'@ssa_bool',Count0}}, + Count = Count0 + 1, + IsBool = #b_set{op={bif,is_boolean},dst=Bool,args=[Arg]}, + Br = #b_br{bool=Bool,succ=Lbl,fail=Fail}, + Blk = Blk0#b_blk{is=Is++[IsBool],last=Br}, + opt_sw(Bs, Count, [{L,Blk}|Acc]); + Sw0 -> + opt_sw(Bs, Count0, [{L,Blk0}|Acc]); + Sw -> + Blk = Blk0#b_blk{last=Sw}, + opt_sw(Bs, Count0, [{L,Blk}|Acc]) + end; +opt_sw([{L,#b_blk{}=Blk}|Bs], Count, Acc) -> + opt_sw(Bs, Count, [{L,Blk}|Acc]); +opt_sw([], Count, Acc) -> + {reverse(Acc),Count}. + +%%% +%%% Merge blocks. +%%% + +ssa_opt_merge_blocks({#st{ssa=Blocks}=St, FuncDb}) -> + Preds = beam_ssa:predecessors(Blocks), + Merged = merge_blocks_1(beam_ssa:rpo(Blocks), Preds, Blocks), + {St#st{ssa=Merged}, FuncDb}. + +merge_blocks_1([L|Ls], Preds0, Blocks0) -> + case Preds0 of + #{L:=[P]} -> + #{P:=Blk0,L:=Blk1} = Blocks0, + case is_merge_allowed(L, Blk0, Blk1) of + true -> + #b_blk{is=Is0} = Blk0, + #b_blk{is=Is1} = Blk1, + verify_merge_is(Is1), + Is = Is0 ++ Is1, + Blk = Blk1#b_blk{is=Is}, + Blocks1 = maps:remove(L, Blocks0), + Blocks2 = Blocks1#{P:=Blk}, + Successors = beam_ssa:successors(Blk), + Blocks = beam_ssa:update_phi_labels(Successors, L, P, Blocks2), + Preds = merge_update_preds(Successors, L, P, Preds0), + merge_blocks_1(Ls, Preds, Blocks); + false -> + merge_blocks_1(Ls, Preds0, Blocks0) + end; + #{} -> + merge_blocks_1(Ls, Preds0, Blocks0) + end; +merge_blocks_1([], _Preds, Blocks) -> Blocks. + +merge_update_preds([L|Ls], From, To, Preds0) -> + Ps = [rename_label(P, From, To) || P <- map_get(L, Preds0)], + Preds = Preds0#{L:=Ps}, + merge_update_preds(Ls, From, To, Preds); +merge_update_preds([], _, _, Preds) -> Preds. + +rename_label(From, From, To) -> To; +rename_label(Lbl, _, _) -> Lbl. + +verify_merge_is([#b_set{op=Op}|_]) -> + %% The merged block has only one predecessor, so it should not have any phi + %% nodes. + true = Op =/= phi; %Assertion. +verify_merge_is(_) -> + ok. + +is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) -> + false; +is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> + %% The predecessor block must have exactly one successor (L) for + %% the merge to be safe. + case beam_ssa:successors(Blk) of + [L] -> + case Is of + [#b_set{op=phi,args=[_]}|_] -> + %% The type optimizer pass must have been + %% turned off, since it would have removed this + %% redundant phi node. Refuse to merge the blocks + %% to ensure that this phi node remains at the + %% beginning of a block. + false; + _ -> + true + end; + [_|_] -> + false + end; +is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> + false. + +%%% +%%% When a tuple is matched, the pattern matching compiler generates a +%%% get_tuple_element instruction for every tuple element that will +%%% ever be used in the rest of the function. That often forces the +%%% extracted tuple elements to be stored in Y registers until it's +%%% time to use them. It could also mean that there could be execution +%%% paths that will never use the extracted elements. +%%% +%%% This optimization will sink get_tuple_element instructions, that +%%% is, move them forward in the execution stream to the last possible +%%% block there they will still dominate all uses. That may reduce the +%%% size of stack frames, reduce register shuffling, and avoid +%%% extracting tuple elements on execution paths that never use the +%%% extracted values. +%%% + +ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> + Linear = beam_ssa:linearize(Blocks0), + + %% Create a map with all variables that define get_tuple_element + %% instructions. The variable name map to the block it is defined in. + case def_blocks(Linear) of + [] -> + %% No get_tuple_element instructions, so there is nothing to do. + {St, FuncDb}; + [_|_]=Defs0 -> + Defs = maps:from_list(Defs0), + {do_ssa_opt_sink(Linear, Defs, St), FuncDb} + end. + +do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> + %% Now find all the blocks that use variables defined by get_tuple_element + %% instructions. + Used = used_blocks(Linear, Defs, []), + + %% Calculate dominators. + {Dom,Numbering} = beam_ssa:dominators(Blocks0), + + %% It is not safe to move get_tuple_element instructions to blocks + %% that begin with certain instructions. It is also unsafe to move + %% the instructions into any part of a receive. To avoid such + %% unsafe moves, pretend that the unsuitable blocks are not + %% dominators. + Unsuitable = unsuitable(Linear, Blocks0), + + %% Calculate new positions for get_tuple_element instructions. The new + %% position is a block that dominates all uses of the variable. + DefLoc = new_def_locations(Used, Defs, Dom, Numbering, Unsuitable), + + %% Now move all suitable get_tuple_element instructions to their + %% new blocks. + Blocks = foldl(fun({V,To}, A) -> + From = map_get(V, Defs), + move_defs(V, From, To, A) + end, Blocks0, DefLoc), + St#st{ssa=Blocks}. + +def_blocks([{L,#b_blk{is=Is}}|Bs]) -> + def_blocks_is(Is, L, def_blocks(Bs)); +def_blocks([]) -> []. + +def_blocks_is([#b_set{op=get_tuple_element,dst=Dst}|Is], L, Acc) -> + def_blocks_is(Is, L, [{Dst,L}|Acc]); +def_blocks_is([_|Is], L, Acc) -> + def_blocks_is(Is, L, Acc); +def_blocks_is([], _, Acc) -> Acc. + +used_blocks([{L,Blk}|Bs], Def, Acc0) -> + Used = beam_ssa:used(Blk), + Acc = [{V,L} || V <- Used, maps:is_key(V, Def)] ++ Acc0, + used_blocks(Bs, Def, Acc); +used_blocks([], _Def, Acc) -> + rel2fam(Acc). + +%% unsuitable(Linear, Blocks) -> Unsuitable. +%% Return an ordset of block labels for the blocks that are not +%% suitable for sinking of get_tuple_element instructions. + +unsuitable(Linear, Blocks) -> + Predecessors = beam_ssa:predecessors(Blocks), + Unsuitable0 = unsuitable_1(Linear), + Unsuitable1 = unsuitable_recv(Linear, Blocks, Predecessors), + gb_sets:from_list(Unsuitable0 ++ Unsuitable1). + +unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs]) -> + Unsuitable = case Op of + bs_extract -> true; + bs_put -> true; + {float,_} -> true; + landingpad -> true; + peek_message -> true; + wait_timeout -> true; + _ -> false + end, + case Unsuitable of + true -> + [L|unsuitable_1(Bs)]; + false -> + unsuitable_1(Bs) + end; +unsuitable_1([{_,#b_blk{}}|Bs]) -> + unsuitable_1(Bs); +unsuitable_1([]) -> []. + +unsuitable_recv([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs], Blocks, Predecessors) -> + Ls = case Op of + remove_message -> + unsuitable_loop(L, Blocks, Predecessors); + recv_next -> + unsuitable_loop(L, Blocks, Predecessors); + _ -> + [] + end, + Ls ++ unsuitable_recv(Bs, Blocks, Predecessors); +unsuitable_recv([_|Bs], Blocks, Predecessors) -> + unsuitable_recv(Bs, Blocks, Predecessors); +unsuitable_recv([], _, _) -> []. + +unsuitable_loop(L, Blocks, Predecessors) -> + unsuitable_loop(L, Blocks, Predecessors, []). + +unsuitable_loop(L, Blocks, Predecessors, Acc) -> + Ps = map_get(L, Predecessors), + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc). + +unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) -> + case map_get(P, Blocks) of + #b_blk{is=[#b_set{op=peek_message}|_]} -> + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0); + #b_blk{} -> + case ordsets:is_element(P, Acc0) of + false -> + Acc1 = ordsets:add_element(P, Acc0), + Acc = unsuitable_loop(P, Blocks, Predecessors, Acc1), + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc); + true -> + unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0) + end + end; +unsuitable_loop_1([], _, _, Acc) -> Acc. + +%% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs, +%% Dominators, Numbering, Unsuitable) -> +%% [{Variable,NewDefinitionBlock}] +%% +%% Calculate new locations for get_tuple_element instructions. For +%% each variable, the new location is a block that dominates all uses +%% of the variable and as near to the uses of as possible. + +new_def_locations([{V,UsedIn}|Vs], Defs, Dom, Numbering, Unsuitable) -> + DefIn = map_get(V, Defs), + Common = common_dominator(UsedIn, Dom, Numbering, Unsuitable), + case member(Common, map_get(DefIn, Dom)) of + true -> + %% The common dominator is either DefIn or an + %% ancestor of DefIn. + new_def_locations(Vs, Defs, Dom, Numbering, Unsuitable); + false -> + %% We have found a suitable descendant of DefIn, + %% to which the get_tuple_element instruction can + %% be sunk. + [{V,Common}|new_def_locations(Vs, Defs, Dom, Numbering, Unsuitable)] + end; +new_def_locations([], _, _, _, _) -> []. + +common_dominator(Ls0, Dom, Numbering, Unsuitable) -> + [Common|_] = beam_ssa:common_dominators(Ls0, Dom, Numbering), + case gb_sets:is_member(Common, Unsuitable) of + true -> + %% It is not allowed to place the instruction here. Try + %% to find another suitable dominating block by going up + %% one step in the dominator tree. + [Common,OneUp|_] = map_get(Common, Dom), + common_dominator([OneUp], Dom, Numbering, Unsuitable); + false -> + Common + end. + +%% Move get_tuple_element instructions to their new locations. + +move_defs(V, From, To, Blocks) -> + #{From:=FromBlk0,To:=ToBlk0} = Blocks, + {Def,FromBlk} = remove_def(V, FromBlk0), + try insert_def(V, Def, ToBlk0) of + ToBlk -> + %%io:format("~p: ~p => ~p\n", [V,From,To]), + Blocks#{From:=FromBlk,To:=ToBlk} + catch + throw:not_possible -> + Blocks + end. + +remove_def(V, #b_blk{is=Is0}=Blk) -> + {Def,Is} = remove_def_is(Is0, V, []), + {Def,Blk#b_blk{is=Is}}. + +remove_def_is([#b_set{dst=Dst}=Def|Is], Dst, Acc) -> + {Def,reverse(Acc, Is)}; +remove_def_is([I|Is], Dst, Acc) -> + remove_def_is(Is, Dst, [I|Acc]). + +insert_def(V, Def, #b_blk{is=Is0}=Blk) -> + Is = insert_def_is(Is0, V, Def), + Blk#b_blk{is=Is}. + +insert_def_is([#b_set{op=phi}=I|Is], V, Def) -> + case member(V, beam_ssa:used(I)) of + true -> + throw(not_possible); + false -> + [I|insert_def_is(Is, V, Def)] + end; +insert_def_is([#b_set{op=Op}=I|Is]=Is0, V, Def) -> + Action0 = case Op of + call -> beyond; + 'catch_end' -> beyond; + timeout -> beyond; + _ -> here + end, + Action = case Is of + [#b_set{op=succeeded}|_] -> here; + _ -> Action0 + end, + case Action of + beyond -> + case member(V, beam_ssa:used(I)) of + true -> + %% The variable is used by this instruction. We must + %% place the definition before this instruction. + [Def|Is0]; + false -> + %% Place it beyond the current instruction. + [I|insert_def_is(Is, V, Def)] + end; + here -> + [Def|Is0] + end; +insert_def_is([], _V, Def) -> + [Def]. + +%%% +%%% Order consecutive get_tuple_element instructions in ascending +%%% position order. This will give the loader more opportunities +%%% for combining get_tuple_element instructions. +%%% + +ssa_opt_get_tuple_element({#st{ssa=Blocks0}=St, FuncDb}) -> + Blocks = opt_get_tuple_element(maps:to_list(Blocks0), Blocks0), + {St#st{ssa=Blocks}, FuncDb}. + +opt_get_tuple_element([{L,#b_blk{is=Is0}=Blk0}|Bs], Blocks) -> + case opt_get_tuple_element_is(Is0, false, []) of + {yes,Is} -> + Blk = Blk0#b_blk{is=Is}, + opt_get_tuple_element(Bs, Blocks#{L:=Blk}); + no -> + opt_get_tuple_element(Bs, Blocks) + end; +opt_get_tuple_element([], Blocks) -> Blocks. + +opt_get_tuple_element_is([#b_set{op=get_tuple_element, + args=[#b_var{}=Src,_]}=I0|Is0], + _AnyChange, Acc) -> + {GetIs0,Is} = collect_get_tuple_element(Is0, Src, [I0]), + GetIs1 = sort([{Pos,I} || #b_set{args=[_,Pos]}=I <- GetIs0]), + GetIs = [I || {_,I} <- GetIs1], + opt_get_tuple_element_is(Is, true, reverse(GetIs, Acc)); +opt_get_tuple_element_is([I|Is], AnyChange, Acc) -> + opt_get_tuple_element_is(Is, AnyChange, [I|Acc]); +opt_get_tuple_element_is([], AnyChange, Acc) -> + case AnyChange of + true -> {yes,reverse(Acc)}; + false -> no + end. + +collect_get_tuple_element([#b_set{op=get_tuple_element, + args=[Src,_]}=I|Is], Src, Acc) -> + collect_get_tuple_element(Is, Src, [I|Acc]); +collect_get_tuple_element(Is, _Src, Acc) -> + {Acc,Is}. + +%%% +%%% Common utilities. +%%% + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +non_guards(Linear) -> + gb_sets:from_list(non_guards_1(Linear)). + +non_guards_1([{L,#b_blk{is=Is}}|Bs]) -> + case Is of + [#b_set{op=landingpad}|_] -> + [L | non_guards_1(Bs)]; + _ -> + non_guards_1(Bs) + end; +non_guards_1([]) -> + [?BADARG_BLOCK]. + +rel2fam(S0) -> + S1 = sofs:relation(S0), + S = sofs:rel2fam(S1), + sofs:to_external(S). + +sub(I, Sub) -> + beam_ssa:normalize(sub_1(I, Sub)). + +sub_1(#b_set{op=phi,args=Args}=I, Sub) -> + I#b_set{args=[{sub_arg(A, Sub),P} || {A,P} <- Args]}; +sub_1(#b_set{args=Args}=I, Sub) -> + I#b_set{args=[sub_arg(A, Sub) || A <- Args]}; +sub_1(#b_br{bool=#b_var{}=Old}=Br, Sub) -> + New = sub_arg(Old, Sub), + Br#b_br{bool=New}; +sub_1(#b_switch{arg=#b_var{}=Old}=Sw, Sub) -> + New = sub_arg(Old, Sub), + Sw#b_switch{arg=New}; +sub_1(#b_ret{arg=#b_var{}=Old}=Ret, Sub) -> + New = sub_arg(Old, Sub), + Ret#b_ret{arg=New}; +sub_1(Last, _) -> Last. + +sub_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub) -> + Rem#b_remote{mod=sub_arg(Mod, Sub),name=sub_arg(Name, Sub)}; +sub_arg(Old, Sub) -> + case Sub of + #{Old:=New} -> New; + #{} -> Old + end. + +new_var(#b_var{name={Base,N}}, Count) -> + true = is_integer(N), %Assertion. + {#b_var{name={Base,Count}},Count+1}; +new_var(#b_var{name=Base}, Count) -> + {#b_var{name={Base,Count}},Count+1}. diff --git a/lib/compiler/src/beam_ssa_opt.hrl b/lib/compiler/src/beam_ssa_opt.hrl new file mode 100644 index 0000000000..37711a6f48 --- /dev/null +++ b/lib/compiler/src/beam_ssa_opt.hrl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. 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% +%% + +-include("beam_ssa.hrl"). + +-record(func_info, + {%% Local calls going in/out of this function. + in = ordsets:new() :: ordsets:ordset(func_id()), + out = ordsets:new() :: ordsets:ordset(func_id()), + + %% Whether the function is exported or not; some optimizations may + %% need to be suppressed if it is. + exported = true :: boolean(), + + %% The inferred types of each argument (as opposed to parameter), + %% indexed by call site. + %% + %% This is more effective than the naive approach of joining into a + %% "parameter_type" as we go as it lets us narrow parameter types + %% without having to visit all callers on each pass, which helps a lot + %% when dealing with co-recursive functions. + arg_types = [] :: list(arg_type_map()), + + %% The inferred return type of this function, this is either [type()] + %% or [] to note absence. + ret_type = [] :: list()}). + +-type arg_key() :: {CallerId :: func_id(), + CallDst :: beam_ssa:b_var()}. +-type arg_type_map() :: #{ arg_key() => term() }. + +%% Per-function metadata used by various optimization passes to perform +%% module-level optimization. If a function is absent it means that +%% module-level optimization has been turned off for said function. +-type func_id() :: beam_ssa:b_local(). +-type func_info_db() :: #{ func_id() => #func_info{} }. diff --git a/lib/compiler/src/beam_ssa_pp.erl b/lib/compiler/src/beam_ssa_pp.erl new file mode 100644 index 0000000000..34ac08b32e --- /dev/null +++ b/lib/compiler/src/beam_ssa_pp.erl @@ -0,0 +1,238 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_ssa_pp). + +-export([format_function/1,format_instr/1,format_var/1]). + +-include("beam_ssa.hrl"). + +-spec format_function(beam_ssa:b_function()) -> iolist(). + +format_function(#b_function{anno=Anno0,args=Args, + bs=Blocks,cnt=Counter}) -> + #{func_info:={M,F,_}} = Anno0, + Anno = maps:without([func_info,location,live_intervals,registers], Anno0), + FuncAnno = case Anno0 of + #{live_intervals:=Intervals} -> + Anno0#{live_intervals:=maps:from_list(Intervals)}; + #{} -> + Anno0 + end, + ReachableBlocks = beam_ssa:rpo(Blocks), + All = maps:keys(Blocks), + Unreachable = ordsets:subtract(ordsets:from_list(All), + ordsets:from_list(ReachableBlocks)), + [case Anno0 of + #{location:={Filename,Line}} -> + io_lib:format("%% ~ts:~p\n", [Filename,Line]); + #{} -> + [] + end, + io_lib:format("%% Counter = ~p\n", [Counter]), + [format_anno(Key, Value) || + {Key,Value} <- lists:sort(maps:to_list(Anno))], + io_lib:format("function ~p:~p(~ts) {\n", [M,F,format_args(Args, FuncAnno)]), + [format_live_interval(Var, FuncAnno) || Var <- Args], + format_blocks(ReachableBlocks, Blocks, FuncAnno), + case Unreachable of + [] -> + []; + [_|_] -> + ["\n%% Unreachable blocks\n\n", + format_blocks(Unreachable, Blocks, FuncAnno)] + end, + + "}\n"]. + + +-spec format_instr(beam_ssa:b_set()) -> iolist(). + +format_instr(#b_set{}=I) -> + Cs = lists:flatten(format_instr(I#b_set{anno=#{}}, #{}, true)), + string:trim(Cs, leading); +format_instr(I0) -> + I = setelement(2, I0, #{}), + Cs = lists:flatten(format_terminator(I, #{})), + string:trim(Cs, both). + +-spec format_var(beam_ssa:b_var()) -> iolist(). + +format_var(V) -> + Cs = lists:flatten(format_var(V, #{})), + string:trim(Cs, leading). + +%%% +%%% Local functions. +%%% + +format_anno(Key, Map) when is_map(Map) -> + Sorted = lists:sort(maps:to_list(Map)), + [io_lib:format("%% ~s:\n", [Key]), + [io_lib:format("%% ~w => ~w\n", [K,V]) || {K,V} <- Sorted]]; +format_anno(Key, Value) -> + io_lib:format("%% ~s: ~p\n", [Key,Value]). + +format_blocks(Ls, Blocks, Anno) -> + PP = [format_block(L, Blocks, Anno) || L <- Ls], + lists:join($\n, PP). + +format_block(L, Blocks, FuncAnno) -> + #b_blk{anno=Anno,is=Is,last=Last} = maps:get(L, Blocks), + [case map_size(Anno) of + 0 -> []; + _ -> io_lib:format("%% ~p\n", [Anno]) + end, + io_lib:format("~p:", [L]), + format_instrs(Is, FuncAnno, true), + $\n, + format_terminator(Last, FuncAnno)]. + +format_instrs([I|Is], FuncAnno, First) -> + [$\n, + format_instr(I, FuncAnno, First), + format_instrs(Is, FuncAnno, false)]; +format_instrs([], _FuncAnno, _First) -> + []. + +format_instr(#b_set{anno=Anno,op=Op,dst=Dst,args=Args}, + FuncAnno, First) -> + AnnoStr = format_anno(Anno), + LiveIntervalStr = format_live_interval(Dst, FuncAnno), + [if + First -> + []; + AnnoStr =/= []; LiveIntervalStr =/= [] -> + $\n; + true -> + [] + end, + AnnoStr, + LiveIntervalStr, + io_lib:format(" ~s~ts = ~ts", [format_i_number(Anno), + format_var(Dst, FuncAnno), + format_op(Op)]), + case Args of + [] -> + []; + [_|_] -> + io_lib:format(" ~ts", [format_args(Args, FuncAnno)]) + end]. + +format_i_number(#{n:=N}) -> + io_lib:format("[~p] ", [N]); +format_i_number(#{}) -> []. + +format_terminator(#b_br{anno=A,bool=#b_literal{val=true},succ=Lbl}, _) -> + io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); +format_terminator(#b_br{anno=A,bool=#b_literal{val=false},fail=Lbl}, _) -> + io_lib:format(" ~sbr label ~p\n", [format_i_number(A),Lbl]); +format_terminator(#b_br{anno=A,bool=Bool,succ=Succ,fail=Fail}, FuncAnno) -> + io_lib:format(" ~sbr ~ts, label ~p, label ~p\n", + [format_i_number(A),format_arg(Bool, FuncAnno),Succ,Fail]); +format_terminator(#b_switch{anno=A,arg=Arg,fail=Fail,list=List}, FuncAnno) -> + io_lib:format(" ~sswitch ~ts, label ~p, ~ts\n", + [format_i_number(A),format_arg(Arg, FuncAnno),Fail, + format_list(List,FuncAnno)]); +format_terminator(#b_ret{anno=A,arg=Arg}, FuncAnno) -> + io_lib:format(" ~sret ~ts\n", [format_i_number(A),format_arg(Arg, FuncAnno)]). + +format_op({Prefix,Name}) -> + io_lib:format("~p:~p", [Prefix,Name]); +format_op(Name) -> + io_lib:format("~p", [Name]). + +format_register(#b_var{}=V, #{registers:=Regs}) -> + {Tag,N} = maps:get(V, Regs), + io_lib:format("~p~p", [Tag,N]); +format_register(_, #{}) -> "". + +format_var(Var, FuncAnno) -> + VarString = format_var_1(Var), + case format_register(Var, FuncAnno) of + [] -> VarString; + [_|_]=Reg -> [Reg,$/,VarString] + end. + +format_var_1(#b_var{name={Name,Uniq}}) -> + if + is_atom(Name) -> + io_lib:format("~ts:~p", [Name,Uniq]); + is_integer(Name) -> + io_lib:format("_~p:~p", [Name,Uniq]) + end; +format_var_1(#b_var{name=Name}) when is_atom(Name) -> + atom_to_list(Name); +format_var_1(#b_var{name=Name}) when is_integer(Name) -> + "_"++integer_to_list(Name). + +format_args(Args, FuncAnno) -> + Ss = [format_arg(Arg, FuncAnno) || Arg <- Args], + lists:join(", ", Ss). + +format_arg(#b_var{}=Arg, FuncAnno) -> + format_var(Arg, FuncAnno); +format_arg(#b_literal{val=Val}, _FuncAnno) -> + io_lib:format("literal ~p", [Val]); +format_arg(#b_remote{mod=Mod,name=Name,arity=Arity}, FuncAnno) -> + io_lib:format("remote (~ts):(~ts)/~p", + [format_arg(Mod, FuncAnno),format_arg(Name, FuncAnno),Arity]); +format_arg(#b_local{name=Name,arity=Arity}, FuncAnno) -> + io_lib:format("local ~ts/~p", [format_arg(Name, FuncAnno),Arity]); +format_arg({Value,Label}, FuncAnno) when is_integer(Label) -> + io_lib:format("{ ~ts, ~p }", [format_arg(Value, FuncAnno),Label]); +format_arg(Other, _) -> + io_lib:format("*** ~p ***", [Other]). + +format_list(List, FuncAnno) -> + Ss = [io_lib:format("{ ~ts, ~ts }", [format_arg(Val, FuncAnno),format_label(L)]) || + {Val,L} <- List], + io_lib:format("[ ~ts ]", [lists:join(", ", Ss)]). + +format_label(L) -> + ["label ",integer_to_list(L)]. + +format_anno(#{n:=_}=Anno) -> + format_anno(maps:remove(n, Anno)); +format_anno(#{location:={File,Line}}=Anno0) -> + Anno = maps:remove(location, Anno0), + [io_lib:format(" %% ~ts:~p\n", [File,Line])|format_anno_1(Anno)]; +format_anno(Anno) -> + format_anno_1(Anno). + +format_anno_1(Anno) -> + case map_size(Anno) of + 0 -> + []; + _ -> + [io_lib:format(" %% Anno: ~p\n", [Anno])] + end. + +format_live_interval(#b_var{}=Dst, #{live_intervals:=Intervals}) -> + case Intervals of + #{Dst:=Rs0} -> + Rs1 = [io_lib:format("~p..~p", [Start,End]) || + {Start,End} <- Rs0], + Rs = lists:join(" ", Rs1), + io_lib:format(" %% ~ts: ~s\n", [format_var_1(Dst),Rs]); + #{} -> + [] + end; +format_live_interval(_, _) -> []. + diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl new file mode 100644 index 0000000000..7f816b9802 --- /dev/null +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -0,0 +1,2937 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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: Prepare for code generation, including register allocation. +%% +%% The output of this compiler pass is still in the SSA format, but +%% it has been annotated and transformed to help the code generator. +%% +%% * Some instructions are translated to other instructions closer to +%% the BEAM instructions. For example, the binary matching +%% instructions are transformed from the optimization-friendly +%% internal format to instruction more similar to the actual BEAM +%% instructions. +%% +%% * Blocks that will need an instruction for allocating a stack frame +%% are annotated with a {frame_size,Size} annotation. +%% +%% * 'copy' instructions are added for all variables that need +%% to be saved to the stack frame. Additional 'copy' instructions +%% can be added as an optimization to reuse y registers (see +%% the copy_retval sub pass). +%% +%% * Each function is annotated with a {register,RegisterMap} +%% annotation that maps each variable to a BEAM register. The linear +%% scan algorithm is used to allocate registers. +%% +%% There are four kind of registers. x, y, fr (floating point register), +%% and z. A variable will be allocated to a z register if it is only +%% used by the instruction following the instruction that defines the +%% the variable. The code generator will typically combine those +%% instructions to a test instruction. z registers are also used for +%% some instructions that don't have a return value. +%% +%% References: +%% +%% [1] H. Mössenböck and M. Pfeiffer. Linear scan register allocation +%% in the context of SSA form and register constraints. In Proceedings +%% of the International Conference on Compiler Construction, pages +%% 229–246. LNCS 2304, Springer-Verlag, 2002. +%% +%% [2] C. Wimmer and H. Mössenböck. Optimized interval splitting in a +%% linear scan register allocator. In Proceedings of the ACM/USENIX +%% International Conference on Virtual Execution Environments, pages +%% 132–141. ACM Press, 2005. +%% +%% [3] C. Wimmer and M. Franz. Linear Scan Register Allocation on SSA +%% Form. In Proceedings of the International Symposium on Code +%% Generation and Optimization, pages 170-179. ACM Press, 2010. +%% + +-module(beam_ssa_pre_codegen). + +-export([module/2]). + +-include("beam_ssa.hrl"). + +-import(lists, [all/2,any/2,append/1,duplicate/2, + foldl/3,last/1,map/2,member/2,partition/2, + reverse/1,reverse/2,sort/1,splitwith/2,zip/2]). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, Opts) -> + UseBSM3 = not proplists:get_bool(no_bsm3, Opts), + Ps = passes(Opts), + Fs = functions(Fs0, Ps, UseBSM3), + {ok,Module#b_module{body=Fs}}. + +functions([F|Fs], Ps, UseBSM3) -> + [function(F, Ps, UseBSM3)|functions(Fs, Ps, UseBSM3)]; +functions([], _Ps, _UseBSM3) -> []. + +-type b_var() :: beam_ssa:b_var(). +-type var_name() :: beam_ssa:var_name(). +-type instr_number() :: pos_integer(). +-type range() :: {instr_number(),instr_number()}. +-type reg_num() :: beam_asm:reg_num(). +-type xreg() :: {'x',reg_num()}. +-type yreg() :: {'y',reg_num()}. +-type ypool() :: {'y',beam_ssa:label()}. +-type reservation() :: 'fr' | {'prefer',xreg()} | 'x' | {'x',xreg()} | + ypool() | {yreg(),ypool()} | 'z'. +-type ssa_register() :: beam_ssa_codegen:ssa_register(). + +-define(TC(Body), tc(fun() -> Body end, ?FILE, ?LINE)). +-record(st, {ssa :: beam_ssa:block_map(), + args :: [b_var()], + cnt :: beam_ssa:label(), + use_bsm3 :: boolean(), + frames=[] :: [beam_ssa:label()], + intervals=[] :: [{b_var(),[range()]}], + res=[] :: [{b_var(),reservation()}] | #{b_var():=reservation()}, + regs=#{} :: #{b_var():=ssa_register()}, + extra_annos=[] :: [{atom(),term()}] + }). +-define(PASS(N), {N,fun N/1}). + +passes(Opts) -> + AddPrecgAnnos = proplists:get_bool(dprecg, Opts), + FixTuples = proplists:get_bool(no_put_tuple2, Opts), + Ps = [?PASS(assert_no_critical_edges), + + %% Preliminaries. + ?PASS(fix_bs), + ?PASS(sanitize), + case FixTuples of + false -> ignore; + true -> ?PASS(fix_tuples) + end, + ?PASS(use_set_tuple_element), + ?PASS(place_frames), + ?PASS(fix_receives), + + %% Find and reserve Y registers. + ?PASS(find_yregs), + ?PASS(reserve_yregs), + + %% Handle legacy binary match instruction that don't + %% accept a Y register as destination. + ?PASS(legacy_bs), + + %% Improve reuse of Y registers to potentially + %% reduce the size of the stack frame. + ?PASS(copy_retval), + ?PASS(opt_get_list), + + %% Calculate live intervals. + ?PASS(number_instructions), + ?PASS(live_intervals), + ?PASS(reserve_regs), + + %% If needed for a .precg file, save the live intervals + %% so they can be included in an annotation. + case AddPrecgAnnos of + false -> ignore; + true -> ?PASS(save_live_intervals) + end, + + %% Allocate registers. + ?PASS(linear_scan), + ?PASS(frame_size), + ?PASS(turn_yregs), + + ?PASS(assert_no_critical_edges)], + [P || P <- Ps, P =/= ignore]. + +function(#b_function{anno=Anno,args=Args,bs=Blocks0,cnt=Count0}=F0, + Ps, UseBSM3) -> + try + St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3,cnt=Count0}, + St = compile:run_sub_passes(Ps, St0), + #st{ssa=Blocks,cnt=Count,regs=Regs,extra_annos=ExtraAnnos} = St, + F1 = add_extra_annos(F0, ExtraAnnos), + F = beam_ssa:add_anno(registers, Regs, F1), + F#b_function{bs=Blocks,cnt=Count} + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +save_live_intervals(#st{intervals=Intervals}=St) -> + St#st{extra_annos=[{live_intervals,Intervals}]}. + +%% Add extra annotations when a .precg listing file is being produced. +add_extra_annos(F, Annos) -> + foldl(fun({Name,Value}, Acc) -> + beam_ssa:add_anno(Name, Value, Acc) + end, F, Annos). + +%% assert_no_critical_edges(St0) -> St. +%% The code generator will not work if there are critial edges. +%% Abort if any critical edges are found. + +assert_no_critical_edges(#st{ssa=Blocks}=St) -> + F = fun assert_no_ces/3, + beam_ssa:fold_rpo(F, Blocks, Blocks), + St. + +assert_no_ces(_, #b_blk{is=[#b_set{op=phi,args=[_,_]=Phis}|_]}, Blocks) -> + %% This block has multiple predecessors. Make sure that none + %% of the precessors have more than one successor. + true = all(fun({_,P}) -> + length(beam_ssa:successors(P, Blocks)) =:= 1 + end, Phis), %Assertion. + Blocks; +assert_no_ces(_, _, Blocks) -> Blocks. + +%% fix_bs(St0) -> St. +%% Fix up the binary matching instructions: +%% +%% * Insert bs_save and bs_restore instructions where needed. +%% +%% * Combine bs_match and bs_extract instructions to bs_get +%% instructions. + +fix_bs(#st{ssa=Blocks,cnt=Count0,use_bsm3=UseBSM3}=St) -> + F = fun(#b_set{op=bs_start_match,dst=Dst}, A) -> + %% Mark the root of the match context list. + [{Dst,{context,Dst}}|A]; + (#b_set{op=bs_match,dst=Dst,args=[_,ParentCtx|_]}, A) -> + %% Link this match context the previous match context. + [{Dst,ParentCtx}|A]; + (_, A) -> + A + end, + case beam_ssa:fold_instrs_rpo(F, [0], [],Blocks) of + [] -> + %% No binary matching in this function. + St; + [_|_]=M -> + CtxChain = maps:from_list(M), + Linear0 = beam_ssa:linearize(Blocks), + + %% Insert position instructions where needed. + {Linear1,Count} = case UseBSM3 of + true -> + bs_pos_bsm3(Linear0, CtxChain, Count0); + false -> + bs_pos_bsm2(Linear0, CtxChain, Count0) + end, + + %% Rename instructions. + Linear = bs_instrs(Linear1, CtxChain, []), + + St#st{ssa=maps:from_list(Linear),cnt=Count} + end. + +%% Insert bs_get_position and bs_set_position instructions as needed. +bs_pos_bsm3(Linear0, CtxChain, Count0) -> + Rs0 = bs_restores(Linear0, CtxChain, #{}, #{}), + Rs = maps:values(Rs0), + S0 = sofs:relation(Rs, [{context,save_point}]), + S1 = sofs:relation_to_family(S0), + S = sofs:to_external(S1), + + {SavePoints,Count1} = make_bs_pos_dict(S, Count0, []), + {Gets,Count2} = make_bs_setpos_map(Rs, SavePoints, Count1, []), + {Sets,Count} = make_bs_getpos_map(maps:to_list(Rs0), SavePoints, Count2, []), + + %% Now insert all saves and restores. + {bs_insert_bsm3(Linear0, Gets, Sets, SavePoints),Count}. + +make_bs_setpos_map([{Ctx,Save}=Ps|T], SavePoints, Count, Acc) -> + SavePoint = get_savepoint(Ps, SavePoints), + I = #b_set{op=bs_get_position,dst=SavePoint,args=[Ctx]}, + make_bs_setpos_map(T, SavePoints, Count+1, [{Save,I}|Acc]); +make_bs_setpos_map([], _, Count, Acc) -> + {maps:from_list(Acc),Count}. + +make_bs_getpos_map([{Bef,{Ctx,_}=Ps}|T], SavePoints, Count, Acc) -> + Ignored = #b_var{name={'@ssa_ignored',Count}}, + Args = [Ctx, get_savepoint(Ps, SavePoints)], + I = #b_set{op=bs_set_position,dst=Ignored,args=Args}, + make_bs_getpos_map(T, SavePoints, Count+1, [{Bef,I}|Acc]); +make_bs_getpos_map([], _, Count, Acc) -> + {maps:from_list(Acc),Count}. + +get_savepoint({_,_}=Ps, SavePoints) -> + Name = {'@ssa_bs_position', map_get(Ps, SavePoints)}, + #b_var{name=Name}. + +make_bs_pos_dict([{Ctx,Pts}|T], Count0, Acc0) -> + {Acc, Count} = make_bs_pos_dict_1(Pts, Ctx, Count0, Acc0), + make_bs_pos_dict(T, Count, Acc); +make_bs_pos_dict([], Count, Acc) -> + {maps:from_list(Acc), Count}. + +make_bs_pos_dict_1([H|T], Ctx, I, Acc) -> + make_bs_pos_dict_1(T, Ctx, I+1, [{{Ctx,H},I}|Acc]); +make_bs_pos_dict_1([], Ctx, I, Acc) -> + {[{Ctx,I}|Acc], I}. + +%% As bs_position but without OTP-22 instructions. This is only used when +%% cross-compiling to older versions. +bs_pos_bsm2(Linear0, CtxChain, Count0) -> + Rs0 = bs_restores(Linear0, CtxChain, #{}, #{}), + Rs = maps:values(Rs0), + S0 = sofs:relation(Rs, [{context,save_point}]), + S1 = sofs:relation_to_family(S0), + S = sofs:to_external(S1), + Slots = make_save_point_dict(S, []), + {Saves,Count1} = make_save_map(Rs, Slots, Count0, []), + {Restores,Count} = make_restore_map(maps:to_list(Rs0), Slots, Count1, []), + + %% Now insert all saves and restores. + {bs_insert_bsm2(Linear0, Saves, Restores, Slots),Count}. + +make_save_map([{Ctx,Save}=Ps|T], Slots, Count, Acc) -> + Ignored = #b_var{name={'@ssa_ignored',Count}}, + case make_slot(Ps, Slots) of + #b_literal{val=start} -> + make_save_map(T, Slots, Count, Acc); + Slot -> + I = #b_set{op=bs_save,dst=Ignored,args=[Ctx,Slot]}, + make_save_map(T, Slots, Count+1, [{Save,I}|Acc]) + end; +make_save_map([], _, Count, Acc) -> + {maps:from_list(Acc),Count}. + +make_restore_map([{Bef,{Ctx,_}=Ps}|T], Slots, Count, Acc) -> + Ignored = #b_var{name={'@ssa_ignored',Count}}, + I = #b_set{op=bs_restore,dst=Ignored,args=[Ctx,make_slot(Ps, Slots)]}, + make_restore_map(T, Slots, Count+1, [{Bef,I}|Acc]); +make_restore_map([], _, Count, Acc) -> + {maps:from_list(Acc),Count}. + +make_slot({Same,Same}, _Slots) -> + #b_literal{val=start}; +make_slot({_,_}=Ps, Slots) -> + #b_literal{val=map_get(Ps, Slots)}. + +make_save_point_dict([{Ctx,Pts}|T], Acc0) -> + Acc = make_save_point_dict_1(Pts, Ctx, 0, Acc0), + make_save_point_dict(T, Acc); +make_save_point_dict([], Acc) -> + maps:from_list(Acc). + +make_save_point_dict_1([Ctx|T], Ctx, I, Acc) -> + %% Special {atom,start} save point. Does not need a + %% bs_save instruction. + make_save_point_dict_1(T, Ctx, I, Acc); +make_save_point_dict_1([H|T], Ctx, I, Acc) -> + make_save_point_dict_1(T, Ctx, I+1, [{{Ctx,H},I}|Acc]); +make_save_point_dict_1([], Ctx, I, Acc) -> + [{Ctx,I}|Acc]. + +bs_restores([{L,#b_blk{is=Is,last=Last}}|Bs], CtxChain, D0, Rs0) -> + InPos = maps:get(L, D0, #{}), + {SuccPos, FailPos, Rs} = bs_restores_is(Is, CtxChain, InPos, InPos, Rs0), + + D = bs_update_successors(Last, SuccPos, FailPos, D0), + bs_restores(Bs, CtxChain, D, Rs); +bs_restores([], _, _, Rs) -> Rs. + +bs_update_successors(#b_br{succ=Succ,fail=Fail}, SPos, FPos, D) -> + join_positions([{Succ,SPos},{Fail,FPos}], D); +bs_update_successors(#b_switch{fail=Fail,list=List}, SPos, FPos, D) -> + SPos = FPos, %Assertion. + Update = [{L,SPos} || {_,L} <- List] ++ [{Fail,SPos}], + join_positions(Update, D); +bs_update_successors(#b_ret{}, SPos, FPos, D) -> + SPos = FPos, %Assertion. + D. + +join_positions([{L,MapPos0}|T], D) -> + case D of + #{L:=MapPos0} -> + %% Same map. + join_positions(T, D); + #{L:=MapPos1} -> + %% Different maps. + MapPos = join_positions_1(MapPos0, MapPos1), + join_positions(T, D#{L:=MapPos}); + #{} -> + join_positions(T, D#{L=>MapPos0}) + end; +join_positions([], D) -> D. + +join_positions_1(MapPos0, MapPos1) -> + MapPos2 = maps:map(fun(Start, Pos) -> + case MapPos0 of + #{Start:=Pos} -> Pos; + #{Start:=_} -> unknown; + #{} -> Pos + end + end, MapPos1), + maps:merge(MapPos0, MapPos2). + +%% +%% Updates the restore and position maps according to the given instructions. +%% +%% Note that positions may be updated even when a match fails; if a match +%% requires a restore, the position at the fail block will be the position +%% we've *restored to* and not the one we entered the current block with. +%% + +bs_restores_is([#b_set{op=bs_start_match,dst=Start}|Is], + CtxChain, SPos0, FPos, Rs) -> + %% We only allow one match per block. + SPos0 = FPos, %Assertion. + SPos = SPos0#{Start=>Start}, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is], + CtxChain, SPos0, FPos0, Rs0) -> + SPos0 = FPos0, %Assertion. + Start = bs_subst_ctx(NewPos, CtxChain), + [_,FromPos|_] = Args, + case SPos0 of + #{Start:=FromPos} -> + %% Same position, no restore needed. + SPos = case bs_match_type(I) of + plain -> + %% Update position to new position. + SPos0#{Start:=NewPos}; + _ -> + %% Position will not change (test_unit + %% instruction or no instruction at + %% all). + SPos0#{Start:=FromPos} + end, + bs_restores_is(Is, CtxChain, SPos, FPos0, Rs0); + #{Start:=_} -> + %% Different positions, might need a restore instruction. + case bs_match_type(I) of + none -> + %% This is a tail test that will be optimized away. + %% There's no need to do a restore, and all + %% positions are unchanged. + bs_restores_is(Is, CtxChain, SPos0, FPos0, Rs0); + test_unit -> + %% This match instruction will be replaced by + %% a test_unit instruction. We will need a + %% restore. The new position will be the position + %% restored to (NOT NewPos). + SPos = SPos0#{Start:=FromPos}, + FPos = FPos0#{Start:=FromPos}, + Rs = Rs0#{NewPos=>{Start,FromPos}}, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); + plain -> + %% Match or skip. Position will be changed. + SPos = SPos0#{Start:=NewPos}, + FPos = FPos0#{Start:=FromPos}, + Rs = Rs0#{NewPos=>{Start,FromPos}}, + bs_restores_is(Is, CtxChain, SPos, FPos, Rs) + end + end; +bs_restores_is([#b_set{op=bs_extract,args=[FromPos|_]}|Is], + CtxChain, SPos, FPos, Rs) -> + Start = bs_subst_ctx(FromPos, CtxChain), + #{Start:=FromPos} = SPos, %Assertion. + #{Start:=FromPos} = FPos, %Assertion. + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([#b_set{op=call,dst=Dst,args=Args}|Is], + CtxChain, SPos0, FPos0, Rs0) -> + {Rs, SPos1, FPos1} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + {SPos, FPos} = bs_invalidate_pos(Args, SPos1, FPos1, CtxChain), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, SPos0, FPos0, Rs) -> + %% We can land here from any point, so all positions are invalid. + Invalidate = fun(_Start,_Pos) -> unknown end, + SPos = maps:map(Invalidate, SPos0), + FPos = maps:map(Invalidate, FPos0), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([#b_set{op=Op,dst=Dst,args=Args}|Is], + CtxChain, SPos0, FPos0, Rs0) + when Op =:= bs_test_tail; + Op =:= bs_get_tail -> + {Rs, SPos, FPos} = bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0), + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([_|Is], CtxChain, SPos, FPos, Rs) -> + bs_restores_is(Is, CtxChain, SPos, FPos, Rs); +bs_restores_is([], _CtxChain, SPos, FPos, Rs) -> + {SPos, FPos, Rs}. + +bs_match_type(#b_set{args=[#b_literal{val=skip},_Ctx, + #b_literal{val=binary},_Flags, + #b_literal{val=all},#b_literal{val=U}]}) -> + case U of + 1 -> none; + _ -> test_unit + end; +bs_match_type(_) -> + plain. + +%% Call instructions leave the match position in an undefined state, +%% requiring us to invalidate each affected argument. +bs_invalidate_pos([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain) -> + Start = bs_subst_ctx(Arg, CtxChain), + case SPos0 of + #{Start:=_} -> + SPos = SPos0#{Start:=unknown}, + FPos = FPos0#{Start:=unknown}, + bs_invalidate_pos(Args, SPos, FPos, CtxChain); + #{} -> + %% Not a match context. + bs_invalidate_pos(Args, SPos0, FPos0, CtxChain) + end; +bs_invalidate_pos([_|Args], SPos, FPos, CtxChain) -> + bs_invalidate_pos(Args, SPos, FPos, CtxChain); +bs_invalidate_pos([], SPos, FPos, _CtxChain) -> + {SPos, FPos}. + +bs_restore_args([#b_var{}=Arg|Args], SPos0, FPos0, CtxChain, Dst, Rs0) -> + Start = bs_subst_ctx(Arg, CtxChain), + case SPos0 of + #{Start:=Arg} -> + %% Same position, no restore needed. + bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0); + #{Start:=_} -> + %% Different positions, need a restore instruction. + SPos = SPos0#{Start:=Arg}, + FPos = FPos0#{Start:=Arg}, + Rs = Rs0#{Dst=>{Start,Arg}}, + bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); + #{} -> + %% Not a match context. + bs_restore_args(Args, SPos0, FPos0, CtxChain, Dst, Rs0) + end; +bs_restore_args([_|Args], SPos, FPos, CtxChain, Dst, Rs) -> + bs_restore_args(Args, SPos, FPos, CtxChain, Dst, Rs); +bs_restore_args([], SPos, FPos, _CtxChain, _Dst, Rs) -> + {Rs,SPos,FPos}. + +%% Insert all bs_save and bs_restore instructions. + +bs_insert_bsm3(Blocks, Saves, Restores, SavePoints) -> + bs_insert_1(Blocks, Saves, Restores, SavePoints, fun(I) -> I end). + +bs_insert_bsm2(Blocks, Saves, Restores, SavePoints) -> + %% The old instructions require bs_start_match to be annotated with the + %% number of position slots it needs. + bs_insert_1(Blocks, Saves, Restores, SavePoints, + fun(#b_set{op=bs_start_match,dst=Dst}=I0) -> + NumSlots = case SavePoints of + #{Dst:=NumSlots0} -> NumSlots0; + #{} -> 0 + end, + beam_ssa:add_anno(num_slots, NumSlots, I0); + (I) -> + I + end). + +bs_insert_1([{L,#b_blk{is=Is0}=Blk}|Bs0], Saves, Restores, Slots, XFrm) -> + Is = bs_insert_is_1(Is0, Restores, Slots, XFrm), + Bs = bs_insert_saves(Is, Bs0, Saves), + [{L,Blk#b_blk{is=Is}}|bs_insert_1(Bs, Saves, Restores, Slots, XFrm)]; +bs_insert_1([], _, _, _, _) -> []. + +bs_insert_is_1([#b_set{op=Op,dst=Dst}=I0|Is], Restores, SavePoints, XFrm) -> + I = XFrm(I0), + if + Op =:= bs_test_tail; + Op =:= bs_get_tail; + Op =:= bs_match; + Op =:= call -> + Rs = case Restores of + #{Dst:=R} -> [R]; + #{} -> [] + end, + Rs ++ [I|bs_insert_is_1(Is, Restores, SavePoints, XFrm)]; + true -> + [I|bs_insert_is_1(Is, Restores, SavePoints, XFrm)] + end; +bs_insert_is_1([], _, _, _) -> []. + +bs_insert_saves([#b_set{dst=Dst}|Is], Bs, Saves) -> + case Saves of + #{Dst:=S} -> + bs_insert_save(S, Bs); + #{} -> + bs_insert_saves(Is, Bs, Saves) + end; +bs_insert_saves([], Bs, _) -> Bs. + +bs_insert_save(Save, [{L,#b_blk{is=Is0}=Blk}|Bs]) -> + Is = case Is0 of + [#b_set{op=bs_extract}=Ex|Is1] -> + [Ex,Save|Is1]; + _ -> + [Save|Is0] + end, + [{L,Blk#b_blk{is=Is}}|Bs]. + +%% Translate bs_match instructions to bs_get, bs_match_string, +%% or bs_skip. Also rename match context variables to use the +%% variable assigned to by the start_match instruction. + +bs_instrs([{L,#b_blk{is=Is0}=Blk}|Bs], CtxChain, Acc0) -> + case bs_instrs_is(Is0, CtxChain, []) of + [#b_set{op=bs_extract,dst=Dst,args=[Ctx]}|Is] -> + %% Drop this instruction. Rewrite the corresponding + %% bs_match instruction in the previous block to + %% a bs_get instruction. + Acc = bs_combine(Dst, Ctx, Acc0), + bs_instrs(Bs, CtxChain, [{L,Blk#b_blk{is=Is}}|Acc]); + Is -> + bs_instrs(Bs, CtxChain, [{L,Blk#b_blk{is=Is}}|Acc0]) + end; +bs_instrs([], _, Acc) -> + reverse(Acc). + +bs_instrs_is([#b_set{op=Op,args=Args0}=I0|Is], CtxChain, Acc) -> + Args = [bs_subst_ctx(A, CtxChain) || A <- Args0], + I1 = I0#b_set{args=Args}, + I = case {Op,Args} of + {bs_match,[#b_literal{val=skip},Ctx,Type|As]} -> + I1#b_set{op=bs_skip,args=[Type,Ctx|As]}; + {bs_match,[#b_literal{val=string},Ctx|As]} -> + I1#b_set{op=bs_match_string,args=[Ctx|As]}; + {bs_get_tail,[Ctx|As]} -> + I1#b_set{op=bs_get_tail,args=[Ctx|As]}; + {_,_} -> + I1 + end, + bs_instrs_is(Is, CtxChain, [I|Acc]); +bs_instrs_is([], _, Acc) -> + reverse(Acc). + +%% Combine a bs_match instruction with the destination register +%% taken from a bs_extract instruction. + +bs_combine(Dst, Ctx, [{L,#b_blk{is=Is0}=Blk}|Acc]) -> + [#b_set{}=Succeeded, + #b_set{op=bs_match,args=[Type,_|As]}=BsMatch|Is1] = reverse(Is0), + Is = reverse(Is1, [BsMatch#b_set{op=bs_get,dst=Dst,args=[Type,Ctx|As]}, + Succeeded#b_set{args=[Dst]}]), + [{L,Blk#b_blk{is=Is}}|Acc]. + +bs_subst_ctx(#b_var{}=Var, CtxChain) -> + case CtxChain of + #{Var:={context,Ctx}} -> + Ctx; + #{Var:=ParentCtx} -> + bs_subst_ctx(ParentCtx, CtxChain); + #{} -> + %% Not a match context variable. + Var + end; +bs_subst_ctx(Other, _CtxChain) -> + Other. + +%% legacy_bs(St0) -> St. +%% Binary matching instructions in OTP 21 and earlier don't support +%% a Y register as destination. If St#st.use_bsm3 is false, +%% we will need to rewrite those instructions so that the result +%% is first put in an X register and then moved to a Y register +%% if the operation succeeded. + +legacy_bs(#st{use_bsm3=false,ssa=Blocks0,cnt=Count0,res=Res}=St) -> + IsYreg = maps:from_list([{V,true} || {V,{y,_}} <- Res]), + Linear0 = beam_ssa:linearize(Blocks0), + {Linear,Count} = legacy_bs(Linear0, IsYreg, Count0, #{}, []), + Blocks = maps:from_list(Linear), + St#st{ssa=Blocks,cnt=Count}; +legacy_bs(#st{use_bsm3=true}=St) -> St. + +legacy_bs([{L,Blk}|Bs], IsYreg, Count0, Copies0, Acc) -> + #b_blk{is=Is0,last=Last} = Blk, + Is1 = case Copies0 of + #{L:=Copy} -> [Copy|Is0]; + #{} -> Is0 + end, + {Is,Count,Copies} = legacy_bs_is(Is1, Last, IsYreg, Count0, Copies0, []), + legacy_bs(Bs, IsYreg, Count, Copies, [{L,Blk#b_blk{is=Is}}|Acc]); +legacy_bs([], _IsYreg, Count, _Copies, Acc) -> + {Acc,Count}. + +legacy_bs_is([#b_set{op=Op,dst=Dst}=I0, + #b_set{op=succeeded,dst=SuccDst,args=[Dst]}=SuccI0], + Last, IsYreg, Count0, Copies0, Acc) -> + NeedsFix = is_map_key(Dst, IsYreg) andalso + case Op of + bs_get -> true; + bs_init -> true; + _ -> false + end, + case NeedsFix of + true -> + TempDst = #b_var{name={'@bs_temp_dst',Count0}}, + Count = Count0 + 1, + I = I0#b_set{dst=TempDst}, + SuccI = SuccI0#b_set{args=[TempDst]}, + Copy = #b_set{op=copy,dst=Dst,args=[TempDst]}, + #b_br{bool=SuccDst,succ=SuccL} = Last, + Copies = Copies0#{SuccL=>Copy}, + legacy_bs_is([], Last, IsYreg, Count, Copies, [SuccI,I|Acc]); + false -> + legacy_bs_is([], Last, IsYreg, Count0, Copies0, [SuccI0,I0|Acc]) + end; +legacy_bs_is([I|Is], Last, IsYreg, Count, Copies, Acc) -> + legacy_bs_is(Is, Last, IsYreg, Count, Copies, [I|Acc]); +legacy_bs_is([], _Last, _IsYreg, Count, Copies, Acc) -> + {reverse(Acc),Count,Copies}. + +%% sanitize(St0) -> St. +%% Remove constructs that can cause problems later: +%% +%% * Unreachable blocks may cause problems for determination of +%% dominators. +%% +%% * Some instructions (such as get_hd) don't accept literal +%% arguments. Evaluate the instructions and remove them. + +sanitize(#st{ssa=Blocks0,cnt=Count0}=St) -> + Ls = beam_ssa:rpo(Blocks0), + {Blocks,Count} = sanitize(Ls, Count0, Blocks0, #{}), + St#st{ssa=Blocks,cnt=Count}. + +sanitize([L|Ls], Count0, Blocks0, Values0) -> + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks0), + case sanitize_is(Is0, Count0, Values0, false, []) of + no_change -> + sanitize(Ls, Count0, Blocks0, Values0); + {Is,Count,Values} -> + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks0#{L:=Blk}, + sanitize(Ls, Count, Blocks, Values) + end; +sanitize([], Count, Blocks0, Values) -> + Blocks = if + map_size(Values) =:= 0 -> + Blocks0; + true -> + beam_ssa:rename_vars(Values, [0], Blocks0) + end, + + %% Unreachable blocks can cause problems for the dominator calculations. + Ls = beam_ssa:rpo(Blocks), + Reachable = gb_sets:from_list(Ls), + {case map_size(Blocks) =:= gb_sets:size(Reachable) of + true -> Blocks; + false -> remove_unreachable(Ls, Blocks, Reachable, []) + end,Count}. + +sanitize_is([#b_set{op=get_map_element,args=Args0}=I0|Is], + Count0, Values, Changed, Acc) -> + case sanitize_args(Args0, Values) of + [#b_literal{}=Map,Key] -> + %% Bind the literal map to a variable. + {MapVar,Count} = new_var('@ssa_map', Count0), + I = I0#b_set{args=[MapVar,Key]}, + Copy = #b_set{op=copy,dst=MapVar,args=[Map]}, + sanitize_is(Is, Count, Values, true, [I,Copy|Acc]); + [_,_]=Args0 -> + sanitize_is(Is, Count0, Values, Changed, [I0|Acc]); + [_,_]=Args -> + I = I0#b_set{args=Args}, + sanitize_is(Is, Count0, Values, Changed, [I|Acc]) + end; +sanitize_is([#b_set{op=Op,dst=Dst,args=Args0}=I0|Is0], + Count, Values, Changed0, Acc) -> + Args = sanitize_args(Args0, Values), + case sanitize_instr(Op, Args, I0) of + {value,Value0} -> + Value = #b_literal{val=Value0}, + sanitize_is(Is0, Count, Values#{Dst=>Value}, true, Acc); + {ok,I} -> + sanitize_is(Is0, Count, Values, true, [I|Acc]); + ok -> + I = I0#b_set{args=Args}, + Changed = Changed0 orelse Args =/= Args0, + sanitize_is(Is0, Count, Values, Changed, [I|Acc]) + end; +sanitize_is([], Count, Values, Changed, Acc) -> + case Changed of + true -> + {reverse(Acc),Count,Values}; + false -> + no_change + end. + +sanitize_args(Args, Values) -> + map(fun(Var) -> + case Values of + #{Var:=New} -> New; + #{} -> Var + end + end, Args). + +sanitize_instr({bif,Bif}, [#b_literal{val=Lit}], _I) -> + case erl_bifs:is_pure(erlang, Bif, 1) of + false -> + ok; + true -> + try + {value,erlang:Bif(Lit)} + catch + error:_ -> + ok + end + end; +sanitize_instr({bif,Bif}, [#b_literal{val=Lit1},#b_literal{val=Lit2}], _I) -> + true = erl_bifs:is_pure(erlang, Bif, 2), %Assertion. + try + {value,erlang:Bif(Lit1, Lit2)} + catch + error:_ -> + ok + end; +sanitize_instr(get_hd, [#b_literal{val=[Hd|_]}], _I) -> + {value,Hd}; +sanitize_instr(get_tl, [#b_literal{val=[_|Tl]}], _I) -> + {value,Tl}; +sanitize_instr(get_tuple_element, [#b_literal{val=T}, + #b_literal{val=I}], _I) + when I < tuple_size(T) -> + {value,element(I+1, T)}; +sanitize_instr(is_nonempty_list, [#b_literal{val=Lit}], _I) -> + {value,case Lit of + [_|_] -> true; + _ -> false + end}; +sanitize_instr(is_tagged_tuple, [#b_literal{val=Tuple}, + #b_literal{val=Arity}, + #b_literal{val=Tag}], _I) + when is_integer(Arity), is_atom(Tag) -> + if + tuple_size(Tuple) =:= Arity, element(1, Tuple) =:= Tag -> + {value,true}; + true -> + {value,false} + end; +sanitize_instr(bs_init, [#b_literal{val=new},#b_literal{val=Sz}|_], I0) -> + if + is_integer(Sz), Sz >= 0 -> ok; + true -> {ok,sanitize_badarg(I0)} + end; +sanitize_instr(bs_init, [#b_literal{val=append},_,#b_literal{val=Sz}|_], I0) -> + if + is_integer(Sz), Sz >= 0 -> ok; + true -> {ok,sanitize_badarg(I0)} + end; +sanitize_instr(succeeded, [#b_literal{}], _I) -> + {value,true}; +sanitize_instr(_, _, _) -> ok. + +sanitize_badarg(I) -> + Func = #b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error},arity=1}, + I#b_set{op=call,args=[Func,#b_literal{val=badarg}]}. + +remove_unreachable([L|Ls], Blocks, Reachable, Acc) -> + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks), + case split_phis(Is0) of + {[_|_]=Phis,Rest} -> + Is = [prune_phi(Phi, Reachable) || Phi <- Phis] ++ Rest, + Blk = Blk0#b_blk{is=Is}, + remove_unreachable(Ls, Blocks, Reachable, [{L,Blk}|Acc]); + {[],_} -> + remove_unreachable(Ls, Blocks, Reachable, [{L,Blk0}|Acc]) + end; +remove_unreachable([], _Blocks, _, Acc) -> + maps:from_list(Acc). + +prune_phi(#b_set{args=Args0}=Phi, Reachable) -> + Args = [A || {_,Pred}=A <- Args0, + gb_sets:is_element(Pred, Reachable)], + Phi#b_set{args=Args}. + +%%% +%%% Fix tuples. +%%% + +%% fix_tuples(St0) -> St. +%% If compatibility with a previous version of Erlang has been +%% requested, tuple creation must be split into two instruction to +%% mirror the the way tuples are created in BEAM prior to OTP 22. +%% Each put_tuple instruction is split into put_tuple_arity followed +%% by put_tuple_elements. + +fix_tuples(#st{ssa=Blocks0,cnt=Count0}=St) -> + F = fun (#b_set{op=put_tuple,args=Args}=Put, C0) -> + Arity = #b_literal{val=length(Args)}, + {Ignore,C} = new_var('@ssa_ignore', C0), + {[Put#b_set{op=put_tuple_arity,args=[Arity]}, + #b_set{dst=Ignore,op=put_tuple_elements,args=Args}],C}; + (I, C) -> {[I],C} + end, + {Blocks,Count} = beam_ssa:flatmapfold_instrs_rpo(F, [0], Count0, Blocks0), + St#st{ssa=Blocks,cnt=Count}. + +%%% +%%% Introduce the set_tuple_element instructions to make +%%% multiple-field record updates faster. +%%% +%%% The expansion of record field updates, when more than one field is +%%% updated, but not a majority of the fields, will create a sequence of +%%% calls to `erlang:setelement(Index, Value, Tuple)` where Tuple in the +%%% first call is the original record tuple, and in the subsequent calls +%%% Tuple is the result of the previous call. Furthermore, all Index +%%% values are constant positive integers, and the first call to +%%% `setelement` will have the greatest index. Thus all the following +%%% calls do not actually need to test at run-time whether Tuple has type +%%% tuple, nor that the index is within the tuple bounds. +%%% +%%% Since this optimization introduces destructive updates, it used to +%%% be done as the very last Core Erlang pass before going to +%%% lower-level code. However, it turns out that this kind of destructive +%%% updates are awkward also in SSA code and can prevent or complicate +%%% type analysis and aggressive optimizations. +%%% +%%% NOTE: Because there no write barriers in the system, this kind of +%%% optimization can only be done when we are sure that garbage +%%% collection will not be triggered between the creation of the tuple +%%% and the destructive updates - otherwise we might insert pointers +%%% from an older generation to a newer. +%%% + +use_set_tuple_element(#st{ssa=Blocks0}=St) -> + Uses = count_uses(Blocks0), + RPO = reverse(beam_ssa:rpo(Blocks0)), + Blocks = use_ste_1(RPO, Uses, Blocks0), + St#st{ssa=Blocks}. + +use_ste_1([L|Ls], Uses, Blocks0) -> + {Blk0,Blocks} = use_ste_across(L, Uses, Blocks0), + #b_blk{is=Is0} = Blk0, + case use_ste_is(Is0, Uses) of + Is0 -> + use_ste_1(Ls, Uses, Blocks); + Is -> + Blk = Blk0#b_blk{is=Is}, + use_ste_1(Ls, Uses, Blocks#{L:=Blk}) + end; +use_ste_1([], _, Blocks) -> Blocks. + +%%% Optimize within a single block. + +use_ste_is([#b_set{}=I|Is0], Uses) -> + Is = use_ste_is(Is0, Uses), + case extract_ste(I) of + none -> + [I|Is]; + Extracted -> + use_ste_call(Extracted, I, Is, Uses) + end; +use_ste_is([], _Uses) -> []. + +use_ste_call({Dst0,Pos0,_Var0,_Val0}, Call1, Is0, Uses) -> + case get_ste_call(Is0, []) of + {Prefix,{Dst1,Pos1,Dst0,Val1},Call2,Is} + when Pos1 > 0, Pos0 > Pos1 -> + case is_single_use(Dst0, Uses) of + true -> + Call = Call1#b_set{dst=Dst1}, + Args = [Val1,Dst1,#b_literal{val=Pos1-1}], + Dsetel = Call2#b_set{op=set_tuple_element, + dst=Dst0, + args=Args}, + [Call|Prefix] ++ [Dsetel|Is]; + false -> + [Call1|Is0] + end; + _ -> + [Call1|Is0] + end. + +get_ste_call([#b_set{op=get_tuple_element}=I|Is], Acc) -> + get_ste_call(Is, [I|Acc]); +get_ste_call([#b_set{op=call}=I|Is], Acc) -> + case extract_ste(I) of + none -> + none; + Extracted -> + {reverse(Acc),Extracted,I,Is} + end; +get_ste_call(_, _) -> none. + +extract_ste(#b_set{op=call,dst=Dst, + args=[#b_remote{mod=#b_literal{val=M}, + name=#b_literal{val=F}}|Args]}) -> + case {M,F,Args} of + {erlang,setelement,[#b_literal{val=Pos},Tuple,Val]} -> + {Dst,Pos,Tuple,Val}; + {_,_,_} -> + none + end; +extract_ste(#b_set{}) -> none. + +%%% Optimize accross blocks within a try/catch block. + +use_ste_across(L, Uses, Blocks) -> + case map_get(L, Blocks) of + #b_blk{last=#b_br{bool=#b_var{}}}=Blk -> + try + use_ste_across_1(L, Blk, Uses, Blocks) + catch + throw:not_possible -> + {Blk,Blocks} + end; + #b_blk{}=Blk -> + {Blk,Blocks} + end. + +use_ste_across_1(L, Blk0, Uses, Blocks0) -> + #b_blk{is=IsThis,last=#b_br{bool=Bool,succ=Next}} = Blk0, + case reverse(IsThis) of + [#b_set{op=succeeded,dst=Bool,args=[Result]}=Succ0, + #b_set{op=call,args=[#b_remote{}|_],dst=Result}=Call1|Prefix] -> + case is_single_use(Bool, Uses) andalso + is_n_uses(2, Result, Uses) of + true -> ok; + false -> throw(not_possible) + end, + Call2 = use_ste_across_next(Next, Uses, Blocks0), + Is = [Call1,Call2], + case use_ste_is(Is, decrement_uses(Result, Uses)) of + [#b_set{}=Call,#b_set{op=set_tuple_element}=Ste] -> + Blocks1 = use_ste_fix_next(Ste, Next, Blocks0), + Succ = Succ0#b_set{args=[Call#b_set.dst]}, + Blk = Blk0#b_blk{is=reverse(Prefix, [Call,Succ])}, + Blocks = Blocks1#{L:=Blk}, + {Blk,Blocks}; + _ -> + throw(not_possible) + end; + _ -> + throw(not_possible) + end. + +use_ste_across_next(Next, Uses, Blocks) -> + case map_get(Next, Blocks) of + #b_blk{is=[#b_set{op=call,dst=Result,args=[#b_remote{}|_]}=Call, + #b_set{op=succeeded,dst=Bool,args=[Result]}], + last=#b_br{bool=Bool}} -> + case is_single_use(Bool, Uses) andalso + is_n_uses(2, Result, Uses) of + true -> ok; + false -> throw(not_possible) + end, + Call; + #b_blk{} -> + throw(not_possible) + end. + +use_ste_fix_next(Ste, Next, Blocks) -> + Blk0 = map_get(Next, Blocks), + #b_blk{is=[#b_set{op=call},#b_set{op=succeeded}],last=Br0} = Blk0, + Br = beam_ssa:normalize(Br0#b_br{bool=#b_literal{val=true}}), + Blk = Blk0#b_blk{is=[Ste],last=Br}, + Blocks#{Next:=Blk}. + +%% Count how many times each variable is used. + +count_uses(Blocks) -> + count_uses_blk(maps:values(Blocks), #{}). + +count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> + F = fun(I, CountMap) -> + foldl(fun(Var, Acc) -> + case Acc of + #{Var:=3} -> Acc; + #{Var:=C} -> Acc#{Var:=C+1}; + #{} -> Acc#{Var=>1} + end + end, CountMap, beam_ssa:used(I)) + end, + CountMap = F(Last, foldl(F, CountMap0, Is)), + count_uses_blk(Bs, CountMap); +count_uses_blk([], CountMap) -> CountMap. + +decrement_uses(V, Uses) -> + #{V:=C} = Uses, + Uses#{V:=C-1}. + +is_n_uses(N, V, Uses) -> + case Uses of + #{V:=N} -> true; + #{} -> false + end. + +is_single_use(V, Uses) -> + case Uses of + #{V:=1} -> true; + #{} -> false + end. + +%%% +%%% Find out where frames should be placed. +%%% + +%% place_frames(St0) -> St. +%% Return a list of the labels for the blocks that need stack frame +%% allocation instructions. +%% +%% This function attempts to place stack frames as tight as possible +%% around the code, to avoid building stack frames for code paths +%% that don't need one. +%% +%% Stack frames are placed in blocks that dominate all of their +%% descendants. That guarantees that the deallocation instructions +%% cannot be reached from other execution paths that didn't set up +%% a stack frame or set up a stack frame with a different size. + +place_frames(#st{ssa=Blocks}=St) -> + {Doms,_} = beam_ssa:dominators(Blocks), + Ls = beam_ssa:rpo(Blocks), + Tried = gb_sets:empty(), + Frames0 = [], + {Frames,_} = place_frames_1(Ls, Blocks, Doms, Tried, Frames0), + St#st{frames=Frames}. + +place_frames_1([L|Ls], Blocks, Doms, Tried0, Frames0) -> + Blk = map_get(L, Blocks), + case need_frame(Blk) of + true -> + %% This block needs a frame. Try to place it here. + {Frames,Tried} = do_place_frame(L, Blocks, Doms, Tried0, Frames0), + + %% Successfully placed. Try to place more frames in descendants + %% that are not dominated by this block. + place_frames_1(Ls, Blocks, Doms, Tried, Frames); + false -> + try + place_frames_1(Ls, Blocks, Doms, Tried0, Frames0) + catch + throw:{need_frame,For,Tried1}=Reason -> + %% An descendant block needs a stack frame. Try to + %% place it here. + case is_dominated_by(For, L, Doms) of + true -> + %% Try to place a frame here. + {Frames,Tried} = do_place_frame(L, Blocks, Doms, + Tried1, Frames0), + place_frames_1(Ls, Blocks, Doms, Tried, Frames); + false -> + %% Wrong place. This block does not dominate + %% the block that needs the frame. Pass it on + %% to our ancestors. + throw(Reason) + end + end + end; +place_frames_1([], _, _, Tried, Frames) -> + {Frames,Tried}. + +%% do_place_frame(Label, Blocks, Dominators, Tried0, Frames0) -> {Frames,Tried}. +%% Try to place a frame in this block. This function returns +%% successfully if it either succeds at placing a frame in this +%% block, if an ancestor that dominates this block has already placed +%% a frame, or if we have already tried to put a frame in this block. +%% +%% An {need_frame,Label,Tried} exception will be thrown if this block +%% block is not suitable for having a stack frame (i.e. it does not dominate +%% all of its descendants). The exception means that an ancestor will have to +%% place the frame needed by this block. + +do_place_frame(L, Blocks, Doms, Tried0, Frames) -> + case gb_sets:is_element(L, Tried0) of + true -> + %% We have already tried to put a frame in this block. + {Frames,Tried0}; + false -> + %% Try to place a frame in this block. + Tried = gb_sets:insert(L, Tried0), + case place_frame_here(L, Blocks, Doms, Frames) of + yes -> + %% We need a frame and it is safe to place it here. + {[L|Frames],Tried}; + no -> + %% An ancestor has a frame. Not needed. + {Frames,Tried}; + ancestor -> + %% This block does not dominate all of its + %% descendants. We must place the frame in + %% an ancestor. + throw({need_frame,L,Tried}) + end + end. + +%% place_frame_here(Label, Blocks, Doms, Frames) -> no|yes|ancestor. +%% Determine whether a frame should be placed in block Label. + +place_frame_here(L, Blocks, Doms, Frames) -> + B0 = any(fun(DomBy) -> + is_dominated_by(L, DomBy, Doms) + end, Frames), + case B0 of + true -> + %% This block is dominated by an ancestor block that + %% defines a frame. Not needed/allowed to put a frame + %% here. + no; + false -> + %% No frame in any ancestor. We need a frame. + %% Now check whether the frame can be placed here. + %% If this block dominates all of its descendants + %% and the predecessors of any phi nodes it can be + %% placed here. + Descendants = beam_ssa:rpo([L], Blocks), + PhiPredecessors = phi_predecessors(L, Blocks), + MustDominate = ordsets:from_list(PhiPredecessors ++ Descendants), + Dominates = all(fun(?BADARG_BLOCK) -> + %% This block defines no variables and calls + %% erlang:error(badarg). It does not matter + %% whether L dominates ?BADARG_BLOCK or not; + %% it is still safe to put the frame in L. + true; + (Bl) -> + is_dominated_by(Bl, L, Doms) + end, MustDominate), + + %% Also, this block must not be a loop header. + IsLoopHeader = is_loop_header(L, Blocks), + case Dominates andalso not IsLoopHeader of + true -> yes; + false -> ancestor + end + end. + +%% phi_predecessors(Label, Blocks) -> +%% Return all predecessors referenced in phi nodes. + +phi_predecessors(L, Blocks) -> + #b_blk{is=Is} = map_get(L, Blocks), + [P || #b_set{op=phi,args=Args} <- Is, {_,P} <- Args]. + +%% is_dominated_by(Label, DominatedBy, Dominators) -> true|false. +%% Test whether block Label is dominated by block DominatedBy. + +is_dominated_by(L, DomBy, Doms) -> + DominatedBy = map_get(L, Doms), + member(DomBy, DominatedBy). + +%% need_frame(#b_blk{}) -> true|false. +%% Test whether any of the instructions in the block requires a stack frame. + +need_frame(#b_blk{is=Is,last=#b_ret{arg=Ret}}) -> + need_frame_1(Is, {return,Ret}); +need_frame(#b_blk{is=Is}) -> + need_frame_1(Is, body). + +need_frame_1([#b_set{op=make_fun,dst=Fun}|Is], {return,_}=Context) -> + %% Since make_fun clobbers X registers, a stack frame is needed if + %% any of the following instructions use any other variable than + %% the one holding the reference to the created fun. + need_frame_1(Is, Context) orelse + case beam_ssa:used(#b_blk{is=Is,last=#b_ret{arg=Fun}}) of + [Fun] -> false; + [_|_] -> true + end; +need_frame_1([#b_set{op=new_try_tag}|_], _) -> + true; +need_frame_1([#b_set{op=call,dst=Val}]=Is, {return,Ret}) -> + if + Val =:= Ret -> need_frame_1(Is, tail); + true -> need_frame_1(Is, body) + end; +need_frame_1([#b_set{op=call,args=[Func|_]}|Is], Context) -> + case Func of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}, + arity=Arity} when is_atom(Mod), is_atom(Name) -> + case erl_bifs:is_exit_bif(Mod, Name, Arity) of + true -> + false; + false -> + Context =:= body orelse + Is =/= [] orelse + is_trap_bif(Mod, Name, Arity) + end; + #b_remote{} -> + %% This is an apply(), which always needs a frame. + true; + #b_local{} -> + Context =:= body orelse Is =/= []; + _ -> + %% A fun call always needs a frame. + true + end; +need_frame_1([I|Is], Context) -> + beam_ssa:clobbers_xregs(I) orelse need_frame_1(Is, Context); +need_frame_1([], _) -> false. + +%% is_trap_bif(Mod, Name, Arity) -> true|false. +%% Test whether we need a stack frame for this BIF. + +is_trap_bif(erlang, '!', 2) -> true; +is_trap_bif(erlang, link, 1) -> true; +is_trap_bif(erlang, unlink, 1) -> true; +is_trap_bif(erlang, monitor_node, 2) -> true; +is_trap_bif(erlang, group_leader, 2) -> true; +is_trap_bif(erlang, exit, 2) -> true; +is_trap_bif(_, _, _) -> false. + +%%% +%%% Fix variables used in matching in receive. +%%% +%%% The loop_rec/2 instruction may return a reference to a +%%% message outside of any heap or heap fragment. If the message +%%% does not match, it is not allowed to store any reference to +%%% the message (or part of the message) on the stack. If we do, +%%% the message will be corrupted if there happens to be a GC. +%%% +%%% Here we make sure to introduce copies of variables that are +%%% matched out and subsequently used after the remove_message/0 +%%% instructions. That will make sure that only X registers are +%%% used during matching. +%%% +%%% Depending on where variables are defined and used, they must +%%% be handled in two different ways. +%%% +%%% Variables that are always defined in the receive (before branching +%%% out into the different clauses of the receive) and used after the +%%% receive must be handled in the following way: Before each +%%% remove_message instruction, each such variable must be copied, and +%%% all variables must be consolidated using a phi node in the +%%% common exit block for the receive. +%%% +%%% Variables that are matched out and used in the same clause +%%% need copy instructions before the remove_message instruction +%%% in that clause. +%%% + +fix_receives(#st{ssa=Blocks0,cnt=Count0}=St) -> + {Blocks,Count} = fix_receives_1(maps:to_list(Blocks0), + Blocks0, Count0), + St#st{ssa=Blocks,cnt=Count}. + +fix_receives_1([{L,Blk}|Ls], Blocks0, Count0) -> + case Blk of + #b_blk{is=[#b_set{op=peek_message}|_]} -> + Rm = find_rm_blocks(L, Blocks0), + LoopExit = find_loop_exit(Rm, Blocks0), + Defs0 = beam_ssa:def([L], Blocks0), + CommonUsed = recv_common(Defs0, LoopExit, Blocks0), + {Blocks1,Count1} = recv_crit_edges(Rm, LoopExit, Blocks0, Count0), + {Blocks2,Count2} = recv_fix_common(CommonUsed, LoopExit, Rm, + Blocks1, Count1), + Defs = ordsets:subtract(Defs0, CommonUsed), + {Blocks,Count} = fix_receive(Rm, Defs, Blocks2, Count2), + fix_receives_1(Ls, Blocks, Count); + #b_blk{} -> + fix_receives_1(Ls, Blocks0, Count0) + end; +fix_receives_1([], Blocks, Count) -> + {Blocks,Count}. + +recv_common(_Defs, none, _Blocks) -> + %% There is no common exit block because receive is used + %% in the tail position of a function. + []; +recv_common(Defs, Exit, Blocks) -> + {ExitDefs,ExitUsed} = beam_ssa:def_used([Exit], Blocks), + Def = ordsets:subtract(Defs, ExitDefs), + ordsets:intersection(Def, ExitUsed). + +%% recv_crit_edges([RemoveMessageLabel], LoopExit, +%% Blocks0, Count0) -> {Blocks,Count}. +%% +%% Adds dummy blocks on all conditional jumps to the exit block so that +%% recv_fix_common/5 can insert phi nodes without having to worry about +%% critical edges. + +recv_crit_edges(_Rms, none, Blocks0, Count0) -> + {Blocks0, Count0}; +recv_crit_edges(Rms, Exit, Blocks0, Count0) -> + Ls = beam_ssa:rpo(Rms, Blocks0), + rce_insert_edges(Ls, Exit, Count0, Blocks0). + +rce_insert_edges([L | Ls], Exit, Count0, Blocks0) -> + Successors = beam_ssa:successors(map_get(L, Blocks0)), + case member(Exit, Successors) of + true when Successors =/= [Exit] -> + {Blocks, Count} = rce_insert_edge(L, Exit, Count0, Blocks0), + rce_insert_edges(Ls, Exit, Count, Blocks); + _ -> + rce_insert_edges(Ls, Exit, Count0, Blocks0) + end; +rce_insert_edges([], _Exit, Count, Blocks) -> + {Blocks, Count}. + +rce_insert_edge(L, Exit, Count, Blocks0) -> + #b_blk{last=Last0} = FromBlk0 = map_get(L, Blocks0), + + ToExit = #b_br{bool=#b_literal{val=true},succ=Exit,fail=Exit}, + + FromBlk = FromBlk0#b_blk{last=rce_reroute_terminator(Last0, Exit, Count)}, + EdgeBlk = #b_blk{anno=#{},is=[],last=ToExit}, + + Blocks = Blocks0#{ Count => EdgeBlk, L => FromBlk }, + {Blocks, Count + 1}. + +rce_reroute_terminator(#b_br{succ=Exit}=Last, Exit, New) -> + rce_reroute_terminator(Last#b_br{succ=New}, Exit, New); +rce_reroute_terminator(#b_br{fail=Exit}=Last, Exit, New) -> + rce_reroute_terminator(Last#b_br{fail=New}, Exit, New); +rce_reroute_terminator(#b_br{}=Last, _Exit, _New) -> + Last; +rce_reroute_terminator(#b_switch{fail=Exit}=Last, Exit, New) -> + rce_reroute_terminator(Last#b_switch{fail=New}, Exit, New); +rce_reroute_terminator(#b_switch{list=List0}=Last, Exit, New) -> + List = [if + Lbl =:= Exit -> {Arg, New}; + Lbl =/= Exit -> {Arg, Lbl} + end || {Arg, Lbl} <- List0], + Last#b_switch{list=List}. + +%% recv_fix_common([CommonVar], LoopExit, [RemoveMessageLabel], +%% Blocks0, Count0) -> {Blocks,Count}. +%% Handle variables alwys defined in a receive and used +%% in the exit block following the receive. + +recv_fix_common([Msg0|T], Exit, Rm, Blocks0, Count0) -> + {Msg,Count1} = new_var('@recv', Count0), + Blocks1 = beam_ssa:rename_vars(#{Msg0=>Msg}, [Exit], Blocks0), + N = length(Rm), + {MsgVars,Count} = new_vars(duplicate(N, '@recv'), Count1), + PhiArgs = fix_exit_phi_args(MsgVars, Rm, Exit, Blocks1), + Phi = #b_set{op=phi,dst=Msg,args=PhiArgs}, + ExitBlk0 = map_get(Exit, Blocks1), + ExitBlk = ExitBlk0#b_blk{is=[Phi|ExitBlk0#b_blk.is]}, + Blocks2 = Blocks1#{Exit:=ExitBlk}, + Blocks = recv_fix_common_1(MsgVars, Rm, Msg0, Blocks2), + recv_fix_common(T, Exit, Rm, Blocks, Count); +recv_fix_common([], _, _, Blocks, Count) -> + {Blocks,Count}. + +recv_fix_common_1([V|Vs], [Rm|Rms], Msg, Blocks0) -> + Ren = #{Msg=>V}, + Blocks1 = beam_ssa:rename_vars(Ren, [Rm], Blocks0), + #b_blk{is=Is0} = Blk0 = map_get(Rm, Blocks1), + Copy = #b_set{op=copy,dst=V,args=[Msg]}, + Is = insert_after_phis(Is0, [Copy]), + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks1#{Rm:=Blk}, + recv_fix_common_1(Vs, Rms, Msg, Blocks); +recv_fix_common_1([], [], _Msg, Blocks) -> Blocks. + +fix_exit_phi_args([V|Vs], [Rm|Rms], Exit, Blocks) -> + Path = beam_ssa:rpo([Rm], Blocks), + Preds = exit_predecessors(Path, Exit, Blocks), + [{V,Pred} || Pred <- Preds] ++ fix_exit_phi_args(Vs, Rms, Exit, Blocks); +fix_exit_phi_args([], [], _, _) -> []. + +exit_predecessors([L|Ls], Exit, Blocks) -> + Blk = map_get(L, Blocks), + case member(Exit, beam_ssa:successors(Blk)) of + true -> + [L|exit_predecessors(Ls, Exit, Blocks)]; + false -> + exit_predecessors(Ls, Exit, Blocks) + end; +exit_predecessors([], _Exit, _Blocks) -> []. + +%% fix_receive([Label], Defs, Blocks0, Count0) -> {Blocks,Count}. +%% Add a copy instruction for all variables that are matched out and +%% later used within a clause of the receive. + +fix_receive([L|Ls], Defs, Blocks0, Count0) -> + {RmDefs,Used0} = beam_ssa:def_used([L], Blocks0), + Def = ordsets:subtract(Defs, RmDefs), + Used = ordsets:intersection(Def, Used0), + {NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Used], Count0), + Ren = zip(Used, NewVars), + Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), + #b_blk{is=Is0} = Blk1 = map_get(L, Blocks1), + CopyIs = [#b_set{op=copy,dst=New,args=[Old]} || {Old,New} <- Ren], + Is = insert_after_phis(Is0, CopyIs), + Blk = Blk1#b_blk{is=Is}, + Blocks = Blocks1#{L:=Blk}, + fix_receive(Ls, Defs, Blocks, Count); +fix_receive([], _Defs, Blocks, Count) -> + {Blocks,Count}. + +%% find_loop_exit([Label], Blocks) -> Label | none. +%% Given the list of all blocks with the remove_message instructions +%% for this receive, find the block to which control is transferred +%% when the receive loop is exited (if any). + +find_loop_exit([_,_|_]=RmBlocks, Blocks) -> + %% We used to only analyze the path from two of the remove_message + %% blocks. That would fail to find a common block if one or both + %% of the blocks happened to raise an exception. To be sure that + %% we always find a common block if there is one (shared by at + %% least two clauses), we must analyze the path from all + %% remove_message blocks. + {Dominators,_} = beam_ssa:dominators(Blocks), + RmSet = cerl_sets:from_list(RmBlocks), + Rpo = beam_ssa:rpo(RmBlocks, Blocks), + find_loop_exit_1(Rpo, RmSet, Dominators); +find_loop_exit(_, _) -> + %% There is (at most) a single clause. There is no common + %% loop exit block. + none. + +find_loop_exit_1([?BADARG_BLOCK|Ls], RmSet, Dominators) -> + %% ?BADARG_BLOCK is a marker and not an actual block, so it is not + %% the block we are looking for. + find_loop_exit_1(Ls, RmSet, Dominators); +find_loop_exit_1([L|Ls], RmSet, Dominators) -> + DomBy = map_get(L, Dominators), + case any(fun(E) -> cerl_sets:is_element(E, RmSet) end, DomBy) of + true -> + %% This block is dominated by one of the remove_message blocks, + %% which means that the block is part of only one clause. + %% It is not the block we are looking for. + find_loop_exit_1(Ls, RmSet, Dominators); + false -> + %% This block is the first block that is not dominated by + %% any of the blocks with remove_message instructions, + %% which means that at least two of the receive clauses + %% will ultimately transfer control to it. It is the block + %% we are looking for. + L + end; +find_loop_exit_1([], _, _) -> + %% None of clauses transfers control to a common block after the receive + %% statement. That means that the receive statement is a the end of a + %% function (or that all clauses raise exceptions). + none. + +%% find_rm_blocks(StartLabel, Blocks) -> [Label]. +%% Find all blocks that start with remove_message within the receive +%% loop whose peek_message label is StartLabel. + +find_rm_blocks(L, Blocks) -> + Seen = gb_sets:singleton(L), + Blk = map_get(L, Blocks), + Succ = beam_ssa:successors(Blk), + find_rm_blocks_1(Succ, Seen, Blocks). + +find_rm_blocks_1([L|Ls], Seen0, Blocks) -> + case gb_sets:is_member(L, Seen0) of + true -> + find_rm_blocks_1(Ls, Seen0, Blocks); + false -> + Seen = gb_sets:insert(L, Seen0), + Blk = map_get(L, Blocks), + case find_rm_act(Blk#b_blk.is) of + prune -> + %% Looping back. Don't look at any successors. + find_rm_blocks_1(Ls, Seen, Blocks); + continue -> + %% Neutral block. Do nothing here, but look at + %% all successors. + Succ = beam_ssa:successors(Blk), + find_rm_blocks_1(Succ++Ls, Seen, Blocks); + found -> + %% Found remove_message instruction. + [L|find_rm_blocks_1(Ls, Seen, Blocks)] + end + end; +find_rm_blocks_1([], _, _) -> []. + +find_rm_act([#b_set{op=Op}|Is]) -> + case Op of + remove_message -> found; + peek_message -> prune; + recv_next -> prune; + wait_timeout -> prune; + wait -> prune; + _ -> find_rm_act(Is) + end; +find_rm_act([]) -> + continue. + +%%% +%%% Find out which variables need to be stored in Y registers. +%%% + +-record(dk, {d :: ordsets:ordset(var_name()), + k :: ordsets:ordset(var_name()) + }). + +%% find_yregs(St0) -> St. +%% Find all variables that must be stored in Y registers. Annotate +%% the blocks that allocate frames with the set of Y registers +%% used within that stack frame. +%% +%% Basically, we following all execution paths starting from a block +%% that allocates a frame, keeping track of of all defined registers +%% and all registers killed by an instruction that clobbers X +%% registers. For every use of a variable, we check if if it is in +%% the set of killed variables; if it is, it must be stored in an Y +%% register. + +find_yregs(#st{frames=[]}=St) -> + St; +find_yregs(#st{frames=[_|_]=Frames,args=Args,ssa=Blocks0}=St) -> + FrameDefs = find_defs(Frames, Blocks0, [V || #b_var{}=V <- Args]), + Blocks = find_yregs_1(FrameDefs, Blocks0), + St#st{ssa=Blocks}. + +find_yregs_1([{F,Defs}|Fs], Blocks0) -> + DK = #dk{d=Defs,k=[]}, + D0 = #{F=>DK}, + Ls = beam_ssa:rpo([F], Blocks0), + Yregs0 = [], + Yregs = find_yregs_2(Ls, Blocks0, D0, Yregs0), + Blk0 = map_get(F, Blocks0), + Blk = beam_ssa:add_anno(yregs, Yregs, Blk0), + Blocks = Blocks0#{F:=Blk}, + find_yregs_1(Fs, Blocks); +find_yregs_1([], Blocks) -> Blocks. + +find_yregs_2([L|Ls], Blocks0, D0, Yregs0) -> + Blk0 = map_get(L, Blocks0), + #b_blk{is=Is,last=Last} = Blk0, + Ys0 = map_get(L, D0), + {Yregs1,Ys} = find_yregs_is(Is, Ys0, Yregs0), + Yregs = find_yregs_terminator(Last, Ys, Yregs1), + Successors = beam_ssa:successors(Blk0), + D = find_update_succ(Successors, Ys, D0), + find_yregs_2(Ls, Blocks0, D, Yregs); +find_yregs_2([], _Blocks, _D, Yregs) -> Yregs. + +find_defs(Frames, Blocks, Defs) -> + Seen = gb_sets:empty(), + FramesSet = gb_sets:from_list(Frames), + {FrameDefs,_} = find_defs_1([0], Blocks, FramesSet, Seen, Defs, []), + FrameDefs. + +find_defs_1([L|Ls], Blocks, Frames, Seen0, Defs0, Acc0) -> + case gb_sets:is_member(L, Frames) of + true -> + OrderedDefs = ordsets:from_list(Defs0), + find_defs_1(Ls, Blocks, Frames, Seen0, Defs0, + [{L,OrderedDefs}|Acc0]); + false -> + case gb_sets:is_member(L, Seen0) of + true -> + find_defs_1(Ls, Blocks, Frames, Seen0, Defs0, Acc0); + false -> + Seen1 = gb_sets:insert(L, Seen0), + {Acc,Seen} = find_defs_1(Ls, Blocks, Frames, Seen1, Defs0, Acc0), + #b_blk{is=Is} = Blk = map_get(L, Blocks), + Defs = find_defs_is(Is, Defs0), + Successors = beam_ssa:successors(Blk), + find_defs_1(Successors, Blocks, Frames, Seen, Defs, Acc) + end + end; +find_defs_1([], _, _, Seen, _, Acc) -> + {Acc,Seen}. + +find_defs_is([#b_set{dst=Dst}|Is], Acc) -> + find_defs_is(Is, [Dst|Acc]); +find_defs_is([], Acc) -> Acc. + +find_update_succ([S|Ss], #dk{d=Defs0,k=Killed0}=DK0, D0) -> + case D0 of + #{S:=#dk{d=Defs1,k=Killed1}} -> + Defs = ordsets:intersection(Defs0, Defs1), + Killed = ordsets:union(Killed0, Killed1), + DK = #dk{d=Defs,k=Killed}, + D = D0#{S:=DK}, + find_update_succ(Ss, DK0, D); + #{} -> + D = D0#{S=>DK0}, + find_update_succ(Ss, DK0, D) + end; +find_update_succ([], _, D) -> D. + +find_yregs_is([#b_set{dst=Dst}=I|Is], #dk{d=Defs0,k=Killed0}=Ys, Yregs0) -> + Used = beam_ssa:used(I), + Yregs1 = ordsets:intersection(Used, Killed0), + Yregs = ordsets:union(Yregs0, Yregs1), + case beam_ssa:clobbers_xregs(I) of + false -> + Defs = ordsets:add_element(Dst, Defs0), + find_yregs_is(Is, Ys#dk{d=Defs}, Yregs); + true -> + Killed = ordsets:union(Defs0, Killed0), + Defs = [Dst], + find_yregs_is(Is, Ys#dk{d=Defs,k=Killed}, Yregs) + end; +find_yregs_is([], Ys, Yregs) -> {Yregs,Ys}. + +find_yregs_terminator(Terminator, #dk{k=Killed}, Yregs0) -> + Used = beam_ssa:used(Terminator), + Yregs = ordsets:intersection(Used, Killed), + ordsets:union(Yregs0, Yregs). + +%%% +%%% Try to reduce the size of the stack frame, by adding an explicit +%%% 'copy' instructions for return values from 'call' and 'make_fun' that +%%% need to be saved in Y registers. Here is an example to show +%%% how that's useful. First, here is the Erlang code: +%%% +%%% f(Pid) -> +%%% Res = foo(42), +%%% _ = node(Pid), +%%% bar(), +%%% Res. +%%% +%%% Compiled to SSA format, the main part of the code looks like this: +%%% +%%% 0: +%%% Res = call local literal foo/1, literal 42 +%%% _1 = bif:node Pid +%%% @ssa_bool = succeeded _1 +%%% br @ssa_bool, label 3, label 1 +%%% 3: +%%% @ssa_ignored = call local literal bar/0 +%%% ret Res +%%% +%%% It can be seen that the variables Pid and Res must be saved in Y +%%% registers in order to survive the function calls. A previous sub +%%% pass has inserted a 'copy' instruction to save the value of the +%%% variable Pid: +%%% +%%% 0: +%%% Pid:4 = copy Pid +%%% Res = call local literal foo/1, literal 42 +%%% _1 = bif:node Pid:4 +%%% @ssa_bool = succeeded _1 +%%% br @ssa_bool, label 3, label 1 +%%% +%%% 3: +%%% @ssa_ignored = call local literal bar/0 +%%% ret Res +%%% +%%% The Res and Pid:4 variables must be assigned to different Y registers +%%% because they are live at the same time. copy_retval() inserts a +%%% 'copy' instruction to copy Res to a new variable: +%%% +%%% 0: +%%% Pid:4 = copy Pid +%%% Res:6 = call local literal foo/1, literal 42 +%%% _1 = bif:node Pid:4 +%%% @ssa_bool = succeeded _1 +%%% br @ssa_bool, label 3, label 1 +%%% +%%% 3: +%%% Res = copy Res:6 +%%% @ssa_ignored = call local literal bar/0 +%%% ret Res +%%% +%%% The new variable Res:6 is used to capture the return value from the call. +%%% The variables Pid:4 and Res are no longer live at the same time, so they +%%% can be assigned to the same Y register. +%%% + +copy_retval(#st{frames=Frames,ssa=Blocks0,cnt=Count0}=St) -> + {Blocks,Count} = copy_retval_1(Frames, Blocks0, Count0), + St#st{ssa=Blocks,cnt=Count}. + +copy_retval_1([F|Fs], Blocks0, Count0) -> + #b_blk{anno=#{yregs:=Yregs0},is=Is} = map_get(F, Blocks0), + Yregs1 = gb_sets:from_list(Yregs0), + Yregs = collect_yregs(Is, Yregs1), + Ls = beam_ssa:rpo([F], Blocks0), + {Blocks,Count} = copy_retval_2(Ls, Yregs, none, Blocks0, Count0), + copy_retval_1(Fs, Blocks, Count); +copy_retval_1([], Blocks, Count) -> + {Blocks,Count}. + +collect_yregs([#b_set{op=copy,dst=Y,args=[#b_var{}=X]}|Is], + Yregs0) -> + true = gb_sets:is_member(X, Yregs0), %Assertion. + Yregs = gb_sets:insert(Y, gb_sets:delete(X, Yregs0)), + collect_yregs(Is, Yregs); +collect_yregs([#b_set{}|Is], Yregs) -> + collect_yregs(Is, Yregs); +collect_yregs([], Yregs) -> Yregs. + +copy_retval_2([L|Ls], Yregs, Copy0, Blocks0, Count0) -> + #b_blk{is=Is0,last=Last} = Blk = map_get(L, Blocks0), + RC = case {Last,Ls} of + {#b_br{succ=Succ,fail=?BADARG_BLOCK},[Succ|_]} -> + true; + {_,_} -> + false + end, + case copy_retval_is(Is0, RC, Yregs, Copy0, Count0, []) of + {Is,Count} -> + case Copy0 =:= none andalso Count0 =:= Count of + true -> + copy_retval_2(Ls, Yregs, none, Blocks0, Count0); + false -> + Blocks = Blocks0#{L=>Blk#b_blk{is=Is}}, + copy_retval_2(Ls, Yregs, none, Blocks, Count) + end; + {Is,Count,Copy} -> + Blocks = Blocks0#{L=>Blk#b_blk{is=Is}}, + copy_retval_2(Ls, Yregs, Copy, Blocks, Count) + end; +copy_retval_2([], _Yregs, none, Blocks, Count) -> + {Blocks,Count}. + +copy_retval_is([#b_set{op=put_tuple_elements,args=Args0}=I0], false, _Yregs, + Copy, Count, Acc) -> + I = I0#b_set{args=copy_sub_args(Args0, Copy)}, + {reverse(Acc, [I|acc_copy([], Copy)]),Count}; +copy_retval_is([#b_set{op=Op}=I0], false, Yregs, Copy, Count0, Acc0) + when Op =:= call; Op =:= make_fun -> + {I,Count,Acc} = place_retval_copy(I0, Yregs, Copy, Count0, Acc0), + {reverse(Acc, [I]),Count}; +copy_retval_is([#b_set{}]=Is, false, _Yregs, Copy, Count, Acc) -> + {reverse(Acc, acc_copy(Is, Copy)),Count}; +copy_retval_is([#b_set{},#b_set{op=succeeded}]=Is, false, _Yregs, Copy, Count, Acc) -> + {reverse(Acc, acc_copy(Is, Copy)),Count}; +copy_retval_is([#b_set{op=Op,dst=#b_var{name=RetName}=Dst}=I0|Is], RC, Yregs, + Copy0, Count0, Acc0) when Op =:= call; Op =:= make_fun -> + {I1,Count1,Acc} = place_retval_copy(I0, Yregs, Copy0, Count0, Acc0), + case gb_sets:is_member(Dst, Yregs) of + true -> + {NewVar,Count} = new_var(RetName, Count1), + Copy = #b_set{op=copy,dst=Dst,args=[NewVar]}, + I = I1#b_set{dst=NewVar}, + copy_retval_is(Is, RC, Yregs, Copy, Count, [I|Acc]); + false -> + copy_retval_is(Is, RC, Yregs, none, Count1, [I1|Acc]) + end; +copy_retval_is([#b_set{args=Args0}=I0|Is], RC, Yregs, Copy, Count, Acc) -> + I = I0#b_set{args=copy_sub_args(Args0, Copy)}, + case beam_ssa:clobbers_xregs(I) of + true -> + copy_retval_is(Is, RC, Yregs, none, Count, [I|acc_copy(Acc, Copy)]); + false -> + copy_retval_is(Is, RC, Yregs, Copy, Count, [I|Acc]) + end; +copy_retval_is([], RC, _, Copy, Count, Acc) -> + case {Copy,RC} of + {none,_} -> + {reverse(Acc),Count}; + {#b_set{},true} -> + {reverse(Acc),Count,Copy}; + {#b_set{},false} -> + {reverse(Acc, [Copy]),Count} + end. + +%% +%% Consider this code: +%% +%% Var = ... +%% ... +%% A1 = call foo/0 +%% A = copy A1 +%% B = call bar/1, Var +%% +%% If the Var variable is no longer used after this code, its Y register +%% can't be reused for A. To allow the Y register to be reused +%% we will need to insert 'copy' instructions for arguments that are +%% in Y registers: +%% +%% Var = ... +%% ... +%% A1 = call foo/0 +%% Var1 = copy Var +%% A = copy A1 +%% B = call bar/1, Var1 +%% + +place_retval_copy(I, _Yregs, none, Count, Acc) -> + {I,Count,Acc}; +place_retval_copy(#b_set{args=[F|Args0]}=I, Yregs, Copy, Count0, Acc0) -> + #b_set{dst=Avoid} = Copy, + {Args,Acc1,Count} = copy_func_args(Args0, Yregs, Avoid, Acc0, [], Count0), + Acc = [Copy|Acc1], + {I#b_set{args=[F|Args]},Count,Acc}. + +copy_func_args([#b_var{name=AName}=A|As], Yregs, Avoid, CopyAcc, Acc, Count0) -> + case gb_sets:is_member(A, Yregs) of + true when A =/= Avoid -> + {NewVar,Count} = new_var(AName, Count0), + Copy = #b_set{op=copy,dst=NewVar,args=[A]}, + copy_func_args(As, Yregs, Avoid, [Copy|CopyAcc], [NewVar|Acc], Count); + _ -> + copy_func_args(As, Yregs, Avoid, CopyAcc, [A|Acc], Count0) + end; +copy_func_args([A|As], Yregs, Avoid, CopyAcc, Acc, Count) -> + copy_func_args(As, Yregs, Avoid, CopyAcc, [A|Acc], Count); +copy_func_args([], _Yregs, _Avoid, CopyAcc, Acc, Count) -> + {reverse(Acc),CopyAcc,Count}. + +acc_copy(Acc, none) -> Acc; +acc_copy(Acc, #b_set{}=Copy) -> [Copy|Acc]. + +copy_sub_args(Args, none) -> + Args; +copy_sub_args(Args, #b_set{dst=Dst,args=[Src]}) -> + [sub_arg(A, Dst, Src) || A <- Args]. + +sub_arg(Old, Old, New) -> New; +sub_arg(Old, _, _) -> Old. + +%%% +%%% Consider: +%%% +%%% x1/Hd = get_hd x0/Cons +%%% y0/Tl = get_tl x0/Cons +%%% +%%% Register x0 can't be reused for Hd. If Hd needs to be in x0, +%%% a 'move' instruction must be inserted. +%%% +%%% If we swap get_hd and get_tl when Tl is in a Y register, +%%% x0 can be used for Hd if Cons is not used again: +%%% +%%% y0/Tl = get_tl x0/Cons +%%% x0/Hd = get_hd x0/Cons +%%% + +opt_get_list(#st{ssa=Blocks,res=Res}=St) -> + ResMap = maps:from_list(Res), + Ls = beam_ssa:rpo(Blocks), + St#st{ssa=opt_get_list_1(Ls, ResMap, Blocks)}. + +opt_get_list_1([L|Ls], Res, Blocks0) -> + #b_blk{is=Is0} = Blk = map_get(L, Blocks0), + case opt_get_list_is(Is0, Res, [], false) of + no -> + opt_get_list_1(Ls, Res, Blocks0); + {yes,Is} -> + Blocks = Blocks0#{L:=Blk#b_blk{is=Is}}, + opt_get_list_1(Ls, Res, Blocks) + end; +opt_get_list_1([], _, Blocks) -> Blocks. + +opt_get_list_is([#b_set{op=get_hd,dst=Hd, + args=[Cons]}=GetHd, + #b_set{op=get_tl,dst=Tl, + args=[Cons]}=GetTl|Is], + Res, Acc, Changed) -> + %% Note that when this pass is run, only Y registers have + %% reservations. The absence of an entry for a variable therefore + %% means that the variable will be in an X register. + case Res of + #{Hd:={y,_}} -> + %% Hd will be in a Y register. Don't swap. + opt_get_list_is([GetTl|Is], Res, [GetHd|Acc], Changed); + #{Tl:={y,_}} -> + %% Tl will be in a Y register. Swap. + opt_get_list_is([GetHd|Is], Res, [GetTl|Acc], true); + #{} -> + %% Both are in X registers. Nothing to do. + opt_get_list_is([GetTl|Is], Res, [GetHd|Acc], Changed) + end; +opt_get_list_is([I|Is], Res, Acc, Changed) -> + opt_get_list_is(Is, Res, [I|Acc], Changed); +opt_get_list_is([], _Res, Acc, Changed) -> + case Changed of + true -> + {yes,reverse(Acc)}; + false -> + no + end. + +%%% +%%% Number instructions in the order they are executed. +%%% + +%% number_instructions(St0) -> St. +%% Number instructions in the order they are executed. Use a step +%% size of 2. Don't number phi instructions. All phi variables in +%% a block will be live one unit before the first non-phi instruction +%% in the block. + +number_instructions(#st{ssa=Blocks0}=St) -> + Ls = beam_ssa:rpo(Blocks0), + St#st{ssa=number_is_1(Ls, 1, Blocks0)}. + +number_is_1([L|Ls], N0, Blocks0) -> + #b_blk{is=Is0,last=Last0} = Bl0 = map_get(L, Blocks0), + {Is,N1} = number_is_2(Is0, N0, []), + Last = beam_ssa:add_anno(n, N1, Last0), + N = N1 + 2, + Bl = Bl0#b_blk{is=Is,last=Last}, + Blocks = Blocks0#{L:=Bl}, + number_is_1(Ls, N, Blocks); +number_is_1([], _, Blocks) -> Blocks. + +number_is_2([#b_set{op=phi}=I|Is], N, Acc) -> + number_is_2(Is, N, [I|Acc]); +number_is_2([I0|Is], N, Acc) -> + I = beam_ssa:add_anno(n, N, I0), + number_is_2(Is, N+2, [I|Acc]); +number_is_2([], N, Acc) -> + {reverse(Acc),N}. + +%%% +%%% Calculate live intervals. +%%% + +live_intervals(#st{args=Args,ssa=Blocks}=St) -> + Vars0 = [{V,{0,1}} || #b_var{}=V <- Args], + F = fun(L, _, A) -> live_interval_blk(L, Blocks, A) end, + LiveMap0 = #{}, + Acc0 = {[],LiveMap0}, + {Vars,_} = beam_ssa:fold_po(F, Acc0, Blocks), + Intervals = merge_ranges(rel2fam(Vars0++Vars)), + St#st{intervals=Intervals}. + +merge_ranges([{V,Rs}|T]) -> + [{V,merge_ranges_1(Rs)}|merge_ranges(T)]; +merge_ranges([]) -> []. + +merge_ranges_1([{A,N},{N,Z}|Rs]) -> + merge_ranges_1([{A,Z}|Rs]); +merge_ranges_1([R|Rs]) -> + [R|merge_ranges_1(Rs)]; +merge_ranges_1([]) -> []. + +live_interval_blk(L, Blocks, {Vars0,LiveMap0}) -> + Live0 = [], + Successors = beam_ssa:successors(L, Blocks), + Live1 = update_successors(Successors, L, Blocks, LiveMap0, Live0), + + %% Add ranges for all variables that are live in the successors. + #b_blk{is=Is,last=Last} = map_get(L, Blocks), + End = beam_ssa:get_anno(n, Last), + Use = [{V,{use,End+1}} || V <- Live1], + + %% Determine used and defined variables in this block. + FirstNumber = first_number(Is, Last), + UseDef0 = live_interval_blk_1([Last|reverse(Is)], FirstNumber, Use), + UseDef = rel2fam(UseDef0), + + %% Update what is live at the beginning of this block and + %% store it. + Used = [V || {V,[{use,_}|_]} <- UseDef], + Live2 = ordsets:union(Live1, Used), + Killed = [V || {V,[{def,_}|_]} <- UseDef], + Live = ordsets:subtract(Live2, Killed), + LiveMap = LiveMap0#{L=>Live}, + + %% Construct the ranges for this block. + Vars = make_block_ranges(UseDef, FirstNumber, Vars0), + {Vars,LiveMap}. + +make_block_ranges([{V,[{def,Def}]}|Vs], First, Acc) -> + make_block_ranges(Vs, First, [{V,{Def,Def}}|Acc]); +make_block_ranges([{V,[{def,Def}|Uses]}|Vs], First, Acc) -> + {use,Last} = last(Uses), + make_block_ranges(Vs, First, [{V,{Def,Last}}|Acc]); +make_block_ranges([{V,[{use,_}|_]=Uses}|Vs], First, Acc) -> + {use,Last} = last(Uses), + make_block_ranges(Vs, First, [{V,{First,Last}}|Acc]); +make_block_ranges([], _, Acc) -> Acc. + +live_interval_blk_1([#b_set{op=phi,dst=Dst}|Is], FirstNumber, Acc0) -> + Acc = [{Dst,{def,FirstNumber}}|Acc0], + live_interval_blk_1(Is, FirstNumber, Acc); +live_interval_blk_1([#b_set{op=bs_start_match}=I|Is], + FirstNumber, Acc0) -> + N = beam_ssa:get_anno(n, I), + #b_set{dst=Dst} = I, + Acc1 = [{Dst,{def,N}}|Acc0], + Acc = [{V,{use,N}} || V <- beam_ssa:used(I)] ++ Acc1, + live_interval_blk_1(Is, FirstNumber, Acc); +live_interval_blk_1([I|Is], FirstNumber, Acc0) -> + N = beam_ssa:get_anno(n, I), + Acc1 = case I of + #b_set{dst=Dst} -> + [{Dst,{def,N}}|Acc0]; + _ -> + Acc0 + end, + Used = beam_ssa:used(I), + Acc = [{V,{use,N}} || V <- Used] ++ Acc1, + live_interval_blk_1(Is, FirstNumber, Acc); +live_interval_blk_1([], _FirstNumber, Acc) -> + Acc. + +%% first_number([#b_set{}]) -> InstructionNumber. +%% Return the number for the first instruction for the block. +%% Note that this number is one less than the first +%% non-phi instruction in the block. + +first_number([#b_set{op=phi}|Is], Last) -> + first_number(Is, Last); +first_number([I|_], _) -> + beam_ssa:get_anno(n, I) - 1; +first_number([], Last) -> + beam_ssa:get_anno(n, Last) - 1. + +update_successors([L|Ls], Pred, Blocks, LiveMap, Live0) -> + Live1 = ordsets:union(Live0, get_live(L, LiveMap)), + #b_blk{is=Is} = map_get(L, Blocks), + Live = update_live_phis(Is, Pred, Live1), + update_successors(Ls, Pred, Blocks, LiveMap, Live); +update_successors([], _, _, _, Live) -> Live. + +get_live(L, LiveMap) -> + case LiveMap of + #{L:=Live} -> Live; + #{} -> [] + end. + +update_live_phis([#b_set{op=phi,dst=Killed,args=Args}|Is], + Pred, Live0) -> + Used = [V || {#b_var{}=V,L} <- Args, L =:= Pred], + Live1 = ordsets:union(ordsets:from_list(Used), Live0), + Live = ordsets:del_element(Killed, Live1), + update_live_phis(Is, Pred, Live); +update_live_phis(_, _, Live) -> Live. + +%%% +%%% Reserve Y registers. +%%% + +%% reserve_yregs(St0) -> St. +%% In each block that allocates a stack frame, insert instructions +%% that copy variables that must be in Y registers (given by +%% the `yregs` annotation) to new variables. +%% +%% Also allocate specific Y registers for try and catch tags. +%% The outermost try/catch tag is placed in y0, any directly +%% nested tag in y1, and so on. Note that this is the reversed +%% order as required by BEAM; it will be corrected later by +%% turn_yregs(). + +reserve_yregs(#st{frames=Frames}=St0) -> + foldl(fun reserve_yregs_1/2, St0, Frames). + +reserve_yregs_1(L, #st{ssa=Blocks0,cnt=Count0,res=Res0}=St) -> + Blk = map_get(L, Blocks0), + Yregs = beam_ssa:get_anno(yregs, Blk), + {Def,Used} = beam_ssa:def_used([L], Blocks0), + UsedYregs = ordsets:intersection(Yregs, Used), + DefBefore = ordsets:subtract(UsedYregs, Def), + {BeforeVars,Blocks,Count} = rename_vars(DefBefore, L, Blocks0, Count0), + InsideVars = ordsets:subtract(UsedYregs, DefBefore), + ResTryTags0 = reserve_try_tags(L, Blocks), + ResTryTags = [{V,{Reg,Count}} || {V,Reg} <- ResTryTags0], + Vars = BeforeVars ++ InsideVars, + Res = [{V,{y,Count}} || V <- Vars] ++ ResTryTags ++ Res0, + St#st{res=Res,ssa=Blocks,cnt=Count+1}. + +reserve_try_tags(L, Blocks) -> + Seen = gb_sets:empty(), + {Res0,_} = reserve_try_tags_1([L], Blocks, Seen, #{}), + Res1 = [maps:to_list(M) || {_,M} <- maps:to_list(Res0)], + Res = [{V,{y,Y}} || {V,Y} <- append(Res1)], + ordsets:from_list(Res). + +reserve_try_tags_1([L|Ls], Blocks, Seen0, ActMap0) -> + case gb_sets:is_element(L, Seen0) of + true -> + reserve_try_tags_1(Ls, Blocks, Seen0, ActMap0); + false -> + Seen1 = gb_sets:insert(L, Seen0), + #b_blk{is=Is} = Blk = map_get(L, Blocks), + Active0 = get_active(L, ActMap0), + Active = reserve_try_tags_is(Is, Active0), + Successors = beam_ssa:successors(Blk), + ActMap1 = update_act_map(Successors, Active, ActMap0), + {ActMap,Seen} = reserve_try_tags_1(Ls, Blocks, Seen1, ActMap1), + reserve_try_tags_1(Successors, Blocks, Seen,ActMap) + end; +reserve_try_tags_1([], _Blocks, Seen, ActMap) -> + {ActMap,Seen}. + +get_active(L, ActMap) -> + case ActMap of + #{L:=Active} -> Active; + #{} -> #{} + end. + +reserve_try_tags_is([#b_set{op=new_try_tag,dst=V}|Is], Active) -> + N = map_size(Active), + reserve_try_tags_is(Is, Active#{V=>N}); +reserve_try_tags_is([#b_set{op=kill_try_tag,args=[Tag]}|Is], Active) -> + reserve_try_tags_is(Is, maps:remove(Tag, Active)); +reserve_try_tags_is([_|Is], Active) -> + reserve_try_tags_is(Is, Active); +reserve_try_tags_is([], Active) -> Active. + +update_act_map([L|Ls], Active0, ActMap0) -> + case ActMap0 of + #{L:=Active1} -> + ActMap = ActMap0#{L=>maps:merge(Active0, Active1)}, + update_act_map(Ls, Active0, ActMap); + #{} -> + ActMap = ActMap0#{L=>Active0}, + update_act_map(Ls, Active0, ActMap) + end; +update_act_map([], _, ActMap) -> ActMap. + +rename_vars([], _, Blocks, Count) -> + {[],Blocks,Count}; +rename_vars(Vs, L, Blocks0, Count0) -> + {NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Vs], Count0), + Ren = zip(Vs, NewVars), + Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks1), + CopyIs = [#b_set{op=copy,dst=New,args=[Old]} || {Old,New} <- Ren], + Is = insert_after_phis(Is0, CopyIs), + Blk = Blk0#b_blk{is=Is}, + Blocks = Blocks1#{L:=Blk}, + {NewVars,Blocks,Count}. + +insert_after_phis([#b_set{op=phi}=I|Is], InsertIs) -> + [I|insert_after_phis(Is, InsertIs)]; +insert_after_phis(Is, InsertIs) -> + InsertIs ++ Is. + +%% frame_size(St0) -> St. +%% Calculate the frame size for each block that allocates a frame. +%% Annotate the block with the frame size. Also annotate all +%% return instructions with {deallocate,FrameSize} to simplify +%% code generation. + +frame_size(#st{frames=Frames,regs=Regs,ssa=Blocks0}=St) -> + Blocks = foldl(fun(L, Blks) -> + frame_size_1(L, Regs, Blks) + end, Blocks0, Frames), + St#st{ssa=Blocks}. + +frame_size_1(L, Regs, Blocks0) -> + Def = beam_ssa:def([L], Blocks0), + Yregs0 = [map_get(V, Regs) || V <- Def, is_yreg(map_get(V, Regs))], + Yregs = ordsets:from_list(Yregs0), + FrameSize = length(ordsets:from_list(Yregs)), + if + FrameSize =/= 0 -> + [{y,0}|_] = Yregs, %Assertion. + {y,Last} = last(Yregs), + Last = FrameSize - 1, %Assertion. + ok; + true -> + ok + end, + Blk0 = map_get(L, Blocks0), + Blk = beam_ssa:add_anno(frame_size, FrameSize, Blk0), + + %% Insert an annotation for frame deallocation on + %% each #b_ret{}. + Blocks = Blocks0#{L:=Blk}, + Reachable = beam_ssa:rpo([L], Blocks), + frame_deallocate(Reachable, FrameSize, Blocks). + +frame_deallocate([L|Ls], Size, Blocks0) -> + Blk0 = map_get(L, Blocks0), + Blk = case Blk0 of + #b_blk{last=#b_ret{}=Ret0} -> + Ret = beam_ssa:add_anno(deallocate, Size, Ret0), + Blk0#b_blk{last=Ret}; + #b_blk{} -> + Blk0 + end, + Blocks = Blocks0#{L:=Blk}, + frame_deallocate(Ls, Size, Blocks); +frame_deallocate([], _, Blocks) -> Blocks. + + +%% turn_yregs(St0) -> St. +%% Renumber y registers so that {y,0} becomes {y,FrameSize-1}, +%% {y,FrameSize-1} becomes {y,0} and so on. This is to make nested +%% catches work. The register allocator (linear_scan()) has given +%% a lower number to the outermost catch. + +turn_yregs(#st{frames=Frames,regs=Regs0,ssa=Blocks}=St) -> + Regs1 = foldl(fun(L, A) -> + Blk = map_get(L, Blocks), + FrameSize = beam_ssa:get_anno(frame_size, Blk), + Def = beam_ssa:def([L], Blocks), + [turn_yregs_1(Def, FrameSize, Regs0)|A] + end, [], Frames), + Regs = maps:merge(Regs0, maps:from_list(append(Regs1))), + St#st{regs=Regs}. + +turn_yregs_1(Def, FrameSize, Regs) -> + Yregs0 = [{map_get(V, Regs),V} || V <- Def, is_yreg(map_get(V, Regs))], + Yregs1 = rel2fam(Yregs0), + FrameSize = length(Yregs1), + Yregs2 = [{{y,FrameSize-Y-1},Vs} || {{y,Y},Vs} <- Yregs1], + R0 = sofs:family(Yregs2), + R1 = sofs:family_to_relation(R0), + R = sofs:converse(R1), + sofs:to_external(R). + +%%% +%%% Reserving registers before register allocation. +%%% + +%% reserve_regs(St0) -> St. +%% Reserve registers prior to register allocation. Y registers +%% have already been reserved. This function will reserve z, +%% fr, and specific x registers. + +reserve_regs(#st{args=Args,ssa=Blocks,intervals=Intervals,res=Res0}=St) -> + %% Reserve x0, x1, and so on for the function arguments. + Res1 = reserve_arg_regs(Args, 0, Res0), + + %% Reserve Z registers (dummy registers) for instructions with no + %% return values (e.g. remove_message) or pseudo-return values + %% (e.g. landingpad). + Res2 = reserve_zregs(Blocks, Intervals, Res1), + + %% Reserve float registers. + Res3 = reserve_fregs(Blocks, Res2), + + %% Reserve all remaining unreserved variables as X registers. + Res = maps:from_list(Res3), + St#st{res=reserve_xregs(Blocks, Res)}. + +reserve_arg_regs([#b_var{}=Arg|Is], N, Acc) -> + reserve_arg_regs(Is, N+1, [{Arg,{x,N}}|Acc]); +reserve_arg_regs([], _, Acc) -> Acc. + +reserve_zregs(Blocks, Intervals, Res) -> + ShortLived0 = [V || {V,[{Start,End}]} <- Intervals, Start+2 =:= End], + ShortLived = cerl_sets:from_list(ShortLived0), + F = fun(_, #b_blk{is=Is,last=Last}, A) -> + reserve_zreg(Is, Last, ShortLived, A) + end, + beam_ssa:fold_rpo(F, [0], Res, Blocks). + +reserve_zreg([#b_set{op=Op,dst=Dst}], + #b_br{bool=Dst}, _ShortLived, A) when Op =:= call; + Op =:= get_tuple_element -> + %% If type optimization has determined that the result of these + %% instructions can be used directly in a branch, we must avoid reserving a + %% z register or code generation will fail. + A; +reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}, + #b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) -> + case {Val,Last} of + {#b_literal{val=Arity},#b_br{bool=#b_var{}}} when Arity bsr 32 =:= 0 -> + %% These two instructions can be combined to a test_arity + %% instruction provided that the arity variable is short-lived. + reserve_zreg_1(Dst, ShortLived, A0); + {_,_} -> + %% Either the arity is too big, or the boolean value is not + %% used in a conditional branch. + A0 + end; +reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst}], + #b_switch{}, ShortLived, A) -> + reserve_zreg_1(Dst, ShortLived, A); +reserve_zreg([#b_set{op={bif,'xor'}}], _Last, _ShortLived, A) -> + %% There is no short, easy way to rewrite 'xor' to a series of + %% test instructions. + A; +reserve_zreg([#b_set{op={bif,is_record}}], _Last, _ShortLived, A) -> + %% There is no short, easy way to rewrite is_record/2 to a series of + %% test instructions. + A; +reserve_zreg([#b_set{op=Op,dst=Dst}|Is], Last, ShortLived, A0) -> + IsZReg = case Op of + bs_match_string -> true; + bs_save -> true; + bs_restore -> true; + bs_set_position -> true; + {float,clearerror} -> true; + kill_try_tag -> true; + landingpad -> true; + put_tuple_elements -> true; + remove_message -> true; + set_tuple_element -> true; + succeeded -> true; + timeout -> true; + wait_timeout -> true; + _ -> false + end, + A = case IsZReg of + true -> [{Dst,z}|A0]; + false -> A0 + end, + reserve_zreg(Is, Last, ShortLived, A); +reserve_zreg([], #b_br{bool=Bool}, ShortLived, A) -> + reserve_zreg_1(Bool, ShortLived, A); +reserve_zreg([], _, _, A) -> A. + +reserve_zreg_1(#b_var{}=V, ShortLived, A) -> + case cerl_sets:is_element(V, ShortLived) of + true -> [{V,z}|A]; + false -> A + end; +reserve_zreg_1(#b_literal{}, _, A) -> A. + +reserve_fregs(Blocks, Res) -> + F = fun(_, #b_blk{is=Is}, A) -> + reserve_freg(Is, A) + end, + beam_ssa:fold_rpo(F, [0], Res, Blocks). + +reserve_freg([#b_set{op={float,Op},dst=V}|Is], Res) -> + case Op of + get -> + reserve_freg(Is, Res); + _ -> + reserve_freg(Is, [{V,fr}|Res]) + end; +reserve_freg([_|Is], Res) -> + reserve_freg(Is, Res); +reserve_freg([], Res) -> Res. + +%% reserve_xregs(St0) -> St. +%% Reserve all remaining variables as X registers. +%% +%% If a variable will need to be in a specific X register for a +%% 'call' or 'make_fun' (and there is nothing that will kill it +%% between the definition and use), reserve the register using a +%% {prefer,{x,X} annotation. That annotation means that the linear +%% scan algorithm will place the variable in the preferred register, +%% unless that register is already occupied. +%% +%% All remaining variables are reserved as X registers. Linear scan +%% will allocate the lowest free X register for the variable. + +reserve_xregs(Blocks, Res) -> + Ls = reverse(beam_ssa:rpo(Blocks)), + reserve_xregs(Ls, Blocks, #{}, Res). + +reserve_xregs([L|Ls], Blocks, XsMap0, Res0) -> + #b_blk{anno=Anno,is=Is0,last=Last} = map_get(L, Blocks), + + %% Calculate mapping from variable name to the preferred + %% register. + Xs0 = reserve_terminator(L, Is0, Last, Blocks, XsMap0, Res0), + + %% We need to figure out where the code generator will + %% place instructions that will do a garbage collection. + %% Insert 'gc' markers as pseudo-instructions in the + %% instruction sequence. + Is1 = reverse(Is0), + Is2 = res_place_gc_instrs(Is1, []), + Is = res_place_allocate(Anno, Is2), + + %% Add register hints for variables that are defined + %% in the (reversed) instruction sequence. + {Res,Xs} = reserve_xregs_is(Is, Res0, Xs0, []), + + XsMap = XsMap0#{L=>Xs}, + reserve_xregs(Ls, Blocks, XsMap, Res); +reserve_xregs([], _, _, Res) -> Res. + +%% Insert explicit 'gc' markers points where there will +%% be a garbage collection. (Note that the instruction +%% sequence passed to this function is reversed.) + +res_place_gc_instrs([#b_set{op=phi}=I|Is], Acc) -> + res_place_gc_instrs(Is, [I|Acc]); +res_place_gc_instrs([#b_set{op=Op}=I|Is], Acc) + when Op =:= call; Op =:= make_fun -> + case Acc of + [] -> + res_place_gc_instrs(Is, [I|Acc]); + [GC|_] when GC =:= gc; GC =:= test_heap -> + res_place_gc_instrs(Is, [I,gc|Acc]); + [_|_] -> + res_place_gc_instrs(Is, [I,gc|Acc]) + end; +res_place_gc_instrs([#b_set{op=Op,args=Args}=I|Is], Acc0) -> + case beam_ssa_codegen:classify_heap_need(Op, Args) of + neutral -> + case Acc0 of + [test_heap|Acc] -> + res_place_gc_instrs(Is, [test_heap,I|Acc]); + Acc -> + res_place_gc_instrs(Is, [I|Acc]) + end; + {put,_} -> + case Acc0 of + [test_heap|Acc] -> + res_place_gc_instrs(Is, [test_heap,I|Acc]); + Acc -> + res_place_gc_instrs(Is, [test_heap,I|Acc]) + end; + _ -> + res_place_gc_instrs(Is, [gc,I|Acc0]) + end; +res_place_gc_instrs([], Acc) -> + %% Reverse and replace 'test_heap' markers with 'gc'. + %% (The distinction is no longer useful.) + res_place_gc_instrs_rev(Acc, []). + +res_place_gc_instrs_rev([test_heap|Is], [gc|_]=Acc) -> + res_place_gc_instrs_rev(Is, Acc); +res_place_gc_instrs_rev([test_heap|Is], Acc) -> + res_place_gc_instrs_rev(Is, [gc|Acc]); +res_place_gc_instrs_rev([gc|Is], [gc|_]=Acc) -> + res_place_gc_instrs_rev(Is, Acc); +res_place_gc_instrs_rev([I|Is], Acc) -> + res_place_gc_instrs_rev(Is, [I|Acc]); +res_place_gc_instrs_rev([], Acc) -> Acc. + +res_place_allocate(#{yregs:=_}, Is) -> + %% There will be an 'allocate' instruction inserted here. + Is ++ [gc]; +res_place_allocate(#{}, Is) -> Is. + +reserve_xregs_is([gc|Is], Res, Xs0, Used) -> + %% At this point, the code generator will place an instruction + %% that does a garbage collection. We must prune the remembered + %% registers. + Xs = res_xregs_prune(Xs0, Used, Res), + reserve_xregs_is(Is, Res, Xs, Used); +reserve_xregs_is([#b_set{op=Op,dst=Dst,args=Args}=I|Is], Res0, Xs0, Used0) -> + Res = reserve_xreg(Dst, Xs0, Res0), + Used1 = ordsets:union(Used0, beam_ssa:used(I)), + Used = ordsets:del_element(Dst, Used1), + case Op of + call -> + Xs = reserve_call_args(tl(Args)), + reserve_xregs_is(Is, Res, Xs, Used); + make_fun -> + Xs = reserve_call_args(tl(Args)), + reserve_xregs_is(Is, Res, Xs, Used); + _ -> + reserve_xregs_is(Is, Res, Xs0, Used) + end; +reserve_xregs_is([], Res, Xs, _Used) -> + {Res,Xs}. + +%% Pick up register hints from the successors of this blocks. +reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?BADARG_BLOCK}, + _Blocks, XsMap, _Res) -> + %% We know that no variables are used at ?BADARG_BLOCK, so + %% any register hints from the success blocks are safe to use. + map_get(Succ, XsMap); +reserve_terminator(L, Is, #b_br{bool=#b_var{},succ=Succ,fail=Fail}, + Blocks, XsMap, Res) when Succ =/= Fail -> + #{Succ:=SuccBlk,Fail:=FailBlk} = Blocks, + case {SuccBlk,FailBlk} of + {#b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}, + #b_blk{is=[],last=#b_br{succ=PhiL,fail=PhiL}}} -> + %% Both branches ultimately transfer to the same + %% block (via two blocks with no instructions). + %% Pick up register hints from the phi nodes + %% in the common block. + #{PhiL:=#b_blk{is=PhiIs}} = Blocks, + Xs = res_xregs_from_phi(PhiIs, Succ, Res, #{}), + res_xregs_from_phi(PhiIs, Fail, Res, Xs); + {_,_} when Is =/= [] -> + case last(Is) of + #b_set{op=succeeded,args=[Arg]} -> + %% We know that Arg will not be used at the failure + %% label, so we can pick up register hints from the + %% success label. + Br = #b_br{bool=#b_literal{val=true},succ=Succ,fail=Succ}, + case reserve_terminator(L, [], Br, Blocks, XsMap, Res) of + #{Arg:=Reg} -> #{Arg=>Reg}; + #{} -> #{} + end; + _ -> + %% Register hints from the success block may not + %% be safe at the failure block, and vice versa. + #{} + end; + {_,_} -> + %% Register hints from the success block may not + %% be safe at the failure block, and vice versa. + #{} + end; +reserve_terminator(L, Is, #b_br{bool=#b_literal{val=true},succ=Succ}, + Blocks, XsMap, Res) -> + case map_get(Succ, Blocks) of + #b_blk{is=[],last=Last} -> + reserve_terminator(Succ, Is, Last, Blocks, XsMap, Res); + #b_blk{is=[_|_]=PhiIs} -> + res_xregs_from_phi(PhiIs, L, Res, #{}) + end; +reserve_terminator(_, _, _, _, _, _) -> #{}. + +%% Pick up a reservation from a phi node. +res_xregs_from_phi([#b_set{op=phi,dst=Dst,args=Args}|Is], + Pred, Res, Acc) -> + case [V || {#b_var{}=V,L} <- Args, L =:= Pred] of + [] -> + %% The value of the phi node for this predecessor + %% is a literal. Nothing to do here. + res_xregs_from_phi(Is, Pred, Res, Acc); + [V] -> + case Res of + #{Dst:={prefer,Reg}} -> + %% Try placing V in the same register as for + %% the phi node. + res_xregs_from_phi(Is, Pred, Res, Acc#{V=>Reg}); + #{Dst:=_} -> + res_xregs_from_phi(Is, Pred, Res, Acc) + end + end; +res_xregs_from_phi(_, _, _, Acc) -> Acc. + +reserve_call_args(Args) -> + reserve_call_args(Args, 0, #{}). + +reserve_call_args([#b_var{}=Var|As], X, Xs) -> + reserve_call_args(As, X+1, Xs#{Var=>{x,X}}); +reserve_call_args([#b_literal{}|As], X, Xs) -> + reserve_call_args(As, X+1, Xs); +reserve_call_args([], _, Xs) -> Xs. + +reserve_xreg(V, Xs, Res) -> + case Res of + #{V:=_} -> + %% Already reserved (but not as an X register). + Res; + #{} -> + case Xs of + #{V:=X} -> + %% Add a hint that this specific X register is + %% preferred, unless it is already in use. + Res#{V=>{prefer,X}}; + #{} -> + %% Reserve as an X register in general. + Res#{V=>x} + end + end. + +%% res_xregs_prune(PreferredRegs, Used, Res) -> PreferredRegs. +%% Prune the list of preferred registers, to make sure that +%% there are no "holes" (uninitialized X registers) when +%% invoking the garbage collector. + +res_xregs_prune(Xs, Used, Res) when map_size(Xs) =/= 0 -> + %% The number of safe registers is the number of the X registers + %% used after this point. The actual number of safe registers may + %% be higher than this number, but this is a conservative safe + %% estimate. + NumSafe = foldl(fun(V, N) -> + case Res of + #{V:={x,_}} -> N + 1; + #{V:=_} -> N; + #{} -> N + 1 + end + end, 0, Used), + + %% Remove unsafe registers from the list of potential + %% preferred registers. + maps:filter(fun(_, {x,X}) -> X < NumSafe end, Xs); +res_xregs_prune(Xs, _Used, _Res) -> Xs. + +%%% +%%% Register allocation using linear scan. +%%% + +-record(i, + {sort=1 :: instr_number(), + reg=none :: i_reg(), + pool=x :: pool_id(), + var=#b_var{} :: b_var(), + rs=[] :: [range()] + }). + +-record(l, + {cur=#i{} :: interval(), + unhandled_res=[] :: [interval()], + unhandled_any=[] :: [interval()], + active=[] :: [interval()], + inactive=[] :: [interval()], + free=#{} :: #{var_name()=>pool(), + {'next',pool_id()}:=reg_num()}, + regs=[] :: [{b_var(),ssa_register()}] + }). + +-type interval() :: #i{}. +-type i_reg() :: ssa_register() | {'prefer',xreg()} | 'none'. +-type pool_id() :: 'fr' | 'x' | 'z' | instr_number(). +-type pool() :: ordsets:ordset(ssa_register()). + +linear_scan(#st{intervals=Intervals0,res=Res}=St0) -> + St = St0#st{intervals=[],res=[]}, + Free = init_free(maps:to_list(Res)), + Intervals1 = [init_interval(Int, Res) || Int <- Intervals0], + Intervals = sort(Intervals1), + IsReserved = fun(#i{reg=Reg}) -> + case Reg of + none -> false; + {prefer,{_,_}} -> false; + {_,_} -> true + end + end, + {UnhandledRes,Unhandled} = partition(IsReserved, Intervals), + L = #l{unhandled_res=UnhandledRes, + unhandled_any=Unhandled,free=Free}, + #l{regs=Regs} = do_linear(L), + St#st{regs=maps:from_list(Regs)}. + +init_interval({V,[{Start,_}|_]=Rs}, Res) -> + Info = map_get(V, Res), + Pool = case Info of + {prefer,{x,_}} -> x; + x -> x; + {x,_} -> x; + {y,Uniq} -> Uniq; + {{y,_},Uniq} -> Uniq; + z -> z; + fr -> fr + end, + Reg = case Info of + {prefer,{x,_}} -> Info; + {x,_} -> Info; + {{y,_}=Y,_} -> Y; + _ -> none + end, + #i{sort=Start,var=V,reg=Reg,pool=Pool,rs=Rs}. + +init_free(Res) -> + Free0 = rel2fam([{x,{x,0}}|init_free_1(Res)]), + #{x:=Xs0} = Free1 = maps:from_list(Free0), + Xs = init_xregs(Xs0), + Free = Free1#{x:=Xs}, + Next = maps:fold(fun(K, V, A) -> [{{next,K},length(V)}|A] end, [], Free), + maps:merge(Free, maps:from_list(Next)). + +init_free_1([{_,{prefer,{x,_}=Reg}}|Res]) -> + [{x,Reg}|init_free_1(Res)]; +init_free_1([{_,{x,_}=Reg}|Res]) -> + [{x,Reg}|init_free_1(Res)]; +init_free_1([{_,{y,Uniq}}|Res]) -> + [{Uniq,{y,0}}|init_free_1(Res)]; +init_free_1([{_,{{y,_}=Reg,Uniq}}|Res]) -> + [{Uniq,Reg}|init_free_1(Res)]; +init_free_1([{_,z}|Res]) -> + [{z,{z,0}}|init_free_1(Res)]; +init_free_1([{_,fr}|Res]) -> + [{fr,{fr,0}}|init_free_1(Res)]; +init_free_1([{_,x}|Res]) -> + init_free_1(Res); +init_free_1([]) -> []. + +%% Make sure that the pool of xregs is contiguous. +init_xregs([{x,N},{x,M}|Is]) when N+1 =:= M -> + [{x,N}|init_xregs([{x,M}|Is])]; +init_xregs([{x,N}|[{x,_}|_]=Is]) -> + [{x,N}|init_xregs([{x,N+1}|Is])]; +init_xregs([{x,_}]=Is) -> Is. + +do_linear(L0) -> + case set_next_current(L0) of + done -> + L0; + L1 -> + L2 = expire_active(L1), + L3 = check_inactive(L2), + Available = collect_available(L3), + L4 = select_register(Available, L3), + L = make_cur_active(L4), + do_linear(L) + end. + +set_next_current(#l{unhandled_res=[Cur1|T1], + unhandled_any=[Cur2|T2]}=L) -> + case {Cur1,Cur2} of + {#i{sort=N1},#i{sort=N2}} when N1 < N2 -> + L#l{cur=Cur1,unhandled_res=T1}; + {_,_} -> + L#l{cur=Cur2,unhandled_any=T2} + end; +set_next_current(#l{unhandled_res=[], + unhandled_any=[Cur|T]}=L) -> + L#l{cur=Cur,unhandled_any=T}; +set_next_current(#l{unhandled_res=[Cur|T], + unhandled_any=[]}=L) -> + L#l{cur=Cur,unhandled_res=T}; +set_next_current(#l{unhandled_res=[],unhandled_any=[]}) -> + done. + +expire_active(#l{cur=#i{sort=CurBegin},active=Act0}=L0) -> + {Act,L} = expire_active(Act0, CurBegin, L0, []), + L#l{active=Act}. + +expire_active([#i{reg=Reg,rs=Rs0}=I|Is], CurBegin, L0, Acc) -> + {_,_} = Reg, %Assertion. + case overlap_status(Rs0, CurBegin) of + ends_before_cur -> + L = free_reg(I, L0), + expire_active(Is, CurBegin, L, Acc); + overlapping -> + expire_active(Is, CurBegin, L0, [I|Acc]); + not_overlapping -> + Rs = strip_before_current(Rs0, CurBegin), + L1 = free_reg(I, L0), + L = L1#l{inactive=[I#i{rs=Rs}|L1#l.inactive]}, + expire_active(Is, CurBegin, L, Acc) + end; +expire_active([], _CurBegin, L, Acc) -> + {Acc,L}. + +check_inactive(#l{cur=#i{sort=CurBegin},inactive=InAct0}=L0) -> + {InAct,L} = check_inactive(InAct0, CurBegin, L0, []), + L#l{inactive=InAct}. + +check_inactive([#i{rs=Rs0}=I|Is], CurBegin, L0, Acc) -> + case overlap_status(Rs0, CurBegin) of + ends_before_cur -> + check_inactive(Is, CurBegin, L0, Acc); + not_overlapping -> + check_inactive(Is, CurBegin, L0, [I|Acc]); + overlapping -> + Rs = strip_before_current(Rs0, CurBegin), + L1 = L0#l{active=[I#i{rs=Rs}|L0#l.active]}, + L = reserve_reg(I, L1), + check_inactive(Is, CurBegin, L, Acc) + end; +check_inactive([], _CurBegin, L, Acc) -> + {Acc,L}. + +strip_before_current([{_,E}|Rs], CurBegin) when E =< CurBegin -> + strip_before_current(Rs, CurBegin); +strip_before_current(Rs, _CurBegin) -> Rs. + +collect_available(#l{cur=#i{reg={prefer,{_,_}=Prefer}}=I}=L) -> + %% Use the preferred register if it is available. + Avail = collect_available(L#l{cur=I#i{reg=none}}), + case member(Prefer, Avail) of + true -> [Prefer]; + false -> Avail + end; +collect_available(#l{cur=#i{reg={_,_}=ReservedReg}}) -> + %% Return the already reserved register. + [ReservedReg]; +collect_available(#l{unhandled_res=Unhandled,cur=Cur}=L) -> + Free = get_pool(Cur, L), + + %% Note that since the live intervals are constructed from + %% SSA form, there cannot be any overlap of the current interval + %% with any inactive interval. See [3], page 175. Therefore we + %% only have check the unhandled intervals for overlap with + %% the current interval. As a further optimization, we only need + %% to check the intervals that have reserved registers. + collect_available(Unhandled, Cur, Free). + +collect_available([#i{pool=Pool1}|Is], #i{pool=Pool2}=Cur, Free) + when Pool1 =/= Pool2 -> + %% Wrong pool. Ignore this interval. + collect_available(Is, Cur, Free); +collect_available([#i{reg={_,_}=Reg}=I|Is], Cur, Free0) -> + case overlaps(I, Cur) of + true -> + Free = ordsets:del_element(Reg, Free0), + collect_available(Is, Cur, Free); + false -> + collect_available(Is, Cur, Free0) + end; +collect_available([], _, Free) -> Free. + +select_register([{_,_}=Reg|_], #l{cur=Cur0,regs=Regs}=L) -> + Cur = Cur0#i{reg=Reg}, + reserve_reg(Cur, L#l{cur=Cur,regs=[{Cur#i.var,Reg}|Regs]}); +select_register([], #l{cur=Cur0,regs=Regs}=L0) -> + %% Allocate a new register in the pool. + {Reg,L1} = get_next_free(Cur0, L0), + Cur = Cur0#i{reg=Reg}, + L = L1#l{cur=Cur,regs=[{Cur#i.var,Reg}|Regs]}, + reserve_reg(Cur, L). + +make_cur_active(#l{cur=Cur,active=Act}=L) -> + L#l{active=[Cur|Act]}. + +overlaps(#i{rs=Rs1}, #i{rs=Rs2}) -> + are_overlapping(Rs1, Rs2). + +overlap_status([{S,E}], CurBegin) -> + if + E =< CurBegin -> ends_before_cur; + CurBegin < S -> not_overlapping; + true -> overlapping + end; +overlap_status([{S,E}|Rs], CurBegin) -> + if + E =< CurBegin -> + overlap_status(Rs, CurBegin); + S =< CurBegin -> + overlapping; + true -> + not_overlapping + end. + +reserve_reg(#i{reg={_,_}=Reg}=I, L) -> + FreeRegs0 = get_pool(I, L), + FreeRegs = ordsets:del_element(Reg, FreeRegs0), + update_pool(I, FreeRegs, L). + +free_reg(#i{reg={_,_}=Reg}=I, L) -> + FreeRegs0 = get_pool(I, L), + FreeRegs = ordsets:add_element(Reg, FreeRegs0), + update_pool(I, FreeRegs, L). + +get_pool(#i{pool=Pool}, #l{free=Free}) -> + map_get(Pool, Free). + +update_pool(#i{pool=Pool}, New, #l{free=Free0}=L) -> + Free = Free0#{Pool:=New}, + L#l{free=Free}. + +get_next_free(#i{pool=Pool}, #l{free=Free0}=L0) -> + K = {next,Pool}, + N = map_get(K, Free0), + Free = Free0#{K:=N+1}, + L = L0#l{free=Free}, + if + is_integer(Pool) -> {{y,N},L}; + is_atom(Pool) -> {{Pool,N},L} + end. + +%%% +%%% Interval utilities. +%%% + +are_overlapping([R|Rs1], Rs2) -> + case are_overlapping_1(R, Rs2) of + true -> + true; + false -> + are_overlapping(Rs1, Rs2) + end; +are_overlapping([], _) -> false. + +are_overlapping_1({_S1,E1}, [{S2,_E2}|_]) when E1 < S2 -> + false; +are_overlapping_1({S1,E1}=R, [{S2,E2}|Rs]) -> + (S2 < E1 andalso E2 > S1) orelse are_overlapping_1(R, Rs); +are_overlapping_1({_,_}, []) -> false. + +%%% +%%% Utilities. +%%% + +%% is_loop_header(L, Blocks) -> false|true. +%% Check whether the block is a loop header. + +is_loop_header(L, Blocks) -> + %% We KNOW that a loop header must start with a peek_message + %% instruction. + case map_get(L, Blocks) of + #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + _ -> false + end. + +rel2fam(S0) -> + S1 = sofs:relation(S0), + S = sofs:rel2fam(S1), + sofs:to_external(S). + +split_phis(Is) -> + splitwith(fun(#b_set{op=Op}) -> Op =:= phi end, Is). + +is_yreg({y,_}) -> true; +is_yreg({x,_}) -> false; +is_yreg({z,_}) -> false; +is_yreg({fr,_}) -> false. + +new_vars([Base|Vs0], Count0) -> + {V,Count1} = new_var(Base, Count0), + {Vs,Count} = new_vars(Vs0, Count1), + {[V|Vs],Count}; +new_vars([], Count) -> {[],Count}. + +new_var({Base,Int}, Count) -> + true = is_integer(Int), %Assertion. + {#b_var{name={Base,Count}},Count+1}; +new_var(Base, Count) -> + {#b_var{name={Base,Count}},Count+1}. diff --git a/lib/compiler/src/beam_ssa_recv.erl b/lib/compiler/src/beam_ssa_recv.erl new file mode 100644 index 0000000000..1e0e1ecac2 --- /dev/null +++ b/lib/compiler/src/beam_ssa_recv.erl @@ -0,0 +1,278 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_ssa_recv). +-export([module/2]). + +%%% +%%% In code such as: +%%% +%%% Ref = make_ref(), %Or erlang:monitor(process, Pid) +%%% . +%%% . +%%% . +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% we know that none of the messages that exist in the message queue +%%% before the call to make_ref/0 can be matched out in the receive +%%% statement. Therefore we can avoid going through the entire message +%%% queue if we introduce two new instructions (here written as +%%% BIFs in pseudo-Erlang): +%%% +%%% recv_mark(SomeUniqInteger), +%%% Ref = make_ref(), +%%% . +%%% . +%%% . +%%% recv_set(SomeUniqInteger), +%%% receive +%%% {Ref,Reply} -> Reply +%%% end. +%%% +%%% The recv_mark/1 instruction will save the current position and +%%% SomeUniqInteger in the process context. The recv_set +%%% instruction will verify that SomeUniqInteger is still stored +%%% in the process context. If it is, it will set the current pointer +%%% for the message queue (the next message to be read out) to the +%%% position that was saved by recv_mark/1. +%%% +%%% The remove_message instruction must be modified to invalidate +%%% the information stored by the previous recv_mark/1, in case there +%%% is another receive executed between the calls to recv_mark/1 and +%%% recv_set/1. +%%% +%%% We use a reference to a label (i.e. a position in the loaded code) +%%% as the SomeUniqInteger. +%%% + +-include("beam_ssa.hrl"). +-import(lists, [all/2,reverse/2]). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, _Opts) -> + Fs = [function(F) || F <- Fs0], + {ok,Module#b_module{body=Fs}}. + +%%% +%%% Local functions. +%%% + +function(#b_function{anno=Anno,bs=Blocks0}=F) -> + try + Blocks = opt(Blocks0), + F#b_function{bs=Blocks} + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +opt(Blocks) -> + Linear = beam_ssa:linearize(Blocks), + opt(Linear, Blocks, []). + +opt([{L,#b_blk{is=[#b_set{op=peek_message}|_]}=Blk0}|Bs], Blocks0, Preds) -> + %% Search for a suitable reference creating call in one of the predecessor + %% blocks. Whether we find such a call or not, we always clear the + %% the list of predecessors to ensure that any nested receive can't + %% search above the current receive. + case recv_opt(Preds, L, Blocks0) of + {yes,Blocks1} -> + Blk = beam_ssa:add_anno(recv_set, L, Blk0), + Blocks = Blocks1#{L:=Blk}, + opt(Bs, Blocks, []); + no -> + opt(Bs, Blocks0, []) + end; +opt([{L,_}|Bs], Blocks, Preds) -> + opt(Bs, Blocks, [L|Preds]); +opt([], Blocks, _) -> Blocks. + +recv_opt([L|Ls], RecvLbl, Blocks) -> + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks), + case recv_opt_is(Is0, RecvLbl, Blocks, []) of + {yes,Is} -> + Blk = Blk0#b_blk{is=Is}, + {yes,Blocks#{L:=Blk}}; + no -> + recv_opt(Ls, RecvLbl, Blocks) + end; +recv_opt([], _, _Blocks) -> no. + +recv_opt_is([#b_set{op=call}=I0|Is], RecvLbl, Blocks0, Acc) -> + case makes_ref(I0, Blocks0) of + no -> + recv_opt_is(Is, RecvLbl, Blocks0, [I0|Acc]); + {yes,Ref} -> + case opt_ref_used(RecvLbl, Ref, Blocks0) of + false -> + recv_opt_is(Is, RecvLbl, Blocks0, [I0|Acc]); + true -> + I = beam_ssa:add_anno(recv_mark, RecvLbl, I0), + {yes,reverse(Acc, [I|Is])} + end + end; +recv_opt_is([I|Is], RecvLbl, Blocks, Acc) -> + recv_opt_is(Is, RecvLbl, Blocks, [I|Acc]); +recv_opt_is([], _, _, _) -> no. + +makes_ref(#b_set{dst=Dst,args=[Func0|_]}, Blocks) -> + Func = case Func0 of + #b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=Name},arity=A0} -> + {Name,A0}; + _ -> + none + end, + case Func of + {make_ref,0} -> + {yes,Dst}; + {monitor,2} -> + {yes,Dst}; + {spawn_monitor,A} when A =:= 1; A =:= 3 -> + ref_in_tuple(Dst, Blocks); + _ -> + no + end. + +ref_in_tuple(Tuple, Blocks) -> + F = fun(#b_set{op=get_tuple_element,dst=Ref, + args=[#b_var{}=Tup,#b_literal{val=1}]}, no) + when Tup =:= Tuple -> {yes,Ref}; + (_, A) -> A + end, + beam_ssa:fold_instrs_rpo(F, [0], no, Blocks). + +opt_ref_used(RecvLbl, Ref, Blocks) -> + Vs = #{Ref=>ref,ref=>Ref,ref_matched=>false}, + case opt_ref_used_1(RecvLbl, Vs, Blocks) of + used -> true; + not_used -> false; + done -> false + end. + +opt_ref_used_1(L, Vs0, Blocks) -> + #b_blk{is=Is} = Blk = map_get(L, Blocks), + case opt_ref_used_is(Is, Vs0) of + #{}=Vs -> + opt_ref_used_last(Blk, Vs, Blocks); + Result -> + Result + end. + +opt_ref_used_is([#b_set{op=peek_message,dst=Msg}|Is], Vs0) -> + Vs = Vs0#{Msg=>message}, + opt_ref_used_is(Is, Vs); +opt_ref_used_is([#b_set{op={bif,Bif},args=Args,dst=Dst}=I|Is], + Vs0) -> + S = case Bif of + '=:=' -> true; + '==' -> true; + _ -> none + end, + case S of + none -> + Vs = update_vars(I, Vs0), + opt_ref_used_is(Is, Vs); + Bool when is_boolean(Bool) -> + case is_ref_msg_comparison(Args, Vs0) of + true -> + Vs = Vs0#{Dst=>{is_ref,Bool}}, + opt_ref_used_is(Is, Vs); + false -> + opt_ref_used_is(Is, Vs0) + end + end; +opt_ref_used_is([#b_set{op=remove_message}|_], Vs) -> + case Vs of + #{ref_matched:=true} -> + used; + #{ref_matched:=false} -> + not_used + end; +opt_ref_used_is([#b_set{op=recv_next}|_], _Vs) -> + done; +opt_ref_used_is([#b_set{op=wait_timeout}|_], _Vs) -> + done; +opt_ref_used_is([#b_set{op=wait}|_], _Vs) -> + done; +opt_ref_used_is([#b_set{}=I|Is], Vs0) -> + Vs = update_vars(I, Vs0), + opt_ref_used_is(Is, Vs); +opt_ref_used_is([], Vs) -> Vs. + +opt_ref_used_last(#b_blk{last=Last}=Blk, Vs, Blocks) -> + case Last of + #b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail} -> + case Vs of + #{Bool:={is_ref,Matched}} -> + ref_used_in([{Succ,Vs#{ref_matched:=Matched}}, + {Fail,Vs#{ref_matched:=not Matched}}], + Blocks); + #{} -> + ref_used_in([{Succ,Vs},{Fail,Vs}], Blocks) + end; + _ -> + SuccVs = [{Succ,Vs} || Succ <- beam_ssa:successors(Blk)], + ref_used_in(SuccVs, Blocks) + end. + +ref_used_in([{L,Vs0}|Ls], Blocks) -> + case opt_ref_used_1(L, Vs0, Blocks) of + not_used -> + not_used; + used -> + case ref_used_in(Ls, Blocks) of + done -> used; + Result -> Result + end; + done -> ref_used_in(Ls, Blocks) + end; +ref_used_in([], _) -> done. + +update_vars(#b_set{args=Args,dst=Dst}, Vs) -> + Vars = [V || #b_var{}=V <- Args], + All = all(fun(Var) -> + case Vs of + #{Var:=message} -> true; + #{} -> false + end + end, Vars), + case All of + true -> Vs#{Dst=>message}; + false -> Vs + end. + +%% is_ref_msg_comparison(Args, Variables) -> true|false. +%% Return 'true' if Args denotes a comparison between the +%% reference and message or part of the message. + +is_ref_msg_comparison([#b_var{}=V1,#b_var{}=V2], Vs) -> + case Vs of + #{V1:=ref,V2:=message} -> true; + #{V1:=message,V2:=ref} -> true; + #{} -> false + end; +is_ref_msg_comparison(_, _) -> false. diff --git a/lib/compiler/src/beam_ssa_share.erl b/lib/compiler/src/beam_ssa_share.erl new file mode 100644 index 0000000000..73983bd34a --- /dev/null +++ b/lib/compiler/src/beam_ssa_share.erl @@ -0,0 +1,374 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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% +%% + +%% +%% Share code for semantically equivalent blocks referred to +%% to by `br` and `switch` instructions. +%% +%% A similar optimization is done in beam_jump, but doing it here as +%% well is beneficial as it may enable other optimizations. If there +%% are many semantically equivalent clauses, this optimization can +%% substanstially decrease compilation times. +%% +%% block/2 is called from the liveness optimization pass in +%% beam_ssa_opt, as code sharing helps the liveness pass and vice +%% versa. +%% + +-module(beam_ssa_share). +-export([module/2,block/2]). + +-include("beam_ssa.hrl"). + +-import(lists, [keyfind/3,reverse/1,sort/1]). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, _Opts) -> + Fs = [function(F) || F <- Fs0], + {ok,Module#b_module{body=Fs}}. + +-spec block(Blk0, Blocks0) -> Blk when + Blk0 :: beam_ssa:b_blk(), + Blocks0 :: beam_ssa:block_map(), + Blk :: beam_ssa:b_blk(). + +block(#b_blk{last=Last0}=Blk, Blocks) -> + case share_terminator(Last0, Blocks) of + none -> Blk; + Last -> Blk#b_blk{last=beam_ssa:normalize(Last)} + end. + +%%% +%%% Local functions. +%%% + +function(#b_function{anno=Anno,bs=Blocks0}=F) -> + try + PO = reverse(beam_ssa:rpo(Blocks0)), + {Blocks1,Changed} = blocks(PO, Blocks0, false), + Blocks = case Changed of + true -> + beam_ssa:trim_unreachable(Blocks1); + false -> + Blocks0 + end, + F#b_function{bs=Blocks} + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +blocks([L|Ls], Blocks, Changed) -> + #b_blk{last=Last0} = Blk0 = map_get(L, Blocks), + case block(Blk0, Blocks) of + #b_blk{last=Last0} -> + blocks(Ls, Blocks, Changed); + #b_blk{}=Blk -> + blocks(Ls, Blocks#{L:=Blk}, true) + end; +blocks([], Blocks, Changed) -> + {Blocks,Changed}. + +share_terminator(#b_br{bool=#b_var{},succ=Succ0,fail=Fail0}=Br, Blocks) -> + {Succ,SuccBlk} = shortcut_nonempty_block(Succ0, Blocks), + {Fail,FailBlk} = shortcut_nonempty_block(Fail0, Blocks), + case are_equivalent(Succ, SuccBlk, Fail, FailBlk, Blocks) of + true -> + %% The blocks are semantically equivalent. + Br#b_br{succ=Succ,fail=Succ}; + false -> + if + Succ =:= Succ0, Fail =:= Fail0 -> + %% None of blocks were cut short. + none; + true -> + %% One or both labels were cut short + %% to avoid jumping to an empty block. + Br#b_br{succ=Succ,fail=Fail} + end + end; +share_terminator(#b_switch{}=Sw, Blocks) -> + share_switch(Sw, Blocks); +share_terminator(_Last, _Blocks) -> none. + +%% Test whether the two blocks are semantically equivalent. This +%% function is specially optimized to return `false` as fast as +%% possible if the blocks are not equivalent, as that is the common +%% case. + +are_equivalent(_Succ, _, ?BADARG_BLOCK, _, _Blocks) -> + %% ?BADARG_BLOCK is special. Sharing could be incorrect. + false; +are_equivalent(_Succ, #b_blk{is=Is1,last=#b_ret{arg=RetVal1}=Ret1}, + _Fail, #b_blk{is=Is2,last=#b_ret{arg=RetVal2}=Ret2}, _Blocks) -> + case {RetVal1,RetVal2} of + {#b_literal{},#b_literal{}} -> + case RetVal1 =:= RetVal2 of + true -> + %% The return values are identical literals. We + %% only need to compare the canonicalized bodies. + Can1 = canonical_is(Is1), + Can2 = canonical_is(Is2), + Can1 =:= Can2; + false -> + %% Non-equal literals. + false + end; + {#b_var{},#b_var{}} -> + %% The return values are varibles. We must canonicalize + %% the blocks (including returns) and compare them. + Can1 = canonical_is(Is1 ++ [Ret1]), + Can2 = canonical_is(Is2 ++ [Ret2]), + Can1 =:= Can2; + {_,_} -> + %% One literal and one variable. + false + end; +are_equivalent(Succ, + #b_blk{is=Is1, + last=#b_br{bool=#b_literal{val=true}, + succ=Target}}, + Fail, + #b_blk{is=Is2, + last=#b_br{bool=#b_literal{val=true}, + succ=Target}}, + Blocks) -> + %% Both blocks end with an unconditional branch to the + %% same target block. If the target block has phi nodes, + %% we must pick up the values from the phi nodes and + %% compare them. + #b_blk{is=Is} = map_get(Target, Blocks), + Phis1 = canonical_terminator_phis(Is, Succ), + Phis2 = canonical_terminator_phis(Is, Fail), + case {Phis1,Phis2} of + {[#b_set{args=[#b_literal{}]}|_],_} when Phis1 =/= Phis2 -> + %% Different values are used in the phi nodes. + false; + {_,[#b_set{args=[#b_literal{}]}|_]} when Phis1 =/= Phis2 -> + %% Different values are used in the phi nodes. + false; + {_,_} -> + %% The values in the phi nodes are variables or identical + %% literals. We must canonicalize the blocks and compare + %% them. + Can1 = canonical_is(Is1 ++ Phis1), + Can2 = canonical_is(Is2 ++ Phis2), + Can1 =:= Can2 + end; +are_equivalent(Succ0, #b_blk{is=Is1,last=#b_br{bool=#b_var{},fail=Same}}, + Fail0, #b_blk{is=Is2,last=#b_br{bool=#b_var{},fail=Same}}, + Blocks) -> + %% Two-way branches with identical failure labels. First compare the + %% canonicalized bodies of the blocks. + case canonical_is(Is1) =:= canonical_is(Is2) of + false -> + %% Different bodies. + false; + true -> + %% Bodies were equal. That is fairly uncommon, so to keep + %% the code simple we will rewrite the `br` to a `switch` + %% and let share_switch/2 do the work of following the + %% branches. + Sw = #b_switch{arg=#b_var{name=not_used},fail=Fail0, + list=[{#b_literal{},Succ0}]}, + #b_switch{fail=Fail,list=[{_,Succ}]} = share_switch(Sw, Blocks), + Fail =:= Succ + end; +are_equivalent(_, _, _, _, _) -> false. + +share_switch(#b_switch{fail=Fail0,list=List0}=Sw, Blocks) -> + Prep = share_prepare_sw([{value,Fail0}|List0], Blocks, 0, []), + Res = do_share_switch(Prep, Blocks, []), + [{_,Fail}|List] = [VL || {_,VL} <- sort(Res)], + Sw#b_switch{fail=Fail,list=List}. + +share_prepare_sw([{V,L0}|T], Blocks, N, Acc) -> + {L,_Blk} = shortcut_nonempty_block(L0, Blocks), + share_prepare_sw(T, Blocks, N+1, [{{L,#{}},{N,{V,L}}}|Acc]); +share_prepare_sw([], _, _, Acc) -> Acc. + +do_share_switch(Prep, Blocks, Acc) -> + Map = share_switch_1(Prep, Blocks, #{}), + share_switch_2(maps:values(Map), Blocks, Acc). + +share_switch_1([{Next0,Res}|T], Blocks, Map) -> + {Can,Next} = canonical_block(Next0, Blocks), + case Map of + #{Can:=Ls} -> + share_switch_1(T, Blocks, Map#{Can:=[{Next,Res}|Ls]}); + #{} -> + share_switch_1(T, Blocks, Map#{Can=>[{Next,Res}]}) + end; +share_switch_1([], _Blocks, Map) -> Map. + +share_switch_2([[{_,{N,Res}}]|T], Blocks, Acc) -> + %% This block is not equivalent to any other block. + share_switch_2(T, Blocks, [{N,Res}|Acc]); +share_switch_2([[{done,{_,{_,Common}}}|_]=Eqs|T], Blocks, Acc0) -> + %% Two or more blocks are semantically equivalent, and all blocks + %% are either terminated with a `ret` or a `br` to the same target + %% block. Replace the labels in the `switch` for all of those + %% blocks with the label for the first of the blocks. + Acc = [{N,{V,Common}} || {done,{N,{V,_}}} <- Eqs] ++ Acc0, + share_switch_2(T, Blocks, Acc); +share_switch_2([[{_,_}|_]=Prep|T], Blocks, Acc0) -> + %% Two or more blocks are semantically equivalent, but they have + %% different successful successor blocks. Now we must check + %% recursively whether the successor blocks are equivalent too. + Acc = do_share_switch(Prep, Blocks, Acc0), + share_switch_2(T, Blocks, Acc); +share_switch_2([], _, Acc) -> Acc. + +canonical_block({L,VarMap0}, Blocks) -> + #b_blk{is=Is,last=Last0} = map_get(L, Blocks), + case canonical_terminator(L, Last0, Blocks) of + none -> + %% The block has a terminator that we don't handle. + {{none,L},done}; + {Last,done} -> + %% The block ends with a `ret` or an unconditional `br` to + %% another block. + {Can,_VarMap} = canonical_is(Is ++ Last, VarMap0, []), + {Can,done}; + {Last,Next} -> + %% The block ends with a conditional branch. + {Can,VarMap} = canonical_is(Is ++ Last, VarMap0, []), + {Can,{Next,VarMap}} + end. + +%% Translate a sequence of instructions to a canonical representation. If the +%% canonical representation of two blocks compare equal, the blocks are +%% semantically equivalent. The following translations are done: +%% +%% * Variables defined in the instruction sequence are replaced with +%% {var,0}, {var,1}, and so on. Free variables are not changed. +%% +%% * `location` annotations that would produce a `line` instruction are +%% kept. All other annotations are cleared. +%% +%% * Instructions are repackaged into tuples instead of into the +%% usual records. The main reason is to avoid violating the types for +%% the SSA records. We can simplify things a little by linking the +%% instructions directly instead of putting them into a list. + +canonical_is(Is) -> + {Can,_} = canonical_is(Is, #{}, []), + Can. + +canonical_is([#b_set{op=Op,dst=Dst,args=Args0}=I|Is], VarMap0, Acc) -> + Args = [canonical_arg(Arg, VarMap0) || Arg <-Args0], + Var = {var,map_size(VarMap0)}, + VarMap = VarMap0#{Dst=>Var}, + LineAnno = case Op of + bs_match -> + %% The location annotation for a bs_match instruction + %% is only used in warnings, never to emit a `line` + %% instruction. Therefore, it should not be included. + []; + _ -> + %% The location annotation will be used in a `line` + %% instruction. It must be included. + beam_ssa:get_anno(location, I, none) + end, + canonical_is(Is, VarMap, {Op,LineAnno,Var,Args,Acc}); +canonical_is([#b_ret{arg=Arg}], VarMap, Acc0) -> + Acc1 = case Acc0 of + {call,_Anno,Var,[#b_local{}|_]=Args,PrevAcc} -> + %% This is a tail-recursive call to a local function. + %% There will be no line instruction generated; + %% thus, the annotation is not significant. + {call,[],Var,Args,PrevAcc}; + _ -> + Acc0 + end, + {{ret,canonical_arg(Arg, VarMap),Acc1},VarMap}; +canonical_is([#b_br{bool=#b_var{}=Arg,fail=Fail}], VarMap, Acc) -> + %% A previous buggy version of this code omitted the canonicalized + %% argument in the return value. Unfortunately, that worked most + %% of the time, except when `br` terminator referenced a variable + %% defined in a previous block instead of in the same block. + {{br,canonical_arg(Arg, VarMap),succ,Fail,Acc},VarMap}; +canonical_is([#b_br{succ=Succ}], VarMap, Acc) -> + {{br,Succ,Acc},VarMap}; +canonical_is([], VarMap, Acc) -> + {Acc,VarMap}. + +canonical_terminator(_L, #b_ret{}=Ret, _Blocks) -> + {[Ret],done}; +canonical_terminator(L, #b_br{bool=#b_literal{val=true},succ=Succ}=Br, Blocks) -> + #b_blk{is=Is} = map_get(Succ, Blocks), + case canonical_terminator_phis(Is, L) of + [] -> + {[],Succ}; + [_|_]=Phis -> + {Phis ++ [Br],done} + end; +canonical_terminator(_L, #b_br{bool=#b_var{},succ=Succ}=Br, _Blocks) -> + {[Br],Succ}; +canonical_terminator(_, _, _) -> none. + +canonical_terminator_phis([#b_set{op=phi,args=PhiArgs}=Phi|Is], L) -> + {Value,L} = keyfind(L, 2, PhiArgs), + [Phi#b_set{op=copy,args=[Value]}|canonical_terminator_phis(Is, L)]; +canonical_terminator_phis([#b_set{op=peek_message}=I|_], L) -> + %% We could get stuck into an infinite loop if we allowed the + %% comparisons to continue into this block. Force an unequal + %% compare with all other predecessors of this block. + [I#b_set{op=copy,args=[#b_literal{val=L}]}]; +canonical_terminator_phis(_, _) -> []. + +canonical_arg(#b_var{}=Var, VarMap) -> + case VarMap of + #{Var:=CanonicalVar} -> + CanonicalVar; + #{} -> + Var + end; +canonical_arg(#b_remote{mod=Mod,name=Name}, VarMap) -> + {remote,canonical_arg(Mod, VarMap), + canonical_arg(Name, VarMap)}; +canonical_arg(Other, _VarMap) -> Other. + +%% Shortcut branches to empty blocks if safe. + +shortcut_nonempty_block(L, Blocks) -> + case map_get(L, Blocks) of + #b_blk{is=[],last=#b_br{bool=#b_literal{val=true},succ=Succ}}=Blk -> + %% This block is empty. + case is_forbidden(Succ, Blocks) of + false -> + shortcut_nonempty_block(Succ, Blocks); + true -> + {L,Blk} + end; + #b_blk{}=Blk -> + {L,Blk} + end. + +is_forbidden(L, Blocks) -> + case map_get(L, Blocks) of + #b_blk{is=[#b_set{op=phi}|_]} -> true; + #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + #b_blk{} -> false + end. diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl new file mode 100644 index 0000000000..3c06c83e2e --- /dev/null +++ b/lib/compiler/src/beam_ssa_type.erl @@ -0,0 +1,1967 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_ssa_type). +-export([opt_start/4, opt_continue/4, opt_finish/3]). + +-include("beam_ssa_opt.hrl"). +-import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, + keyfind/3,reverse/1,reverse/2, + sort/1,split/2]). + +-define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). + +-record(d, + {ds :: #{beam_ssa:b_var():=beam_ssa:b_set()}, + ls :: #{beam_ssa:label():=type_db()}, + once :: cerl_sets:set(beam_ssa:b_var()), + func_id :: func_id(), + func_db :: func_info_db(), + sub = #{} :: #{beam_ssa:b_var():=beam_ssa:value()}, + ret_type = [] :: [type()]}). + +-define(ATOM_SET_SIZE, 5). + +%% Records that represent type information. +-record(t_atom, {elements=any :: 'any' | [atom()]}). +-record(t_integer, {elements=any :: 'any' | {integer(),integer()}}). +-record(t_bs_match, {type :: type()}). +-record(t_tuple, {size=0 :: integer(), + exact=false :: boolean(), + %% Known element types (1-based index), unknown elements are + %% are assumed to be 'any'. + elements=#{} :: #{ non_neg_integer() => type() }}). + +-type type() :: 'any' | 'none' | + #t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} | + {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'. +-type type_db() :: #{beam_ssa:var_name():=type()}. + +-spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when + Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], + Args :: [beam_ssa:b_var()], + Anno :: beam_ssa:anno(), + FuncDb :: func_info_db(). +opt_start(Linear, Args, Anno, FuncDb) -> + %% This is the first run through the module, so our arg_types can be + %% incomplete as we may not have visited all call sites at least once. + Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), + opt_continue_1(Linear, Args, get_func_id(Anno), Ts, FuncDb). + +-spec opt_continue(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when + Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], + Args :: [beam_ssa:b_var()], + Anno :: beam_ssa:anno(), + FuncDb :: func_info_db(). +opt_continue(Linear, Args, Anno, FuncDb) -> + Id = get_func_id(Anno), + case FuncDb of + #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> + %% This is a local function and we're guaranteed to have visited + %% every call site at least once, so we know that the parameter + %% types are at least as narrow as the join of all argument types. + Ts = join_arg_types(Args, ArgTypes, Anno), + opt_continue_1(Linear, Args, Id, Ts, FuncDb); + #{} -> + %% We can't infer the parameter types of exported functions, nor + %% the ones where module-level optimization is disabled, but + %% running the pass again could still help other functions. + Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), + opt_continue_1(Linear, Args, Id, Ts, FuncDb) + end. + +join_arg_types(Args, ArgTypes, Anno) -> + %% We suppress type optimization for parameters that have already been + %% optimized by another pass, as they may have done things we have no idea + %% how to interpret and running them over could generate incorrect code. + ParamTypes = maps:get(parameter_type_info, Anno, #{}), + Ts0 = join_arg_types_1(Args, ArgTypes, #{}), + maps:fold(fun(Arg, _V, Ts) -> + maps:put(Arg, any, Ts) + end, Ts0, ParamTypes). + +join_arg_types_1([Arg | Args], [TM | TMs], Ts) when map_size(TM) =/= 0 -> + join_arg_types_1(Args, TMs, Ts#{ Arg => join(maps:values(TM))}); +join_arg_types_1([Arg | Args], [_TM | TMs], Ts) -> + join_arg_types_1(Args, TMs, Ts#{ Arg => any }); +join_arg_types_1([], [], Ts) -> + Ts. + +-spec opt_continue_1(Linear, Args, Id, Ts, FuncDb) -> Result when + Linear :: [{non_neg_integer(), beam_ssa:b_blk()}], + Args :: [beam_ssa:b_var()], + Id :: func_id(), + Ts :: type_db(), + FuncDb :: func_info_db(), + Result :: {Linear, FuncDb}. +opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) -> + UsedOnce = used_once(Linear0, Args), + FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, + name=#b_literal{val=unknown}, + arity=0}]}, + Defs = maps:from_list([{Var,FakeCall#b_set{dst=Var}} || + #b_var{}=Var <- Args]), + + D = #d{ func_db=FuncDb0, + func_id=Id, + ds=Defs, + ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, + once=UsedOnce }, + + {Linear, FuncDb, NewRet} = opt(Linear0, D, []), + + case FuncDb of + #{ Id := Entry0 } -> + Entry = Entry0#func_info{ret_type=NewRet}, + {Linear, FuncDb#{ Id := Entry }}; + #{} -> + %% Module-level optimizations have been turned off for this + %% function. + {Linear, FuncDb} + end. + +-spec opt_finish(Args, Anno, FuncDb) -> {Anno, FuncDb} when + Args :: [beam_ssa:b_var()], + Anno :: beam_ssa:anno(), + FuncDb :: func_info_db(). +opt_finish(Args, Anno, FuncDb) -> + Id = get_func_id(Anno), + case FuncDb of + #{ Id := #func_info{exported=false,arg_types=ArgTypes} } -> + ParamInfo0 = maps:get(parameter_type_info, Anno, #{}), + ParamInfo = opt_finish_1(Args, ArgTypes, ParamInfo0), + {Anno#{ parameter_type_info => ParamInfo }, FuncDb}; + #{} -> + {Anno, FuncDb} + end. + +opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo) + when is_map_key(Arg, ParamInfo); %% See join_arg_types/3 + map_size(TypeMap) =:= 0 -> + opt_finish_1(Args, TypeMaps, ParamInfo); +opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) -> + case join(maps:values(TypeMap)) of + any -> + opt_finish_1(Args, TypeMaps, ParamInfo0); + none -> + %% This function will never be called. Pretend that we don't + %% know the type for this argument. + opt_finish_1(Args, TypeMaps, ParamInfo0); + JoinedType -> + JoinedType = verified_type(JoinedType), + ParamInfo = ParamInfo0#{ Arg => validator_anno(JoinedType) }, + opt_finish_1(Args, TypeMaps, ParamInfo) + end; +opt_finish_1([], [], ParamInfo) -> + ParamInfo. + +validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) -> + Elements = maps:fold(fun(Index, Type, Acc) -> + Key = beam_validator:type_anno(integer, Index), + Acc#{ Key => validator_anno(Type) } + end, #{}, Elements0), + beam_validator:type_anno(tuple, Size, Exact, Elements); +validator_anno(#t_integer{elements={Same,Same}}) -> + beam_validator:type_anno(integer, Same); +validator_anno(#t_integer{}) -> + beam_validator:type_anno(integer); +validator_anno(float) -> + beam_validator:type_anno(float); +validator_anno(#t_atom{elements=[Val]}) -> + beam_validator:type_anno(atom, Val); +validator_anno(#t_atom{}=A) -> + case t_is_boolean(A) of + true -> beam_validator:type_anno(bool); + false -> beam_validator:type_anno(atom) + end; +validator_anno(T) -> + beam_validator:type_anno(T). + +get_func_id(Anno) -> + #{func_info:={_Mod, Name, Arity}} = Anno, + #b_local{name=#b_literal{val=Name}, arity=Arity}. + +opt([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) -> + case Ls of + #{L:=Ts} -> + opt_1(L, Blk, Bs, Ts, D, Acc); + #{} -> + %% This block is never reached. Discard it. + opt(Bs, D, Acc) + end; +opt([], D, Acc) -> + #d{func_db=FuncDb,ret_type=NewRet} = D, + {reverse(Acc), FuncDb, NewRet}. + +opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, + #d{ds=Ds0,sub=Sub0,func_db=Fdb0}=D0, Acc) -> + case opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []) of + {Is,Ts,Ds,Fdb,Sub} -> + D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, + Last1 = simplify_terminator(Last0, Sub, Ts, Ds), + Last = opt_terminator(Last1, Ts, Ds), + D = update_successors(Last, Ts, D1), + Blk = Blk0#b_blk{is=Is,last=Last}, + opt(Bs, D, [{L,Blk}|Acc]); + {no_return,Ret,Is,Ds,Fdb,Sub} -> + %% This call will never reach the successor block. + %% Rewrite the terminator to a 'ret', and remove + %% all type information for this label. That can + %% potentially narrow the type of the phi node + %% in the former successor. + Ls = maps:remove(L, D0#d.ls), + RetType = join([none|D0#d.ret_type]), + D = D0#d{ds=Ds,ls=Ls,sub=Sub, + func_db=Fdb,ret_type=[RetType]}, + Blk = Blk0#b_blk{is=Is,last=Ret}, + opt(Bs, D, [{L,Blk}|Acc]) + end. + +simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) -> + Br#b_br{bool=simplify_arg(Bool, Sub, Ts)}; +simplify_terminator(#b_switch{arg=Arg}=Sw, Sub, Ts, _Ds) -> + Sw#b_switch{arg=simplify_arg(Arg, Sub, Ts)}; +simplify_terminator(#b_ret{arg=Arg}=Ret, Sub, Ts, Ds) -> + %% Reducing the result of a call to a literal (fairly common for 'ok') + %% breaks tail call optimization. + case Ds of + #{ Arg := #b_set{op=call}} -> Ret; + #{} -> Ret#b_ret{arg=simplify_arg(Arg, Sub, Ts)} + end. + +opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], + Ts0, Ds0, Fdb, #d{ls=Ls}=D, Sub0, Acc) -> + %% Simplify the phi node by removing all predecessor blocks that no + %% longer exists or no longer branches to this block. + Args = [{simplify_arg(Arg, Sub0, Ts0),From} || + {Arg,From} <- Args0, maps:is_key(From, Ls)], + case all_same(Args) of + true -> + %% Eliminate the phi node if there is just one source + %% value or if the values are identical. + [{Val,_}|_] = Args, + Sub = Sub0#{Dst=>Val}, + opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); + false -> + I = I0#b_set{args=Args}, + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{Dst=>I}, + opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]) + end; +opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], + Ts0, Ds0, Fdb0, D, Sub0, Acc) -> + Args = simplify_args(Args0, Sub0, Ts0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + {Ts1,Ds,Fdb,I2} = opt_call(I1, D, Ts0, Ds0, Fdb0), + case {map_get(Dst, Ts1),Is} of + {Type,[#b_set{op=succeeded}]} when Type =/= none -> + %% This call instruction is inside a try/catch + %% block. Don't attempt to simplify it. + opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I2|Acc]); + {none,[#b_set{op=succeeded}]} -> + %% This call instruction is inside a try/catch + %% block, but we know it will never return and + %% later optimizations may try to exploit that. + %% + %% For example, if we have an expression that + %% either returns this call or a tuple, we know + %% that the expression always returns a tuple + %% and can turn a later element/3 into + %% get_tuple_element. + %% + %% This is sound but difficult to validate in a + %% meaningful way as try/catch currently forces + %% us to maintain the illusion that the success + %% block is reachable even when its not, so we + %% disable the optimization to keep things + %% simple. + Ts = Ts1#{ Dst := any }, + opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I2|Acc]); + {none,_} -> + %% This call never returns. The rest of the + %% instructions will not be executed. + Ret = #b_ret{arg=Dst}, + {no_return,Ret,reverse(Acc, [I2]),Ds,Fdb,Sub0}; + {_,_} -> + case simplify_call(I2) of + #b_set{}=I -> + opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I|Acc]); + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + Ts = maps:remove(Dst, Ts1), + opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc); + #b_var{}=Var -> + Ts = maps:remove(Dst, Ts1), + Sub = Sub0#{Dst=>Var}, + opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) + end + end; +opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], + Ts0, Ds0, Fdb, D, Sub0, Acc) -> + case Ds0 of + #{ Arg := #b_set{op=call} } -> + %% The success check of a call is part of exception handling and + %% must not be optimized away. We still have to update its type + %% though. + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{Dst=>I}, + + opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]); + #{} -> + Args = simplify_args([Arg], Sub0, Ts0), + Type = type(succeeded, Args, Ts0, Ds0), + case get_literal_from_type(Type) of + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); + none -> + Ts = Ts0#{Dst=>Type}, + Ds = Ds0#{Dst=>I}, + opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]) + end + end; +opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], + Ts0, Ds0, Fdb, D, Sub0, Acc) -> + Args = simplify_args(Args0, Sub0, Ts0), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + case simplify(I1, Ts0) of + #b_set{}=I2 -> + I = beam_ssa:normalize(I2), + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{Dst=>I}, + opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]); + #b_literal{}=Lit -> + Sub = Sub0#{Dst=>Lit}, + opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); + #b_var{}=Var -> + case Is of + [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] -> + %% We must remove this 'succeeded' instruction. + Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, + opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); + _ -> + Sub = Sub0#{Dst=>Var}, + opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc) + end + end; +opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) -> + {reverse(Acc), Ts, Ds, Fdb, Sub}. + +simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) -> + case Rem of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}} -> + case erl_bifs:is_pure(Mod, Name, length(Args)) of + true -> + simplify_remote_call(Mod, Name, Args, I); + false -> + I + end; + #b_remote{} -> + I + end; +simplify_call(I) -> I. + +%% Simplify a remote call to a pure BIF. +simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> + Tl; +simplify_remote_call(erlang, setelement, + [#b_literal{val=Pos}, + #b_literal{val=Tuple}, + #b_var{}=Value], I) + when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> + %% Position is a literal integer and the shape of the + %% tuple is known. + Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], + {Bef,[_|Aft]} = split(Pos - 1, Els0), + Els = Bef ++ [Value|Aft], + I#b_set{op=put_tuple,args=Els}; +simplify_remote_call(Mod, Name, Args0, I) -> + case make_literal_list(Args0) of + none -> + I; + Args -> + %% The arguments are literals. Try to evaluate the BIF. + try apply(Mod, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + #b_literal{val=Val}; + false -> + %% The value can't be expressed as a literal + %% (e.g. a pid). + I + end + catch + _:_ -> + %% Failed. Don't bother trying to optimize + %% the call. + I + end + end. + +opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> + {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), + case Fdb0 of + #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + %% Update the argument types of *this exact call*, the types + %% will be joined later when the callee is optimized. + CallId = {D#d.func_id, Dst}, + ArgTypes = update_arg_types(Args, ArgTypes0, CallId, Ts0), + + Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, + {Ts, Ds, Fdb, I}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. + {Ts, Ds, Fdb0, I} + end; +opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> + Ts = update_types(I, Ts0, Ds0), + Ds = Ds0#{ Dst => I }, + {Ts, Ds, Fdb, I}. + +opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> + Type = case Fdb of + #{ Id := #func_info{ret_type=[T]} } -> T; + #{} -> any + end, + I = case Type of + any -> I0; + none -> I0; + _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0) + end, + Ts = Ts0#{ Dst => Type }, + Ds = Ds0#{ Dst => I }, + {Ts, Ds, I}. + +update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> + %% Match contexts are treated as bitstrings when optimizing arguments, as + %% we don't yet support removing the "bs_start_match3" instruction. + NewType = case get_type(Arg, Ts) of + #t_bs_match{} -> {binary, 1}; + Type -> Type + end, + TypeMap = TypeMap0#{ CallId => NewType }, + [TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)]; +update_arg_types([], [], _CallId, _Ts) -> + []. + +simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> + case is_safe_bool_op(Args, Ts) of + true -> + case Args of + [_,#b_literal{val=false}=Res] -> Res; + [Res,#b_literal{val=true}] -> Res; + _ -> eval_bif(I, Ts) + end; + false -> + I + end; +simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) -> + case is_safe_bool_op(Args, Ts) of + true -> + case Args of + [Res,#b_literal{val=false}] -> Res; + [_,#b_literal{val=true}=Res] -> Res; + _ -> eval_bif(I, Ts) + end; + false -> + I + end; +simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> + case t_tuple_size(get_type(Tuple, Ts)) of + {_,Size} when is_integer(Index), 1 =< Index, Index =< Size -> + I = I0#b_set{op=get_tuple_element, + args=[Tuple,#b_literal{val=Index-1}]}, + simplify(I, Ts); + _ -> + eval_bif(I0, Ts) + end; +simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) -> + case get_type(List, Ts) of + cons -> + I#b_set{op=get_hd}; + _ -> + eval_bif(I, Ts) + end; +simplify(#b_set{op={bif,tl},args=[List]}=I, Ts) -> + case get_type(List, Ts) of + cons -> + I#b_set{op=get_tl}; + _ -> + eval_bif(I, Ts) + end; +simplify(#b_set{op={bif,size},args=[Term]}=I, Ts) -> + case get_type(Term, Ts) of + #t_tuple{} -> + simplify(I#b_set{op={bif,tuple_size}}, Ts); + _ -> + eval_bif(I, Ts) + end; +simplify(#b_set{op={bif,tuple_size},args=[Term]}=I, Ts) -> + case get_type(Term, Ts) of + #t_tuple{size=Size,exact=true} -> + #b_literal{val=Size}; + _ -> + I + end; +simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) -> + Types = get_types(Args, Ts), + EqEq = case {meet(Types),join(Types)} of + {none,any} -> true; + {#t_integer{},#t_integer{}} -> true; + {float,float} -> true; + {{binary,_},_} -> true; + {#t_atom{},_} -> true; + {_,_} -> false + end, + case EqEq of + true -> + simplify(I#b_set{op={bif,'=:='}}, Ts); + false -> + eval_bif(I, Ts) + end; +simplify(#b_set{op={bif,'=:='},args=[Same,Same]}, _Ts) -> + #b_literal{val=true}; +simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) -> + [T1,T2] = get_types(Args, Ts), + case meet(T1, T2) of + none -> + #b_literal{val=false}; + _ -> + case {t_is_boolean(T1),T2} of + {true,#t_atom{elements=[true]}} -> + %% Bool =:= true ==> Bool + A1; + {_,_} -> + eval_bif(I, Ts) + end + end; +simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> + Types = get_types(Args, Ts), + case is_float_op(Op, Types) of + false -> + eval_bif(I, Ts); + true -> + AnnoArgs = [anno_float_arg(A) || A <- Types], + eval_bif(beam_ssa:add_anno(float_op, AnnoArgs, I), Ts) + end; +simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> + case get_type(Tuple, Ts) of + #t_tuple{size=Size,elements=Es} when Size > N -> + ElemType = get_element_type(N + 1, Es), + case get_literal_from_type(ElemType) of + #b_literal{}=Lit -> Lit; + none -> I + end; + none -> + %% Will never be executed because of type conflict. + %% #b_literal{val=ignored}; + I + end; +simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> + case get_type(Src, Ts) of + any -> I; + list -> I; + cons -> #b_literal{val=true}; + _ -> #b_literal{val=false} + end; +simplify(#b_set{op=is_tagged_tuple, + args=[Src,#b_literal{val=Size},#b_literal{}=Tag]}=I, Ts) -> + simplify_is_record(I, get_type(Src, Ts), Size, Tag, Ts); +simplify(#b_set{op=put_list,args=[#b_literal{val=H}, + #b_literal{val=T}]}, _Ts) -> + #b_literal{val=[H|T]}; +simplify(#b_set{op=put_tuple,args=Args}=I, _Ts) -> + case make_literal_list(Args) of + none -> I; + List -> #b_literal{val=list_to_tuple(List)} + end; +simplify(#b_set{op=wait_timeout,args=[#b_literal{val=0}]}, _Ts) -> + #b_literal{val=true}; +simplify(#b_set{op=wait_timeout,args=[#b_literal{val=infinity}]}=I, _Ts) -> + I#b_set{op=wait,args=[]}; +simplify(I, _Ts) -> I. + +make_literal_list(Args) -> + make_literal_list(Args, []). + +make_literal_list([#b_literal{val=H}|T], Acc) -> + make_literal_list(T, [H|Acc]); +make_literal_list([_|_], _) -> + none; +make_literal_list([], Acc) -> + reverse(Acc). + +is_safe_bool_op(Args, Ts) -> + [T1,T2] = get_types(Args, Ts), + t_is_boolean(T1) andalso t_is_boolean(T2). + +all_same([{H,_}|T]) -> + all(fun({E,_}) -> E =:= H end, T). + +eval_bif(#b_set{op={bif,Bif},args=Args}=I, Ts) -> + Arity = length(Args), + case erl_bifs:is_pure(erlang, Bif, Arity) of + false -> + I; + true -> + case make_literal_list(Args) of + none -> + case get_types(Args, Ts) of + [any] -> + I; + [Type] -> + case will_succeed(Bif, Type) of + yes -> + #b_literal{val=true}; + no -> + #b_literal{val=false}; + maybe -> + I + end; + _ -> + I + end; + LitArgs -> + try apply(erlang, Bif, LitArgs) of + Val -> #b_literal{val=Val} + catch + error:_ -> I + end + + end + end. + +simplify_args(Args, Sub, Ts) -> + [simplify_arg(Arg, Sub, Ts) || Arg <- Args]. + +simplify_arg(#b_var{}=Arg0, Sub, Ts) -> + case sub_arg(Arg0, Sub) of + #b_literal{}=LitArg -> + LitArg; + #b_var{}=Arg -> + Type = get_type(Arg, Ts), + case get_literal_from_type(Type) of + none -> Arg; + #b_literal{}=Lit -> Lit + end + end; +simplify_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub, Ts) -> + Rem#b_remote{mod=simplify_arg(Mod, Sub, Ts), + name=simplify_arg(Name, Sub, Ts)}; +simplify_arg(Arg, _Sub, _Ts) -> Arg. + +sub_arg(#b_var{}=Old, Sub) -> + case Sub of + #{Old:=New} -> New; + #{} -> Old + end. + +is_float_op('-', [float]) -> + true; +is_float_op('/', [_,_]) -> + true; +is_float_op(Op, [float,_Other]) -> + is_float_op_1(Op); +is_float_op(Op, [_Other,float]) -> + is_float_op_1(Op); +is_float_op(_, _) -> false. + +is_float_op_1('+') -> true; +is_float_op_1('-') -> true; +is_float_op_1('*') -> true; +is_float_op_1(_) -> false. + +anno_float_arg(float) -> float; +anno_float_arg(_) -> convert. + +opt_terminator(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> + beam_ssa:normalize(Br); +opt_terminator(#b_br{bool=#b_var{}}=Br, Ts, Ds) -> + simplify_not(Br, Ts, Ds); +opt_terminator(#b_switch{arg=#b_literal{}}=Sw, _Ts, _Ds) -> + beam_ssa:normalize(Sw); +opt_terminator(#b_switch{arg=#b_var{}=V}=Sw, Ts, Ds) -> + case get_type(V, Ts) of + any -> + beam_ssa:normalize(Sw); + Type -> + beam_ssa:normalize(opt_switch(Sw, Type, Ts, Ds)) + end; +opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. + + +opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) -> + List = prune_switch_list(List0, Fail, Type, Ts), + Sw1 = Sw0#b_switch{list=List}, + case Type of + #t_integer{elements={_,_}=Range} -> + simplify_switch_int(Sw1, Range); + #t_atom{elements=[_|_]} -> + case t_is_boolean(Type) of + true -> + #b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds), + opt_terminator(Br, Ts, Ds); + false -> + simplify_switch_atom(Type, Sw1) + end; + _ -> + Sw1 + end. + +prune_switch_list([{_,Fail}|T], Fail, Type, Ts) -> + prune_switch_list(T, Fail, Type, Ts); +prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) -> + case meet(get_type(Arg, Ts), Type) of + none -> + %% Different types. This value can never match. + prune_switch_list(T, Fail, Type, Ts); + _ -> + [Pair|prune_switch_list(T, Fail, Type, Ts)] + end; +prune_switch_list([], _, _, _) -> []. + +update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) -> + update_successor(S, Ts, D); +update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> + case cerl_sets:is_element(Bool, D0#d.once) of + true -> + %% This variable is defined in this block and is only + %% referenced by this br terminator. Therefore, there is + %% no need to include it in the type database passed on to + %% the successors of this block. + Ts = maps:remove(Bool, Ts0), + {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), + D = update_successor(Fail, FailTs, D0), + update_successor(Succ, SuccTs, D); + false -> + {SuccTs,FailTs} = infer_types_br(Bool, Ts0, D0), + D = update_successor_bool(Bool, false, Fail, FailTs, D0), + update_successor_bool(Bool, true, Succ, SuccTs, D) + end; +update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) -> + case cerl_sets:is_element(V, D0#d.once) of + true -> + %% This variable is defined in this block and is only + %% referenced by this switch terminator. Therefore, there is + %% no need to include it in the type database passed on to + %% the successors of this block. + D = update_successor(Fail, Ts, D0), + F = fun({Val,S}, A) -> + SuccTs0 = infer_types_switch(V, Val, Ts, D), + SuccTs = maps:remove(V, SuccTs0), + update_successor(S, SuccTs, A) + end, + foldl(F, D, List); + false -> + %% V can not be equal to any of the values in List at the fail + %% block. + FailTs = subtract_sw_list(V, List, Ts), + D = update_successor(Fail, FailTs, D0), + F = fun({Val,S}, A) -> + SuccTs = infer_types_switch(V, Val, Ts, D), + update_successor(S, SuccTs, A) + end, + foldl(F, D, List) + end; +update_successors(#b_ret{arg=Arg}, Ts, D) -> + FuncId = D#d.func_id, + case D#d.ds of + #{ Arg := #b_set{op=call,args=[FuncId | _]} } -> + %% Returning a call to ourselves doesn't affect our own return + %% type. + D; + #{} -> + RetType = join([get_type(Arg, Ts) | D#d.ret_type]), + D#d{ret_type=[RetType]} + end. + +subtract_sw_list(V, List, Ts) -> + Ts#{ V := sub_sw_list_1(get_type(V, Ts), List, Ts) }. + +sub_sw_list_1(Type, [{Val,_}|T], Ts) -> + ValType = get_type(Val, Ts), + sub_sw_list_1(subtract(Type, ValType), T, Ts); +sub_sw_list_1(Type, [], _Ts) -> + Type. + +update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> + case t_is_boolean(get_type(Var, Ts)) of + true -> + update_successor(S, Ts#{Var:=t_atom(BoolValue)}, D); + false -> + %% The `br` terminator is preceeded by an instruction that + %% does not produce a boolean value, such a `new_try_tag`. + update_successor(S, Ts, D) + end. + +update_successor(?BADARG_BLOCK, _Ts, #d{}=D) -> + %% We KNOW that no variables are used in the ?BADARG_BLOCK, + %% so there is no need to update the type information. That + %% can be a huge timesaver for huge functions. + D; +update_successor(S, Ts0, #d{ls=Ls}=D) -> + case Ls of + #{S:=Ts1} -> + Ts = join_types(Ts0, Ts1), + D#d{ls=Ls#{S:=Ts}}; + #{} -> + D#d{ls=Ls#{S=>Ts0}} + end. + +update_types(#b_set{op=Op,dst=Dst,args=Args}, Ts, Ds) -> + T = type(Op, Args, Ts, Ds), + Ts#{Dst=>T}. + +type(phi, Args, Ts, _Ds) -> + Types = [get_type(A, Ts) || {A,_} <- Args], + join(Types); +type({bif,'band'}, Args, Ts, _Ds) -> + band_type(Args, Ts); +type({bif,Bif}, Args, Ts, _Ds) -> + case bif_type(Bif, Args) of + number -> + arith_op_type(Args, Ts); + Type -> + Type + end; +type(bs_init, _Args, _Ts, _Ds) -> + {binary, 1}; +type(bs_extract, [Ctx], Ts, _Ds) -> + #t_bs_match{type=Type} = get_type(Ctx, Ts), + Type; +type(bs_match, Args, _Ts, _Ds) -> + #t_bs_match{type=bs_match_type(Args)}; +type(bs_get_tail, _Args, _Ts, _Ds) -> + {binary, 1}; +type(call, [#b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}}|Args], Ts, _Ds) -> + case {Mod,Name,Args} of + {erlang,setelement,[Pos,Tuple,Arg]} -> + case {get_type(Pos, Ts),get_type(Tuple, Ts)} of + {#t_integer{elements={Index,Index}}, + #t_tuple{elements=Es0,size=Size}=T} -> + %% This is an exact index, update the type of said element + %% or return 'none' if it's known to be out of bounds. + Es = set_element_type(Index, get_type(Arg, Ts), Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{size=max(Index, Size),elements=Es}; + true when Index =< Size -> + T#t_tuple{elements=Es}; + true -> + none + end; + {#t_integer{elements={Min,_}}=IntType, + #t_tuple{elements=Es0,size=Size}=T} -> + %% Remove type information for all indices that + %% falls into the range of the integer. + Es = remove_element_info(IntType, Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{elements=Es,size=max(Min, Size)}; + true when Min =< Size -> + T#t_tuple{elements=Es,size=Size}; + true -> + none + end; + {_,#t_tuple{}=T} -> + %% Position unknown, so we have to discard all element + %% information. + T#t_tuple{elements=#{}}; + {#t_integer{elements={Min,_Max}},_} -> + #t_tuple{size=Min}; + {_,_} -> + #t_tuple{} + end; + {erlang,'++',[LHS,RHS]} -> + LType = get_type(LHS, Ts), + RType = get_type(RHS, Ts), + case LType =:= cons orelse RType =:= cons of + true -> + cons; + false -> + %% `[] ++ RHS` yields RHS, even if RHS is not a list. + join(list, RType) + end; + {erlang,'--',[_,_]} -> + list; + {lists,F,Args} -> + Types = get_types(Args, Ts), + lists_function_type(F, Types); + {math,_,_} -> + case is_math_bif(Name, length(Args)) of + false -> any; + true -> float + end; + {_,_,_} -> + case erl_bifs:is_exit_bif(Mod, Name, length(Args)) of + true -> none; + false -> any + end + end; +type(get_tuple_element, [Tuple, Offset], Ts, _Ds) -> + #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts), + #b_literal{val=N} = Offset, + true = Size > N, %Assertion. + get_element_type(N + 1, Es); +type(is_nonempty_list, [_], _Ts, _Ds) -> + t_boolean(); +type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) -> + t_boolean(); +type(put_map, _Args, _Ts, _Ds) -> + map; +type(put_list, _Args, _Ts, _Ds) -> + cons; +type(put_tuple, Args, Ts, _Ds) -> + {Es, _} = foldl(fun(Arg, {Es0, Index}) -> + Type = get_type(Arg, Ts), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, Args), + #t_tuple{exact=true,size=length(Args),elements=Es}; +type(succeeded, [#b_var{}=Src], Ts, Ds) -> + case maps:get(Src, Ds) of + #b_set{op={bif,Bif},args=BifArgs} -> + Types = get_types(BifArgs, Ts), + case {Bif,Types} of + {BoolOp,[T1,T2]} when BoolOp =:= 'and'; BoolOp =:= 'or' -> + case t_is_boolean(T1) andalso t_is_boolean(T2) of + true -> t_atom(true); + false -> t_boolean() + end; + {byte_size,[{binary,_}]} -> + t_atom(true); + {bit_size,[{binary,_}]} -> + t_atom(true); + {map_size,[map]} -> + t_atom(true); + {'not',[Type]} -> + case t_is_boolean(Type) of + true -> t_atom(true); + false -> t_boolean() + end; + {size,[{binary,_}]} -> + t_atom(true); + {tuple_size,[#t_tuple{}]} -> + t_atom(true); + {_,_} -> + t_boolean() + end; + #b_set{op=get_hd} -> + t_atom(true); + #b_set{op=get_tl} -> + t_atom(true); + #b_set{op=get_tuple_element} -> + t_atom(true); + #b_set{op=wait} -> + t_atom(false); + #b_set{} -> + t_boolean() + end; +type(succeeded, [#b_literal{}], _Ts, _Ds) -> + t_atom(true); +type(_, _, _, _) -> any. + +arith_op_type(Args, Ts) -> + Types = get_types(Args, Ts), + foldl(fun(#t_integer{}, unknown) -> t_integer(); + (#t_integer{}, number) -> number; + (#t_integer{}, float) -> float; + (#t_integer{}, #t_integer{}) -> t_integer(); + (float, unknown) -> float; + (float, #t_integer{}) -> float; + (float, number) -> float; + (number, unknown) -> number; + (number, #t_integer{}) -> number; + (number, float) -> float; + (any, _) -> number; + (Same, Same) -> Same; + (_, _) -> none + end, unknown, Types). + +lists_function_type(F, Types) -> + case {F,Types} of + %% Functions that return booleans. + {all,[_,_]} -> + t_boolean(); + {any,[_,_]} -> + t_boolean(); + {keymember,[_,_,_]} -> + t_boolean(); + {member,[_,_]} -> + t_boolean(); + {prefix,[_,_]} -> + t_boolean(); + {suffix,[_,_]} -> + t_boolean(); + + %% Functions that return lists. + {dropwhile,[_,_]} -> + list; + {duplicate,[_,_]} -> + list; + {filter,[_,_]} -> + list; + {flatten,[_]} -> + list; + {map,[_Fun,List]} -> + same_length_type(List); + {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; + MapFold =:= mapfoldr -> + #t_tuple{size=2,exact=true, + elements=#{1=>same_length_type(List)}}; + {partition,[_,_]} -> + t_two_tuple(list, list); + {reverse,[List]} -> + same_length_type(List); + {sort,[List]} -> + same_length_type(List); + {splitwith,[_,_]} -> + t_two_tuple(list, list); + {takewhile,[_,_]} -> + list; + {unzip,[List]} -> + ListType = same_length_type(List), + t_two_tuple(ListType, ListType); + {usort,[List]} -> + same_length_type(List); + {zip,[_,_]} -> + list; + {zipwith,[_,_,_]} -> + list; + {_,_} -> + any + end. + +%% For a lists function that return a list of the same +%% length as the input list, return the type of the list. +same_length_type(cons) -> cons; +same_length_type(nil) -> nil; +same_length_type(_) -> list. + +t_two_tuple(Type1, Type2) -> + #t_tuple{size=2,exact=true, + elements=#{1=>Type1,2=>Type2}}. + +%% 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 + #t_atom{} -> 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_bitstring, Type) -> + case Type of + {binary,_} -> yes; + _ -> no + end; +will_succeed(is_boolean, Type) -> + case Type of + #t_atom{elements=any} -> + maybe; + #t_atom{elements=Es} -> + case t_is_boolean(Type) of + true -> + yes; + false -> + case any(fun is_boolean/1, Es) of + true -> maybe; + false -> no + end + end; + _ -> + no + end; +will_succeed(is_float, Type) -> + case Type of + float -> yes; + number -> maybe; + _ -> no + end; +will_succeed(is_integer, Type) -> + case Type of + #t_integer{} -> yes; + number -> maybe; + _ -> no + end; +will_succeed(is_list, Type) -> + case Type of + list -> yes; + cons -> yes; + _ -> no + end; +will_succeed(is_map, Type) -> + case Type of + map -> yes; + _ -> no + end; +will_succeed(is_number, Type) -> + case Type of + float -> yes; + #t_integer{} -> yes; + number -> yes; + _ -> no + end; +will_succeed(is_tuple, Type) -> + case Type of + #t_tuple{} -> yes; + _ -> no + end; +will_succeed(_, _) -> maybe. + + +band_type([Other,#b_literal{val=Int}], Ts) when is_integer(Int) -> + band_type_1(Int, Other, Ts); +band_type([_,_], _) -> t_integer(). + +band_type_1(Int, OtherSrc, Ts) -> + Type = band_type_2(Int, 0), + OtherType = get_type(OtherSrc, Ts), + meet(Type, OtherType). + +band_type_2(N, Bits) when Bits < 64 -> + case 1 bsl Bits of + P when P =:= N + 1 -> + t_integer(0, N); + P when P > N + 1 -> + t_integer(); + _ -> + band_type_2(N, Bits+1) + end; +band_type_2(_, _) -> + %% Negative or large positive number. Give up. + t_integer(). + +bs_match_type([#b_literal{val=Type}|Args]) -> + bs_match_type(Type, Args). + +bs_match_type(binary, Args) -> + [_,_,_,#b_literal{val=U}] = Args, + {binary,U}; +bs_match_type(float, _) -> + float; +bs_match_type(integer, Args) -> + case Args of + [_, + #b_literal{val=Flags}, + #b_literal{val=Size}, + #b_literal{val=Unit}] when Size * Unit < 64 -> + NumBits = Size * Unit, + case member(unsigned, Flags) of + true -> + t_integer(0, (1 bsl NumBits)-1); + false -> + %% Signed integer. Don't bother. + t_integer() + end; + [_|_] -> + t_integer() + end; +bs_match_type(skip, _) -> + any; +bs_match_type(string, _) -> + any; +bs_match_type(utf8, _) -> + ?UNICODE_INT; +bs_match_type(utf16, _) -> + ?UNICODE_INT; +bs_match_type(utf32, _) -> + ?UNICODE_INT. + +simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) -> + case sort([A || {#b_literal{val=A},_} <- List0]) of + Atoms -> + %% All possible atoms are included in the list. The + %% failure label will never be used. + [{_,Fail}|List] = List0, + Sw#b_switch{fail=Fail,list=List}; + _ -> + Sw + end. + +simplify_switch_int(#b_switch{list=List0}=Sw, {Min,Max}) -> + List1 = sort(List0), + Vs = [V || {#b_literal{val=V},_} <- List1], + case eq_ranges(Vs, Min, Max) of + true -> + {_,LastL} = last(List1), + List = droplast(List1), + Sw#b_switch{fail=LastL,list=List}; + false -> + Sw + end. + +eq_ranges([H], H, H) -> true; +eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); +eq_ranges(_, _, _) -> false. + +simplify_is_record(I, #t_tuple{exact=Exact, + size=Size, + elements=Es}, + RecSize, RecTag, Ts) -> + TagType = maps:get(1, Es, any), + TagMatch = case get_literal_from_type(TagType) of + #b_literal{}=RecTag -> yes; + #b_literal{} -> no; + none -> + %% Is it at all possible for the tag to match? + case meet(get_type(RecTag, Ts), TagType) of + none -> no; + _ -> maybe + end + end, + if + Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no -> + #b_literal{val=false}; + Size =:= RecSize, Exact, TagMatch =:= yes -> + #b_literal{val=true}; + true -> + I + end; +simplify_is_record(I, any, _Size, _Tag, _Ts) -> + I; +simplify_is_record(_I, _Type, _Size, _Tag, _Ts) -> + #b_literal{val=false}. + +simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds) -> + FalseVal = #b_literal{val=false}, + TrueVal = #b_literal{val=true}, + List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}], + {_,FalseLbl} = keyfind(FalseVal, 1, List1), + {_,TrueLbl} = keyfind(TrueVal, 1, List1), + Br = beam_ssa:normalize(#b_br{bool=B,succ=TrueLbl,fail=FalseLbl}), + simplify_not(Br, Ts, Ds). + +simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> + case Ds of + #{V:=#b_set{op={bif,'not'},args=[Bool]}} -> + case t_is_boolean(get_type(Bool, Ts)) of + true -> + Br = Br0#b_br{bool=Bool,succ=Fail,fail=Succ}, + beam_ssa:normalize(Br); + false -> + Br0 + end; + #{} -> + Br0 + end; +simplify_not(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> Br. + +%%% +%%% Calculate the set of variables that are only used once in the +%%% terminator of the block that defines them. That will allow us to +%%% discard type information for variables that will never be +%%% referenced by the successor blocks, potentially improving +%%% compilation times. +%%% + +used_once(Linear, Args) -> + Map0 = used_once_1(reverse(Linear), #{}), + Map = maps:without(Args, Map0), + cerl_sets:from_list(maps:keys(Map)). + +used_once_1([{L,#b_blk{is=Is,last=Last}}|Bs], Uses0) -> + Uses1 = used_once_last_uses(beam_ssa:used(Last), L, Uses0), + Uses = used_once_2(reverse(Is), L, Uses1), + used_once_1(Bs, Uses); +used_once_1([], Uses) -> Uses. + +used_once_2([#b_set{dst=Dst}=I|Is], L, Uses0) -> + Uses = used_once_uses(beam_ssa:used(I), L, Uses0), + case Uses of + #{Dst:=[L]} -> + used_once_2(Is, L, Uses); + #{} -> + %% Used more than once or used once in + %% in another block. + used_once_2(Is, L, maps:remove(Dst, Uses)) + end; +used_once_2([], _, Uses) -> Uses. + +used_once_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=more_than_once} -> + used_once_uses(Vs, L, Uses); + #{} -> + %% Already used or first use is not in + %% a terminator. + used_once_uses(Vs, L, Uses#{V=>more_than_once}) + end; +used_once_uses([], _, Uses) -> Uses. + +used_once_last_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=[_]} -> + %% Second time this variable is used. + used_once_last_uses(Vs, L, Uses#{V:=more_than_once}); + #{V:=more_than_once} -> + %% Used at least twice before. + used_once_last_uses(Vs, L, Uses); + #{} -> + %% First time this variable is used. + used_once_last_uses(Vs, L, Uses#{V=>[L]}) + end; +used_once_last_uses([], _, Uses) -> Uses. + + +get_types(Values, Ts) -> + [get_type(Val, Ts) || Val <- Values]. +-spec get_type(beam_ssa:value(), type_db()) -> type(). + +get_type(#b_var{}=V, Ts) -> + #{V:=T} = Ts, + T; +get_type(#b_literal{val=Val}, _Ts) -> + if + is_atom(Val) -> + t_atom(Val); + is_float(Val) -> + float; + is_integer(Val) -> + t_integer(Val); + is_list(Val), Val =/= [] -> + cons; + is_map(Val) -> + map; + Val =:= {} -> + #t_tuple{exact=true}; + is_tuple(Val) -> + {Es, _} = foldl(fun(E, {Es0, Index}) -> + Type = get_type(#b_literal{val=E}, #{}), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(Val)), + #t_tuple{exact=true,size=tuple_size(Val),elements=Es}; + Val =:= [] -> + nil; + true -> + any + end. + +%% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes} +%% Looking at the expression that defines the variable Var, infer +%% the types for the variables in the arguments. Return the updated +%% type database for the case that the expression evaluates to +%% true, and and for the case that it evaluates to false. +%% +%% Here is an example. The variable being asked about is +%% the variable Bool, which is defined like this: +%% +%% Bool = is_nonempty_list L +%% +%% If 'is_nonempty_list L' evaluates to 'true', L must +%% must be cons. The meet of the previously known type of L and 'cons' +%% will be added to SuccTypes. +%% +%% On the other hand, if 'is_nonempty_list L' evaluates to false, L +%% is not cons and cons can be subtracted from the previously known +%% type for L. For example, if L was known to be 'list', subtracting +%% 'cons' would give 'nil' as the only possible type. The result of the +%% subtraction for L will be added to FailTypes. + +infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> + #{V:=#b_set{op=Op,args=Args}} = Ds, + PosTypes0 = infer_type(Op, Args, Ds), + NegTypes0 = infer_type_negative(Op, Args, Ds), + + %% We must be careful with types inferred from '=:='. + %% + %% If we have seen L =:= [a], we know that L is 'cons' if the + %% comparison succeeds. However, if the comparison fails, L could + %% still be 'cons'. Therefore, we must not subtract 'cons' from the + %% previous type of L. + %% + %% However, it is safe to subtract a type inferred from '=:=' if + %% it is single-valued, e.g. if it is [] or the atom 'true'. + + EqTypes = infer_eq_type(Op, Args, Ts, Ds), + NegTypes1 = [P || {_,T}=P <- EqTypes, is_singleton_type(T)], + + PosTypes = EqTypes ++ PosTypes0, + SuccTs = meet_types(PosTypes, Ts), + + NegTypes = NegTypes0 ++ NegTypes1, + FailTs = subtract_types(NegTypes, Ts), + + {SuccTs,FailTs}. + +infer_types_switch(V, Lit, Ts, #d{ds=Ds}) -> + Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds), + meet_types(Types, Ts). + +infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> + Def = maps:get(Src, Ds), + Type = get_type(Lit, Ts), + [{Src,Type} | infer_eq_lit(Def, Lit)]; +infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> + %% As an example, assume that L1 is known to be 'list', and L2 is + %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can + %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). + Type0 = get_type(Arg0, Ts), + Type1 = get_type(Arg1, Ts), + Type = meet(Type0, Type1), + [{V,MeetType} || + {V,OrigType,MeetType} <- + [{Arg0,Type0,Type},{Arg1,Type1,Type}], + OrigType =/= MeetType]; +infer_eq_type(_Op, _Args, _Ts, _Ds) -> + []. + +infer_eq_lit(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, + #b_literal{val=Size}) when is_integer(Size) -> + [{Tuple,#t_tuple{exact=true,size=Size}}]; +infer_eq_lit(#b_set{op=get_tuple_element, + args=[#b_var{}=Tuple,#b_literal{val=N}]}, + #b_literal{}=Lit) -> + Index = N + 1, + Es = set_element_type(Index, get_type(Lit, #{}), #{}), + [{Tuple,#t_tuple{size=Index,elements=Es}}]; +infer_eq_lit(_, _) -> []. + +infer_type_negative(Op, Args, Ds) -> + case is_negative_inference_safe(Op, Args) of + true -> + infer_type(Op, Args, Ds); + false -> + [] + end. + +%% Conservative list of instructions for which negative +%% inference is safe. +is_negative_inference_safe(is_nonempty_list, _Args) -> true; +is_negative_inference_safe(_, _) -> false. + +infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> + if + is_integer(Pos), 1 =< Pos -> + [{Tuple,#t_tuple{size=Pos}}]; + true -> + [] + end; +infer_type({bif,element}, [#b_var{}=Position,#b_var{}=Tuple], _Ds) -> + [{Position,t_integer()},{Tuple,#t_tuple{}}]; +infer_type({bif,Bif}, [#b_var{}=Src]=Args, _Ds) -> + case inferred_bif_type(Bif, Args) of + any -> []; + T -> [{Src,T}] + end; +infer_type({bif,binary_part}, [#b_var{}=Src,_], _Ds) -> + [{Src,{binary,8}}]; +infer_type({bif,is_map_key}, [_,#b_var{}=Src], _Ds) -> + [{Src,map}]; +infer_type({bif,map_get}, [_,#b_var{}=Src], _Ds) -> + [{Src,map}]; +infer_type({bif,Bif}, [_,_]=Args, _Ds) -> + case inferred_bif_type(Bif, Args) of + any -> []; + T -> [{A,T} || #b_var{}=A <- Args] + end; +infer_type({bif,binary_part}, [#b_var{}=Src,Pos,Len], _Ds) -> + [{Src,{binary,8}}| + [{V,t_integer()} || #b_var{}=V <- [Pos,Len]]]; +infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> + [{Bin,{binary,1}}]; +infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> + [{Src,cons}]; +infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, + #b_literal{}=Tag], _Ds) -> + Es = set_element_type(1, get_type(Tag, #{}), #{}), + [{Src,#t_tuple{exact=true,size=Size,elements=Es}}]; +infer_type(succeeded, [#b_var{}=Src], Ds) -> + #b_set{op=Op,args=Args} = maps:get(Src, Ds), + infer_type(Op, Args, Ds); +infer_type(_Op, _Args, _Ds) -> + []. + +%% bif_type(Name, Args) -> Type +%% Return the return type for the guard BIF or operator Name with +%% arguments Args. +%% +%% Note that that the following BIFs are handle elsewhere: +%% +%% band/2 + +bif_type(abs, [_]) -> number; +bif_type(bit_size, [_]) -> t_integer(); +bif_type(byte_size, [_]) -> t_integer(); +bif_type(ceil, [_]) -> t_integer(); +bif_type(float, [_]) -> float; +bif_type(floor, [_]) -> t_integer(); +bif_type(is_map_key, [_,_]) -> t_boolean(); +bif_type(length, [_]) -> t_integer(); +bif_type(map_size, [_]) -> t_integer(); +bif_type(node, []) -> #t_atom{}; +bif_type(node, [_]) -> #t_atom{}; +bif_type(round, [_]) -> t_integer(); +bif_type(size, [_]) -> t_integer(); +bif_type(trunc, [_]) -> t_integer(); +bif_type(tuple_size, [_]) -> t_integer(); +bif_type('bnot', [_]) -> t_integer(); +bif_type('bor', [_,_]) -> t_integer(); +bif_type('bsl', [_,_]) -> t_integer(); +bif_type('bsr', [_,_]) -> t_integer(); +bif_type('bxor', [_,_]) -> t_integer(); +bif_type('div', [_,_]) -> t_integer(); +bif_type('rem', [_,_]) -> t_integer(); +bif_type('/', [_,_]) -> float; +bif_type(Name, Args) -> + Arity = length(Args), + case erl_internal:new_type_test(Name, Arity) orelse + erl_internal:bool_op(Name, Arity) orelse + erl_internal:comp_op(Name, Arity) of + true -> + t_boolean(); + false -> + case erl_internal:arith_op(Name, Arity) of + true -> number; + false -> any + end + end. + +inferred_bif_type(is_atom, [_]) -> t_atom(); +inferred_bif_type(is_binary, [_]) -> {binary,8}; +inferred_bif_type(is_bitstring, [_]) -> {binary,1}; +inferred_bif_type(is_boolean, [_]) -> t_boolean(); +inferred_bif_type(is_float, [_]) -> float; +inferred_bif_type(is_integer, [_]) -> t_integer(); +inferred_bif_type(is_list, [_]) -> list; +inferred_bif_type(is_map, [_]) -> map; +inferred_bif_type(is_number, [_]) -> number; +inferred_bif_type(is_tuple, [_]) -> #t_tuple{}; +inferred_bif_type(abs, [_]) -> number; +inferred_bif_type(bit_size, [_]) -> {binary,1}; +inferred_bif_type('bnot', [_]) -> t_integer(); +inferred_bif_type(byte_size, [_]) -> {binary,1}; +inferred_bif_type(ceil, [_]) -> number; +inferred_bif_type(float, [_]) -> number; +inferred_bif_type(floor, [_]) -> number; +inferred_bif_type(hd, [_]) -> cons; +inferred_bif_type(length, [_]) -> list; +inferred_bif_type(map_size, [_]) -> map; +inferred_bif_type('not', [_]) -> t_boolean(); +inferred_bif_type(round, [_]) -> number; +inferred_bif_type(trunc, [_]) -> number; +inferred_bif_type(tl, [_]) -> cons; +inferred_bif_type(tuple_size, [_]) -> #t_tuple{}; +inferred_bif_type('and', [_,_]) -> t_boolean(); +inferred_bif_type('or', [_,_]) -> t_boolean(); +inferred_bif_type('xor', [_,_]) -> t_boolean(); +inferred_bif_type('band', [_,_]) -> t_integer(); +inferred_bif_type('bor', [_,_]) -> t_integer(); +inferred_bif_type('bsl', [_,_]) -> t_integer(); +inferred_bif_type('bsr', [_,_]) -> t_integer(); +inferred_bif_type('bxor', [_,_]) -> t_integer(); +inferred_bif_type('div', [_,_]) -> t_integer(); +inferred_bif_type('rem', [_,_]) -> t_integer(); +inferred_bif_type('+', [_,_]) -> number; +inferred_bif_type('-', [_,_]) -> number; +inferred_bif_type('*', [_,_]) -> number; +inferred_bif_type('/', [_,_]) -> number; +inferred_bif_type(_, _) -> any. + +is_math_bif(cos, 1) -> true; +is_math_bif(cosh, 1) -> true; +is_math_bif(sin, 1) -> true; +is_math_bif(sinh, 1) -> true; +is_math_bif(tan, 1) -> true; +is_math_bif(tanh, 1) -> true; +is_math_bif(acos, 1) -> true; +is_math_bif(acosh, 1) -> true; +is_math_bif(asin, 1) -> true; +is_math_bif(asinh, 1) -> true; +is_math_bif(atan, 1) -> true; +is_math_bif(atanh, 1) -> true; +is_math_bif(erf, 1) -> true; +is_math_bif(erfc, 1) -> true; +is_math_bif(exp, 1) -> true; +is_math_bif(log, 1) -> true; +is_math_bif(log2, 1) -> true; +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. + +join_types(Ts0, Ts1) -> + if + map_size(Ts0) < map_size(Ts1) -> + join_types_1(maps:keys(Ts0), Ts1, Ts0); + true -> + join_types_1(maps:keys(Ts1), Ts0, Ts1) + end. + +join_types_1([V|Vs], Ts0, Ts1) -> + case {Ts0,Ts1} of + {#{V:=Same},#{V:=Same}} -> + join_types_1(Vs, Ts0, Ts1); + {#{V:=T0},#{V:=T1}} -> + case join(T0, T1) of + T1 -> + join_types_1(Vs, Ts0, Ts1); + T -> + join_types_1(Vs, Ts0, Ts1#{V:=T}) + end; + {#{},#{V:=_}} -> + join_types_1(Vs, Ts0, Ts1) + end; +join_types_1([], Ts0, Ts1) -> + maps:merge(Ts0, Ts1). + +join([T1,T2|Ts]) -> + join([join(T1, T2)|Ts]); +join([T]) -> T. + +get_literal_from_type(#t_atom{elements=[Atom]}) -> + #b_literal{val=Atom}; +get_literal_from_type(#t_integer{elements={Int,Int}}) -> + #b_literal{val=Int}; +get_literal_from_type(nil) -> + #b_literal{val=[]}; +get_literal_from_type(_) -> none. + +remove_element_info(#t_integer{elements={Min,Max}}, Es) -> + foldl(fun(El, Acc) when Min =< El, El =< Max -> + maps:remove(El, Acc); + (_El, Acc) -> Acc + end, Es, maps:keys(Es)). + +t_atom() -> + #t_atom{elements=any}. + +t_atom(Atom) when is_atom(Atom) -> + #t_atom{elements=[Atom]}. + +t_boolean() -> + #t_atom{elements=[false,true]}. + +t_integer() -> + #t_integer{elements=any}. + +t_integer(Int) when is_integer(Int) -> + #t_integer{elements={Int,Int}}. + +t_integer(Min, Max) when is_integer(Min), is_integer(Max) -> + #t_integer{elements={Min,Max}}. + +t_is_boolean(#t_atom{elements=[F,T]}) -> + F =:= false andalso T =:= true; +t_is_boolean(#t_atom{elements=[B]}) -> + is_boolean(B); +t_is_boolean(_) -> false. + +t_tuple_size(#t_tuple{size=Size,exact=false}) -> + {at_least,Size}; +t_tuple_size(#t_tuple{size=Size,exact=true}) -> + {exact,Size}; +t_tuple_size(_) -> + none. + +is_singleton_type(Type) -> + get_literal_from_type(Type) =/= none. + +get_element_type(Index, Es) -> + case Es of + #{ Index := T } -> T; + #{} -> any + end. + +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, any, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. + +%% join(Type1, Type2) -> Type +%% Return the "join" of Type1 and Type2. The join is a more general +%% type than Type1 and Type2. For example: +%% +%% join(#t_integer{elements=any}, #t_integer=elements={0,3}}) -> +%% #t_integer{} +%% +%% The join for two different types result in 'any', which is +%% the top element for our type lattice: +%% +%% join(#t_integer{}, map) -> any + +-spec join(type(), type()) -> type(). + +join(T, T) -> + verified_type(T); +join(none, T) -> + verified_type(T); +join(T, none) -> + verified_type(T); +join(any, _) -> any; +join(_, any) -> any; +join(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + Set = ordsets:union(Set1, Set2), + case ordsets:size(Set) of + Size when Size =< ?ATOM_SET_SIZE -> + #t_atom{elements=Set}; + _Size -> + #t_atom{elements=any} + end; +join(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T; +join(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T; +join({binary,U1}, {binary,U2}) -> + {binary,gcd(U1, U2)}; +join(#t_integer{}, #t_integer{}) -> t_integer(); +join(list, cons) -> list; +join(cons, list) -> list; +join(nil, cons) -> list; +join(cons, nil) -> list; +join(nil, list) -> list; +join(list, nil) -> list; +join(#t_integer{}, float) -> number; +join(float, #t_integer{}) -> number; +join(#t_integer{}, number) -> number; +join(number, #t_integer{}) -> number; +join(float, number) -> number; +join(number, float) -> number; +join(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, + #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> + Exact = ExactA and ExactB, + Es = join_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,exact=Exact,elements=Es}; +join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> + Sz = min(SzA, SzB), + Es = join_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,elements=Es}; +join(_T1, _T2) -> + %%io:format("~p ~p\n", [_T1,_T2]), + any. + +join_tuple_elements(MinSize, EsA, EsB) -> + Es0 = join_elements(EsA, EsB), + maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + +join_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + join_elements_1(Keys, Es1, Es2, #{}). + +join_elements_1([Key | Keys], Es1, Es2, Acc0) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + Acc = set_element_type(Key, join(Type1, Type2), Acc0), + join_elements_1(Keys, Es1, Es2, Acc); + {#{}, #{}} -> + join_elements_1(Keys, Es1, Es2, Acc0) + end; +join_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +meet_types([{V,T0}|Vs], Ts) -> + #{V:=T1} = Ts, + case meet(T0, T1) of + T1 -> meet_types(Vs, Ts); + T -> meet_types(Vs, Ts#{V:=T}) + end; +meet_types([], Ts) -> Ts. + +meet([T1,T2|Ts]) -> + meet([meet(T1, T2)|Ts]); +meet([T]) -> T. + +subtract_types([{V,T0}|Vs], Ts) -> + #{V:=T1} = Ts, + case subtract(T1, T0) of + T1 -> subtract_types(Vs, Ts); + T -> subtract_types(Vs, Ts#{V:=T}) + end; +subtract_types([], Ts) -> Ts. + +%% subtract(Type1, Type2) -> Type. +%% Subtract Type2 from Type1. Example: +%% +%% subtract(list, cons) -> nil + +subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> + case ordsets:subtract(Set0, Set1) of + [] -> none; + [_|_]=Set -> #t_atom{elements=Set} + end; +subtract(number, float) -> #t_integer{}; +subtract(number, #t_integer{elements=any}) -> float; +subtract(list, cons) -> nil; +subtract(list, nil) -> cons; +subtract(T, _) -> T. + +%% meet(Type1, Type2) -> Type +%% Return the "meet" of Type1 and Type2. The meet is a narrower +%% type than Type1 and Type2. For example: +%% +%% meet(#t_integer{elements=any}, #t_integer{elements={0,3}}) -> +%% #t_integer{elements={0,3}} +%% +%% The meet for two different types result in 'none', which is +%% the bottom element for our type lattice: +%% +%% meet(#t_integer{}, map) -> none + +-spec meet(type(), type()) -> type(). + +meet(T, T) -> + verified_type(T); +meet(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + case ordsets:intersection(Set1, Set2) of + [] -> + none; + [_|_]=Set -> + #t_atom{elements=Set} + end; +meet(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) -> + T; +meet(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) -> + T; +meet(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) -> + T; +meet(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) -> + T; +meet(#t_integer{elements={Min1,Max1}}, + #t_integer{elements={Min2,Max2}}) -> + #t_integer{elements={max(Min1, Min2),min(Max1, Max2)}}; +meet(#t_integer{}=T, number) -> T; +meet(float=T, number) -> T; +meet(number, #t_integer{}=T) -> T; +meet(number, float=T) -> T; +meet(list, cons) -> cons; +meet(list, nil) -> nil; +meet(cons, list) -> cons; +meet(nil, list) -> nil; +meet(#t_tuple{}=T1, #t_tuple{}=T2) -> + meet_tuples(T1, T2); +meet({binary,U1}, {binary,U2}) -> + {binary,max(U1, U2)}; +meet(any, T) -> + verified_type(T); +meet(T, any) -> + verified_type(T); +meet(_, _) -> + %% Inconsistent types. There will be an exception at runtime. + none. + +meet_tuples(#t_tuple{size=Sz1,exact=true}, + #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 -> + none; +meet_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, + #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> + Size = max(Sz1, Sz2), + Exact = Ex1 or Ex2, + case meet_elements(Es1, Es2) of + none -> + none; + Es -> + #t_tuple{size=Size,exact=Exact,elements=Es} + end. + +meet_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + meet_elements_1(Keys, Es1, Es2, #{}). + +meet_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + case meet(Type1, Type2) of + none -> none; + Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +meet_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% 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). +%% +%% #t_atom{} Any atom or some specific atoms. +%% {binary,Unit} Binary/bitstring aligned to unit Unit. +%% float Floating point number. +%% #t_integer{} Integer +%% list Empty or nonempty list. +%% map Map. +%% nil Empty list. +%% cons Cons (nonempty list). +%% number A number (float or integer). +%% #t_tuple{} Tuple. +%% +%% none No type (bottom element for the type lattice). + +-spec verified_type(T) -> T when + T :: type(). + +verified_type(any=T) -> T; +verified_type(none=T) -> T; +verified_type(#t_atom{elements=any}=T) -> T; +verified_type(#t_atom{elements=[_|_]}=T) -> T; +verified_type({binary,U}=T) when is_integer(U) -> T; +verified_type(#t_integer{elements=any}=T) -> T; +verified_type(#t_integer{elements={Min,Max}}=T) + when is_integer(Min), is_integer(Max) -> T; +verified_type(list=T) -> T; +verified_type(map=T) -> T; +verified_type(nil=T) -> T; +verified_type(cons=T) -> T; +verified_type(number=T) -> T; +verified_type(#t_tuple{size=Size,elements=Es}=T) -> + %% All known elements must have a valid index and type. 'any' is prohibited + %% since it's implicit and should never be present in the map. + maps:fold(fun(Index, Element, _) when is_integer(Index), + 1 =< Index, Index =< Size, + Element =/= any, Element =/= none -> + verified_type(Element) + end, [], Es), + T; +verified_type(float=T) -> T. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 4da0985085..acf3838da4 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -21,12 +21,11 @@ -module(beam_trim). -export([module/2]). --import(lists, [reverse/1,reverse/2,splitwith/2,sort/1]). +-import(lists, [any/2,member/2,reverse/1,reverse/2,splitwith/2,sort/1]). -record(st, - {safe :: gb_sets:set(beam_asm:label()), %Safe labels. - lbl :: beam_utils:code_index() %Code at each label. - }). + {safe :: cerl_sets:set(beam_asm:label()) %Safe labels. + }). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -36,10 +35,15 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> {ok,{Mod,Exp,Attr,Fs,Lc}}. function({function,Name,Arity,CLabel,Is0}) -> - %%ok = io:fwrite("~w: ~p\n", [?LINE,{Name,Arity}]), - St = #st{safe=safe_labels(Is0, []),lbl=beam_utils:index_labels(Is0)}, - Is = trim(Is0, St, []), - {function,Name,Arity,CLabel,Is}. + try + St = #st{safe=safe_labels(Is0, [])}, + Is = trim(Is0, St, []), + {function,Name,Arity,CLabel,Is} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. trim([{kill,_}|_]=Is0, St, Acc) -> {Kills0,Is1} = splitwith(fun({kill,_}) -> true; @@ -47,14 +51,33 @@ trim([{kill,_}|_]=Is0, St, Acc) -> end, Is0), Kills = sort(Kills0), try - {FrameSize,Layout} = frame_layout(Is1, Kills, St), - Configs = trim_instructions(Layout), - try_remap(Configs, Is1, FrameSize) - of + %% Find out the size and layout of the stack frame. + %% Example of a layout: + %% + %% [{kill,{y,0}},{dead,{y,1},{live,{y,2}},{kill,{y,3}}] + %% + %% That means that y0 and y3 are to be killed, that y1 + %% has been killed previously, and that y2 is live. + {FrameSize,Layout} = frame_layout(Is1, Kills, St), + + %% Calculate all recipes that are not worse in terms + %% of estimated execution time. The recipes are ordered + %% in descending order from how much they trim. + Recipes = trim_recipes(Layout), + + %% Try the recipes in order. A recipe may not work out because + %% a register that was previously killed may be + %% resurrected. If that happens, the next recipe, which trims + %% less, will be tried. + try_remap(Recipes, Is1, FrameSize) + of {Is,TrimInstr} -> + %% One of the recipes was applied. trim(Is, St, reverse(TrimInstr)++Acc) catch not_possible -> + %% No recipe worked out. Use the original kill + %% instructions. trim(Is1, St, reverse(Kills, Acc)) end; trim([I|Is], St, Acc) -> @@ -62,34 +85,42 @@ trim([I|Is], St, Acc) -> trim([], _, Acc) -> reverse(Acc). -%% trim_instructions([{kill,R}|{live,R}|{dead,R}]) -> {[Instruction],MapFun} -%% Figure out the sequence of moves and trim to use. +%% trim_recipes([{kill,R}|{live,R}|{dead,R}]) -> [Recipe]. +%% Recipe = {Kills,NumberToTrim,Moves} +%% Kills = [{kill,Y}] +%% Moves = [{move,SrcY,DstY}] +%% +%% Calculate how to best trim the stack and kill the correct +%% Y registers. Return a list of possible recipes. The best +%% recipe (the one that trims the most) is first in the list. +%% All of the recipes are no worse in estimated execution time +%% than the original sequences of kill instructions. -trim_instructions(Layout) -> +trim_recipes(Layout) -> Cost = length([I || {kill,_}=I <- Layout]), - trim_instructions_1(Layout, 0, [], {Cost,[]}). + trim_recipes_1(Layout, 0, [], {Cost,[]}). -trim_instructions_1([{kill,{y,Trim0}}|Ks], Trim0, Moves, Config0) -> +trim_recipes_1([{kill,{y,Trim0}}|Ks], Trim0, Moves, Recipes0) -> Trim = Trim0 + 1, - Config = save_config(Ks, Trim, Moves, Config0), - trim_instructions_1(Ks, Trim, Moves, Config); -trim_instructions_1([{dead,{y,Trim0}}|Ks], Trim0, Moves, Config0) -> + Recipes = save_recipe(Ks, Trim, Moves, Recipes0), + trim_recipes_1(Ks, Trim, Moves, Recipes); +trim_recipes_1([{dead,{y,Trim0}}|Ks], Trim0, Moves, Recipes0) -> Trim = Trim0 + 1, - Config = save_config(Ks, Trim, Moves, Config0), - trim_instructions_1(Ks, Trim, Moves, Config); -trim_instructions_1([{live,{y,Trim0}=Src}|Ks0], Trim0, Moves0, Config0) -> + Recipes = save_recipe(Ks, Trim, Moves, Recipes0), + trim_recipes_1(Ks, Trim, Moves, Recipes); +trim_recipes_1([{live,{y,Trim0}=Src}|Ks0], Trim0, Moves0, Recipes0) -> case take_last_dead(Ks0) of none -> - {_,ConfigList} = Config0, - ConfigList; + {_,RecipesList} = Recipes0, + RecipesList; {Dst,Ks} -> Trim = Trim0 + 1, Moves = [{move,Src,Dst}|Moves0], - Config = save_config(Ks, Trim, Moves, Config0), - trim_instructions_1(Ks, Trim, Moves, Config) + Recipes = save_recipe(Ks, Trim, Moves, Recipes0), + trim_recipes_1(Ks, Trim, Moves, Recipes) end; -trim_instructions_1([], _, _, {_,ConfigList}) -> - ConfigList. +trim_recipes_1([], _, _, {_,RecipesList}) -> + RecipesList. take_last_dead(L) -> take_last_dead_1(reverse(L)). @@ -100,28 +131,48 @@ take_last_dead_1([{dead,Reg}|Is]) -> {Reg,reverse(Is)}; take_last_dead_1(_) -> none. -save_config(Ks, Trim, Moves, {MaxCost,Acc}=Config) -> - case config_cost(Ks, Moves) of - Cost when Cost =< MaxCost -> - {MaxCost,[{Ks,Trim,Moves}|Acc]}; +save_recipe(Ks, Trim, Moves, {MaxCost,Acc}=Recipes) -> + case recipe_cost(Ks, Moves) of + Cost when Cost =< MaxCost -> + %% The price is right. + {MaxCost,[{Ks,Trim,Moves}|Acc]}; _Cost -> - Config + %% Too expensive. + Recipes end. -config_cost(Ks, Moves) -> +recipe_cost(Ks, Moves) -> %% We estimate that a {move,{y,_},{y,_}} instruction is roughly twice as %% expensive as a {kill,{y,_}} instruction. A {trim,_} instruction is %% roughly as expensive as a {kill,{y,_}} instruction. - config_cost_1(Ks, 1+2*length(Moves)). + recipe_cost_1(Ks, 1+2*length(Moves)). -config_cost_1([{kill,_}|Ks], Cost) -> - config_cost_1(Ks, Cost+1); -config_cost_1([_|Ks], Cost) -> - config_cost_1(Ks, Cost); -config_cost_1([], Cost) -> Cost. +recipe_cost_1([{kill,_}|Ks], Cost) -> + recipe_cost_1(Ks, Cost+1); +recipe_cost_1([_|Ks], Cost) -> + recipe_cost_1(Ks, Cost); +recipe_cost_1([], Cost) -> Cost. -expand_config({Layout,Trim,Moves}, FrameSize) -> +%% try_remap([Recipe], [Instruction], FrameSize) -> +%% {[Instruction],[TrimInstruction]}. +%% Try to renumber Y registers in the instruction stream. The +%% first rececipe that works will be used. +%% +%% This function will issue a `not_possible` exception if none +%% of the recipes were possible to apply. + +try_remap([R|Rs], Is, FrameSize) -> + {TrimInstr,Map} = expand_recipe(R, FrameSize), + try + {remap(Is, Map, []),TrimInstr} + catch + throw:not_possible -> + try_remap(Rs, Is, FrameSize) + end; +try_remap([], _, _) -> throw(not_possible). + +expand_recipe({Layout,Trim,Moves}, FrameSize) -> Kills = [Kill || {kill,_}=Kill <- Layout], {Kills++reverse(Moves, [{trim,Trim,FrameSize-Trim}]),create_map(Trim, Moves)}. @@ -132,16 +183,16 @@ create_map(Trim, []) -> (Any) -> Any end; create_map(Trim, Moves) -> - GbTree0 = [{Src,Dst-Trim} || {move,{y,Src},{y,Dst}} <- Moves], - GbTree = gb_trees:from_orddict(sort(GbTree0)), - IllegalTargets = gb_sets:from_list([Dst || {move,_,{y,Dst}} <- Moves]), + Map0 = [{Src,Dst-Trim} || {move,{y,Src},{y,Dst}} <- Moves], + Map = maps:from_list(Map0), + IllegalTargets = cerl_sets:from_list([Dst || {move,_,{y,Dst}} <- Moves]), fun({y,Y0}) when Y0 < Trim -> - case gb_trees:lookup(Y0, GbTree) of - {value,Y} -> {y,Y}; - none -> throw(not_possible) - end; + case Map of + #{Y0:=Y} -> {y,Y}; + #{} -> throw(not_possible) + end; ({y,Y}) -> - case gb_sets:is_element(Y, IllegalTargets) of + case cerl_sets:is_element(Y, IllegalTargets) of true -> throw(not_possible); false -> {y,Y-Trim} end; @@ -149,19 +200,17 @@ create_map(Trim, Moves) -> (Any) -> Any end. -try_remap([C|Cs], Is, FrameSize) -> - {TrimInstr,Map} = expand_config(C, FrameSize), - try - {remap(Is, Map, []),TrimInstr} - catch - throw:not_possible -> - try_remap(Cs, Is, FrameSize) - end; -try_remap([], _, _) -> throw(not_possible). - +remap([{'%',_}=I|Is], Map, Acc) -> + remap(Is, Map, [I|Acc]); remap([{block,Bl0}|Is], Map, Acc) -> Bl = remap_block(Bl0, Map, []), remap(Is, Map, [{block,Bl}|Acc]); +remap([{bs_get_tail,Src,Dst,Live}|Is], Map, Acc) -> + I = {bs_get_tail,Map(Src),Map(Dst),Live}, + remap(Is, Map, [I|Acc]); +remap([{bs_set_position,Src1,Src2}|Is], Map, Acc) -> + I = {bs_set_position,Map(Src1),Map(Src2)}, + remap(Is, Map, [I|Acc]); remap([{call_fun,_}=I|Is], Map, Acc) -> remap(Is, Map, [I|Acc]); remap([{call,_,_}=I|Is], Map, Acc) -> @@ -205,35 +254,68 @@ remap([return|_]=Is, _, Acc) -> reverse(Acc, Is); remap([{line,_}=I|Is], Map, Acc) -> remap(Is, Map, [I|Acc]). - + remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> Ds = [Map(D) || D <- Ds0], Ss = [Map(S) || S <- Ss0], remap_block(Is, Map, [{set,Ds,Ss,Info}|Acc]); remap_block([], _, Acc) -> reverse(Acc). - -safe_labels([{label,L},{line,_},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> - safe_labels(Is, [L|Acc]); -safe_labels([{label,L},{line,_},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> - safe_labels(Is, [L|Acc]); -safe_labels([{label,L},{line,_},if_end|Is], Acc) -> - safe_labels(Is, [L|Acc]); -safe_labels([{label,L}, - {block,[{set,[{x,0}],[{Tag,_}],move}]}, - {line,_}, - {call_ext,1,{extfunc,erlang,error,1}}|Is], Acc) when Tag =/= y -> - safe_labels(Is, [L|Acc]); + +%% safe_labels([Instruction], Accumulator) -> gb_set() +%% Build a gb_set of safe labels. The code at a safe +%% label does not depend on the values in a specific +%% Y register, only that all Y registers are initialized +%% so that it safe to scan the stack when an exception +%% is generated. +%% +%% In other words, code at a safe label will continue +%% to work if Y registers have been renumbered and +%% the size of the stack frame has changed. + +safe_labels([{label,L}|Is], Acc) -> + case is_safe_label(Is) of + true -> safe_labels(Is, [L|Acc]); + false -> safe_labels(Is, Acc) + end; safe_labels([_|Is], Acc) -> safe_labels(Is, Acc); -safe_labels([], Acc) -> gb_sets:from_list(Acc). +safe_labels([], Acc) -> cerl_sets:from_list(Acc). + +is_safe_label([{'%',_}|Is]) -> + is_safe_label(Is); +is_safe_label([{line,_}|Is]) -> + is_safe_label(Is); +is_safe_label([{badmatch,{Tag,_}}|_]) -> + Tag =/= y; +is_safe_label([{case_end,{Tag,_}}|_]) -> + Tag =/= y; +is_safe_label([{try_case_end,{Tag,_}}|_]) -> + Tag =/= y; +is_safe_label([if_end|_]) -> + true; +is_safe_label([{block,Bl}|Is]) -> + is_safe_label_block(Bl) andalso is_safe_label(Is); +is_safe_label([{call_ext,_,{extfunc,M,F,A}}|_]) -> + erl_bifs:is_exit_bif(M, F, A); +is_safe_label(_) -> false. + +is_safe_label_block([{set,Ds,Ss,_}|Is]) -> + IsYreg = fun({y,_}) -> true; + (_) -> false + end, + %% This instruction is safe if the instruction + %% neither reads or writes Y registers. + not (any(IsYreg, Ss) orelse any(IsYreg, Ds)) andalso + is_safe_label_block(Is); +is_safe_label_block([]) -> true. %% frame_layout([Instruction], [{kill,_}], St) -> %% [{kill,Reg} | {live,Reg} | {dead,Reg}] %% Figure out the layout of the stack frame. -frame_layout(Is, Kills, #st{safe=Safe,lbl=D}) -> +frame_layout(Is, Kills, #st{safe=Safe}) -> N = frame_size(Is, Safe), - IsKilled = fun(R) -> beam_utils:is_not_used(R, Is, D) end, + IsKilled = fun(R) -> is_not_used(R, Is) end, {N,frame_layout_1(Kills, 0, N, IsKilled, [])}. frame_layout_1([{kill,{y,Y}}=I|Ks], Y, N, IsKilled, Acc) -> @@ -253,7 +335,14 @@ frame_layout_2(Is) -> reverse(Is). %% frame_size([Instruction], SafeLabels) -> FrameSize %% Find out the frame size by looking at the code that follows. +%% +%% Implicitly, also check that the instructions are a straight +%% sequence of code that ends in a return. Any branches are +%% to safe labels (i.e., the code at those labels don't depend +%% on the contents of any Y register). +frame_size([{'%',_}|Is], Safe) -> + frame_size(Is, Safe); frame_size([{block,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{call_fun,_}|Is], Safe) -> @@ -285,15 +374,94 @@ frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{get_map_elements,{f,L},_,_}|Is], Safe) -> frame_size_branch(L, Is, Safe); -frame_size([{deallocate,N}|_], _) -> N; +frame_size([{deallocate,N}|_], _) -> + N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); -frame_size([_|_], _) -> throw(not_possible). +frame_size([{bs_set_position,_,_}|Is], Safe) -> + frame_size(Is, Safe); +frame_size([{bs_get_tail,_,_,_}|Is], Safe) -> + frame_size(Is, Safe); +frame_size(_, _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> frame_size(Is, Safe); frame_size_branch(L, Is, Safe) -> - case gb_sets:is_member(L, Safe) of + case cerl_sets:is_element(L, Safe) of false -> throw(not_possible); true -> frame_size(Is, Safe) end. + +%% is_not_used(Y, [Instruction]) -> true|false. +%% Test whether the value of Y is unused in the instruction sequence. +%% Return true if the value of Y is not used, and false if it is used. +%% +%% This function handles the same instructions as frame_size/2. It +%% assumes that any labels in the instructions are safe labels. + +is_not_used(Y, [{'%',_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{apply,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{bif,_,{f,_},Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is); +is_not_used(Y, [{block,Bl}|Is]) -> + case is_not_used_block(Y, Bl) of + used -> false; + killed -> true; + transparent -> is_not_used(Y, Is) + end; +is_not_used(Y, [{bs_get_tail,Src,Dst,_}|Is]) -> + is_not_used_ss_dst(Y, [Src], Dst, Is); +is_not_used(Y, [{bs_init,_,_,_,Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is); +is_not_used(Y, [{bs_put,{f,_},_,Ss}|Is]) -> + not member(Y, Ss) andalso is_not_used(Y, Is); +is_not_used(Y, [{bs_set_position,Src1,Src2}|Is]) -> + Y =/= Src1 andalso Y =/= Src2 andalso + is_not_used(Y, Is); +is_not_used(Y, [{call,_,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{call_ext,_,_}=I|Is]) -> + beam_jump:is_exit_instruction(I) orelse is_not_used(Y, Is); +is_not_used(Y, [{call_fun,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(_Y, [{deallocate,_}|_]) -> + true; +is_not_used(Y, [{gc_bif,_,{f,_},_Live,Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is); +is_not_used(Y, [{get_map_elements,{f,_},S,{list,List}}|Is]) -> + {Ss,Ds} = beam_utils:split_even(List), + case member(Y, [S|Ss]) of + true -> + false; + false -> + member(Y, Ds) orelse is_not_used(Y, Is) + end; +is_not_used(Y, [{kill,Yreg}|Is]) -> + Y =:= Yreg orelse is_not_used(Y, Is); +is_not_used(Y, [{line,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{make_fun2,_,_,_,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{test,_,_,Ss}|Is]) -> + not member(Y, Ss) andalso is_not_used(Y, Is); +is_not_used(Y, [{test,_Op,{f,_},_Live,Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is). + +is_not_used_block(Y, [{set,Ds,Ss,_}|Is]) -> + case member(Y, Ss) of + true -> + used; + false -> + case member(Y, Ds) of + true -> + killed; + false -> + is_not_used_block(Y, Is) + end + end; +is_not_used_block(_Y, []) -> transparent. + +is_not_used_ss_dst(Y, Ss, Dst, Is) -> + not member(Y, Ss) andalso (Y =:= Dst orelse is_not_used(Y, Is)). diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl deleted file mode 100644 index a1e9eff8f3..0000000000 --- a/lib/compiler/src/beam_type.erl +++ /dev/null @@ -1,1118 +0,0 @@ -%% -%% %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: 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, [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], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Asm0}) -> - try - Asm1 = beam_utils:live_opt(Asm0), - Asm2 = opt(Asm1, [], tdb_new()), - Asm3 = beam_utils:live_opt(Asm2), - Asm = beam_utils:delete_annos(Asm3), - {function,Name,Arity,CLabel,Asm} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% opt([Instruction], Accumulator, TypeDb) -> {[Instruction'],TypeDb'} -%% Keep track of type information; try to simplify. - -opt([{block,Body1}|Is], [{block,Body0}|Acc], Ts0) -> - {Body2,Ts} = simplify(Body1, Ts0), - Body = merge_blocks(Body0, Body2), - opt(Is, [{block,Body}|Acc], Ts); -opt([{block,Body0}|Is], Acc, Ts0) -> - {Body,Ts} = simplify(Body0, Ts0), - opt(Is, [{block,Body}|Acc], Ts); -opt([I0|Is], Acc, Ts0) -> - case simplify_basic([I0], Ts0) of - {[],Ts} -> opt(Is, Acc, Ts); - {[I],Ts} -> opt(Is, [I|Acc], Ts) - end; -opt([], Acc, _) -> reverse(Acc). - -%% simplify(Instruction, TypeDb) -> NewInstruction -%% Simplify an instruction using type information (this is -%% technically a "strength reduction"). - -simplify(Is0, TypeDb0) -> - {Is,_} = BasicRes = simplify_basic(Is0, TypeDb0), - case simplify_float(Is, TypeDb0) of - not_possible -> BasicRes; - {_,_}=Res -> Res - end. - -%% simplify_basic([Instruction], TypeDatabase) -> {[Instruction],TypeDatabase'} -%% Basic simplification, mostly tuples, no floating point optimizations. - -simplify_basic(Is, Ts) -> - 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([], 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 - 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_instr({test,test_arity,_,[R,Arity]}=I, Ts) -> - case tdb_find(R, Ts) of - {tuple,exact_size,Arity,_} -> []; - _ -> [I] - end; -simplify_instr({test,is_eq_exact,Fail,[R,{atom,A}=Atom]}=I, Ts) -> - case tdb_find(R, Ts) of - {atom,_}=Atom -> []; - boolean when is_boolean(A) -> [I]; - any -> [I]; - _ -> [{jump,Fail}] - end; -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_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_instr(I, _) -> [I]. - -simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) -> - Vs = sort([V || {integer,V} <- L0]), - case eq_ranges(Vs, Min, Max) of - false -> I; - true -> simplify_select_val_1(L0, {integer,Max}, R, []) - end. - -simplify_select_val_bool({select,select_val,R,_,L}=I) -> - Vs = sort([V || {atom,V} <- L]), - case Vs of - [false,true] -> - simplify_select_val_1(L, {atom,false}, R, []); - _ -> - I - end. - -simplify_select_val_1([Val,F|T], Val, R, Acc) -> - L = reverse(Acc, T), - {select,select_val,R,F,L}; -simplify_select_val_1([V,F|T], Val, R, Acc) -> - simplify_select_val_1(T, Val, R, [F,V|Acc]). - -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. -%% -simplify_float(Is0, Ts0) -> - {Is1,Ts} = simplify_float_1(Is0, Ts0, [], []), - Is2 = opt_fmoves(Is1, []), - Is3 = flt_need_heap(Is2), - try - {flt_liveness(Is3),Ts} - catch - throw:not_possible -> not_possible - end. - -simplify_float_1([{set,[],[],fclearerror}|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, clearerror(Acc)); -simplify_float_1([{set,[],[],fcheckerror}|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, checkerror(Acc)); -simplify_float_1([{set,[{fr,_}],_,_}=I|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, [I|Acc]); -simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, - Ts0, Rs0, Acc0) -> - case tdb_find(A0, Ts0) of - float -> - A = coerce_to_float(A0), - {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), - {D,Rs} = find_dest(D0, Rs1), - Areg = fetch_reg(A, Rs), - Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)], - Ts = tdb_store(D0, float, Ts0), - simplify_float_1(Is, Ts, Rs, Acc); - _Other -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]) - end; -simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, - Ts0, Rs0, Acc0) -> - case float_op(Op0, A0, B0, Ts0) of - no -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]); - {yes,Op} -> - A = coerce_to_float(A0), - B = coerce_to_float(B0), - {Rs1,Acc1} = load_reg(A, Ts0, Rs0, Acc0), - {Rs2,Acc2} = load_reg(B, Ts0, Rs1, Acc1), - {D,Rs} = find_dest(D0, Rs2), - Areg = fetch_reg(A, Rs), - Breg = fetch_reg(B, Rs), - Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)], - 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) -> - Acc = flush_all(Rs0, Is0, Acc0), - simplify_float_1(Is, tdb_new(), Rs0, [I|Acc]); -simplify_float_1([{set,_,_,{line,_}}=I|Is], Ts, Rs, Acc) -> - simplify_float_1(Is, Ts, Rs, [I|Acc]); -simplify_float_1([I|Is], Ts0, [], Acc) -> - Ts = update(I, Ts0), - simplify_float_1(Is, Ts, [], [I|Acc]); -simplify_float_1([I|Is]=Is0, Ts0, Rs0, Acc0) -> - Ts = update(I, Ts0), - {Rs,Acc} = flush(Rs0, Is0, Acc0), - simplify_float_1(Is, Ts, Rs, [I|checkerror(Acc)]); -simplify_float_1([], Ts, [], Acc) -> - Is = reverse(Acc), - {Is,Ts}. - -coerce_to_float({integer,I}=Int) -> - try float(I) of - F -> - {float,F} - catch _:_ -> - %% Let the overflow happen at run-time. - Int - end; -coerce_to_float(Other) -> Other. - -opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1, - {set,[_]=Dst,[{x,_}=R],move}=I2|Is], Acc) -> - case beam_utils:is_killed_block(R, Is) of - false -> opt_fmoves(Is, [I2,I1|Acc]); - true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc]) - end; -opt_fmoves([I|Is], Acc) -> - opt_fmoves(Is, [I|Acc]); -opt_fmoves([], Acc) -> reverse(Acc). - -clearerror(Is) -> - clearerror(Is, Is). - -clearerror([{set,[],[],fclearerror}|_], OrigIs) -> OrigIs; -clearerror([{set,[],[],fcheckerror}|_], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]; -clearerror([_|Is], OrigIs) -> clearerror(Is, OrigIs); -clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. - -%% merge_blocks(Block1, Block2) -> Block. -%% Combine two blocks and eliminate any move instructions that assign -%% to registers that are killed later in the block. -%% -merge_blocks(B1, [{'%anno',_}|B2]) -> - merge_blocks_1(B1++[{set,[],[],stop_here}|B2]). - -merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is; -merge_blocks_1([{set,[D],_,move}=I|Is]) -> - case beam_utils:is_killed_block(D, Is) of - true -> merge_blocks_1(Is); - false -> [I|merge_blocks_1(Is)] - end; -merge_blocks_1([I|Is]) -> [I|merge_blocks_1(Is)]. - -%% flt_need_heap([Instruction]) -> [Instruction] -%% Insert need heap allocation instructions in the instruction stream -%% to properly account for both inserted floating point operations and -%% normal term build operations (such as put_list/3). -%% -%% Ignore old heap allocation instructions (except if they allocate a stack -%% frame too), as they may be in the wrong place (because gc_bif instructions -%% could have been converted to floating point operations). - -flt_need_heap(Is) -> - flt_need_heap_1(reverse(Is), 0, 0, []). - -flt_need_heap_1([{set,[],[],{alloc,_,Alloc}}|Is], H, Fl, Acc) -> - case Alloc of - {_,nostack,_,_} -> - %% Remove any existing test_heap/2 instruction. - flt_need_heap_1(Is, H, Fl, Acc); - {Z,Stk,_,Inits} when is_integer(Stk) -> - %% Keep any allocate*/2 instruction and recalculate heap need. - I = {set,[],[],{alloc,regs,{Z,Stk,build_alloc(H, Fl),Inits}}}, - flt_need_heap_1(Is, 0, 0, [I|Acc]) - end; -flt_need_heap_1([I|Is], H0, Fl0, Acc) -> - {Ns,H1,Fl1} = flt_need_heap_2(I, H0, Fl0), - flt_need_heap_1(Is, H1, Fl1, [I|Ns]++Acc); -flt_need_heap_1([], H, Fl, Acc) -> - flt_alloc(H, Fl) ++ Acc. - -%% First come all instructions that build. We pass through, while we -%% add to the need for heap words and floats on the heap. -flt_need_heap_2({set,[_],[{fr,_}],fmove}, H, Fl) -> - {[],H,Fl+1}; -flt_need_heap_2({set,_,_,put_list}, H, Fl) -> - {[],H+2,Fl}; -flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) -> - {[],H+1,Fl}; -flt_need_heap_2({set,_,_,put}, H, Fl) -> - {[],H+1,Fl}; -%% 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) -> - {[],H,Fl}. - -flt_alloc(0, 0) -> - []; -flt_alloc(H, 0) -> - [{set,[],[],{alloc,regs,{nozero,nostack,H,[]}}}]; -flt_alloc(H, F) -> - [{set,[],[],{alloc,regs,{nozero,nostack, - build_alloc(H, F),[]}}}]. - -build_alloc(Words, 0) -> Words; -build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}. - - -%% flt_liveness([Instruction]) -> [Instruction] -%% (Re)calculate the number of live registers for each heap allocation -%% function. We base liveness of the number of register map at the -%% beginning of the instruction sequence. -%% -%% A 'not_possible' term will be thrown if the set of live registers -%% is not continous at an allocation function (e.g. if {x,0} and {x,2} -%% are live, but not {x,1}). - -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) -> - Live = min(Live0, live_regs(Regs0)), - I = {set,Ds,Ss,{alloc,Live,Alloc}}, - Regs1 = init_regs(Live), - Regs = x_live(Ds, Regs1), - flt_liveness_1(Is, Regs, [I|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([{'%anno',_}], _Regs, Acc) -> - reverse(Acc). - -init_regs(Live) -> - (1 bsl Live) - 1. - -live_regs(Regs) -> - live_regs_1(Regs, 0). - -live_regs_1(0, N) -> N; -live_regs_1(R, N) -> - case R band 1 of - 0 -> throw(not_possible); - 1 -> live_regs_1(R bsr 1, N+1) - end. - -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. - -%% update(Instruction, TypeDb) -> NewTypeDb -%% Update the type database to account for executing an instruction. -%% -%% First the cases for instructions inside basic blocks. -update({'%anno',_}, Ts) -> - Ts; -update({set,[D],[S],move}, Ts) -> - tdb_copy(S, D, Ts); -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), - 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],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) -> - %% Make sure we reject non-numeric literal argument. - case possibly_numeric(S) of - true -> tdb_store(D, float, Ts0); - false -> Ts0 - end; -update({set,[D],[S1,S2],{alloc,_,{gc_bif,'band',{f,0}}}}, Ts) -> - 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_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_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_store(D, any, Ts); - -%% Instructions outside of blocks. -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_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; - -%% Calls - -update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> - case is_math_bif(Math, Ar) of - 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,SzKind,Sz,_}=T0 -> - T = case tdb_find({x,0}, Ts0) of - {integer,{I,I}} when I > 1 -> - %% First element is not changed. The result - %% will have the same type. - T0; - _ -> - %% Position is 1 or unknown. May change the - %% first element of the tuple. - {tuple,SzKind,Sz,[]} - end, - 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({'%',_}, Ts) -> Ts; - -%% The instruction is unknown. Kill all information. -update(_I, _Ts) -> tdb_new(). - -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). - -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; - _ -> - band_type_2(N, Bits+1) - end; -band_type_2(_, _) -> - %% Negative or large positive number. Give up. - integer. - -get_bs_integer_type([_,{integer,N},U,{field_flags,Fl}]) - when N*U < 64 -> - NumBits = N*U, - case member(unsigned, Fl) of - true -> - {integer,{0,(1 bsl NumBits)-1}}; - false -> - %% Signed integer. Don't bother. - integer - end; -get_bs_integer_type(_) -> - %% Avoid creating ranges with a huge upper limit. - integer. - -is_math_bif(cos, 1) -> true; -is_math_bif(cosh, 1) -> true; -is_math_bif(sin, 1) -> true; -is_math_bif(sinh, 1) -> true; -is_math_bif(tan, 1) -> true; -is_math_bif(tanh, 1) -> true; -is_math_bif(acos, 1) -> true; -is_math_bif(acosh, 1) -> true; -is_math_bif(asin, 1) -> true; -is_math_bif(asinh, 1) -> true; -is_math_bif(atan, 1) -> true; -is_math_bif(atanh, 1) -> true; -is_math_bif(erf, 1) -> true; -is_math_bif(erfc, 1) -> true; -is_math_bif(exp, 1) -> true; -is_math_bif(log, 1) -> true; -is_math_bif(log2, 1) -> true; -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. - -%% Reject non-numeric literals. -possibly_numeric({x,_}) -> true; -possibly_numeric({y,_}) -> true; -possibly_numeric({integer,_}) -> true; -possibly_numeric({float,_}) -> true; -possibly_numeric(_) -> false. - -max_tuple_size(Reg, Ts) -> - case tdb_find(Reg, Ts) of - {tuple,_,Sz,_} -> Sz; - _Other -> 0 - end. - -float_op('/', A, B, _) -> - case possibly_numeric(A) andalso possibly_numeric(B) of - true -> {yes,fdiv}; - false -> no - end; -float_op(Op, {float,_}, B, _) -> - case possibly_numeric(B) of - true -> arith_op(Op); - false -> no - end; -float_op(Op, A, {float,_}, _) -> - case possibly_numeric(A) of - true -> arith_op(Op); - false -> no - end; -float_op(Op, A, B, Ts) -> - case {tdb_find(A, Ts),tdb_find(B, Ts)} of - {float,_} -> arith_op(Op); - {_,float} -> arith_op(Op); - {_,_} -> no - end. - -find_dest(V, Rs0) -> - case find_reg(V, Rs0) of - {ok,FR} -> - {FR,mark(V, Rs0, dirty)}; - error -> - Rs = put_reg(V, Rs0, dirty), - {ok,FR} = find_reg(V, Rs), - {FR,Rs} - end. - -load_reg({float,_}=F, _, Rs0, Is0) -> - Rs = put_reg(F, Rs0, clean), - {ok,FR} = find_reg(F, Rs), - Is = [{set,[FR],[F],fmove}|Is0], - {Rs,Is}; -load_reg(V, Ts, Rs0, Is0) -> - case find_reg(V, Rs0) of - {ok,_FR} -> {Rs0,Is0}; - error -> - Rs = put_reg(V, Rs0, clean), - {ok,FR} = find_reg(V, Rs), - Op = case tdb_find(V, Ts) of - float -> fmove; - _ -> fconv - end, - Is = [{set,[FR],[V],Op}|Is0], - {Rs,Is} - end. - -arith_op(Op) -> - case op_type(Op) of - {float,Instr} -> {yes,Instr}; - _ -> no - end. - -op_type('+') -> {float,fadd}; -op_type('-') -> {float,fsub}; -op_type('*') -> {float,fmul}; -%% '/' and 'band' are specially handled. -op_type('bor') -> integer; -op_type('bxor') -> integer; -op_type('bsl') -> integer; -op_type('bsr') -> integer; -op_type('div') -> integer; -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}; -flush(Rs0, [{set,Ds,Ss,_Op}|_], Acc0) -> - Save = cerl_sets:from_list(Ss), - Acc = save_regs(Rs0, Save, Acc0), - Rs1 = foldl(fun(S, A) -> mark(S, A, clean) end, Rs0, Ss), - Kill = cerl_sets:from_list(Ds), - Rs = kill_regs(Rs1, Kill), - {Rs,Acc}; -flush(Rs0, Is, Acc0) -> - Acc = flush_all(Rs0, Is, Acc0), - {[],Acc}. - -flush_all([{_,{float,_},_}|Rs], Is, Acc) -> - flush_all(Rs, Is, Acc); -flush_all([{I,V,dirty}|Rs], Is, Acc0) -> - Acc = checkerror(Acc0), - case beam_utils:is_killed_block(V, Is) of - true -> flush_all(Rs, Is, Acc); - false -> flush_all(Rs, Is, [{set,[V],[{fr,I}],fmove}|Acc]) - end; -flush_all([{_,_,clean}|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); -flush_all([free|Rs], Is, Acc) -> flush_all(Rs, Is, Acc); -flush_all([], _, Acc) -> Acc. - -save_regs(Rs, Save, Acc) -> - foldl(fun(R, A) -> save_reg(R, Save, A) end, Acc, Rs). - -save_reg({I,V,dirty}, Save, Acc) -> - case cerl_sets:is_element(V, Save) of - true -> [{set,[V],[{fr,I}],fmove}|checkerror(Acc)]; - false -> Acc - end; -save_reg(_, _, Acc) -> Acc. - -kill_regs(Rs, Kill) -> - [kill_reg(R, Kill) || R <- Rs]. - -kill_reg({_,V,_}=R, Kill) -> - case cerl_sets:is_element(V, Kill) of - true -> free; - false -> R - end; -kill_reg(R, _) -> R. - -mark(V, [{I,V,_}|Rs], Mark) -> [{I,V,Mark}|Rs]; -mark(V, [R|Rs], Mark) -> [R|mark(V, Rs, Mark)]; -mark(_, [], _) -> []. - -fetch_reg(V, [{I,V,_}|_]) -> {fr,I}; -fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). - -find_reg(V, [{I,V,_}|_]) -> {ok,{fr,I}}; -find_reg(V, [_|SRs]) -> find_reg(V, SRs); -find_reg(_, []) -> error. - -put_reg(V, Rs, Dirty) -> put_reg_1(V, Rs, Dirty, 0). - -put_reg_1(V, [free|Rs], Dirty, I) -> [{I,V,Dirty}|Rs]; -put_reg_1(V, [R|Rs], Dirty, I) -> [R|put_reg_1(V, Rs, Dirty, I+1)]; -put_reg_1(V, [], Dirty, I) -> [{I,V,Dirty}]. - -checkerror(Is) -> - checkerror_1(Is, Is). - -checkerror_1([{set,[],[],fcheckerror}|_], OrigIs) -> OrigIs; -checkerror_1([{set,_,_,{bif,fadd,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fsub,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fmul,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fdiv,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([{set,_,_,{bif,fnegate,_}}|_], OrigIs) -> checkerror_2(OrigIs); -checkerror_1([_|Is], OrigIs) -> checkerror_1(Is, OrigIs); -checkerror_1([], OrigIs) -> OrigIs. - -checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. - - -%%% Routines for maintaining a type database. The type database -%%% associates type information with registers. -%%% -%%% 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) -> 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(Reg, Ts) -> - case tdb_find_raw(Reg, Ts) of - {tuple_element,_,_} -> any; - Type -> Type - end. - -%% 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' -%% Update the type information for Dest to have the same type -%% as the Source. - -tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y -> - 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 - {atom,_} -> Literal; - {float,_} -> float; - {integer,Int} -> {integer,{Int,Int}}; - {literal,[_|_]} -> nonempty_list; - {literal,#{}} -> map; - {literal,Tuple} when tuple_size(Tuple) >= 1 -> - Lit = tag_literal(element(1, Tuple)), - {tuple,exact_size,tuple_size(Tuple),[Lit]}; - _ -> any - end, - 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}; -tag_literal(F) when is_float(F) -> {float,F}; -tag_literal(I) when is_integer(I) -> {integer,I}; -tag_literal([]) -> nil; -tag_literal(Lit) -> {literal,Lit}. - -%% tdb_kill_xregs(Db) -> NewDb -%% Kill all information about x registers. Also kill all tuple_element -%% dependencies from y registers to x registers. - -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([]) -> []. - -%% 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; -meet({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 -> - Max; -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; -verified_type(none=T) -> T. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 6b2ab5a2a4..6e6574c0b3 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -18,29 +18,16 @@ %% %CopyrightEnd% %% %% Purpose : Common utilities used by several optimization passes. -%% +%% -module(beam_utils). --export([is_killed_block/2,is_killed/3,is_killed_at/3, - 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_annos/1,combine_heap_needs/2, - anno_defs/1, - split_even/1 - ]). +-export([replace_labels/4,is_pure_test/1,split_even/1]). -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)). +-import(lists, [map/2,reverse/1]). -%% instruction() describes all instructions that are used during optimzation +%% instruction() describes all instructions that are used during optimization %% (from beam_a to beam_z). -type instruction() :: atom() | tuple(). @@ -56,137 +43,6 @@ -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, - {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 -%% Determine whether a register is killed by the instruction sequence inside -%% a block. -%% -%% If true is returned, it means that the register will not be -%% referenced in ANY way (not even indirectly by an allocate instruction); -%% i.e. it is OK to enter the instruction sequence with Register -%% containing garbage. - --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. -%% If true is returned, it means that the register will not be -%% referenced in ANY way (not even indirectly by an allocate instruction); -%% i.e. it is OK to enter the instruction sequence with Register -%% containing garbage. -%% -%% 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{lbl=D,res=gb_trees:empty()}, - case check_liveness(R, Is, St) of - {killed,_} -> true; - {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{lbl=D,res=gb_trees:empty()}, - case check_liveness_at(R, Lbl, St0) of - {killed,_} -> true; - {exit_not_used,_} -> false; - {_,_} -> 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. - --spec is_not_used(beam_asm:reg(), [instruction()], code_index()) -> boolean(). - -is_not_used(R, Is, D) -> - St = #live{lbl=D,res=gb_trees:empty()}, - case check_liveness(R, Is, St) of - {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). - - -%% 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. @@ -200,49 +56,6 @@ code_at(L, Ll) -> 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}; -bif_to_test(is_bitstring,[_]=Ops, Fail) -> {test,is_bitstr,Fail,Ops}; -bif_to_test(is_float, [_]=Ops, Fail) -> {test,is_float,Fail,Ops}; -bif_to_test(is_function, [_]=Ops, Fail) -> {test,is_function,Fail,Ops}; -bif_to_test(is_function, [_,_]=Ops, Fail) -> {test,is_function2,Fail,Ops}; -bif_to_test(is_integer, [_]=Ops, Fail) -> {test,is_integer,Fail,Ops}; -bif_to_test(is_list, [_]=Ops, Fail) -> {test,is_list,Fail,Ops}; -bif_to_test(is_map, [_]=Ops, Fail) -> {test,is_map,Fail,Ops}; -bif_to_test(is_number, [_]=Ops, Fail) -> {test,is_number,Fail,Ops}; -bif_to_test(is_pid, [_]=Ops, Fail) -> {test,is_pid,Fail,Ops}; -bif_to_test(is_port, [_]=Ops, Fail) -> {test,is_port,Fail,Ops}; -bif_to_test(is_reference, [_]=Ops, Fail) -> {test,is_reference,Fail,Ops}; -bif_to_test(is_tuple, [_]=Ops, Fail) -> {test,is_tuple,Fail,Ops}; -bif_to_test('=<', [A,B], Fail) -> {test,is_ge,Fail,[B,A]}; -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}. - - %% is_pure_test({test,Op,Fail,Ops}) -> true|false. %% Return 'true' if the test instruction does not modify any %% registers and/or bit syntax matching state. @@ -256,82 +69,15 @@ is_pure_test({test,is_eq_exact,_,[_,_]}) -> true; is_pure_test({test,is_ne_exact,_,[_,_]}) -> true; is_pure_test({test,is_ge,_,[_,_]}) -> true; is_pure_test({test,is_lt,_,[_,_]}) -> true; -is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; +is_pure_test({test,is_tagged_tuple,_,[_,_,_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; is_pure_test({test,has_map_fields,_,[_|_]}) -> true; is_pure_test({test,is_bitstr,_,[_]}) -> true; is_pure_test({test,is_function2,_,[_,_]}) -> true; -is_pure_test({test,Op,_,Ops}) -> +is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). - -%% live_opt([Instruction]) -> [Instruction]. -%% 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 {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; - (_) -> true - end, Is0), - {func_info,_,_,Live} = Fi, - D = gb_trees:insert(Fail, live_call(Live), gb_trees:empty()), - Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. - - -%% 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. - --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; -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]} @@ -343,446 +89,6 @@ split_even(Rs) -> split_even(Rs, [], []). %%% Local functions. %%% - -%% check_liveness(Reg, [Instruction], #live{}) -> -%% {killed | not_used | used, #live{}} -%% Find out whether Reg is used or killed in instruction sequence. -%% -%% 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); -check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) -> - case member(R, As) of - true -> - {used,St0}; - false -> - case check_liveness_at(R, Fail, St0) of - {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) -> - %% Check this instruction as a block to get a less conservative - %% result if the caller is is_not_used/3. - Block = [{set,[Dst],Ss,{alloc,Live,{bif,Op,Fail}}}], - check_liveness(R, [{block,Block}|Is], St); -check_liveness(R, [{select,_,R,_,_}|_], St) -> - {used,St}; -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_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_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}; - _ -> {killed,St} - end; -check_liveness(R, [{kill,R}|_], St) -> - {killed,St}; -check_liveness(R, [{kill,_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(R, [{bs_init,_,_,none,Ss,Dst}|Is], St) -> - case member(R, Ss) of - true -> - {used,St}; - false -> - if - R =:= Dst -> {killed,St}; - true -> check_liveness(R, Is, St) - end - end; -check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) -> - case R of - {x,X} -> - 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 -> {not_used,St}; - true -> not_used(check_liveness(R, Is, St)) - end - end - end; -check_liveness(R, [{deallocate,_}|Is], St) -> - case R of - {y,_} -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness({x,_}=R, [return|_], St) -> - case R of - {x,0} -> {used,St}; - {x,_} -> {killed,St} - end; -check_liveness(R, [{call,Live,_}|Is], St) -> - case R of - {x,X} when X < Live -> {used,St}; - {x,_} -> {killed,St}; - {y,_} -> not_used(check_liveness(R, Is, St)) - end; -check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> - case R of - {x,X} when X < Live -> - {used,St}; - {x,_} -> - {killed,St}; - {y,_} -> - case beam_jump:is_exit_instruction(I) of - false -> - 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. - {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,_} -> 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,_} -> 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}; - false -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_restore2,S,_}|Is], St) -> - case R of - S -> {used,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_save2,S,_}|Is], St) -> - case R of - S -> {used,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{move,S,D}|Is], St) -> - case R of - S -> {used,St}; - D -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> - case R of - {x,X} when X < NumFree -> {used,St}; - {x,_} -> {killed,St}; - {y,_} -> not_used(check_liveness(R, Is, St)) - end; -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 -> - {killed,St}; - {y,_} -> - %% y registers will be used if an exception occurs and - %% control transfers to the label given in the previous - %% try/2 instruction. - {used,St}; - _ -> - check_liveness(R, Is, St) - end; -check_liveness(R, [{catch_end,Y}|Is], St) -> - case R of - Y -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{get_tuple_element,S,_,D}|Is], St) -> - case R of - S -> {used,St}; - D -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_context_to_binary,S}|Is], St) -> - case R of - S -> {used,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) -> - case R of - {x,_} -> - {killed,St}; - _ -> - %% y register. Rarely happens. Be very conversative and - %% assume it's used. - {used,St} - end; -check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> - check_liveness_at(R, Fail, St); -check_liveness(R, [{line,_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> - {Ss,Ds} = split_even(L), - case member(R, [S|Ss]) of - true -> - {used,St0}; - false -> - case check_liveness_at(R, Fail, St0) of - {killed,St}=Killed -> - case member(R, Ds) of - true -> Killed; - false -> check_liveness(R, Is, St) - end; - Other -> - Other - end - 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_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, 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_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 - {value,Res} -> - {Res,St0}; - none -> - {Res,St} = case gb_trees:lookup(Lbl, Ll) of - {value,Is} -> check_liveness(R, Is, St0); - none -> {used,St0} - end, - {Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}} - end. - -not_used({used,_}=Res) -> Res; -not_used({_,St}) -> {not_used,St}. - -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_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 -%% 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 -%% -%% Annotations are not allowed. -%% -%% (Unknown instructions will cause an exception.) - -check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) -> - if - 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_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_liveness_block_1(R, Ss, Ds, Op, Is, St0) -> - case member(R, Ss) of - true -> - {used,St0}; - false -> - case check_liveness_block_2(R, Op, Ss, St0) of - {killed,St} -> - case member(R, Ds) of - true -> {killed,St}; - 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. - -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), - - %% Note that is_function/2 is a type test but is not safe. - case erl_internal:comp_op(Op, Arity) orelse - (erl_internal:new_type_test(Op, Arity) andalso - erl_bifs:is_safe(erlang, 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}. - -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), - index_labels_1(Is0, [{Lbl,Is}|Acc]); -index_labels_1([_|Is], Acc) -> - index_labels_1(Is, Acc); -index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). - -drop_labels([{label,_}|Is]) -> drop_labels(Is); -drop_labels(Is) -> Is. - - 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) -> @@ -838,485 +144,7 @@ label(Old, D, Fb) -> _ -> Fb(Old) end. -%% Help function for combine_heap_needs. - -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. - -%% Bit syntax instructions. -live_opt([{bs_context_to_binary,Src}=I|Is], Regs0, D, Acc) -> - Regs = x_live([Src], Regs0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_init,Fail,_,none,Ss,Dst}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live(Ss, x_dead([Dst], Regs0)), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_init,Fail,Info,Live0,Ss,Dst}|Is], Regs0, D, Acc) -> - Regs1 = x_dead([Dst], Regs0), - Live = live_regs(Regs1), - true = Live =< Live0, %Assertion. - Regs2 = live_call(Live), - Regs3 = x_live(Ss, Regs2), - Regs = live_join_label(Fail, D, Regs3), - I = {bs_init,Fail,Info,Live,Ss,Dst}, - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put,Fail,_,Ss}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live(Ss, Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_restore2,Src,_}=I|Is], Regs0, D, Acc) -> - Regs = x_live([Src], Regs0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_save2,Src,_}=I|Is], Regs0, D, Acc) -> - Regs = x_live([Src], Regs0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) -> - Regs0 = live_call(Live), - Regs1 = x_live([Src], Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); - -%% Other instructions. -live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> - Live0 = make_anno({used,Regs0}), - {Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]), - 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]); -live_opt([{jump,{f,L}}=I|Is], _, D, Acc) -> - Regs = gb_trees:get(L, D), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([return=I|Is], _, D, Acc) -> - live_opt(Is, 1, D, [I|Acc]); -live_opt([{catch_end,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(1), D, [I|Acc]); -live_opt([{badmatch,Src}=I|Is], _, D, Acc) -> - Regs = x_live([Src], 0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{case_end,Src}=I|Is], _, D, Acc) -> - Regs = x_live([Src], 0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_case_end,Src}=I|Is], _, D, Acc) -> - Regs = x_live([Src], 0), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([if_end=I|Is], _, D, Acc) -> - Regs = 0, - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{call,Arity,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{call_ext,Arity,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{call_fun,Arity}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity+1), D, [I|Acc]); -live_opt([{apply,Arity}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity+2), D, [I|Acc]); -live_opt([{make_fun2,_,_,_,Arity}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{test,_,Fail,Ss}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live(Ss, Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) -> - Regs0 = live_call(Live), - 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], _, 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,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) -> - live_opt(Is, 0, D, [I|Acc]); -live_opt([{wait,_}=I|Is], _, D, Acc) -> - live_opt(Is, 0, D, [I|Acc]); -live_opt([{get_map_elements,Fail,Src,{list,List}}=I|Is], Regs0, D, Acc) -> - {Ss,Ds} = split_even(List), - 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) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{kill,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{wait_timeout,_,nil}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{line,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -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. -live_opt([{trim,_,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{'%',_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{recv_set,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{recv_mark,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); - -live_opt([], _, _, Acc) -> Acc. - -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([{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_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, - live_join_labels(T, D, Regs); -live_join_labels([_|T], D, Regs) -> - live_join_labels(T, D, Regs); -live_join_labels([], _, Regs) -> Regs. - -live_join_label({f,0}, _, Regs) -> - Regs; -live_join_label({f,L}, D, Regs) -> - gb_trees:get(L, D) bor Regs. - -live_call(Live) -> (1 bsl Live) - 1. - -live_regs(Regs) -> - live_regs_1(0, Regs). - -live_regs_1(N, 0) -> N; -live_regs_1(N, Regs) -> live_regs_1(N+1, Regs bsr 1). - -x_dead([{x,N}|Rs], Regs) -> x_dead(Rs, Regs band (bnot (1 bsl N))); -x_dead([_|Rs], Regs) -> x_dead(Rs, Regs); -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. - -is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. - split_even([], Ss, Ds) -> {reverse(Ss),reverse(Ds)}; split_even([S,D|Rs], Ss, Ds) -> split_even(Rs, [S|Ss], [D|Ds]). - -%%% -%%% Add annotations for defined registers. -%%% -%%% This analysis is done by scanning the instructions in -%%% execution order. -%%% - -defs([{apply,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{bif,_,{f,Fail},_Src,Dst}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; -defs([{block,Block0}|Is], Regs0, D0) -> - {Block,Regs,D} = defs_list(Block0, Regs0, D0), - [{block,[make_anno({def,Regs0})|Block]}|defs(Is, Regs, D)]; -defs([{bs_init,{f,L},_,Live,_,Dst}=I|Is], Regs0, D) -> - Regs1 = case Live of - none -> Regs0; - _ -> init_def_regs(Live) - end, - Regs = def_regs([Dst], Regs1), - [I|defs(Is, Regs, update_regs(L, Regs, D))]; -defs([{test,bs_start_match2,{f,L},Live,_,Dst}=I|Is], _Regs, D) -> - Regs0 = init_def_regs(Live), - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, update_regs(L, Regs0, D))]; -defs([{bs_put,{f,L},_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, update_regs(L, Regs, D))]; -defs([build_stacktrace=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{call,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{call_ext,_,{extfunc,M,F,A}}=I|Is], _Regs, D) -> - case erl_bifs:is_exit_bif(M, F, A) of - false -> - [I|defs(Is, 1, D)]; - true -> - [I|defs_unreachable(Is, D)] - end; -defs([{call_ext,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{call_fun,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{'catch',_,{f,L}}=I|Is], Regs, D) -> - RegsAtLabel = init_def_regs(1), - [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))]; -defs([{catch_end,_}=I|Is], _Regs, D) -> - Regs = init_def_regs(1), - [I|defs(Is, Regs, D)]; -defs([{gc_bif,_,{f,Fail},Live,_Src,Dst}=I|Is], Regs0, D) -> - true = all_defined(Live, Regs0), %Assertion. - Regs = def_regs([Dst], init_def_regs(Live)), - [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; -defs([{get_map_elements,{f,L},_Src,{list,DstList}}=I|Is], Regs0, D) -> - {_,Ds} = beam_utils:split_even(DstList), - Regs = def_regs(Ds, Regs0), - [I|defs(Is, Regs, update_regs(L, Regs0, D))]; -defs([{get_tuple_element,_,_,Dst}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, D)]; -defs([{jump,{f,L}}=I|Is], Regs, D) -> - [I|defs_unreachable(Is, update_regs(L, Regs, D))]; -defs([{label,L}=I|Is], Regs0, D) -> - case D of - #{L:=Regs1} -> - Regs = Regs0 band Regs1, - [I|defs(Is, Regs, D)]; - #{} -> - [I|defs(Is, Regs0, D)] - end; -defs([{loop_rec,{f,L},{x,0}}=I|Is], _Regs, D0) -> - RegsAtLabel = init_def_regs(0), - D = update_regs(L, RegsAtLabel, D0), - [I|defs(Is, init_def_regs(1), D)]; -defs([{loop_rec_end,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{make_fun2,_,_,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([{move,_,Dst}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, D)]; -defs([{put_map,{f,Fail},_,_,Dst,_,_}=I|Is], Regs0, D) -> - Regs = def_regs([Dst], Regs0), - [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; -defs([raw_raise=I|Is], _Regs, D) -> - [I|defs(Is, 1, D)]; -defs([return=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{select,_,_Src,Fail,List}=I|Is], Regs, D0) -> - D = update_list([Fail|List], Regs, D0), - [I|defs_unreachable(Is, D)]; -defs([{test,_,{f,L},_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, update_regs(L, Regs, D))]; -defs([{test,_,{f,L},Live,_,Dst}=I|Is], Regs0, D) -> - true = all_defined(Live, Regs0), %Assertion. - Regs = def_regs([Dst], init_def_regs(Live)), - [I|defs(Is, Regs, update_regs(L, Regs0, D))]; -defs([{'try',_,{f,L}}=I|Is], Regs, D) -> - RegsAtLabel = init_def_regs(3), - [I|defs(Is, Regs, update_regs(L, RegsAtLabel, D))]; -defs([{try_case,_}=I|Is], _Regs, D) -> - [I|defs(Is, init_def_regs(3), D)]; -defs([{wait,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{wait_timeout,_,_}=I|Is], _Regs, D) -> - [I|defs(Is, 0, D)]; - -%% Exceptions. -defs([{badmatch,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{case_end,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([if_end=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; -defs([{try_case_end,_}=I|Is], _Regs, D) -> - [I|defs_unreachable(Is, D)]; - -%% Neutral instructions -defs([{bs_context_to_binary,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{bs_restore2,_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{bs_save2,_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{deallocate,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{kill,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{line,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{recv_mark,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{recv_set,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([timeout=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{trim,_,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{try_end,_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([{'%',_}=I|Is], Regs, D) -> - [I|defs(Is, Regs, D)]; -defs([], _, _) -> []. - -defs_unreachable([{label,L}=I|Is], D) -> - case D of - #{L:=Regs} -> - [I|defs(Is, Regs, D)]; - #{} -> - defs_unreachable(Is, D) - end; -defs_unreachable([_|Is], D) -> - defs_unreachable(Is, D); -defs_unreachable([], _D) -> []. - -defs_list(Is, Regs, D) -> - defs_list(Is, Regs, D, []). - -defs_list([{set,Ds,_,{alloc,Live,Info}}=I|Is], Regs0, D0, Acc) -> - true = all_defined(Live, Regs0), %Assertion. - D = case Info of - {gc_bif,_,{f,Fail}} -> - update_regs(Fail, Regs0, D0); - {put_map,_,{f,Fail}} -> - update_regs(Fail, Regs0, D0); - _ -> - D0 - end, - Regs = def_regs(Ds, init_def_regs(Live)), - defs_list(Is, Regs, D, [I|Acc]); -defs_list([{set,Ds,_,Info}=I|Is], Regs0, D0, Acc) -> - D = case Info of - {bif,_,{f,Fail}} -> - update_regs(Fail, Regs0, D0); - {try_catch,'catch',{f,Fail}} -> - update_regs(Fail, init_def_regs(1), D0); - {try_catch,'try',{f,Fail}} -> - update_regs(Fail, init_def_regs(3), D0); - _ -> - D0 - end, - Regs = def_regs(Ds, Regs0), - defs_list(Is, Regs, D, [I|Acc]); -defs_list([], Regs, D, Acc) -> - {reverse(Acc),Regs,D}. - -init_def_regs(Arity) -> - (1 bsl Arity) - 1. - -def_regs([{x,X}|T], Regs) -> - def_regs(T, Regs bor (1 bsl X)); -def_regs([_|T], Regs) -> - def_regs(T, Regs); -def_regs([], Regs) -> Regs. - -update_list([{f,L}|T], Regs, D0) -> - D = update_regs(L, Regs, D0), - update_list(T, Regs, D); -update_list([_|T], Regs, D) -> - update_list(T, Regs, D); -update_list([], _Regs, D) -> D. - -update_regs(L, Regs0, D) -> - case D of - #{L:=Regs1} -> - Regs = Regs0 band Regs1, - D#{L:=Regs}; - #{} -> - D#{L=>Regs0} - end. - -all_defined(Live, Regs) -> - All = (1 bsl Live) - 1, - Regs band All =:= All. - -%%% -%%% Utilities. -%%% - -%% make_anno(Anno) -> WrappedAnno. -%% Wrap an annotation term. - -make_anno(Anno) -> - {'%anno',Anno}. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index fb2e7df65c..349d74eb58 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -26,8 +26,9 @@ %% Interface for compiler. -export([module/2, format_error/1]). +-export([type_anno/1, type_anno/2, type_anno/4]). --import(lists, [any/2,dropwhile/2,foldl/3,foreach/2,reverse/1]). +-import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]). %% To be called by the compiler. @@ -44,6 +45,34 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) {error,[{atom_to_list(Mod),Es}]} end. +%% Provides a stable interface for type annotations, used by certain passes to +%% indicate that we can safely assume that a register has a given type. +-spec type_anno(term()) -> term(). +type_anno(atom) -> {atom,[]}; +type_anno(bool) -> bool; +type_anno({binary,_}) -> binary; +type_anno(cons) -> cons; +type_anno(float) -> {float,[]}; +type_anno(integer) -> {integer,[]}; +type_anno(list) -> list; +type_anno(map) -> map; +type_anno(match_context) -> match_context; +type_anno(number) -> number; +type_anno(nil) -> nil. + +-spec type_anno(term(), term()) -> term(). +type_anno(atom, Value) when is_atom(Value) -> {atom, Value}; +type_anno(float, Value) when is_float(Value) -> {float, Value}; +type_anno(integer, Value) when is_integer(Value) -> {integer, Value}. + +-spec type_anno(term(), term(), term(), term()) -> term(). +type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0, + is_map(Elements) -> + case Exact of + true -> {tuple, Size, Elements}; + false -> {tuple, [Size], Elements} + end. + -spec format_error(term()) -> iolist(). format_error({{_M,F,A},{I,Off,limit}}) -> @@ -90,34 +119,9 @@ format_error(Error) -> %% format as used in the compiler and in .S files. validate(Module, Fs) -> - Ft = index_bs_start_match(Fs, []), + Ft = index_parameter_types(Fs, []), validate_0(Module, Fs, Ft). -index_bs_start_match([{function,_,_,Entry,Code0}|Fs], Acc0) -> - Code = dropwhile(fun({label,L}) when L =:= Entry -> false; - (_) -> true - end, Code0), - case Code of - [{label,Entry}|Is] -> - Acc = index_bs_start_match_1(Is, Entry, Acc0), - index_bs_start_match(Fs, Acc); - _ -> - %% Something serious is wrong. Ignore it for now. - %% It will be detected and diagnosed later. - index_bs_start_match(Fs, Acc0) - end; -index_bs_start_match([], Acc) -> - gb_trees:from_orddict(lists:sort(Acc)). - -index_bs_start_match_1([{test,bs_start_match2,_,_,_,_}=I|_], Entry, Acc) -> - [{Entry,[I]}|Acc]; -index_bs_start_match_1([{test,_,{f,F},_},{bs_context_to_binary,_}|Is0], Entry, Acc) -> - [{label,F}|Is] = dropwhile(fun({label,L}) when L =:= F -> false; - (_) -> true - end, Is0), - index_bs_start_match_1(Is, Entry, Acc); -index_bs_start_match_1(_, _, Acc) -> Acc. - validate_0(_Module, [], _) -> []; validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> try validate_1(Code, Name, Ar, Entry, Ft) of @@ -132,41 +136,126 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> erlang:raise(Class, Error, Stack) end. +-record(value_ref, {id :: index()}). +-record(value, {op :: term(), args :: [argument()], type :: type()}). + +-type argument() :: #value_ref{} | literal(). + -type index() :: non_neg_integer(). --type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}). - --record(st, %Emulation state - {x=init_regs(0, term) :: reg_tab(),%x register info. - y=init_regs(0, initialized) :: reg_tab(),%y register info. - f=init_fregs(), % - numy=none, %Number of y registers. - h=0, %Available heap size. - 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. - puts_left=none %put/1 instructions left. - }). + +-type literal() :: {atom, [] | atom()} | + {float, [] | float()} | + {integer, [] | integer()} | + {literal, term()} | + nil. + +-type tuple_sz() :: [non_neg_integer()] | %% Inexact + non_neg_integer(). %% Exact. + +%% Match context type. +-record(ms, + {id=make_ref() :: reference(), %Unique ID. + valid=0 :: non_neg_integer(), %Valid slots + slots=0 :: non_neg_integer() %Number of slots + }). + +-type type() :: binary | + cons | + list | + map | + nil | + #ms{} | + ms_position | + none | + number | + term | + tuple_in_progress | + {tuple, tuple_sz(), #{ literal() => type() }} | + literal(). + +-type tag() :: initialized | + uninitialized | + {catchtag, [label()]} | + {trytag, [label()]}. + +-type x_regs() :: #{ {x, index()} => #value_ref{} }. +-type y_regs() :: #{ {y, index()} => tag() | #value_ref{} }. + +%% Emulation state +-record(st, + {%% All known values. + vs=#{} :: #{ #value_ref{} => #value{} }, + %% Register states. + xs=#{} :: x_regs(), + ys=#{} :: y_regs(), + f=init_fregs(), + %% A set of all registers containing "fragile" terms. That is, terms + %% that don't exist on our process heap and would be destroyed by a + %% GC. + fragile=cerl_sets:new() :: cerl_sets:set(), + %% Number of Y registers. + %% + %% Note that this may be 0 if there's a frame without saved values, + %% such as on a body-recursive call. + numy=none :: none | undecided | index(), + %% Available heap size. + h=0, + %Available heap size for floats. + hf=0, + %% Floating point state. + fls=undefined, + %% List of hot catch/try labels + ct=[], + %% Previous instruction was setelement/3. + setelem=false, + %% put/1 instructions left. + puts_left=none + }). -type label() :: integer(). -type label_set() :: gb_sets:set(label()). -type branched_tab() :: gb_trees:tree(label(), #st{}). -type ft_tab() :: gb_trees:tree(). --record(vst, %Validator state - {current=none :: #st{} | 'none', %Current state - branched=gb_trees:empty() :: branched_tab(), %States at jumps - labels=gb_sets:empty() :: label_set(), %All defined labels - ft=gb_trees:empty() :: ft_tab() %Some other functions - % in the module (those that start with bs_start_match2). - }). - -%% Match context type. --record(ms, - {id=make_ref() :: reference(), %Unique ID. - valid=0 :: non_neg_integer(), %Valid slots - slots=0 :: non_neg_integer() %Number of slots - }). +%% Validator state +-record(vst, + {%% Current state + current=none :: #st{} | 'none', + %% States at labels + branched=gb_trees:empty() :: branched_tab(), + %% All defined labels + labels=gb_sets:empty() :: label_set(), + %% Argument information of other functions in the module + ft=gb_trees:empty() :: ft_tab(), + %% Counter for #value_ref{} creation + ref_ctr=0 :: index() + }). + +index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> + Code = dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Code0), + case Code of + [{label,Entry}|Is] -> + Acc = index_parameter_types_1(Is, Entry, Acc0), + index_parameter_types(Fs, Acc); + _ -> + %% Something serious is wrong. Ignore it for now. + %% It will be detected and diagnosed later. + index_parameter_types(Fs, Acc0) + end; +index_parameter_types([], Acc) -> + gb_trees:from_orddict(sort(Acc)). + +index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> + Type = case Type0 of + match_context -> #ms{}; + _ -> Type0 + end, + Key = {Entry, Reg}, + index_parameter_types_1(Is, Entry, [{Key, Type} | Acc]); +index_parameter_types_1(_, _, Acc) -> + Acc. validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). @@ -179,14 +268,10 @@ validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) -> validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) -> Offset = 1 + length(Ls1) + 1 + length(Ls2), - EntryOK = lists:member(Entry, Ls2), + EntryOK = member(Entry, Ls2), if EntryOK -> - St = init_state(Arity), - Vst0 = #vst{current=St, - branched=gb_trees_from_list([{L,St} || L <- Ls1]), - labels=gb_sets:from_list(Ls1++Ls2), - ft=Ft}, + Vst0 = init_vst(Arity, Ls1, Ls2, Ft), MFA = {Mod,Name,Arity}, Vst = valfun(Is, MFA, Offset, Vst0), validate_fun_info_branches(Ls1, MFA, Vst); @@ -203,7 +288,13 @@ validate_fun_info_branches([], _, _) -> ok. validate_fun_info_branches_1(Arity, {_,_,Arity}, _) -> ok; validate_fun_info_branches_1(X, {Mod,Name,Arity}=MFA, Vst) -> try - get_term_type({x,X}, Vst) + case Vst of + #vst{current=#st{numy=none}} -> + ok; + #vst{current=#st{numy=Size}} -> + error({unexpected_stack_frame,Size}) + end, + assert_term({x,X}, Vst) catch Error -> I = {func_info,{atom,Mod},{atom,Name},Arity}, Offset = 2, @@ -224,19 +315,22 @@ labels_1([{line,_}|Is], R) -> labels_1(Is, R) -> {reverse(R),Is}. -init_state(Arity) -> - Xs = init_regs(Arity, term), - Ys = init_regs(0, initialized), - kill_heap_allocation(#st{x=Xs,y=Ys,numy=none,ct=[]}). +init_vst(Arity, Ls1, Ls2, Ft) -> + Vst0 = init_function_args(Arity - 1, #vst{current=#st{}}), + Branches = gb_trees_from_list([{L,Vst0#vst.current} || L <- Ls1]), + Labels = gb_sets:from_list(Ls1++Ls2), + Vst0#vst{branched=Branches, + labels=Labels, + ft=Ft}. + +init_function_args(-1, Vst) -> + Vst; +init_function_args(X, Vst) -> + init_function_args(X - 1, create_term(term, argument, [], {x,X}, Vst)). kill_heap_allocation(St) -> St#st{h=0,hf=0}. -init_regs(0, _) -> - gb_trees:empty(); -init_regs(N, Type) -> - gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]). - valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) -> Targets = gb_trees:keys(Targets0), Labels = gb_sets:to_list(Labels0), @@ -257,20 +351,25 @@ valfun([I|Is], MFA, Offset, Vst0) -> %% Instructions that are allowed in dead code or when failing, %% that is while the state is undecided in some way. -valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) -> - St = merge_states(Lbl, St0, B), - Vst#vst{current=St,branched=gb_trees:enter(Lbl, St, B), - labels=gb_sets:add(Lbl, Lbls)}; +valfun_1({label,Lbl}, #vst{current=St0, + ref_ctr=Counter0, + branched=B, + labels=Lbls}=Vst) -> + {St, Counter} = merge_states(Lbl, St0, B, Counter0), + Vst#vst{current=St, + ref_ctr=Counter, + branched=gb_trees:enter(Lbl, St, B), + labels=gb_sets:add(Lbl, Lbls)}; valfun_1(_I, #vst{current=none}=Vst) -> %% Ignore instructions after erlang:error/1,2, which %% the original R10B compiler thought would return. Vst; valfun_1({badmatch,Src}, Vst) -> - assert_term(Src, Vst), + assert_durable_term(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1({case_end,Src}, Vst) -> - assert_term(Src, Vst), + assert_durable_term(Src, Vst), verify_y_init(Vst), kill_state(Vst); valfun_1(if_end, Vst) -> @@ -278,35 +377,21 @@ valfun_1(if_end, Vst) -> kill_state(Vst); valfun_1({try_case_end,Src}, Vst) -> verify_y_init(Vst), - assert_term(Src, Vst), + assert_durable_term(Src, Vst), kill_state(Vst); -%% Instructions that can not cause exceptions -valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) -> - case Ctx of - {Tag,X} when Tag =:= x; Tag =:= y -> - Type = case gb_trees:lookup(X, Xs) of - {value,#ms{}} -> term; - _ -> get_term_type(Ctx, Vst) - end, - set_type_reg(Type, Ctx, Vst); - _ -> - error({bad_source,Ctx}) - end; +%% Instructions that cannot cause exceptions +valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> + bsm_validate_context(Ctx, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + Vst = prune_x_regs(Live, Vst0), + extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0); 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. - case get_term_type_1(Src, Vst) of - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); - Type -> set_type_reg(Type, Dst, Vst) - end; valfun_1({move,Src,Dst}, Vst) -> - Type = get_move_term_type(Src, Vst), - set_type_reg(Type, Dst, Vst); + assign(Src, Dst, Vst); valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> assert_type(float, Src, Vst), set_freg(Dst, Vst); @@ -314,15 +399,15 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - set_type_reg({float,[]}, Dst, Vst); -valfun_1({kill,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); -valfun_1({init,{y,_}=Reg}, Vst) -> - set_type_y(initialized, Reg, Vst); + create_term({float,[]}, fmove, [], Dst, Vst); +valfun_1({kill,Reg}, Vst) -> + create_tag(initialized, kill, [], Reg, Vst); +valfun_1({init,Reg}, Vst) -> + create_tag(initialized, init, [], Reg, Vst); valfun_1({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> - case is_bif_safe(Op, length(Src)) of +valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> + case is_bif_safe(Op, length(Ss)) of false -> %% Since the BIF can fail, make sure that any catch state %% is updated. @@ -330,21 +415,32 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> true -> %% It can't fail, so we finish handling it here (not updating %% catch state). - validate_src(Src, Vst), - Type = bif_type(Op, Src, Vst), - set_type_reg(Type, Dst, Vst) + validate_src(Ss, Vst), + Type = bif_return_type(Op, Ss, Vst), + extract_term(Type, {bif,Op}, Ss, Dst, Vst) end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> assert_term(A, Vst0), assert_term(B, Vst0), Vst = eat_heap(2, Vst0), - set_type_reg(cons, Dst, Vst); + create_term(cons, put_list, [A, B], Dst, Vst); +valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> + _ = [assert_term(El, Vst0) || El <- Elements], + Size = length(Elements), + Vst = eat_heap(Size+1, Vst0), + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = get_term_type(Val, Vst0), + Es = set_element_type({integer,Index}, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, Elements), + Type = {tuple,Size,Es}, + create_term(Type, put_tuple2, [], 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 = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1), #vst{current=St0} = Vst, - St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}}, + St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; valfun_1({put,Src}, Vst0) -> assert_term(Src, Vst0), @@ -353,11 +449,14 @@ valfun_1({put,Src}, Vst0) -> case St0 of #st{puts_left=none} -> error(not_building_a_tuple); - #st{puts_left={1,{Dst,Type}}} -> + #st{puts_left={1,{Dst,Sz,Es0}}} -> + Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) }, 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}}, + create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St}); + #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> + Index = Sz - PutsLeft + 1, + Es = Es0#{ {integer,Index} => get_term_type(Src, Vst0) }, + St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; %% Instructions for optimization of selective receives. @@ -370,13 +469,28 @@ valfun_1(remove_message, Vst) -> %% The message term is no longer fragile. It can be used %% without restrictions. remove_fragility(Vst); +valfun_1({'%', {type_info, Reg, match_context}}, Vst) -> + update_type(fun meet/2, #ms{}, Reg, Vst); +valfun_1({'%', {type_info, Reg, Type}}, Vst) -> + %% Explicit type information inserted by optimization passes to indicate + %% that Reg has a certain type, so that we can accept cross-function type + %% optimizations. + update_type(fun meet/2, Type, Reg, Vst); +valfun_1({'%', {remove_fragility, Reg}}, Vst) -> + %% This is a hack to make prim_eval:'receive'/2 work. + %% + %% Normally it's illegal to pass fragile terms as a function argument as we + %% have no way of knowing what the callee will do with it, but we know that + %% prim_eval:'receive'/2 won't leak the term, nor cause a GC since it's + %% disabled while matching messages. + remove_fragility(Reg, Vst); valfun_1({'%',_}, Vst) -> Vst; valfun_1({line,_}, Vst) -> Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> - case return_type(Func, Vst) of + case call_return_type(Func, Vst) of exception -> verify_live(Live, Vst), %% The stack will be scanned, so Y registers @@ -391,88 +505,122 @@ valfun_1(_I, #vst{current=#st{ct=undecided}}) -> %% %% Allocate and deallocate, et.al valfun_1({allocate,Stk,Live}, Vst) -> - allocate(false, Stk, 0, Live, Vst); + allocate(uninitialized, Stk, 0, Live, Vst); valfun_1({allocate_heap,Stk,Heap,Live}, Vst) -> - allocate(false, Stk, Heap, Live, Vst); + allocate(uninitialized, Stk, Heap, Live, Vst); valfun_1({allocate_zero,Stk,Live}, Vst) -> - allocate(true, Stk, 0, Live, Vst); + allocate(initialized, Stk, 0, Live, Vst); valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) -> - allocate(true, Stk, Heap, Live, Vst); + allocate(initialized, Stk, Heap, Live, Vst); valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) -> verify_no_ct(Vst), deallocate(Vst); valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_1({trim,N,Remaining}, #vst{current=#st{y=Yregs0,numy=NumY}=St}=Vst) -> +valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) -> + #st{numy=NumY} = St0, if - N =< NumY, N+Remaining =:= NumY -> - Yregs1 = [{Y-N,Type} || {Y,Type} <- gb_trees:to_list(Yregs0), Y >= N], - Yregs = gb_trees_from_list(Yregs1), - Vst#vst{current=St#st{y=Yregs,numy=NumY-N}}; - true -> - error({trim,N,Remaining,allocated,NumY}) + N =< NumY, N+Remaining =:= NumY -> + Vst#vst{current=trim_stack(N, 0, NumY, St0)}; + N > NumY; N+Remaining =/= NumY -> + error({trim,N,Remaining,allocated,NumY}) end; %% Catch & try. -valfun_1({'catch',Dst,{f,Fail}}, Vst0) when Fail /= none -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({catchtag,[Fail]}, Dst, Vst0), - Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({'try',Dst,{f,Fail}}, Vst0) -> - Vst = #vst{current=#st{ct=Fails}=St} = - set_type_y({trytag,[Fail]}, Dst, Vst0), - Vst#vst{current=St#st{ct=[[Fail]|Fails]}}; -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {catchtag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xs = gb_trees_from_list([{0,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; - Type -> - error({bad_type,Type}) +valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> + init_try_catch_branch(catchtag, Dst, Fail, Vst); +valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> + init_try_catch_branch(trytag, Dst, Fail, Vst); +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {catchtag,Fail} -> + %% {x,0} contains the caught term, if any. + create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {trytag,Fail} -> - Vst = case Fail of - [FailLabel] -> branch_state(FailLabel, Vst0); - _ -> Vst0 - end, - St = St0#st{ct=Fails,fls=undefined}, - set_catch_end(Reg, Vst#vst{current=St}); - Type -> - error({bad_type,Type}) +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) -> + case get_tag_type(Reg, Vst) of + {trytag,Fail} -> + %% Kill the catch tag, note that x registers are unaffected. + kill_catch_tag(Reg, Vst); + Type -> + error({wrong_tag_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) -> - case get_special_y_type(Reg, Vst0) of - {trytag,Fail} -> - Vst = #vst{current=St} = set_catch_end(Reg, Vst0), - Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]), - Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined}}; - Type -> - error({bad_type,Type}) +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> + case get_tag_type(Reg, Vst0) of + {trytag,Fail} -> + %% Kill the catch tag and all x registers. + Vst1 = prune_x_regs(0, kill_catch_tag(Reg, Vst0)), + + %% Class:Error:Stacktrace + Vst2 = create_term({atom,[]}, try_case, [], {x,0}, Vst1), + Vst = create_term(term, try_case, [], {x,1}, Vst2), + create_term(term, try_case, [], {x,2}, Vst); + Type -> + error({wrong_tag_type,Type}) end; valfun_1({get_list,Src,D1,D2}, Vst0) -> + assert_not_literal(Src), assert_type(cons, Src, Vst0), - Vst = set_type_reg(term, Src, D1, Vst0), - set_type_reg(term, Src, D2, Vst); + Vst = extract_term(term, get_hd, [Src], D1, Vst0), + extract_term(term, get_tl, [Src], D2, Vst); valfun_1({get_hd,Src,Dst}, Vst) -> + assert_not_literal(Src), assert_type(cons, Src, Vst), - set_type_reg(term, Src, Dst, Vst); + extract_term(term, get_hd, [Src], Dst, Vst); valfun_1({get_tl,Src,Dst}, Vst) -> + assert_not_literal(Src), 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); + extract_term(term, get_tl, [Src], Dst, Vst); +valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> + assert_not_literal(Src), + assert_type({tuple_element,N+1}, Src, Vst), + Index = {integer,N+1}, + Type = get_element_type(Index, Src, Vst), + extract_term(Type, {bif,element}, [Index, Src], Dst, Vst); +valfun_1({jump,{f,Lbl}}, Vst) -> + branch(Lbl, Vst, + fun(SuccVst) -> + %% The next instruction is never executed. + kill_state(SuccVst) + end); valfun_1(I, Vst) -> valfun_2(I, Vst). -%% Update branched state if necessary and try next set of instructions. -valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> - valfun_3(I, Vst); +init_try_catch_branch(Tag, Dst, Fail, Vst0) -> + Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0), + #vst{current=#st{ct=Fails}=St0} = Vst1, + St = St0#st{ct=[[Fail]|Fails]}, + Vst = Vst0#vst{current=St}, + + branch(Fail, Vst, + fun(CatchVst) -> + #vst{current=#st{ys=Ys}} = CatchVst, + maps:fold(fun init_catch_handler_1/3, CatchVst, Ys) + end, + fun(SuccVst) -> + %% All potentially-throwing instructions after this + %% one will implicitly branch to the fail label; + %% see valfun_2/2 + SuccVst + end). + +%% Set the initial state at the try/catch label. Assume that Y registers +%% contain terms or try/catch tags. +init_catch_handler_1(Reg, initialized, Vst) -> + create_term(term, 'catch_handler', [], Reg, Vst); +init_catch_handler_1(Reg, uninitialized, Vst) -> + create_term(term, 'catch_handler', [], Reg, Vst); +init_catch_handler_1(_, _, Vst) -> + Vst. + valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> - %% Update branched state + %% We have an active try/catch tag and we can jump there from this + %% instruction, so we need to update the branched state of the try/catch + %% handler. valfun_3(I, branch_state(Fail, Vst)); +valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> + valfun_3(I, Vst); valfun_2(_, _) -> error(ambiguous_catch_try_state). @@ -480,17 +628,23 @@ valfun_2(_, _) -> %% Floating point. valfun_3({fconv,Src,{fr,_}=Dst}, Vst) -> assert_term(Src, Vst), - set_freg(Dst, Vst); -valfun_3({bif,fadd,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fdiv,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fmul,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fnegate,_,[_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); -valfun_3({bif,fsub,_,[_,_]=Src,Dst}, Vst) -> - float_op(Src, Dst, Vst); + + %% An exception is raised on error, hence branching to 0. + branch(0, Vst, + fun(SuccVst0) -> + SuccVst = update_type(fun meet/2, number, Src, SuccVst0), + set_freg(Dst, SuccVst) + end); +valfun_3({bif,fadd,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fmul,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fnegate,_,[_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); +valfun_3({bif,fsub,_,[_,_]=Ss,Dst}, Vst) -> + float_op(Ss, Dst, Vst); valfun_3(fclearerror, Vst) -> case get_fls(Vst) of undefined -> ok; @@ -541,67 +695,87 @@ valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs -valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), - Vst1 = branch_state(Fail, Vst0), - TupleType = upgrade_tuple_type({tuple,[0]}, TupleType0), - Vst = set_type(TupleType, Tuple, Vst1), - set_type_reg({integer,[]}, Dst, Vst); -valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> - TupleType0 = get_term_type(Tuple, Vst0), - PosType = get_term_type(Pos, 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, Tuple, Dst, Vst); +valfun_4({bif,element,{f,Fail},[Pos,Src],Dst}, Vst) -> + branch(Fail, Vst, + fun(SuccVst0) -> + PosType = get_term_type(Pos, SuccVst0), + TupleType = {tuple,[get_tuple_size(PosType)],#{}}, + + SuccVst1 = update_type(fun meet/2, TupleType, + Src, SuccVst0), + SuccVst = update_type(fun meet/2, {integer,[]}, + Pos, SuccVst1), + + ElementType = get_element_type(PosType, Src, SuccVst), + extract_term(ElementType, {bif,element}, [Pos,Src], + Dst, SuccVst) + end); 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), - 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) -> +valfun_4({bif,Op,{f,Fail},[Src]=Ss,Dst}, Vst) when Op =:= hd; Op =:= tl -> + assert_term(Src, Vst), + branch(Fail, Vst, + fun(FailVst) -> + update_type(fun subtract/2, cons, Src, FailVst) + end, + fun(SuccVst0) -> + SuccVst = update_type(fun meet/2, cons, Src, SuccVst0), + extract_term(term, {bif,Op}, Ss, Dst, SuccVst) + end); +valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst) -> + validate_src(Ss, Vst), + branch(Fail, Vst, + fun(SuccVst0) -> + %% Infer argument types. Note that we can't subtract + %% types as the BIF could fail for reasons other than + %% bad argument types. + ArgTypes = bif_arg_types(Op, Ss), + SuccVst = foldl(fun({Arg, T}, V) -> + update_type(fun meet/2, T, Arg, V) + end, SuccVst0, zip(Ss, ArgTypes)), + Type = bif_return_type(Op, Ss, SuccVst), + extract_term(Type, {bif,Op}, Ss, Dst, SuccVst) + end); +valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> + validate_src(Ss, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), + + %% Heap allocations and X registers are killed regardless of whether we + %% fail or not, as we may fail after GC. St = kill_heap_allocation(St0), - Vst1 = Vst0#vst{current=St}, - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - validate_src(Src, Vst), - Type0 = bif_type(Op, Src, Vst), - Type = propagate_fragility(Type0, Src, Vst), - set_type_reg(Type, Dst, Vst); + Vst = prune_x_regs(Live, Vst0#vst{current=St}), + + branch(Fail, Vst, + fun(SuccVst0) -> + ArgTypes = bif_arg_types(Op, Ss), + SuccVst = foldl(fun({Arg, T}, V) -> + update_type(fun meet/2, T, Arg, V) + end, SuccVst0, zip(Ss, ArgTypes)), + + Type = bif_return_type(Op, Ss, SuccVst), + + %% We're passing Vst0 as the original because the + %% registers were pruned before the branch. + extract_term(Type, {gc_bif,Op}, Ss, Dst, SuccVst, Vst0) + end); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> - assert_term({x,0}, Vst), + assert_durable_term({x,0}, Vst), kill_state(Vst); valfun_4(return, #vst{current=#st{numy=NumY}}) -> error({stack_frame,NumY}); -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), - %% 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({loop_rec,{f,Fail},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. + branch(Fail, Vst, + fun(SuccVst0) -> + {Ref, SuccVst} = new_value(term, loop_rec, [], SuccVst0), + mark_fragile(Dst, set_reg_vref(Ref, Dst, SuccVst)) + end); valfun_4({wait,_}, Vst) -> verify_y_init(Vst), kill_state(Vst); @@ -612,131 +786,169 @@ valfun_4({wait_timeout,_,Src}, 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)}}; +valfun_4(timeout, Vst) -> + prune_x_regs(0, Vst); valfun_4(send, Vst) -> call(send, 2, Vst); -valfun_4({set_tuple_element,Src,Tuple,I}, Vst) -> +valfun_4({set_tuple_element,Src,Tuple,N}, Vst) -> + I = N + 1, assert_term(Src, Vst), - assert_type({tuple_element,I+1}, Tuple, Vst), - Vst; + assert_type({tuple_element,I}, Tuple, Vst), + %% Manually update the tuple type; we can't rely on the ordinary update + %% helpers as we must support overwriting (rather than just widening or + %% narrowing) known elements, and we can't use extract_term either since + %% the source tuple may be aliased. + {tuple, Sz, Es0} = get_term_type(Tuple, Vst), + Es = set_element_type({integer,I}, get_term_type(Src, Vst), Es0), + override_type({tuple, Sz, Es}, Tuple, Vst); %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> assert_term(Src, Vst), - Lbls = [L || {f,L} <- Choices]++[Fail], - kill_state(foldl(fun(L, S) -> branch_state(L, S) end, Vst, Lbls)); + assert_choices(Choices), + validate_select_val(Fail, Choices, Src, 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))); + assert_arities(Choices), + validate_select_tuple_arity(Fail, Choices, Tuple, Vst); %% New bit syntax matching instructions. -valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> - %% If source and destination registers are the same, match state - %% is OK as input. - 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{} -> - %% The failure branch will never be taken when Ctx - %% is a match context. Therefore, the type for Ctx - %% at the failure label must not be match_context - %% (or we could reject legal code). - set_type_reg(term, Ctx, Vst1); - _ -> - Vst1 - end, - Vst = branch_state(Fail, BranchVst), - set_type_reg(bsm_match_state(NeedSlots), Ctx, Vst); -valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) -> - assert_term(Src, Vst0), - 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), Src, Dst, Vst); +valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, bsm_match_state(), Src, Dst, Vst); +valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) -> + validate_bs_start_match(Fail, Live, 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); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_skip_bits2,{f,Fail},[Ctx,Src,_,_]}, Vst) -> bsm_validate_context(Ctx, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) -> bsm_validate_context(Ctx, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_test_unit,{f,Fail},[Ctx,_]}, Vst) -> bsm_validate_context(Ctx, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(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, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst); -valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],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, {integer, []}, Dst, Vst); -valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],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, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst); +valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst); +valfun_4({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> + validate_bs_get(Op, 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) -> bsm_restore(Ctx, SavePoint, Vst); +valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> + bsm_validate_context(Ctx, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + Vst = prune_x_regs(Live, Vst0), + create_term(ms_position, bs_get_position, [Ctx], Dst, Vst, Vst0); +valfun_4({bs_set_position, Ctx, Pos}, Vst) -> + bsm_validate_context(Ctx, Vst), + assert_type(ms_position, Pos, Vst), + Vst; %% Other test instructions. -valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) -> - assert_term(Float, Vst), - set_type({float,[]}, Float, branch_state(Lbl, Vst)); -valfun_4({test,is_tuple,{f,Lbl},[Tuple]}, Vst) -> - Type0 = get_term_type(Tuple, Vst), - Type = upgrade_tuple_type({tuple,[0]}, Type0), - set_type(Type, Tuple, branch_state(Lbl, Vst)); -valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) -> - assert_term(Cons, Vst), - set_type(cons, Cons, branch_state(Lbl, 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), - branch_state(Lbl, Vst); -valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> - Vst = branch_state(Lbl, Vst0), - case Src of - {Tag,_} when Tag =:= x; Tag =:= y -> - set_type_reg(map, Src, Vst); - {literal,Map} when is_map(Map) -> - Vst; - _ -> - kill_state(Vst) - end; + branch(Lbl, Vst, fun(V) -> V end); +valfun_4({test,is_atom,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {atom,[]}, Src, Vst); +valfun_4({test,is_binary,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, binary, Src, Vst); +valfun_4({test,is_bitstr,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, binary, Src, Vst); +valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, bool, Src, Vst); +valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {float,[]}, Src, Vst); +valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {tuple,[0],#{}}, Src, Vst); +valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, {integer,[]}, Src, Vst); +valfun_4({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, cons, Src, Vst); +valfun_4({test,is_number,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, number, Src, Vst); +valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, list, Src, Vst); +valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) -> + type_test(Lbl, map, Src, Vst); +valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) -> + %% is_nil is an exact check against the 'nil' value, and should not be + %% treated as a simple type test. + assert_term(Src, Vst), + branch(Lbl, Vst, + fun(FailVst) -> + update_ne_types(Src, nil, FailVst) + end, + fun(SuccVst) -> + update_eq_types(Src, nil, SuccVst) + end); +valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> + assert_type(tuple, Tuple, Vst), + Type = {tuple, Sz, #{}}, + type_test(Lbl, Type, Tuple, Vst); +valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) -> + assert_term(Src, Vst), + Type = {tuple, Sz, #{ {integer,1} => Atom }}, + type_test(Lbl, Type, Src, Vst); +valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> + validate_src(Ss, Vst), + branch(Lbl, Vst, + fun(FailVst) -> + update_ne_types(Src, Val, FailVst) + end, + fun(SuccVst) -> + update_eq_types(Src, Val, SuccVst) + end); +valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> + validate_src(Ss, Vst), + branch(Lbl, Vst, + fun(FailVst) -> + update_eq_types(Src, Val, FailVst) + end, + fun(SuccVst) -> + update_ne_types(Src, Val, SuccVst) + end); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> + %% is_pid, is_reference, et cetera. validate_src(Src, Vst), - branch_state(Lbl, Vst); + branch(Lbl, Vst, fun(V) -> V end); valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> assert_term(A, Vst), assert_term(B, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + branch(Fail, Vst, + fun(SuccVst) -> + create_term({integer,[]}, bs_add, [A, B], Dst, SuccVst) + end); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + branch(Fail, Vst, + fun(SuccVst) -> + create_term({integer,[]}, bs_utf8_size, [A], Dst, SuccVst) + end); valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); + branch(Fail, Vst, + fun(SuccVst) -> + create_term({integer,[]}, bs_utf16_size, [A], Dst, SuccVst) + end); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -746,10 +958,12 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> true -> assert_term(Sz, Vst0) end, - Vst1 = heap_alloc(Heap, Vst0), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + Vst = heap_alloc(Heap, Vst0), + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + create_term(binary, bs_init2, [], Dst, SuccVst, SuccVst0) + end); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), @@ -759,116 +973,217 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> true -> assert_term(Sz, Vst0) end, - Vst1 = heap_alloc(Heap, Vst0), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); + Vst = heap_alloc(Heap, Vst0), + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + create_term(binary, bs_init_bits, [], Dst, SuccVst) + end); 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), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - set_type_reg(binary, Dst, Vst); -valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) -> - assert_term(Bits, Vst0), - assert_term(Bin, Vst0), - Vst = branch_state(Fail, Vst0), - set_type_reg(binary, Dst, Vst); + Vst = heap_alloc(Heap, Vst0), + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + create_term(binary, bs_append, [Bin], Dst, SuccVst, SuccVst0) + end); +valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst) -> + assert_term(Bits, Vst), + assert_term(Bin, Vst), + branch(Fail, Vst, + fun(SuccVst) -> + create_term(binary, bs_private_append, [Bin], Dst, SuccVst) + end); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, binary, Src, SuccVst) + end); valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {float,[]}, Src, SuccVst) + end); valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), - branch_state(Fail, Vst); + branch(Fail, Vst, + fun(SuccVst) -> + update_type(fun meet/2, {integer,[]}, Src, SuccVst) + end); %% Map instructions. -valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); -valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> - verify_put_map(Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); +valfun_4({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> + verify_put_map(Op, Fail, Src, Dst, Live, List, Vst); valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> verify_get_map(Fail, Src, List, Vst); valfun_4(_, _) -> error(unknown_instruction). verify_get_map(Fail, Src, List, Vst0) -> + assert_not_literal(Src), %OTP 22. assert_type(map, Src, Vst0), - Vst1 = foldl(fun(D, Vsti) -> - case is_reg_defined(D,Vsti) of - true -> set_type_reg(term,D,Vsti); - false -> Vsti - end - end, Vst0, extract_map_vals(List)), - Vst2 = branch_state(Fail, Vst1), - Keys = extract_map_keys(List), - assert_unique_map_keys(Keys), - verify_get_map_pair(List, Src, Vst0, Vst2). - -extract_map_vals([_Key,Val|T]) -> - [Val|extract_map_vals(T)]; -extract_map_vals([]) -> []. + + branch(Fail, Vst0, + fun(FailVst) -> + clobber_map_vals(List, Src, FailVst) + end, + fun(SuccVst) -> + Keys = extract_map_keys(List), + assert_unique_map_keys(Keys), + extract_map_vals(List, Src, SuccVst, SuccVst) + end). + +%% get_map_elements may leave its destinations in an inconsistent state when +%% the fail label is taken. Consider the following: +%% +%% {get_map_elements,{f,7},{x,1},{list,[{atom,a},{x,1},{atom,b},{x,2}]}}. +%% +%% If 'a' exists but not 'b', {x,1} is overwritten when we jump to {f,7}. +%% +%% We must be careful to preserve the uninitialized status for Y registers +%% that have been allocated but not yet defined. +clobber_map_vals([Key,Dst|T], Map, Vst0) -> + case is_reg_initialized(Dst, Vst0) of + true -> + Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0), + clobber_map_vals(T, Map, Vst); + false -> + clobber_map_vals(T, Map, Vst0) + end; +clobber_map_vals([], _Map, Vst) -> + Vst. + +is_reg_initialized({x,_}=Reg, #vst{current=#st{xs=Xs}}) -> + is_map_key(Reg, Xs); +is_reg_initialized({y,_}=Reg, #vst{current=#st{ys=Ys}}) -> + case Ys of + #{Reg:=Val} -> + Val =/= uninitialized; + #{} -> + false + end; +is_reg_initialized(V, #vst{}) -> error({not_a_register, V}). extract_map_keys([Key,_Val|T]) -> [Key|extract_map_keys(T)]; extract_map_keys([]) -> []. -verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) -> - assert_term(Src, Vst0), - Vsti = set_type_reg(term, Map, Dst, Vsti0), - verify_get_map_pair(Vs, Map, Vst0, Vsti); -verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst. +extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) -> + assert_term(Key, Vst0), + Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0), + extract_map_vals(Vs, Map, Vst0, Vsti); +extract_map_vals([], _Map, _Vst0, Vst) -> + Vst. -verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> +verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), - foreach(fun (Term) -> assert_term(Term, Vst0) end, List), - Vst1 = heap_alloc(0, Vst0), - Vst2 = branch_state(Fail, Vst1), - Vst = prune_x_regs(Live, Vst2), - Keys = extract_map_keys(List), - assert_unique_map_keys(Keys), - set_type_reg(map, Dst, Vst). + _ = [assert_term(Term, Vst0) || Term <- List], + Vst = heap_alloc(0, Vst0), + + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + Keys = extract_map_keys(List), + assert_unique_map_keys(Keys), + create_term(map, Op, [Src], Dst, SuccVst, SuccVst0) + end). + +%% +%% Common code for validating bs_start_match* instructions. +%% + +validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> + verify_live(Live, Vst), + verify_y_init(Vst), + + %% #ms{} can represent either a match context or a term, so we have to mark + %% the source as a term if it fails with a match context as an input. This + %% hack is only needed until we get proper union types. + branch(Fail, Vst, + fun(FailVst) -> + case get_movable_term_type(Src, FailVst) of + #ms{} -> override_type(term, Src, FailVst); + _ -> FailVst + end + end, + fun(SuccVst0) -> + SuccVst1 = update_type(fun meet/2, binary, + Src, SuccVst0), + SuccVst = prune_x_regs(Live, SuccVst1), + extract_term(Type, bs_start_match, [Src], Dst, + SuccVst, SuccVst0) + end). %% %% Common code for validating bs_get* instructions. %% -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(Type, Dst, Vst). +validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) -> + bsm_validate_context(Ctx, Vst), + verify_live(Live, Vst), + verify_y_init(Vst), + + branch(Fail, Vst, + fun(SuccVst0) -> + SuccVst = prune_x_regs(Live, SuccVst0), + extract_term(Type, Op, [Ctx], Dst, SuccVst, SuccVst0) + end). %% %% 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). +validate_bs_skip_utf(Fail, Ctx, Live, Vst) -> + bsm_validate_context(Ctx, Vst), + verify_y_init(Vst), + verify_live(Live, Vst), + + branch(Fail, Vst, + fun(SuccVst) -> + prune_x_regs(Live, SuccVst) + end). + +%% +%% Common code for is_$type instructions. +%% +type_test(Fail, Type, Reg, Vst) -> + assert_term(Reg, Vst), + branch(Fail, Vst, + fun(FailVst) -> + update_type(fun subtract/2, Type, Reg, FailVst) + end, + fun(SuccVst) -> + update_type(fun meet/2, Type, Reg, SuccVst) + end). %% %% Special state handling for setelement/3 and set_tuple_element/3 instructions. @@ -885,34 +1200,29 @@ val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; +val_dsetel({get_tuple_element,_,_,_}, Vst) -> + Vst; val_dsetel({line,_}, Vst) -> Vst; val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; val_dsetel(_, Vst) -> Vst. -kill_state(#vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> - %% There is an active catch. Make sure that we merge the state into - %% the catch label before clearing it, so that that we can be sure - %% that the label gets a state. - kill_state_1(branch_state(Fail, Vst)); kill_state(Vst) -> - kill_state_1(Vst). - -kill_state_1(Vst) -> Vst#vst{current=none}. %% A "plain" call. %% The stackframe must be initialized. %% The instruction will return to the instruction following the call. -call(Name, Live, #vst{current=St}=Vst) -> - verify_call_args(Name, Live, Vst), - verify_y_init(Vst), - case return_type(Name, Vst) of - Type when Type =/= exception -> - %% Type is never 'exception' because it has been handled earlier. - Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs,f=init_fregs()}} +call(Name, Live, #vst{current=St0}=Vst0) -> + verify_call_args(Name, Live, Vst0), + verify_y_init(Vst0), + case call_return_type(Name, Vst0) of + Type when Type =/= exception -> + %% Type is never 'exception' because it has been handled earlier. + St = St0#st{f=init_fregs()}, + Vst = prune_x_regs(0, Vst0#vst{current=St}), + create_term(Type, call, [], {x,0}, Vst) end. %% Tail call. @@ -928,79 +1238,131 @@ tail_call(Name, Live, Vst0) -> verify_call_args(_, 0, #vst{}) -> ok; verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - verify_local_call(Lbl, Live, Vst); + verify_local_args(Live - 1, Lbl, #{}, Vst); verify_call_args(_, Live, Vst) when is_integer(Live)-> - verify_call_args_1(Live, Vst); + verify_remote_args_1(Live - 1, Vst); verify_call_args(_, Live, _) -> error({bad_number_of_live_regs,Live}). -verify_call_args_1(0, _) -> ok; -verify_call_args_1(N, Vst) -> - X = N - 1, - get_term_type({x,X}, Vst), - verify_call_args_1(X, Vst). - -verify_local_call(Lbl, Live, Vst) -> - case all_ms_in_x_regs(Live, Vst) of - [{R,Ctx}] -> - %% Verify that there is a suitable bs_start_match2 instruction. - verify_call_match_context(Lbl, R, Vst), - - %% Since the callee has consumed the match context, - %% there must be no additional copies in Y registers. - #ms{id=Id} = Ctx, - case ms_in_y_regs(Id, Vst) of - [] -> - ok; - [_|_]=Ys -> - error({multiple_match_contexts,[R|Ys]}) - end; - [_,_|_]=Xs0 -> - Xs = [R || {R,_} <- Xs0], - error({multiple_match_contexts,Xs}); - [] -> - ok +verify_remote_args_1(-1, _) -> + ok; +verify_remote_args_1(X, Vst) -> + assert_durable_term({x, X}, Vst), + verify_remote_args_1(X - 1, Vst). + +verify_local_args(-1, _Lbl, _CtxIds, _Vst) -> + ok; +verify_local_args(X, Lbl, CtxIds, Vst) -> + Reg = {x, X}, + assert_not_fragile(Reg, Vst), + case get_movable_term_type(Reg, Vst) of + #ms{id=Id}=Type -> + case CtxIds of + #{ Id := Other } -> + error({multiple_match_contexts, [Reg, Other]}); + #{} -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) + end; + Type -> + verify_arg_type(Lbl, Reg, Type, Vst), + verify_local_args(X - 1, Lbl, CtxIds, Vst) end. -all_ms_in_x_regs(0, _Vst) -> - []; -all_ms_in_x_regs(Live0, Vst) -> - Live = Live0 - 1, - R = {x,Live}, - case get_move_term_type(R, Vst) of - #ms{}=M -> - [{R,M}|all_ms_in_x_regs(Live, Vst)]; - _ -> - all_ms_in_x_regs(Live, Vst) +%% Verifies that the given argument narrows to what the function expects. +verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) -> + %% Match contexts require explicit support, and may not be passed to a + %% function that accepts arbitrary terms. + case gb_trees:lookup({Lbl, Reg}, Ft) of + {value, #ms{}} -> ok; + _ -> error(no_bs_start_match2) + end; +verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) -> + case gb_trees:lookup({Lbl, Reg}, Ft) of + {value, #ms{}} -> + %% Functions that accept match contexts also accept all other + %% terms. This will change once we support union types. + ok; + {value, RequiredType} -> + case vat_1(GivenType, RequiredType) of + true -> ok; + false -> error({bad_arg_type, Reg, GivenType, RequiredType}) + end; + none -> + ok end. -ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) -> - Ys = gb_trees:to_list(Ys0), - [{y,Y} || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id]. +%% Checks whether the Given argument is compatible with the Required one. This +%% is essentially a relaxed version of 'meet(Given, Req) =:= Given', where we +%% accept that the Given value has the right type but not necessarily the exact +%% same value; if {atom,gurka} is required, we'll consider {atom,[]} valid. +%% +%% This will catch all problems that could crash the emulator, like passing a +%% 1-tuple when the callee expects a 3-tuple, but some value errors might slip +%% through. +vat_1(Same, Same) -> true; +vat_1({atom,A}, {atom,B}) -> A =:= B orelse is_list(A) orelse is_list(B); +vat_1({atom,A}, bool) -> is_boolean(A) orelse is_list(A); +vat_1(bool, {atom,B}) -> is_boolean(B) orelse is_list(B); +vat_1(cons, list) -> true; +vat_1({float,A}, {float,B}) -> A =:= B orelse is_list(A) orelse is_list(B); +vat_1({float,_}, number) -> true; +vat_1({integer,A}, {integer,B}) -> A =:= B orelse is_list(A) orelse is_list(B); +vat_1({integer,_}, number) -> true; +vat_1(_, {literal,_}) -> false; +vat_1({literal,_}=Lit, Required) -> vat_1(get_literal_type(Lit), Required); +vat_1(nil, list) -> true; +vat_1({tuple,SzA,EsA}, {tuple,SzB,EsB}) -> + if + is_list(SzB) -> + tuple_sz(SzA) >= tuple_sz(SzB) andalso vat_elements(EsA, EsB); + SzA =:= SzB -> + vat_elements(EsA, EsB); + SzA =/= SzB -> + false + end; +vat_1(_, _) -> false. -verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) -> - case gb_trees:lookup(Lbl, Ft) of - none -> - error(no_bs_start_match2); - {value,[{test,bs_start_match2,_,_,[Ctx,_],Ctx}|_]} -> - ok; - {value,[{test,bs_start_match2,_,_,_,_}=I|_]} -> - error({unsuitable_bs_start_match2,I}) - end. +vat_elements(EsA, EsB) -> + maps:fold(fun(Key, Req, Acc) -> + case EsA of + #{ Key := Given } -> Acc andalso vat_1(Given, Req); + #{} -> false + end + end, true, EsB). -allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}}=Vst0) -> +allocate(Tag, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> verify_live(Live, Vst0), - Vst = #vst{current=St} = prune_x_regs(Live, Vst0), - Ys = init_regs(Stk, case Zero of - true -> initialized; - false -> uninitialized - end), - heap_alloc(Heap, Vst#vst{current=St#st{y=Ys,numy=Stk}}); + Vst1 = Vst0#vst{current=St#st{numy=Stk}}, + Vst2 = prune_x_regs(Live, Vst1), + Vst = init_stack(Tag, Stk - 1, Vst2), + heap_alloc(Heap, Vst); allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> error({existing_stack_frame,{size,Numy}}). deallocate(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. + Vst#vst{current=St#st{ys=#{},numy=none}}. + +init_stack(_Tag, -1, Vst) -> + Vst; +init_stack(Tag, Y, Vst) -> + init_stack(Tag, Y - 1, create_tag(Tag, allocate, [], {y,Y}, Vst)). + +trim_stack(From, To, Top, #st{ys=Ys0}=St) when From =:= Top -> + Ys = maps:filter(fun({y,Y}, _) -> Y < To end, Ys0), + St#st{numy=To,ys=Ys}; +trim_stack(From, To, Top, St0) -> + Src = {y, From}, + Dst = {y, To}, + + #st{ys=Ys0} = St0, + Ys = case Ys0 of + #{ Src := Ref } -> Ys0#{ Dst => Ref }; + #{} -> error({invalid_shift,Src,Dst}) + end, + St = St0#st{ys=Ys}, + + trim_stack(From + 1, To + 1, Top, St). test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), @@ -1025,13 +1387,43 @@ heap_alloc_2([{floats,Floats}|T], St0) -> St = St0#st{hf=Floats}, heap_alloc_2(T, St); heap_alloc_2([], St) -> St. - -prune_x_regs(Live, #vst{current=#st{x=Xs0}=St0}=Vst) when is_integer(Live) -> - Xs1 = gb_trees:to_list(Xs0), - Xs = [P || {R,_}=P <- Xs1, R < Live], - St = St0#st{x=gb_trees:from_orddict(Xs)}, + +prune_x_regs(Live, #vst{current=St0}=Vst) when is_integer(Live) -> + #st{fragile=Fragile0,xs=Xs0} = St0, + Fragile = cerl_sets:filter(fun({x,X}) -> + X < Live; + ({y,_}) -> + true + end, Fragile0), + Xs = maps:filter(fun({x,X}, _) -> + X < Live + end, Xs0), + St = St0#st{fragile=Fragile,xs=Xs}, Vst#vst{current=St}. +%% All choices in a select_val list must be integers, floats, or atoms. +%% All must be of the same type. +assert_choices([{Tag,_},{f,_}|T]) -> + if + Tag =:= atom; Tag =:= float; Tag =:= integer -> + assert_choices_1(T, Tag); + true -> + error(bad_select_list) + end; +assert_choices([]) -> ok. + +assert_choices_1([{Tag,_},{f,_}|T], Tag) -> + assert_choices_1(T, Tag); +assert_choices_1([_,{f,_}|_], _Tag) -> + error(bad_select_list); +assert_choices_1([], _Tag) -> ok. + +assert_arities([Arity,{f,_}|T]) when is_integer(Arity) -> + assert_arities(T); +assert_arities([]) -> ok; +assert_arities(_) -> error(bad_tuple_arity_list). + + %%% %%% Floating point checking. %%% @@ -1051,8 +1443,8 @@ prune_x_regs(Live, #vst{current=#st{x=Xs0}=St0}=Vst) when is_integer(Live) -> %%% fmove Src {fr,_} %% Move INTO floating point register. %%% -float_op(Src, Dst, Vst0) -> - foreach (fun(S) -> assert_freg_set(S, Vst0) end, Src), +float_op(Ss, Dst, Vst0) -> + _ = [assert_freg_set(S, Vst0) || S <- Ss], assert_fls(cleared, Vst0), Vst = set_fls(cleared, Vst0), set_freg(Dst, Vst). @@ -1070,8 +1462,7 @@ get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls. init_fregs() -> 0. -set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst) - when is_integer(Fr), 0 =< Fr -> +set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst) -> check_limit(Freg), Bit = 1 bsl Fr, if @@ -1107,7 +1498,10 @@ assert_unique_map_keys([]) -> assert_unique_map_keys([_]) -> ok; assert_unique_map_keys([_,_|_]=Ls) -> - Vs = [get_literal(L) || L <- Ls], + Vs = [begin + assert_literal(L), + L + end || L <- Ls], case length(Vs) =:= sets:size(sets:from_list(Vs)) of true -> ok; false -> error(keys_not_unique) @@ -1117,6 +1511,8 @@ assert_unique_map_keys([_,_|_]=Ls) -> %%% New binary matching instructions. %%% +bsm_match_state() -> + #ms{}. bsm_match_state(Slots) -> #ms{slots=Slots}. @@ -1124,13 +1520,13 @@ bsm_validate_context(Reg, Vst) -> _ = bsm_get_context(Reg, Vst), ok. -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}) +bsm_get_context({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y-> + case get_movable_term_type(Reg, Vst) of + #ms{}=Ctx -> Ctx; + _ -> error({no_bsm_context,Reg}) end; -bsm_get_context(Reg, _) -> error({bad_source,Reg}). +bsm_get_context(Reg, _) -> + error({bad_source,Reg}). bsm_save(Reg, {atom,start}, Vst) -> %% Save point refering to where the match started. @@ -1141,7 +1537,7 @@ bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, - set_type_reg(Ctx, Reg, Vst); + override_type(Ctx, Reg, Vst); _ -> error({illegal_save,SavePoint}) end. @@ -1160,104 +1556,365 @@ bsm_restore(Reg, SavePoint, Vst) -> _ -> error({illegal_restore,SavePoint,range}) end. +validate_select_val(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> + %% We've already branched on all of Src's possible values, so we know we + %% can't reach the fail label or any of the remaining choices. + Vst; +validate_select_val(Fail, [Val,{f,L}|T], Src, Vst0) -> + Vst = branch(L, Vst0, + fun(BranchVst) -> + update_eq_types(Src, Val, BranchVst) + end, + fun(FailVst) -> + update_ne_types(Src, Val, FailVst) + end), + validate_select_val(Fail, T, Src, Vst); +validate_select_val(Fail, [], _, Vst) -> + branch(Fail, Vst, + fun(SuccVst) -> + %% The next instruction is never executed. + kill_state(SuccVst) + end). + +validate_select_tuple_arity(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> + %% We've already branched on all of Src's possible values, so we know we + %% can't reach the fail label or any of the remaining choices. + Vst; +validate_select_tuple_arity(Fail, [Arity,{f,L}|T], Tuple, Vst0) -> + Type = {tuple, Arity, #{}}, + Vst = branch(L, Vst0, + fun(BranchVst) -> + update_type(fun meet/2, Type, Tuple, BranchVst) + end, + fun(FailVst) -> + update_type(fun subtract/2, Type, Tuple, FailVst) + end), + validate_select_tuple_arity(Fail, T, Tuple, Vst); +validate_select_tuple_arity(Fail, [], _, #vst{}=Vst) -> + branch(Fail, Vst, + fun(SuccVst) -> + %% The next instruction is never executed. + kill_state(SuccVst) + end). + +infer_types({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> + infer_types(get_reg_vref(Reg, Vst), Vst); +infer_types(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> + case Vs of + #{ Ref := Entry } -> infer_types_1(Entry); + #{} -> fun(_, S) -> S end + end; +infer_types(_, #vst{}) -> + fun(_, S) -> S end. + +infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> + fun({atom,true}, S) -> + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, S), + Infer_R = infer_types(LHS, S), + Infer_R(RHS, Infer_L(LHS, S)); + (_, S) -> S + end; +infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> + fun(Val, S) -> + Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }}, + update_type(fun meet/2, Type, Tuple, S) + end; +infer_types_1(#value{op={bif,is_atom},args=[Src]}) -> + infer_type_test_bif({atom,[]}, Src); +infer_types_1(#value{op={bif,is_boolean},args=[Src]}) -> + infer_type_test_bif(bool, Src); +infer_types_1(#value{op={bif,is_binary},args=[Src]}) -> + infer_type_test_bif(binary, Src); +infer_types_1(#value{op={bif,is_bitstring},args=[Src]}) -> + infer_type_test_bif(binary, Src); +infer_types_1(#value{op={bif,is_float},args=[Src]}) -> + infer_type_test_bif(float, Src); +infer_types_1(#value{op={bif,is_integer},args=[Src]}) -> + infer_type_test_bif({integer,{}}, Src); +infer_types_1(#value{op={bif,is_list},args=[Src]}) -> + infer_type_test_bif(list, Src); +infer_types_1(#value{op={bif,is_map},args=[Src]}) -> + infer_type_test_bif(map, Src); +infer_types_1(#value{op={bif,is_number},args=[Src]}) -> + infer_type_test_bif(number, Src); +infer_types_1(#value{op={bif,is_tuple},args=[Src]}) -> + infer_type_test_bif({tuple,[0],#{}}, Src); +infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) -> + fun({integer,Arity}, S) -> + update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); + (_, S) -> S + end; +infer_types_1(_) -> + fun(_, S) -> S end. + +infer_type_test_bif(Type, Src) -> + fun({atom,true}, S) -> + update_type(fun meet/2, Type, Src, S); + (_, S) -> + S + end. + %%% %%% Keeping track of types. %%% -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, Src, Dst, Vst) -> - case get_term_type_1(Src, Vst) of - {fragile,_} -> - set_type_reg(make_fragile(Type), Dst, Vst); +%% Assigns Src to Dst and marks them as aliasing each other. +assign({y,_}=Src, {y,_}=Dst, Vst) -> + %% The stack trimming optimization may generate a move from an initialized + %% but unassigned Y register to another Y register. + case get_raw_type(Src, Vst) of + initialized -> create_tag(initialized, init, [], Dst, Vst); + _ -> assign_1(Src, Dst, Vst) + end; +assign({Kind,_}=Src, Dst, Vst) when Kind =:= x; Kind =:= y -> + assign_1(Src, Dst, Vst); +assign(Literal, Dst, Vst) -> + Type = get_literal_type(Literal), + create_term(Type, move, [Literal], Dst, Vst). + +%% Creates a special tag value that isn't a regular term, such as 'initialized' +%% or 'catchtag' +create_tag(Tag, _Op, _Ss, {y,_}=Dst, #vst{current=#st{ys=Ys0}=St0}=Vst) -> + case maps:get(Dst, Ys0, uninitialized) of + {catchtag,_}=Prev -> + error(Prev); + {trytag,_}=Prev -> + error(Prev); _ -> - set_type_reg(Type, Dst, Vst) + check_try_catch_tags(Tag, Dst, Vst), + Ys = Ys0#{ Dst => Tag }, + St = St0#st{ys=Ys}, + remove_fragility(Dst, Vst#vst{current=St}) + end; +create_tag(_Tag, _Op, _Ss, Dst, _Vst) -> + error({invalid_tag_register, Dst}). + +%% Wipes a special tag, leaving the register initialized but empty. +kill_tag({y,_}=Reg, #vst{current=#st{ys=Ys0}=St0}=Vst) -> + _ = get_tag_type(Reg, Vst), %Assertion. + Ys = Ys0#{ Reg => initialized }, + Vst#vst{current=St0#st{ys=Ys}}. + +%% Creates a completely new term with the given type. +create_term(Type, Op, Ss0, Dst, Vst0) -> + create_term(Type, Op, Ss0, Dst, Vst0, Vst0). + +%% As create_term/4, but uses the incoming Vst for argument resolution in +%% case x-regs have been pruned and the sources can no longer be found. +create_term(Type, Op, Ss0, Dst, Vst0, OrigVst) -> + {Ref, Vst1} = new_value(Type, Op, resolve_args(Ss0, OrigVst), Vst0), + Vst = remove_fragility(Dst, Vst1), + set_reg_vref(Ref, Dst, Vst). + +%% Extracts a term from Ss, propagating fragility. +extract_term(Type, Op, Ss0, Dst, Vst0) -> + extract_term(Type, Op, Ss0, Dst, Vst0, Vst0). + +%% As extract_term/4, but uses the incoming Vst for argument resolution in +%% case x-regs have been pruned and the sources can no longer be found. +extract_term(Type, Op, Ss0, Dst, Vst0, OrigVst) -> + {Ref, Vst1} = new_value(Type, Op, resolve_args(Ss0, OrigVst), Vst0), + Vst = propagate_fragility(Dst, Ss0, Vst1), + set_reg_vref(Ref, Dst, Vst). + +%% Translates instruction arguments into the argument() type, decoupling them +%% from their registers, allowing us to infer their types after they've been +%% clobbered or moved. +resolve_args([{Kind,_}=Src | Args], Vst) when Kind =:= x; Kind =:= y -> + [get_reg_vref(Src, Vst) | resolve_args(Args, Vst)]; +resolve_args([Lit | Args], Vst) -> + assert_literal(Lit), + [Lit | resolve_args(Args, Vst)]; +resolve_args([], _Vst) -> + []. + +%% Overrides the type of Reg. This is ugly but a necessity for certain +%% destructive operations. +override_type(Type, Reg, Vst) -> + update_type(fun(_, T) -> T end, Type, Reg, Vst). + +%% This is used when linear code finds out more and more information about a +%% type, so that the type gets more specialized. +update_type(Merge, With, #value_ref{}=Ref, Vst) -> + %% If the old type can't be merged with the new one, the type information + %% is inconsistent and we know that some instructions will never be + %% executed at run-time. For example: + %% + %% {test,is_list,Fail,[Reg]}. + %% {test,is_tuple,Fail,[Reg]}. + %% {test,test_arity,Fail,[Reg,5]}. + %% + %% Note that the test_arity instruction can never be reached, so we need to + %% kill the state to avoid raising an error when we encounter it. + %% + %% Simply returning `kill_state(Vst)` is unsafe however as we might be in + %% the middle of an instruction, and altering the rest of the validator + %% (eg. prune_x_regs/2) to no-op on dead states is prone to error. + %% + %% We therefore throw a 'type_conflict' error instead, which causes + %% validation to fail unless we're in a context where such errors can be + %% handled, such as in a branch handler. + Current = get_raw_type(Ref, Vst), + case Merge(Current, With) of + none -> throw({type_conflict, Current, With}); + Type -> set_type(Type, Ref, Vst) + end; +update_type(Merge, With, {Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> + update_type(Merge, With, get_reg_vref(Reg, Vst), Vst); +update_type(Merge, With, Literal, Vst) -> + assert_literal(Literal), + %% Literals always retain their type, but we still need to bail on type + %% conflicts. + case Merge(Literal, With) of + none -> throw({type_conflict, Literal, With}); + _Type -> 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), - Ys = case gb_trees:lookup(Y, Ys0) of - none -> - error({invalid_store,Reg,Type}); - {value,{catchtag,_}=Tag} -> - error(Tag); - {value,{trytag,_}=Tag} -> - error(Tag); - {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 +update_ne_types(LHS, RHS, Vst) -> + %% While updating types on equality is fairly straightforward, inequality + %% is a bit trickier since all we know is that the *value* of LHS differs + %% from RHS, so we can't blindly subtract their types. + %% + %% Consider `number =/= {integer,[]}`; all we know is that LHS isn't equal + %% to some *specific integer* of unknown value, and if we were to subtract + %% {integer,[]} we would erroneously infer that the new type is {float,[]}. + %% + %% Therefore, we only subtract when we know that RHS has a specific value. + RType = get_term_type(RHS, Vst), + case is_literal(RType) of + true -> update_type(fun subtract/2, RType, LHS, Vst); + false -> Vst end. -is_try_catch_tag({catchtag,_}) -> true; -is_try_catch_tag({trytag,_}) -> true; -is_try_catch_tag(_) -> false. +update_eq_types(LHS, RHS, Vst0) -> + %% Either side might contain something worth inferring, so we need + %% to check them both. + Infer_L = infer_types(RHS, Vst0), + Infer_R = infer_types(LHS, Vst0), + Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)), + + T1 = get_term_type(LHS, Vst1), + T2 = get_term_type(RHS, Vst1), + + Vst = update_type(fun meet/2, T2, LHS, Vst1), + update_type(fun meet/2, T1, RHS, Vst). + +%% Helper functions for the above. + +assign_1(Src, Dst, Vst0) -> + assert_movable(Src, Vst0), + Vst = propagate_fragility(Dst, [Src], Vst0), + set_reg_vref(get_reg_vref(Src, Vst), Dst, Vst). + +set_reg_vref(Ref, {x,_}=Dst, Vst) -> + check_limit(Dst), + #vst{current=#st{xs=Xs0}=St0} = Vst, + St = St0#st{xs=Xs0#{ Dst => Ref }}, + Vst#vst{current=St}; +set_reg_vref(Ref, {y,_}=Dst, #vst{current=#st{ys=Ys0}=St0} = Vst) -> + check_limit(Dst), + case Ys0 of + #{ Dst := {catchtag,_}=Tag } -> + error(Tag); + #{ Dst := {trytag,_}=Tag } -> + error(Tag); + #{ Dst := _ } -> + St = St0#st{ys=Ys0#{ Dst => Ref }}, + Vst#vst{current=St}; + #{} -> + %% Storing into a non-existent Y register means that we haven't set + %% up a (sufficiently large) stack. + error({invalid_store, Dst}) + end. -is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst); -is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst); -is_reg_defined(V, #vst{}) -> error({not_a_register, V}). +get_reg_vref({x,_}=Src, #vst{current=#st{xs=Xs}}) -> + check_limit(Src), + case Xs of + #{ Src := #value_ref{}=Ref } -> + Ref; + #{} -> + error({uninitialized_reg, Src}) + end; +get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) -> + check_limit(Src), + case Ys of + #{ Src := #value_ref{}=Ref } -> + Ref; + #{ Src := initialized } -> + error({unassigned, Src}); + #{ Src := Tag } when Tag =/= uninitialized -> + error(Tag); + #{} -> + error({uninitialized_reg, Src}) + end. + +set_type(Type, #value_ref{}=Ref, #vst{current=#st{vs=Vs0}=St}=Vst) -> + case Vs0 of + #{ Ref := #value{}=Entry } -> + Vs = Vs0#{ Ref => Entry#value{type=Type} }, + Vst#vst{current=St#st{vs=Vs}}; + #{} -> + %% Dead references may happen during type inference and are not an + %% error in and of themselves. If a problem were to arise from this + %% it'll explode elsewhere. + Vst + end. + +new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> + Ref = #value_ref{id=Counter}, + Vs = Vs0#{ Ref => #value{op=Op,args=Ss,type=Type} }, -is_type_defined_x({x,X}, #vst{current=#st{x=Xs}}) -> - gb_trees:is_defined(X,Xs). + {Ref, Vst#vst{current=St#st{vs=Vs},ref_ctr=Counter+1}}. -is_type_defined_y({y,Y}, #vst{current=#st{y=Ys}}) -> - gb_trees:is_defined(Y,Ys). +kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> + Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, + {_, Fail} = get_tag_type(Reg, Vst), %Assertion. + kill_tag(Reg, Vst). + +check_try_catch_tags(Type, {y,N}=Reg, Vst) -> + %% 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. + case is_try_catch_tag(Type) of + true -> + case collect_try_catch_tags(N - 1, Vst, []) of + [_|_]=Bad -> error({bad_try_catch_nesting, Reg, Bad}); + [] -> ok + end; + false -> + ok + end. assert_term(Src, Vst) -> - get_term_type(Src, Vst), + _ = get_term_type(Src, Vst), ok. +assert_movable(Src, Vst) -> + _ = get_movable_term_type(Src, Vst), + ok. + +assert_literal(Src) -> + case is_literal(Src) of + true -> ok; + false -> error({literal_required,Src}) + end. + +assert_not_literal(Src) -> + case is_literal(Src) of + true -> error({literal_not_allowed,Src}); + false -> ok + end. + +is_literal(nil) -> true; +is_literal({atom,A}) when is_atom(A) -> true; +is_literal({float,F}) when is_float(F) -> true; +is_literal({integer,I}) when is_integer(I) -> true; +is_literal({literal,_L}) -> true; +is_literal(_) -> false. + %% The possible types. %% %% First non-term types: @@ -1276,10 +1933,10 @@ assert_term(Src, Vst) -> %% used by the catch instructions; NOT safe to use in other %% instructions. %% -%% exception Can only be used as a type returned by return_type/2 -%% (which gives the type of the value returned by a BIF). -%% Thus 'exception' is never stored as type descriptor -%% for a register. +%% exception Can only be used as a type returned by +%% call_return_type/2 (which gives the type of the value +%% returned by a call). Thus 'exception' is never stored +%% as type descriptor for a register. %% %% #ms{} A match context for bit syntax matching. We do allow %% it to moved/to from stack, but otherwise it must only @@ -1290,17 +1947,22 @@ assert_term(Src, Vst) -> %% %% term Any valid Erlang (but not of the special types above). %% +%% binary Binary or bitstring. +%% %% bool The atom 'true' or the atom 'false'. %% %% cons Cons cell: [_|_] %% %% nil Empty list: [] %% -%% {tuple,[Sz]} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. +%% list List: [] or [_|_] +%% +%% {tuple,[Sz],Es} Tuple. An element has been accessed using +%% element/2 or setelement/3 so that it is known that +%% the type is a tuple of size at least Sz. Es is a map +%% containing known types by tuple index. %% -%% {tuple,Sz} Tuple. A test_arity instruction has been seen +%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen %% so that it is known that the size is exactly Sz. %% %% {atom,[]} Atom. @@ -1316,35 +1978,214 @@ assert_term(Src, Vst) -> %% %% map Map. %% +%% none A conflict in types. There will be an exception at runtime. %% -%% -%% 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) -> - case get_term_type(Term, Vst) of - {fragile,Type} -> - assert_type(WantedType, Type); - Type -> - assert_type(WantedType, Type) +%% join(Type1, Type2) -> Type +%% Return the most specific type possible. +join(Same, Same) -> + Same; +join(none, Other) -> + Other; +join(Other, none) -> + Other; +join({literal,_}=T1, T2) -> + join_literal(T1, T2); +join(T1, {literal,_}=T2) -> + join_literal(T2, T1); +join({tuple,Size,EsA}, {tuple,Size,EsB}) -> + Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), + {tuple, Size, Es}; +join({tuple,A,EsA}, {tuple,B,EsB}) -> + Size = min(tuple_sz(A), tuple_sz(B)), + Es = join_tuple_elements(Size, EsA, EsB), + {tuple, [Size], Es}; +join({Type,A}, {Type,B}) + when Type =:= atom; Type =:= integer; Type =:= float -> + if A =:= B -> {Type,A}; + true -> {Type,[]} + end; +join({Type,_}, number) + when Type =:= integer; Type =:= float -> + number; +join(number, {Type,_}) + when Type =:= integer; Type =:= float -> + number; +join({integer,_}, {float,_}) -> + number; +join({float,_}, {integer,_}) -> + number; +join(bool, {atom,A}) -> + join_bool(A); +join({atom,A}, bool) -> + join_bool(A); +join({atom,A}, {atom,B}) when is_boolean(A), is_boolean(B) -> + bool; +join({atom,_}, {atom,_}) -> + {atom,[]}; +join(#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)}; +join(T1, T2) when T1 =/= T2 -> + %% We've exhaused all other options, so the type must either be a list or + %% a 'term'. + join_list(T1, T2). + +join_tuple_elements(Limit, EsA, EsB) -> + Es0 = join_elements(EsA, EsB), + maps:filter(fun({integer,Index}, _Type) -> Index =< Limit end, Es0). + +join_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + join_elements_1(Keys, Es1, Es2, #{}). + +join_elements_1([Key | Keys], Es1, Es2, Acc0) -> + Type = case {Es1, Es2} of + {#{ Key := Same }, #{ Key := Same }} -> Same; + {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); + {#{}, #{}} -> term + end, + Acc = set_element_type(Key, Type, Acc0), + join_elements_1(Keys, Es1, Es2, Acc); +join_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% Joins types of literals; note that the left argument must either be a +%% literal or exactly equal to the second argument. +join_literal(Same, Same) -> + Same; +join_literal({literal,_}=Lit, T) -> + join_literal(T, get_literal_type(Lit)); +join_literal(T1, T2) -> + %% We're done extracting the types, try merging them again. + join(T1, T2). + +join_list(nil, cons) -> list; +join_list(nil, list) -> list; +join_list(cons, list) -> list; +join_list(T, nil) -> join_list(nil, T); +join_list(T, cons) -> join_list(cons, T); +join_list(_, _) -> + %% Not a list, so it must be a term. + term. + +join_bool([]) -> {atom,[]}; +join_bool(true) -> bool; +join_bool(false) -> bool; +join_bool(_) -> {atom,[]}. + +%% meet(Type1, Type2) -> Type +%% Return the meet of two types. The meet is a more specific type. +%% It will be 'none' if the types are in conflict. + +meet(Same, Same) -> + Same; +meet(term, Other) -> + Other; +meet(Other, term) -> + Other; +meet(#ms{}, binary) -> + #ms{}; +meet(binary, #ms{}) -> + #ms{}; +meet({literal,_}, {literal,_}) -> + none; +meet(T1, {literal,_}=T2) -> + meet(T2, T1); +meet({literal,_}=T1, T2) -> + case meet(get_literal_type(T1), T2) of + none -> none; + _ -> T1 + end; +meet(T1, T2) -> + case {erlang:min(T1, T2),erlang:max(T1, T2)} of + {{atom,_}=A,{atom,[]}} -> A; + {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; + {bool,{atom,[]}} -> bool; + {cons,list} -> cons; + {{float,_}=T,{float,[]}} -> T; + {{integer,_}=T,{integer,[]}} -> T; + {list,nil} -> nil; + {number,{integer,_}=T} -> T; + {number,{float,_}=T} -> T; + {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> + Es = meet_elements(Es1, Es2), + case {Size1,Size2,Es} of + {_, _, none} -> + none; + {[Sz1],[Sz2],_} -> + Sz = erlang:max(Sz1, Sz2), + assert_tuple_elements(Sz, Es), + {tuple,[Sz],Es}; + {Sz1,[Sz2],_} when Sz2 =< Sz1 -> + assert_tuple_elements(Sz1, Es), + {tuple,Sz1,Es}; + {Sz,Sz,_} -> + assert_tuple_elements(Sz, Es), + {tuple,Sz,Es}; + {_,_,_} -> + none + end; + {_,_} -> none end. +meet_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + meet_elements_1(Keys, Es1, Es2, #{}). + +meet_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + case meet(Type1, Type2) of + none -> none; + Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +meet_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% No tuple elements may have an index above the known size. +assert_tuple_elements(Limit, Es) -> + true = maps:fold(fun({integer,Index}, _T, true) -> + Index =< Limit + end, true, Es). %Assertion. + +%% subtract(Type1, Type2) -> Type +%% Subtract Type2 from Type2. Example: +%% subtract(list, nil) -> cons + +subtract(Same, Same) -> none; +subtract(list, nil) -> cons; +subtract(list, cons) -> nil; +subtract(number, {integer,[]}) -> {float,[]}; +subtract(number, {float,[]}) -> {integer,[]}; +subtract(bool, {atom,false}) -> {atom, true}; +subtract(bool, {atom,true}) -> {atom, false}; +subtract(Type, _) -> Type. + +assert_type(WantedType, Term, Vst) -> + Type = get_term_type(Term, Vst), + assert_type(WantedType, Type). + assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_}) -> ok; +assert_type(tuple, {tuple,_,_}) -> ok; assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz]}) +assert_type({tuple_element,I}, {tuple,[Sz],_}) when 1 =< I, I =< Sz -> ok; -assert_type({tuple_element,I}, {tuple,Sz}) +assert_type({tuple_element,I}, {tuple,Sz,_}) when is_integer(Sz), 1 =< I, I =< Sz -> ok; assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> @@ -1354,141 +2195,316 @@ assert_type(cons, {literal,[_|_]}) -> assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). -%% upgrade_tuple_type(NewTupleType, OldType) -> TupleType. -%% upgrade_tuple_type/2 is used when linear code finds out more and -%% more information about a tuple type, so that the type gets more -%% specialized. If OldType is not a tuple type, the type information -%% is inconsistent, and we know that some instructions will never -%% be executed at run-time. - -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_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_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 - %% clause, e.g. if the old type was an integer or a tuple accessed - %% outside its size; inconsistences will generally cause an exception - %% at run-time but are safe from our point of view. - T. +get_element_type(Key, Src, Vst) -> + get_element_type_1(Key, get_term_type(Src, Vst)). + +get_element_type_1({integer,_}=Key, {tuple,_Sz,Es}) -> + case Es of + #{ Key := Type } -> Type; + #{} -> term + end; +get_element_type_1(_Index, _Type) -> + term. + +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, term, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. get_tuple_size({integer,[]}) -> 0; get_tuple_size({integer,Sz}) -> Sz; get_tuple_size(_) -> 0. validate_src(Ss, Vst) when is_list(Ss) -> - foreach(fun(S) -> get_term_type(S, Vst) end, Ss). + _ = [assert_term(S, Vst) || S <- Ss], + ok. -%% get_move_term_type(Src, ValidatorState) -> Type +%% get_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be -%% a standard Erlang type (no catch/try tags). Match contexts are OK. +%% a standard Erlang type (no catch/try tags or match contexts). -get_move_term_type(Src, Vst) -> - case get_term_type_1(Src, Vst) of - initialized -> error({unassigned,Src}); - {catchtag,_} -> error({catchtag,Src}); - {trytag,_} -> error({trytag,Src}); - tuple_in_progress -> error({tuple_in_progress,Src}); - Type -> Type +get_term_type(Src, Vst) -> + case get_movable_term_type(Src, Vst) of + #ms{} -> error({match_context,Src}); + Type -> Type end. -%% get_term_type(Src, ValidatorState) -> Type +%% get_movable_term_type(Src, ValidatorState) -> Type %% Get the type of the source Src. The returned type Type will be -%% a standard Erlang type (no catch/try tags or match contexts). +%% a standard Erlang type (no catch/try tags). Match contexts are OK. -get_term_type(Src, Vst) -> - case get_move_term_type(Src, Vst) of - #ms{} -> error({match_context,Src}); - Type -> Type +get_movable_term_type(Src, Vst) -> + case get_raw_type(Src, Vst) of + initialized -> error({unassigned,Src}); + uninitialized -> error({uninitialized_reg,Src}); + {catchtag,_} -> error({catchtag,Src}); + {trytag,_} -> error({trytag,Src}); + tuple_in_progress -> error({tuple_in_progress,Src}); + {literal,_}=Lit -> get_literal_type(Lit); + Type -> Type end. -%% get_special_y_type(Src, ValidatorState) -> Type -%% Return the type for the Y register without doing any validity checks. - -get_special_y_type({y,_}=Reg, Vst) -> get_term_type_1(Reg, Vst); -get_special_y_type(Src, _) -> error({source_not_y_reg,Src}). - -get_term_type_1(nil=T, _) -> T; -get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; -get_term_type_1({float,F}=T, _) when is_float(F) -> T; -get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; -get_term_type_1({literal,Map}, _) when is_map(Map) -> map; -get_term_type_1({literal,_}=T, _) -> T; -get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> - case gb_trees:lookup(X, Xs) of - {value,Type} -> Type; - none -> error({uninitialized_reg,Reg}) +%% get_tag_type(Src, ValidatorState) -> Type +%% Return the tag type of a Y register, erroring out if it contains a term. + +get_tag_type({y,_}=Src, Vst) -> + case get_raw_type(Src, Vst) of + {catchtag, _}=Tag -> Tag; + {trytag, _}=Tag -> Tag; + uninitialized=Tag -> Tag; + initialized=Tag -> Tag; + Other -> error({invalid_tag,Src,Other}) end; -get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> - case gb_trees:lookup(Y, Ys) of - none -> error({uninitialized_reg,Reg}); - {value,uninitialized} -> error({uninitialized_reg,Reg}); - {value,Type} -> Type +get_tag_type(Src, _) -> + error({invalid_tag_register,Src}). + +%% get_raw_type(Src, ValidatorState) -> Type +%% Return the type of a register without doing any validity checks or +%% conversions. +get_raw_type({x,X}=Src, #vst{current=#st{xs=Xs}}=Vst) when is_integer(X) -> + check_limit(Src), + case Xs of + #{ Src := #value_ref{}=Ref } -> get_raw_type(Ref, Vst); + #{} -> uninitialized end; -get_term_type_1(Src, _) -> error({bad_source,Src}). - +get_raw_type({y,Y}=Src, #vst{current=#st{ys=Ys}}=Vst) when is_integer(Y) -> + check_limit(Src), + case Ys of + #{ Src := #value_ref{}=Ref } -> get_raw_type(Ref, Vst); + #{ Src := Tag } -> Tag; + #{} -> uninitialized + end; +get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> + case Vs of + #{ Ref := #value{type=Type} } -> Type; + #{} -> none + end; +get_raw_type(Src, #vst{}) -> + get_literal_type(Src). + +get_literal_type(nil=T) -> T; +get_literal_type({atom,A}=T) when is_atom(A) -> T; +get_literal_type({float,F}=T) when is_float(F) -> T; +get_literal_type({integer,I}=T) when is_integer(I) -> T; +get_literal_type({literal,[_|_]}) -> cons; +get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary; +get_literal_type({literal,Map}) when is_map(Map) -> map; +get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> glt_1(Tuple); +get_literal_type({literal,_}) -> term; +get_literal_type(T) -> error({not_literal,T}). + +glt_1([]) -> nil; +glt_1(A) when is_atom(A) -> {atom, A}; +glt_1(F) when is_float(F) -> {float, F}; +glt_1(I) when is_integer(I) -> {integer, I}; +glt_1(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = glt_1(Val), + Es = set_element_type({integer,Index}, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + {tuple, tuple_size(T), Es}; +glt_1(L) -> + {literal, L}. -%% get_literal(Src) -> literal_value(). -get_literal(nil) -> []; -get_literal({atom,A}) when is_atom(A) -> A; -get_literal({float,F}) when is_float(F) -> F; -get_literal({integer,I}) when is_integer(I) -> I; -get_literal({literal,L}) -> L; -get_literal(T) -> error({not_literal,T}). +%%% +%%% Branch tracking +%%% +%% Forks the execution flow, with the provided funs returning the new state of +%% their respective branch; the "fail" fun returns the state where the branch +%% is taken, and the "success" fun returns the state where it's not. +%% +%% If either path is known not to be taken at runtime (eg. due to a type +%% conflict), it will simply be discarded. +-spec branch(Lbl :: label(), + Original :: #vst{}, + FailFun :: BranchFun, + SuccFun :: BranchFun) -> #vst{} when + BranchFun :: fun((#vst{}) -> #vst{}). +branch(Lbl, Vst0, FailFun, SuccFun) -> + #vst{current=St0} = Vst0, + try FailFun(Vst0) of + Vst1 -> + Vst2 = branch_state(Lbl, Vst1), + Vst = Vst2#vst{current=St0}, + try SuccFun(Vst) of + V -> V + catch + {type_conflict, _, _} -> + %% The instruction is guaranteed to fail; kill the state. + kill_state(Vst) + end + catch + {type_conflict, _, _} -> + %% This instruction is guaranteed not to fail, so we run the + %% success branch *without* catching type conflicts to avoid hiding + %% errors in the validator itself; one of the branches must + %% succeed. + SuccFun(Vst0) + end. -branch_arities([], _, #vst{}=Vst) -> Vst; -branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) - when is_integer(Sz) -> - Vst1 = set_type_reg({tuple,Sz}, Tuple, Vst0), - Vst = branch_state(L, Vst1), - branch_arities(T, Tuple, Vst#vst{current=St}). +%% A shorthand version of branch/4 for when the state is only altered on +%% success. +branch(Fail, Vst, SuccFun) -> + branch(Fail, Vst, fun(V) -> V end, SuccFun). +%% Directly branches off the state. This is an "internal" operation that should +%% be used sparingly. 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. + %% 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 - false -> - gb_trees:insert(L, St, B); - true -> - MergedSt = merge_states(L, St, B), - gb_trees:update(L, MergedSt, B) - end}. - -%% merge_states/3 is used when there are more than one way to arrive -%% at this point, and the type states for the different paths has -%% to be merged. The type states are downgraded to the least common -%% subset for the subsequent code. - -merge_states(L, St, Branched) when L =/= 0 -> +branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> + case gb_trees:is_defined(L, B) of + true -> + {MergedSt, Counter} = merge_states(L, St, B, Counter0), + Branched = gb_trees:update(L, MergedSt, B), + Vst#vst{branched=Branched,ref_ctr=Counter}; + false -> + Vst#vst{branched=gb_trees:insert(L, St, B)} + end. + +%% merge_states/3 is used when there's more than one way to arrive at a +%% certain point, requiring the states to be merged down to the least +%% common subset for the subsequent code. + +merge_states(L, St, Branched, Counter) when L =/= 0 -> case gb_trees:lookup(L, Branched) of - none -> St; - {value,OtherSt} when St =:= none -> OtherSt; - {value,OtherSt} -> merge_states_1(St, OtherSt) + none -> + {St, Counter}; + {value,OtherSt} when St =:= none -> + {OtherSt, Counter}; + {value,OtherSt} -> + merge_states_1(St, OtherSt, Counter) + end. + +merge_states_1(#st{xs=XsA,ys=YsA,vs=VsA,fragile=FragA,numy=NumYA,h=HA,ct=CtA}, + #st{xs=XsB,ys=YsB,vs=VsB,fragile=FragB,numy=NumYB,h=HB,ct=CtB}, + Counter0) -> + %% When merging registers we drop all registers that aren't defined in both + %% states, and resolve conflicts by creating new values (similar to phi + %% nodes in SSA). + %% + %% While doing this we build a "merge map" detailing which values need to + %% be kept and which new values need to be created to resolve conflicts. + %% This map is then used to create a new value database where the types of + %% all values have been joined. + {Xs, Merge0, Counter1} = merge_regs(XsA, XsB, #{}, Counter0), + {Ys, Merge, Counter} = merge_regs(YsA, YsB, Merge0, Counter1), + Vs = merge_values(Merge, VsA, VsB), + + Fragile = merge_fragility(FragA, FragB), + NumY = merge_stk(NumYA, NumYB), + Ct = merge_ct(CtA, CtB), + + St = #st{xs=Xs,ys=Ys,vs=Vs,fragile=Fragile,numy=NumY,h=min(HA, HB),ct=Ct}, + {St, Counter}. + +%% Merges the contents of two register maps, returning the updated "merge map" +%% and the new registers. +merge_regs(RsA, RsB, Merge, Counter) -> + Keys = if + map_size(RsA) =< map_size(RsB) -> maps:keys(RsA); + map_size(RsA) > map_size(RsB) -> maps:keys(RsB) + end, + merge_regs_1(Keys, RsA, RsB, #{}, Merge, Counter). + +merge_regs_1([Reg | Keys], RsA, RsB, Regs, Merge0, Counter0) -> + case {RsA, RsB} of + {#{ Reg := #value_ref{}=RefA }, #{ Reg := #value_ref{}=RefB }} -> + {Ref, Merge, Counter} = merge_vrefs(RefA, RefB, Merge0, Counter0), + merge_regs_1(Keys, RsA, RsB, Regs#{ Reg => Ref }, Merge, Counter); + {#{ Reg := TagA }, #{ Reg := TagB }} -> + %% Tags describe the state of the register rather than the value it + %% contains, so if a register contains a tag in one state we have + %% to merge it as a tag regardless of whether the other state says + %% it's a value. + {y, _} = Reg, %Assertion. + merge_regs_1(Keys, RsA, RsB, Regs#{ Reg => merge_tags(TagA,TagB) }, + Merge0, Counter0); + {#{}, #{}} -> + merge_regs_1(Keys, RsA, RsB, Regs, Merge0, Counter0) + end; +merge_regs_1([], _, _, Regs, Merge, Counter) -> + {Regs, Merge, Counter}. + +merge_tags(Same, Same) -> + Same; +merge_tags(uninitialized, _) -> + uninitialized; +merge_tags(_, uninitialized) -> + uninitialized; +merge_tags({catchtag,T0}, {catchtag,T1}) -> + {catchtag, ordsets:from_list(T0 ++ T1)}; +merge_tags({trytag,T0}, {trytag,T1}) -> + {trytag, ordsets:from_list(T0 ++ T1)}; +merge_tags(_A, _B) -> + %% All other combinations leave the register initialized. Errors arising + %% from this will be caught later on. + initialized. + +merge_vrefs(Ref, Ref, Merge, Counter) -> + %% We have two (potentially) different versions of the same value, so we + %% should join their types into the same value. + {Ref, Merge#{ Ref => Ref }, Counter}; +merge_vrefs(RefA, RefB, Merge, Counter) -> + %% We have two different values, so we need to create a new value from + %% their joined type if we haven't already done so. + Key = {RefA, RefB}, + case Merge of + #{ Key := Ref } -> + {Ref, Merge, Counter}; + #{} -> + Ref = #value_ref{id=Counter}, + {Ref, Merge#{ Key => Ref }, Counter + 1} end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}, - #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> - NumY = merge_stk(NumY0, NumY1), - Xs = merge_regs(Xs0, Xs1), - Ys = merge_y_regs(Ys0, Ys1), - Ct = merge_ct(Ct0, Ct1), - #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. +merge_values(Merge, VsA, VsB) -> + maps:fold(fun(Spec, New, Acc) -> + mv_1(Spec, New, VsA, VsB, Acc) + end, #{}, Merge). + +mv_1(Same, Same, VsA, VsB, Acc0) -> + %% We're merging different versions of the same value, so it's safe to + %% reuse old entries if the type's unchanged. + #value{type=TypeA,args=Args}=EntryA = map_get(Same, VsA), + #value{type=TypeB,args=Args}=EntryB = map_get(Same, VsB), + + Entry = case join(TypeA, TypeB) of + TypeA -> EntryA; + TypeB -> EntryB; + JoinedType -> EntryA#value{type=JoinedType} + end, + + Acc = Acc0#{ Same => Entry }, + + %% Type inference may depend on values that are no longer reachable from a + %% register, so all arguments must be merged into the new state. + mv_args(Args, VsA, VsB, Acc); +mv_1({RefA, RefB}, New, VsA, VsB, Acc) -> + #value{type=TypeA} = map_get(RefA, VsA), + #value{type=TypeB} = map_get(RefB, VsB), + Acc#{ New => #value{op=join,args=[],type=join(TypeA, TypeB)} }. + +mv_args([#value_ref{}=Arg | Args], VsA, VsB, Acc0) -> + case Acc0 of + #{ Arg := _ } -> + mv_args(Args, VsA, VsB, Acc0); + #{} -> + Acc = mv_1(Arg, Arg, VsA, VsB, Acc0), + mv_args(Args, VsA, VsB, Acc) + end; +mv_args([_ | Args], VsA, VsB, Acc) -> + mv_args(Args, VsA, VsB, Acc); +mv_args([], _VsA, _VsB, Acc) -> + Acc. + +merge_fragility(FragileA, FragileB) -> + cerl_sets:union(FragileA, FragileB). merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1501,135 +2517,70 @@ merge_ct_1([C0|Ct0], [C1|Ct1]) -> merge_ct_1([], []) -> []; merge_ct_1(_, _) -> undecided. -merge_regs(Rs0, Rs1) -> - Rs = merge_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)), - gb_trees_from_list(Rs). - -merge_regs_1([Same|Rs1], [Same|Rs2]) -> - [Same|merge_regs_1(Rs1, Rs2)]; -merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 -> - merge_regs_1(Rs1, Rs2); -merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 -> - merge_regs_1(Rs1, Rs2); -merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) -> - [{R,merge_types(Type1, Type2)}|merge_regs_1(Rs1, Rs2)]; -merge_regs_1([], []) -> []; -merge_regs_1([], [_|_]) -> []; -merge_regs_1([_|_], []) -> []. - -merge_y_regs(Rs0, Rs1) -> - case {gb_trees:size(Rs0),gb_trees:size(Rs1)} of - {Sz0,Sz1} when Sz0 < Sz1 -> - merge_y_regs_1(Sz0-1, Rs1, Rs0); - {_,Sz1} -> - merge_y_regs_1(Sz1-1, Rs0, Rs1) - end. +tuple_sz([Sz]) -> Sz; +tuple_sz(Sz) -> Sz. -merge_y_regs_1(Y, S, Regs0) when Y >= 0 -> - Type0 = gb_trees:get(Y, Regs0), - case gb_trees:get(Y, S) of - Type0 -> - merge_y_regs_1(Y-1, S, Regs0); - Type1 -> - Type = merge_types(Type0, Type1), - Regs = gb_trees:update(Y, Type, Regs0), - merge_y_regs_1(Y-1, S, Regs) - end; -merge_y_regs_1(_, _, Regs) -> Regs. +verify_y_init(#vst{current=#st{numy=NumY,ys=Ys}}=Vst) when is_integer(NumY) -> + HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), + true = NumY > HighestY, %Assertion. + verify_y_init_1(NumY - 1, Vst), + ok; +verify_y_init(#vst{current=#st{numy=undecided,ys=Ys}}=Vst) -> + HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), + verify_y_init_1(HighestY, Vst); +verify_y_init(#vst{}) -> + ok. -%% 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; -merge_types(_, initialized=I) -> I; -merge_types({catchtag,T0},{catchtag,T1}) -> - {catchtag,ordsets:from_list(T0++T1)}; -merge_types({trytag,T0},{trytag,T1}) -> - {trytag,ordsets:from_list(T0++T1)}; -merge_types({tuple,A}, {tuple,B}) -> - {tuple,[min(tuple_sz(A), tuple_sz(B))]}; -merge_types({Type,A}, {Type,B}) - when Type =:= atom; Type =:= integer; Type =:= float -> - if A =:= B -> {Type,A}; - true -> {Type,[]} - end; -merge_types({Type,_}, number) - when Type =:= integer; Type =:= float -> - number; -merge_types(number, {Type,_}) - when Type =:= integer; Type =:= float -> - number; -merge_types(bool, {atom,A}) -> - merge_bool(A); -merge_types({atom,A}, bool) -> - merge_bool(A); -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. +verify_y_init_1(-1, _Vst) -> + ok; +verify_y_init_1(Y, Vst) -> + Reg = {y, Y}, + assert_not_fragile(Reg, Vst), + case get_raw_type(Reg, Vst) of + uninitialized -> error({uninitialized_reg,Reg}); + _ -> verify_y_init_1(Y - 1, Vst) + end. -tuple_sz([Sz]) -> Sz; -tuple_sz(Sz) -> Sz. +verify_live(0, _Vst) -> + ok; +verify_live(Live, Vst) when is_integer(Live), 0 < Live, Live =< 1023 -> + verify_live_1(Live - 1, Vst); +verify_live(Live, _Vst) -> + error({bad_number_of_live_regs,Live}). -merge_bool([]) -> {atom,[]}; -merge_bool(true) -> bool; -merge_bool(false) -> bool; -merge_bool(_) -> {atom,[]}. - -verify_y_init(#vst{current=#st{y=Ys}}) -> - verify_y_init_1(gb_trees:to_list(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). - -verify_live(0, #vst{}) -> ok; -verify_live(N, #vst{current=#st{x=Xs}}) -> - verify_live_1(N, Xs). - -verify_live_1(0, _) -> ok; -verify_live_1(N, Xs) when is_integer(N) -> - X = N-1, - case gb_trees:is_defined(X, Xs) of - false -> error({{x,X},not_live}); - true -> verify_live_1(X, Xs) - end; -verify_live_1(N, _) -> error({bad_number_of_live_regs,N}). +verify_live_1(-1, _) -> + ok; +verify_live_1(X, Vst) when is_integer(X) -> + Reg = {x, X}, + case get_raw_type(Reg, Vst) of + uninitialized -> error({Reg, not_live}); + _ -> verify_live_1(X - 1, Vst) + end. -verify_no_ct(#vst{current=#st{numy=none}}) -> ok; +verify_no_ct(#vst{current=#st{numy=none}}) -> + ok; verify_no_ct(#vst{current=#st{numy=undecided}}) -> error(unknown_size_of_stackframe); -verify_no_ct(#vst{current=#st{y=Ys}}) -> - case [Y || Y <- gb_trees:to_list(Ys), verify_no_ct_1(Y)] of - [] -> ok; - CT -> error({unfinished_catch_try,CT}) +verify_no_ct(#vst{current=St}=Vst) -> + case collect_try_catch_tags(St#st.numy - 1, Vst, []) of + [_|_]=Bad -> error({unfinished_catch_try,Bad}); + [] -> ok end. -verify_no_ct_1({_, {catchtag, _}}) -> true; -verify_no_ct_1({_, {trytag, _}}) -> true; -verify_no_ct_1({_, _}) -> false. +%% Collects all try/catch tags, walking down from the Nth stack position. +collect_try_catch_tags(-1, _Vst, Acc) -> + Acc; +collect_try_catch_tags(Y, Vst, Acc0) -> + Tag = get_raw_type({y, Y}, Vst), + Acc = case is_try_catch_tag(Tag) of + true -> [{{y, Y}, Tag} | Acc0]; + false -> Acc0 + end, + collect_try_catch_tags(Y - 1, Vst, Acc). + +is_try_catch_tag({catchtag,_}) -> true; +is_try_catch_tag({trytag,_}) -> true; +is_try_catch_tag(_) -> false. eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) -> case Heap0-N of @@ -1647,89 +2598,190 @@ 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}, +%%% 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 +%%% passed to another function, placed in another term, or live in a Y register +%%% over an instruction that may GC. +%%% +%%% Fragility is marked on a per-register (rather than per-value) basis. + +%% Marks Reg as fragile. +mark_fragile(Reg, Vst) -> + #vst{current=#st{fragile=Fragile0}=St0} = Vst, + Fragile = cerl_sets:add_element(Reg, Fragile0), + St = St0#st{fragile=Fragile}, 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 +propagate_fragility(Reg, Args, #vst{current=St0}=Vst) -> + #st{fragile=Fragile0} = St0, + + Sources = cerl_sets:from_list(Args), + Fragile = case cerl_sets:is_disjoint(Sources, Fragile0) of + true -> cerl_sets:del_element(Reg, Fragile0); + false -> cerl_sets:add_element(Reg, Fragile0) + end, + + St = St0#st{fragile=Fragile}, + Vst#vst{current=St}. + +%% Marks Reg as durable, must be used when assigning a newly created value to +%% a register. +remove_fragility(Reg, Vst) -> + #vst{current=#st{fragile=Fragile0}=St0} = Vst, + case cerl_sets:is_element(Reg, Fragile0) of + true -> + Fragile = cerl_sets:del_element(Reg, Fragile0), + St = St0#st{fragile=Fragile}, + Vst#vst{current=St}; + false -> + Vst end. -bif_type('-', Src, Vst) -> - arith_type(Src, Vst); -bif_type('+', Src, Vst) -> - arith_type(Src, Vst); -bif_type('*', Src, Vst) -> - arith_type(Src, Vst); -bif_type(abs, [Num], Vst) -> +%% Marks all registers as durable. +remove_fragility(#vst{current=St0}=Vst) -> + St = St0#st{fragile=cerl_sets:new()}, + Vst#vst{current=St}. + +assert_durable_term(Src, Vst) -> + assert_term(Src, Vst), + assert_not_fragile(Src, Vst). + +assert_not_fragile({Kind,_}=Src, Vst) when Kind =:= x; Kind =:= y -> + check_limit(Src), + #vst{current=#st{fragile=Fragile}} = Vst, + case cerl_sets:is_element(Src, Fragile) of + true -> error({fragile_message_reference, Src}); + false -> ok + end; +assert_not_fragile(Lit, #vst{}) -> + assert_literal(Lit), + ok. + +%%% +%%% Return/argument types of BIFs +%%% + +bif_return_type('-', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('+', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type('*', Src, Vst) -> + arith_return_type(Src, Vst); +bif_return_type(abs, [Num], Vst) -> case get_term_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number + {float,_}=T -> T; + {integer,_}=T -> T; + _ -> number end; -bif_type(float, _, _) -> {float,[]}; -bif_type('/', _, _) -> {float,[]}; +bif_return_type(float, _, _) -> {float,[]}; +bif_return_type('/', _, _) -> {float,[]}; +%% Binary operations +bif_return_type('binary_part', [_,_], _) -> binary; +bif_return_type('binary_part', [_,_,_], _) -> binary; +bif_return_type('bit_size', [_], _) -> {integer,[]}; +bif_return_type('byte_size', [_], _) -> {integer,[]}; %% 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,[]}; -bif_type(trunc, [_], _) -> {integer,[]}; -bif_type(round, [_], _) -> {integer,[]}; -bif_type('band', [_,_], _) -> {integer,[]}; -bif_type('bor', [_,_], _) -> {integer,[]}; -bif_type('bxor', [_,_], _) -> {integer,[]}; -bif_type('bnot', [_], _) -> {integer,[]}; -bif_type('bsl', [_,_], _) -> {integer,[]}; -bif_type('bsr', [_,_], _) -> {integer,[]}; +bif_return_type(ceil, [_], _) -> {integer,[]}; +bif_return_type('div', [_,_], _) -> {integer,[]}; +bif_return_type(floor, [_], _) -> {integer,[]}; +bif_return_type('rem', [_,_], _) -> {integer,[]}; +bif_return_type(length, [_], _) -> {integer,[]}; +bif_return_type(size, [_], _) -> {integer,[]}; +bif_return_type(trunc, [_], _) -> {integer,[]}; +bif_return_type(round, [_], _) -> {integer,[]}; +bif_return_type('band', [_,_], _) -> {integer,[]}; +bif_return_type('bor', [_,_], _) -> {integer,[]}; +bif_return_type('bxor', [_,_], _) -> {integer,[]}; +bif_return_type('bnot', [_], _) -> {integer,[]}; +bif_return_type('bsl', [_,_], _) -> {integer,[]}; +bif_return_type('bsr', [_,_], _) -> {integer,[]}; %% Booleans. -bif_type('==', [_,_], _) -> bool; -bif_type('/=', [_,_], _) -> bool; -bif_type('=<', [_,_], _) -> bool; -bif_type('<', [_,_], _) -> bool; -bif_type('>=', [_,_], _) -> bool; -bif_type('>', [_,_], _) -> bool; -bif_type('=:=', [_,_], _) -> bool; -bif_type('=/=', [_,_], _) -> bool; -bif_type('not', [_], _) -> bool; -bif_type('and', [_,_], _) -> bool; -bif_type('or', [_,_], _) -> bool; -bif_type('xor', [_,_], _) -> bool; -bif_type(is_atom, [_], _) -> bool; -bif_type(is_boolean, [_], _) -> bool; -bif_type(is_binary, [_], _) -> bool; -bif_type(is_float, [_], _) -> bool; -bif_type(is_function, [_], _) -> bool; -bif_type(is_integer, [_], _) -> bool; -bif_type(is_list, [_], _) -> bool; -bif_type(is_map, [_], _) -> bool; -bif_type(is_number, [_], _) -> bool; -bif_type(is_pid, [_], _) -> bool; -bif_type(is_port, [_], _) -> bool; -bif_type(is_reference, [_], _) -> bool; -bif_type(is_tuple, [_], _) -> bool; +bif_return_type('==', [_,_], _) -> bool; +bif_return_type('/=', [_,_], _) -> bool; +bif_return_type('=<', [_,_], _) -> bool; +bif_return_type('<', [_,_], _) -> bool; +bif_return_type('>=', [_,_], _) -> bool; +bif_return_type('>', [_,_], _) -> bool; +bif_return_type('=:=', [_,_], _) -> bool; +bif_return_type('=/=', [_,_], _) -> bool; +bif_return_type('not', [_], _) -> bool; +bif_return_type('and', [_,_], _) -> bool; +bif_return_type('or', [_,_], _) -> bool; +bif_return_type('xor', [_,_], _) -> bool; +bif_return_type(is_atom, [_], _) -> bool; +bif_return_type(is_boolean, [_], _) -> bool; +bif_return_type(is_binary, [_], _) -> bool; +bif_return_type(is_float, [_], _) -> bool; +bif_return_type(is_function, [_], _) -> bool; +bif_return_type(is_function, [_,_], _) -> bool; +bif_return_type(is_integer, [_], _) -> bool; +bif_return_type(is_list, [_], _) -> bool; +bif_return_type(is_map, [_], _) -> bool; +bif_return_type(is_number, [_], _) -> bool; +bif_return_type(is_pid, [_], _) -> bool; +bif_return_type(is_port, [_], _) -> bool; +bif_return_type(is_reference, [_], _) -> bool; +bif_return_type(is_tuple, [_], _) -> bool; %% Misc. -bif_type(node, [], _) -> {atom,[]}; -bif_type(node, [_], _) -> {atom,[]}; -bif_type(hd, [_], _) -> term; -bif_type(tl, [_], _) -> term; -bif_type(get, [_], _) -> term; -bif_type(Bif, _, _) when is_atom(Bif) -> term. +bif_return_type(tuple_size, [_], _) -> {integer,[]}; +bif_return_type(map_size, [_], _) -> {integer,[]}; +bif_return_type(node, [], _) -> {atom,[]}; +bif_return_type(node, [_], _) -> {atom,[]}; +bif_return_type(hd, [_], _) -> term; +bif_return_type(tl, [_], _) -> term; +bif_return_type(get, [_], _) -> term; +bif_return_type(Bif, _, _) when is_atom(Bif) -> term. + +%% Generic +bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; +bif_arg_types(map_size, [_]) -> [map]; +bif_arg_types(is_map_key, [_,_]) -> [term, map]; +bif_arg_types(map_get, [_,_]) -> [term, map]; +bif_arg_types(length, [_]) -> [list]; +bif_arg_types(hd, [_]) -> [cons]; +bif_arg_types(tl, [_]) -> [cons]; +%% Boolean +bif_arg_types('not', [_]) -> [bool]; +bif_arg_types('and', [_,_]) -> [bool, bool]; +bif_arg_types('or', [_,_]) -> [bool, bool]; +bif_arg_types('xor', [_,_]) -> [bool, bool]; +%% Binary +bif_arg_types('binary_part', [_,_]) -> + PosLen = {tuple, 2, #{ {integer,1} => {integer,[]}, + {integer,2} => {integer,[]} }}, + [binary, PosLen]; +bif_arg_types('binary_part', [_,_,_]) -> + [binary, {integer,[]}, {integer,[]}]; +bif_arg_types('bit_size', [_]) -> [binary]; +bif_arg_types('byte_size', [_]) -> [binary]; +%% Numerical +bif_arg_types('-', [_]) -> [number]; +bif_arg_types('-', [_,_]) -> [number,number]; +bif_arg_types('+', [_]) -> [number]; +bif_arg_types('+', [_,_]) -> [number,number]; +bif_arg_types('*', [_,_]) -> [number, number]; +bif_arg_types('/', [_,_]) -> [number, number]; +bif_arg_types(abs, [_]) -> [number]; +bif_arg_types(ceil, [_]) -> [number]; +bif_arg_types(float, [_]) -> [number]; +bif_arg_types(floor, [_]) -> [number]; +bif_arg_types(trunc, [_]) -> [number]; +bif_arg_types(round, [_]) -> [number]; +%% Integer-specific +bif_arg_types('div', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('rem', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('band', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bor', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bxor', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bnot', [_]) -> [{integer,[]}]; +bif_arg_types('bsl', [_,_]) -> [{integer,[]}, {integer,[]}]; +bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}]; +%% Unsafe type tests that may fail if an argument doesn't have the right type. +bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}]; +bif_arg_types(_, Args) -> [term || _Arg <- Args]. is_bif_safe('/=', 2) -> true; is_bif_safe('<', 2) -> true; @@ -1758,86 +2810,194 @@ is_bif_safe(self, 0) -> true; is_bif_safe(node, 0) -> true; is_bif_safe(_, _) -> false. -arith_type([A,B], Vst) -> - case {get_term_type(A, Vst),get_term_type(B, Vst)} of +arith_return_type([A], Vst) -> + %% Unary '+' or '-'. + case get_term_type(A, Vst) of + {integer,_} -> {integer,[]}; + {float,_} -> {float,[]}; + _ -> number + end; +arith_return_type([A,B], Vst) -> + TypeA = get_term_type(A, Vst), + TypeB = get_term_type(B, Vst), + case {TypeA, TypeB} of + {{integer,_},{integer,_}} -> {integer,[]}; {{float,_},_} -> {float,[]}; {_,{float,_}} -> {float,[]}; {_,_} -> number end; -arith_type(_, _) -> number. +arith_return_type(_, _) -> number. + +%%% +%%% Return/argument types of calls +%%% -return_type({extfunc,M,F,A}, Vst) -> return_type_1(M, F, A, Vst); -return_type(_, _) -> term. +call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); +call_return_type(_, _) -> term. -return_type_1(erlang, setelement, 3, Vst) -> - Tuple = {x,1}, +call_return_type_1(erlang, setelement, 3, Vst) -> + IndexType = get_term_type({x,0}, Vst), TupleType = - case get_term_type(Tuple, Vst) of - {tuple,_}=TT -> - TT; - {literal,Lit} when is_tuple(Lit) -> - {tuple,tuple_size(Lit)}; - _ -> - {tuple,[0]} - end, - case get_term_type({x,0}, Vst) of - {integer,[]} -> TupleType; - {integer,I} -> upgrade_tuple_type({tuple,[I]}, TupleType); - _ -> TupleType + case get_term_type({x,1}, Vst) of + {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit); + {tuple,_,_}=TT -> TT; + _ -> {tuple,[0],#{}} + end, + case IndexType of + {integer,I} when is_integer(I) -> + case meet({tuple,[I],#{}}, TupleType) of + {tuple, Sz, Es0} -> + ValueType = get_term_type({x,2}, Vst), + Es = set_element_type({integer,I}, ValueType, Es0), + {tuple, Sz, Es}; + none -> + TupleType + end; + _ -> + %% The index could point anywhere, so we must discard all element + %% information. + setelement(3, TupleType, #{}) end; -return_type_1(erlang, F, A, _) -> - return_type_erl(F, A); -return_type_1(math, F, A, _) -> - return_type_math(F, A); -return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> +call_return_type_1(erlang, '++', 2, Vst) -> + LType = get_term_type({x,0}, Vst), + RType = get_term_type({x,1}, Vst), + case LType =:= cons orelse RType =:= cons of + true -> + cons; + false -> + %% `[] ++ RHS` yields RHS, even if RHS is not a list + join(list, RType) + end; +call_return_type_1(erlang, '--', 2, _Vst) -> + list; +call_return_type_1(erlang, F, A, _) -> + erlang_mod_return_type(F, A); +call_return_type_1(lists, F, A, Vst) -> + lists_mod_return_type(F, A, Vst); +call_return_type_1(math, F, A, _) -> + math_mod_return_type(F, A); +call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> term. -return_type_erl(exit, 1) -> exception; -return_type_erl(throw, 1) -> exception; -return_type_erl(error, 1) -> exception; -return_type_erl(error, 2) -> exception; -return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -return_type_math(cos, 1) -> {float,[]}; -return_type_math(cosh, 1) -> {float,[]}; -return_type_math(sin, 1) -> {float,[]}; -return_type_math(sinh, 1) -> {float,[]}; -return_type_math(tan, 1) -> {float,[]}; -return_type_math(tanh, 1) -> {float,[]}; -return_type_math(acos, 1) -> {float,[]}; -return_type_math(acosh, 1) -> {float,[]}; -return_type_math(asin, 1) -> {float,[]}; -return_type_math(asinh, 1) -> {float,[]}; -return_type_math(atan, 1) -> {float,[]}; -return_type_math(atanh, 1) -> {float,[]}; -return_type_math(erf, 1) -> {float,[]}; -return_type_math(erfc, 1) -> {float,[]}; -return_type_math(exp, 1) -> {float,[]}; -return_type_math(log, 1) -> {float,[]}; -return_type_math(log2, 1) -> {float,[]}; -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. - -check_limit({x,X}) when is_integer(X), X < 1023 -> - %% Note: x(1023) is reserved for use by the BEAM loader. - ok; -check_limit({y,Y}) when is_integer(Y), Y < 1024 -> - ok; -check_limit({fr,Fr}) when is_integer(Fr), Fr < 1024 -> - ok; -check_limit(_) -> - error(limit). +erlang_mod_return_type(exit, 1) -> exception; +erlang_mod_return_type(throw, 1) -> exception; +erlang_mod_return_type(error, 1) -> exception; +erlang_mod_return_type(error, 2) -> exception; +erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +math_mod_return_type(cos, 1) -> {float,[]}; +math_mod_return_type(cosh, 1) -> {float,[]}; +math_mod_return_type(sin, 1) -> {float,[]}; +math_mod_return_type(sinh, 1) -> {float,[]}; +math_mod_return_type(tan, 1) -> {float,[]}; +math_mod_return_type(tanh, 1) -> {float,[]}; +math_mod_return_type(acos, 1) -> {float,[]}; +math_mod_return_type(acosh, 1) -> {float,[]}; +math_mod_return_type(asin, 1) -> {float,[]}; +math_mod_return_type(asinh, 1) -> {float,[]}; +math_mod_return_type(atan, 1) -> {float,[]}; +math_mod_return_type(atanh, 1) -> {float,[]}; +math_mod_return_type(erf, 1) -> {float,[]}; +math_mod_return_type(erfc, 1) -> {float,[]}; +math_mod_return_type(exp, 1) -> {float,[]}; +math_mod_return_type(log, 1) -> {float,[]}; +math_mod_return_type(log2, 1) -> {float,[]}; +math_mod_return_type(log10, 1) -> {float,[]}; +math_mod_return_type(sqrt, 1) -> {float,[]}; +math_mod_return_type(atan2, 2) -> {float,[]}; +math_mod_return_type(pow, 2) -> {float,[]}; +math_mod_return_type(ceil, 1) -> {float,[]}; +math_mod_return_type(floor, 1) -> {float,[]}; +math_mod_return_type(fmod, 2) -> {float,[]}; +math_mod_return_type(pi, 0) -> {float,[]}; +math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. + +lists_mod_return_type(all, 2, _Vst) -> + bool; +lists_mod_return_type(any, 2, _Vst) -> + bool; +lists_mod_return_type(keymember, 3, _Vst) -> + bool; +lists_mod_return_type(member, 2, _Vst) -> + bool; +lists_mod_return_type(prefix, 2, _Vst) -> + bool; +lists_mod_return_type(suffix, 2, _Vst) -> + bool; +lists_mod_return_type(dropwhile, 2, _Vst) -> + list; +lists_mod_return_type(duplicate, 2, _Vst) -> + list; +lists_mod_return_type(filter, 2, _Vst) -> + list; +lists_mod_return_type(flatten, 1, _Vst) -> + list; +lists_mod_return_type(map, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> + ListType = same_length_type({x,2}, Vst), + {tuple,2,#{ {integer,1} => ListType} }; +lists_mod_return_type(partition, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(reverse, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(seq, 2, _Vst) -> + list; +lists_mod_return_type(sort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(sort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(splitwith, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(takewhile, 2, _Vst) -> + list; +lists_mod_return_type(unzip, 1, Vst) -> + ListType = same_length_type({x,0}, Vst), + two_tuple(ListType, ListType); +lists_mod_return_type(usort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(zip, 2, _Vst) -> + list; +lists_mod_return_type(zipwith, 3, _Vst) -> + list; +lists_mod_return_type(_, _, _) -> + term. + +two_tuple(Type1, Type2) -> + {tuple,2,#{ {integer,1} => Type1, + {integer,2} => Type2 }}. + +same_length_type(Reg, Vst) -> + case get_term_type(Reg, Vst) of + {literal,[_|_]} -> cons; + cons -> cons; + nil -> nil; + _ -> list + end. + +check_limit({x,X}=Src) when is_integer(X) -> + if + %% Note: x(1023) is reserved for use by the BEAM loader. + 0 =< X, X < 1023 -> ok; + 1023 =< X -> error(limit); + X < 0 -> error({bad_register, Src}) + end; +check_limit({y,Y}=Src) when is_integer(Y) -> + if + 0 =< Y, Y < 1024 -> ok; + 1024 =< Y -> error(limit); + Y < 0 -> error({bad_register, Src}) + end; +check_limit({fr,Fr}=Src) when is_integer(Fr) -> + if + 0 =< Fr, Fr < 1023 -> ok; + 1023 =< Fr -> error(limit); + Fr < 0 -> error({bad_register, Src}) + end. min(A, B) when is_integer(A), is_integer(B), A < B -> A; min(A, B) when is_integer(A), is_integer(B) -> B. -gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)). +gb_trees_from_list(L) -> gb_trees:from_orddict(sort(L)). error(Error) -> throw(Error). diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 1c9d762eb1..415b579240 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -71,6 +71,31 @@ 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([{bs_put,_,{bs_put_binary,1,_}, + [{atom,all},{literal,<<>>}]}|Is]) -> + undo_renames(Is); +undo_renames([{bs_put,Fail,{bs_put_binary,1,_Flags}, + [{atom,all},{literal,BinString}]}|Is0]) -> + Bits = bit_size(BinString), + Bytes = Bits div 8, + case Bits rem 8 of + 0 -> + I = {bs_put_string,byte_size(BinString), + {string,BinString}}, + [undo_rename(I)|undo_renames(Is0)]; + Rem -> + <<Binary:Bytes/bytes,Int:Rem>> = BinString, + PutInt = {bs_put_integer,Fail,{integer,Rem},1, + {field_flags,[unsigned,big]},{integer,Int}}, + Is = [PutInt|undo_renames(Is0)], + case Binary of + <<>> -> + Is; + _ -> + [{bs_put_string,byte_size(Binary), + {string,Binary}}|Is] + end + end; undo_renames([I|Is]) -> [undo_rename(I)|undo_renames(Is)]; undo_renames([]) -> []. @@ -79,8 +104,6 @@ undo_rename({bs_put,F,{I,U,Fl},[Sz,Src]}) -> {I,F,Sz,U,Fl,Src}; undo_rename({bs_put,F,{I,Fl},[Src]}) -> {I,F,Fl,Src}; -undo_rename({bs_put,{f,0},{bs_put_string,_,_}=I,[]}) -> - I; undo_rename({bif,bs_add=I,F,[Src1,Src2,{integer,U}],Dst}) -> {I,F,[Src1,Src2,U],Dst}; undo_rename({bif,bs_utf8_size=I,F,[Src],Dst}) -> @@ -101,7 +124,7 @@ undo_rename({test,bs_match_string=Op,F,[Ctx,Bin0]}) -> 0 -> Bin0; Rem -> <<Bin0/bitstring,0:(8-Rem)>> end, - {test,Op,F,[Ctx,Bits,{string,binary_to_list(Bin)}]}; + {test,Op,F,[Ctx,Bits,{string,Bin}]}; undo_rename({put_map,Fail,assoc,S,D,R,L}) -> {put_map_assoc,Fail,S,D,R,L}; undo_rename({put_map,Fail,exact,S,D,R,L}) -> @@ -110,6 +133,8 @@ undo_rename({test,has_map_fields,Fail,[Src|List]}) -> {test,has_map_fields,Fail,Src,{list,List}}; undo_rename({get_map_elements,Fail,Src,{list,List}}) -> {get_map_elements,Fail,Src,{list,List}}; +undo_rename({test,is_eq_exact,Fail,[Src,nil]}) -> + {test,is_nil,Fail,[Src]}; undo_rename({select,I,Reg,Fail,List}) -> {I,Reg,Fail,{list,List}}; undo_rename(I) -> I. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index fce23bfd68..bc28f58712 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -263,7 +263,7 @@ %% @see subtrees/1 %% @see meta/1 --type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' +-type ctype() :: 'alias' | 'apply' | 'binary' | 'bitstr' | 'call' | 'case' | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' | 'literal' | 'map' | 'map_pair' | 'module' | 'primop' | 'receive' | 'seq' | 'try' | 'tuple' | 'values' | 'var'. @@ -2157,12 +2157,16 @@ values_arity(Node) -> %% @spec c_binary(Segments::[cerl()]) -> cerl() %% -%% @doc Creates an abstract binary-template. A binary object is a -%% sequence of 8-bit bytes. It is specified by zero or more bit-string -%% template <em>segments</em> of arbitrary lengths (in number of bits), -%% such that the sum of the lengths is evenly divisible by 8. If -%% <code>Segments</code> is <code>[S1, ..., Sn]</code>, the result -%% represents "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the + +%% @doc Creates an abstract binary-template. A binary object is in +%% this context a sequence of an arbitrary number of bits. (The number +%% of bits used to be evenly divisible by 8, but after the +%% introduction of bit strings in the Erlang language, the choice was +%% made to use the binary template for all bit strings.) It is +%% specified by zero or more bit-string template <em>segments</em> of +%% arbitrary lengths (in number of bits). If <code>Segments</code> is +%% <code>[S1, ..., Sn]</code>, the result represents +%% "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the %% <code>Si</code> must have type <code>bitstr</code>. %% %% @see ann_c_binary/2 diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index fa5104c01b..3fd7ddd181 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -14,8 +14,8 @@ %% @author Richard Carlsson <[email protected]> %% @doc Utility functions for Core Erlang case/receive clauses. %% -%% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> +%% <p>Syntax trees are defined in the module +%% <a href="cerl"><code>cerl</code></a>.</p> %% %% @type cerl() = cerl:cerl() diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl index 0361186713..f489baf238 100644 --- a/lib/compiler/src/cerl_sets.erl +++ b/lib/compiler/src/cerl_sets.erl @@ -204,4 +204,4 @@ fold(F, Init, D) -> Set2 :: set(Element). filter(F, D) -> - maps:from_list(lists:filter(fun({K,_}) -> F(K) end, maps:to_list(D))). + maps:filter(fun(K,_) -> F(K) end, D). diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 6510571441..0325c714d0 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -31,6 +31,9 @@ %% Erlc interface. -export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]). +%% Utility functions for compiler passes. +-export([run_sub_passes/2]). + -export_type([option/0]). -include("erl_compile.hrl"). @@ -39,6 +42,8 @@ -import(lists, [member/2,reverse/1,reverse/2,keyfind/3,last/1, map/2,flatmap/2,foreach/2,foldr/3,any/2]). +-define(SUB_PASS_TIMES, compile__sub_pass_times). + %%---------------------------------------------------------------------- -type abstract_code() :: [erl_parse:abstract_form()]. @@ -64,6 +69,7 @@ -type err_ret() :: 'error' | {'error', errors(), warnings()}. -type comp_ret() :: mod_ret() | bin_ret() | err_ret(). + %%---------------------------------------------------------------------- %% @@ -143,6 +149,30 @@ noenv_output_generated(Opts) -> env_compiler_options() -> env_default_opts(). + +%%% +%%% Run sub passes from a compiler pass. +%%% + +-spec run_sub_passes([term()], term()) -> term(). + +run_sub_passes(Ps, St) -> + case get(?SUB_PASS_TIMES) of + undefined -> + Runner = fun(_Name, Run, S) -> Run(S) end, + run_sub_passes_1(Ps, Runner, St); + Times when is_list(Times) -> + Runner = fun(Name, Run, S0) -> + T1 = erlang:monotonic_time(), + S = Run(S0), + T2 = erlang:monotonic_time(), + put(?SUB_PASS_TIMES, + [{Name,T2-T1}|get(?SUB_PASS_TIMES)]), + S + end, + run_sub_passes_1(Ps, Runner, St) + end. + %% %% Local functions %% @@ -180,8 +210,11 @@ do_compile(Input, Opts0) -> {error,Reason} end end, - %% Dialyzer has already spawned workers. - case lists:member(dialyzer, Opts) of + %% Some tools, like Dialyzer, has already spawned workers + %% and spawning extra workers actually slow the compilation + %% down instead of speeding it up, so we provide a mechanism + %% to bypass the compiler process. + case lists:member(no_spawn_compiler_process, Opts) of true -> IntFun(); false -> @@ -218,23 +251,36 @@ expand_opt(report, Os) -> [report_errors,report_warnings|Os]; expand_opt(return, Os) -> [return_errors,return_warnings|Os]; +expand_opt(no_bsm3, Os) -> + %% The new bsm pass requires bsm3 instructions. + [no_bsm3,no_bsm_opt|Os]; expand_opt(r16, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r17, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r18, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r19, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); expand_opt(r20, Os) -> - [no_get_hd_tl,no_record_opt,no_utf8_atoms|Os]; + expand_opt_before_21(Os); +expand_opt(r21, Os) -> + [no_put_tuple2 | expand_opt(no_bsm3, Os)]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; -expand_opt(no_float_opt, Os) -> - %%Turn off the entire type optimization pass. - [no_topt|Os]; +expand_opt(no_type_opt=O, Os) -> + %% Be sure to keep the no_type_opt option so that it will + %% be recorded in the BEAM file, allowing the test suites + %% to recompile the file with this option. + [O,no_ssa_opt_type_start, + no_ssa_opt_type_continue, + no_ssa_opt_type_finish | Os]; expand_opt(O, Os) -> [O|Os]. +expand_opt_before_21(Os) -> + [no_put_tuple2, no_get_hd_tl, no_ssa_opt_record, + no_utf8_atoms | expand_opt(no_bsm3, Os)]. + %% format_error(ErrorDescriptor) -> string() -spec format_error(term()) -> iolist(). @@ -247,6 +293,10 @@ format_error(bad_crypto_key) -> "invalid crypto key."; format_error(no_crypto_key) -> "no crypto key supplied."; +format_error({unimplemented_instruction,Instruction}) -> + io_lib:fwrite("native-code compilation failed because of an " + "unimplemented instruction (~s).", + [Instruction]); format_error({native, E}) -> io_lib:fwrite("native-code compilation failed with reason: ~tP.", [E, 25]); @@ -387,17 +437,57 @@ fold_comp([{Name,Pass}|Ps], Run, Code0, St0) -> end; fold_comp([], _Run, Code, St) -> {ok,Code,St}. +run_sub_passes_1([{Name,Run}|Ps], Runner, St0) + when is_atom(Name), is_function(Run, 1) -> + try Runner(Name, Run, St0) of + St -> + run_sub_passes_1(Ps, Runner, St) + catch + C:E:Stk -> + io:format("Sub pass ~s\n", [Name]), + erlang:raise(C, E, Stk) + end; +run_sub_passes_1([], _, St) -> St. + run_tc({Name,Fun}, Code, St) -> + put(?SUB_PASS_TIMES, []), T1 = erlang:monotonic_time(), Val = (catch Fun(Code, St)), T2 = erlang:monotonic_time(), - Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond), + Times = erase(?SUB_PASS_TIMES), + Elapsed = erlang:convert_time_unit(T2 - T1, native, microsecond), 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]), + [Name,Elapsed/1000000,Mem]), + print_times(Times, Name), Val. +print_times(Times0, Name) -> + Fam0 = sofs:relation(Times0), + Fam1 = sofs:rel2fam(Fam0), + Fam2 = sofs:to_external(Fam1), + Fam3 = [{W,lists:sum(Times)} || {W,Times} <- Fam2], + Fam = reverse(lists:keysort(2, Fam3)), + Total = case lists:sum([T || {_,T} <- Fam]) of + 0 -> 1; + Total0 -> Total0 + end, + case Fam of + [] -> + ok; + [_|_] -> + io:format(" %% Sub passes of ~s from slowest to fastest:\n", [Name]), + print_times_1(Fam, Total) + end. + +print_times_1([{Name,T}|Ts], Total) -> + Elapsed = erlang:convert_time_unit(T, native, microsecond), + io:format(" ~-27s: ~10.3f s ~3w %\n", + [Name,Elapsed/1000000,round(100*T/Total)]), + print_times_1(Ts, Total); +print_times_1([], _Total) -> ok. + run_eprof({Name,Fun}, Code, Name, St) -> io:format("~p: Running eprof\n", [Name]), c:appcall(tools, eprof, start_profiling, [[self()]]), @@ -731,8 +821,6 @@ kernel_passes() -> %% 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)}, {iff,core,?pass(save_core_code)}, @@ -741,8 +829,30 @@ kernel_passes() -> ?pass(v3_kernel), {iff,dkern,{listing,"kernel"}}, {iff,'to_kernel',{done,"kernel"}}, - {pass,v3_codegen}, - {iff,dcg,{listing,"codegen"}} + {pass,beam_kernel_to_ssa}, + {iff,dssa,{listing,"ssa"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {delay, + [{unless,no_share_opt,{pass,beam_ssa_share}}, + {iff,dssashare,{listing,"ssashare"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_bsm_opt,{pass,beam_ssa_bsm}}, + {iff,dssabsm,{listing,"ssabsm"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_fun_opt,{pass,beam_ssa_funs}}, + {iff,dssafuns,{listing,"ssafuns"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_ssa_opt,{pass,beam_ssa_opt}}, + {iff,dssaopt,{listing,"ssaopt"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_recv_opt,{pass,beam_ssa_recv}}, + {iff,drecv,{listing,"recv"}}]}, + {pass,beam_ssa_pre_codegen}, + {iff,dprecg,{listing,"precodegen"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, + {pass,beam_ssa_codegen}, + {iff,dcg,{listing,"codegen"}}, + {iff,doldcg,{listing,"codegen"}} | asm_passes()]. asm_passes() -> @@ -751,34 +861,16 @@ asm_passes() -> [{pass,beam_a}, {iff,da,{listing,"a"}}, {unless,no_postopt, - [{unless,no_reorder,{pass,beam_reorder}}, - {iff,dre,{listing,"reorder"}}, - {pass,beam_block}, + [{pass,beam_block}, {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, {iff,dexcept,{listing,"except"}}, - {unless,no_bs_opt,{pass,beam_bs}}, - {iff,dbs,{listing,"bs"}}, - {unless,no_topt,{pass,beam_type}}, - {iff,dtype,{listing,"type"}}, - {pass,beam_split}, - {iff,dsplit,{listing,"split"}}, - {unless,no_dead,{pass,beam_dead}}, - {iff,ddead,{listing,"dead"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, {unless,no_peep_opt,{pass,beam_peep}}, {iff,dpeep,{listing,"peep"}}, {pass,beam_clean}, {iff,dclean,{listing,"clean"}}, - {unless,no_bsm_opt,{pass,beam_bsm}}, - {iff,dbsm,{listing,"bsm"}}, - {unless,no_recv_opt,{pass,beam_receive}}, - {iff,drecv,{listing,"recv"}}, - {unless,no_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}]}, @@ -787,7 +879,9 @@ asm_passes() -> %% need to do a few clean-ups to code. {iff,no_postopt,[{pass,beam_clean}]}, + {iff,diffable,?pass(diffable)}, {pass,beam_z}, + {iff,diffable,{listing,"S"}}, {iff,dz,{listing,"z"}}, {iff,dopt,{listing,"optimize"}}, {iff,'S',{listing,"S"}}, @@ -1360,10 +1454,6 @@ v3_kernel(Code0, #compile{options=Opts,warnings=Ws0}=St) -> {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. @@ -1568,18 +1658,22 @@ native_compile_1(Code, St) -> case IgnoreErrors of true -> Ws = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> Es = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end catch + exit:{unimplemented_instruction,_}=Unimplemented -> + Ws = [{St#compile.ifile, + [{none,?MODULE,Unimplemented}]}], + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; Class:R:Stack -> case IgnoreErrors of true -> Ws = [{St#compile.ifile, [{none,?MODULE,{native_crash,R,Stack}}]}], - {ok,St#compile{warnings=St#compile.warnings ++ Ws}}; + {ok,Code,St#compile{warnings=St#compile.warnings ++ Ws}}; false -> erlang:raise(Class, R, Stack) end @@ -1849,6 +1943,39 @@ restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. +%%% +%%% Transform the BEAM code to make it more friendly for +%%% diffing: using function names instead of labels for +%%% local calls and number labels relative to each function. +%%% + +diffable(Code0, St) -> + {Mod,Exp,Attr,Fs0,NumLabels} = Code0, + EntryLabels0 = [{Entry,{Name,Arity}} || + {function,Name,Arity,Entry,_} <- Fs0], + EntryLabels = maps:from_list(EntryLabels0), + Fs = [diffable_fix_function(F, EntryLabels) || F <- Fs0], + Code = {Mod,Exp,Attr,Fs,NumLabels}, + {ok,Code,St}. + +diffable_fix_function({function,Name,Arity,Entry0,Is0}, LabelMap0) -> + Entry = maps:get(Entry0, LabelMap0), + {Is1,LabelMap} = diffable_label_map(Is0, 1, LabelMap0, []), + Fb = fun(Old) -> error({no_fb,Old}) end, + Is = beam_utils:replace_labels(Is1, [], LabelMap, Fb), + {function,Name,Arity,Entry,Is}. + +diffable_label_map([{label,Old}|Is], New, Map, Acc) -> + case Map of + #{Old:=NewLabel} -> + diffable_label_map(Is, New, Map, [{label,NewLabel}|Acc]); + #{} -> + diffable_label_map(Is, New+1, Map#{Old=>New}, [{label,New}|Acc]) + end; +diffable_label_map([I|Is], New, Map, Acc) -> + diffable_label_map(Is, New, Map, [I|Acc]); +diffable_label_map([], _New, Map, Acc) -> + {Acc,Map}. -spec options() -> 'ok'. @@ -1969,22 +2096,25 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, - beam_bs, - beam_bsm, beam_clean, - beam_dead, beam_dict, beam_except, beam_flatten, beam_jump, + beam_kernel_to_ssa, beam_opcodes, beam_peep, - beam_receive, - beam_record, - beam_reorder, - beam_split, + beam_ssa, + beam_ssa_bsm, + beam_ssa_codegen, + beam_ssa_dead, + beam_ssa_funs, + beam_ssa_opt, + beam_ssa_pre_codegen, + beam_ssa_recv, + beam_ssa_share, + beam_ssa_type, beam_trim, - beam_type, beam_utils, beam_validator, beam_z, @@ -2001,9 +2131,7 @@ pre_load() -> erl_scan, sys_core_alias, sys_core_bsm, - sys_core_dsetel, sys_core_fold, - v3_codegen, v3_core, v3_kernel], _ = code:ensure_modules_loaded(L), diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index cf32fd251c..a086a3a8d3 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,24 +24,29 @@ beam_a, beam_asm, beam_block, - beam_bs, - beam_bsm, beam_clean, - beam_dead, beam_dict, beam_disasm, beam_except, beam_flatten, beam_jump, + beam_kernel_to_ssa, beam_listing, beam_opcodes, beam_peep, - beam_receive, - beam_reorder, - beam_record, - beam_split, + beam_ssa, + beam_ssa_bsm, + beam_ssa_codegen, + beam_ssa_dead, + beam_ssa_funs, + beam_ssa_lint, + beam_ssa_opt, + beam_ssa_pp, + beam_ssa_pre_codegen, + beam_ssa_recv, + beam_ssa_share, + beam_ssa_type, beam_trim, - beam_type, beam_utils, beam_validator, beam_z, @@ -60,12 +65,10 @@ rec_env, sys_core_alias, sys_core_bsm, - sys_core_dsetel, sys_core_fold, sys_core_fold_lists, sys_core_inline, sys_pre_attributes, - v3_codegen, v3_core, v3_kernel, v3_kernel_pp diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index 83a6f0179c..90c796d3d9 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% Copyright Ericsson AB 1999-2019. 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,81 +29,82 @@ %% The record definitions appear alphabetically --record(c_alias, {anno=[], var, % var :: Tree, - pat}). % pat :: Tree +-record(c_alias, {anno=[] :: list(), var :: cerl:cerl(), + pat :: cerl:cerl()}). --record(c_apply, {anno=[], op, % op :: Tree, - args}). % args :: [Tree] +-record(c_apply, {anno=[] :: list(), op :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}). +-record(c_binary, {anno=[] :: list(), segments :: [cerl:c_bitstr()]}). --record(c_bitstr, {anno=[], val, % val :: Tree, - size, % size :: Tree, - unit, % unit :: Tree, - type, % type :: Tree, - flags}). % flags :: Tree +-record(c_bitstr, {anno=[] :: list(), val :: cerl:cerl(), + size :: cerl:cerl(), + unit :: cerl:cerl(), + type :: cerl:cerl(), + flags :: cerl:cerl()}). --record(c_call, {anno=[], module, % module :: Tree, - name, % name :: Tree, - args}). % args :: [Tree] +-record(c_call, {anno=[] :: list(), module :: cerl:cerl(), + name :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_case, {anno=[], arg, % arg :: Tree, - clauses}). % clauses :: [Tree] +-record(c_case, {anno=[] :: list(), arg :: cerl:cerl(), + clauses :: [cerl:cerl()]}). --record(c_catch, {anno=[], body}). % body :: Tree +-record(c_catch, {anno=[] :: list(), body :: cerl:cerl()}). --record(c_clause, {anno=[], pats, % pats :: [Tree], - guard, % guard :: Tree, - body}). % body :: Tree +-record(c_clause, {anno=[] :: list(), pats :: [cerl:cerl()], + guard :: cerl:cerl(), + body :: cerl:cerl() | any()}). % TODO --record(c_cons, {anno=[], hd, % hd :: Tree, - tl}). % tl :: Tree +-record(c_cons, {anno=[] :: list(), hd :: cerl:cerl(), + tl :: cerl:cerl()}). --record(c_fun, {anno=[], vars, % vars :: [Tree], - body}). % body :: Tree +-record(c_fun, {anno=[] :: list(), vars :: [cerl:cerl()], + body :: cerl:cerl()}). --record(c_let, {anno=[], vars, % vars :: [Tree], - arg, % arg :: Tree, - body}). % body :: Tree +-record(c_let, {anno=[] :: list(), vars :: [cerl:cerl()], + arg :: cerl:cerl(), + body :: cerl:cerl()}). --record(c_letrec, {anno=[], defs, % defs :: [#c_def{}], - body}). % body :: Tree +-record(c_letrec, {anno=[] :: list(), + defs :: [{cerl:cerl(), cerl:cerl()}], + body :: cerl:cerl()}). --record(c_literal, {anno=[], val}). % val :: literal() +-record(c_literal, {anno=[] :: list(), val :: any()}). --record(c_map, {anno=[], +-record(c_map, {anno=[] :: list(), arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(), es :: [cerl:c_map_pair()], is_pat=false :: boolean()}). --record(c_map_pair, {anno=[], +-record(c_map_pair, {anno=[] :: list(), op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, - key, - val}). + key :: any(), % TODO + val :: any()}). % TODO --record(c_module, {anno=[], name, % name :: Tree, - exports, % exports :: [Tree], - attrs, % attrs :: [#c_def{}], - defs}). % defs :: [#c_def{}] +-record(c_module, {anno=[] :: list(), name :: cerl:cerl(), + exports :: [cerl:cerl()], + attrs :: [{cerl:cerl(), cerl:cerl()}], + defs :: [{cerl:cerl(), cerl:cerl()}]}). --record(c_primop, {anno=[], name, % name :: Tree, - args}). % args :: [Tree] +-record(c_primop, {anno=[] :: list(), name :: cerl:cerl(), + args :: [cerl:cerl()]}). --record(c_receive, {anno=[], clauses, % clauses :: [Tree], - timeout, % timeout :: Tree, - action}). % action :: Tree +-record(c_receive, {anno=[] :: list(), clauses :: [cerl:cerl()], + timeout :: cerl:cerl(), + action :: cerl:cerl()}). --record(c_seq, {anno=[], arg, % arg :: Tree, - body}). % body :: Tree +-record(c_seq, {anno=[] :: list(), arg :: cerl:cerl() | any(), % TODO + body :: cerl:cerl()}). --record(c_try, {anno=[], arg, % arg :: Tree, - vars, % vars :: [Tree], - body, % body :: Tree - evars, % evars :: [Tree], - handler}). % handler :: Tree +-record(c_try, {anno=[] :: list(), arg :: cerl:cerl(), + vars :: [cerl:cerl()], + body :: cerl:cerl(), + evars :: [cerl:cerl()], + handler :: cerl:cerl()}). --record(c_tuple, {anno=[], es}). % es :: [Tree] +-record(c_tuple, {anno=[] :: list(), es :: [cerl:cerl()]}). --record(c_values, {anno=[], es}). % es :: [Tree] +-record(c_values, {anno=[] :: list(), es :: [cerl:cerl()]}). --record(c_var, {anno=[], name :: cerl:var_name()}). +-record(c_var, {anno=[] :: list(), name :: cerl:var_name()}). diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 68489a0122..94a5dfe012 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -32,6 +32,22 @@ %% Returns `true' if the function `Module:Name/Arity' does not %% affect the state, nor depend on the state, although its %% evaluation is not guaranteed to complete normally for all input. +%% +%% NOTE: There is no need to include every new pure BIF +%% here. Including it here means that the value of the function +%% will be evaluated at compile-time if the arguments are +%% constant. If that optimization is not useful/desired, there is +%% no need to include the new BIF here. +%% +%% Functions whose return value could conceivably change in a +%% future version of the runtime system must NOT be included here. +%% +%% Here are some example of functions that should not be +%% included: `term_to_binary/1', hashing functions, non-trivial +%% encode/decode functions. +%% +%% When unsure whether a new BIF should be included here, the +%% conservative safe choice is NOT to include it. -spec is_pure(atom(), atom(), arity()) -> boolean(). @@ -91,6 +107,7 @@ is_pure(erlang, is_bitstring, 1) -> true; %% erlang:is_builtin/3 depends on the state (i.e. the version of the emulator). is_pure(erlang, is_float, 1) -> true; is_pure(erlang, is_function, 1) -> true; +is_pure(erlang, is_function, 2) -> true; is_pure(erlang, is_integer, 1) -> true; is_pure(erlang, is_list, 1) -> true; is_pure(erlang, is_map, 1) -> true; @@ -107,6 +124,7 @@ is_pure(erlang, list_to_atom, 1) -> true; is_pure(erlang, list_to_binary, 1) -> true; is_pure(erlang, list_to_float, 1) -> true; is_pure(erlang, list_to_integer, 1) -> true; +is_pure(erlang, list_to_integer, 2) -> true; is_pure(erlang, list_to_pid, 1) -> true; is_pure(erlang, list_to_tuple, 1) -> true; is_pure(erlang, max, 2) -> true; @@ -193,6 +211,7 @@ is_safe(erlang, is_float, 1) -> true; is_safe(erlang, is_function, 1) -> true; is_safe(erlang, is_integer, 1) -> true; is_safe(erlang, is_list, 1) -> true; +is_safe(erlang, is_map, 1) -> true; is_safe(erlang, is_number, 1) -> true; is_safe(erlang, is_pid, 1) -> true; is_safe(erlang, is_port, 1) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 02dead9e92..86590fad87 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -142,8 +142,7 @@ BEAM_FORMAT_NUMBER=0 20: send/0 ## @spec remove_message -## @doc Unlink the current message from the message queue and store a -## pointer to the message in x(0). Remove any timeout. +## @doc Unlink the current message from the message queue. Remove any timeout. 21: remove_message/0 ## @spec timeout @@ -574,3 +573,26 @@ BEAM_FORMAT_NUMBER=0 ## @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 + +# OTP 22 + +## @spec put_tuple2 Destination Elements +## @doc Build a tuple with the elements in the list Elements and put it +## put into register Destination. +164: put_tuple2/2 + +## @spec bs_get_tail Ctx Dst Live +## @doc Sets Dst to the tail of Ctx at the current position +165: bs_get_tail/3 + +## @spec bs_start_match3 Fail Bin Live Dst +## @doc Starts a binary match sequence +166: bs_start_match3/4 + +## @spec bs_get_position Ctx Dst Live +## @doc Sets Dst to the current position of Ctx +167: bs_get_position/3 + +## @spec bs_set_positon Ctx Pos +## @doc Sets the current position of Ctx to Pos +168: bs_set_position/2 diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl index 62657933ee..685e807e65 100644 --- a/lib/compiler/src/sys_core_bsm.erl +++ b/lib/compiler/src/sys_core_bsm.erl @@ -24,223 +24,52 @@ -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. +module(#c_module{defs=Ds}=Mod, _Opts) -> + {ok,Mod#c_module{defs=function(Ds)}}. -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) +function([{#c_var{name={F,Arity}}=Name,B0}|Fs]) -> + try cerl_trees:map(fun bsm_reorder/1, B0) of + B -> [{Name,B} | function(Fs)] catch - throw:unsafe_bs_context_to_binary -> - %% Unsafe bs_context_to_binary (in the sense that the - %% contents of the binary will probably be wrong). - %% Disable binary optimizations for the entire function. - %% We don't generate an INFO message, because this happens - %% very infrequently and it would be hard to explain in - %% a comprehensible way in an INFO message. - function(Fs, [{Name,B0}|FsAcc], Ws0); Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [F,Arity]), - erlang:raise(Class, Error, Stack) + io:fwrite("Function: ~w/~w\n", [F,Arity]), + erlang:raise(Class, Error, Stack) end; -function([], Fs, Ws) -> - {reverse(Fs),Ws}. +function([]) -> + []. -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". - +format_error(_) -> error(badarg). -%%% -%%% Annotate bit syntax matching to faciliate optimization in further passes. -%%% +%%% Reorder 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_reorder(#c_case{arg=#c_var{}=V}=Case) -> + bsm_reorder_1([V], Case); +bsm_reorder(#c_case{arg=#c_values{es=Es}}=Case) -> + bsm_reorder_1(Es, Case); +bsm_reorder(Core) -> + Core. -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) -> +bsm_reorder_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}} + Pos when Pos > 0, Pos =/= none -> + Vs = core_lib:make_values(move_from_col(Pos, Vs0)), + Cs = [C#c_clause{pats=move_from_col(Pos, Ps)} + || #c_clause{pats=Ps}=C <- Cs0], + Case#c_case{arg=Vs,clauses=Cs}; + _ -> + Case end. move_from_col(Pos, L) -> {First,[Col|Rest]} = lists:split(Pos - 1, L), [Col|First] ++ Rest. -bsm_do_an([#c_var{name=Vname}=V0|Vs0], Cs0, Case) -> - bsm_inner_context_to_binary(Cs0), - Cs = bsm_do_an_var(Vname, Cs0), - V = bsm_annotate_for_reuse(V0), - Vs = core_lib:make_values([V|Vs0]), - Case#c_case{arg=Vs,clauses=Cs}; -bsm_do_an(_Vs, _Cs, Case) -> Case. - -bsm_inner_context_to_binary([#c_clause{body=B}|Cs]) -> - %% Consider: - %% - %% foo(<<Length, Data/binary>>) -> %Line 1 - %% case {Data, Length} of %Line 2 - %% {_, 0} -> Data; %Line 3 - %% {<<...>>, 4} -> ... %Line 4 - %% end. - %% - %% No sub binary will be created for Data in line 1. The match - %% context will be passed on to the `case` in line 2. In line 3, - %% this pass inserts a `bs_context_to_binary` instruction to - %% convert the match context representing Data to a binary before - %% returning it. The problem is that the binary created will be - %% the original binary (including the matched out Length field), - %% not the tail of the binary as it is supposed to be. - %% - %% Here follows a heuristic to disable the binary optimizations - %% for the entire function if this code kind of code is found. - - case cerl_trees:free_variables(B) of - [] -> - %% Since there are no free variables in the body of - %% this clause, there can't be any troublesome - %% bs_context_to_binary instructions. - bsm_inner_context_to_binary(Cs); - [_|_]=Free -> - %% One of the free variables could refer to a match context - %% created by the outer binary match. - F = fun(#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}, _) -> - case member(V, Free) of - true -> - %% This bs_context_to_binary instruction will - %% make a binary of the match context from an - %% outer binary match. It is very likely that - %% the contents of the binary will be wrong - %% (the original binary as opposed to only - %% the tail binary). - throw(unsafe_bs_context_to_binary); - false -> - %% Safe. This bs_context_to_binary instruction - %% will make a binary from a match context - %% defined in the body of the clause. - ok - end; - (_, _) -> - ok - end, - cerl_trees:fold(F, ok, B) - end; -bsm_inner_context_to_binary([]) -> ok. - -bsm_do_an_var(V, [#c_clause{pats=[P|_],guard=G,body=B0}=C0|Cs]) -> - case P of - #c_var{name=VarName} -> - case core_lib:is_var_used(V, G) of - true -> bsm_problem(C0, orig_bin_var_used_in_guard); - false -> ok - end, - case core_lib:is_var_used(VarName, G) of - true -> bsm_problem(C0, bin_var_used_in_guard); - false -> ok - end, - B1 = bsm_maybe_ctx_to_binary(VarName, B0), - B = bsm_maybe_ctx_to_binary(V, B1), - C = C0#c_clause{body=B}, - [C|bsm_do_an_var(V, Cs)]; - #c_alias{} -> - case bsm_could_match_binary(P) of - false -> - [C0|bsm_do_an_var(V, Cs)]; - true -> - bsm_problem(C0, bin_opt_alias) - end; - _ -> - case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of - false -> - [C0|bsm_do_an_var(V, Cs)]; - true -> - bsm_problem(C0, bin_var_used) - end - end; -bsm_do_an_var(_, []) -> []. - -bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) -> - Var#c_var{anno=[reuse_for_context|Anno]}. - -bsm_is_var_used(V, G, B) -> - core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B). - -bsm_maybe_ctx_to_binary(V, B) -> - case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of - false -> - B; - true -> - #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}, - body=B} - end. - -previous_ctx_to_binary(V, Core) -> - case Core of - #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, - args=[#c_var{name=V}]}} -> - true; - _ -> - false - end. - %% bsm_leftmost(Cs) -> none | ArgumentNumber %% Find the leftmost argument that matches a nonempty binary. %% Return either 'none' or the argument number (1-N). @@ -262,94 +91,3 @@ 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 deleted file mode 100644 index 9ab83c210f..0000000000 --- a/lib/compiler/src/sys_core_dsetel.erl +++ /dev/null @@ -1,360 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% 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. -%% 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 : Using dsetelement to make multiple-field record updates -%% faster. - -%% The expansion of record field updates, when more than one field is -%% updated, but not a majority of the fields, will create a sequence of -%% calls to 'erlang:setelement(Index, Value, Tuple)' where Tuple in the -%% first call is the original record tuple, and in the subsequent calls -%% Tuple is the result of the previous call. Furthermore, all Index -%% values are constant positive integers, and the first call to -%% 'setelement' will have the greatest index. Thus all the following -%% calls do not actually need to test at run-time whether Tuple has type -%% tuple, nor that the index is within the tuple bounds. -%% -%% Since this introduces destructive updates in the Core Erlang code, it -%% must be done as a last stage before going to lower-level code. -%% -%% NOTE: Because there are currently no write barriers in the system, -%% this kind of optimization can only be done when we are sure that -%% garbage collection will not be triggered between the creation of the -%% tuple and the destructive updates - otherwise we might insert -%% pointers from an older generation to a newer. -%% -%% The rewriting is done as follows: -%% -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in call 'erlang':'setelement(3, X1, Value2) -%% => -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X1, Value2) -%% X1 -%% and -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in let X2 = call 'erlang':'setelement(3, X1, Value2) -%% in ... -%% => -%% let X2 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop 'dsetelement(3, X2, Value2) -%% ... -%% if X1 is used exactly once. -%% Thus, we need to track variable usage. -%% - --module(sys_core_dsetel). - --export([module/2]). - --include("core_parse.hrl"). - --spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}. - -module(M0, _Options) -> - M = visit_module(M0), - {ok,M}. - -visit_module(#c_module{defs=Ds0}=R) -> - Env = #{}, - Ds = visit_module_1(Ds0, Env, []), - R#c_module{defs=Ds}. - -visit_module_1([{Name,F0}|Fs], Env, Acc) -> - try visit(Env, F0) of - {F,_} -> - visit_module_1(Fs, Env, [{Name,F}|Acc]) - catch - Class:Error:Stack -> - #c_var{name={Func,Arity}} = Name, - io:fwrite("Function: ~w/~w\n", [Func,Arity]), - erlang:raise(Class, Error, Stack) - end; -visit_module_1([], _, Acc) -> - lists:reverse(Acc). - -visit(Env, #c_var{name={_,_}}=R) -> - %% Ignore local function name. - {R, Env}; -visit(Env0, #c_var{name=X}=R) -> - %% There should not be any free variables. If there are, - %% the case will fail with an exception. - case Env0 of - #{X:=N} -> - {R, Env0#{X:=N+1}} - end; -visit(Env, #c_literal{}=R) -> - {R, Env}; -visit(Env0, #c_tuple{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_tuple{es=Es1}, Env1}; -visit(Env0, #c_map{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_map{es=Es1}, Env1}; -visit(Env0, #c_map_pair{key=K0,val=V0}=R) -> - {K,Env1} = visit(Env0, K0), - {V,Env2} = visit(Env1, V0), - {R#c_map_pair{key=K,val=V}, Env2}; -visit(Env0, #c_cons{hd=H0,tl=T0}=R) -> - {H1,Env1} = visit(Env0, H0), - {T1,Env2} = visit(Env1, T0), - {R#c_cons{hd=H1,tl=T1}, Env2}; -visit(Env0, #c_binary{segments=Segs}=R) -> - Env = visit_bin_segs(Env0, Segs), - {R, Env}; -visit(Env0, #c_values{es=Es0}=R) -> - {Es1,Env1} = visit_list(Env0, Es0), - {R#c_values{es=Es1}, Env1}; -visit(Env0, #c_fun{vars=Vs, body=B0}=R) -> - {Xs, Env1} = bind_vars(Vs, Env0), - {B1,Env2} = visit(Env1, B0), - {R#c_fun{body=B1}, restore_vars(Xs, Env0, Env2)}; -visit(Env0, #c_let{vars=Vs, arg=A0, body=B0}=R) -> - {A1,Env1} = visit(Env0, A0), - {Xs,Env2} = bind_vars(Vs, Env1), - {B1,Env3} = visit(Env2, B0), - rewrite(R#c_let{arg=A1,body=B1}, Env3, restore_vars(Xs, Env1, Env3)); -visit(Env0, #c_seq{arg=A0, body=B0}=R) -> - {A1,Env1} = visit(Env0, A0), - {B1,Env2} = visit(Env1, B0), - {R#c_seq{arg=A1,body=B1}, Env2}; -visit(Env0, #c_case{arg=A0,clauses=Cs0}=R) -> - {A1,Env1} = visit(Env0, A0), - {Cs1,Env2} = visit_list(Env1, Cs0), - {R#c_case{arg=A1,clauses=Cs1}, Env2}; -visit(Env0, #c_clause{pats=Ps,guard=G0,body=B0}=R) -> - {Vs, Env1} = visit_pats(Ps, Env0), - {G1,Env2} = visit(Env1, G0), - {B1,Env3} = visit(Env2, B0), - {R#c_clause{guard=G1,body=B1}, restore_vars(Vs, Env0, Env3)}; -visit(Env0, #c_receive{clauses=Cs0,timeout=T0,action=A0}=R) -> - {T1,Env1} = visit(Env0, T0), - {Cs1,Env2} = visit_list(Env1, Cs0), - {A1,Env3} = visit(Env2, A0), - {R#c_receive{clauses=Cs1,timeout=T1,action=A1}, Env3}; -visit(Env0, #c_apply{op=Op0, args=As0}=R) -> - {Op1,Env1} = visit(Env0, Op0), - {As1,Env2} = visit_list(Env1, As0), - {R#c_apply{op=Op1,args=As1}, Env2}; -visit(Env0, #c_call{module=M0,name=N0,args=As0}=R) -> - {M1,Env1} = visit(Env0, M0), - {N1,Env2} = visit(Env1, N0), - {As1,Env3} = visit_list(Env2, As0), - {R#c_call{module=M1,name=N1,args=As1}, Env3}; -visit(Env0, #c_primop{name=N0, args=As0}=R) -> - {N1,Env1} = visit(Env0, N0), - {As1,Env2} = visit_list(Env1, As0), - {R#c_primop{name=N1,args=As1}, Env2}; -visit(Env0, #c_try{arg=E0, vars=Vs, body=B0, evars=Evs, handler=H0}=R) -> - {E1,Env1} = visit(Env0, E0), - {Xs, Env2} = bind_vars(Vs, Env1), - {B1,Env3} = visit(Env2, B0), - Env4 = restore_vars(Xs, Env1, Env3), - {Ys, Env5} = bind_vars(Evs, Env4), - {H1,Env6} = visit(Env5, H0), - {R#c_try{arg=E1,body=B1,handler=H1}, restore_vars(Ys, Env4, Env6)}; -visit(Env0, #c_catch{body=B0}=R) -> - {B1,Env1} = visit(Env0, B0), - {R#c_catch{body=B1}, Env1}; -visit(Env0, #c_letrec{defs=Ds0,body=B0}=R) -> - {Xs, Env1} = bind_vars([V || {V,_} <- Ds0], Env0), - {Ds1,Env2} = visit_def_list(Env1, Ds0), - {B1,Env3} = visit(Env2, B0), - {R#c_letrec{defs=Ds1,body=B1}, restore_vars(Xs, Env0, Env3)}. -%% The following general code for handling modules is slow if a module -%% contains very many functions. There is special code in visit_module/1 -%% which is much faster. -%% visit(Env0, #c_module{defs=D0}=R) -> -%% {R1,Env1} = visit(Env0, #c_letrec{defs=D0,body=#c_nil{}}), -%% {R#c_module{defs=R1#c_letrec.defs}, Env1}; - -visit_list(Env, L) -> - lists:mapfoldl(fun (E, A) -> visit(A, E) end, Env, L). - -visit_def_list(Env, L) -> - lists:mapfoldl(fun ({Name,V0}, E0) -> - {V1,E1} = visit(E0, V0), - {{Name,V1}, E1} - end, Env, L). - -visit_bin_segs(Env, Segs) -> - lists:foldl(fun (#c_bitstr{val=Val,size=Sz}, E0) -> - {_, E1} = visit(E0, Val), - {_, E2} = visit(E1, Sz), - E2 - end, Env, Segs). - -bind_vars(Vs, Env) -> - bind_vars(Vs, Env, []). - -bind_vars([#c_var{name=X}|Vs], Env0, Xs)-> - bind_vars(Vs, Env0#{X=>0}, [X|Xs]); -bind_vars([], Env,Xs) -> - {Xs, Env}. - -visit_pats(Ps, Env) -> - visit_pats(Ps, Env, []). - -visit_pats([P|Ps], Env0, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, P, Vs0), - visit_pats(Ps, Env1, Vs1); -visit_pats([], Env, Vs) -> - {Vs, Env}. - -visit_pat(Env0, #c_var{name=V}, Vs) -> - {[V|Vs], Env0#{V=>0}}; -visit_pat(Env0, #c_tuple{es=Es}, Vs) -> - visit_pats(Es, Env0, Vs); -visit_pat(Env0, #c_map{es=Es}, Vs) -> - visit_pats(Es, Env0, Vs); -visit_pat(Env0, #c_map_pair{op=#c_literal{val=exact},key=V,val=K}, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, V, Vs0), - visit_pat(Env1, K, Vs1); -visit_pat(Env0, #c_cons{hd=H,tl=T}, Vs0) -> - {Vs1, Env1} = visit_pat(Env0, H, Vs0), - visit_pat(Env1, T, Vs1); -visit_pat(Env0, #c_binary{segments=Segs}, Vs) -> - visit_pats(Segs, Env0, Vs); -visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) -> - {Vs1, Env1} = - case Sz of - #c_var{name=V} -> - %% We don't tolerate free variables. - case Env0 of - #{V:=N} -> - {Vs0, Env0#{V:=N+1}} - end; - _ -> - visit_pat(Env0, Sz, Vs0) - end, - visit_pat(Env1, Val, Vs1); -visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) -> - visit_pat(Env0#{V=>0}, P, [V|Vs]); -visit_pat(Env, #c_literal{}, Vs) -> - {Vs, Env}. - -restore_vars([V|Vs], Env0, Env1) -> - case Env0 of - #{V:=N} -> - restore_vars(Vs, Env0, Env1#{V=>N}); - _ -> - restore_vars(Vs, Env0, maps:remove(V, Env1)) - end; -restore_vars([], _, Env1) -> - Env1. - - -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in call 'erlang':'setelement(3, X1, Value2) -%% => -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X1, Value2) -%% X1 - -rewrite(#c_let{vars=[#c_var{name=X}=V]=Vs, - arg=#c_call{module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index1}, _Tuple, _Val1] - }=A, - body=#c_call{anno=Banno,module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index2}, - #c_var{name=X}, - Val2] - } - }=R, - _BodyEnv, FinalEnv) - when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 -> - case is_safe(Val2) of - true -> - {R#c_let{vars=Vs, - arg=A, - body=#c_seq{arg=#c_primop{ - anno=Banno, - name=#c_literal{val='dsetelement'}, - args=[#c_literal{val=Index2}, - V, - Val2]}, - body=V} - }, - FinalEnv}; - false -> - {R, FinalEnv} - end; - -%% let X1 = call 'erlang':'setelement(5, Tuple, Value1) -%% in let X2 = 'erlang':'setelement(3, X1, Value2) -%% in ... -%% => -%% let X2 = call 'erlang':'setelement(5, Tuple, Value1) -%% in do primop dsetelement(3, X2, Value2) -%% ... -%% if X1 is used exactly once. - -rewrite(#c_let{vars=[#c_var{name=X1}], - arg=#c_call{module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index1}, _Tuple, _Val1] - }=A, - body=#c_let{vars=[#c_var{}=V]=Vs, - arg=#c_call{anno=Banno, - module=#c_literal{val='erlang'}, - name=#c_literal{val='setelement'}, - args=[#c_literal{val=Index2}, - #c_var{name=X1}, - Val2]}, - body=B} - }=R, - BodyEnv, FinalEnv) - when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 -> - case is_single_use(X1, BodyEnv) andalso is_safe(Val2) of - true -> - {R#c_let{vars=Vs, - arg=A, - body=#c_seq{arg=#c_primop{ - anno=Banno, - name=#c_literal{val='dsetelement'}, - args=[#c_literal{val=Index2}, - V, - Val2]}, - body=B} - }, - FinalEnv}; - false -> - {R, FinalEnv} - end; - -rewrite(R, _, FinalEnv) -> - {R, FinalEnv}. - -%% is_safe(CoreExpr) -> true|false -%% Determines whether the Core expression can cause a GC collection at run-time. -%% Note: Assumes that the constant pool is turned on. - -is_safe(#c_var{}) -> true; -is_safe(#c_literal{}) -> true; -is_safe(_) -> false. - -is_single_use(V, Env) -> - case Env of - #{V:=1} -> - true; - _ -> - false - end. diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 1681d97efb..4939a94a92 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -99,7 +99,7 @@ t=#{} :: map(), %Types in_guard=false}). %In guard or not. --type type_info() :: cerl:cerl() | 'bool' | 'integer'. +-type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}. -type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. -type sub() :: #sub{}. @@ -478,9 +478,20 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) false -> {Evs1,Sub2} = var_list(Evs0, Sub0), H1 = body(H0, value, Sub2), - Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1} + H2 = opt_try_handler(H1, lists:last(Evs1)), + Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H2} end. +%% Attempts to convert old erlang:get_stacktrace/0 calls into the new +%% three-argument catch, with possibility of further optimisations. +opt_try_handler(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=get_stacktrace},args=[]}, Var) -> + #c_primop{anno=A,name=#c_literal{val=build_stacktrace},args=[Var]}; +opt_try_handler(#c_case{clauses=Cs0} = Case, Var) -> + Cs = [C#c_clause{body=opt_try_handler(B, Var)} || #c_clause{body=B} = C <- Cs0], + Case#c_case{clauses=Cs}; +opt_try_handler(#c_let{arg=Arg} = Let, Var) -> + Let#c_let{arg=opt_try_handler(Arg, Var)}; +opt_try_handler(X, _) -> X. %% 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 @@ -561,6 +572,7 @@ ifes_list(FVar, [E|Es], Safe) -> ifes_list(_FVar, [], _Safe) -> true. + expr_list(Es, Ctxt, Sub) -> [expr(E, Ctxt, Sub) || E <- Es]. @@ -949,18 +961,16 @@ fold_lit_args(Call, Module, Name, Args0) -> %% fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) -> eval_is_boolean(Call, Arg, Sub); -fold_non_lit_args(Call, erlang, element, [Arg1,Arg2], Sub) -> - eval_element(Call, Arg1, Arg2, Sub); fold_non_lit_args(Call, erlang, length, [Arg], _) -> eval_length(Call, Arg); fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); -fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) -> - eval_setelement(Call, Arg1, Arg2, Arg3); -fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) -> - eval_is_record(Call, Arg1, Arg2, Arg3, Sub); +fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) -> + eval_is_function_1(Call, Arg1, Sub); +fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) -> + eval_is_function_2(Call, Arg1, Arg2, Sub); fold_non_lit_args(Call, erlang, N, Args, Sub) -> NumArgs = length(Args), case erl_internal:comp_op(N, NumArgs) of @@ -976,6 +986,22 @@ fold_non_lit_args(Call, erlang, N, Args, Sub) -> end; fold_non_lit_args(Call, _, _, _, _) -> Call. +eval_is_function_1(Call, Arg1, Sub) -> + case get_type(Arg1, Sub) of + none -> Call; + {'fun',_} -> #c_literal{anno=cerl:get_ann(Call),val=true}; + _ -> #c_literal{anno=cerl:get_ann(Call),val=false} + end. + +eval_is_function_2(Call, Arg1, #c_literal{val=Arity}, Sub) + when is_integer(Arity), Arity > 0 -> + case get_type(Arg1, Sub) of + none -> Call; + {'fun',Arity} -> #c_literal{anno=cerl:get_ann(Call),val=true}; + _ -> #c_literal{anno=cerl:get_ann(Call),val=false} + end; +eval_is_function_2(Call, _Arg1, _Arg2, _Sub) -> Call. + %% Evaluate a relational operation using type information. eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) -> Bool = erlang:Op(same, same), @@ -1109,96 +1135,6 @@ eval_append(Call, #c_cons{anno=Anno,hd=H,tl=T}, List) -> eval_append(Call, X, Y) -> Call#c_call{args=[X,Y]}. %Rebuild call arguments. -%% eval_element(Call, Pos, Tuple, Types) -> Val. -%% Evaluates element/2 if the position Pos is a literal and -%% the shape of the tuple Tuple is known. -%% -eval_element(Call, #c_literal{val=Pos}, Tuple, Types) - when is_integer(Pos) -> - case get_type(Tuple, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - if - 1 =< Pos, Pos =< length(Es) -> - El = lists:nth(Pos, Es), - try - cerl:set_ann(pat_to_expr(El), [compiler_generated]) - catch - throw:impossible -> - Call - end; - true -> - %% Index outside tuple or not a tuple. - eval_failure(Call, badarg) - end - end; -eval_element(Call, Pos, Tuple, Sub) -> - case is_int_type(Pos, Sub) =:= no orelse - is_tuple_type(Tuple, Sub) =:= no of - true -> - eval_failure(Call, badarg); - false -> - Call - end. - -%% eval_is_record(Call, Var, Tag, Size, Types) -> Val. -%% Evaluates is_record/3 using type information. -%% -eval_is_record(Call, Term, #c_literal{val=NeededTag}, - #c_literal{val=Size}, Types) -> - case get_type(Term, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - case Es of - [#c_literal{val=Tag}|_] -> - Bool = Tag =:= NeededTag andalso - length(Es) =:= Size, - #c_literal{val=Bool}; - _ -> - #c_literal{val=false} - end - end; -eval_is_record(Call, _, _, _, _) -> Call. - -%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. -%% Evaluates setelement/3 if position Pos is an integer -%% and the shape of the tuple Tuple is known. -%% -eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) - when is_integer(Pos) -> - case cerl:is_data(Tuple) of - false -> - Call; - true -> - Es0 = case cerl:is_c_tuple(Tuple) of - false -> []; - true -> cerl:tuple_es(Tuple) - end, - if - 1 =< Pos, Pos =< length(Es0) -> - Es = eval_setelement_1(Pos, Es0, NewVal), - cerl:update_c_tuple(Tuple, Es); - true -> - eval_failure(Call, badarg) - end - end; -eval_setelement(Call, _, _, _) -> Call. - -eval_setelement_1(1, [_|T], NewVal) -> - [NewVal|T]; -eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_1(Pos-1, T, NewVal)]. - %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with %% a call to erlang:error(Reason). @@ -1258,16 +1194,15 @@ clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) -> end. clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> - Sub2 = update_types(Cexpr, Ps1, Sub1), GSub = case {Cexpr,Ps1,G0} of {_,_,#c_literal{}} -> %% No need for substitution tricks when the guard %% does not contain any variables. - Sub2; + Sub1; {#c_var{name='_'},_,_} -> %% In a 'receive', Cexpr is the variable '_', which represents the %% message being matched. We must NOT do any extra substiutions. - Sub2; + Sub1; {#c_var{},[#c_var{}=Var],_} -> %% The idea here is to optimize expressions such as %% @@ -1289,16 +1224,16 @@ clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> %% case cerl:is_c_fname(Cexpr) of false -> - sub_set_var(Var, Cexpr, Sub2); + sub_set_var(Var, Cexpr, Sub1); true -> %% We must not copy funs, and especially not into guards. - Sub2 + Sub1 end; _ -> - Sub2 + Sub1 end, G1 = guard(G0, GSub), - B1 = body(B0, Ctxt, Sub2), + B1 = body(B0, Ctxt, Sub1), Cl#c_clause{pats=Ps1,guard=G1,body=B1}. %% let_substs(LetVars, LetArg, Sub) -> {[Var],[Val],Sub}. @@ -1382,8 +1317,7 @@ pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) -> {Pat#c_binary{segments=V1},Osub1}; pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) -> {V1,Osub1} = pattern(V0, Isub, Osub0), - {P1,Osub2} = pattern(P0, Isub, Osub1), - Osub = update_types(V1, [P1], Osub2), + {P1,Osub} = pattern(P0, Isub, Osub1), {Pat#c_alias{var=V1,pat=P1},Osub}. map_pair_pattern_list(Ps0, Isub, Osub0) -> @@ -2063,58 +1997,22 @@ case_opt_compiler_generated(Core) -> %% case_expand_var(Expr0, Sub) -> Expr -%% If Expr0 is a variable that has been previously matched and -%% is known to be a tuple, return the tuple instead. Otherwise +%% If Expr0 is a variable that is known to be bound to a +%% constructed tuple, return the tuple instead. Otherwise %% return Expr0 unchanged. -%% + case_expand_var(E, #sub{t=Tdb}) -> Key = cerl:var_name(E), case Tdb of - #{Key:=T0} -> - case cerl:is_c_tuple(T0) of - false -> - E; - true -> - %% The pattern was a tuple. Now we must make sure - %% that the elements of the tuple are suitable. In - %% particular, we don't want binary or map - %% construction here, since that means that the - %% binary or map will be constructed in the 'case' - %% argument. That is wasteful for binaries. Even - %% worse is that any map pattern that use the ':=' - %% operator will fail when used in map - %% construction (only the '=>' operator is allowed - %% when constructing a map from scratch). - try - cerl_trees:map(fun coerce_to_data/1, T0) - catch - throw:impossible -> - %% Something unsuitable was found (map or - %% or binary). Keep the variable. - E - end + #{Key:=T} -> + case cerl:is_c_tuple(T) of + false -> E; + true -> T end; _ -> E end. -%% coerce_to_data(Core) -> Core' -%% Coerce an element originally from a pattern to an data item or or -%% variable. Throw an 'impossible' exception if non-data Core Erlang -%% terms such as binary construction or map construction are -%% encountered. - -coerce_to_data(C) -> - case cerl:is_c_alias(C) of - false -> - case cerl:is_data(C) orelse cerl:is_c_var(C) of - true -> C; - false -> throw(impossible) - end; - true -> - coerce_to_data(cerl:alias_pat(C)) - end. - %% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' %% Remove all clauses that cannot possibly match. @@ -3108,14 +3006,6 @@ is_int_type(Var, Sub) -> C -> yes_no(cerl:is_c_int(C)) end. --spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_tuple_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> maybe; - C -> yes_no(cerl:is_c_tuple(C)) - end. - yes_no(true) -> yes; yes_no(false) -> no. @@ -3177,23 +3067,23 @@ returns_integer(_, _) -> false. %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. --spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). +-spec update_types(cerl:c_var(), [type_info()], sub()) -> sub(). -update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> - Tdb = update_types_1(Expr, Pat, Tdb0), +update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) -> + Tdb = update_types_1(V, Pat, Tdb0), Sub#sub{t=Tdb}. -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) -> +update_types_1(V, [#c_tuple{}=P], Types) -> Types#{V=>P}; -update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> +update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> Types#{V=>bool}; -update_types_2(V, [Type], Types) when is_atom(Type) -> +update_types_1(V, [#c_fun{vars=Vars}], Types) -> + Types#{V=>{'fun',length(Vars)}}; +update_types_1(V, [#c_var{name={_,Arity}}], Types) -> + Types#{V=>{'fun',Arity}}; +update_types_1(V, [Type], Types) when is_atom(Type) -> Types#{V=>Type}; -update_types_2(_, _, Types) -> Types. +update_types_1(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, @@ -3209,6 +3099,8 @@ kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) -> false -> [Entry|kill_types2(V, Tdb)]; true -> kill_types2(V, Tdb) end; +kill_types2(V, [{_, {'fun',_}}=Entry|Tdb]) -> + [Entry|kill_types2(V, Tdb)]; kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) -> [Entry|kill_types2(V, Tdb)]; kill_types2(_, []) -> []. diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl index 9867fab46a..e93b435011 100644 --- a/lib/compiler/src/sys_core_fold_lists.erl +++ b/lib/compiler/src/sys_core_fold_lists.erl @@ -37,22 +37,27 @@ call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + CC1 = #c_clause{anno=Anno, + pats=[#c_literal{val=true}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + CC2 = #c_clause{anno=Anno, + pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=#c_literal{val=false}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + CC3 = #c_clause{anno=Anno, + pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=true}}, Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -66,16 +71,21 @@ call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + CC1 = #c_clause{anno=Anno, + pats=[#c_literal{val=true}], guard=#c_literal{val=true}, body=#c_literal{val=true}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + CC2 = #c_clause{anno=Anno, + pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + CC3 = #c_clause{anno=Anno, + pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, @@ -94,16 +104,17 @@ call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) -> F = #c_var{name='F'}, Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=ok}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -117,7 +128,8 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_let{vars=[H], arg=#c_apply{anno=Anno, op=F, args=[X]}, @@ -126,7 +138,7 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> tl=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, @@ -146,7 +158,8 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_let{vars=[H], arg=#c_apply{anno=Anno, op=F, args=[X]}, body=#c_call{anno=[compiler_generated|Anno], @@ -156,13 +169,13 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> #c_apply{anno=Anno, op=Loop, args=[Xs]}]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -177,11 +190,13 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> X = #c_var{name='X'}, B = #c_var{name='B'}, Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + CC1 = #c_clause{anno=Anno, + pats=[#c_literal{val=true}], guard=#c_literal{val=true}, body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + CC2 = #c_clause{anno=Anno, + pats=[#c_literal{val=false}], guard=#c_literal{val=true}, body=Xs}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + CC3 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err1)}, Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]}, C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, @@ -192,13 +207,15 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> op=Loop, args=[Xs]}, body=Case}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=1}]}, body=#c_literal{val=[]}}, Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, + pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, Fun = #c_fun{vars=[Xs], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -212,19 +229,20 @@ call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=Loop, args=[Xs, #c_apply{anno=Anno, op=F, args=[X, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -238,19 +256,20 @@ call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) -> Xs = #c_var{name='Xs'}, X = #c_var{name='X'}, A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=#c_apply{anno=Anno, op=F, args=[X, #c_apply{anno=Anno, op=Loop, args=[Xs, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, body=A}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, A], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -266,13 +285,14 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> Avar = #c_var{name='A'}, Match = fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + C1 = #c_clause{anno=Anno, pats=[P], guard=#c_literal{val=true}, body=E}, Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + C2 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err)}, #c_case{arg=A, clauses=[C1, C2]} end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, + pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, #c_tuple{es=[X, Avar]}, %%% Tuple passing version @@ -292,7 +312,7 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> %%% body=#c_values{es=[#c_cons{hd=X, tl=Xs}, %%% A]}} )}, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, @@ -302,7 +322,7 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, @@ -326,13 +346,13 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> Avar = #c_var{name='A'}, Match = fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + C1 = #c_clause{anno=Anno, pats=[P], guard=#c_literal{val=true}, body=E}, Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + C2 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true}, body=match_fail(Anno, Err)}, #c_case{arg=A, clauses=[C1, C2]} end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + C1 = #c_clause{anno=Anno, pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, %%% Tuple passing version body=Match(#c_apply{anno=Anno, op=Loop, @@ -352,7 +372,8 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> %%% #c_values{es=[#c_cons{hd=X, tl=Xs}, %%% A]})} }, - C2 = #c_clause{pats=[#c_literal{val=[]}], + C2 = #c_clause{anno=Anno, + pats=[#c_literal{val=[]}], guard=#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[F, #c_literal{val=2}]}, @@ -362,7 +383,7 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> %%% Multiple-value version %%% body=#c_values{es=[#c_literal{val=[]}, A]}}, Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true}, body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, Fun = #c_fun{vars=[Xs, Avar], body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index 5a6cc45e4a..3380e3f1bd 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -195,6 +195,9 @@ kill_id_anns(Body) -> cerl_trees:map(fun(#c_fun{anno=A0}=CFun) -> A = kill_id_anns_1(A0), CFun#c_fun{anno=A}; + (#c_var{anno=A0}=Var) -> + A = kill_id_anns_1(A0), + Var#c_var{anno=A}; (Expr) -> %% Mark everything as compiler generated to %% suppress bogus warnings. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl deleted file mode 100644 index d7a7778740..0000000000 --- a/lib/compiler/src/v3_codegen.erl +++ /dev/null @@ -1,2791 +0,0 @@ -%% -%% %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 : Code generator for Beam. - --module(v3_codegen). - -%% The main interface. --export([module/2]). - --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,map/2]). --import(ordsets, [add_element/2,intersection/2,union/2]). - --include("v3_kernel.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 - bfail, %Fail label for BIFs - break, %Break label - recv, %Receive label - is_top_block, %Boolean: top block or not - 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. - ctx %Match context. - }). - -%% Stack/register state record. --record(sr, {reg=[], %Register table - stk=[], %Stack table - res=[]}). %Registers to reserve - -%% 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(#k_fdef{anno=#k{a=Anno},func=Name,arity=Arity, - vars=As,body=Kb}, AtomMod, St0) -> - try - #k_match{} = Kb, %Assertion. - - %% Annotate kernel records with variable usage. - Vdb0 = init_vars(As), - {Body,_,Vdb} = body(Kb, 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 -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - -%% 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) -> - {Fi,St1} = new_label(St0), %FuncInfo label - {Fl,St2} = local_func_label(NameArity, St1), - - %% - %% The pattern matching compiler (in v3_kernel) no longer - %% provides its own catch-all clause, because the - %% call to erlang:exit/1 caused problem when cases were - %% used in guards. Therefore, there may be tests that - %% cannot fail (providing that there is not a bug in a - %% previous optimzation pass), but still need to provide - %% a label (there are instructions, such as is_tuple/2, - %% that do not allow {f,0}). - %% - %% We will generate an ultimate failure label and put it - %% at the end of function, followed by an 'if_end' instruction. - %% 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 - %% 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 (#k_var{name=V}, Reg) -> - put_reg(V, Reg) - end, [], Hvs), - stk=[]}, 0, Vdb), - {B,_Aft,St} = cg_list(Les, Vdb, Bef, - St3#cg{bfail=0, - ultimate_failure=UltimateMatchFail, - is_top_block=true}), - {Name,Arity} = NameArity, - Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, - {label,Fl}|B++[{label,UltimateMatchFail},if_end]], - {Asm,Fl,St}. - -%% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. -%% Generate code for a kexpr. - -cg(#cg_block{anno=Le,es=Es}, Vdb, Bef, St) -> - block_cg(Es, 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(#k_guard_match{anno=Le,body=M,ret=Rs}, Vdb, Bef, St) -> - guard_match_cg(M, 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(#k_enter{anno=Le,op=Func,args=As}, Vdb, Bef, St) -> - enter_cg(Func, As, 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(#k_receive_next{anno=Le}, Vdb, Bef, St) -> - recv_next_cg(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(#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(#k_catch{anno=Le,body=Cb,ret=[R]}, Vdb, Bef, St) -> - catch_cg(Cb, R, 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, 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)), - {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) -> - {Kes,H} = need_heap_0(reverse(Kes0), 0, []), - - %% Prepend need_heap if necessary. - need_heap_need(H) ++ Kes. - -need_heap_0([Ke|Kes], H0, Acc) -> - {Ns,H} = need_heap_1(Ke, H0), - need_heap_0(Kes, H, [Ke|Ns]++Acc); -need_heap_0([], H, Acc) -> - {Acc,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 - #k_cons{} -> 2; - #k_tuple{es=Es} -> 1 + length(Es); - _Other -> 0 - end}; -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 -%% their registers as they might actually be in the right place. - -match_cg(M, Rs, Le, Vdb, Bef, St0) -> - I = Le#l.i, - {Sis,Int0} = adjust_stack(Bef, I, I+1, Vdb), - {B,St1} = new_label(St0), - {Mis,Int1,St2} = match_cg(M, St1#cg.ultimate_failure, - Int0, St1#cg{break=B}), - %% Put return values in registers. - Reg = load_vars(Rs, Int1#sr.reg), - {Sis ++ Mis ++ [{label,B}], - clear_dead(Int1#sr{reg=Reg}, I, Vdb), - St2#cg{break=St1#cg.break}}. - -guard_match_cg(M, Rs, Le, Vdb, Bef, St0) -> - I = Le#l.i, - {B,St1} = new_label(St0), - 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), - {Mis ++ [{label,B}], - clear_dead(Aft#sr{reg=Reg}, I, Vdb), - St2#cg{break=St1#cg.break}}. - -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)]; -guard_match_regs([], []) -> []. - - -%% match_cg(Match, Fail, StackReg, State) -> {[Ainstr],StackReg,State}. -%% Generate code for a match tree. N.B. there is no need pass Vdb -%% down as each level which uses this takes its own internal Vdb not -%% the outer one. - -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(#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; - true -> bsm_rename_ctx(Scs0, Vname) - end, - match_fmf(fun (S, F, Sta) -> - select_cg(S, V, F, Fail, Bef, Sta) end, - Fail, St, Scs); -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(#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). - -%% 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 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 -%% context) to the variable for the binary (which can have a very -%% long life-time because it is locked during matching). We KNOW that -%% the match state variable will only be alive during the matching. -%% -%% We must also remove all information about the match context -%% variable from all life-time information databases (Vdb). - -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), - 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([], _) -> []. - -%% bsm_rename_ctx(Ke, OldName, NewName, InProt) -> Ke' -%% Rename and clear OldName from life-time information. We must -%% recurse into any block contained in a protected, but it would -%% only complicatate things to recurse into blocks not in a protected -%% (the match context variable is not live inside them). - -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), - 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), - 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), - 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), - 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), - 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. - %% Since the match state variable Old is an alias for New (uses the - %% 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(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(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), - 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(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. - 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(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}. - -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.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, Vdb, Bef, St0) -> - {Kes2,Int1,St1} = - case basic_block(Kes0) of - {Kes1,LastI,Args,Rest} -> - cg_basic_block(Kes1, LastI, Args, Vdb, Bef, St0); - {Kes1,Rest} -> - cg_list(Kes1, Vdb, Bef, St0) - end, - {Kes3,Int2,St2} = cg_block(Rest, Vdb, Int1, St1), - {Kes2 ++ Kes3,Int2,St2}. - -basic_block(Kes) -> basic_block(Kes, []). - -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 #k_put{} instructions, - %% it serves no useful purpose to do basic block optimizations. - {[Ke],Kes}; - _ -> - #l{i=I} = get_kanno(Ke), - {reverse(Acc, [Ke]),I,As,Kes} - end; - no_block -> {reverse(Acc, [Ke]),Kes} - end. - -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, Arguments, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% -%% 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, - {Int,St0}, need_heap(Kes)), - {Keis,Aft,St1}. - -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_1(Rs, Regs, Stk)]; - false -> [{I,Var}|reserve_1(Rs, Regs, Stk)] - end; -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, Regs), - Move = {move,SrcReg,fetch_stack(V, Stk1)}, - {x,_} = SrcReg, %Assertion - must be X register. - save_carefully_1(Vs, Bef#sr{stk=Stk1}, [Move|Acc]) - end; -save_carefully_1([], Bef, Acc) -> - {reverse(Acc),Bef}. - -%% 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; -top_level_block(Keis, Bef, MaxRegs, _St) -> - %% This top block needs an allocate instruction before it, and a - %% deallocate instruction before each return. - FrameSz = length(Bef#sr.stk), - MaxY = FrameSz-1, - Keis1 = flatmap(fun ({call_only,Arity,Func}) -> - [{call_last,Arity,Func,FrameSz}]; - ({call_ext_only,Arity,Func}) -> - [{call_ext_last,Arity,Func,FrameSz}]; - ({apply_only,Arity}) -> - [{apply_last,Arity,FrameSz}]; - (return) -> - [{deallocate,FrameSz},return]; - (Tuple) when is_tuple(Tuple) -> - [turn_yregs(Tuple, MaxY)]; - (Other) -> - [Other] - end, Keis), - [{allocate_zero,FrameSz,MaxRegs}|Keis1]. - -%% turn_yregs(Size, Tuple, MaxY) -> Tuple' -%% Renumber y register so that {y,0} becomes {y,FrameSize-1}, -%% {y,FrameSize-1} becomes {y,0} and so on. This is to make nested -%% catches work. The code generation algorithm gives a lower register -%% number to the outer catch, which is wrong. - -turn_yregs({call,_,_}=I, _MaxY) -> I; -turn_yregs({call_ext,_,_}=I, _MaxY) -> I; -turn_yregs({jump,_}=I, _MaxY) -> I; -turn_yregs({label,_}=I, _MaxY) -> I; -turn_yregs({line,_}=I, _MaxY) -> I; -turn_yregs({test_heap,_,_}=I, _MaxY) -> I; -turn_yregs({bif,Op,F,A,B}, MaxY) -> - {bif,Op,F,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({gc_bif,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> - {gc_bif,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({get_tuple_element,S,N,D}, MaxY) -> - {get_tuple_element,turn_yreg(S, MaxY),N,turn_yreg(D, MaxY)}; -turn_yregs({put_tuple,Arity,D}, MaxY) -> - {put_tuple,Arity,turn_yreg(D, MaxY)}; -turn_yregs({select_val,R,F,L}, MaxY) -> - {select_val,turn_yreg(R, MaxY),F,L}; -turn_yregs({test,Op,F,L}, MaxY) -> - {test,Op,F,turn_yreg(L, MaxY)}; -turn_yregs({test,Op,F,Live,A,B}, MaxY) when is_integer(Live) -> - {test,Op,F,Live,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({Op,A}, MaxY) -> - {Op,turn_yreg(A, MaxY)}; -turn_yregs({Op,A,B}, MaxY) -> - {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY)}; -turn_yregs({Op,A,B,C}, MaxY) -> - {Op,turn_yreg(A, MaxY),turn_yreg(B, MaxY),turn_yreg(C, MaxY)}; -turn_yregs(Tuple, MaxY) -> - turn_yregs(tuple_size(Tuple), Tuple, MaxY). - -turn_yregs(1, Tp, _) -> - Tp; -turn_yregs(N, Tp, MaxY) -> - E = turn_yreg(element(N, Tp), MaxY), - turn_yregs(N-1, setelement(N, Tp, E), MaxY). - -turn_yreg({yy,YY}, MaxY) -> - {y,MaxY-YY}; -turn_yreg({list,Ls},MaxY) -> - {list,turn_yreg(Ls, MaxY)}; -turn_yreg([_|_]=Ts, MaxY) -> - [turn_yreg(T, MaxY) || T <- Ts]; -turn_yreg(Other, _MaxY) -> - Other. - -%% select_cg(Sclause, V, TypeFail, ValueFail, StackReg, State) -> -%% {Is,StackReg,State}. -%% Selecting type and value needs two failure labels, TypeFail is the -%% label to jump to of the next type test when this type fails, and -%% ValueFail is the label when this type is correct but the value is -%% wrong. These are different as in the second case there is no need -%% to try the next type, it will always fail. - -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(k_nil, [S], V, Tf, Vf, Bef, St) -> - select_nil(S, 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(k_bin_seg, S, V, Tf, _Vf, Bef, St) -> - select_bin_segs(S, V, Tf, Bef, St); -select_cg(k_bin_int, S, V, Tf, _Vf, Bef, St) -> - select_bin_segs(S, V, Tf, Bef, St); -select_cg(k_bin_end, [S], V, Tf, _Vf, Bef, St) -> - select_bin_end(S, V, Tf, Bef, St); -select_cg(k_map, S, V, Tf, Vf, Bef, St) -> - select_map(S, V, Tf, Vf, Bef, St); -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), - {{Is,[Val]},{sr_merge(Int, Inta),Stb}} - end, {void,St0}, Scs), - OptVls = combine(lists:sort(combine(Vis))), - {Vls,Sis,St2} = select_labels(OptVls, St1, [], []), - {select_val_cg(Type, fetch_var(V, Bef), Vls, Tf, Vf, Sis), Aft, St2}. - -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(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(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(Type),Val}]}|Sis]; -select_val_cg(Type, R, Vls0, Tf, Vf, Sis) -> - 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]. - -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)]; -combine([]) -> []. - -select_labels([{Is,Vs}|Vis], St0, Vls, Sis) -> - {Lbl,St1} = new_label(St0), - select_labels(Vis, St1, add_vls(Vs, Lbl, Vls), [[{label,Lbl}|Is]|Sis]); -select_labels([], St, Vls, Sis) -> - {Vls,append(Sis),St}. - -add_vls([V|Vs], Lbl, Acc) -> - add_vls(Vs, Lbl, [V, {f,Lbl}|Acc]); -add_vls([], _, Acc) -> Acc. - -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(#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(#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#cg{ctx=V}), - CtxReg = fetch_var(V, Int0), - Live = max_reg(Bef#sr.reg), - 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#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#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),{context,Ivar}],CtxReg}, - {bs_save2,CtxReg,{Ivar,Ivar}}|Bis0], - Bis = finish_select_binary(Bis1), - {Bis,Aft,St1#cg{ctx=OldCtx}}. - -finish_select_binary([{bs_save2,R,Point}=I,{bs_restore2,R,Point}|Is]) -> - [I|finish_select_binary(Is)]; -finish_select_binary([{bs_save2,R,Point}=I,{test,is_eq_exact,_,_}=Test, - {bs_restore2,R,Point}|Is]) -> - [I,Test|finish_select_binary(Is)]; -finish_select_binary([{test,bs_match_string,F,[Ctx,BinList]}|Is]) - when is_list(BinList) -> - I = {test,bs_match_string,F,[Ctx,list_to_bitstring(BinList)]}, - [I|finish_select_binary(Is)]; -finish_select_binary([I|Is]) -> - [I|finish_select_binary(Is)]; -finish_select_binary([]) -> []. - -%% New instructions for selection of binary segments. - -select_bin_segs(Scs, Ivar, Tf, Bef, St) -> - match_fmf(fun(S, Fail, Sta) -> - select_bin_seg(S, Ivar, Fail, Bef, Sta) end, - Tf, St, Scs). - -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), - CtxReg = fetch_var(Ctx, Bef), - Is = if - Mis =:= [] -> - %% No bs_restore2 instruction needed if no match instructions. - Bis; - true -> - [{bs_restore2,CtxReg,{Ctx,Ivar}}|Mis++Bis] - end, - {Is,Aft,St2}; -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), - Is = case Mis ++ Bis of - [{test,bs_match_string,F,[OtherCtx,Bin1]}, - {bs_save2,OtherCtx,_}, - {bs_restore2,OtherCtx,_}, - {test,bs_match_string,F,[OtherCtx,Bin2]}|Is0] -> - %% We used to do this optimization later, but it - %% turns out that in huge functions with many - %% bs_match_string instructions, it's a big win - %% to do the combination now. To avoid copying the - %% binary data again and again, we'll combine bitstrings - %% in a list and convert all of it to a bitstring later. - [{test,bs_match_string,F,[OtherCtx,[Bin1,Bin2]]}|Is0]; - Is0 -> - Is0 - end, - {[{bs_restore2,CtxReg,{Ctx,Ivar}}|Is],Aft,St2}. - -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 - true -> - <<Val:Bits>>; - false -> - true = member(little, Fs), %Assertion. - <<Val:Bits/little>> - end, - Bits = bit_size(Bin), %Assertion. - CtxReg = fetch_var(Ctx, Bef), - Is = if - Bits =:= 0 -> - [{bs_save2,CtxReg,{Ctx,Tl}}]; - true -> - [{test,bs_match_string,{f,Vf},[CtxReg,Bin]}, - {bs_save2,CtxReg,{Ctx,Tl}}] - end, - {Is,clear_dead(Bef, I, Vdb),St}. - -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} = - case vdb_find(Hd, Vdb) of - {_,_,Lhd} when Lhd =< I -> - %% The extracted value will not be used. - CtxReg = fetch_var(Ctx, Bef), - Live = max_reg(Bef#sr.reg), - Skip = build_skip_instr(Type, Vf, CtxReg, Live, - SizeReg, Unit, Flags), - {[Skip,{bs_save2,CtxReg,{Ctx,Tl}}],Bef}; - {_,_,_} -> - Reg = put_reg(Hd, Bef#sr.reg), - Int1 = Bef#sr{reg=Reg}, - Rhd = fetch_reg(Hd, Reg), - CtxReg = fetch_reg(Ctx, Reg), - Live = max_reg(Bef#sr.reg), - {[build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, - Unit, Flags, Rhd), - {bs_save2,CtxReg,{Ctx,Tl}}],Int1} - end, - {Es,clear_dead(Aft, I, Vdb),St}; -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'. - #k_atom{val=all} = Size, %Assertion. - {Es,Aft} = - case vdb_find(Hd, Vdb) of - {_,_,Lhd} when Lhd =< I -> - %% The result will not be used. Furthermore, since we - %% we are at the end of the binary, the position will - %% not be used again; thus, it is safe to do a cheaper - %% test of the unit. - CtxReg = fetch_var(Ctx, Bef), - {case Unit of - 1 -> - []; - _ -> - [{test,bs_test_unit,{f,Vf},[CtxReg,Unit]}] - end,Bef}; - {_,_,_} -> - case is_context_unused(Body) of - false -> - Reg = put_reg(Hd, Bef#sr.reg), - Int1 = Bef#sr{reg=Reg}, - Rhd = fetch_reg(Hd, Reg), - CtxReg = fetch_reg(Ctx, Reg), - Name = bs_get_binary2, - Live = max_reg(Bef#sr.reg), - {[{test,Name,{f,Vf},Live, - [CtxReg,atomic(Size),Unit,{field_flags,Flags}],Rhd}], - Int1}; - true -> - %% Since the matching context will not be used again, - %% we can reuse its register. Reusing the register - %% opens some interesting optimizations in the - %% run-time system. - - Reg0 = Bef#sr.reg, - CtxReg = fetch_reg(Ctx, Reg0), - Reg = replace_reg_contents(Ctx, Hd, Reg0), - Int1 = Bef#sr{reg=Reg}, - Name = bs_get_binary2, - Live = max_reg(Int1#sr.reg), - {[{test,Name,{f,Vf},Live, - [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 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(#k_var{name=V}, Bef) -> - fetch_var(V, Bef); -get_bin_size_reg(Literal, _Bef) -> - atomic(Literal). - -build_bs_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags, Rhd) -> - {Format,Name} = case Type of - integer -> {plain,bs_get_integer2}; - float -> {plain,bs_get_float2}; - binary -> {plain,bs_get_binary2}; - utf8 -> {utf,bs_get_utf8}; - utf16 -> {utf,bs_get_utf16}; - utf32 -> {utf,bs_get_utf32} - end, - case Format of - plain -> - {test,Name,{f,Vf},Live, - [CtxReg,SizeReg,Unit,{field_flags,Flags}],Rhd}; - utf -> - {test,Name,{f,Vf},Live, - [CtxReg,{field_flags,Flags}],Rhd} - end. - -build_skip_instr(Type, Vf, CtxReg, Live, SizeReg, Unit, Flags) -> - {Format,Name} = case Type of - utf8 -> {utf,bs_skip_utf8}; - utf16 -> {utf,bs_skip_utf16}; - utf32 -> {utf,bs_skip_utf32}; - _ -> {plain,bs_skip_bits2} - end, - case Format of - plain -> - {test,Name,{f,Vf},[CtxReg,SizeReg,Unit,{field_flags,Flags}]}; - utf -> - {test,Name,{f,Vf},[CtxReg,Live,{field_flags,Flags}]} - end. - -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(#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}. - -%% select_extract_tuple(Src, [V], I, Vdb, StackReg, State) -> -%% {[E],StackReg,State}. -%% Extract tuple elements, but only if they do not immediately die. - -select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> - F = fun (#k_var{name=V}, {Int0,Elem}) -> - case vdb_find(V, Vdb) of - {V,_,L} when L =< I -> {[], {Int0,Elem+1}}; - _Other -> - Reg1 = put_reg(V, Int0#sr.reg), - Int1 = Int0#sr{reg=Reg1}, - Rsrc = fetch_var(Src, Int1), - {[{get_tuple_element,Rsrc,Elem,fetch_reg(V, Reg1)}], - {Int1,Elem+1}} - end - end, - {Es,{Aft,_}} = flatmapfoldl(F, {Bef,0}, Vs), - {Es,Aft,St}. - -select_map(Scs, V, Tf, Vf, Bef, St0) -> - Reg = fetch_var(V, Bef), - {Is,Aft,St1} = - 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) -> - {Eis,Int,St1} = select_extract_map(V, Es, Fail, I, Vdb, Bef, St0), - {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), - {Eis++Bis,Aft,St2}. - -select_extract_map(_, [], _, _, _, Bef, St) -> {[],Bef,St}; -select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> - %% First split the instruction flow - %% We want one set of each - %% 1) has_map_fields (no target registers) - %% 2) get_map_elements (with target registers) - %% Assume keys are term-sorted - Rsrc = fetch_var(Src, Bef), - - {{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] ++ - [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++ - [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs], - {Code, 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(#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}. - -%% guard_cg(Guard, Fail, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% A guard is a boolean expression of tests. Tests return true or -%% false. A fault in a test causes the test to return false. Tests -%% never return the boolean, instead we generate jump code to go to -%% the correct exit point. Primops and tests all go to the next -%% instruction on success or jump to a failure label. - -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 -%% the next instruction and failure jumps to Fail. If there are -%% return values then these must be set to 'false' on failure, -%% control always passes to the next instruction. - -protected_cg(Ts, [], Fail, Vdb, Bef, St0) -> - %% Protect these calls, revert when done. - {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, Vdb, Bef, St0) -> - {Pfail,St1} = new_label(St0), - {Psucc,St2} = new_label(St1), - {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)}||#k_var{name=V} <- Rs], - {Tis ++ [{jump,{f,Psucc}}, - {label,Pfail}] ++ Mis ++ [{label,Psucc}], - Aft,St3#cg{bfail=St0#cg.bfail}}. - -%% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Generate test instruction. Use explicit fail label here. - -test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> - %% We must avoid creating code like this: - %% - %% move x(0) y(0) - %% is_map Fail [x(0)] - %% make_fun => x(0) %% Overwrite x(0) - %% put_map_assoc y(0) ... - %% - %% The code is safe, but beam_validator does not understand that. - %% Extending beam_validator to handle such (rare) code as the - %% above would make it slower for all programs. Instead, change - %% the code generator to always prefer the Y register for is_map() - %% and put_map_assoc() instructions, ensuring that they use the - %% same register. - 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}. - -%% 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 -%% an externally generated failure label, LastFail. N.B. We do not -%% know or care how the failure labels are used. - -match_fmf(F, LastFail, St, [H]) -> - F(H, LastFail, St); -match_fmf(F, LastFail, St0, [H|T]) -> - {Fail,St1} = new_label(St0), - {R,Aft1,St2} = F(H, Fail, St1), - {Rs,Aft2,St3} = match_fmf(F, LastFail, St2, T), - {R ++ [{label,Fail}] ++ Rs,sr_merge(Aft1, Aft2),St3}. - -%% call_cg(Func, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% enter_cg(Func, [Arg], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% Call and enter first put the arguments into registers and save any -%% other registers, then clean up and compress the stack and set the -%% frame size. Finally the actual call is made. Call then needs the -%% return values filled in. - -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)), - %% Build complete code and final stack/register state. - Arity = length(As), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft, - need_stack_frame(St0)}; -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)), - %% Build complete code and final stack/register state. - Arity = length(As), - St = need_stack_frame(St0), - %%{Call,St1} = build_call(Func, Arity, St0), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [line(Le),{apply,Arity}],Aft,St}; -call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> - case St0 of - #cg{bfail=Fail} when Fail =/= 0 -> - %% Inside a guard. The only allowed function call is to - %% erlang:error/1,2. We will generate the following code: - %% - %% move {atom,ok} DestReg - %% jump FailureLabel - #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}, - Dst = fetch_reg(DestVar, Reg), - {[{move,{atom,ok},Dst},{jump,{f,Fail}}], - clear_dead(Int, Le#l.i, Vdb),St0}; - #cg{} -> - %% Ordinary function call in a function body. - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - %% Put return values in registers. - Reg = load_vars(Rs, clear_regs(Int#sr.reg)), - %% Build complete code and final stack/register state. - Arity = length(As), - {Call,St1} = build_call(Func, Arity, St0), - {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [line(Le)|Call],Aft,St1} - end. - -build_call(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> - {[send],need_stack_frame(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(#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}. - -free_dead(#sr{stk=Stk0}=Aft) -> - {Instr,Stk} = free_dead(Stk0, 0, [], []), - {Instr,Aft#sr{stk=Stk}}. - -free_dead([dead|Stk], Y, Instr, StkAcc) -> - %% Note: kill/1 is equivalent to init/1 (translated by beam_asm). - %% We use kill/1 to help further optimisation passes. - free_dead(Stk, Y+1, [{kill,{yy,Y}}|Instr], [free|StkAcc]); -free_dead([Any|Stk], Y, Instr, StkAcc) -> - free_dead(Stk, Y+1, Instr, [Any|StkAcc]); -free_dead([], _, Instr, StkAcc) -> {Instr,reverse(StkAcc)}. - -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(#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), - St = need_stack_frame(St0), - {Sis ++ [line(Le),{apply_only,Arity}], - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - St}; -enter_cg(Func, As, Le, Vdb, Bef, St0) -> - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - %% Build complete code and final stack/register state. - Arity = length(As), - {Call,St1} = build_enter(Func, Arity, St0), - Line = enter_line(Func, Arity, Le), - {Sis ++ Line ++ Call, - clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), - St1}. - -build_enter(#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val='!'}}, 2, St0) -> - {[send,return],need_stack_frame(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(#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(#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. - %% We'll need a line instruction in case the - %% BIF call fails. - [line(Le)]; - true -> - %% Call to a safe BIF. Since it cannot fail, - %% we don't need any line instruction here. - [] - end; -enter_line(_, _, _) -> - %% Tail-recursive call to a local function. A line - %% instruction will not be useful. - []. - -%% local_func_label(Name, Arity, State) -> {Label,State'} -%% local_func_label({Name,Arity}, State) -> {Label,State'} -%% Get the function entry label for a local function. - -local_func_label(Name, Arity, St) -> - local_func_label({Name,Arity}, St). - -local_func_label(Key, #cg{functable=Map}=St0) -> - case Map of - #{Key := Label} -> {Label,St0}; - _ -> - {Label,St} = new_label(St0), - {Label,St#cg{functable=Map#{Key => Label}}} - end. - -%% need_stack_frame(State) -> State' -%% Make a note in the state that this function will need a stack frame. - -need_stack_frame(#cg{need_frame=true}=St) -> St; -need_stack_frame(St) -> St#cg{need_frame=true}. - -%% trap_bif(Mod, Name, Arity) -> true|false -%% Trap bifs that need a stack frame. - -trap_bif(erlang, link, 1) -> true; -trap_bif(erlang, unlink, 1) -> true; -trap_bif(erlang, monitor_node, 2) -> true; -trap_bif(erlang, group_leader, 2) -> true; -trap_bif(erlang, exit, 2) -> true; -trap_bif(_, _, _) -> false. - -%% bif_cg(#k_bif{}, Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% 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 -> - bif_cg(Name, As, Rs, Le, Vdb, Bef, St); - true -> - 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}; -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},0,0,length(As)}, - {Sis ++ [MakeFun], - clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb), - St1}; -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}; -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 - %% BIF may fail, we must save everything that will be alive after - %% the catch (because the code after the code assumes that all - %% variables that are live are stored on the stack). - %% - %% Currently, we are somewhat pessimistic in - %% that we save any variable that will be live after this BIF call. - - MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), - {Sis,Int0} = - case MayFail of - true -> - maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0); - false -> - {[],Bef} - end, - Int1 = clear_dead(Int0, Le#l.i, Vdb), - Reg = put_reg(V, Int1#sr.reg), - Int = Int1#sr{reg=Reg}, - Dst = fetch_reg(V, Reg), - BifFail = {f,St0#cg.bfail}, - %% We need a line instructions for BIFs that may fail in a body. - Line = case BifFail of - {f,0} when MayFail -> - [line(Le)]; - _ -> - [] - end, - {Sis++Line++[{bif,Bif,BifFail,Ars,Dst}], - clear_dead(Int, Le#l.i, Vdb), St0}. - - -%% gc_bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. - -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 - %% BIF may fail, we must save everything that will be alive after - %% the catch (because the code after the code assumes that all - %% variables that are live are stored on the stack). - %% - %% Currently, we are somewhat pessimistic in - %% that we save any variable that will be live after this BIF call. - - {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), - - Int1 = clear_dead(Int0, Le#l.i, Vdb), - Reg = put_reg(V, Int1#sr.reg), - Int = Int1#sr{reg=Reg}, - Dst = fetch_reg(V, Reg), - BifFail = {f,St0#cg.bfail}, - Line = case BifFail of - {f,0} -> [line(Le)]; - {f,_} -> [] - end, - {Sis++Line++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], - clear_dead(Int, Le#l.i, Vdb), St0}. - -%% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, -%% [Ret], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. - -recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> - {Sis,Int0} = adjust_stack(Bef, Le#l.i, Le#l.i, Vdb), - Int1 = Int0#sr{reg=clear_regs(Int0#sr.reg)}, - %% Get labels. - {Rl,St1} = new_label(St0), - {Tl,St2} = new_label(St1), - {Bl,St3} = new_label(St2), - St4 = St3#cg{break=Bl,recv=Rl}, %Set correct receive labels - {Ris,Raft,St5} = cg_recv_mesg(Rvar, Rm, Tl, Int1, St4), - {Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5), - Int2 = sr_merge(Raft, Taft), %Merge stack/registers - Reg = load_vars(Rs, Int2#sr.reg), - {Sis ++ [line(Le)] ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], - clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb), - St6#cg{break=St0#cg.break,recv=St0#cg.recv}}. - -%% cg_recv_mesg( ) -> {[Ainstr],Aft,St}. - -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), - Int1 = Int0, - {Mis,Int2,St1} = match_cg(Rm, none, Int1, St0), - {[{label,St1#cg.recv},{loop_rec,{f,Tl},Ret}|Mis],Int2,St1}. - -%% cg_recv_wait(Te, Tes, I, Vdb, Int2, St3) -> {[Ainstr],Aft,St}. - -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, 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(#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, #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, 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}. - -%% recv_next_cg(Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. -%% Use adjust stack to clear stack, but only need it for Aft. - -recv_next_cg(Le, Vdb, Bef, St) -> - {Sis,Aft} = adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb), - {[{loop_rec_end,{f,St#cg.recv}}] ++ Sis,Aft,St}. %Joke - -%% try_cg(TryBlock, [BodyVar], TryBody, [ExcpVar], TryHandler, [Ret], -%% Le, Vdb, StackReg, St) -> {[Ainstr],StackReg,St}. - -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 - #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}), - Int3 = Int2#sr{stk=drop_catch(TryTag, Int2#sr.stk)}, - St5 = St4#cg{break=E,in_catch=St3#cg.in_catch}, - {Bis,Baft,St6} = cg(Tb, Vdb, Int3#sr{reg=load_vars(Vs, Int3#sr.reg)}, St5), - {His,Haft,St7} = cg(Th, Vdb, Int3#sr{reg=load_vars(Evs, Int3#sr.reg)}, St6), - Int4 = sr_merge(Baft, Haft), %Merge stack/registers - Aft = Int4#sr{reg=load_vars(Rs, Int4#sr.reg)}, - {[{'try',TryReg,{f,H}}] ++ Ais ++ - [{label,B},{try_end,TryReg}] ++ Bis ++ - [{label,H},{try_case,TryReg}] ++ His ++ - [{label,E}], - clear_dead(Aft, Le#l.i, Vdb), - St7#cg{break=St0#cg.break}}. - -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 - #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}), - Int3 = Int2#sr{stk=drop_catch(TryTag, Int2#sr.stk)}, - St4 = St3#cg{in_catch=St2#cg.in_catch}, - {Bis,Baft,St5} = cg(Tb, Vdb, Int3#sr{reg=load_vars(Vs, Int3#sr.reg)}, St4), - {His,Haft,St6} = cg(Th, Vdb, Int3#sr{reg=load_vars(Evs, Int3#sr.reg)}, St5), - Int4 = sr_merge(Baft, Haft), %Merge stack/registers - Aft = Int4, - {[{'try',TryReg,{f,H}}] ++ Ais ++ - [{label,B},{try_end,TryReg}] ++ Bis ++ - [{label,H},{try_case,TryReg}] ++ His, - clear_dead(Aft, Le#l.i, Vdb), - St6#cg{break=St0#cg.break}}. - -%% catch_cg(CatchBlock, Ret, Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. - -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.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)}, - {[{'catch',CatchReg,{f,B}}] ++ Cis ++ - [{label,B},{catch_end,CatchReg}], - clear_dead(Aft, Le#l.i, Vdb), - St2#cg{break=St1#cg.break,in_catch=St1#cg.in_catch}}. - -%% 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. -%% -%% put_list and put_map are atomic instructions, both of -%% which can safely resuse one of the source registers as target. - -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}; -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. - %% 3) Then each field in the binary is constructed. - %% For simplicity, we use the target register to also hold the - %% size of the binary. Therefore the target register must *not* - %% be one of the source registers. - - %% First allocate the target register. - Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, - Target = fetch_reg(R, Int0#sr.reg), - - %% Also allocate a scratch register for size calculations. - Temp = find_scratch_reg(Int0#sr.reg), - - %% First generate the code that constructs each field. - Fail = {f,Bfail}, - PutCode = cg_bin_put(Segs, Fail, Bef), - {Sis,Int1} = maybe_adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb, St), - MaxRegs = max_reg(Bef#sr.reg), - Aft = clear_dead(Int1, Le#l.i, Vdb), - - %% Now generate the complete code for constructing the binary. - Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), - {Sis++Code,Aft,St}; - -%% Map: single variable key. -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), - Line = line(Le#l.a), - - List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], - - Live = max_reg(Bef#sr.reg), - - %% The target register can reuse one of the source registers. - Aft0 = clear_dead(Int0, Le#l.i, Vdb), - Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, - Target = fetch_reg(R, Aft#sr.reg), - - {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), - {Sis++Is,Aft,St1}; - -%% Map: (possibly) multiple literal keys. -put_cg([#k_var{name=R}], #k_map{op=Op,var=Map,es=Es}, Le, Vdb, Bef, St0) -> - - %% assert key literals - [] = [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 - 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), - - %% The target register can reuse one of the source registers. - Aft0 = clear_dead(Int0, Le#l.i, Vdb), - Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, - Target = fetch_reg(R, Aft#sr.reg), - - {Is,St1} = put_cg_map(Line, Op, SrcReg, Target, Live, List, St0), - {Sis++Is,Aft,St1}; - -%% Everything else. -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 - #k_tuple{es=Es} -> - [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); - Other -> - [{move,cg_reg_arg(Other, Int),Ret}] - end, - {Ais,clear_dead(Int, Le#l.i, Vdb),St}. - - -put_cg_map(Line, Op0, SrcReg, Target, Live, List, St0) -> - Bfail = St0#cg.bfail, - Fail = {f,St0#cg.bfail}, - Op = case Op0 of - assoc -> put_map_assoc; - exact -> put_map_exact - end, - {OkLbl,St1} = new_label(St0), - {BadLbl,St2} = new_label(St1), - Is = if - Bfail =:= 0 orelse Op =:= put_map_assoc -> - [Line,{Op,{f,0},SrcReg,Target,Live,{list,List}}]; - true -> - %% Ensure that Target is always set, even if - %% the map update operation fails. That is necessary - %% because Target may be included in a test_heap - %% instruction. - [Line, - {Op,{f,BadLbl},SrcReg,Target,Live,{list,List}}, - {jump,{f,OkLbl}}, - {label,BadLbl}, - {move,{atom,ok},Target}, - {jump,Fail}, - {label,OkLbl}] - end, - {Is,St2}. - -%%% -%%% Code generation for constructing binaries. -%%% - -cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], - Target, Temp, Fail, MaxRegs, Anno) -> - Line = line(Anno), - Live = cg_live(Target, MaxRegs), - SzCode = cg_bitstr_size(PutCode, Target, Temp, Fail, Live), - BinFlags = {field_flags,[]}, - Code = [Line|SzCode] ++ - [case member(single_use, Anno) of - true -> - {bs_private_append,Fail,Target,U,Src,BinFlags,Target}; - false -> - {bs_append,Fail,Target,0,MaxRegs,U,Src,BinFlags,Target} - end] ++ PutCode, - cg_bin_opt(Code); -cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Anno) -> - Line = line(Anno), - Live = cg_live(Target, MaxRegs), - {InitOp,SzCode} = cg_binary_size(PutCode, Target, Temp, Fail, Live), - - Code = [Line|SzCode] ++ [{InitOp,Fail,Target,0,MaxRegs, - {field_flags,[]},Target}|PutCode], - cg_bin_opt(Code). - -cg_live({x,X}, MaxRegs) when X =:= MaxRegs -> MaxRegs+1; -cg_live({x,X}, MaxRegs) when X < MaxRegs -> MaxRegs. - -%% Generate code that calculate the size of the bitstr to be -%% built in BITS. - -cg_bitstr_size(PutCode, Target, Temp, Fail, Live) -> - {Bits,Es} = cg_bitstr_size_1(PutCode, 0, []), - reverse(cg_gen_binsize(Es, Target, Temp, Fail, Live, - [{move,{integer,Bits},Target}])). - -cg_bitstr_size_1([{bs_put_utf8,_,_,Src}|Next], Bits, Acc) -> - cg_bitstr_size_1(Next, Bits, [{'*',{bs_utf8_size,Src},8}|Acc]); -cg_bitstr_size_1([{bs_put_utf16,_,_,Src}|Next], Bits, Acc) -> - cg_bitstr_size_1(Next, Bits, [{'*',{bs_utf16_size,Src},8}|Acc]); -cg_bitstr_size_1([{bs_put_utf32,_,_,_}|Next], Bits, Acc) -> - cg_bitstr_size_1(Next, Bits+32, Acc); -cg_bitstr_size_1([{_,_,S,U,_,Src}|Next], Bits, Acc) -> - case S of - {integer,N} -> cg_bitstr_size_1(Next, Bits+N*U, Acc); - {atom,all} -> cg_bitstr_size_1(Next, Bits, [{bit_size,Src}|Acc]); - _ when U =:= 1 -> cg_bitstr_size_1(Next, Bits, [S|Acc]); - _ -> cg_bitstr_size_1(Next, Bits, [{'*',S,U}|Acc]) - end; -cg_bitstr_size_1([], Bits, Acc) -> {Bits,Acc}. - -%% Generate code that calculate the size of the bitstr to be -%% built in BYTES or BITS (depending on what is easiest). - -cg_binary_size(PutCode, Target, Temp, Fail, Live) -> - {InitInstruction,Szs} = cg_binary_size_1(PutCode, 0, []), - SizeExpr = reverse(cg_gen_binsize(Szs, Target, Temp, Fail, Live, [{move,{integer,0},Target}])), - {InitInstruction,SizeExpr}. - -cg_binary_size_1([{bs_put_utf8,_Fail,_Flags,Src}|T], Bits, Acc) -> - cg_binary_size_1(T, Bits, [{8,{bs_utf8_size,Src}}|Acc]); -cg_binary_size_1([{bs_put_utf16,_Fail,_Flags,Src}|T], Bits, Acc) -> - cg_binary_size_1(T, Bits, [{8,{bs_utf16_size,Src}}|Acc]); -cg_binary_size_1([{bs_put_utf32,_Fail,_Flags,_Src}|T], Bits, Acc) -> - cg_binary_size_1(T, Bits+32, Acc); -cg_binary_size_1([{_Put,_Fail,S,U,_Flags,Src}|T], Bits, Acc) -> - cg_binary_size_2(S, U, Src, T, Bits, Acc); -cg_binary_size_1([], Bits, Acc) -> - Bytes = Bits div 8, - RemBits = Bits rem 8, - Sizes0 = sort([{1,{integer,RemBits}},{8,{integer,Bytes}}|Acc]), - Sizes = filter(fun({_,{integer,0}}) -> false; - (_) -> true end, Sizes0), - case Sizes of - [{1,_}|_] -> - {bs_init_bits,cg_binary_bytes_to_bits(Sizes, [])}; - [{8,_}|_] -> - {bs_init2,[E || {8,E} <- Sizes]}; - [] -> - {bs_init_bits,[]} - end. - -cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits+N*U, Acc); -cg_binary_size_2({atom,all}, U, E, Next, Bits, Acc) -> - if - U rem 8 =:= 0 -> - cg_binary_size_1(Next, Bits, [{8,{byte_size,E}}|Acc]); - true -> - cg_binary_size_1(Next, Bits, [{1,{bit_size,E}}|Acc]) - end; -cg_binary_size_2(Reg, 1, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{1,Reg}|Acc]); -cg_binary_size_2(Reg, 8, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{8,Reg}|Acc]); -cg_binary_size_2(Reg, U, _, Next, Bits, Acc) -> - cg_binary_size_1(Next, Bits, [{1,{'*',Reg,U}}|Acc]). - -cg_binary_bytes_to_bits([{8,{integer,N}}|T], Acc) -> - cg_binary_bytes_to_bits(T, [{integer,8*N}|Acc]); -cg_binary_bytes_to_bits([{8,{byte_size,Reg}}|T], Acc) -> - cg_binary_bytes_to_bits(T, [{bit_size,Reg}|Acc]); -cg_binary_bytes_to_bits([{8,Reg}|T], Acc) -> - cg_binary_bytes_to_bits(T, [{'*',Reg,8}|Acc]); -cg_binary_bytes_to_bits([{1,Sz}|T], Acc) -> - cg_binary_bytes_to_bits(T, [Sz|Acc]); -cg_binary_bytes_to_bits([], Acc) -> - cg_binary_bytes_to_bits_1(sort(Acc)). - -cg_binary_bytes_to_bits_1([{integer,I},{integer,J}|T]) -> - cg_binary_bytes_to_bits_1([{integer,I+J}|T]); -cg_binary_bytes_to_bits_1([H|T]) -> - [H|cg_binary_bytes_to_bits_1(T)]; -cg_binary_bytes_to_bits_1([]) -> []. - -cg_gen_binsize([{'*',{bs_utf8_size,Src},B}|T], Target, Temp, Fail, Live, Acc) -> - Size = {bs_utf8_size,Fail,Src,Temp}, - Add = {bs_add,Fail,[Target,Temp,B],Target}, - cg_gen_binsize(T, Target, Temp, Fail, Live, - [Add,Size|Acc]); -cg_gen_binsize([{'*',{bs_utf16_size,Src},B}|T], Target, Temp, Fail, Live, Acc) -> - Size = {bs_utf16_size,Fail,Src,Temp}, - Add = {bs_add,Fail,[Target,Temp,B],Target}, - cg_gen_binsize(T, Target, Temp, Fail, Live, - [Add,Size|Acc]); -cg_gen_binsize([{'*',A,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize(T, Target, Temp, Fail, Live, - [{bs_add,Fail,[Target,A,B],Target}|Acc]); -cg_gen_binsize([{bit_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{gc_bif,bit_size,Fail,Live,[B],Temp}|Acc]); -cg_gen_binsize([{byte_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{gc_bif,byte_size,Fail,Live,[B],Temp}|Acc]); -cg_gen_binsize([{bs_utf8_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{bs_utf8_size,Fail,B,Temp}|Acc]); -cg_gen_binsize([{bs_utf16_size,B}|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize([Temp|T], Target, Temp, Fail, Live, - [{bs_utf16_size,Fail,B,Temp}|Acc]); -cg_gen_binsize([E0|T], Target, Temp, Fail, Live, Acc) -> - cg_gen_binsize(T, Target, Temp, Fail, Live, - [{bs_add,Fail,[Target,E0,1],Target}|Acc]); -cg_gen_binsize([], _, _, _, _, Acc) -> Acc. - - -%% cg_bin_opt(Code0) -> Code -%% Optimize the size calculations for binary construction. - -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 -> - 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_1([]) -> - []. - -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 - integer -> {plain,bs_put_integer}; - utf8 -> {utf,bs_put_utf8}; - utf16 -> {utf,bs_put_utf16}; - utf32 -> {utf,bs_put_utf32}; - binary -> {plain,bs_put_binary}; - float -> {plain,bs_put_float} - end, - case Format of - plain -> - [{Op,Fail,S1,U,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)]; - utf -> - [{Op,Fail,{field_flags,Fs},E1}|cg_bin_put(Next, Fail, Bef)] - end; -cg_bin_put(#k_bin_end{}, _, _) -> []. - -cg_build_args(As, Bef) -> - [{put,cg_reg_arg(A, Bef)} || A <- As]. - -%% return_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% break_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. -%% These are very simple, just put return/break values in registers -%% from 0, then return/break. Use the call setup to clean up stack, -%% but must clear registers to ensure sr_merge works correctly. - -return_cg(Rs, Le, Vdb, Bef, St) -> - {Ms,Int} = cg_setup_call(Rs, Bef, Le#l.i, Vdb), - {Ms ++ [return],Int#sr{reg=clear_regs(Int#sr.reg)},St}. - -break_cg(Bs, Le, Vdb, Bef, St) -> - {Ms,Int} = cg_setup_call(Bs, Bef, Le#l.i, Vdb), - {Ms ++ [{jump,{f,St#cg.break}}], - Int#sr{reg=clear_regs(Int#sr.reg)},St}. - -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(Reg0)), - {BreakVars,_} = mapfoldl(fun(_, RegNum) -> - {{RegNum,gbreakvar},RegNum+1} - end, length(Reg2), Bs), - Reg = Reg2 ++ BreakVars, - Aft = Int#sr{reg=Reg}, - {Moves ++ [{jump,{f,St#cg.break}}],Aft,St}. - -%% 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(#k_var{name=V}, Bef) -> fetch_var(V, Bef); -cg_reg_arg(Literal, _) -> atomic(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. - -cg_setup_call(As, Bef, I, Vdb) -> - {Ms,Int0} = cg_call_args(As, Bef, I, Vdb), - %% Have set up arguments, can now clean up, compress and save to stack. - Int1 = Int0#sr{stk=clear_dead_stk(Int0#sr.stk, I, Vdb),res=[]}, - {Sis,Int2} = adjust_stack(Int1, I, I+1, Vdb), - {Ms ++ Sis,Int2}. - -%% cg_call_args([Arg], SrState) -> {[Instr],SrState}. -%% Setup the arguments to a call/enter/bif. Put the arguments into -%% consecutive registers starting at {x,0} moving any data which -%% needs to be saved. Return a modified SrState structure with the -%% new register contents. N.B. the resultant register info will -%% contain non-variable values when there are non-variable values. -%% -%% This routine is complicated by unsaved values in x registers. -%% We'll move away any unsaved values that are in the registers -%% to be overwritten by the arguments. - -cg_call_args(As, Bef, I, Vdb) -> - Regs0 = load_arg_regs(Bef#sr.reg, As), - Unsaved = unsaved_registers(Regs0, Bef#sr.stk, I, I+1, Vdb), - {UnsavedMoves,Regs} = move_unsaved(Unsaved, Bef#sr.reg, Regs0), - Moves0 = gen_moves(As, Bef), - Moves = order_moves(Moves0, find_scratch_reg(Regs)), - {UnsavedMoves ++ Moves,Bef#sr{reg=Regs}}. - -%% load_arg_regs([Reg], Arguments) -> [Reg] -%% Update the register descriptor to include the arguments (from {x,0} -%% and upwards). Values in argument register are overwritten. -%% Values in x registers above the arguments are preserved. - -load_arg_regs(Regs, As) -> load_arg_regs(Regs, As, 0). - -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([], [#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. - -%% Returns the variables must be saved and are currently in the -%% x registers that are about to be overwritten by the arguments. - -unsaved_registers(Regs, Stk, Fb, Lf, Vdb) -> - [V || {V,F,L} <- Vdb, - F < Fb, - L >= Lf, - not on_stack(V, Stk), - not in_reg(V, Regs)]. - -in_reg(V, Regs) -> keymember(V, 2, Regs). - -%% Move away unsaved variables from the registers that are to be -%% overwritten by the arguments. -move_unsaved(Vs, OrigRegs, NewRegs) -> - move_unsaved(Vs, OrigRegs, NewRegs, []). - -move_unsaved([V|Vs], OrigRegs, NewRegs0, Acc) -> - NewRegs = put_reg(V, NewRegs0), - Src = fetch_reg(V, OrigRegs), - Dst = fetch_reg(V, NewRegs), - move_unsaved(Vs, OrigRegs, NewRegs, [{move,Src,Dst}|Acc]); -move_unsaved([], _, Regs, Acc) -> {Acc,Regs}. - -%% gen_moves(As, Sr) -%% Generate the basic move instruction to move the arguments -%% to their proper registers. The list will be sorted on -%% destinations. (I.e. the move to {x,0} will be first -- -%% see the comment to order_moves/2.) - -gen_moves(As, Sr) -> gen_moves(As, Sr, 0, []). - -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([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). - -%% order_moves([Move], ScratchReg) -> [Move] -%% Orders move instruction so that source registers are not -%% destroyed before they are used. If there are cycles -%% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), -%% the scratch register is used to break up the cycle. -%% If possible, the first move of the input list is placed -%% last in the result list (to make the move to {x,0} occur -%% just before the call to allow the Beam loader to coalesce -%% the instructions). - -order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). - -order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> - {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), - Acc = reverse(Chain, Acc0), - order_moves(Ms, ScrReg, Acc); -order_moves([], _, Acc) -> Acc. - -collect_chain(Ms, Path, ScrReg) -> - collect_chain(Ms, Path, [], ScrReg). - -collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> - case lists:keyfind(Src, 3, Path) of - false -> - collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg); - _ -> % We have a cycle. - {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)} - end; -collect_chain([M|Ms], Path, Others, ScrReg) -> - collect_chain(Ms, Path, [M|Others], ScrReg); -collect_chain([], Path, Others, _) -> - {Path,Others}. - -break_up_cycle({move,Src,_}=M, Path, ScrReg) -> - [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. - -break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> - [{move,Src,ScrReg}|Path]; -break_up_cycle1(Dst, [M|Path], LastMove) -> - [M|break_up_cycle1(Dst, Path, LastMove)]. - -%% clear_dead(Sr, Until, Vdb) -> Aft. -%% Remove all variables in Sr which have died AT ALL so far. - -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) -> - [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 - {V} = T -> - case vdb_find(V, Vdb) of - {V,_,L} when L > Until -> T; - _ -> dead %Remove anything else - end; - free -> free; - dead -> dead - end ||Â S <- Stk]. - - -%% sr_merge(Sr1, Sr2) -> Sr. -%% Merge two stack/register states keeping the longest of both stack -%% and register. Perform consistency check on both, elements must be -%% the same. Allow frame size 'void' to make easy creation of -%% "empty" frame. - -sr_merge(#sr{reg=R1,stk=S1,res=[]}, #sr{reg=R2,stk=S2,res=[]}) -> - #sr{reg=longest(R1, R2),stk=longest(S1, S2),res=[]}; -sr_merge(void, S2) -> S2#sr{res=[]}. - -longest([H|T1], [H|T2]) -> [H|longest(T1, T2)]; -longest([dead|T1], [free|T2]) -> [dead|longest(T1, T2)]; -longest([free|T1], [dead|T2]) -> [dead|longest(T1, T2)]; -longest([dead|_] = L, []) -> L; -longest([], [dead|_] = L) -> L; -longest([free|_] = L, []) -> L; -longest([], [free|_] = L) -> L; -longest([], []) -> []. - -trim_free([R|Rs0]) -> - case {trim_free(Rs0),R} of - {[],free} -> []; - {Rs,R} -> [R|Rs] - end; -trim_free([]) -> []. - -%% maybe_adjust_stack(Bef, FirstBefore, LastFrom, Vdb, St) -> {[Ainstr],Aft}. -%% Adjust the stack, but only if the code is inside a catch and not -%% inside a guard. Use this funtion before instructions that may -%% cause an exception. - -maybe_adjust_stack(Bef, Fb, Lf, Vdb, St) -> - case St of - #cg{in_catch=true,bfail=0} -> - adjust_stack(Bef, Fb, Lf, Vdb); - #cg{} -> - {[],Bef} - end. - -%% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}. -%% Do complete stack adjustment by compressing stack and adding -%% variables to be saved. Try to optimise ordering on stack by -%% having reverse order to their lifetimes. -%% -%% In Beam, there is a fixed stack frame and no need to do stack compression. - -adjust_stack(Bef, Fb, Lf, Vdb) -> - Stk0 = Bef#sr.stk, - {Stk1,Saves} = save_stack(Stk0, Fb, Lf, Vdb), - {saves(Saves, Bef#sr.reg, Stk1), - Bef#sr{stk=Stk1}}. - -%% save_stack(Stack, FirstBefore, LastFrom, Vdb) -> {[SaveVar],NewStack}. -%% Save variables which are used past current point and which are not -%% already on the stack. - -save_stack(Stk0, Fb, Lf, Vdb) -> - %% New variables that are in use but not on stack. - 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. - -saves(Ss, Reg, Stk) -> - [{move,fetch_reg(V, Reg),fetch_stack(V, Stk)} || V <- Ss]. - -%% fetch_var(VarName, StkReg) -> r{R} | sp{Sp}. -%% find_var(VarName, StkReg) -> ok{r{R} | sp{Sp}} | error. -%% Fetch/find a variable in either the registers or on the -%% stack. Fetch KNOWS it's there. - -fetch_var(V, Sr) -> - case find_reg(V, Sr#sr.reg) of - {ok,R} -> R; - error -> fetch_stack(V, Sr#sr.stk) - end. - -fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) -> - case find_stack(V, Stk) of - {ok,R} -> R; - error -> fetch_reg(V, Reg) - end. - -load_vars(Vs, Regs) -> - 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. -%% fetch_reg(Val, Regs) -> r{R}. -%% Functions to interface the registers. - -% put_regs(Vs, Rs) -> foldl(fun put_reg/2, Rs, Vs). - -put_reg(V, Rs) -> put_reg_1(V, Rs, 0). - -put_reg_1(V, [free|Rs], I) -> [{I,V}|Rs]; -put_reg_1(V, [{reserved,I,V}|Rs], I) -> [{I,V}|Rs]; -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). - -find_reg(V, [{I,V}|_]) -> {ok,{x,I}}; -find_reg(V, [_|SRs]) -> find_reg(V, SRs); -find_reg(_, []) -> error. - -%% For the bit syntax, we need a scratch register if we are constructing -%% a binary that will not be used. - -find_scratch_reg(Rs) -> find_scratch_reg(Rs, 0). - -find_scratch_reg([free|_], I) -> {x,I}; -find_scratch_reg([_|Rs], I) -> find_scratch_reg(Rs, I+1); -find_scratch_reg([], I) -> {x,I}. - -replace_reg_contents(Old, New, [{I,Old}|Rs]) -> [{I,New}|Rs]; -replace_reg_contents(Old, New, [R|Rs]) -> [R|replace_reg_contents(Old, New, Rs)]. - -%%clear_regs(Regs) -> map(fun (R) -> free end, Regs). -clear_regs(_) -> []. - -max_reg(Regs) -> - foldl(fun ({I,_}, _) -> I; - (_, Max) -> Max end, - -1, Regs) + 1. - -%% put_stack(Val, [{Val}]) -> [{Val}]. -%% fetch_stack(Var, Stk) -> sp{S}. -%% find_stack(Var, Stk) -> ok{sp{S}} | error. -%% Functions to interface the stack. - -put_stack(Val, []) -> [{Val}]; -put_stack(Val, [dead|Stk]) -> [{Val}|Stk]; -put_stack(Val, [free|Stk]) -> [{Val}|Stk]; -put_stack(Val, [NotFree|Stk]) -> [NotFree|put_stack(Val, Stk)]. - -put_stack_carefully(Val, Stk0) -> - try - put_stack_carefully1(Val, Stk0) - catch - throw:error -> - error - end. - -put_stack_carefully1(_, []) -> throw(error); -put_stack_carefully1(Val, [dead|Stk]) -> [{Val}|Stk]; -put_stack_carefully1(Val, [free|Stk]) -> [{Val}|Stk]; -put_stack_carefully1(Val, [NotFree|Stk]) -> - [NotFree|put_stack_carefully1(Val, Stk)]. - -fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0). - -fetch_stack(V, [{V}|_], I) -> {yy,I}; -fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). - -find_stack(Var, Stk) -> find_stack(Var, Stk, 0). - -find_stack(V, [{V}|_], I) -> {ok,{yy,I}}; -find_stack(V, [_|Stk], I) -> find_stack(V, Stk, I+1); -find_stack(_, [], _) -> error. - -on_stack(V, Stk) -> keymember(V, 1, Stk). - -%% put_catch(CatchTag, Stack) -> Stack' -%% drop_catch(CatchTag, Stack) -> Stack' -%% Special interface for putting and removing catch tags, to ensure that -%% catches nest properly. Also used for try tags. - -put_catch(Tag, Stk0) -> put_catch(Tag, reverse(Stk0), []). - -put_catch(Tag, [], Stk) -> - put_stack({catch_tag,Tag}, Stk); -put_catch(Tag, [{{catch_tag,_}}|_]=RevStk, Stk) -> - reverse(RevStk, put_stack({catch_tag,Tag}, Stk)); -put_catch(Tag, [Other|Stk], Acc) -> - put_catch(Tag, Stk, [Other|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) -> - {Next,St#cg{lcount=Next+1}}. - -%% line(Le) -> {line,[] | {location,File,Line}} -%% Create a line instruction, containing information about -%% the current filename and line number. A line information -%% instruction should be placed before any operation that could -%% cause an exception. - -line(#l{a=Anno}) -> - line(Anno); -line([Line,{file,Name}]) when is_integer(Line) -> - line_1(Name, Line); -line([_|_]=A) -> - {Name,Line} = find_loc(A, no_file, 0), - line_1(Name, Line); -line([]) -> - {line,[]}. - -line_1(no_file, _) -> - {line,[]}; -line_1(_, 0) -> - %% Missing line number or line number 0. - {line,[]}; -line_1(Name, Line) -> - {line,[{location,Name,Line}]}. - -find_loc([Line|T], File, _) when is_integer(Line) -> - find_loc(T, File, Line); -find_loc([{file,File}|T], _, Line) -> - find_loc(T, File, Line); -find_loc([_|T], File, Line) -> - find_loc(T, File, Line); -find_loc([], File, Line) -> {File,Line}. - -flatmapfoldl(F, Accu0, [Hd|Tail]) -> - {R,Accu1} = F(Hd, Accu0), - {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), - {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 66e578b776..007a0247f4 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -228,7 +228,8 @@ function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), - {Args,St1} = new_vars(Anno, Arity, St0), + {Args0,St1} = new_vars(Anno, Arity, St0), + Args = reverse(Args0), %Nicer order case clauses(Cs0, St1) of {Cs1,[],St2} -> {Ps,St3} = new_vars(Arity, St2), %Need new variables here @@ -329,7 +330,7 @@ gexpr({protect,Line,Arg}, Bools0, St0) -> {#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St} end; gexpr({op,_,'andalso',_,_}=E0, Bools, St0) -> - {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0), + {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -337,7 +338,7 @@ gexpr({op,_,'andalso',_,_}=E0, Bools, St0) -> E = make_bool_switch_guard(L, E1, V, E2, False), gexpr(E, Bools, St); gexpr({op,_,'orelse',_,_}=E0, Bools, St0) -> - {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0), + {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -767,7 +768,7 @@ expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; expr({op,_,'andalso',_,_}=E0, St0) -> - {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0), + {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -775,7 +776,7 @@ expr({op,_,'andalso',_,_}=E0, St0) -> E = make_bool_switch(L, E1, V, E2, False, St0), expr(E, St); expr({op,_,'orelse',_,_}=E0, St0) -> - {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0), + {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'), Anno = lineno_anno(L, St0), {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, @@ -1810,7 +1811,8 @@ force_safe(Ce, St0) -> is_safe(#c_cons{}) -> true; is_safe(#c_tuple{}) -> true; -is_safe(#c_var{}) -> true; +is_safe(#c_var{name={_,_}}) -> false; %Fun. Not safe. +is_safe(#c_var{name=_}) -> true; %Ordinary variable. is_safe(#c_literal{}) -> true; is_safe(_) -> false. @@ -2059,17 +2061,9 @@ fail_clause(Pats, Anno, Arg) -> 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. +right_assoc({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) -> + right_assoc({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op); +right_assoc(E, _Op) -> E. annotate_tuple(A, Es, St) -> case member(dialyzer, St#core.opts) of diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index aef0b6cc9f..e2b8787224 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -82,8 +82,7 @@ -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,sort/1, - reverse/1]). + 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]). @@ -1415,8 +1414,6 @@ is_remote_bif(_, _, _) -> false. %% return multiple values. Only used in bodies where a BIF may be %% called for effect only. -bif_vals(dsetelement, 3) -> 0; -bif_vals(bs_context_to_binary, 1) -> 0; bif_vals(_, _) -> 1. bif_vals(_, _, _) -> 1. @@ -1593,19 +1590,12 @@ match_var([U|Us], Cs0, Def, St) -> %% constructor/constant as first argument. Group the constructors %% according to type, the order is really irrelevant but tries to be %% smart. - -match_con(Us, Cs0, Def, St) -> - %% 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) -> +match_con([U|_Us] = L, Cs, Def, St0) -> %% Extract clauses for different constructors (types). %%ok = io:format("match_con ~p~n", [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), + Ttcs0 = select_types(Cs, [], [], [], [], [], [], [], [], []), + Ttcs1 = [{T, Types} || {T, [_ | _] = Types} <- Ttcs0], + Ttcs = opt_single_valued(Ttcs1), %%ok = io:format("ttcs = ~p~n", [Ttcs]), {Scs,St1} = mapfoldl(fun ({T,Tcs}, St) -> @@ -1616,8 +1606,41 @@ match_con_1([U|_Us] = L, Cs, Def, St0) -> St0, Ttcs), {build_alt_1st_no_fail(build_select(U, Scs), Def),St1}. -select_types(Types, Cs) -> - [{T,Tcs} || T <- Types, begin Tcs = select(T, Cs), Tcs =/= [] end]. +select_types([NoExpC | Cs], Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil) -> + C = expand_pat_lit_clause(NoExpC), + case clause_con(C) of + k_binary -> + select_types(Cs, [C |Bin], BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil); + k_bin_seg -> + select_types(Cs, Bin, [C | BinCon], Cons, Tuple, Map, Atom, Float, Int, Nil); + k_bin_end -> + select_types(Cs, Bin, [C | BinCon], Cons, Tuple, Map, Atom, Float, Int, Nil); + k_cons -> + select_types(Cs, Bin, BinCon, [C | Cons], Tuple, Map, Atom, Float, Int, Nil); + k_tuple -> + select_types(Cs, Bin, BinCon, Cons, [C | Tuple], Map, Atom, Float, Int, Nil); + k_map -> + select_types(Cs, Bin, BinCon, Cons, Tuple, [C | Map], Atom, Float, Int, Nil); + k_atom -> + select_types(Cs, Bin, BinCon, Cons, Tuple, Map, [C | Atom], Float, Int, Nil); + k_float -> + select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, [C | Float], Int, Nil); + k_int -> + select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, Float, [C | Int], Nil); + k_nil -> + select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, [C | Nil]) + end; +select_types([], Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil) -> + [{k_binary, reverse(Bin)}] ++ handle_bin_con(reverse(BinCon)) ++ + [ + {k_cons, reverse(Cons)}, + {k_tuple, reverse(Tuple)}, + {k_map, reverse(Map)}, + {k_atom, reverse(Atom)}, + {k_float, reverse(Float)}, + {k_int, reverse(Int)}, + {k_nil, reverse(Nil)} + ]. expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C) -> P = expand_pat_lit(Val, A), @@ -1746,20 +1769,12 @@ 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 +%% handle_bin_con([Clause]) -> [{Type,[Clause]}]. +%% Handle clauses for the k_bin_seg constructor. As k_bin_seg %% matching can overlap, the k_bin_seg constructors cannot be %% reordered, only grouped. -select_bin_con(Cs0) -> - Cs1 = lists:filter(fun (C) -> - Con = clause_con(C), - (Con =:= k_bin_seg) or (Con =:= k_bin_end) - end, Cs0), - select_bin_con_1(Cs1). - - -select_bin_con_1(Cs) -> +handle_bin_con(Cs) -> try %% The usual way to match literals is to first extract the %% value to a register, and then compare the register to the @@ -1798,14 +1813,14 @@ select_bin_con_1(Cs) -> end catch throw:not_possible -> - select_bin_con_2(Cs) + handle_bin_con_not_possible(Cs) end. -select_bin_con_2([C1|Cs]) -> +handle_bin_con_not_possible([C1|Cs]) -> Con = clause_con(C1), {More,Rest} = splitwith(fun (C) -> clause_con(C) =:= Con end, Cs), - [{Con,[C1|More]}|select_bin_con_2(Rest)]; -select_bin_con_2([]) -> []. + [{Con,[C1|More]}|handle_bin_con_not_possible(Rest)]; +handle_bin_con_not_possible([]) -> []. %% select_bin_int([Clause]) -> {k_bin_int,[Clause]} %% If the first pattern in each clause selects the same integer, @@ -1905,10 +1920,6 @@ select_utf8(Val0) -> throw(not_possible) end. -%% select(Con, [Clause]) -> [Clause]. - -select(T, Cs) -> [ C || C <- Cs, clause_con(C) =:= T ]. - %% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}. %% At this point all the clauses have the same constructor, we must %% now separate them according to value. @@ -2044,8 +2055,9 @@ get_match(#k_binary{}, St0) -> {[V]=Mes,St1} = new_vars(1, St0), {#k_binary{segs=V},Mes,St1}; get_match(#k_bin_seg{size=#k_atom{val=all},next={k_bin_end,[]}}=Seg, St0) -> - {[S]=Vars,St1} = new_vars(1, St0), - {Seg#k_bin_seg{seg=S,next=[]},Vars,St1}; + {[S,N0],St1} = new_vars(2, St0), + N = set_kanno(N0, [no_usage]), + {Seg#k_bin_seg{seg=S,next=N},[S],St1}; get_match(#k_bin_seg{}=Seg, St0) -> {[S,N0],St1} = new_vars(2, St0), N = set_kanno(N0, [no_usage]), @@ -2343,8 +2355,7 @@ uexpr(#k_bif{anno=A,op=Op,args=As}=Bif, {break,Rs}, St0) -> {Brs,St1} = bif_returns(Op, Rs, St0), {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Brs),a=A},ret=Brs}, Used,St1}; -uexpr(#k_match{anno=A,vars=Vs0,body=B0}, Br, St0) -> - Vs = handle_reuse_annos(Vs0, St0), +uexpr(#k_match{anno=A,vars=Vs,body=B0}, Br, St0) -> Rs = break_rets(Br), {B1,Bu,St1} = umatch(B0, Br, St0), case is_in_guard(St1) of @@ -2374,9 +2385,10 @@ uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, 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), + {Avs,St1} = new_vars(length(Rs0), St0), + {A1,Bu,St} = uexpr(A0, {break,Avs}, St1), {#k_protected{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, - arg=A1,ret=Rs0},Bu,St1}; + arg=A1,ret=Rs0,inner=Avs},Bu,St}; false -> {Avs,St1} = new_vars(length(Vs), St0), {A1,Au,St2} = ubody(A0, {break,Avs}, St1), @@ -2446,33 +2458,6 @@ make_fdef(Anno, Name, Arity, Vs, Body) -> 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. -%% -%% If a variable has been bound in an outer letrec and is therefore -%% free in the current function, the variable may still be used. -%% We don't bother to check whether the variable is actually used, -%% but simply clears the 'reuse_for_context' annotation for any variable -%% that is free. -handle_reuse_annos(Vs, St) -> - [handle_reuse_anno(V, St) || V <- Vs]. - -handle_reuse_anno(#k_var{anno=A}=V, St) -> - case member(reuse_for_context, A) of - false -> V; - true -> handle_reuse_anno_1(V, St) - end. - -handle_reuse_anno_1(#k_var{anno=Anno,name=Vname}=V, #kern{ff={F,A}}=St) -> - FreeVs = get_free(F, A, St), - case keymember(Vname, #k_var.name, FreeVs) of - true -> V#k_var{anno=Anno--[reuse_for_context]}; - false -> V - end; -handle_reuse_anno_1(V, _St) -> V. - %% get_free(Name, Arity, State) -> [Free]. %% store_free(Name, Arity, [Free], State) -> State. @@ -2516,8 +2501,7 @@ umatch(#k_alt{anno=A,first=F0,then=T0}, Br, St0) -> Used = union(Fu, Tu), {#k_alt{anno=#k{us=Used,ns=[],a=A},first=F1,then=T1}, Used,St2}; -umatch(#k_select{anno=A,var=V0,types=Ts0}, Br, St0) -> - V = handle_reuse_anno(V0, St0), +umatch(#k_select{anno=A,var=V,types=Ts0}, Br, St0) -> {Ts1,Tus,St1} = umatch_list(Ts0, Br, St0), Used = case member(no_usage, get_kanno(V)) of true -> Tus; diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index e6f0d3c1f7..e26360a6da 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -66,7 +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_protected, {anno=[],arg,ret=[],inner}). -record(k_catch, {anno=[],body,ret=[]}). -record(k_guard_match, {anno=[],vars,body,ret=[]}). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index da5d207db9..7be23fbb93 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -14,6 +14,7 @@ MODULES= \ beam_except_SUITE \ beam_jump_SUITE \ beam_reorder_SUITE \ + beam_ssa_SUITE \ beam_type_SUITE \ beam_utils_SUITE \ bif_SUITE \ @@ -52,6 +53,7 @@ NO_OPT= \ beam_except \ beam_jump \ beam_reorder \ + beam_ssa \ beam_type \ beam_utils \ bif \ @@ -75,6 +77,7 @@ INLINE= \ andor \ apply \ beam_block \ + beam_ssa \ beam_utils \ bif \ bs_bincomp \ @@ -94,16 +97,34 @@ INLINE= \ receive \ record +R21= \ + bs_construct \ + bs_match + CORE_MODULES = \ lfe_andor_SUITE \ lfe_guard_SUITE +NO_MOD_OPT = $(NO_OPT) + +NO_SSA_OPT = $(NO_OPT) + +NO_TYPE_OPT = $(NO_OPT) + NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl) POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE) POST_OPT_ERL_FILES= $(POST_OPT_MODULES:%=%.erl) INLINE_MODULES= $(INLINE:%=%_inline_SUITE) INLINE_ERL_FILES= $(INLINE_MODULES:%=%.erl) +R21_MODULES= $(R21:%=%_r21_SUITE) +R21_ERL_FILES= $(R21_MODULES:%=%.erl) +NO_MOD_OPT_MODULES= $(NO_MOD_OPT:%=%_no_module_opt_SUITE) +NO_MOD_OPT_ERL_FILES= $(NO_MOD_OPT_MODULES:%=%.erl) +NO_SSA_OPT_MODULES= $(NO_SSA_OPT:%=%_no_ssa_opt_SUITE) +NO_SSA_OPT_ERL_FILES= $(NO_SSA_OPT_MODULES:%=%.erl) +NO_TYPE_OPT_MODULES= $(NO_TYPE_OPT:%=%_no_type_opt_SUITE) +NO_TYPE_OPT_ERL_FILES= $(NO_TYPE_OPT_MODULES:%=%.erl) ERL_FILES= $(MODULES:%=%.erl) CORE_FILES= $(CORE_MODULES:%=%.core) @@ -124,7 +145,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += +clint +clint0 +ERL_COMPILE_FLAGS += +clint +clint0 +ssalint EBIN = . @@ -132,17 +153,28 @@ EBIN = . # Targets # ---------------------------------------------------- -make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(INLINE_ERL_FILES) +make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(NO_SSA_OPT_ERL_FILES) \ + $(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES) $(NO_TYPE_OPT_ERL_FILES) $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ > $(EMAKEFILE) - $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt $(ERL_COMPILE_FLAGS) \ + $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt \ + +no_ssa_opt +no_recv_opt $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +no_share_opt +no_bsm_opt +no_fun_opt \ + +no_ssa_opt +no_recv_opt $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(NO_SSA_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +no_copt $(ERL_COMPILE_FLAGS) \ -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 +r21 $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(R21_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +no_module_opt $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(NO_MOD_OPT_MODULES) >> $(EMAKEFILE) $(ERL_TOP)/make/make_emakefile +from_core $(ERL_COMPILE_FLAGS) \ -o$(EBIN) $(CORE_MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +no_type_opt $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(NO_TYPE_OPT_MODULES) >> $(EMAKEFILE) tests debug opt: make_emakefile erl $(ERL_MAKE_FLAGS) -make @@ -161,12 +193,25 @@ docs: %_no_opt_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ +%_no_ssa_opt_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + %_post_opt_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ %_inline_SUITE.erl: %_SUITE.erl sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ +%_r21_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + +%_no_module_opt_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + +%_no_type_opt_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -179,7 +224,10 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) compiler.spec compiler.cover \ $(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ - $(INLINE_ERL_FILES) "$(RELSYSDIR)" + $(INLINE_ERL_FILES) $(R21_ERL_FILES) \ + $(NO_MOD_OPT_ERL_FILES) \ + $(NO_SSA_OPT_ERL_FILES) \ + $(NO_TYPE_OPT_ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)" for file in $(ERL_DUMMY_FILES); do \ module=`basename $$file .erl`; \ diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl index 0f82a56fb7..2ee518b1a0 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -73,6 +73,7 @@ mfa(Config) when is_list(Config) -> {'EXIT',_} = (catch ?APPLY2(Mod, (id(bazzzzzz)), a, b)), {'EXIT',_} = (catch ?APPLY2({}, baz, a, b)), {'EXIT',_} = (catch ?APPLY2(?MODULE, [], a, b)), + {'EXIT',_} = (catch bad_literal_call(1)), ok = apply(Mod, foo, id([])), {[a,b|c]} = apply(Mod, bar, id([[a,b|c]])), @@ -92,6 +93,13 @@ mfa(Config) when is_list(Config) -> apply(Mod, foo, []). +%% The single call to this function with a literal argument caused type +%% optimization to swap out the 'mod' field of a #b_remote{}, which was +%% mishandled during code generation as it assumed that the module would always +%% be an atom. +bad_literal_call(I) -> + I:foo(). + foo() -> ok. diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index 2b4a780899..f52239f2a8 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -21,7 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - multiple_allocs/1,coverage/1]). + multiple_allocs/1,bs_get_tail/1,coverage/1, + binary_construction_allocation/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -31,7 +32,9 @@ all() -> groups() -> [{p,[parallel], [multiple_allocs, - coverage]}]. + bs_get_tail, + coverage, + binary_construction_allocation]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -63,6 +66,31 @@ place(lee) -> conditions() -> (talking = going) = storage + [large = wanted]. +bs_get_tail(Config) -> + {<<"abc">>,0,0,Config} = bs_get_tail_1(id(<<0:32, "abc">>), 0, 0, Config), + {'EXIT', + {function_clause, + [{?MODULE,bs_get_tail_1,[<<>>,0,0,Config],_}|_]}} = + (catch bs_get_tail_1(id(<<>>), 0, 0, Config)), + + ok = bs_get_tail_2(<<"W">>, <<"X">>, <<"Z">>), + ok = bs_get_tail_2(<<"M">>, <<"X">>, <<"Z">>), + {'EXIT', + {function_clause, + [{?MODULE,do_get_bs_tail_2,[<<"A">>,<<"B">>,[],<<"C">>],_}|_]}} = + (catch bs_get_tail_2(<<"A">>, <<"B">>, <<"C">>)), + + ok. + +bs_get_tail_1(<<_:32, Rest/binary>>, Z1, Z2, F1) -> + {Rest,Z1,Z2,F1}. + +bs_get_tail_2(A, B, C) -> + do_get_bs_tail_2(A, B, [], C). + +do_get_bs_tail_2(<<"W">>, <<"X">>, _, <<"Z">>) -> ok; +do_get_bs_tail_2(<<"M">>, <<"X">>, _, <<"Z">>) -> ok. + coverage(_) -> File = {file,"fake.erl"}, ok = fc(a), @@ -72,9 +100,16 @@ coverage(_) -> {'EXIT',{function_clause, [{?MODULE,fc,[y],[File,{line,2}]}|_]}} = (catch fc(y)), - {'EXIT',{function_clause, - [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} = - (catch fc([a,b,c])), + case ?MODULE of + beam_except_no_opt_SUITE -> + %% There will be a different stack fram in + %% unoptimized code. + ok; + _ -> + {'EXIT',{function_clause, + [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} = + (catch fc([a,b,c])) + end, {'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} = (catch erlang:error(a, b, c)), @@ -83,8 +118,38 @@ coverage(_) -> (catch bar(x)), {'EXIT',{{case_clause,{1}},[{?MODULE,bar,1,[File,{line,9}]}|_]}} = (catch bar(0)), + + Self = self(), + {'EXIT',{{strange,Self},[{?MODULE,foo,[any],[File,{line,14}]}|_]}} = + (catch foo(any)), + + {ok,succeed,1,2} = foobar(succeed, 1, 2), + {'EXIT',{function_clause,[{?MODULE,foobar,[[fail],1,2], + [{file,"fake.erl"},{line,16}]}|_]}} = + (catch foobar([fail], 1, 2)), + {'EXIT',{function_clause,[{?MODULE,fake_function_clause,[{a,b},42.0],_}|_]}} = + (catch fake_function_clause({a,b})), + + ok. + +fake_function_clause(A) -> error(function_clause, [A,42.0]). + + +binary_construction_allocation(_Config) -> + ok = do_binary_construction_allocation("PUT"), ok. +do_binary_construction_allocation(Req) -> + %% Allocation for building the error term was done by the + %% bs_init2 instruction. beam_except crashed because it expected + %% an explicit allocation instruction. + ok = case Req of + "POST" -> {error, <<"BAD METHOD ", Req/binary>>, Req}; + _ -> ok + end. + +id(I) -> I. + -file("fake.erl", 1). fc(a) -> %Line 2 ok; %Line 3 @@ -96,3 +161,9 @@ bar(X) -> %Line 8 case {X+1} of %Line 9 1 -> ok %Line 10 end. %Line 11 +%% Cover collection code for function_clause exceptions. +foo(A) -> %Line 13 + error({strange,self()}, [A]). %Line 14 +%% Cover beam_except:tag_literal/1. +foobar(A, B, C) when is_atom(A) -> %Line 16 + {ok,A,B,C}. %Line 17 diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl index faedc0c1f1..a456f31d79 100644 --- a/lib/compiler/test/beam_jump_SUITE.erl +++ b/lib/compiler/test/beam_jump_SUITE.erl @@ -22,7 +22,8 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, undefined_label/1,ambiguous_catch_try_state/1, - build_tuple/1]). + unsafe_move_elimination/1,build_tuple/1, + coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -34,7 +35,9 @@ groups() -> [{p,[parallel], [undefined_label, ambiguous_catch_try_state, - build_tuple + unsafe_move_elimination, + build_tuple, + coverage ]}]. init_per_suite(Config) -> @@ -75,6 +78,82 @@ checks(Wanted) -> %% Must be one line to cause the unsafe optimization. {catch case river() of sheet -> begin +Wanted, if "da" -> Wanted end end end, catch case river() of sheet -> begin + Wanted, if "da" -> Wanted end end end}. +unsafe_move_elimination(_Config) -> + {{left,right,false},false} = unsafe_move_elimination_1(left, right, false), + {{false,right,false},false} = unsafe_move_elimination_1(false, right, true), + {{true,right,right},right} = unsafe_move_elimination_1(true, right, true), + [ok = unsafe_move_elimination_2(I) || I <- lists:seq(0,16)], + ok. + +unsafe_move_elimination_1(Left, Right, Simple0) -> + id(1), + + %% The move at label 29 would be removed by beam_jump, which is unsafe because + %% the two select_val instructions have different source registers. + %% + %% {select_val,{y,0},{f,25},{list,[{atom,true},{f,27},{atom,false},{f,29}]}}. + %% ^^^^^ ^^^^^^^^^^^^^^^^^^^ + %% {label,27}. + %% {kill,{y,0}}. + %% {move,{y,2},{x,0}}. + %% {line,...}. + %% {call,1,{f,31}}. + %% {select_val,{x,0},{f,33},{list,[{atom,true},{f,35},{atom,false},{f,29}]}}. + %% ^^^^^ ^^^^^^^^^^^^^^^^^^^ + %% {label,29}. + %% {move,{atom,false},{y,0}}. <=== REMOVED (unsafely). + %% {jump,{f,37}}. + + Simple = case case Simple0 of + false -> false; + true -> id(Left) + end + of + false -> + false; + true -> + id(Right) + end, + {id({Left,Right,Simple}),Simple}. + +unsafe_move_elimination_2(Int) -> + %% The type optimization pass would recognize that TagInt can only be + %% [0 .. 7], so the first 'case' would select_val over [0 .. 6] and swap + %% out the fail label with the block for 7. + %% + %% A later optimization would merge this block with 'expects_h' in the + %% second case, as the latter is only reachable from the former. + %% + %% ... but this broke down when the move elimination optimization didn't + %% take the fail label of the first select_val into account. This caused it + %% to believe that the only way to reach 'expects_h' was through the second + %% case when 'Tag' =:= 'h', which made it remove the move instruction + %% added in the first case, passing garbage to expects_h/2. + TagInt = Int band 2#111, + Tag = case TagInt of + 0 -> a; + 1 -> b; + 2 -> c; + 3 -> d; + 4 -> e; + 5 -> f; + 6 -> g; + 7 -> h + end, + case Tag of + g -> expects_g(TagInt, Tag); + h -> expects_h(TagInt, Tag); + _ -> Tag = id(Tag), ok + end. + +expects_g(6, Atom) -> + Atom = id(g), + ok. + +expects_h(7, Atom) -> + Atom = id(h), + ok. + -record(message2, {id, p1}). -record(message3, {id, p1, p2}). @@ -87,3 +166,45 @@ do_build_tuple(Message) -> Res = {res, rand:uniform(100)}, {Message#message3.id, Res} end. + +coverage(_Config) -> + ok = coverage_1(ok), + {error,badarg} = coverage_1({error,badarg}), + + gt = coverage_2(100, 42), + le = coverage_2(100, 999), + le = coverage_2([], []), + gt = coverage_2([], xxx), + + ok. + +coverage_1(Var) -> + case id(Var) of + ok -> ok; + Error -> Error + end. + +%% Cover beam_jump:invert_test(is_ne_exact). +coverage_2(Pre1, Pre2) -> + case + case Pre1 == [] of + false -> + false; + true -> + Pre2 /= [] + end + of + true -> + gt; + false -> + case Pre1 > Pre2 of + true -> + gt; + false -> + le + end + end. + + +id(I) -> + I. diff --git a/lib/compiler/test/beam_ssa_SUITE.erl b/lib/compiler/test/beam_ssa_SUITE.erl new file mode 100644 index 0000000000..3b510f3528 --- /dev/null +++ b/lib/compiler/test/beam_ssa_SUITE.erl @@ -0,0 +1,641 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_ssa_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + calls/1,tuple_matching/1,recv/1,maps/1, + cover_ssa_dead/1,combine_sw/1,share_opt/1, + beam_ssa_dead_crash/1,stack_init/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,p}]. + +groups() -> + [{p,test_lib:parallel(), + [tuple_matching, + calls, + recv, + maps, + cover_ssa_dead, + combine_sw, + share_opt, + beam_ssa_dead_crash, + stack_init + ]}]. + +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. + +calls(Config) -> + Ret = {return,value,Config}, + Ret = fun_call(fun(42) -> ok end, Ret), + Ret = apply_fun(fun(a, b) -> ok end, [a,b], Ret), + Ret = apply_mfa(test_lib, id, [anything], Ret), + {'EXIT',{badarg,_}} = (catch call_error()), + {'EXIT',{badarg,_}} = (catch call_error(42)), + 5 = start_it([erlang,length,1,2,3,4,5]), + ok. + +fun_call(Fun, X0) -> + X = id(X0), + Fun(42), + X. + +apply_fun(Fun, Args, X0) -> + X = id(X0), + apply(Fun, Args), + X. + +apply_mfa(Mod, Name, Args, X0) -> + X = id(X0), + apply(Mod, Name, Args), + X. + +call_error() -> + error(badarg), + ok. + +call_error(I) -> + <<I:(-8)>>, + ok. + +start_it([_|_]=MFA) -> + case MFA of + [M,F|Args] -> M:F(Args) + end. + +tuple_matching(_Config) -> + do_tuple_matching({tag,42}), + + true = is_two_tuple({a,b}), + false = is_two_tuple({a,b,c}), + false = is_two_tuple(atom), + + ok. + +do_tuple_matching(Arg) -> + Res = do_tuple_matching_1(Arg), + Res = do_tuple_matching_2(Arg), + Res = do_tuple_matching_3(Arg), + Res. + +do_tuple_matching_1({tag,V}) -> + {ok,V}. + +do_tuple_matching_2(Tuple) when is_tuple(Tuple) -> + Size = tuple_size(Tuple), + if + Size =:= 2 -> + {ok,element(2, Tuple)} + end. + +do_tuple_matching_3(Tuple) when is_tuple(Tuple) -> + Size = tuple_size(Tuple), + if + Size =:= 2 -> + 2 = id(Size), + {ok,element(2, Tuple)} + end. + +is_two_tuple(Arg) -> + case is_tuple(Arg) of + false -> false; + true -> tuple_size(Arg) == 2 + end. + +-record(reporter_state, {res,run_config}). +-record(run_config, {report_interval=0}). + +recv(_Config) -> + Parent = self(), + + %% Test sync_wait_mon/2. + Succ = fun() -> Parent ! {ack,self(),{result,42}} end, + {result,42} = sync_wait_mon(spawn_monitor(Succ), infinity), + + Down = fun() -> exit(down) end, + {error,down} = sync_wait_mon(spawn_monitor(Down), infinity), + + Exit = fun() -> + Self = self(), + spawn(fun() -> exit(Self, kill_me) end), + receive _ -> ok end + end, + {error,kill_me} = sync_wait_mon(spawn_monitor(Exit), infinity), + + Timeout = fun() -> receive _ -> ok end end, + {error,timeout} = sync_wait_mon(spawn_monitor(Timeout), 0), + + %% Test reporter_loop/1. + {a,Parent} = reporter_loop(#reporter_state{res={a,Parent}, + run_config=#run_config{}}), + + %% Test bad_sink/0. + bad_sink(), + + %% Test tricky_recv_1/0. + self() ! 1, + a = tricky_recv_1(), + self() ! 2, + b = tricky_recv_1(), + + %% Test tricky_recv_2/0. + self() ! 1, + {1,yes} = tricky_recv_2(), + self() ! 2, + {2,maybe} = tricky_recv_2(), + + %% Test 'receive after infinity' in try/catch. + Pid = spawn(fun recv_after_inf_in_try/0), + exit(Pid, done), + + %% Test tricky_recv_3(). + self() ! {{self(),r0},{1,42,"name"}}, + {Parent,r0,[<<1:32,1:8,42:8>>,"name",0]} = tricky_recv_3(), + self() ! {{self(),r1},{2,99,<<"data">>}}, + {Parent,r1,<<1:32,2:8,99:8,"data">>} = tricky_recv_3(), + + %% Test tricky_recv_4(). + self() ! {[self(),r0],{1,42,"name"}}, + {Parent,r0,[<<1:32,1:8,42:8>>,"name",0]} = tricky_recv_4(), + self() ! {[self(),r1],{2,99,<<"data">>}}, + {Parent,r1,<<1:32,2:8,99:8,"data">>} = tricky_recv_4(), + + %% Test tricky_recv_5/0. + self() ! 1, + a = tricky_recv_5(), + self() ! 2, + b = tricky_recv_5(), + + %% tricky_recv_6/0 is a compile-time error. + tricky_recv_6(), + + ok. + +sync_wait_mon({Pid, Ref}, Timeout) -> + receive + {ack,Pid,Return} -> + erlang:demonitor(Ref, [flush]), + Return; + {'DOWN',Ref,_Type,Pid,Reason} -> + {error,Reason}; + {'EXIT',Pid,Reason} -> + erlang:demonitor(Ref, [flush]), + {error,Reason} + after Timeout -> + erlang:demonitor(Ref, [flush]), + exit(Pid, kill), + {error,timeout} + end. + +reporter_loop(State) -> + RC = State#reporter_state.run_config, + receive after RC#run_config.report_interval -> + State#reporter_state.res + end. + +bad_sink() -> + {ok,Pid} = my_spawn(self()), + %% The get_tuple_element instruction for the matching + %% above was sinked into the receive loop. That will + %% not work (and would be bad for performance if it + %% would work). + receive + {ok,Pid} -> + ok; + error -> + exit(failed) + end, + exit(Pid, kill). + +my_spawn(Parent) -> + Pid = spawn(fun() -> + Parent ! {ok,self()}, + receive _ -> ok end + end), + {ok,Pid}. + +tricky_recv_1() -> + receive + X=1 -> + id(42), + a; + X=2 -> + b + end, + case X of + 1 -> a; + 2 -> b + end. + +tricky_recv_2() -> + receive + X=1 -> + Y = case id(X) of + 1 -> yes; + _ -> no + end, + a; + X=2 -> + Y = maybe, + b + end, + {X,Y}. + +recv_after_inf_in_try() -> + try + %% Used to crash beam_kernel_to_ssa. + receive after infinity -> ok end + catch + _A:_B -> + receive after infinity -> ok end + end. + +tricky_recv_3() -> + {Pid, R, Request} = + receive + {{Pid0,R0}, {1, Proto0, Name0}} -> + {Pid0, R0, + [<<1:32, 1:8, Proto0:8>>,Name0,0]}; + {{Pid1,R1}, {2, Proto1, Data1}} -> + {Pid1, R1, + <<1:32, 2:8, Proto1:8, Data1/binary>>} + end, + id({Pid,R,Request}). + +tricky_recv_4() -> + {Pid, R, Request} = + receive + {[Pid0,R0], {1, Proto0, Name0}} -> + {Pid0, R0, + [<<1:32, 1:8, Proto0:8>>,Name0,0]}; + {[Pid1,R1], {2, Proto1, Data1}} -> + {Pid1, R1, + <<1:32, 2:8, Proto1:8, Data1/binary>>} + end, + id({Pid,R,Request}). + +%% beam_ssa_pre_codegen would accidentally create phi nodes on critical edges +%% when fixing up receives; the call to id/2 can either succeed or land in the +%% catch block, and we added a phi node to its immediate successor. +tricky_recv_5() -> + try + receive + X=1 -> + id(42), + a; + X=2 -> + b + end, + case X of + 1 -> a; + 2 -> b + end + catch + _:_ -> c + end. + +%% When fixing tricky_recv_5, we introduced a compiler crash when the common +%% exit block was ?BADARG_BLOCK and floats were in the picture. +tricky_recv_6() -> + RefA = make_ref(), + RefB = make_ref(), + receive + {RefA, Number} -> Number + 1.0; + {RefB, Number} -> Number + 2.0 + after 0 -> + ok + end. + +maps(_Config) -> + {'EXIT',{{badmatch,#{}},_}} = (catch maps_1(any)), + ok. + +maps_1(K) -> + _ = id(42), + #{K:=V} = #{}, + V. + +-record(wx_ref, {type=any_type,ref=any_ref}). + +cover_ssa_dead(_Config) -> + str = format_str(str, escapable, [], true), + [iolist,str] = format_str(str, escapable, iolist, true), + bad = format_str(str, not_escapable, [], true), + bad = format_str(str, not_escapable, iolist, true), + bad = format_str(str, escapable, [], false), + bad = format_str(str, escapable, [], bad), + + DefWxRef = #wx_ref{}, + {DefWxRef,77,9999,[]} = contains(#wx_ref{}, 77, 9999), + {DefWxRef,77.0,9999,[]} = contains(#wx_ref{}, 77.0, 9999), + {DefWxRef,77,9999.0,[]} = contains(#wx_ref{}, 77, 9999.0), + {DefWxRef,77.0,9999.0,[]} = contains(#wx_ref{}, 77.0, 9999.0), + {any_type,any_ref,42,43,[option]} = contains(#wx_ref{}, {42,43}, [option]), + {any_type,any_ref,42,43,[]} = contains(#wx_ref{}, {42,43}, []), + {any_type,any_ref,42.0,43,[]} = contains(#wx_ref{}, {42.0,43}, []), + {any_type,any_ref,42,43.0,[]} = contains(#wx_ref{}, {42,43.0}, []), + {any_type,any_ref,42.0,43.0,[]} = contains(#wx_ref{}, {42.0,43.0}, []), + + nope = conv_alub(false, '=:='), + ok = conv_alub(true, '=:='), + ok = conv_alub(true, none), + error = conv_alub(false, none), + + {false,false} = eval_alu(false, false, false), + {true,false} = eval_alu(false, false, true), + {false,true} = eval_alu(false, true, false), + {false,false} = eval_alu(false, true, true), + {false,true} = eval_alu(true, false, false), + {false,false} = eval_alu(true, false, true), + {true,true} = eval_alu(true, true, false), + {false,true} = eval_alu(true, true, true), + + 100.0 = percentage(1.0, 0.0), + 100.0 = percentage(1, 0), + 0.0 = percentage(0, 0), + 0.0 = percentage(0.0, 0.0), + 40.0 = percentage(4.0, 10.0), + 60.0 = percentage(6, 10), + + %% Cover '=:=', followed by '=/='. + false = 'cover__=:=__=/='(41), + true = 'cover__=:=__=/='(42), + false = 'cover__=:=__=/='(43), + + %% Cover '<', followed by '=/='. + true = 'cover__<__=/='(41), + false = 'cover__<__=/='(42), + false = 'cover__<__=/='(43), + + %% Cover '=<', followed by '=/='. + true = 'cover__=<__=/='(41), + true = 'cover__=<__=/='(42), + false = 'cover__=<__=/='(43), + + %% Cover '>=', followed by '=/='. + false = 'cover__>=__=/='(41), + true = 'cover__>=__=/='(42), + true = 'cover__>=__=/='(43), + + %% Cover '>', followed by '=/='. + false = 'cover__>__=/='(41), + false = 'cover__>__=/='(42), + true = 'cover__>__=/='(43), + + ok. + +'cover__=:=__=/='(X) when X =:= 42 -> X =/= 43; +'cover__=:=__=/='(_) -> false. + +'cover__<__=/='(X) when X < 42 -> X =/= 42; +'cover__<__=/='(_) -> false. + +'cover__=<__=/='(X) when X =< 42 -> X =/= 43; +'cover__=<__=/='(_) -> false. + +'cover__>=__=/='(X) when X >= 42 -> X =/= 41; +'cover__>=__=/='(_) -> false. + +'cover__>__=/='(X) when X > 42 -> X =/= 42; +'cover__>__=/='(_) -> false. + +format_str(Str, FormatData, IoList, EscChars) -> + Escapable = FormatData =:= escapable, + case id(Str) of + IoStr when Escapable, EscChars, IoList == [] -> + id(IoStr); + IoStr when Escapable, EscChars -> + [IoList,id(IoStr)]; + _ -> + bad + end. + +contains(This, X, Y) when is_record(This, wx_ref), is_number(X), is_number(Y) -> + {This,X,Y,[]}; +contains(#wx_ref{type=ThisT,ref=ThisRef}, {CX,CY}, Options) + when is_number(CX), is_number(CY), is_list(Options) -> + {ThisT,ThisRef,CX,CY,Options}. + +conv_alub(HasDst, CmpOp) -> + case (not HasDst) andalso CmpOp =/= none of + true -> nope; + false -> + case HasDst of + false -> error; + true -> ok + end + end. + +eval_alu(Sign1, Sign2, N) -> + V = (Sign1 andalso Sign2 andalso (not N)) + or ((not Sign1) andalso (not Sign2) andalso N), + C = (Sign1 andalso Sign2) + or ((not N) andalso (Sign1 orelse Sign2)), + {V,C}. + +percentage(Divident, Divisor) -> + if Divisor == 0 andalso Divident /= 0 -> + 100.0; + Divisor == 0 -> + 0.0; + true -> + Divident / Divisor * 100 + end. + +combine_sw(_Config) -> + [a] = do_comb_sw_1(a), + [b,b] = do_comb_sw_1(b), + [c] = do_comb_sw_1(c), + [c] = do_comb_sw_1(c), + [] = do_comb_sw_1(z), + + [a] = do_comb_sw_2(a), + [b2,b1] = do_comb_sw_2(b), + [c] = do_comb_sw_2(c), + [c] = do_comb_sw_2(c), + [] = do_comb_sw_2(z), + + ok. + +do_comb_sw_1(X) -> + put(?MODULE, []), + if + X == a; X == b -> + put(?MODULE, [X|get(?MODULE)]); + true -> + ok + end, + if + X == b; X == c -> + put(?MODULE, [X|get(?MODULE)]); + true -> + ok + end, + erase(?MODULE). + +do_comb_sw_2(X) -> + put(?MODULE, []), + case X of + a -> + put(?MODULE, [a|get(?MODULE)]); + b -> + put(?MODULE, [b1|get(?MODULE)]); + _ -> + ok + end, + case X of + b -> + put(?MODULE, [b2|get(?MODULE)]); + c -> + put(?MODULE, [c|get(?MODULE)]); + _ -> + ok + end, + erase(?MODULE). + +share_opt(_Config) -> + ok = do_share_opt_1(0), + ok = do_share_opt_2(), + ok. + +do_share_opt_1(A) -> + %% The compiler would be stuck in an infinite loop in beam_ssa_share. + case A of + 0 -> a; + 1 -> b; + 2 -> c + end, + receive after 1 -> ok end. + +do_share_opt_2() -> + ok = sopt_2({[pointtopoint], [{dstaddr,any}]}, ok), + ok = sopt_2({[broadcast], [{broadaddr,any}]}, ok), + ok = sopt_2({[], []}, ok), + ok. + +sopt_2({Flags, Opts}, ok) -> + Broadcast = lists:member(broadcast, Flags), + P2P = lists:member(pointtopoint, Flags), + case Opts of + %% The following two clauses would be combined to one, silently + %% discarding the guard test of the P2P variable. + [{broadaddr,_}|Os] when Broadcast -> + sopt_2({Flags, Os}, ok); + [{dstaddr,_}|Os] when P2P -> + sopt_2({Flags, Os}, ok); + [] -> + ok + end. + +beam_ssa_dead_crash(_Config) -> + not_A_B = do_beam_ssa_dead_crash(id(false), id(true)), + not_A_not_B = do_beam_ssa_dead_crash(false, false), + neither = do_beam_ssa_dead_crash(true, false), + neither = do_beam_ssa_dead_crash(true, true), + ok. + +do_beam_ssa_dead_crash(A, B) -> + %% beam_ssa_dead attempts to shortcut branches that branch other + %% branches. When a two-way branch is encountered, beam_ssa_dead + %% will simulate execution along both paths, in the hope that both + %% paths happens to end up in the same place. + %% + %% During the simulated execution of this function, the boolean + %% varible for a `br` instruction would be replaced with the + %% literal atom `nil`, which is not allowed, and would crash the + %% compiler. In practice, during the actual execution, control + %% would never be transferred to that `br` instruction when the + %% variable in question had the value `nil`. + %% + %% beam_ssa_dead has been updated to immediately abort the search + %% along the current path if there is an attempt to substitute a + %% non-boolean value into a `br` instruction. + + case + case not A of + false -> + false; + true -> + B + end + of + V + when + V /= nil + andalso + V /= false -> + not_A_B; + _ -> + case + case not A of + false -> + false; + true -> + not B + end + of + true -> + not_A_not_B; + false -> + neither + end + end. + +stack_init(_Config) -> + 6 = stack_init(a, #{a => [1,2,3]}), + 0 = stack_init(missing, #{}), + ok. + +stack_init(Key, Map) -> + %% beam_ssa_codegen would wrongly assume that y(0) would always be + %% initialized by the `get_map_elements` instruction that follows, and + %% would set up the stack frame using an `allocate` instruction and + %% would not generate an `init` instruction to initialize y(0). + Res = case Map of + #{Key := Elements} -> + %% Elements will be assigned to y(0) if the key Key exists. + lists:foldl(fun(El, Acc) -> + Acc + El + end, 0, Elements); + #{} -> + %% y(0) will be left uninitialized when the key is not + %% present in the map. + 0 + end, + %% y(0) would be uninitialized here if the key was not present in the map + %% (if the second clause was executed). + id(Res). + +%% The identity function. +id(I) -> I. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 9f691716e3..a99dee48aa 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -21,9 +21,11 @@ -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,record_float/1,binary_float/1,float_compare/1, - arity_checks/1,elixir_binaries/1,find_best/1]). + integers/1,numbers/1,coverage/1,booleans/1,setelement/1, + cons/1,tuple/1,record_float/1,binary_float/1,float_compare/1, + arity_checks/1,elixir_binaries/1,find_best/1, + test_size/1,cover_lists_functions/1,list_append/1,bad_binary_unit/1, + none_argument/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -33,6 +35,7 @@ all() -> groups() -> [{p,[parallel], [integers, + numbers, coverage, booleans, setelement, @@ -43,7 +46,12 @@ groups() -> float_compare, arity_checks, elixir_binaries, - find_best + find_best, + test_size, + cover_lists_functions, + list_append, + bad_binary_unit, + none_argument ]}]. init_per_suite(Config) -> @@ -113,8 +121,8 @@ do_integers_4(_, _, Res) -> Res. do_integers_5(X0, Y0) -> - %% X and Y will use the same register. - X = X0 band 1, + %% _X and Y will use the same register. + _X = X0 band 1, Y = Y0 band 3, case Y of 0 -> zero; @@ -123,6 +131,59 @@ do_integers_5(X0, Y0) -> 3 -> three end. +numbers(_Config) -> + Int = id(42), + true = is_integer(Int), + true = is_number(Int), + false = is_float(Int), + + Float = id(42.0), + true = is_float(Float), + true = is_number(Float), + false = is_integer(Float), + + Number = id(1) + id(2), + true = is_number(Number), + true = is_integer(Number), + false = is_float(Number), + + AnotherNumber = id(99.0) + id(1), + true = is_float(AnotherNumber), + true = is_number(AnotherNumber), + false = is_integer(AnotherNumber), + + NotNumber = id(atom), + true = is_atom(NotNumber), + false = is_number(NotNumber), + false = is_integer(NotNumber), + false = is_float(NotNumber), + + true = is_number(Int), + true = is_number(Float), + true = is_number(Number), + true = is_number(AnotherNumber), + + %% Cover beam_ssa_type:join/2. + + Join1 = case id(a) of + a -> 3 + id(7); %Number. + b -> id(5) / id(2) %Float. + end, + true = is_integer(Join1), + + Join2 = case id(a) of + a -> id(5) / 2; %Float. + b -> 3 + id(7) %Number. + end, + true = is_float(Join2), + + %% Cover beam_ssa_type:meet/2. + + Meet1 = id(0) + -10.0, %Float. + 10.0 = abs(Meet1), %Number. + + ok. + coverage(Config) -> {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5), {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2), @@ -164,30 +225,127 @@ coverage(Config) -> ok. booleans(_Config) -> - {'EXIT',{{case_clause,_},_}} = (catch do_booleans(42)), + {'EXIT',{{case_clause,_},_}} = (catch do_booleans_1(42)), + + ok = do_booleans_2(42, 41), + error = do_booleans_2(42, 42), + + AnyAtom = id(atom), + true = is_atom(AnyAtom), + false = is_boolean(AnyAtom), + + MaybeBool = id(maybe), + case MaybeBool of + true -> ok; + maybe -> ok; + false -> ok + end, + false = is_boolean(MaybeBool), + + NotBool = id(a), + case NotBool of + a -> ok; + b -> ok; + c -> ok + end, + false = is_boolean(NotBool), + ok. -do_booleans(B) -> +do_booleans_1(B) -> case is_integer(B) of yes -> yes; no -> no end. +do_booleans_2(A, B) -> + Not = not do_booleans_cmp(A, B), + case Not of + true -> + case Not of + true -> error; + false -> ok + end; + false -> ok + end. + +do_booleans_cmp(A, B) -> A > B. + setelement(_Config) -> T0 = id({a,42}), {a,_} = T0, {b,_} = setelement(1, T0, b), + {z,b} = do_setelement_1(<<(id(1)):32>>, {a,b}, z), + {new,two} = do_setelement_2(<<(id(1)):1>>, {one,two}, new), ok. +do_setelement_1(<<N:32>>, Tuple, NewValue) -> + _ = element(N, Tuple), + %% While updating the type for Tuple, beam_ssa_type would do: + %% maps:without(lists:seq(0, 4294967295), Elements) + setelement(N, Tuple, NewValue). + +do_setelement_2(<<N:1>>, Tuple, NewValue) -> + %% Cover the second clause in remove_element_info/2. The + %% type for the second element will be kept. + two = element(2, Tuple), + setelement(N, Tuple, NewValue). + cons(_Config) -> [did] = cons(assigned, did), + + true = cons_is_empty_list([]), + false = cons_is_empty_list([a]), + + false = cons_not(true), + true = cons_not(false), + + {$a,"bc"} = cons_hdtl(true), + {$d,"ef"} = cons_hdtl(false), ok. cons(assigned, Instrument) -> [Instrument] = [did]. +cons_is_empty_list(L) -> + Cons = case L of + [] -> "true"; + _ -> "false" + end, + id(1), + case Cons of + "true" -> true; + "false" -> false + end. + +cons_not(B) -> + Cons = case B of + true -> "true"; + false -> "false" + end, + id(1), + case Cons of + "true" -> false; + "false" -> true + end. + +cons_hdtl(B) -> + Cons = case B of + true -> "abc"; + false -> "def" + end, + id(1), + {id(hd(Cons)),id(tl(Cons))}. + +-record(bird, {a=a,b=id(42)}). + tuple(_Config) -> {'EXIT',{{badmatch,{necessary}},_}} = (catch do_tuple()), + + [] = [X || X <- [], #bird{a = a} == {r,X,foo}], + [] = [X || X <- [], #bird{b = b} == {bird,X}], + [] = [X || X <- [], 3 == X#bird.a], + ok. do_tuple() -> @@ -324,6 +482,62 @@ find_best([], <<"a">>) -> find_best([], nil) -> {error,<<"should not get here">>}. +test_size(_Config) -> + 2 = do_test_size({a,b}), + 4 = do_test_size(<<42:32>>), + ok. + +do_test_size(Term) when is_tuple(Term) -> + size(Term); +do_test_size(Term) when is_binary(Term) -> + size(Term). + +cover_lists_functions(Config) -> + case lists:suffix([no|Config], Config) of + true -> + ct:fail(should_be_false); + false -> + ok + end, + Zipped = lists:zipwith(fun(A, B) -> {A,B} end, + lists:duplicate(length(Config), zip), + Config), + true = is_list(Zipped), + ok. + +list_append(_Config) -> + %% '++'/2 has a quirk where it returns the right-hand argument as-is when + %% the left-hand is []. + hello = id([]) ++ id(hello), + ok. + +%% OTP-15872: The compiler would treat the "Unit" of bs_init instructions as +%% the unit of the result instead of the required unit of the input, causing +%% is_binary checks to be wrongly optimized away. +bad_binary_unit(_Config) -> + Bin = id(<<1,2,3>>), + Bitstring = <<Bin/binary,1:1>>, + false = is_binary(Bitstring), + ok. + +%% ERL-1013: The compiler would crash during the type optimization pass. +none_argument(_Config) -> + Binary = id(<<3:16, 42>>), + error = id(case Binary of + <<Len:16, Body/binary>> when length(Body) == Len - 2 -> + %% The type for Body will be none. It means + %% that this clause will never match and that + %% uncompress/1 will never be called. + uncompress(Body); + _ -> + error + end), + ok. + +uncompress(CompressedBinary) -> + %% The type for CompressedBinary is none, which beam_ssa_type + %% did not handle properly. + zlib:uncompress(CompressedBinary). id(I) -> I. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index ff0f72d519..eb0af59f9d 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -197,7 +197,7 @@ do_bs_init_4(Arg1, Arg2) -> id(Rewrite) end/binary, "/shared">>); - Other -> + _Other -> error end. @@ -553,7 +553,7 @@ not_used_p(_C, S, K, L) when is_record(K, k) -> id(K) end. -is_used_fr(Config) -> +is_used_fr(_Config) -> 1 = is_used_fr(self(), self()), 1 = is_used_fr(self(), other), receive 1 -> ok end, @@ -572,7 +572,7 @@ is_used_fr(X, Y) -> X ! 1. %% ERL-778. -unsafe_is_function(Config) -> +unsafe_is_function(_Config) -> {undefined,any} = unsafe_is_function(undefined, any), {ok,any} = unsafe_is_function(fun() -> ok end, any), {'EXIT',{{case_clause,_},_}} = (catch unsafe_is_function(fun(_) -> ok end, any)), diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index d3e544a9cc..20f6cb2691 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -34,7 +34,8 @@ undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, - receive_stacked/1]). + receive_stacked/1,aliased_types/1,type_conflict/1, + infer_on_eq/1,infer_dead_value/1]). -include_lib("common_test/include/ct.hrl"). @@ -63,7 +64,8 @@ groups() -> undef_label,illegal_instruction,failing_gc_guard_bif, map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, - receive_stacked]}]. + receive_stacked,aliased_types,type_conflict, + infer_on_eq,infer_dead_value]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -107,13 +109,12 @@ xrange(Config) when is_list(Config) -> Errors = do_val(xrange, Config), [{{t,sum_1,2}, {{bif,'+',{f,0},[{x,-1},{x,1}],{x,0}},4, - {uninitialized_reg,{x,-1}}}}, + {bad_register,{x,-1}}}}, {{t,sum_2,2}, - {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4, - {uninitialized_reg,{x,1023}}}}, + {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4,limit}}, {{t,sum_3,2}, {{bif,'+',{f,0},[{x,0},{x,1}],{x,-1}},4, - {invalid_store,{x,-1},number}}}, + {bad_register,{x,-1}}}}, {{t,sum_4,2}, {{bif,'+',{f,0},[{x,0},{x,1}],{x,1023}},4,limit}}] = Errors, ok. @@ -122,15 +123,15 @@ yrange(Config) when is_list(Config) -> Errors = do_val(yrange, Config), [{{t,sum_1,2}, {{move,{x,1},{y,-1}},5, - {invalid_store,{y,-1},term}}}, + {bad_register,{y,-1}}}}, {{t,sum_2,2}, {{bif,'+',{f,0},[{x,0},{y,1024}],{x,0}},7, - {uninitialized_reg,{y,1024}}}}, + limit}}, {{t,sum_3,2}, {{move,{x,1},{y,1024}},5,limit}}, {{t,sum_4,2}, {{move,{x,1},{y,-1}},5, - {invalid_store,{y,-1},term}}}] = Errors, + {bad_register,{y,-1}}}}] = Errors, ok. stack(Config) when is_list(Config) -> @@ -157,9 +158,9 @@ 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,1,{extfunc,erlang,exit,1}}, - 10, - {uninitialized_reg,{y,0}}}}] = Errors, + {{call_ext,2,{extfunc,debug,filter,2}}, + 22, + {uninitialized_reg,{y,_}}}}] = Errors, ok. uninit(Config) when is_list(Config) -> @@ -178,7 +179,7 @@ unsafe_catch(Config) when is_list(Config) -> Errors = do_val(unsafe_catch, Config), [{{t,small,2}, {{bs_put_integer,{f,0},{integer,16},1, - {field_flags,[unsigned,big]},{y,0}}, + {field_flags,[unsigned,big]},{y,0}}, 20, {unassigned,{y,0}}}}] = Errors, ok. @@ -211,19 +212,19 @@ bad_catch_try(Config) when is_list(Config) -> Errors = do_val(bad_catch_try, Config), [{{bad_catch_try,bad_1,1}, {{'catch',{x,0},{f,3}}, - 5,{invalid_store,{x,0},{catchtag,[3]}}}}, + 5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_2,1}, {{catch_end,{x,9}}, - 8,{source_not_y_reg,{x,9}}}}, + 8,{invalid_tag_register,{x,9}}}}, {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}}, + {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}}, {{bad_catch_try,bad_4,1}, - {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}}, + {{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{bad_type,term}}}, + {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}}, {{bad_catch_try,bad_6,1}, {{move,{integer,1},{y,1}},7, - {invalid_store,{y,1},{integer,1}}}}] = Errors, + {invalid_store,{y,1}}}}] = Errors, ok. cons_guard(Config) when is_list(Config) -> @@ -247,7 +248,7 @@ freg_range(Config) when is_list(Config) -> {{t,sum_3,2}, {{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,-1}}, 7, - {bad_target,{fr,-1}}}}, + {bad_register,{fr,-1}}}}, {{t,sum_4,2}, {{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,1024}}, 7, @@ -539,37 +540,37 @@ receive_stacked(Config) -> [{{receive_stacked,f1,0}, {{loop_rec_end,{f,3}}, 17, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f2,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f3,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f4,0}, - {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}}, + {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}}, {{receive_stacked,f5,0}, {{loop_rec_end,{f,23}}, 23, - {fragile_message_reference,{y,1}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f6,0}, - {{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}}, + {{gc_bif,byte_size,{f,29},0,[{y,_}],{x,0}}, 12, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f7,0}, {{loop_rec_end,{f,33}}, 20, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,f8,0}, {{loop_rec_end,{f,38}}, 20, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,m1,0}, {{loop_rec_end,{f,43}}, 19, - {fragile_message_reference,{y,0}}}}, + {fragile_message_reference,{y,_}}}}, {{receive_stacked,m2,0}, {{loop_rec_end,{f,48}}, 33, - {fragile_message_reference,{y,0}}}}] = Errors, + {fragile_message_reference,{y,_}}}}] = Errors, %% Compile the original source code as a smoke test. Data = proplists:get_value(data_dir, Config), @@ -579,6 +580,148 @@ receive_stacked(Config) -> ok. +aliased_types(Config) -> + Seq = lists:seq(1, 5), + 1 = aliased_types_1(Seq, Config), + + {1,1} = aliased_types_2(Seq), + {42,none} = aliased_types_2([]), + + gurka = aliased_types_3([gurka]), + gaffel = aliased_types_3([gaffel]), + + ok. + +%% ERL-735: validator failed to track types on aliased registers, rejecting +%% legitimate optimizations. +%% +%% move x0 y0 +%% bif hd L1 x0 +%% get_hd y0 %% The validator failed to see that y0 was a list +%% +aliased_types_1(Bug, Config) -> + if + Config =/= [gurka, gaffel] -> %% Pointless branch. + _ = hd(Bug), + lists:seq(1, 5), + hd(Bug) + end. + +%% ERL-832: validator failed to realize that a Y register was a cons. +aliased_types_2(Bug) -> + Res = case Bug of + [] -> id(42); + _ -> hd(Bug) + end, + {Res,case Bug of + [] -> none; + _ -> hd(Bug) + end}. + +%% ERL-832 part deux; validator failed to realize that an aliased register was +%% a cons. +aliased_types_3(Bug) -> + List = [Y || Y <- Bug], + case List of + [] -> Bug; + _ -> + if + hd(List) -> a:a(); + true -> ok + end, + hd(List) + end. + + +%% ERL-867; validation proceeded after a type conflict, causing incorrect types +%% to be joined. + +-record(r, { e1 = e1, e2 = e2 }). + +type_conflict(Config) when is_list(Config) -> + {e1, e2} = type_conflict_1(#r{}), + ok. + +type_conflict_1(C) -> + Src = id(C#r.e2), + TRes = try id(Src) of + R -> R + catch + %% C:R can never match, yet it assumed that the type of 'C' was + %% an atom from here on. + C:R -> R + end, + {C#r.e1, TRes}. + +%% ERL-886; validation failed to infer types on both sides of '=:=' + +infer_on_eq(Config) when is_list(Config) -> + {ok, gurka} = infer_on_eq_1(id({gurka})), + {ok, gaffel} = infer_on_eq_2(id({gaffel})), + {ok, elefant} = infer_on_eq_3(id({elefant})), + {ok, myra} = infer_on_eq_4(id({myra})), + ok. + +infer_on_eq_1(T) -> + 1 = erlang:tuple_size(T), + {ok, erlang:element(1, T)}. + +infer_on_eq_2(T) -> + Size = erlang:tuple_size(T), + Size = 1, + {ok, erlang:element(1, T)}. + +infer_on_eq_3(T) -> + true = 1 =:= erlang:tuple_size(T), + {ok, erlang:element(1, T)}. + +infer_on_eq_4(T) -> + true = erlang:tuple_size(T) =:= 1, + {ok, erlang:element(1, T)}. + +%% ERIERL-348; types were inferred for dead values, causing validation to fail. + +-record(idv, {key}). + +infer_dead_value(Config) when is_list(Config) -> + a = idv_1({a, b, c, d, e, f, g}, {0, 0, 0, 0, 0, 0, 0}), + b = idv_1({a, b, c, d, 0, 0, 0}, {a, b, c, d, 0, 0, 0}), + c = idv_1({0, 0, 0, 0, 0, f, g}, {0, 0, 0, 0, 0, f, g}), + error = idv_1(gurka, gaffel), + + ok = idv_2(id(#idv{})), + + ok. + +idv_1({_A, _B, _C, _D, _E, _F, _G}, + {0, 0, 0, 0, 0, 0, 0}) -> + a; +idv_1({A, B, C, D,_E, _F, _G}=_Tuple1, + {A, B, C, D, 0, 0, 0}=_Tuple2) -> + b; +idv_1({_A, _B, _C, _D, _E, F, G}, + {0, 0, 0, 0, 0, F, G}) -> + c; +idv_1(_A, _B) -> + error. + +%% ERL-995: The first solution to ERIERL-348 was incomplete and caused +%% validation to fail when living values depended on delayed type inference on +%% "dead" values. + +idv_2(State) -> + Flag = (State#idv.key == undefined), + case id(gurka) of + {_} -> id([Flag]); + _ -> ok + end, + if + Flag -> idv_called_once(State); + true -> ok + end. + +idv_called_once(_State) -> ok. + %%%------------------------------------------------------------------------- transform_remove(Remove, Module) -> @@ -637,3 +780,6 @@ night(Turned) -> ok. participating(_, _, _, _) -> ok. + +id(I) -> + I. diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S b/lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S index a60ca1e89a..c7610971f1 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S @@ -11,5 +11,5 @@ {label,1}. {func_info,{atom,t},{atom,t},1}. {label,2}. - {test,bs_start_match2,{f,1},1,[{x,0},0],{x,0}}. + {test,bs_start_match3,{f,1},1,[{x,0}],{x,0}}. return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S index 481d55045d..aa344807e4 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S +++ b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S @@ -15,8 +15,9 @@ {select_val,{x,0},{f,1},{list,[{atom,gurka},{f,3},{atom,delete},{f,4}]}}. {label,3}. {allocate_heap,2,6,2}. - %% The Y registers are not initialized here. {test,is_eq_exact,{f,5},[{x,0},{atom,ok}]}. + %% This is unreachable since {x,0} is known not to be 'ok'. We should not + %% fail with "uninitialized y registers" on erlang:exit/1 {move,{atom,nisse},{x,0}}. {call_ext,1,{extfunc,erlang,exit,1}}. {label,4}. @@ -29,6 +30,7 @@ {call_ext,2,{extfunc,io,format,2}}. {test,is_ne_exact,{f,6},[{x,0},{atom,ok}]}. {label,5}. + %% The Y registers are not initialized here. {move,{atom,logReader},{x,1}}. {move,{atom,console},{x,0}}. {call_ext,2,{extfunc,debug,filter,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 index cca052a9c4..a878204d16 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S +++ b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S @@ -172,7 +172,7 @@ {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_start_match3,{f,29},1,[{x,0}],{x,0}}. {test,bs_get_integer2, {f,29}, 1, @@ -219,7 +219,7 @@ {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_start_match3,{f,34},1,[{x,0}],{x,0}}. {test,bs_get_integer2, {f,34}, 1, @@ -240,7 +240,7 @@ {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}]}. + {test,is_eq_exact,{f,34},[{y,0},{literal,<<0,1,2,3>>}]}. remove_message. {move,{integer,42},{x,0}}. {line,[{location,"receive_stacked.erl",64}]}. @@ -262,7 +262,7 @@ {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_start_match3,{f,39},1,[{x,0}],{x,1}}. {test,bs_get_integer2, {f,39}, 2, @@ -283,7 +283,7 @@ {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}]}. + {test,is_eq_exact,{f,39},[{x,0},{literal,<<0,1,2,3>>}]}. remove_message. {move,{integer,42},{x,0}}. {line,[{location,"receive_stacked.erl",71}]}. diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl index 42ba5d5365..423a7666af 100644 --- a/lib/compiler/test/bif_SUITE.erl +++ b/lib/compiler/test/bif_SUITE.erl @@ -23,7 +23,7 @@ -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,trunc_and_friends/1,cover_safe_bifs/1]). + beam_validator/1,trunc_and_friends/1,cover_safe_and_pure_bifs/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -35,7 +35,7 @@ groups() -> [{p,[parallel], [beam_validator, trunc_and_friends, - cover_safe_bifs + cover_safe_and_pure_bifs ]}]. init_per_suite(Config) -> @@ -106,7 +106,7 @@ trunc_template(Func, Bif) -> catch error:badarg -> ok end, ok."). -cover_safe_bifs(Config) -> +cover_safe_and_pure_bifs(Config) -> _ = get(), _ = get_keys(a), _ = group_leader(), @@ -118,5 +118,6 @@ cover_safe_bifs(Config) -> _ = processes(), _ = registered(), _ = term_to_binary(Config), + 42 = list_to_integer("2A", 16), ok. diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index ccc49df005..bccd70d6cb 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -27,6 +27,7 @@ -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, + verify_highest_opcode/1, 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, @@ -43,7 +44,8 @@ all() -> groups() -> [{p,[parallel], - [two,test1,fail,float_bin,in_guard,in_catch, + [verify_highest_opcode, + two,test1,fail,float_bin,in_guard,in_catch, nasty_literals,side_effect,opt,otp_7556,float_arith, otp_8054,cover]}]. @@ -68,6 +70,20 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> ok. +verify_highest_opcode(_Config) -> + case ?MODULE of + bs_construct_r21_SUITE -> + {ok,Beam} = file:read_file(code:which(?MODULE)), + case test_lib:highest_opcode(Beam) of + Highest when Highest =< 163 -> + ok; + TooHigh -> + ct:fail({too_high_opcode_for_21,TooHigh}) + end; + _ -> + ok + end. + two(Config) when is_list(Config) -> <<0,1,2,3,4,6,7,8,9>> = two_1([0], [<<1,2,3,4>>,<<6,7,8,9>>]), ok. @@ -153,6 +169,8 @@ l(I_13, I_big1, I_16, Bin) -> [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 16#77,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF, 16#FF,16#FF,16#FF,16#FF,16#FF,16#FF]), + ?T(<< (<<"abc",7:3>>):3/binary >>, + [$a,$b,$c]), %% Mix different units. ?T(<<37558955:(I_16-12)/unit:8,1:1>>, @@ -311,6 +329,9 @@ fail(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch <<0:(-(1 bsl 100))>>), {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-(1 bsl 100))>>), + %% Unaligned sizes with literal binaries. + {'EXIT',{badarg,_}} = (catch <<0,(<<7777:17>>)/binary>>), + ok. float_bin(Config) when is_list(Config) -> diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index a751f6fda5..145a50f4ad 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -24,6 +24,7 @@ -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, + verify_highest_opcode/1, size_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, bin_tail/1,save_restore/1, partitioned_bs_match/1,function_clause/1, @@ -40,8 +41,11 @@ map_and_binary/1,unsafe_branch_caching/1, bad_literals/1,good_literals/1,constant_propagation/1, parse_xml/1,get_payload/1,escape/1,num_slots_different/1, - beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1,erl_689/1, - bs_start_match2_defs/1]). + beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1, + expression_before_match/1,erl_689/1,restore_on_call/1, + restore_after_catch/1,matches_on_parameter/1,big_positions/1, + matching_meets_apply/1,bs_start_match2_defs/1, + exceptions_after_match_failure/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -57,8 +61,9 @@ all() -> [{group,p}]. groups() -> - [{p,[parallel], - [size_shadow,int_float,otp_5269,null_fields,wiger, + [{p,[], + [verify_highest_opcode, + size_shadow,int_float,otp_5269,null_fields,wiger, bin_tail,save_restore, partitioned_bs_match,function_clause,unit, shared_sub_bins,bin_and_float,dec_subidentifiers, @@ -73,8 +78,11 @@ groups() -> map_and_binary,unsafe_branch_caching, bad_literals,good_literals,constant_propagation,parse_xml, get_payload,escape,num_slots_different, - beam_bsm,guard,is_ascii,non_opt_eq,erl_689, - bs_start_match2_defs]}]. + beam_bsm,guard,is_ascii,non_opt_eq, + expression_before_match,erl_689,restore_on_call, + matches_on_parameter,big_positions, + matching_meets_apply,bs_start_match2_defs, + exceptions_after_match_failure]}]. init_per_suite(Config) -> @@ -97,6 +105,20 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> ok. +verify_highest_opcode(_Config) -> + case ?MODULE of + bs_match_r21_SUITE -> + {ok,Beam} = file:read_file(code:which(?MODULE)), + case test_lib:highest_opcode(Beam) of + Highest when Highest =< 163 -> + ok; + TooHigh -> + ct:fail({too_high_opcode_for_21,TooHigh}) + end; + _ -> + ok + end. + size_shadow(Config) when is_list(Config) -> %% Originally OTP-5270. 7 = size_shadow_1(), @@ -250,6 +272,12 @@ bin_tail(Config) when is_list(Config) -> ok = bin_tail_e(<<2:2,1:1,1:5,42:64>>), error = bin_tail_e(<<3:2,1:1,1:5,42:64>>), error = bin_tail_e(<<>>), + + MD5 = erlang:md5(<<42>>), + <<"abc">> = bin_tail_f(<<MD5/binary,"abc">>, MD5, 3), + error = bin_tail_f(<<MD5/binary,"abc">>, MD5, 999), + {'EXIT',{_,_}} = (catch bin_tail_f(<<0:16/unit:8>>, MD5, 0)), + ok. bin_tail_c(Bin, Offset) -> @@ -306,6 +334,14 @@ bin_tail_e_var(Bin) -> <<2:2,_:1,1:5,Tail/binary>> -> Tail; _ -> error end. + +bin_tail_f(Bin, MD5, Size) -> + case Bin of + <<MD5:16/binary, Tail:Size/binary>> -> + Tail; + <<MD5:16/binary, _/binary>> -> + error + end. save_restore(Config) when is_list(Config) -> 0 = save_restore_1(<<0:2,42:6>>), @@ -457,6 +493,15 @@ unit(Config) when is_list(Config) -> 127 = peek7(<<127:7>>), 100 = peek7(<<100:7,19:7>>), fc(peek7, [<<1,2>>], catch peek7(<<1,2>>)), + + 1 = unit_opt(1, -1), + 8 = unit_opt(8, -1), + + <<1:32,"abc">> = unit_opt_2(<<1:32,"abc">>), + <<"def">> = unit_opt_2(<<2:32,"def">>), + {'EXIT',_} = (catch unit_opt_2(<<1:32,33:7>>)), + {'EXIT',_} = (catch unit_opt_2(<<2:32,55:7>>)), + ok. peek1(<<B:8,_/bitstring>>) -> B. @@ -467,6 +512,27 @@ peek8(<<B:8,_/binary>>) -> B. peek16(<<B:16,_/binary-unit:16>>) -> B. +unit_opt(U, X) -> + %% Cover type analysis in beam_ssa_type. + Bin = case U of + 1 -> <<X:7>>; + 8 -> <<X>> + end, + %% The type of Bin will be set to {binary,gcd(1, 8)}. + case Bin of + <<_/binary-unit:8>> -> 8; + <<_/binary-unit:1>> -> 1 + end. + +unit_opt_2(<<St:32,KO/binary>> = Bin0) -> + Bin = if + St =:= 1 -> + Bin0; + St =:= 2 -> + <<KO/binary>> + end, + id(Bin). + shared_sub_bins(Config) when is_list(Config) -> {15,[<<>>,<<5>>,<<4,5>>,<<3,4,5>>,<<2,3,4,5>>]} = sum(<<1,2,3,4,5>>, [], 0), ok. @@ -694,6 +760,20 @@ coverage(Config) when is_list(Config) -> binary = coverage_bitstring(<<7>>), bitstring = coverage_bitstring(<<7:4>>), other = coverage_bitstring([a]), + + %% Cover code in beam_trim. + + {done,<<17,53>>,[253,155,200]} = + coverage_trim(<<253,155,200,17,53>>, e0, e1, e2, e3, []), + + <<"(right|linux)">> = coverage_trim_1(<<"">>, <<"right">>, <<"linux">>), + <<"/(right|linux)">> = coverage_trim_1(<<"/">>, <<"right">>, <<"linux">>), + <<"(left|linux)/(right|linux)">> = + coverage_trim_1(<<"left">>, <<"right">>, <<"linux">>), + + {10,<<"-">>,""} = coverage_trim_2(<<"-">>, 10, []), + {8,<<"-">>,"aa"} = coverage_trim_2(<<"aa-">>, 10, []), + ok. coverage_fold(Fun, Acc, <<H,T/binary>>) -> @@ -788,6 +868,37 @@ coverage_bitstring(Bin) when is_binary(Bin) -> binary; coverage_bitstring(<<_/bitstring>>) -> bitstring; coverage_bitstring(_) -> other. +coverage_trim(<<C:8,T/binary>> = Bin, E0, E1, E2, E3, Acc) -> + case id(C > 128) of + true -> + coverage_trim(T, E0, E1, E2, E3, [C|Acc]); + false -> + {done,Bin,lists:reverse(Acc)} + end. + +coverage_trim_1(<<>>, Right, OsType) -> + do_coverage_trim_1(Right, OsType); +coverage_trim_1(<<"/">>, Right, OsType) -> + <<"/",(do_coverage_trim_1(Right, OsType))/binary>>; +coverage_trim_1(Left, Right, OsType) -> + <<(do_coverage_trim_1(Left, OsType))/binary, + "/", + (do_coverage_trim_1(Right, OsType))/binary>>. + +do_coverage_trim_1(A, OsType) -> + <<"(",A/binary,"|",OsType/binary,")">>. + +coverage_trim_2(<<C/utf8,R/binary>> = Bin, I, L) -> + case printable_char(C) of + true -> + coverage_trim_2(R, I - 1, [C | L]); + false -> + {I,Bin,lists:reverse(L)} + end. + +printable_char($a) -> true; +printable_char(_) -> false. + 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>>), @@ -1754,11 +1865,10 @@ do_erl_689_2b(_, <<Length, Data/binary>>) -> %% ERL-753 bs_start_match2_defs(_Config) -> - {<<"http://127.0.0.1:1234/vsaas/hello">>} = api_url(<<"hello">>, dummy), - {"https://127.0.0.1:4321/vsaas/hello"} = api_url({https, "hello"}, dummy). + {<<"http://127.0.0.1:1234/vsaas/hello">>} = api_url(<<"hello">>), + {"https://127.0.0.1:4321/vsaas/hello"} = api_url({https, "hello"}). -api_url(URL, Auth) -> - Header = [], +api_url(URL) -> case URL of <<_/binary>> -> {<<"http://127.0.0.1:1234/vsaas/",URL/binary>>}; {https, [_|_] = URL1} -> {"https://127.0.0.1:4321/vsaas/"++URL1} @@ -1767,4 +1877,147 @@ api_url(URL, Auth) -> check(F, R) -> R = F(). +%% Make sure that an expression that comes between function start and a match +%% expression passes validation. +expression_before_match(Config) when is_list(Config) -> + <<_,R/binary>> = id(<<0,1,2,3>>), + {1, <<2,3>>} = expression_before_match_1(R), + ok. + +expression_before_match_1(R) -> + A = id(1), + case R of + <<1,Bar/binary>> -> {A, Bar}; + <<>> -> {A, baz} + end. + +%% Make sure that context positions are updated on calls. +restore_on_call(Config) when is_list(Config) -> + ok = restore_on_call_plain(<<0, 1, 2>>), + <<"x">> = restore_on_call_match(<<0, "x">>), + ok. + +restore_on_call_plain(<<0, Rest/binary>>) -> + <<2>> = restore_on_call_plain_1(Rest), + %% {badmatch, <<>>} on missing restore. + <<2>> = restore_on_call_plain_1(Rest), + ok. + +restore_on_call_plain_1(<<1, Rest/binary>>) -> Rest; +restore_on_call_plain_1(Other) -> Other. + +%% Calls a function that moves the match context passed to it, and then matches +%% on its result to confuse the reposition algorithm's success/fail logic. +restore_on_call_match(<<0, Bin/binary>>) -> + case skip_until_zero(Bin) of + {skipped, Rest} -> + Rest; + not_found -> + %% The match context did not get repositioned before the + %% bs_get_tail instruction here. + Bin + end. + +skip_until_zero(<<0,Rest/binary>>) -> + {skipped, Rest}; +skip_until_zero(<<_C,Rest/binary>>) -> + skip_until_zero(Rest); +skip_until_zero(_) -> + not_found. + +%% 'catch' must invalidate positions. +restore_after_catch(Config) when is_list(Config) -> + <<0, 1>> = restore_after_catch_1(<<0, 1>>), + ok. + +restore_after_catch_1(<<A/binary>>) -> + try throw_after_byte(A) of + _ -> impossible + catch + throw:_Any -> + %% Will equal <<1>> if the bug is present. + A + end. + +throw_after_byte(<<_,_/binary>>) -> + throw(away). + +matches_on_parameter(Config) when is_list(Config) -> + %% This improves coverage for matching on "naked" parameters. + {<<"urka">>, <<"a">>} = matches_on_parameter_1(<<"gurka">>), + ok = (catch matches_on_parameter_2(<<"10001110101">>, 0)). + +matches_on_parameter_1(Bin) -> + <<"g", A/binary>> = Bin, + <<_,_,"rk", B/binary>> = Bin, + {A, B}. + +matches_on_parameter_2(Bin, Offset) -> + <<_:Offset, Bit:1, Rest/bits>> = Bin, + case bit_size(Rest) of + 0 -> throw(ok); + _ -> [Bit | matches_on_parameter_2(Bin, Offset + 1)] + end. + +big_positions(Config) when is_list(Config) -> + %% This provides coverage for when match context positions no longer fit + %% into an immediate on 32-bit platforms. + + A = <<0:((1 bsl 27) - 8), $A, 1:1, "gurka", $A>>, + B = <<0:((1 bsl 27) - 8), $B, "hello", $B>>, + + {a,$A} = bp_start_match(A), + {b,$B} = bp_start_match(B), + {a,$A} = bp_getpos(A), + {b,$B} = bp_getpos(B), + + ok. + +%% After the first iteration the context's position will no longer fit into an +%% immediate. To improve performance the bs_start_match3 instruction will +%% return a new context with an updated base position so that we won't have to +%% resort to using bigints. +bp_start_match(<<_:(1 bsl 27),T/bits>>) -> bp_start_match(T); +bp_start_match(<<1:1,"gurka",A>>) -> {a,A}; +bp_start_match(<<"hello",B>>) -> {b,B}. + +%% This is a corner case where the above didn't work perfectly; if the position +%% was _just_ small enough to fit into an immediate when bs_start_match3 was +%% hit, but too large at bs_get_position, then it must be saved as a bigint. +bp_getpos(<<_:((1 bsl 27) - 8),T/bits>>) -> bp_getpos(T); +bp_getpos(<<A,1:1,"gurka",A>>) -> {a,A}; +bp_getpos(<<B,"hello",B>>) -> {b,B}. + +matching_meets_apply(_Config) -> + <<"abc">> = do_matching_meets_apply(<<"/abc">>, []), + 42 = do_matching_meets_apply(<<"">>, {erlang,-42}), + 100 = do_matching_meets_apply(no_binary, {erlang,-100}), + ok. + +do_matching_meets_apply(<<$/, Rest/binary>>, _Handler) -> + id(Rest); +do_matching_meets_apply(<<_/binary>>=Name, never_matches_a) -> + %% Used to crash the compiler because variables in a remote + %% were not handled properly by beam_ssa_bsm. + Name:foo(gurka); +do_matching_meets_apply(<<_/binary>>=Name, never_matches_b) -> + %% Another case of the above. + foo:Name(gurka); +do_matching_meets_apply(_Bin, {Handler, State}) -> + %% Another case of the above. + Handler:abs(State). + +%% Exception handling was broken on the failure path of bs_start_match as +%% beam_ssa_bsm accidentally cloned and renamed the ?BADARG_BLOCK. +exceptions_after_match_failure(_Config) -> + {'EXIT', {badarith, _}} = (catch do_exceptions_after_match_failure(atom)), + ok = do_exceptions_after_match_failure(<<0, 1, "gurka">>), + ok = do_exceptions_after_match_failure(2.0). + +do_exceptions_after_match_failure(<<_A, _B, "gurka">>) -> + ok; +do_exceptions_after_match_failure(Other) -> + Other / 2.0, + ok. + id(I) -> I. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 139f7af0d4..74f9dbd9b4 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -170,7 +170,7 @@ try_it(Module, Conf) -> atom_to_list(Module)), Out = proplists:get_value(priv_dir,Conf), io:format("Compiling: ~s\n", [Src]), - CompRc0 = compile:file(Src, [clint0,clint,{outdir,Out},report, + CompRc0 = compile:file(Src, [clint0,clint,ssalint,{outdir,Out},report, bin_opt_info|OtherOpts]), io:format("Result: ~p\n",[CompRc0]), {ok,_Mod} = CompRc0, @@ -189,7 +189,7 @@ try_it(Module, Conf) -> ct:timetrap(Timetrap), io:format("Compiling (with old inliner): ~s\n", [Src]), - CompRc2 = compile:file(Src, [clint, + CompRc2 = compile:file(Src, [clint,ssalint, {outdir,Out},report,bin_opt_info, {inline,1000}|OtherOpts]), io:format("Result: ~p\n",[CompRc2]), @@ -355,7 +355,7 @@ compile_compiler(Files, OutDir, Version, InlineOpts) -> io:format("~ts", [code:which(compile)]), io:format("Compiling ~s into ~ts", [Version,OutDir]), Opts = [report, - clint0,clint, + clint0,clint,ssalint, bin_opt_info, {outdir,OutDir}, {d,'COMPILER_VSN',"\""++Version++"\""}, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 6b230710b3..53627b9d81 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -28,12 +28,12 @@ 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, + file_1/1, forms_2/1, module_mismatch/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/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, + core_roundtrip/1, asm/1, sys_pre_attributes/1, dialyzer/1, warnings/1, pre_load_check/1, env_compiler_options/1, bc_options/1, deterministic_include/1, deterministic_paths/1 @@ -46,11 +46,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> all_return_type(). all() -> - [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, + [app_test, appup_test, file_1, forms_2, module_mismatch, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, 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, + cover, env, core_pp, core_roundtrip, asm, sys_pre_attributes, dialyzer, warnings, pre_load_check, env_compiler_options, custom_debug_info, bc_options, custom_compile_info, deterministic_include, deterministic_paths]. @@ -104,6 +104,7 @@ file_1(Config) when is_list(Config) -> compile_and_verify(Simple, Target, []), compile_and_verify(Simple, Target, [native]), compile_and_verify(Simple, Target, [debug_info]), + compile_and_verify(Simple, Target, [no_postopt]), {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage {ok,simple} = compile:file(Simple, [{eprof,beam_z}]), %Coverage @@ -231,17 +232,6 @@ module_mismatch(Config) when is_list(Config) -> ok. -big_file(Config) when is_list(Config) -> - {Big,Target} = get_files(Config, big, "big_file"), - ok = file:set_cwd(filename:dirname(Target)), - compile_and_verify(Big, Target, []), - compile_and_verify(Big, Target, [debug_info]), - compile_and_verify(Big, Target, [no_postopt]), - - %% Cleanup. - ok = file:delete(Target), - ok. - %% Tests that the {outdir, Dir} option works. outdir(Config) when is_list(Config) -> @@ -370,41 +360,37 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> TargetDir = filename:join(PrivDir, listings), ok = file:make_dir(TargetDir), - %% Test all dedicated listing options. - do_listing(Simple, TargetDir, 'S'), - do_listing(Simple, TargetDir, 'E'), - do_listing(Simple, TargetDir, 'P'), - do_listing(Simple, TargetDir, dpp, ".pp"), - do_listing(Simple, TargetDir, dabstr, ".abstr"), - do_listing(Simple, TargetDir, dexp, ".expand"), - do_listing(Simple, TargetDir, dcore, ".core"), - do_listing(Simple, TargetDir, doldinline, ".oldinline"), - 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, dcg, ".codegen"), - do_listing(Simple, TargetDir, dblk, ".block"), - do_listing(Simple, TargetDir, dexcept, ".except"), - do_listing(Simple, TargetDir, dbs, ".bs"), - do_listing(Simple, TargetDir, dtype, ".type"), - do_listing(Simple, TargetDir, ddead, ".dead"), - do_listing(Simple, TargetDir, djmp, ".jump"), - do_listing(Simple, TargetDir, dclean, ".clean"), - do_listing(Simple, TargetDir, dpeep, ".peep"), - do_listing(Simple, TargetDir, dopt, ".optimize"), - - %% First clean up. - Listings = filename:join(PrivDir, listings), - lists:foreach(fun(F) -> ok = file:delete(F) end, - filelib:wildcard(filename:join(Listings, "*"))), + List = [{'S',".S"}, + {'E',".E"}, + {'P',".P"}, + {dpp, ".pp"}, + {dabstr, ".abstr"}, + {dexp, ".expand"}, + {dcore, ".core"}, + {doldinline, ".oldinline"}, + {dinline, ".inline"}, + {dcore, ".core"}, + {dcopt, ".copt"}, + {dcbsm, ".core_bsm"}, + {dkern, ".kernel"}, + {dssa, ".ssa"}, + {dssaopt, ".ssaopt"}, + {dprecg, ".precodegen"}, + {dcg, ".codegen"}, + {dblk, ".block"}, + {dexcept, ".except"}, + {djmp, ".jump"}, + {dclean, ".clean"}, + {dpeep, ".peep"}, + {dopt, ".optimize"}, + {diffable, ".S"}], + p_listings(List, Simple, TargetDir), %% Test options that produce a listing file if 'binary' is not given. do_listing(Simple, TargetDir, to_pp, ".P"), do_listing(Simple, TargetDir, to_exp, ".E"), do_listing(Simple, TargetDir, to_core0, ".core"), + Listings = filename:join(PrivDir, listings), ok = file:delete(filename:join(Listings, File ++ ".core")), do_listing(Simple, TargetDir, to_core, ".core"), do_listing(Simple, TargetDir, to_kernel, ".kernel"), @@ -420,21 +406,35 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> listings_big(Config) when is_list(Config) -> {Big,Target} = get_files(Config, big, listings_big), TargetDir = filename:dirname(Target), - do_listing(Big, TargetDir, 'S'), - 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}]), - - %% Cleanup. - ok = file:delete(Target), - lists:foreach(fun(F) -> ok = file:delete(F) end, - filelib:wildcard(filename:join(TargetDir, "*"))), - ok = file:del_dir(TargetDir), - ok. + List = [{'S',".S"}, + {'E',".E"}, + {'P',".P"}, + {dkern, ".kernel"}, + {dssa, ".ssa"}, + {dssaopt, ".ssaopt"}, + {dprecg, ".precodegen"}, + {to_dis, ".dis"}], + p_listings(List, Big, TargetDir). + +p_listings(List, File, BaseDir) -> + Run = fun({Option,Extension}) -> + Uniq = erlang:unique_integer([positive]), + Dir = filename:join(BaseDir, integer_to_list(Uniq)), + ok = file:make_dir(Dir), + try + do_listing(File, Dir, Option, Extension), + ok + catch + Class:Error:Stk -> + io:format("~p:~p\n~p\n", [Class,Error,Stk]), + error + after + _ = [ok = file:delete(F) || + F <- filelib:wildcard(filename:join(Dir, "*"))], + ok = file:del_dir(Dir) + end + end, + test_lib:p_run(Run, List). other_output(Config) when is_list(Config) -> {Simple,_Target} = get_files(Config, simple, "other_output"), @@ -681,9 +681,6 @@ cover(Config) when is_list(Config) -> io:format("~p\n", [compile:options()]), ok. -do_listing(Source, TargetDir, Type) -> - do_listing(Source, TargetDir, Type, "." ++ atom_to_list(Type)). - do_listing(Source, TargetDir, Type, Ext) -> io:format("Source: ~p TargetDir: ~p\n Type: ~p Ext: ~p\n", [Source, TargetDir, Type, Ext]), @@ -920,7 +917,7 @@ do_core_pp_1(M, A, Outdir) -> ok = file:delete(CoreFile), %% Compile as usual (including optimizations). - compile_forms(M, Core, [clint,from_core,binary]), + compile_forms(M, Core, [clint,ssalint,from_core,binary]), %% Don't optimize to test that we are not dependent %% on the Core Erlang optmimization passes. @@ -929,7 +926,7 @@ do_core_pp_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(M, Core, [clint,from_core,no_copt,binary]), + compile_forms(M, Core, [clint,ssalint,from_core,no_copt,binary]), ok. @@ -1170,95 +1167,6 @@ do_asm(Beam, Outdir) -> 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"), @@ -1475,44 +1383,55 @@ env_compiler_options(_Config) -> 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, []), - + L = [{101, small_float, [no_get_hd_tl,no_line_info]}, + {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + no_line_info,no_stack_trimming]}, + {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]}, + + {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + no_ssa_opt_float,no_line_info,no_bsm3]}, + + {153, small, [r20]}, + {153, small, [r21]}, + + {136, big, [no_put_tuple2,no_get_hd_tl, + no_ssa_opt_record,no_line_info]}, + + {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, + {153, big, [r16]}, + {153, big, [r17]}, + {153, big, [r18]}, + {153, big, [r19]}, + {153, small_float, [r16]}, + {153, small_float, []}, + + {158, small_maps, [r17]}, + {158, small_maps, [r18]}, + {158, small_maps, [r19]}, + {158, small_maps, [r20]}, + {158, small_maps, [r21]}, + + {164, small_maps, []}, + {164, big, []} + ], + + Test = fun({Expected,Mod,Options}) -> + case highest_opcode(DataDir, Mod, Options) of + Expected -> + ok; + Got -> + io:format("*** module ~p, options ~p => got ~p; expected ~p\n", + [Mod,Options,Got,Expected]), + error + end + end, + test_lib:p_run(Test, L), 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. + test_lib:highest_opcode(Beam). deterministic_include(Config) when is_list(Config) -> DataDir = proplists:get_value(data_dir, Config), diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover index 3fd7fc1937..fac0f9947c 100644 --- a/lib/compiler/test/compiler.cover +++ b/lib/compiler/test/compiler.cover @@ -1,5 +1,4 @@ -{incl_app,compiler,details}. - %% -*- erlang -*- +{local_only,compiler,true}. +{incl_app,compiler,details}. {excl_mods,compiler,[core_scan,core_parse]}. - diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index e5611e99d1..72016c6d76 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -29,7 +29,8 @@ 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]). + non_variable_apply/1,name_capture/1,fun_letrec_effect/1, + get_map_element/1]). -include_lib("common_test/include/ct.hrl"). @@ -57,7 +58,8 @@ groups() -> 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 + non_variable_apply,name_capture,fun_letrec_effect, + get_map_element ]}]. @@ -95,6 +97,7 @@ end_per_group(_GroupName, Config) -> ?comp(non_variable_apply). ?comp(name_capture). ?comp(fun_letrec_effect). +?comp(get_map_element). try_it(Mod, Conf) -> Src = filename:join(proplists:get_value(data_dir, Conf), diff --git a/lib/compiler/test/core_SUITE_data/get_map_element.core b/lib/compiler/test/core_SUITE_data/get_map_element.core new file mode 100644 index 0000000000..092b5e71eb --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/get_map_element.core @@ -0,0 +1,18 @@ +module 'get_map_element' ['get_map_element'/0] +attributes [] + +'get_map_element'/0 = + fun () -> + apply 'match_map'/1(~{'foo'=>'bar'}~) + +'match_map'/1 = + fun (_0) -> + case _0 of + <~{'foo':='bar'}~> when 'true' -> + 'ok' + %% It will be undefined behaviour at runtime if no + %% clause of the case can be selected. That can't + %% happen for this module, because match_map/1 is + %% always called with a matching map argument. + end +end diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 47606014c3..adfebd5158 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -212,9 +212,14 @@ bifs(Config) when is_list(Config) -> {ok,#{K:=V}} = id(list_to_tuple([ok,#{K=>V}])), ok. --define(CMP_SAME(A0, B), (fun(A) -> true = A == B, false = A /= B end)(id(A0))). --define(CMP_DIFF(A0, B), (fun(A) -> false = A == B, true = A /= B end)(id(A0))). - +-define(CMP_SAME0(A0, B), (fun(A) -> true = A == B, false = A /= B end)(id(A0))). +-define(CMP_SAME1(A0, B), (fun(A) -> false = A /= B, true = A == B end)(id(A0))). +-define(CMP_SAME(A0, B), (true = ?CMP_SAME0(A0, B) =:= not ?CMP_SAME1(A0, B))). + +-define(CMP_DIFF0(A0, B), (fun(A) -> false = A == B, true = A /= B end)(id(A0))). +-define(CMP_DIFF1(A0, B), (fun(A) -> true = A /= B, false = A == B end)(id(A0))). +-define(CMP_DIFF(A0, B), (true = ?CMP_DIFF0(A0, B) =:= not ?CMP_DIFF1(A0, B))). + eq(Config) when is_list(Config) -> ?CMP_SAME([a,b,c], [a,b,c]), ?CMP_SAME([42.0], [42.0]), @@ -278,6 +283,8 @@ coverage(Config) when is_list(Config) -> a = cover_remove_non_vars_alias({a,b,c}), error = cover_will_match_lit_list(), {ok,[a]} = cover_is_safe_bool_expr(a), + false = cover_is_safe_bool_expr2(a), + ok = cover_eval_is_function(fun id/1), ok = cover_opt_guard_try(#cover_opt_guard_try{list=[a]}), error = cover_opt_guard_try(#cover_opt_guard_try{list=[]}), @@ -341,6 +348,15 @@ cover_is_safe_bool_expr(X) -> false end. +cover_is_safe_bool_expr2(X) -> + try + V = [X], + is_function(V, 1) + catch + _:_ -> + false + end. + cover_opt_guard_try(Msg) -> if length(Msg#cover_opt_guard_try.list) =/= 1 -> @@ -349,6 +365,12 @@ cover_opt_guard_try(Msg) -> ok end. +cover_eval_is_function(X) -> + case X of + {a,_} -> is_function(X); + _ -> ok + end. + bsm_an_inlined(<<_:8>>, _) -> ok; bsm_an_inlined(_, _) -> error. @@ -356,7 +378,7 @@ unused_multiple_values_error(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), Dir = test_lib:get_data_dir(Config), Core = filename:join(Dir, "unused_multiple_values_error"), - Opts = [no_copt,clint,return,from_core,{outdir,PrivDir} + Opts = [no_copt,clint,ssalint,return,from_core,{outdir,PrivDir} |test_lib:opt_opts(?MODULE)], {error,[{unused_multiple_values_error, [{none,core_lint,{return_mismatch,{hello,1}}}]}], @@ -480,7 +502,7 @@ source(true, Activities) -> Activities end. -tim(#{reduction := Emergency}) -> +tim(#{reduction := _Emergency}) -> try fun() -> surgery end catch diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 012810aba2..0fa8070dc8 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -20,15 +20,17 @@ -module(float_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1]). + pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1, + subtract_number_type/1,float_followed_by_guard/1]). -include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [pending, bif_calls, math_functions, - mixed_float_and_int]. + mixed_float_and_int, subtract_number_type, + float_followed_by_guard]. groups() -> []. @@ -176,5 +178,31 @@ mixed_float_and_int(Config) when is_list(Config) -> pc(Cov, NotCov, X) -> round(Cov/(Cov+NotCov)*100) + 42 + 2.0*X. +subtract_number_type(Config) when is_list(Config) -> + 120 = fact(5). + +fact(N) -> + fact(N, 1). + +fact(0, P) -> P; +fact(1, P) -> P; +fact(N, P) -> fact(N-1, P*N). + +float_followed_by_guard(Config) when is_list(Config) -> + true = ffbg_1(5, 1), + false = ffbg_1(1, 5), + ok. + +ffbg_1(A, B0) -> + %% This is a non-guard block followed by a *guard block* that starts with a + %% floating point operation, and the compiler erroneously assumed that it + %% was safe to skip fcheckerror because the next block started with a float + %% op. + B = id(B0) / 1.0, + if + A - B > 0.0 -> true; + A - B =< 0.0 -> false + end. + id(I) -> I. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index e00885fcd6..7fc6195e31 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -22,7 +22,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, - external/1,eep37/1,eep37_dup/1,badarity/1,badfun/1]). + external/1,eep37/1,eep37_dup/1,badarity/1,badfun/1, + duplicated_fun/1]). %% Internal exports. -export([call_me/1,dup1/0,dup2/0]). @@ -37,7 +38,7 @@ all() -> groups() -> [{p,[parallel], [test1,overwritten_fun,otp_7202,bif_fun,external,eep37, - eep37_dup,badarity,badfun]}]. + eep37_dup,badarity,badfun,duplicated_fun]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -249,10 +250,32 @@ badfun(_Config) -> expect_badfun(X, catch X(put(?FUNCTION_NAME, of_course))), of_course = erase(?FUNCTION_NAME), + %% A literal as a Fun used to crash the code generator. This only happened + %% when type optimization had reduced `Fun` to a literal, hence the match. + Literal = fun(literal = Fun) -> + Fun() + end, + expect_badfun(literal, catch Literal(literal)), + ok. expect_badfun(Term, Exit) -> {'EXIT',{{badfun,Term},_}} = Exit. +duplicated_fun(_Config) -> + try + %% The following code used to crash the compiler before + %% v3_core:is_safe/1 was corrected to consider fun variables + %% unsafe. + id([print_result_paths_fun = fun duplicated_fun_helper/1]), + ct:error(should_fail) + catch + error:{badmatch,F} when is_function(F, 1) -> + ok + end. + +duplicated_fun_helper(_) -> + ok. + id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 6ad73b46f7..cea7a374cd 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -36,7 +36,7 @@ check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1,bad_guards/1, guard_in_catch/1,beam_bool_SUITE/1, - cover_beam_dead/1]). + repeated_type_tests/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -55,7 +55,7 @@ groups() -> 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,beam_bool_SUITE, - cover_beam_dead]}]. + repeated_type_tests]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -1297,6 +1297,32 @@ rel_ops(Config) when is_list(Config) -> Empty = id([]), ?T(==, [], Empty), + %% Cover beam_ssa_dead:turn_op('/='). + ok = (fun(A, B) when is_atom(A) -> + X = id(A /= B), + if + X -> ok; + true -> error + end + end)(a, b), + ok = (fun(A, B) when is_atom(A) -> + X = id(B /= A), + if + X -> ok; + true -> error + end + end)(a, b), + + %% Cover beam_ssa_dead. + Arrow = fun([T1,T2]) when T1 == $>, T2 == $>; + T1 == $<, T2 == $| -> true; + (_) -> false + end, + true = Arrow(">>"), + true = Arrow("<|"), + false = Arrow("><"), + false = Arrow(""), + ok. -undef(TestOp). @@ -1330,6 +1356,9 @@ rel_op_combinations_1(N, Digits) -> Bool = is_digit_6(N), Bool = is_digit_7(N), Bool = is_digit_8(N), + Bool = is_digit_9(42, N), + Bool = is_digit_10(N, 0), + Bool = is_digit_11(N, 0), rel_op_combinations_1(N-1, Digits). is_digit_1(X) when 16#0660 =< X, X =< 16#0669 -> true; @@ -1373,6 +1402,24 @@ is_digit_8(X) when X =< 16#0669, X > (16#0660-1) -> true; is_digit_8(16#0670) -> false; is_digit_8(_) -> false. +is_digit_9(A, 0) when A =:= 42 -> false; +is_digit_9(_, X) when X > 16#065F, X < 16#066A -> true; +is_digit_9(_, X) when 16#0030 =< X, X =< 16#0039 -> true; +is_digit_9(_, X) when 16#06F0 =< X, X =< 16#06F9 -> true; +is_digit_9(_, _) -> false. + +is_digit_10(0, 0) -> false; +is_digit_10(X, _) when X < 16#066A, 16#0660 =< X -> true; +is_digit_10(X, _) when 16#0030 =< X, X =< 16#0039 -> true; +is_digit_10(X, _) when 16#06F0 =< X, X =< 16#06F9 -> true; +is_digit_10(_, _) -> false. + +is_digit_11(0, 0) -> false; +is_digit_11(X, _) when X =< 16#0669, 16#0660 =< X -> true; +is_digit_11(X, _) when 16#0030 =< X, X =< 16#0039 -> true; +is_digit_11(X, _) when 16#06F0 =< X, X =< 16#06F9 -> true; +is_digit_11(_, _) -> false. + rel_op_combinations_2(0, _) -> ok; rel_op_combinations_2(N, Range) -> @@ -1473,6 +1520,7 @@ rel_op_combinations_3(N, Red) -> Val = redundant_9(N), Val = redundant_10(N), Val = redundant_11(N), + Val = redundant_11(N), rel_op_combinations_3(N-1, Red). redundant_1(X) when X >= 51, X =< 80 -> 5*X; @@ -1527,6 +1575,10 @@ redundant_11(X) when X =:= 10 -> 2*X; redundant_11(X) when X >= 51, X =< 80 -> 5*X; redundant_11(_) -> none. +redundant_12(X) when X >= 50, X =< 80 -> 2*X; +redundant_12(X) when X < 51 -> 5*X; +redundant_12(_) -> none. + %% Test type tests on literal values. (From emulator test suites.) literal_type_tests(Config) when is_list(Config) -> case ?MODULE of @@ -1779,15 +1831,10 @@ t_tuple_size(Config) when is_list(Config) -> error = ludicrous_tuple_size({a,b,c}), error = ludicrous_tuple_size([a,b,c]), - %% Test the "unsafe case" - the register assigned the tuple size is - %% not killed. - DataDir = test_lib:get_data_dir(Config), - File = filename:join(DataDir, "guard_SUITE_tuple_size"), - {ok,Mod,Code} = compile:file(File, [from_asm,binary]), - code:load_binary(Mod, File, Code), - 14 = Mod:t({1,2,3,4}), - _ = code:delete(Mod), - _ = code:purge(Mod), + good_ip({1,2,3,4}), + good_ip({1,2,3,4,5,6,7,8}), + error = validate_ip({42,11}), + error = validate_ip(atom), ok. @@ -1805,6 +1852,16 @@ ludicrous_tuple_size(T) when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok; ludicrous_tuple_size(_) -> error. +good_ip(IP) -> + IP = validate_ip(IP). + +validate_ip(Value) when is_tuple(Value) andalso + ((size(Value) =:= 4) orelse (size(Value) =:= 8)) -> + %% size/1 (converted to tuple_size) used more than once. + Value; +validate_ip(_) -> + error. + %% %% The binary_part/2,3 guard BIFs %% @@ -2206,32 +2263,25 @@ maps() -> 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), - +repeated_type_tests(_Config) -> + binary = repeated_type_test(<<42>>), + bitstring = repeated_type_test(<<1:1>>), + other = repeated_type_test(atom), ok. +repeated_type_test(T) -> + %% Test for a bug in beam_ssa_dead. + if is_bitstring(T) -> + if is_binary(T) -> %This test would be optimized away. + binary; + true -> + bitstring + end; + true -> + other + end. + + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S b/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S deleted file mode 100644 index cffb792920..0000000000 --- a/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S +++ /dev/null @@ -1,30 +0,0 @@ -{module, guard_SUITE_tuple_size}. %% version = 0 - -{exports, [{t,1}]}. - -{attributes, []}. - -{labels, 5}. - - -{function, t, 1, 2}. - {label,1}. - {func_info,{atom,guard_SUITE_tuple_size},{atom,t},1}. - {label,2}. - {bif,tuple_size,{f,4},[{x,0}],{x,1}}. - {test,is_eq_exact,{f,4},[{x,1},{integer,4}]}. - {test,is_tuple,{f,3},[{x,0}]}. - {test,test_arity,{f,3},[{x,0},4]}. - {get_tuple_element,{x,0},0,{x,5}}. - {get_tuple_element,{x,0},1,{x,2}}. - {get_tuple_element,{x,0},2,{x,3}}. - {get_tuple_element,{x,0},3,{x,4}}. - {gc_bif,'+',{f,0},6,[{x,1},{x,2}],{x,0}}. - {gc_bif,'+',{f,0},6,[{x,0},{x,3}],{x,0}}. - {gc_bif,'+',{f,0},6,[{x,0},{x,4}],{x,0}}. - {gc_bif,'+',{f,0},6,[{x,0},{x,5}],{x,0}}. - return. - {label,3}. - {badmatch,{x,0}}. - {label,4}. - {jump,{f,1}}. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index dcc703c3e1..aff1a56c47 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -42,13 +42,9 @@ groups() -> 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]. + Config. -end_per_suite(Config) -> - Node = proplists:get_value(testing_node, Config), - test_server:stop_node(Node), +end_per_suite(_Config) -> ok. init_per_group(_GroupName, Config) -> @@ -89,26 +85,26 @@ attribute(Config) when is_list(Config) -> ?comp(maps_inline_test). try_inline(Mod, Config) -> - Node = proplists:get_value(testing_node, Config), Src = filename:join(proplists:get_value(data_dir, Config), atom_to_list(Mod)), Out = proplists:get_value(priv_dir,Config), %% Normal compilation. io:format("Compiling: ~s\n", [Src]), - {ok,Mod} = compile:file(Src, [{outdir,Out},report,bin_opt_info,clint]), + {ok,Mod} = compile:file(Src, [{outdir,Out},report, + bin_opt_info,clint,ssalint]), ct:timetrap({minutes,10}), - NormalResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), + NormalResult = load_and_call(Out, Mod), %% Inlining. io:format("Compiling with old inliner: ~s\n", [Src]), {ok,Mod} = compile:file(Src, [{outdir,Out},report,bin_opt_info, - {inline,1000},clint]), + {inline,1000},clint,ssalint]), %% Run inlined code. ct:timetrap({minutes,10}), - OldInlinedResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), + OldInlinedResult = load_and_call(Out, Mod), %% Compare results. compare(NormalResult, OldInlinedResult), @@ -117,11 +113,11 @@ try_inline(Mod, Config) -> %% Inlining. io:format("Compiling with new inliner: ~s\n", [Src]), {ok,Mod} = compile:file(Src, [{outdir,Out},report, - bin_opt_info,inline,clint]), + bin_opt_info,inline,clint,ssalint]), %% Run inlined code. ct:timetrap({minutes,10}), - InlinedResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), + InlinedResult = load_and_call(Out, Mod), %% Compare results. compare(NormalResult, InlinedResult), @@ -130,6 +126,11 @@ try_inline(Mod, Config) -> %% Delete Beam file. ok = file:delete(filename:join(Out, atom_to_list(Mod)++code:objfile_extension())), + %% Delete loaded module. + _ = code:purge(Mod), + _ = code:delete(Mod), + _ = code:purge(Mod), + ok. compare(Same, Same) -> ok; @@ -143,12 +144,6 @@ compare([H1|_], [H2|_]) -> ct:fail(different); compare([], []) -> ok. -start_node(Name, Args) -> - case test_server:start_node(Name, slave, [{args,Args}]) of - {ok,Node} -> {ok, Node}; - Error -> ct:fail(Error) - end. - load_and_call(Out, Module) -> io:format("Loading...\n",[]), code:purge(Module), @@ -349,9 +344,8 @@ otp_7223_2({a}) -> 1. coverage(Config) when is_list(Config) -> - Mod = bsdecode, + Mod = attribute, Src = filename:join(proplists:get_value(data_dir, Config), Mod), - {ok,Mod,_} = compile:file(Src, [binary,report,{inline,0},clint]), - {ok,Mod,_} = compile:file(Src, [binary,report,{inline,20}, - verbose,clint]), + {ok,Mod,_} = compile:file(Src, [binary,report,{inline,0}, + clint,ssalint]), ok. diff --git a/lib/compiler/test/inline_SUITE_data/barnes2.erl b/lib/compiler/test/inline_SUITE_data/barnes2.erl index a986331060..49e9bdfb6b 100644 --- a/lib/compiler/test/inline_SUITE_data/barnes2.erl +++ b/lib/compiler/test/inline_SUITE_data/barnes2.erl @@ -6,7 +6,7 @@ ?MODULE() -> Stars = create_scenario(1000, 1.0), R = hd(loop(10,1000.0,Stars,0)), - Str = lists:flatten(io:lib_format("~s", [R])), + Str = lists:flatten(io_lib:format("~p", [R])), {R,Str =:= {1.00000,-1.92269e+4,-1.92269e+4,2.86459e-2,2.86459e-2}}. create_scenario(N, M) -> diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 3e0ab78390..440b632381 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -70,7 +70,10 @@ t_bad_update/1, %% new in OTP 21 - t_reused_key_variable/1 + t_reused_key_variable/1, + + %% new in OTP 22 + t_mixed_clause/1,cover_beam_trim/1 ]). suite() -> []. @@ -124,7 +127,10 @@ all() -> t_bad_update, %% new in OTP 21 - t_reused_key_variable + t_reused_key_variable, + + %% new in OTP 22 + t_mixed_clause,cover_beam_trim ]. groups() -> []. @@ -1373,22 +1379,22 @@ map_usage(Def, Used) -> 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")}), - {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), - {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), - {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), - - {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), - {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), - {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), - {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), - {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), - - %% error case - {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), - {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), - ok. + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. t_guard_sequence_large(Config) when is_list(Config) -> M0 = id(#{ 10=>a0,20=>b0,30=>"c0","40"=>"d0",<<"50">>=>"e0",{["00",03]}=>"10", @@ -1443,21 +1449,21 @@ t_guard_sequence_large(Config) when is_list(Config) -> 18=>a8,28=>b8,38=>"c8","48"=>"d8",<<"58">>=>"e8",{["08"]}=>"18", 19=>a9,29=>b9,39=>"c9","49"=>"d9",<<"59">>=>"e9",{["09"]}=>"19" } => "large map key 2" }), - {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>id("a")}), - {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>id("b")}), - {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>id("c")}), - {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>id("d")}), - {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>id("e")}), + {1, "a"} = map_guard_sequence_1(M0#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(M0#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(M0#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(M0#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(M0#{seq=>5,val=>id("e")}), - {1,M1} = map_guard_sequence_2(M1 = id(M0#{a=>3})), - {2,M2} = map_guard_sequence_2(M2 = id(M0#{a=>4, b=>4})), - {3,gg,M3} = map_guard_sequence_2(M3 = id(M0#{a=>gg, b=>4})), - {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(M0#{a=>sc, b=>3, c=>sc2})), - {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(M0#{a=>kk, b=>other, c=>sc2})), + {1,M1} = map_guard_sequence_2(M1 = id(M0#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(M0#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(M0#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(M0#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(M0#{a=>kk, b=>other, c=>sc2})), - {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>id("e")})), - {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})), - ok. + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(M0#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(M0#{b=>5})), + ok. map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; @@ -2079,7 +2085,7 @@ t_register_corruption(Config) when is_list(Config) -> {3,wanted,<<"value">>} = register_corruption_foo(wanted,M), ok. -register_corruption_foo(A,#{a := V1, b := V2}) -> +register_corruption_foo(_,#{a := V1, b := V2}) -> register_corruption_dummy_call(1,V1,V2); register_corruption_foo(A,#{b := V}) -> register_corruption_dummy_call(2,A,V); @@ -2161,6 +2167,31 @@ t_reused_key_variable(Config) when is_list(Config) -> ok end. +t_mixed_clause(_Config) -> + put(fool_inliner, x), + K = get(fool_inliner), + {42,100} = case #{K=>42,y=>100} of + #{x:=X,y:=Y} -> + {X,Y} + end, + nomatch = case #{K=>42,y=>100} of + #{x:=X,y:=0} -> + {X,Y}; + #{} -> + nomatch + end, + ok. + +cover_beam_trim(_Config) -> + val = do_cover_beam_trim(id, max, max, id, #{id=>val}), + ok. + +do_cover_beam_trim(Id, OldMax, Max, Id, M) -> + OldMax = id(Max), + #{Id:=Val} = id(M), + Val. + + %% aux rand_terms(0) -> []; diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 72e5356a8d..bc74ec4984 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2018. All Rights Reserved. +%% Copyright Ericsson AB 2004-2019. 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,8 @@ match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/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]). + unary_op/1,eq_types/1,match_after_return/1,match_right_tuple/1, + tuple_size_in_try/1]). -include_lib("common_test/include/ct.hrl"). @@ -40,7 +41,9 @@ groups() -> match_in_call,untuplify, shortcut_boolean,letify_guard,selectify,deselectify, underscore,match_map,map_vars_used,coverage, - grab_bag,literal_binary,unary_op]}]. + grab_bag,literal_binary,unary_op,eq_types, + match_after_return,match_right_tuple, + tuple_size_in_try]}]. init_per_suite(Config) -> @@ -254,6 +257,8 @@ non_matching_aliases(_Config) -> none = mixed_aliases([d]), none = mixed_aliases({a,42}), none = mixed_aliases(42), + none = mixed_aliases(<<6789:16>>), + none = mixed_aliases(#{key=>value}), {'EXIT',{{badmatch,42},_}} = (catch nomatch_alias(42)), {'EXIT',{{badmatch,job},_}} = (catch entirely()), @@ -279,6 +284,16 @@ mixed_aliases(<<X:8>> = x) -> {a,X}; mixed_aliases([b] = <<X:8>>) -> {b,X}; mixed_aliases(<<X:8>> = {a,X}) -> {c,X}; mixed_aliases([X] = <<X:8>>) -> {d,X}; +mixed_aliases(<<X:16>> = X) -> {e,X}; +mixed_aliases(X = <<X:16>>) -> {f,X}; +mixed_aliases(<<X:16,_/binary>> = X) -> {g,X}; +mixed_aliases(X = <<X:16,_/binary>>) -> {h,X}; +mixed_aliases(X = #{key:=X}) -> {i,X}; +mixed_aliases(#{key:=X} = X) -> {j,X}; +mixed_aliases([X] = #{key:=X}) -> {k,X}; +mixed_aliases(#{key:=X} = [X]) -> {l,X}; +mixed_aliases({a,X} = #{key:=X}) -> {m,X}; +mixed_aliases(#{key:=X} = {a,X}) -> {n,X}; mixed_aliases(_) -> none. nomatch_alias(I) -> @@ -456,6 +471,7 @@ letify_guard(A, B) -> selectify(Config) when is_list(Config) -> integer = sel_different_types({r,42}), atom = sel_different_types({r,forty_two}), + float = sel_different_types({r,100.0}), none = sel_different_types({r,18}), {'EXIT',_} = (catch sel_different_types([a,b,c])), @@ -466,12 +482,15 @@ selectify(Config) when is_list(Config) -> integer42 = sel_same_value2(42), integer43 = sel_same_value2(43), error = sel_same_value2(44), + ok. sel_different_types({r,_}=T) when element(2, T) =:= forty_two -> atom; sel_different_types({r,_}=T) when element(2, T) =:= 42 -> integer; +sel_different_types({r,_}=T) when element(2, T) =:= 100.0 -> + float; sel_different_types({r,_}) -> none. @@ -489,9 +508,8 @@ 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. +%% Test deconstruction of select_val instructions to regular tests +%% with zero or one values left. deselectify(Config) when is_list(Config) -> one_or_other = desel_tuple_arity({1}), @@ -512,7 +530,31 @@ deselectify(Config) when is_list(Config) -> one_or_other = dsel_atom_typecheck(one), two = dsel_atom_typecheck(two), - one_or_other = dsel_atom_typecheck(three). + one_or_other = dsel_atom_typecheck(three), + + %% Cover deconstruction of select_val instructions in + %% beam_peep. + + stop = dsel_peek_0(stop), + ignore = dsel_peek_0(ignore), + Config = dsel_peek_0(Config), + + stop = dsel_peek_1(stop, any), + Config = dsel_peek_1(ignore, Config), + other = dsel_peek_1(other, ignored), + + 0 = dsel_peek_2(0, any), + Config = dsel_peek_2(1, Config), + 2 = dsel_peek_2(2, ignored), + + true = dsel_peek_3(true), + false = dsel_peek_3(false), + {error,Config} = dsel_peek_3(Config), + + ok. + +%% The following will be optimized by the sharing optimizations +%% in beam_ssa_opt. desel_tuple_arity(Tuple) when is_tuple(Tuple) -> case Tuple of @@ -549,6 +591,39 @@ dsel_atom_typecheck(Val) when is_atom(Val) -> _ -> one_or_other end. +%% The following functions are carefully crafted so that the sharing +%% optimizations in beam_ssa_opt can't be applied. After applying the +%% beam_jump:eliminate_moves/1 optimization and beam_clean:clean_labels/1 +%% has unified labels, beam_peep is able to optimize these functions. + +dsel_peek_0(A0) -> + case id(A0) of + stop -> stop; + ignore -> ignore; + A -> A + end. + +dsel_peek_1(A0, B) -> + case id(A0) of + stop -> stop; + ignore -> B; + A -> A + end. + +dsel_peek_2(A0, B) -> + case id(A0) of + 0 -> 0; + 1 -> B; + A -> A + end. + +dsel_peek_3(A0) -> + case id(A0) of + true -> true; + false -> false; + Other -> {error,Other} + end. + underscore(Config) when is_list(Config) -> case Config of [] -> @@ -591,13 +666,26 @@ do_map_vars_used(X, Y, Map) -> Val end. +-record(coverage_id, {bool=false,id}). coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), ok = coverage_1(x, b), %% Cover sys_pre_expand. - ok = coverage_3("abc"). + ok = coverage_3("abc"), + + %% Cover beam_ssa_dead. + {expr,key} = coverage_4([literal,get], [[expr,key]]), + {expr,key} = coverage_4([expr,key], []), + + a = coverage_5([8,8,8], #coverage_id{bool=true}), + b = coverage_5([], #coverage_id{bool=true}), + + %% Cover beam_ssa_opt. + ok = coverage_6(), + + ok. coverage_1(B, Tag) -> case Tag of @@ -610,6 +698,37 @@ coverage_2(2, b, x) -> ok. coverage_3([$a]++[]++"bc") -> ok. +%% Cover beam_ssa_dead:eval_type_test_1(is_nonempty_list, Arg). +coverage_4([literal,get], [Expr]) -> + coverage_4(Expr, []); +coverage_4([Expr,Key], []) -> + {Expr,Key}. + +%% Cover beam_ssa_dead:eval_type_test_1(is_tagged_tuple, Arg). +coverage_5(Config, TermId) + when TermId =:= #coverage_id{bool=true}, + Config =:= [8,8,8] -> + a; +coverage_5(_Config, #coverage_id{bool=true}) -> + b. + +coverage_6() -> + X = 17, + case + case id(1) > 0 of + true -> + 17; + false -> + 42 + end + of + X -> + ok; + V -> + %% Cover beam_ssa_opt:make_literal/2. + error([error,X,V]) + end. + grab_bag(_Config) -> [_|T] = id([a,b,c]), [b,c] = id(T), @@ -754,5 +873,70 @@ unary_op_1(Vop@1) -> end end. +eq_types(_Config) -> + Ref = make_ref(), + Ref = eq_types(Ref, any), + ok. + +eq_types(A, B) -> + %% {put_tuple2,{y,0},{list,[{x,0},{x,1}]}}. + Term0 = {A, B}, + Term = id(Term0), + + %% {test,is_eq_exact,{f,3},[{y,0},{x,0}]}. + %% Here beam_validator must infer that {x,0} has the + %% same type as {y,0}. + Term = Term0, + + %% {get_tuple_element,{x,0},0,{x,0}}. + {Ref22,_} = Term, + + Ref22. + +match_after_return(Config) when is_list(Config) -> + %% The return type of the following call will never match the 'wont_happen' + %% clauses below, and the beam_ssa_type was clever enough to see that but + %% didn't remove the blocks, so it crashed when trying to extract A. + ok = case mar_test_tuple(erlang:unique_integer()) of + {gurka, never_matches, A} -> {wont_happen, A}; + _ -> ok + end. + +mar_test_tuple(I) -> {gurka, I}. + +match_right_tuple(Config) when is_list(Config) -> + %% The loader wrongly coalesced certain get_tuple_element sequences, fusing + %% the code below into a single i_get_tuple_element2 operating on {x,0} + %% even though the first one overwrites it. + %% + %% {get_tuple_element,{x,0},0,{x,0}}. + %% {get_tuple_element,{x,0},1,{x,1}}. + + Inner = {id(wrong_element), id(ok)}, + Outer = {Inner, id(wrong_tuple)}, + ok = match_right_tuple_1(Outer). + +match_right_tuple_1(T) -> + {A, _} = T, + {_, B} = A, + %% The call ensures that A is in {x,0} and B is in {x,1} + id(force_succ_regs(A, B)). + +force_succ_regs(_A, B) -> B. + +tuple_size_in_try(Config) when is_list(Config) -> + %% The tuple_size optimization was applied outside of guards, causing + %% either the emulator or compiler to crash. + ok = tsit(gurka), + ok = tsit(gaffel). + +tsit(A) -> + try + id(ignored), + 1 = tuple_size(A), + error + catch + _:_ -> ok + end. id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index a1d931b994..a0b415ceaa 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -161,17 +161,16 @@ md5_1(Beam) -> %% Cover some code that handles internal errors. silly_coverage(Config) when is_list(Config) -> - %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel + %% sys_core_fold, sys_core_alias, sys_core_bsm, 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_codegen + %% beam_kernel_to_ssa BadKernel = {k_mdef,[],?MODULE, [{foo,0}], [], @@ -179,7 +178,38 @@ silly_coverage(Config) when is_list(Config) -> {k,[],[],[]}, f,0,[], seriously_bad_body}]}, - expect_error(fun() -> v3_codegen:module(BadKernel, []) end), + expect_error(fun() -> beam_kernel_to_ssa:module(BadKernel, []) end), + + %% beam_ssa_lint + %% beam_ssa_recv + %% beam_ssa_share + %% beam_ssa_pre_codegen + %% beam_ssa_codegen + BadSSA = {b_module,#{},a,b,c, + [{b_function,#{func_info=>{mod,foo,0}},args,bad_blocks,0}]}, + expect_error(fun() -> beam_ssa_lint:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_recv:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_share:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_pre_codegen:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_codegen:module(BadSSA, []) end), + + %% beam_ssa_opt + BadSSABlocks = #{0 => {b_blk,#{},[bad_code],{b_ret,#{},arg}}}, + BadSSAOpt = {b_module,#{},a,[],c, + [{b_function,#{func_info=>{mod,foo,0}},[], + BadSSABlocks,0}]}, + expect_error(fun() -> beam_ssa_opt:module(BadSSAOpt, []) end), + + %% beam_ssa_lint, beam_ssa_pp + {error,[{_,Errors}]} = beam_ssa_lint:module(bad_ssa_lint_input(), []), + _ = [io:put_chars(Mod:format_error(Reason)) || + {Mod,Reason} <- Errors], + + %% Cover printing of annotations in beam_ssa_pp + PPAnno = #{func_info=>{mod,foo,0},other_anno=>value,map_anno=>#{k=>v}}, + PPBlocks = #{0=>{b_blk,#{},[],{b_ret,#{},{b_literal,42}}}}, + PP = {b_function,PPAnno,[],PPBlocks,0}, + io:put_chars(beam_ssa_pp:format_function(PP)), %% beam_a BeamAInput = {?MODULE,[{foo,0}],[], @@ -189,14 +219,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_a:module(BeamAInput, []) end), - %% beam_reorder - BlockInput = {?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_reorder:module(BlockInput, []) end), - %% beam_block BlockInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -205,19 +227,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_block:module(BlockInput, []) end), - %% beam_bs - BsInput = BlockInput, - expect_error(fun() -> beam_bs:module(BsInput, []) end), - - %% beam_type - TypeInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {line,loc}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, - expect_error(fun() -> beam_type:module(TypeInput, []) end), - %% beam_except ExceptInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -227,15 +236,9 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_except:module(ExceptInput, []) 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}],[], - [{function,foo,0,2, - [{label,1}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}, - {test,is_eq_exact,{f,1},[bad,operands]}]}],99}, - expect_error(fun() -> beam_dead:module(DeadInput, []) end), + %% beam_jump + JumpInput = BlockInput, + expect_error(fun() -> beam_jump:module(JumpInput, []) end), %% beam_clean CleanInput = {?MODULE,[{foo,0}],[], @@ -246,6 +249,10 @@ silly_coverage(Config) when is_list(Config) -> {jump,{f,42}}]}],99}, expect_error(fun() -> beam_clean:module(CleanInput, []) end), + %% beam_jump + TrimInput = BlockInput, + expect_error(fun() -> beam_trim:module(TrimInput, []) end), + %% beam_peep. This is tricky. Use a select instruction with %% an odd number of elements in the list to crash %% prune_redundant_values/2 but not beam_clean:clean_labels/1. @@ -253,48 +260,10 @@ silly_coverage(Config) when is_list(Config) -> [{function,foo,0,2, [{label,1}, {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2},{select,op,r,{f,2},[{f,2}]}]}], + {label,2},{select,select_val,r,{f,2},[{f,2}]}]}], 2}, expect_error(fun() -> beam_peep:module(PeepInput, []) end), - %% beam_bsm. This is tricky. Our function must be sane enough to not crash - %% btb_index/1, but must crash the main optimization pass. - BsmInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}, - {test,bs_get_binary2,{f,99},0,[{x,0},{atom,all},1,[]],{x,0}}, - {block,[a|b]}]}],0}, - expect_error(fun() -> beam_bsm:module(BsmInput, []) end), - - %% beam_receive. - ReceiveInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}, - {call_ext,0,{extfunc,erlang,make_ref,0}}, - {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}, @@ -312,6 +281,31 @@ silly_coverage(Config) when is_list(Config) -> ok. +bad_ssa_lint_input() -> + {b_module,#{},t, + [{foobar,1},{module_info,0},{module_info,1}], + [], + [{b_function, + #{func_info => {t,foobar,1},location => {"t.erl",4}}, + [{b_var,0}], + #{0 => {b_blk,#{},[],{b_ret,#{},{b_var,'@undefined_var'}}}}, + 3}, + {b_function, + #{func_info => {t,module_info,0}}, + [], + #{0 => + {b_blk,#{}, + [{b_set,#{}, + {b_var,{'@ssa_ret',3}}, + call, + [{b_remote, + {b_literal,erlang}, + {b_literal,get_module_info}, + 1}, + {b_var,'@unknown_variable'}]}], + {b_ret,#{},{b_var,{'@ssa_ret',3}}}}}, + 4}]}. + expect_error(Fun) -> try Fun() of Any -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 4219768d6f..8cd864c59e 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -25,7 +25,8 @@ 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,recv_in_try/1,double_recv/1]). + wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1, + match_built_terms/1,elusive_common_exit/1]). -include_lib("common_test/include/ct.hrl"). @@ -45,7 +46,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [recv,coverage,otp_7980,ref_opt,export,wait, - recv_in_try,double_recv]}]. + recv_in_try,double_recv,receive_var_zero, + match_built_terms,elusive_common_exit]}]. init_per_suite(Config) -> @@ -378,4 +380,108 @@ do_double_recv(_, Msg) -> error end. +%% Test 'after Z', when Z =:= 0 been propagated as an immediate by the type +%% optimization pass. +receive_var_zero(Config) when is_list(Config) -> + self() ! x, + self() ! y, + Z = zero(), + timeout = receive + z -> ok + after Z -> timeout + end, + timeout = receive + after Z -> timeout + end, + self() ! w, + receive + x -> ok; + Other -> + ct:fail({bad_message,Other}) + end. + +zero() -> 0. + +%% ERL-862; the validator would explode when a term was constructed in a +%% receive guard. + +-define(MATCH_BUILT_TERM(Ref, Expr), + (fun() -> + Ref = make_ref(), + A = id($a), + B = id($b), + Built = id(Expr), + self() ! {Ref, A, B}, + receive + {Ref, A, B} when Expr =:= Built -> + ok + after 5000 -> + ct:fail("Failed to match message with term built in " + "receive guard.") + end + end)()). + +match_built_terms(Config) when is_list(Config) -> + ?MATCH_BUILT_TERM(Ref, [A, B]), + ?MATCH_BUILT_TERM(Ref, {A, B}), + ?MATCH_BUILT_TERM(Ref, <<A, B>>), + ?MATCH_BUILT_TERM(Ref, #{ 1 => A, 2 => B}). + +elusive_common_exit(_Config) -> + self() ! {1, a}, + self() ! {2, b}, + {[z], [{2,b},{1,a}]} = elusive_loop([x,y,z], 2, []), + + CodeServer = whereis(code_server), + Self = self(), + Self ! {Self, abc}, + Self ! {CodeServer, []}, + Self ! {Self, other}, + try elusive2([]) of + Unexpected -> + ct:fail("Expected an exception; got ~p\n", [Unexpected]) + catch + throw:[other, CodeServer, Self] -> + ok + end, + + ok. + +elusive_loop(List, 0, Results) -> + {List, Results}; +elusive_loop(List, ToReceive, Results) -> + {Result, RemList} = + receive + {_Pos, _R} = Res when List =/= [] -> + [_H|T] = List, + {Res, T}; + {_Pos, _R} = Res when List =:= [] -> + {Res, []} + end, + %% beam_ssa_pre_codegen:fix_receives() would fail to find + %% the common exit block for this receive. That would mean + %% that it would not insert all necessary copy instructions. + elusive_loop(RemList, ToReceive-1, [Result | Results]). + + +elusive2(Acc) -> + receive + {Pid, abc} -> + ok; + {Pid, []} -> + ok; + {Pid, Res} -> + %% beam_ssa_pre_codegen:find_loop_exit/2 attempts to find + %% the first block of the common code after the receive + %% statement. It used to only look at the two last clauses + %% of the receive. In this function, the last two clauses + %% don't have any common block, so it would be assumed + %% that there was no common block for any of the + %% clauses. That would mean that copy instructions would + %% not be inserted as needed. + throw([Res | Acc]) + end, + %% Common code. + elusive2([Pid | Acc]). + id(I) -> I. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_5.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_5.erl new file mode 100644 index 0000000000..4fbde3a83d --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_5.erl @@ -0,0 +1,38 @@ +-module(no_5). +-compile([export_all,nowarn_export_all]). + +?MODULE() -> + ok. + +%% Nested receives were not handled properly. + +confusing_recv_mark(Pid) -> + Ref = make_ref(), + %% There would be a recv_mark here. + MRef = erlang:monitor(process, Pid), + receive + Ref -> + %% And a recv_set here. + receive + MRef -> gurka + end; + MRef -> + gaffel + end. + +%% The optimization could potentially be improved to +%% handle matching of multiple refs, like this: + +proper_recv_mark(Pid) -> + %% Place the recv_mark before the creation of both refs. + Ref = make_ref(), + MRef = erlang:monitor(process, Pid), + %% Place the recv_set here. + receive + Ref -> + receive + MRef -> gurka + end; + MRef -> + gaffel + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S deleted file mode 100644 index fd14228135..0000000000 --- a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S +++ /dev/null @@ -1,71 +0,0 @@ -{module, yes_14}. %% version = 0 - -{exports, [{f,2},{module_info,0},{module_info,1},{yes_14,0}]}. - -{attributes, []}. - -{labels, 12}. - - -{function, yes_14, 0, 2}. - {label,1}. - {func_info,{atom,yes_14},{atom,yes_14},0}. - {label,2}. - {move,{atom,ok},{x,0}}. - return. - - -{function, f, 2, 4}. - {label,3}. - {func_info,{atom,yes_14},{atom,f},2}. - {label,4}. - {allocate_heap,2,3,2}. - {move,{x,0},{y,1}}. - {put_tuple,2,{y,0}}. - {put,{atom,data}}. - {put,{x,1}}. - {call_ext,0,{extfunc,erlang,make_ref,0}}. % Ref in [x0] - {test_heap,4,1}. - {put_tuple,3,{x,1}}. - {put,{atom,request}}. - {put,{x,0}}. - {put,{y,0}}. - {move,{x,0},{y,0}}. % Ref in [x0,y0] - {move,{y,1},{x,0}}. % Ref in [y0] - {kill,{y,1}}. - send. - {move,{y,0},{x,0}}. % Ref in [x0,y0] - {move,{x,0},{y,1}}. % Ref in [x0,y0,y1] - {label,5}. - {loop_rec,{f,7},{x,0}}. % Ref in [y0,y1] - {test,is_tuple,{f,6},[{x,0}]}. - {test,test_arity,{f,6},[{x,0},2]}. - {get_tuple_element,{x,0},0,{x,1}}. - {get_tuple_element,{x,0},1,{x,2}}. - {test,is_eq_exact,{f,6},[{x,1},{atom,reply}]}. - {test,is_eq_exact,{f,6},[{x,2},{y,1}]}. - remove_message. - {move,{atom,ok},{x,0}}. - {deallocate,2}. - return. - {label,6}. - {loop_rec_end,{f,5}}. - {label,7}. - {wait,{f,5}}. - - -{function, module_info, 0, 9}. - {label,8}. - {func_info,{atom,yes_14},{atom,module_info},0}. - {label,9}. - {move,{atom,yes_14},{x,0}}. - {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. - - -{function, module_info, 1, 11}. - {label,10}. - {func_info,{atom,yes_14},{atom,module_info},1}. - {label,11}. - {move,{x,0},{x,1}}. - {move,{atom,yes_14},{x,0}}. - {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.erl new file mode 100644 index 0000000000..aa47c02af9 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.erl @@ -0,0 +1,27 @@ +-module(yes_14). +-compile(export_all). + +?MODULE() -> + ok. + +do_call(Process, Request) -> + Mref = erlang:monitor(process, Process), + Process ! Request, + Local = case node(Process) of + Node when Node =:= node() -> true; + _Node -> false + end, + id(Local), + receive + {X,Y,Z} when Mref =/= X, Z =:= 42, Mref =:= Y -> + error; + {X,Y,_} when Mref =/= X, Mref =:= Y -> + error; + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, _} -> + error + end. + +id(I) -> I. diff --git a/lib/compiler/test/regressions_SUITE.erl b/lib/compiler/test/regressions_SUITE.erl index 9b0b9b0c38..39febf060f 100644 --- a/lib/compiler/test/regressions_SUITE.erl +++ b/lib/compiler/test/regressions_SUITE.erl @@ -23,7 +23,7 @@ -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, + init_per_suite/1,end_per_suite/1, suite/0]). -export([maps/1]). diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 8954a9f5fb..34410e4b2a 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -22,7 +22,8 @@ -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]). + is_cloned_mod/1,smoke_disasm/1,p_run/2, + highest_opcode/1]). %% Used by test case that override BIFs. -export([binary_part/2,binary/1]). @@ -50,12 +51,8 @@ smoke_disasm(File) when is_list(File) -> Res = beam_disasm:file(File), {beam_file,_Mod} = {element(1, Res),element(2, Res)}. -%% If we are running cover, we don't want to run test cases that -%% invokes the compiler in parallel, as doing so would probably -%% be slower than running them sequentially. - parallel() -> - case test_server:is_cover() orelse erlang:system_info(schedulers) =:= 1 of + case erlang:system_info(schedulers) =:= 1 of true -> []; false -> [parallel] end. @@ -70,18 +67,24 @@ uniq() -> opt_opts(Mod) -> Comp = Mod:module_info(compile), {options,Opts} = lists:keyfind(options, 1, Comp), - lists:filter(fun(no_copt) -> true; - (no_postopt) -> true; - (no_float_opt) -> true; - (no_new_funs) -> true; - (no_new_binaries) -> true; - (no_new_apply) -> true; - (no_gc_bifs) -> true; - (no_stack_trimming) -> true; - (debug_info) -> true; - (inline) -> true; - (_) -> false - end, Opts). + lists:filter(fun + (debug_info) -> true; + (inline) -> true; + (no_bsm3) -> true; + (no_bsm_opt) -> true; + (no_copt) -> true; + (no_fun_opt) -> true; + (no_module_opt) -> true; + (no_postopt) -> true; + (no_put_tuple2) -> true; + (no_recv_opt) -> true; + (no_share_opt) -> true; + (no_ssa_float) -> true; + (no_ssa_opt) -> true; + (no_stack_trimming) -> true; + (no_type_opt) -> true; + (_) -> false + end, Opts). %% Some test suites gets cloned (e.g. to "record_SUITE" to %% "record_no_opt_SUITE"), but the data directory is not cloned. @@ -91,37 +94,41 @@ get_data_dir(Config) -> Data0 = proplists:get_value(data_dir, Config), Opts = [{return,list}], Data1 = re:replace(Data0, "_no_opt_SUITE", "_SUITE", Opts), - Data = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts), - re:replace(Data, "_inline_SUITE", "_SUITE", Opts). + Data2 = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts), + Data3 = re:replace(Data2, "_inline_SUITE", "_SUITE", Opts), + Data4 = re:replace(Data3, "_r21_SUITE", "_SUITE", Opts), + Data5 = re:replace(Data4, "_no_module_opt_SUITE", "_SUITE", Opts), + Data = re:replace(Data5, "_no_type_opt_SUITE", "_SUITE", Opts), + re:replace(Data, "_no_ssa_opt_SUITE", "_SUITE", Opts). is_cloned_mod(Mod) -> is_cloned_mod_1(atom_to_list(Mod)). %% Test whether Mod is a cloned module. -is_cloned_mod_1("no_opt_SUITE") -> true; -is_cloned_mod_1("post_opt_SUITE") -> true; -is_cloned_mod_1("inline_SUITE") -> true; +is_cloned_mod_1("_no_opt_SUITE") -> true; +is_cloned_mod_1("_no_ssa_opt_SUITE") -> true; +is_cloned_mod_1("_post_opt_SUITE") -> true; +is_cloned_mod_1("_inline_SUITE") -> true; +is_cloned_mod_1("_21_SUITE") -> true; +is_cloned_mod_1("_no_module_opt_SUITE") -> true; is_cloned_mod_1([_|T]) -> is_cloned_mod_1(T); is_cloned_mod_1([]) -> false. +%% Return the highest opcode use in the BEAM module. + +highest_opcode(Beam) -> + {ok,{_Mod,[{"Code",Code}]}} = beam_lib:chunks(Beam, ["Code"]), + FormatNumber = 0, + <<16:32,FormatNumber:32,HighestOpcode:32,_/binary>> = Code, + HighestOpcode. + %% p_run(fun(Data) -> ok|error, List) -> ok %% Will fail the test case if there were any errors. p_run(Test, List) -> S = erlang:system_info(schedulers), - N = case test_server:is_cover() of - false -> - S + 1; - true -> - %% Cover is running. Using too many processes - %% could slow us down. Measurements on my computer - %% showed that using 4 parallel processes was - %% slightly faster than using 3. Using more than - %% 4 would not buy us much and could actually be - %% slower. - min(S, 4) - end, + N = S + 1, io:format("p_run: ~p parallel processes\n", [N]), p_run_loop(Test, List, N, [], 0, 0). diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 8f9cd9ab1e..539f9d69fa 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -27,7 +27,8 @@ 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, - stacktrace/1,nested_stacktrace/1,raise/1]). + stacktrace/1,nested_stacktrace/1,raise/1, + no_return_in_try_block/1]). -include_lib("common_test/include/ct.hrl"). @@ -43,7 +44,8 @@ groups() -> nested_after,nested_horrid,last_call_optimization, bool,plain_catch_coverage,andalso_orelse,get_in_try, hockey,handle_info,catch_in_catch,grab_bag, - stacktrace,nested_stacktrace,raise]}]. + stacktrace,nested_stacktrace,raise, + no_return_in_try_block]}]. init_per_suite(Config) -> @@ -1287,5 +1289,26 @@ do_test_raise_4(Expr) -> erlang:raise(exit, {exception,C,E,Stk}, Stk) end. +no_return_in_try_block(Config) when is_list(Config) -> + 1.0 = no_return_in_try_block_1(0), + 1.0 = no_return_in_try_block_1(0.0), + + gurka = no_return_in_try_block_1(gurka), + [] = no_return_in_try_block_1([]), + + ok. + +no_return_in_try_block_1(H) -> + try + Float = if + is_number(H) -> float(H); + true -> no_return() + end, + Float + 1 + catch + throw:no_return -> H + end. + +no_return() -> throw(no_return). id(I) -> I. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 1c23eba06d..70b7100451 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -240,19 +240,7 @@ guard(Config) when is_list(Config) -> {4,sys_core_fold,nomatch_guard}, {6,sys_core_fold,no_clause_match}, {6,sys_core_fold,nomatch_guard}, - {6,sys_core_fold,{eval_failure,badarg}}, - {8,sys_core_fold,no_clause_match}, - {8,sys_core_fold,nomatch_guard}, - {8,sys_core_fold,{eval_failure,badarg}}, - {9,sys_core_fold,no_clause_match}, - {9,sys_core_fold,nomatch_guard}, - {9,sys_core_fold,{eval_failure,badarg}}, - {10,sys_core_fold,no_clause_match}, - {10,sys_core_fold,nomatch_guard}, - {10,sys_core_fold,{eval_failure,badarg}}, - {11,sys_core_fold,no_clause_match}, - {11,sys_core_fold,nomatch_guard}, - {11,sys_core_fold,{eval_failure,badarg}} + {6,sys_core_fold,{eval_failure,badarg}} ]}}], [] = run(Config, Ts), @@ -523,25 +511,43 @@ bin_opt_info(Config) when is_list(Config) -> <<>> -> ok end. + %% We use a tail in a BIF instruction, remote call, function + %% return, and an optimizable tail call for better coverage. + t2(<<A,B,T/bytes>>) -> + if + A > B -> t2(T); + A =< B -> T + end; + t2(<<_,T/bytes>>) when byte_size(T) < 4 -> + foo; t2(<<_,T/bytes>>) -> - split_binary(T, 4). + split_binary(T, 4). ">>, - Ts1 = [{bsm1, - Code, - [bin_opt_info], - {warnings, - [{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}}}} ]}}], - [] = run(Config, Ts1), + + Ws = (catch run_test(Config, Code, [bin_opt_info])), + + %% This is an inexact match since the pass reports exact instructions as + %% part of the warnings, which may include annotations that vary from run + %% to run. + {warnings, + [{5,beam_ssa_bsm,{unsuitable_call, + {{b_local,{b_literal,t1},1}, + {used_before_match, + {b_set,_,_,{bif,byte_size},[_]}}}}}, + {5,beam_ssa_bsm,{binary_created,_,_}}, + {11,beam_ssa_bsm,{binary_created,_,_}}, %% A =< B -> T + {13,beam_ssa_bsm,context_reused}, %% A > B -> t2(T); + {16,beam_ssa_bsm,{binary_created,_,_}}, %% when byte_size(T) < 4 -> + {19,beam_ssa_bsm,{remote_call, + {b_remote, + {b_literal,erlang}, + {b_literal,split_binary},2}}}, + {19,beam_ssa_bsm,{binary_created,_,_}} %% split_binary(T, 4) + ]} = Ws, %% For coverage: don't give the bin_opt_info option. - Ts2 = [{bsm2, - Code, - [], - []}], - [] = run(Config, Ts2), + [] = (catch run_test(Config, Code, [])), + ok. bin_construction(Config) when is_list(Config) -> @@ -747,7 +753,7 @@ maps_bin_opt_info(Config) when is_list(Config) -> M. ">>, [bin_opt_info], - {warnings,[{2,beam_bsm,bin_opt}]}}], + {warnings,[{3,beam_ssa_bsm,context_reused}]}}], [] = run(Config, Ts), ok. @@ -984,7 +990,6 @@ run(Config, Tests) -> end, lists:foldl(F, [], Tests). - %% Compiles a test module and returns the list of errors and warnings. run_test(Conf, Test0, Warnings) -> diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index a523627384..7192ddca15 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.3.2 +COMPILER_VSN = 7.4.4 |