aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/doc/src/Makefile11
-rw-r--r--lib/compiler/doc/src/book.xml3
-rw-r--r--lib/compiler/doc/src/compile.xml40
-rw-r--r--lib/compiler/doc/src/internal.xml38
-rw-r--r--lib/compiler/scripts/.gitignore1
-rwxr-xr-xlib/compiler/scripts/smoke123
-rw-r--r--lib/compiler/scripts/smoke-mix.exs103
-rw-r--r--lib/compiler/src/Makefile45
-rw-r--r--lib/compiler/src/beam_a.erl41
-rw-r--r--lib/compiler/src/beam_asm.erl30
-rw-r--r--lib/compiler/src/beam_block.erl636
-rw-r--r--lib/compiler/src/beam_bs.erl280
-rw-r--r--lib/compiler/src/beam_bsm.erl708
-rw-r--r--lib/compiler/src/beam_clean.erl178
-rw-r--r--lib/compiler/src/beam_dead.erl971
-rw-r--r--lib/compiler/src/beam_dict.erl15
-rw-r--r--lib/compiler/src/beam_disasm.erl27
-rw-r--r--lib/compiler/src/beam_except.erl168
-rw-r--r--lib/compiler/src/beam_flatten.erl73
-rw-r--r--lib/compiler/src/beam_jump.erl423
-rw-r--r--lib/compiler/src/beam_kernel_to_ssa.erl1312
-rw-r--r--lib/compiler/src/beam_listing.erl9
-rw-r--r--lib/compiler/src/beam_peep.erl83
-rw-r--r--lib/compiler/src/beam_receive.erl416
-rw-r--r--lib/compiler/src/beam_record.erl131
-rw-r--r--lib/compiler/src/beam_reorder.erl150
-rw-r--r--lib/compiler/src/beam_split.erl94
-rw-r--r--lib/compiler/src/beam_ssa.erl890
-rw-r--r--lib/compiler/src/beam_ssa.hrl66
-rw-r--r--lib/compiler/src/beam_ssa_bsm.erl1046
-rw-r--r--lib/compiler/src/beam_ssa_codegen.erl2077
-rw-r--r--lib/compiler/src/beam_ssa_dead.erl1076
-rw-r--r--lib/compiler/src/beam_ssa_funs.erl149
-rw-r--r--lib/compiler/src/beam_ssa_lint.erl349
-rw-r--r--lib/compiler/src/beam_ssa_opt.erl2279
-rw-r--r--lib/compiler/src/beam_ssa_opt.hrl53
-rw-r--r--lib/compiler/src/beam_ssa_pp.erl238
-rw-r--r--lib/compiler/src/beam_ssa_pre_codegen.erl2831
-rw-r--r--lib/compiler/src/beam_ssa_recv.erl278
-rw-r--r--lib/compiler/src/beam_ssa_share.erl370
-rw-r--r--lib/compiler/src/beam_ssa_type.erl1956
-rw-r--r--lib/compiler/src/beam_trim.erl326
-rw-r--r--lib/compiler/src/beam_type.erl1118
-rw-r--r--lib/compiler/src/beam_utils.erl1184
-rw-r--r--lib/compiler/src/beam_validator.erl3035
-rw-r--r--lib/compiler/src/beam_z.erl31
-rw-r--r--lib/compiler/src/cerl.erl16
-rw-r--r--lib/compiler/src/cerl_clauses.erl4
-rw-r--r--lib/compiler/src/cerl_sets.erl2
-rw-r--r--lib/compiler/src/compile.erl227
-rw-r--r--lib/compiler/src/compiler.app.src23
-rw-r--r--lib/compiler/src/core_parse.hrl107
-rw-r--r--lib/compiler/src/erl_bifs.erl19
-rwxr-xr-xlib/compiler/src/genop.tab26
-rw-r--r--lib/compiler/src/sys_core_bsm.erl312
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl360
-rw-r--r--lib/compiler/src/sys_core_fold.erl230
-rw-r--r--lib/compiler/src/sys_core_fold_lists.erl101
-rw-r--r--lib/compiler/src/sys_core_inline.erl3
-rw-r--r--lib/compiler/src/v3_codegen.erl2791
-rw-r--r--lib/compiler/src/v3_core.erl25
-rw-r--r--lib/compiler/src/v3_kernel.erl126
-rw-r--r--lib/compiler/src/v3_kernel.hrl2
-rw-r--r--lib/compiler/test/Makefile45
-rw-r--r--lib/compiler/test/apply_SUITE.erl8
-rw-r--r--lib/compiler/test/beam_except_SUITE.erl49
-rw-r--r--lib/compiler/test/beam_jump_SUITE.erl125
-rw-r--r--lib/compiler/test/beam_ssa_SUITE.erl497
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl178
-rw-r--r--lib/compiler/test/beam_utils_SUITE.erl6
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl165
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/bad_bin_match.S2
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S4
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S10
-rw-r--r--lib/compiler/test/bif_SUITE.erl7
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl23
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl237
-rw-r--r--lib/compiler/test/compilation_SUITE.erl6
-rw-r--r--lib/compiler/test/compile_SUITE.erl293
-rw-r--r--lib/compiler/test/compiler.cover5
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl32
-rw-r--r--lib/compiler/test/float_SUITE.erl34
-rw-r--r--lib/compiler/test/fun_SUITE.erl7
-rw-r--r--lib/compiler/test/guard_SUITE.erl107
-rw-r--r--lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S30
-rw-r--r--lib/compiler/test/inline_SUITE.erl40
-rw-r--r--lib/compiler/test/inline_SUITE_data/barnes2.erl2
-rw-r--r--lib/compiler/test/map_SUITE.erl95
-rw-r--r--lib/compiler/test/match_SUITE.erl161
-rw-r--r--lib/compiler/test/misc_SUITE.erl140
-rw-r--r--lib/compiler/test/receive_SUITE.erl53
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/no_5.erl38
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.S71
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_14.erl27
-rw-r--r--lib/compiler/test/regressions_SUITE.erl2
-rw-r--r--lib/compiler/test/test_lib.erl76
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl27
-rw-r--r--lib/compiler/test/warnings_SUITE.erl65
98 files changed, 20861 insertions, 11641 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/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..28c89782c9 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,113 @@ 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)].
-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(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), 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_fc_1([{block,Bl}|Is], Regs0, Acc) ->
+ Regs = dig_out_fc_block(Bl, Regs0),
+ dig_out_fc_1(Is, Regs, Acc);
+dig_out_fc_1([{bs_set_position,_,_}=I|Is], Regs, Acc) ->
+ dig_out_fc_1(Is, Regs, [I|Acc]);
+dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Regs0, Acc) ->
+ Regs = prune_xregs(Live0, Regs0),
+ Live = dig_out_stack_live(Regs, Live0),
+ I = {bs_get_tail,Src,Dst,Live},
+ dig_out_fc_1(Is, Regs, [I|Acc]);
+dig_out_fc_1([_|_], _Regs, _Acc) ->
+ {#{},[]};
+dig_out_fc_1([], 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;
-dig_out_block_fc(_) -> no.
+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..a9977b0b1d
--- /dev/null
+++ b/lib/compiler/src/beam_ssa.erl
@@ -0,0 +1,890 @@
+%%
+%% %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_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_match_string' | 'bs_restore' | 'bs_skip' |
+ 'copy' | 'put_tuple_arity' | 'put_tuple_element' |
+ 'set_tuple_element'.
+
+-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/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, Used0) ->
+ {Def,Used1} = def_used_is(Is, Preds, Def0, Used0),
+ Used = ordsets:union(used(Last), Used1),
+ def_used_1(Bs, Preds, Def, Used);
+def_used_1([], _Preds, Def, Used) ->
+ {ordsets:from_list(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..382e6f635e
--- /dev/null
+++ b/lib/compiler/src/beam_ssa_bsm.erl
@@ -0,0 +1,1046 @@
+%%
+%% %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([Lbl | Path], Counter0, Acc) ->
+ aca_cs_build_brs(Path, Counter0 + 1, maps:put(Lbl, Counter0, Acc));
+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..c2d5035b19
--- /dev/null
+++ b/lib/compiler/src/beam_ssa_codegen.erl
@@ -0,0 +1,2077 @@
+%%
+%% %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} = def_is(Is0, Regs, Def0, []),
+ Successors = successors(Last),
+ DefMap = def_successors(Successors, Def, 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=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([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.
+
+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=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(get_map_element, Fail, [Map,Key], Dst, _I) ->
+ [{get_map_elements,Fail,Map,{list,[Key,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..bb43a550ae
--- /dev/null
+++ b/lib/compiler/src/beam_ssa_dead.erl
@@ -0,0 +1,1076 @@
+%%
+%% %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():=ordsets:ordset(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 or even cubic if
+ %% the ordset of unset variables grows large, instead of
+ %% linear for post order processing. We try to still get reasonable
+ %% compilation times by optimizations that will keep the constant
+ %% factor as low as possible, and we try to avoid the cubic time
+ %% complexity by trying to keep the set of unset variables as small
+ %% as possible.
+
+ 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),
+ SuccBs = bind_var(Bool, #b_literal{val=true}, Bs),
+ BrSucc = shortcut(Succ0, From, SuccBs, St#st{rel_op=RelOp}),
+ FailBs = bind_var(Bool, #b_literal{val=false}, Bs),
+ 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) ->
+ shortcut_1(L, From, Bs, ordsets: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, 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],
+ ordsets:union(UnsetVars, ordsets: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 member(V, UnsetVars) andalso
+ ordsets:is_disjoint(Used0, UnsetVars) andalso
+ ordsets: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
+ ordsets: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) ->
+ Val = get_value(Bool, Bs),
+ beam_ssa:normalize(Br#b_br{bool=Val});
+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(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) ->
+ case is_numeric_test(T1) andalso is_numeric_test(T2) of
+ true -> maybe;
+ false -> no
+ 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) ->
+ 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.
+
+is_numeric_test(is_float) -> true;
+is_numeric_test(is_integer) -> true;
+is_numeric_test(is_number) -> true;
+is_numeric_test(_) -> false.
+
+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, []),
+ 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 = ordsets:from_list(Defined0),
+ MaySkip = ordsets: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, ordsets: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, ordsets: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},ordsets:union(ordsets: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 = ordsets:union(Used0, 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 = ordsets:union(Used0, beam_ssa:used(I)),
+ Used = ordsets:del_element(Dst, Used1),
+ used_vars_is(Is, Used);
+used_vars_is([], Used) ->
+ Used.
+
+%%%
+%%% Common utilities.
+%%%
+
+sub(#b_set{args=Args}=I, Sub) ->
+ I#b_set{args=[sub_arg(A, Sub) || A <- Args]}.
+
+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..90c0d3cf16
--- /dev/null
+++ b/lib/compiler/src/beam_ssa_opt.erl
@@ -0,0 +1,2279 @@
+%%
+%% %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}) ->
+ NonGuards0 = float_non_guards(Linear0),
+ NonGuards = gb_sets:from_list(NonGuards0),
+ 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_non_guards([{L,#b_blk{is=Is}}|Bs]) ->
+ case Is of
+ [#b_set{op=landingpad}|_] ->
+ [L|float_non_guards(Bs)];
+ _ ->
+ float_non_guards(Bs)
+ end;
+float_non_guards([]) -> [?BADARG_BLOCK].
+
+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}) ->
+ {Linear,Count} = opt_tup_size(Linear0, Count0, []),
+ {St#st{ssa=Linear,cnt=Count}, FuncDb}.
+
+opt_tup_size([{L,#b_blk{is=Is,last=Last}=Blk}|Bs], 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, Count0, Acc0),
+ opt_tup_size(Bs, Count, [{L,Blk}|Acc]);
+ {_,_} ->
+ opt_tup_size(Bs, Count0, [{L,Blk}|Acc0])
+ end;
+opt_tup_size([], Count, Acc) ->
+ {reverse(Acc),Count}.
+
+opt_tup_size_1(Size, EqL, Count0, [{L,Blk0}|Acc]) ->
+ case Blk0 of
+ #b_blk{is=Is0,last=#b_br{bool=Bool,succ=EqL,fail=Fail}} ->
+ 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;
+ #b_blk{} ->
+ {[{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{}) ->
+ %% The predecessor block must have exactly one successor (L) for
+ %% the merge to be safe.
+ case beam_ssa:successors(Blk) of
+ [L] -> true;
+ [_|_] -> 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.
+
+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..bad43a9c4e
--- /dev/null
+++ b/lib/compiler/src/beam_ssa_pre_codegen.erl
@@ -0,0 +1,2831 @@
+%%
+%% %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)],
+ [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) ->
+ FPos = case D0 of
+ #{L:=Pos0} -> Pos0;
+ #{} -> #{}
+ end,
+ {SPos,Rs} = bs_restores_is(Is, CtxChain, FPos, Rs0),
+ D = bs_update_successors(Last, SPos, FPos, 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) ->
+ Update = [{L,SPos} || {_,L} <- List] ++ [{Fail,SPos}],
+ join_positions(Update, D);
+bs_update_successors(#b_ret{}, _, _, D) -> 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).
+
+bs_restores_is([#b_set{op=bs_start_match,dst=Start}|Is],
+ CtxChain, PosMap0, Rs) ->
+ PosMap = PosMap0#{Start=>Start},
+ bs_restores_is(Is, CtxChain, PosMap, Rs);
+bs_restores_is([#b_set{op=bs_match,dst=NewPos,args=Args}=I|Is],
+ CtxChain, PosMap0, Rs0) ->
+ Start = bs_subst_ctx(NewPos, CtxChain),
+ [_,FromPos|_] = Args,
+ case PosMap0 of
+ #{Start:=FromPos} ->
+ %% Same position, no restore needed.
+ PosMap = case bs_match_type(I) of
+ plain ->
+ %% Update position to new position.
+ PosMap0#{Start:=NewPos};
+ _ ->
+ %% Position will not change (test_unit
+ %% instruction or no instruction at
+ %% all).
+ PosMap0#{Start:=FromPos}
+ end,
+ bs_restores_is(Is, CtxChain, PosMap, Rs0);
+ #{Start:=_} ->
+ %% Different positions, might need a restore instruction.
+ case bs_match_type(I) of
+ none ->
+ %% The tail test will be optimized away.
+ %% No need to do a restore.
+ PosMap = PosMap0#{Start:=FromPos},
+ bs_restores_is(Is, CtxChain, PosMap, 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).
+ PosMap = PosMap0#{Start:=FromPos},
+ Rs = Rs0#{NewPos=>{Start,FromPos}},
+ bs_restores_is(Is, CtxChain, PosMap, Rs);
+ plain ->
+ %% Match or skip. Position will be changed.
+ PosMap = PosMap0#{Start:=NewPos},
+ Rs = Rs0#{NewPos=>{Start,FromPos}},
+ bs_restores_is(Is, CtxChain, PosMap, Rs)
+ end
+ end;
+bs_restores_is([#b_set{op=bs_extract,args=[FromPos|_]}|Is],
+ CtxChain, PosMap, Rs) ->
+ Start = bs_subst_ctx(FromPos, CtxChain),
+ #{Start:=FromPos} = PosMap, %Assertion.
+ bs_restores_is(Is, CtxChain, PosMap, Rs);
+bs_restores_is([#b_set{op=call,dst=Dst,args=Args}|Is],
+ CtxChain, PosMap0, Rs0) ->
+ {Rs,PosMap1} = bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0),
+ PosMap = bs_invalidate_pos(Args, PosMap1, CtxChain),
+ bs_restores_is(Is, CtxChain, PosMap, Rs);
+bs_restores_is([#b_set{op=landingpad}|Is], CtxChain, PosMap0, Rs) ->
+ %% We can land here from any point, so all positions are invalid.
+ PosMap = maps:map(fun(_Start,_Pos) -> unknown end, PosMap0),
+ bs_restores_is(Is, CtxChain, PosMap, Rs);
+bs_restores_is([#b_set{op=Op,dst=Dst,args=Args}|Is],
+ CtxChain, PosMap0, Rs0)
+ when Op =:= bs_test_tail;
+ Op =:= bs_get_tail ->
+ {Rs,PosMap} = bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0),
+ bs_restores_is(Is, CtxChain, PosMap, Rs);
+bs_restores_is([_|Is], CtxChain, PosMap, Rs) ->
+ bs_restores_is(Is, CtxChain, PosMap, Rs);
+bs_restores_is([], _CtxChain, PosMap, Rs) ->
+ {PosMap,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], PosMap0, CtxChain) ->
+ Start = bs_subst_ctx(Arg, CtxChain),
+ case PosMap0 of
+ #{Start:=_} ->
+ PosMap = PosMap0#{Start:=unknown},
+ bs_invalidate_pos(Args, PosMap, CtxChain);
+ #{} ->
+ %% Not a match context.
+ bs_invalidate_pos(Args, PosMap0, CtxChain)
+ end;
+bs_invalidate_pos([_|Args], PosMap, CtxChain) ->
+ bs_invalidate_pos(Args, PosMap, CtxChain);
+bs_invalidate_pos([], PosMap, _CtxChain) ->
+ PosMap.
+
+bs_restore_args([#b_var{}=Arg|Args], PosMap0, CtxChain, Dst, Rs0) ->
+ Start = bs_subst_ctx(Arg, CtxChain),
+ case PosMap0 of
+ #{Start:=Arg} ->
+ %% Same position, no restore needed.
+ bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0);
+ #{Start:=_} ->
+ %% Different positions, need a restore instruction.
+ PosMap = PosMap0#{Start:=Arg},
+ Rs = Rs0#{Dst=>{Start,Arg}},
+ bs_restore_args(Args, PosMap, CtxChain, Dst, Rs);
+ #{} ->
+ %% Not a match context.
+ bs_restore_args(Args, PosMap0, CtxChain, Dst, Rs0)
+ end;
+bs_restore_args([_|Args], PosMap, CtxChain, Dst, Rs) ->
+ bs_restore_args(Args, PosMap, CtxChain, Dst, Rs);
+bs_restore_args([], PosMap, _CtxChain, _Dst, Rs) ->
+ {Rs,PosMap}.
+
+%% 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_fix_common(CommonUsed, LoopExit, Rm,
+ Blocks0, Count0),
+ Defs = ordsets:subtract(Defs0, CommonUsed),
+ {Blocks,Count} = fix_receive(Rm, Defs, Blocks1, Count1),
+ 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_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.
+%% Find the block to which control is transferred when the
+%% the receive loop is exited.
+
+find_loop_exit([L1,L2|_Ls], Blocks) ->
+ Path1 = beam_ssa:rpo([L1], Blocks),
+ Path2 = beam_ssa:rpo([L2], Blocks),
+ find_loop_exit_1(reverse(Path1), reverse(Path2), none);
+find_loop_exit(_, _) -> none.
+
+find_loop_exit_1([H|T1], [H|T2], _) ->
+ find_loop_exit_1(T1, T2, H);
+find_loop_exit_1(_, _, Exit) -> Exit.
+
+%% 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..426efa2cc9
--- /dev/null
+++ b/lib/compiler/src/beam_ssa_share.erl
@@ -0,0 +1,370 @@
+%%
+%% %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{},fail=Fail}], VarMap, Acc) ->
+ {{br,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..06b42f1928
--- /dev/null
+++ b/lib/compiler/src/beam_ssa_type.erl
@@ -0,0 +1,1956 @@
+%%
+%% %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,partition/2,reverse/1,reverse/2,
+ seq/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);
+ 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, [#b_literal{val=Type}|Args], _Ts, _Ds) ->
+ case {Type,Args} of
+ {new,[_,#b_literal{val=Unit}]} ->
+ {binary,Unit};
+ {append,[_,_,#b_literal{val=Unit}]} ->
+ {binary,Unit};
+ {private_append,[_,_,#b_literal{val=Unit}]} ->
+ {binary,Unit}
+ end;
+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,Max}},
+ #t_tuple{elements=Es0,size=Size}=T} ->
+ %% We know this will land between Min and Max, so kill the
+ %% types for those indexes.
+ Es = maps:without(seq(Min, Max), 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,'++',[List1,List2]} ->
+ case get_type(List1, Ts) =:= cons orelse
+ get_type(List2, Ts) =:= cons of
+ true -> cons;
+ false -> list
+ 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.
+%%
+%% Here is another example, asking about the variable Bool:
+%%
+%% Head = bif:hd L
+%% Bool = succeeded Head
+%%
+%% 'succeeded Head' will evaluate to 'true' if the instrution that
+%% defined Head succeeded. In this case, it is the 'bif:hd L'
+%% instruction, which will succeed if L is 'cons'. Thus, the meet of
+%% the previous type for L and 'cons' will be added to SuccTypes.
+%%
+%% If 'succeeded Head' evaluates to 'false', it means that 'bif:hd L'
+%% failed and that L is not 'cons'. 'cons' can be subtracted from the
+%% previously known type for L and the result put in FailTypes.
+
+infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) ->
+ #{V:=#b_set{op=Op,args=Args}} = Ds,
+ Types0 = infer_type(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'.
+ EqTypes0 = infer_eq_type(Op, Args, Ts, Ds),
+ {Types1,EqTypes} = partition(fun({_,T}) ->
+ is_singleton_type(T)
+ end, EqTypes0),
+
+ Types = Types1 ++ Types0,
+ {meet_types(EqTypes++Types, Ts),subtract_types(Types, Ts)}.
+
+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({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.
+
+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..efd2be94cb 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,203 @@ 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}.
+clobber_map_vals([Key,Dst|T], Map, Vst0) ->
+ case is_reg_defined(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.
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 +1186,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 +1224,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 +1373,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 +1429,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 +1448,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 +1484,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 +1497,8 @@ assert_unique_map_keys([_,_|_]=Ls) ->
%%% New binary matching instructions.
%%%
+bsm_match_state() ->
+ #ms{}.
bsm_match_state(Slots) ->
#ms{slots=Slots}.
@@ -1124,13 +1506,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 +1523,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 +1542,369 @@ 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 = get_term_type(Val, S),
+ update_type(fun meet/2,{tuple,[Index],#{ Key => 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)),
-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}).
+ 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.
+
+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.
+
+is_reg_defined({x,_}=Reg, #vst{current=#st{xs=Xs}}) -> is_map_key(Reg, Xs);
+is_reg_defined({y,_}=Reg, #vst{current=#st{ys=Ys}}) -> is_map_key(Reg, Ys);
+is_reg_defined(V, #vst{}) -> error({not_a_register, V}).
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 +1923,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 +1937,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} Tuple. A test_arity instruction has been seen
+%% {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,Es} Tuple. A test_arity instruction has been seen
%% so that it is known that the size is exactly Sz.
%%
%% {atom,[]} Atom.
@@ -1316,35 +1968,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 +2185,297 @@ 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{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_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_values(Merge, VsA, VsB) ->
+ maps:fold(fun(Spec, New, Acc) ->
+ merge_values_1(Spec, New, VsA, VsB, Acc)
+ end, #{}, Merge).
+
+merge_values_1(Same, Same, VsA, VsB, Acc) ->
+ %% 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}=EntryA = map_get(Same, VsA),
+ #value{type=TypeB}=EntryB = map_get(Same, VsB),
+ Entry = case join(TypeA, TypeB) of
+ TypeA -> EntryA;
+ TypeB -> EntryB;
+ JoinedType -> EntryA#value{type=JoinedType}
+ end,
+ Acc#{ Same => Entry };
+merge_values_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)} }.
+
+merge_fragility(FragileA, FragileB) ->
+ cerl_sets:union(FragileA, FragileB).
merge_stk(S, S) -> S;
merge_stk(_, _) -> undecided.
@@ -1501,135 +2488,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 +2569,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 +2781,190 @@ 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) ->
+ case get_term_type({x,0}, Vst) =:= cons orelse
+ get_term_type({x,1}, Vst) =:= cons of
+ true -> cons;
+ false -> list
+ 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..62cd5b5120 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -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..28db8986ff 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,33 @@ 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, Os) ->
+ [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 +290,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 +434,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 +818,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 +826,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 +858,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 +876,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 +1451,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 +1655,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 +1940,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 +2093,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 +2128,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..3699c9d22e 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},
@@ -2059,17 +2060,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..db8eb7e2e1 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,30 @@ 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_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)
ERL_FILES= $(MODULES:%=%.erl)
CORE_FILES= $(CORE_MODULES:%=%.core)
@@ -124,7 +141,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS += +clint +clint0
+ERL_COMPILE_FLAGS += +clint +clint0 +ssalint
EBIN = .
@@ -132,15 +149,24 @@ 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)
$(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)
@@ -161,12 +187,21 @@ 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 $@));' $< > $@
+
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
@@ -179,7 +214,9 @@ 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) "$(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..8e3b373d29 100644
--- a/lib/compiler/test/beam_except_SUITE.erl
+++ b/lib/compiler/test/beam_except_SUITE.erl
@@ -21,7 +21,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
- multiple_allocs/1,coverage/1]).
+ multiple_allocs/1,bs_get_tail/1,coverage/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -31,6 +31,7 @@ all() ->
groups() ->
[{p,[parallel],
[multiple_allocs,
+ bs_get_tail,
coverage]}].
init_per_suite(Config) ->
@@ -63,6 +64,17 @@ 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_1(<<_:32, Rest/binary>>, Z1, Z2, F1) ->
+ {Rest,Z1,Z2,F1}.
+
coverage(_) ->
File = {file,"fake.erl"},
ok = fc(a),
@@ -72,9 +84,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 +102,24 @@ 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]).
+
+id(I) -> I.
+
-file("fake.erl", 1).
fc(a) -> %Line 2
ok; %Line 3
@@ -96,3 +131,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..15cf9bcbf3
--- /dev/null
+++ b/lib/compiler/test/beam_ssa_SUITE.erl
@@ -0,0 +1,497 @@
+%%
+%% %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]).
+
+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
+ ]}].
+
+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(),
+
+ 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}).
+
+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(0).
+
+do_share_opt(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.
+
+
+%% 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..882e281a44 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -21,9 +21,10 @@
-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]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -33,6 +34,7 @@ all() ->
groups() ->
[{p,[parallel],
[integers,
+ numbers,
coverage,
booleans,
setelement,
@@ -43,7 +45,9 @@ groups() ->
float_compare,
arity_checks,
elixir_binaries,
- find_best
+ find_best,
+ test_size,
+ cover_lists_functions
]}].
init_per_suite(Config) ->
@@ -113,8 +117,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 +127,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,15 +221,52 @@ 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,
@@ -181,13 +275,59 @@ setelement(_Config) ->
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 +464,28 @@ 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.
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..de5a3c2873 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]).
-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]}].
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,105 @@ 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)}.
+
%%%-------------------------------------------------------------------------
transform_remove(Remove, Module) ->
@@ -637,3 +737,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..41e4918b1e 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,10 @@
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]).
-export([coverage_id/1,coverage_external_ignore/2]).
@@ -57,8 +60,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 +77,10 @@ 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]}].
init_per_suite(Config) ->
@@ -97,6 +103,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 +270,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 +332,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 +491,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 +510,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 +758,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 +866,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 +1863,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 +1875,113 @@ 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_1(<<0, 1, 2>>).
+
+restore_on_call_1(<<0, Rest/binary>>) ->
+ <<2>> = restore_on_call_2(Rest),
+ <<2>> = restore_on_call_2(Rest), %% {badmatch, <<>>} on missing restore.
+ ok.
+
+restore_on_call_2(<<1, Rest/binary>>) -> Rest;
+restore_on_call_2(Other) -> Other.
+
+%% '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).
+
+
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_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..1df0a05275 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -249,6 +249,13 @@ 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) ->
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 6ad73b46f7..ed0a56f064 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -35,8 +35,7 @@
basic_andalso_orelse/1,traverse_dcd/1,
check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
bad_constants/1,bad_guards/1,
- guard_in_catch/1,beam_bool_SUITE/1,
- cover_beam_dead/1]).
+ guard_in_catch/1,beam_bool_SUITE/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -54,8 +53,7 @@ groups() ->
rel_ops,rel_op_combinations,
literal_type_tests,basic_andalso_orelse,traverse_dcd,
check_qlc_hrl,andalso_semi,t_tuple_size,binary_part,
- bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE,
- cover_beam_dead]}].
+ bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE]}].
init_per_suite(Config) ->
test_lib:recompile(?MODULE),
@@ -1297,6 +1295,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 +1354,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 +1400,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 +1518,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 +1573,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 +1829,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 +1850,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 +2261,6 @@ 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),
-
- ok.
-
%% Call this function to turn off constant propagation.
id(I) -> I.
diff --git a/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S b/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S
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..94bfbb0efe 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -25,7 +25,7 @@
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]).
-include_lib("common_test/include/ct.hrl").
@@ -40,7 +40,8 @@ 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]}].
init_per_suite(Config) ->
@@ -254,6 +255,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 +282,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 +469,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 +480,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 +506,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 +528,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 +589,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 +664,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 +696,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 +871,35 @@ 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}.
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..0038eb1a4b 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]).
-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]}].
init_per_suite(Config) ->
@@ -378,4 +380,51 @@ 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}).
+
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..3348c6e9ea 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,40 @@ 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),
+ Data = re:replace(Data4, "_no_module_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) ->