aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/asn1/Makefile9
-rw-r--r--lib/common_test/Makefile4
-rw-r--r--lib/compiler/Makefile3
-rw-r--r--lib/compiler/src/Makefile8
-rw-r--r--lib/compiler/src/beam_asm.erl23
-rw-r--r--lib/compiler/src/beam_block.erl39
-rw-r--r--lib/compiler/src/beam_call_types.erl551
-rw-r--r--lib/compiler/src/beam_clean.erl52
-rw-r--r--lib/compiler/src/beam_dict.erl22
-rw-r--r--lib/compiler/src/beam_disasm.erl7
-rw-r--r--lib/compiler/src/beam_except.erl255
-rw-r--r--lib/compiler/src/beam_kernel_to_ssa.erl171
-rw-r--r--lib/compiler/src/beam_ssa.erl60
-rw-r--r--lib/compiler/src/beam_ssa.hrl12
-rw-r--r--lib/compiler/src/beam_ssa_bsm.erl10
-rw-r--r--lib/compiler/src/beam_ssa_codegen.erl153
-rw-r--r--lib/compiler/src/beam_ssa_dead.erl8
-rw-r--r--lib/compiler/src/beam_ssa_lint.erl198
-rw-r--r--lib/compiler/src/beam_ssa_opt.erl135
-rw-r--r--lib/compiler/src/beam_ssa_pre_codegen.erl265
-rw-r--r--lib/compiler/src/beam_ssa_share.erl4
-rw-r--r--lib/compiler/src/beam_ssa_type.erl1766
-rw-r--r--lib/compiler/src/beam_trim.erl7
-rw-r--r--lib/compiler/src/beam_types.erl778
-rw-r--r--lib/compiler/src/beam_types.hrl88
-rw-r--r--lib/compiler/src/beam_validator.erl1756
-rw-r--r--lib/compiler/src/cerl_sets.erl65
-rw-r--r--lib/compiler/src/compile.erl13
-rw-r--r--lib/compiler/src/compiler.app.src3
-rwxr-xr-xlib/compiler/src/genop.tab6
-rw-r--r--lib/compiler/src/sys_core_fold.erl414
-rw-r--r--lib/compiler/src/v3_kernel.erl291
-rw-r--r--lib/compiler/test/Makefile3
-rw-r--r--lib/compiler/test/beam_ssa_SUITE.erl107
-rw-r--r--lib/compiler/test/beam_types_SUITE.erl124
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl46
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S48
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl162
-rw-r--r--lib/compiler/test/compile_SUITE.erl38
-rw-r--r--lib/compiler/test/guard_SUITE.erl123
-rw-r--r--lib/compiler/test/misc_SUITE.erl33
-rw-r--r--lib/compiler/test/property_test/beam_types_prop.erl228
-rw-r--r--lib/compiler/test/test_lib.erl2
-rw-r--r--lib/crypto/Makefile1
-rw-r--r--lib/crypto/c_src/atoms.c4
-rw-r--r--lib/crypto/c_src/atoms.h2
-rw-r--r--lib/crypto/c_src/crypto.c2
-rw-r--r--lib/crypto/c_src/evp.c27
-rw-r--r--lib/crypto/src/crypto.erl22
-rw-r--r--lib/crypto/test/crypto_SUITE.erl36
-rw-r--r--lib/debugger/Makefile4
-rw-r--r--lib/dialyzer/Makefile3
-rw-r--r--lib/diameter/Makefile5
-rw-r--r--lib/edoc/Makefile9
-rw-r--r--lib/eldap/Makefile3
-rw-r--r--lib/eldap/doc/src/eldap.xml2
-rw-r--r--lib/erl_docgen/Makefile2
-rw-r--r--lib/erl_docgen/priv/bin/specs_gen.escript2
-rw-r--r--lib/erl_docgen/priv/dtd/common.dtd2
-rw-r--r--lib/erl_interface/Makefile2
-rw-r--r--lib/erl_interface/include/ei.h13
-rw-r--r--lib/erl_interface/src/connect/ei_connect.c4
-rw-r--r--lib/erl_interface/src/connect/ei_resolve.c12
-rw-r--r--lib/erl_interface/src/encode/encode_pid.c11
-rw-r--r--lib/erl_interface/src/encode/encode_port.c11
-rw-r--r--lib/erl_interface/src/encode/encode_ref.c10
-rw-r--r--lib/erl_interface/src/epmd/ei_epmd.h5
-rw-r--r--lib/erl_interface/src/epmd/epmd_publish.c28
-rw-r--r--lib/erl_interface/src/misc/ei_portio.c2
-rw-r--r--lib/erl_interface/src/prog/erl_call.c3
-rw-r--r--lib/erl_interface/test/erl_eterm_SUITE.erl10
-rw-r--r--lib/et/Makefile3
-rw-r--r--lib/eunit/Makefile10
-rw-r--r--lib/ftp/Makefile40
-rw-r--r--lib/hipe/Makefile3
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl54
-rw-r--r--lib/inets/Makefile40
-rw-r--r--lib/jinterface/Makefile1
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java6
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java6
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java7
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java50
-rw-r--r--lib/kernel/Makefile2
-rw-r--r--lib/kernel/doc/src/file.xml23
-rw-r--r--lib/kernel/doc/src/seq_trace.xml57
-rw-r--r--lib/kernel/src/erl_epmd.erl11
-rw-r--r--lib/kernel/src/erts_debug.erl11
-rw-r--r--lib/kernel/src/file.erl22
-rw-r--r--lib/kernel/src/file_io_server.erl8
-rw-r--r--lib/kernel/src/raw_file_io_compressed.erl6
-rw-r--r--lib/kernel/src/raw_file_io_delayed.erl6
-rw-r--r--lib/kernel/src/raw_file_io_list.erl7
-rw-r--r--lib/kernel/src/seq_trace.erl20
-rw-r--r--lib/kernel/test/erl_distribution_wb_SUITE.erl58
-rw-r--r--lib/kernel/test/file_SUITE.erl195
-rw-r--r--lib/kernel/test/gen_tcp_api_SUITE.erl7
-rw-r--r--lib/kernel/test/seq_trace_SUITE.erl100
-rw-r--r--lib/megaco/Makefile36
-rw-r--r--lib/mnesia/Makefile1
-rw-r--r--lib/observer/Makefile2
-rw-r--r--lib/observer/test/ttb_SUITE.erl10
-rw-r--r--lib/odbc/Makefile8
-rw-r--r--lib/os_mon/Makefile1
-rw-r--r--lib/os_mon/test/cpu_sup_SUITE.erl76
-rw-r--r--lib/parsetools/Makefile1
-rw-r--r--lib/public_key/Makefile3
-rw-r--r--lib/reltool/Makefile3
-rw-r--r--lib/runtime_tools/Makefile2
-rw-r--r--lib/sasl/Makefile3
-rw-r--r--lib/snmp/Makefile48
-rw-r--r--lib/ssh/Makefile2
-rw-r--r--lib/ssl/Makefile2
-rw-r--r--lib/stdlib/Makefile4
-rw-r--r--lib/stdlib/doc/src/erl_parse.xml19
-rw-r--r--lib/stdlib/src/erl_parse.yrl2
-rw-r--r--lib/stdlib/test/ets_SUITE.erl134
-rw-r--r--lib/stdlib/test/ets_SUITE_data/visualize_throughput.html137
-rw-r--r--lib/syntax_tools/Makefile2
-rw-r--r--lib/syntax_tools/src/epp_dodger.erl2
-rw-r--r--lib/syntax_tools/src/erl_prettypr.erl12
-rw-r--r--lib/syntax_tools/src/erl_syntax.erl97
-rw-r--r--lib/syntax_tools/src/erl_syntax_lib.erl5
-rw-r--r--lib/syntax_tools/src/erl_tidy.erl12
-rw-r--r--lib/tftp/Makefile34
-rw-r--r--lib/tools/Makefile3
-rw-r--r--lib/tools/test/cprof_SUITE.erl12
-rw-r--r--lib/wx/Makefile2
-rw-r--r--lib/xmerl/Makefile8
128 files changed, 5663 insertions, 4100 deletions
diff --git a/lib/asn1/Makefile b/lib/asn1/Makefile
index 26e7e37924..10a8795703 100644
--- a/lib/asn1/Makefile
+++ b/lib/asn1/Makefile
@@ -54,12 +54,7 @@ SPECIAL_TARGETS =
include $(ERL_TOP)/make/otp_subdir.mk
-.PHONY: info version
-
-info:
- @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)"
- @echo "APP_DIR: $(APP_DIR)"
- @echo "APP_TAR_FILE: $(APP_TAR_FILE)"
+.PHONY: version
version:
@echo "$(VSN)"
@@ -100,3 +95,5 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME))
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/common_test/Makefile b/lib/common_test/Makefile
index f2065b8a0d..5ac76f0044 100644
--- a/lib/common_test/Makefile
+++ b/lib/common_test/Makefile
@@ -45,3 +45,7 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=compiler tools crypto runtime_tools syntax_tools ftp inets \
+ debugger sasl snmp ssh reltool observer xmerl
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/compiler/Makefile b/lib/compiler/Makefile
index b8b2f562a2..f18df11e9f 100644
--- a/lib/compiler/Makefile
+++ b/lib/compiler/Makefile
@@ -36,3 +36,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=crypto hipe
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 87b0d345f2..f253f31d13 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -49,10 +49,10 @@ MODULES = \
beam_a \
beam_asm \
beam_block \
+ beam_call_types \
beam_clean \
beam_dict \
beam_disasm \
- beam_except \
beam_flatten \
beam_jump \
beam_listing \
@@ -72,6 +72,7 @@ MODULES = \
beam_ssa_type \
beam_kernel_to_ssa \
beam_trim \
+ beam_types \
beam_utils \
beam_validator \
beam_z \
@@ -104,6 +105,7 @@ HRL_FILES= \
beam_disasm.hrl \
beam_ssa_opt.hrl \
beam_ssa.hrl \
+ beam_types.hrl \
core_parse.hrl \
v3_kernel.hrl
@@ -190,6 +192,7 @@ release_docs_spec:
# Dependencies -- alphabetically, please
# ----------------------------------------------------
+$(EBIN)/beam_call_types.beam: beam_types.hrl
$(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.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
@@ -204,7 +207,8 @@ $(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)/beam_ssa_type.beam: beam_ssa.hrl beam_types.hrl
+$(EBIN)/beam_types.beam: beam_types.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
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index df09dcb06c..60e19ec596 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -64,11 +64,30 @@ module(Code, ExtraChunks, CompileInfo, CompilerOpts) ->
assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) ->
{1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
{0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
+ Dict2 = shared_fun_wrappers(CompilerOpts, Dict1),
NumFuncs = length(Asm0),
{Asm,Attr} = on_load(Asm0, Attr0),
Exp = cerl_sets:from_list(Exp0),
- {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
- build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts).
+ {Code,Dict} = assemble_1(Asm, Exp, Dict2, []),
+ build_file(Code, Attr, Dict, NumLabels, NumFuncs,
+ ExtraChunks, CompileInfo, CompilerOpts).
+
+shared_fun_wrappers(Opts, Dict) ->
+ case proplists:get_bool(no_shared_fun_wrappers, Opts) of
+ false ->
+ %% The compiler in OTP 23 depends on the on the loader
+ %% using the new indices in funs and being able to have
+ %% multiple make_fun2 instructions referring to the same
+ %% fun entry. Artificially set the highest opcode for the
+ %% module to ensure that it cannot be loaded in OTP 22
+ %% and earlier.
+ Swap = beam_opcodes:opcode(swap, 2),
+ beam_dict:opcode(Swap, Dict);
+ true ->
+ %% Fun wrappers are not shared for compatibility with a
+ %% previous OTP release.
+ Dict
+ end.
on_load(Fs0, Attr0) ->
case proplists:get_value(on_load, Attr0) of
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 707974b2c1..a734ca3a10 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -33,8 +33,9 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
function({function,Name,Arity,CLabel,Is0}) ->
try
- Is1 = blockify(Is0),
- Is = embed_lines(Is1),
+ Is1 = swap_opt(Is0),
+ Is2 = blockify(Is1),
+ Is = embed_lines(Is2),
{function,Name,Arity,CLabel,Is}
catch
Class:Error:Stack ->
@@ -42,6 +43,40 @@ function({function,Name,Arity,CLabel,Is0}) ->
erlang:raise(Class, Error, Stack)
end.
+%%%
+%%% Try to use a `swap` instruction instead of a sequence of moves.
+%%%
+%%% Note that beam_ssa_codegen generates `swap` instructions only for
+%%% the moves within a single SSA instruction (such as `call`), not
+%%% for the moves generated by a sequence of SSA instructions.
+%%% Therefore, this optimization is needed.
+%%%
+
+swap_opt([{move,Reg1,{x,X}=Temp}=Move1,
+ {move,Reg2,Reg1}=Move2,
+ {move,Temp,Reg2}=Move3|Is]) when Reg1 =/= Temp ->
+ case is_unused(X, Is) of
+ true ->
+ [{swap,Reg1,Reg2}|swap_opt(Is)];
+ false ->
+ [Move1|swap_opt([Move2,Move3|Is])]
+ end;
+swap_opt([I|Is]) ->
+ [I|swap_opt(Is)];
+swap_opt([]) -> [].
+
+is_unused(X, [{call,A,_}|_]) when A =< X -> true;
+is_unused(X, [{call_ext,A,_}|_]) when A =< X -> true;
+is_unused(X, [{make_fun2,_,_,_,A}|_]) when A =< X -> true;
+is_unused(X, [{move,Src,Dst}|Is]) ->
+ case {Src,Dst} of
+ {{x,X},_} -> false;
+ {_,{x,X}} -> true;
+ {_,_} -> is_unused(X, Is)
+ end;
+is_unused(X, [{line,_}|Is]) -> is_unused(X, Is);
+is_unused(_, _) -> false.
+
%% blockify(Instructions0) -> Instructions
%% Collect sequences of instructions to basic blocks.
%% Also do some simple optimations on instructions outside the blocks.
diff --git a/lib/compiler/src/beam_call_types.erl b/lib/compiler/src/beam_call_types.erl
new file mode 100644
index 0000000000..904d82a62d
--- /dev/null
+++ b/lib/compiler/src/beam_call_types.erl
@@ -0,0 +1,551 @@
+%%
+%% %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%
+%%
+
+-module(beam_call_types).
+
+-include("beam_types.hrl").
+
+-import(lists, [duplicate/2,foldl/3]).
+
+-export([will_succeed/3, types/3]).
+
+%%
+%% Returns whether a call will succeed or not.
+%%
+%% Note that it only answers 'yes' for functions in the 'erlang' module as
+%% calls to other modules may fail due to not being loaded, even if we consider
+%% the module to be known.
+%%
+
+-spec will_succeed(Mod, Func, ArgTypes) -> Result when
+ Mod :: atom(),
+ Func :: atom(),
+ ArgTypes :: [normal_type()],
+ Result :: yes | no | maybe.
+
+will_succeed(erlang, BoolOp, [LHS, RHS]) when BoolOp =:= 'and';
+ BoolOp =:= 'or' ->
+ case {succeeds_if_type(LHS, beam_types:make_boolean()),
+ succeeds_if_type(RHS, beam_types:make_boolean())} of
+ {yes, yes} -> yes;
+ {no, _} -> no;
+ {_, no} -> no;
+ {_, _} -> maybe
+ end;
+will_succeed(erlang, bit_size, [Arg]) ->
+ succeeds_if_type(Arg, #t_bitstring{});
+will_succeed(erlang, byte_size, [Arg]) ->
+ succeeds_if_type(Arg, #t_bitstring{});
+will_succeed(erlang, map_size, [Arg]) ->
+ succeeds_if_type(Arg, #t_map{});
+will_succeed(erlang, 'not', [Arg]) ->
+ succeeds_if_type(Arg, beam_types:make_boolean());
+will_succeed(erlang, setelement, [#t_integer{elements={Min,Max}},
+ #t_tuple{exact=Exact,size=Size}, _]) ->
+ case Min >= 1 andalso Max =< Size of
+ true -> yes;
+ false when Exact -> no;
+ false -> maybe
+ end;
+will_succeed(erlang, size, [Arg]) ->
+ succeeds_if_type(Arg, #t_bitstring{});
+will_succeed(erlang, tuple_size, [Arg]) ->
+ succeeds_if_type(Arg, #t_tuple{});
+will_succeed(Mod, Func, Args) ->
+ Arity = length(Args),
+ case erl_bifs:is_safe(Mod, Func, Arity) of
+ true ->
+ yes;
+ false ->
+ case erl_bifs:is_exit_bif(Mod, Func, Arity) of
+ true -> no;
+ false -> maybe
+ end
+ end.
+
+succeeds_if_type(ArgType, Required) ->
+ case beam_types:meet(ArgType, Required) of
+ ArgType -> yes;
+ none -> no;
+ _ -> maybe
+ end.
+
+%%
+%% Returns the inferred return and argument types for known functions, and
+%% whether it's safe to subtract argument types on failure.
+%%
+%% Note that the return type will be 'none' if we can statically determine that
+%% the function will fail at runtime.
+%%
+
+-spec types(Mod, Func, ArgTypes) -> {RetType, ArgTypes, CanSubtract} when
+ Mod :: atom(),
+ Func :: atom(),
+ ArgTypes :: [normal_type()],
+ RetType :: type(),
+ CanSubtract :: boolean().
+
+%% Functions that only fail due to bad argument *types*, meaning it's safe to
+%% subtract argument types on failure.
+%%
+%% Note that these are all from the erlang module; suitable functions in other
+%% modules could fail due to the module not being loaded.
+types(erlang, 'map_size', [_]) ->
+ sub_safe(#t_integer{}, [#t_map{}]);
+types(erlang, 'tuple_size', [_]) ->
+ sub_safe(#t_integer{}, [#t_tuple{}]);
+types(erlang, 'bit_size', [_]) ->
+ sub_safe(#t_integer{}, [#t_bitstring{}]);
+types(erlang, 'byte_size', [_]) ->
+ sub_safe(#t_integer{}, [#t_bitstring{}]);
+types(erlang, 'hd', [_]) ->
+ sub_safe(any, [cons]);
+types(erlang, 'tl', [_]) ->
+ sub_safe(any, [cons]);
+types(erlang, 'length', [_]) ->
+ sub_safe(#t_integer{}, [list]);
+types(erlang, 'not', [_]) ->
+ Bool = beam_types:make_boolean(),
+ sub_safe(Bool, [Bool]);
+
+%% Boolean ops
+types(erlang, 'and', [_,_]) ->
+ Bool = beam_types:make_boolean(),
+ sub_unsafe(Bool, [Bool, Bool]);
+types(erlang, 'or', [_,_]) ->
+ Bool = beam_types:make_boolean(),
+ sub_unsafe(Bool, [Bool, Bool]);
+types(erlang, 'xor', [_,_]) ->
+ Bool = beam_types:make_boolean(),
+ sub_unsafe(Bool, [Bool, Bool]);
+
+%% Bitwise ops
+types(erlang, 'band', [_,_]=Args) ->
+ sub_unsafe(band_return_type(Args), [#t_integer{}, #t_integer{}]);
+types(erlang, 'bor', [_,_]) ->
+ sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]);
+types(erlang, 'bxor', [_,_]) ->
+ sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]);
+types(erlang, 'bsl', [_,_]) ->
+ sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]);
+types(erlang, 'bsr', [_,_]) ->
+ sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]);
+types(erlang, 'bnot', [_]) ->
+ sub_unsafe(#t_integer{}, [#t_integer{}]);
+
+%% Fixed-type arithmetic
+types(erlang, 'float', [_]) ->
+ sub_unsafe(float, [number]);
+types(erlang, 'round', [_]) ->
+ sub_unsafe(#t_integer{}, [number]);
+types(erlang, 'floor', [_]) ->
+ sub_unsafe(#t_integer{}, [number]);
+types(erlang, 'ceil', [_]) ->
+ sub_unsafe(#t_integer{}, [number]);
+types(erlang, 'trunc', [_]) ->
+ sub_unsafe(#t_integer{}, [number]);
+types(erlang, '/', [_,_]) ->
+ sub_unsafe(float, [number, number]);
+types(erlang, 'div', [_,_]) ->
+ sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]);
+types(erlang, 'rem', [_,_]) ->
+ sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]);
+
+%% Mixed-type arithmetic; '+'/2 and friends are handled in the catch-all
+%% clause for the 'erlang' module.
+types(erlang, 'abs', [_]=Args) ->
+ mixed_arith_types(Args);
+
+%% List operations
+types(erlang, '++', [LHS,RHS]) ->
+ %% `[] ++ RHS` yields RHS, even if RHS is not a list.
+ RetType = case {LHS, RHS} of
+ {cons, _} -> cons;
+ {_, cons} -> cons;
+ _ -> beam_types:join(list, RHS)
+ end,
+ sub_unsafe(RetType, [list, any]);
+types(erlang, '--', [_,_]) ->
+ sub_unsafe(list, [list, list]);
+
+%% Misc ops.
+types(erlang, 'binary_part', [_, _]) ->
+ PosLen = make_two_tuple(#t_integer{}, #t_integer{}),
+ Binary = #t_bitstring{unit=8},
+ sub_unsafe(Binary, [Binary, PosLen]);
+types(erlang, 'binary_part', [_, _, _]) ->
+ Binary = #t_bitstring{unit=8},
+ sub_unsafe(Binary, [Binary, #t_integer{}, #t_integer{}]);
+types(erlang, 'is_map_key', [_,_]) ->
+ sub_unsafe(beam_types:make_boolean(), [any,#t_map{}]);
+types(erlang, 'map_get', [_,_]) ->
+ sub_unsafe(any, [any,#t_map{}]);
+types(erlang, 'node', [_]) ->
+ sub_unsafe(#t_atom{}, [any]);
+types(erlang, 'node', []) ->
+ sub_unsafe(#t_atom{}, []);
+types(erlang, 'size', [_]) ->
+ sub_unsafe(#t_integer{}, [any]);
+types(erlang, 'size', [_]) ->
+ sub_unsafe(#t_integer{}, [any]);
+
+%% Tuple element ops
+types(erlang, element, [PosType, TupleType]) ->
+ Index = case PosType of
+ #t_integer{elements={Same,Same}} when is_integer(Same) ->
+ Same;
+ _ ->
+ 0
+ end,
+
+ RetType = case TupleType of
+ #t_tuple{size=Sz,elements=Es} when Index =< Sz,
+ Index >= 1 ->
+ beam_types:get_element_type(Index, Es);
+ _ ->
+ any
+ end,
+
+ sub_unsafe(RetType, [#t_integer{}, #t_tuple{size=Index}]);
+types(erlang, setelement, [PosType, TupleType, ArgType]) ->
+ RetType = case {PosType,TupleType} of
+ {#t_integer{elements={Index,Index}},
+ #t_tuple{elements=Es0,size=Size}=T} when Index >= 1 ->
+ %% This is an exact index, update the type of said
+ %% element or return 'none' if it's known to be out of
+ %% bounds.
+ Es = beam_types:set_element_type(Index, ArgType, 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} when Min >= 1 ->
+ %% We know this will land between Min and Max, so kill
+ %% the types for those indexes.
+ Es = discard_tuple_element_info(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,
+ sub_unsafe(RetType, [#t_integer{}, #t_tuple{}, any]);
+
+types(erlang, make_fun, [_,_,Arity0]) ->
+ Type = case Arity0 of
+ #t_integer{elements={Arity,Arity}} when Arity >= 0 ->
+ #t_fun{arity=Arity};
+ _ ->
+ #t_fun{}
+ end,
+ sub_unsafe(Type, [#t_atom{}, #t_atom{}, #t_integer{}]);
+
+types(erlang, Name, Args) ->
+ Arity = length(Args),
+
+ case erl_bifs:is_exit_bif(erlang, Name, Arity) of
+ true ->
+ {none, Args, false};
+ false ->
+ case erl_internal:arith_op(Name, Arity) of
+ true ->
+ mixed_arith_types(Args);
+ false ->
+ IsTest =
+ erl_internal:new_type_test(Name, Arity) orelse
+ erl_internal:comp_op(Name, Arity),
+
+ RetType = case IsTest of
+ true -> beam_types:make_boolean();
+ false -> any
+ end,
+
+ sub_unsafe(RetType, duplicate(Arity, any))
+ end
+ end;
+
+%%
+%% Math BIFs
+%%
+
+types(math, cos, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, cosh, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, sin, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, sinh, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, tan, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, tanh, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, acos, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, acosh, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, asin, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, asinh, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, atan, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, atanh, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, erf, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, erfc, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, exp, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, log, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, log2, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, log10, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, sqrt, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, atan2, [_,_]) ->
+ sub_unsafe(float, [number, number]);
+types(math, pow, [_,_]) ->
+ sub_unsafe(float, [number, number]);
+types(math, ceil, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, floor, [_]) ->
+ sub_unsafe(float, [number]);
+types(math, fmod, [_,_]) ->
+ sub_unsafe(float, [number, number]);
+types(math, pi, []) ->
+ sub_unsafe(float, []);
+
+%%
+%% List functions
+%%
+
+%% Operator aliases.
+types(lists, append, [_,_]=Args) ->
+ types(erlang, '++', Args);
+types(lists, append, [_]) ->
+ %% This is implemented through folding the list over erlang:'++'/2, so it
+ %% can hypothetically return anything, but we can infer that its argument
+ %% is a list on success.
+ sub_unsafe(any, [list]);
+types(lists, subtract, [_,_]) ->
+ sub_unsafe(list, [list, list]);
+
+%% Functions returning booleans.
+types(lists, all, [_,_]) ->
+ sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, list]);
+types(lists, any, [_,_]) ->
+ sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, list]);
+types(lists, keymember, [_,_,_]) ->
+ sub_unsafe(beam_types:make_boolean(), [any, #t_integer{}, list]);
+types(lists, member, [_,_]) ->
+ sub_unsafe(beam_types:make_boolean(), [any, list]);
+types(lists, prefix, [_,_]) ->
+ sub_unsafe(beam_types:make_boolean(), [list, list]);
+types(lists, suffix, [_,_]) ->
+ sub_unsafe(beam_types:make_boolean(), [list, list]);
+
+%% Functions returning plain lists.
+types(lists, dropwhile, [_,_]) ->
+ sub_unsafe(list, [#t_fun{arity=1}, list]);
+types(lists, duplicate, [_,_]) ->
+ sub_unsafe(list, [#t_integer{}, any]);
+types(lists, filter, [_,_]) ->
+ sub_unsafe(list, [#t_fun{arity=1}, list]);
+types(lists, flatten, [_]) ->
+ sub_unsafe(list, [list]);
+types(lists, map, [_Fun, List]) ->
+ sub_unsafe(same_length_type(List), [#t_fun{arity=1}, list]);
+types(lists, reverse, [List]) ->
+ sub_unsafe(same_length_type(List), [list]);
+types(lists, sort, [List]) ->
+ sub_unsafe(same_length_type(List), [list]);
+types(lists, takewhile, [_,_]) ->
+ sub_unsafe(list, [#t_fun{arity=1}, list]);
+types(lists, usort, [List]) ->
+ sub_unsafe(same_length_type(List), [list]);
+types(lists, zip, [A,B]) ->
+ ZipType = lists_zip_type([A,B]),
+ sub_unsafe(ZipType, [ZipType, ZipType]);
+types(lists, zip3, [A,B,C]) ->
+ ZipType = lists_zip_type([A,B,C]),
+ sub_unsafe(ZipType, [ZipType, ZipType, ZipType]);
+types(lists, zipwith, [_,A,B]) ->
+ ZipType = lists_zip_type([A,B]),
+ sub_unsafe(ZipType, [#t_fun{arity=2}, ZipType, ZipType]);
+types(lists, zipwith3, [_,A,B,C]) ->
+ ZipType = lists_zip_type([A,B,C]),
+ sub_unsafe(ZipType, [#t_fun{arity=3}, ZipType, ZipType, ZipType]);
+
+%% Functions with complex return values.
+types(lists, keyfind, [KeyType,PosType,_]) ->
+ TupleType = case PosType of
+ #t_integer{elements={Index,Index}} when is_integer(Index),
+ Index >= 1 ->
+ Es = beam_types:set_element_type(Index, KeyType, #{}),
+ #t_tuple{size=Index,elements=Es};
+ _ ->
+ #t_tuple{}
+ end,
+ RetType = beam_types:join(TupleType, beam_types:make_atom(false)),
+ sub_unsafe(RetType, [any, #t_integer{}, list]);
+types(lists, MapFold, [_Fun, _Init, List])
+ when MapFold =:= mapfoldl; MapFold =:= mapfoldr ->
+ RetType = make_two_tuple(same_length_type(List), any),
+ sub_unsafe(RetType, [#t_fun{arity=2}, any, list]);
+types(lists, partition, [_,_]) ->
+ sub_unsafe(make_two_tuple(list, list), [#t_fun{arity=1}, list]);
+types(lists, search, [_,_]) ->
+ TupleType = make_two_tuple(beam_types:make_atom(value), any),
+ RetType = beam_types:join(TupleType, beam_types:make_atom(false)),
+ sub_unsafe(RetType, [#t_fun{arity=1}, list]);
+types(lists, splitwith, [_,_]) ->
+ sub_unsafe(make_two_tuple(list, list), [#t_fun{arity=1}, list]);
+types(lists, unzip, [List]) ->
+ ListType = same_length_type(List),
+ RetType = make_two_tuple(ListType, ListType),
+ sub_unsafe(RetType, [list]);
+
+%% Catch-all clause for unknown functions.
+
+types(_, _, Args) ->
+ sub_unsafe(any, [any || _ <- Args]).
+
+%%
+%% Helpers
+%%
+
+sub_unsafe(none, ArgTypes) ->
+ %% This is known to fail at runtime, but the type optimization pass
+ %% doesn't yet support cutting a block short at any point, so we
+ %% pretend it's raining instead.
+ %%
+ %% Actual exit BIFs get special treatment in the catch-all clause
+ %% for the 'erlang' module.
+ sub_unsafe(any, ArgTypes);
+sub_unsafe(RetType, ArgTypes) ->
+ {RetType, ArgTypes, false}.
+
+sub_safe(RetType, ArgTypes) ->
+ {RetType, ArgTypes, true}.
+
+mixed_arith_types([FirstType | _]=Args0) ->
+ RetType = foldl(fun(#t_integer{}, #t_integer{}) -> #t_integer{};
+ (#t_integer{}, number) -> number;
+ (#t_integer{}, float) -> float;
+ (float, #t_integer{}) -> float;
+ (float, number) -> float;
+ (float, float) -> float;
+ (number, #t_integer{}) -> number;
+ (number, float) -> float;
+ (number, number) -> number;
+ (any, _) -> number;
+ (_, _) -> none
+ end, FirstType, Args0),
+ sub_unsafe(RetType, [number || _ <- Args0]).
+
+band_return_type([#t_integer{elements={Int,Int}}, RHS]) when is_integer(Int) ->
+ band_return_type_1(RHS, Int);
+band_return_type([LHS, #t_integer{elements={Int,Int}}]) when is_integer(Int) ->
+ band_return_type_1(LHS, Int);
+band_return_type(_) ->
+ #t_integer{}.
+
+band_return_type_1(LHS, Int) ->
+ case LHS of
+ #t_integer{elements={Min0,Max0}} when Max0 - Min0 < 1 bsl 256 ->
+ {Intersection, Union} = range_masks(Min0, Max0),
+
+ Min = Intersection band Int,
+ Max = min(Max0, Union band Int),
+
+ #t_integer{elements={Min,Max}};
+ _ when Int >= 0 ->
+ %% The range is either unknown or too wide, conservatively assume
+ %% that the new range is 0 .. Int.
+ #t_integer{elements={0,Int}};
+ _ when Int < 0 ->
+ %% We can't infer boundaries when the range is unknown and the
+ %% other operand is a negative number, as the latter sign-extends
+ %% to infinity and we can't express an inverted range at the
+ %% moment (cf. X band -8; either less than -7 or greater than 7).
+ #t_integer{}
+ end.
+
+%% Returns two bitmasks describing all possible values between From and To.
+%%
+%% The first contains the bits that are common to all values, and the second
+%% contains the bits that are set by any value in the range.
+range_masks(From, To) when From =< To ->
+ range_masks_1(From, To, 0, -1, 0).
+
+range_masks_1(From, To, BitPos, Intersection, Union) when From < To ->
+ range_masks_1(From + (1 bsl BitPos), To, BitPos + 1,
+ Intersection band From, Union bor From);
+range_masks_1(_From, To, _BitPos, Intersection0, Union0) ->
+ Intersection = To band Intersection0,
+ Union = To bor Union0,
+ {Intersection, Union}.
+
+discard_tuple_element_info(Min, Max, Es) ->
+ foldl(fun(El, Acc) when Min =< El, El =< Max ->
+ maps:remove(El, Acc);
+ (_El, Acc) -> Acc
+ end, Es, maps:keys(Es)).
+
+%% 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.
+
+%% lists:zip/2 and friends only succeed when all arguments have the same
+%% length, so if one of them is cons, we can infer that all of them are cons
+%% on success.
+lists_zip_type(Types) ->
+ foldl(fun(cons, _) -> cons;
+ (_, cons) -> cons;
+ (nil, _) -> nil;
+ (_, T) -> T
+ end, list, Types).
+
+make_two_tuple(Type1, Type2) ->
+ Es0 = beam_types:set_element_type(1, Type1, #{}),
+ Es = beam_types:set_element_type(2, Type2, Es0),
+ #t_tuple{size=2,exact=true,elements=Es}.
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 7299654476..6b2b2ce085 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -34,7 +34,8 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) ->
Used = find_all_used(WorkList, All, cerl_sets:from_list(WorkList)),
Fs1 = remove_unused(Order, Used, All),
{Fs2,Lc} = clean_labels(Fs1),
- Fs = maybe_remove_lines(Fs2, Opts),
+ Fs3 = fix_swap(Fs2, Opts),
+ Fs = maybe_remove_lines(Fs3, Opts),
{ok,{Mod,Exp,Attr,Fs,Lc}}.
%% Determine the rootset, i.e. exported functions and
@@ -137,31 +138,54 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) ->
function_replace([], _, Acc) -> Acc.
%%%
+%%% If compatibility with a previous release (OTP 22 or earlier) has
+%%% been requested, replace swap instructions with a sequence of moves.
+%%%
+
+fix_swap(Fs, Opts) ->
+ case proplists:get_bool(no_swap, Opts) of
+ false -> Fs;
+ true -> fold_functions(fun swap_moves/1, Fs)
+ end.
+
+swap_moves([{swap,Reg1,Reg2}|Is]) ->
+ Temp = {x,1022},
+ [{move,Reg1,Temp},{move,Reg2,Reg1},{move,Temp,Reg2}|swap_moves(Is)];
+swap_moves([I|Is]) ->
+ [I|swap_moves(Is)];
+swap_moves([]) -> [].
+
+%%%
%%% Remove line instructions if requested.
%%%
maybe_remove_lines(Fs, Opts) ->
case proplists:get_bool(no_line_info, Opts) of
false -> Fs;
- true -> remove_lines(Fs)
+ true -> fold_functions(fun remove_lines/1, Fs)
end.
-remove_lines([{function,N,A,Lbl,Is0}|T]) ->
- Is = remove_lines_fun(Is0),
- [{function,N,A,Lbl,Is}|remove_lines(T)];
-remove_lines([]) -> [].
-
-remove_lines_fun([{line,_}|Is]) ->
- remove_lines_fun(Is);
-remove_lines_fun([{block,Bl0}|Is]) ->
+remove_lines([{line,_}|Is]) ->
+ remove_lines(Is);
+remove_lines([{block,Bl0}|Is]) ->
Bl = remove_lines_block(Bl0),
- [{block,Bl}|remove_lines_fun(Is)];
-remove_lines_fun([I|Is]) ->
- [I|remove_lines_fun(Is)];
-remove_lines_fun([]) -> [].
+ [{block,Bl}|remove_lines(Is)];
+remove_lines([I|Is]) ->
+ [I|remove_lines(Is)];
+remove_lines([]) -> [].
remove_lines_block([{set,_,_,{line,_}}|Is]) ->
remove_lines_block(Is);
remove_lines_block([I|Is]) ->
[I|remove_lines_block(Is)];
remove_lines_block([]) -> [].
+
+
+%%%
+%%% Helpers.
+%%%
+
+fold_functions(F, [{function,N,A,Lbl,Is0}|T]) ->
+ Is = F(Is0),
+ [{function,N,A,Lbl,Is}|fold_functions(F, T)];
+fold_functions(_F, []) -> [].
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index b2056332e6..4d0cec857d 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -40,6 +40,7 @@
-type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}.
-type lambda_tab() :: {non_neg_integer(),[lambda_info()]}.
+-type wrapper() :: #{label() => index()}.
-record(asm,
{atoms = #{} :: atom_tab(),
@@ -48,6 +49,7 @@
imports = gb_trees:empty() :: import_tab(),
strings = <<>> :: binary(), %String pool
lambdas = {0,[]} :: lambda_tab(),
+ wrappers = #{} :: wrapper(),
literals = dict:new() :: literal_tab(),
fnames = #{} :: fname_tab(),
lines = #{} :: line_tab(),
@@ -147,11 +149,21 @@ string(BinString, Dict) when is_binary(BinString) ->
-spec lambda(label(), non_neg_integer(), bdict()) ->
{non_neg_integer(), bdict()}.
-lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) ->
- %% Set Index the same as OldIndex.
- Index = OldIndex,
- Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
- {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}.
+lambda(Lbl, NumFree, #asm{wrappers=Wrappers0,
+ lambdas={OldIndex,Lambdas0}}=Dict) ->
+ case Wrappers0 of
+ #{Lbl:=Index} ->
+ %% OTP 23: There old is a fun entry for this wrapper function.
+ %% Share the fun entry.
+ {Index,Dict};
+ #{} ->
+ %% Set Index the same as OldIndex.
+ Index = OldIndex,
+ Wrappers = Wrappers0#{Lbl=>Index},
+ Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
+ {OldIndex,Dict#asm{wrappers=Wrappers,
+ lambdas={OldIndex+1,Lambdas}}}
+ end.
%% Returns the index for a literal (adding it to the literal table if necessary).
%% literal(Literal, Dict) -> {Index,Dict'}
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 7d048716e4..45b69d7e95 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1123,6 +1123,13 @@ resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) ->
{put_tuple2,Dst,{list,List}};
%%
+%% OTP 23.
+%%
+resolve_inst({swap,[_,_]=List},_,_,_) ->
+ [R1,R2] = resolve_args(List),
+ {swap,R1,R2};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
deleted file mode 100644
index 2b9c1b0cf5..0000000000
--- a/lib/compiler/src/beam_except.erl
+++ /dev/null
@@ -1,255 +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_except).
--export([module/2]).
-
-%%% Rewrite certain calls to erlang:error/{1,2} to specialized
-%%% instructions:
-%%%
-%%% erlang:error({badmatch,Value}) => badmatch Value
-%%% erlang:error({case_clause,Value}) => case_end Value
-%%% erlang:error({try_clause,Value}) => try_case_end Value
-%%% erlang:error(if_clause) => if_end
-%%% erlang:error(function_clause, Args) => jump FuncInfoLabel
-%%%
-
--import(lists, [reverse/1,reverse/2,seq/2,splitwith/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
- Is = function_1(Is0),
- {function,Name,Arity,CLabel,Is}
- catch
- Class:Error:Stack ->
- io:fwrite("Function: ~w/~w\n", [Name,Arity]),
- erlang:raise(Class, Error, Stack)
- end.
-
--record(st,
- {lbl :: beam_asm:label(), %func_info label
- loc :: [_], %location for func_info
- arity :: arity() %arity for function
- }).
-
-function_1(Is0) ->
- case Is0 of
- [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] ->
- St = #st{lbl=Lbl,loc=Loc,arity=Arity},
- translate(Is0, St, []);
- [{label,_}|_] ->
- %% No line numbers. The source must be a .S file.
- %% There is no need to do anything.
- Is0
- end.
-
-translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) ->
- translate_1(Ar, I, Is, St, Acc);
-translate([I|Is], St, Acc) ->
- translate(Is, St, [I|Acc]);
-translate([], _, Acc) ->
- reverse(Acc).
-
-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,Acc2} ->
- case {Is,Line,St} of
- {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} ->
- Instr = {jump,{f,Fi}},
- translate(Is, St, [Instr|Acc2]);
- {_,_,_} ->
- %% 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(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,[]} ->
- {yes,What,Is};
- {yes,What,Bl} ->
- {yes,What,[{block,Bl}|Is]}
- end;
-dig_out(_) -> no.
-
-dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) ->
- {yes,if_end,[]};
-dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) ->
- translate_exception(Exc, {literal,Value}, Is, 0);
-dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) ->
- translate_exception(Exc, Value, Is, 3);
-dig_out_block(_) -> no.
-
-translate_exception(badmatch, Val, Is, Words) ->
- {yes,{badmatch,Val},fix_block(Is, Words)};
-translate_exception(case_clause, Val, Is, Words) ->
- {yes,{case_end,Val},fix_block(Is, Words)};
-translate_exception(try_clause, Val, Is, Words) ->
- {yes,{try_case_end,Val},fix_block(Is, Words)};
-translate_exception(_, _, _, _) -> no.
-
-fix_block(Is, 0) ->
- reverse(Is);
-fix_block(Is, Words) ->
- reverse(fix_block_1(Is, Words)).
-
-fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) ->
- 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)];
-fix_block_1([], _Words) ->
- %% Rare. The heap allocation was probably done by a binary
- %% construction instruction.
- [].
-
-dig_out_fc(Arity, Is0) ->
- Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]),
- {Is,Acc0} = splitwith(fun({label,_}) -> false;
- ({test,_,_,_}) -> false;
- (_) -> true
- end, Is0),
- {Regs,Acc} = dig_out_fc_1(reverse(Is), Arity, Regs0, Acc0),
- case Regs of
- #{{x,0}:={atom,function_clause},{x,1}:=Args} ->
- case moves_from_stack(Args, 0, []) of
- {Moves,Arity} ->
- {yes,function_clause,reverse(Moves, Acc)};
- {_,_} ->
- no
- end;
- #{} ->
- no
- end.
-
-dig_out_fc_1([{block,Bl}|Is], Arity, Regs0, Acc) ->
- Regs = dig_out_fc_block(Bl, Regs0),
- dig_out_fc_1(Is, Arity, Regs, Acc);
-dig_out_fc_1([{bs_set_position,_,_}=I|Is], Arity, Regs, Acc) ->
- dig_out_fc_1(Is, Arity, Regs, [I|Acc]);
-dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Arity, Regs0, Acc) ->
- case Src of
- {x,X} when X < Arity ->
- %% The heuristic for determining the number of live
- %% registers is likely to give an incorrect result.
- %% Give up.
- {#{},[]};
- _ ->
- Regs = prune_xregs(Live0, Regs0),
- Live = dig_out_stack_live(Regs, Live0),
- I = {bs_get_tail,Src,Dst,Live},
- dig_out_fc_1(Is, Arity, Regs, [I|Acc])
- end;
-dig_out_fc_1([_|_], _Arity, _Regs, _Acc) ->
- {#{},[]};
-dig_out_fc_1([], _Arity, Regs, Acc) ->
- {Regs,Acc}.
-
-dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) ->
- Regs = prune_xregs(Live, Regs0),
- dig_out_fc_block(Is, Regs);
-dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) ->
- Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}},
- dig_out_fc_block(Is, Regs);
-dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) ->
- Regs = Regs0#{Dst=>get_reg(Src, Regs0)},
- dig_out_fc_block(Is, Regs);
-dig_out_fc_block([{set,_,_,_}|_], _Regs) ->
- %% Unknown instruction. Fail.
- #{};
-dig_out_fc_block([], Regs) -> Regs.
-
-dig_out_stack_live(Regs, Default) ->
- Reg = {x,2},
- case Regs of
- #{Reg:=List} ->
- dig_out_stack_live_1(List, Default);
- #{} ->
- Default
- end.
-
-dig_out_stack_live_1({cons,{arg,N},T}, Live) ->
- dig_out_stack_live_1(T, max(N + 1, Live));
-dig_out_stack_live_1({cons,_,T}, Live) ->
- dig_out_stack_live_1(T, Live);
-dig_out_stack_live_1(nil, Live) ->
- Live;
-dig_out_stack_live_1(_, Live) -> Live.
-
-prune_xregs(Live, Regs) ->
- maps:filter(fun({x,X}, _) -> X < Live end, Regs).
-
-moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I ->
- %% Wrong argument. Give up.
- {[],-1};
-moves_from_stack({cons,H,T}, I, Acc) ->
- case H of
- {arg,I} ->
- moves_from_stack(T, I+1, Acc);
- _ ->
- moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc])
- end;
-moves_from_stack(nil, I, Acc) ->
- {reverse(Acc),I};
-moves_from_stack({literal,[H|T]}, I, Acc) ->
- Cons = {cons,tag_literal(H),tag_literal(T)},
- moves_from_stack(Cons, I, Acc);
-moves_from_stack(_, _, _) ->
- %% Not understood. Give up.
- {[],-1}.
-
-
-get_reg(R, Regs) ->
- case Regs of
- #{R:=Val} -> Val;
- #{} -> R
- end.
-
-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_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl
index df95749fb3..2406a634e6 100644
--- a/lib/compiler/src/beam_kernel_to_ssa.erl
+++ b/lib/compiler/src/beam_kernel_to_ssa.erl
@@ -34,7 +34,7 @@
-type label() :: beam_ssa:label().
%% Main codegen structure.
--record(cg, {lcount=1 :: label(), %Label counter
+-record(cg, {lcount=1 :: label(), %Label counter
bfail=1 :: label(),
catch_label=none :: 'none' | label(),
vars=#{} :: map(), %Defined variables.
@@ -83,6 +83,7 @@ function(#k_fdef{anno=Anno0,func=Name,arity=Arity,
cg_fun(Ke, St0) ->
{UltimateFail,FailIs,St1} = make_failure(badarg, St0),
+ ?EXCEPTION_BLOCK = UltimateFail, %Assertion.
St2 = St1#cg{bfail=UltimateFail,ultimate_failure=UltimateFail},
{B,St} = cg(Ke, St2),
Asm = [{label,0}|B++FailIs],
@@ -279,7 +280,7 @@ 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),
+ {TestIs,St} = make_succeeded(Ctx, {guard, Tf}, St2),
Bis1 = [#b_set{op=bs_start_match,dst=Ctx,
args=[ssa_arg(Src, St)]}] ++ TestIs ++ Bis0,
Bis = finish_bs_matching(Bis1),
@@ -311,6 +312,35 @@ make_cond_branch(Cond, Args, Fail, St0) ->
make_uncond_branch(Fail) ->
#b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}.
+%%
+%% The 'succeeded' instruction needs special treatment in catch blocks to
+%% prevent the checked operation from being optimized away if a later pass
+%% determines that it always fails.
+%%
+
+make_succeeded(Var, {in_catch, CatchLbl}, St0) ->
+ {Bool, St1} = new_ssa_var('@ssa_bool', St0),
+ {Succ, St2} = new_label(St1),
+ {Fail, St} = new_label(St2),
+
+ Check = [#b_set{op=succeeded,dst=Bool,args=[Var]},
+ #b_br{bool=Bool,succ=Succ,fail=Fail}],
+
+ %% Add a dummy block that references the checked variable, ensuring it
+ %% stays alive and that it won't be merged with the landing pad.
+ Trampoline = [{label,Fail},
+ #b_set{op=exception_trampoline,args=[Var]},
+ make_uncond_branch(CatchLbl)],
+
+ {Check ++ Trampoline ++ [{label,Succ}], St};
+make_succeeded(Var, {no_catch, Fail}, St) ->
+ %% Ultimate failure raises an exception, so we must treat it as if it were
+ %% in a catch to keep it from being optimized out.
+ #cg{ultimate_failure=Fail} = St, %Assertion
+ make_succeeded(Var, {in_catch, Fail}, St);
+make_succeeded(Var, {guard, Fail}, St) ->
+ make_cond_branch(succeeded, [Var], Fail, St).
+
%% Instructions for selection of binary segments.
select_bin_segs(Scs, Ivar, Tf, St) ->
@@ -394,7 +424,7 @@ select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf,
<<Val:Bits/little>>
end,
Bits = bit_size(Bin), %Assertion.
- {TestIs,St} = make_cond_branch(succeeded, [Dst], Vf, St1),
+ {TestIs,St} = make_succeeded(Dst, {guard, Vf}, St1),
Set = #b_set{op=bs_match,dst=Dst,
args=[#b_literal{val=string},Ctx,#b_literal{val=Bin}]},
{[Set|TestIs],St}.
@@ -412,7 +442,7 @@ build_bs_instr(Anno, Type, Fail, Ctx, Size, Unit0, Flags0, Dst, St0) ->
#b_set{anno=Anno,op=bs_match,dst=Dst,
args=[TypeArg,Ctx,Flags]}
end,
- {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0),
+ {Is,St} = make_succeeded(Dst, {guard, Fail}, St0),
{[Get|Is],St}.
select_val(#k_val_clause{val=#k_tuple{es=Es},body=B}, V, Vf, St0) ->
@@ -475,7 +505,7 @@ select_extract_map([P|Ps], Src, Fail, St0) ->
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),
+ {TestIs,St2} = make_succeeded(Dst, {guard, Fail}, St1),
{Is,St} = select_extract_map(Ps, Src, Fail, St2),
{[Set|TestIs]++Is,St};
select_extract_map([], _, _, St) ->
@@ -596,7 +626,7 @@ match_fmf(F, LastFail, St0, [H|T]) ->
{Rs,St3} = match_fmf(F, LastFail, St2, T),
{R ++ [{label,Fail}] ++ Rs,St3}.
-%% fail_label(State) -> {Where,FailureLabel}.
+%% fail_context(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
@@ -609,7 +639,7 @@ match_fmf(F, LastFail, St0, [H|T]) ->
%% 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}) ->
+fail_context(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) ->
if
Fail =/= Ult ->
{guard,Fail};
@@ -619,14 +649,6 @@ fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) ->
{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}.
@@ -635,7 +657,7 @@ bif_fail_label(St) ->
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
+ case fail_context(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
@@ -645,7 +667,7 @@ call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) ->
[#k_var{name=DestVar}] = Rs,
St = set_ssa_var(DestVar, #b_literal{val=unused}, St0),
{[make_uncond_branch(Fail),#cg_unreachable{}],St};
- {Catch,Fail} ->
+ FailCtx ->
%% Ordinary function call in a function body.
Args = ssa_args(As, St0),
{Ret,St1} = new_ssa_var(R, St0),
@@ -657,13 +679,9 @@ call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) ->
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
+
+ {TestIs,St} = make_succeeded(Ret, FailCtx, St2),
+ {[Call|TestIs],St}
end.
enter_cg(Func0, As0, Le, St0) ->
@@ -748,8 +766,8 @@ bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) ->
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),
+ FailCtx = fail_context(St1),
+ {Is,St} = make_succeeded(Dst, FailCtx, St1),
{[I|Is],St};
true->
{[I],St1}
@@ -797,7 +815,7 @@ 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),
+ {TestIs,St} = make_succeeded(Dst, {guard, Tl}, St2),
Is = [#b_br{anno=line_anno(Le),bool=#b_literal{val=true},
succ=RecvLbl,fail=RecvLbl},
{label,RecvLbl},
@@ -813,7 +831,7 @@ 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),
+ {WaitIs,St} = make_succeeded(WaitDst, {guard, 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,
@@ -924,9 +942,9 @@ put_cg([#k_var{name=R}], #k_tuple{es=Es}, _Le, St0) ->
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),
+ FailCtx = fail_context(St0),
{Dst,St1} = new_ssa_var(R, St0),
- cg_binary(Dst, Segs, Fail, Le, St1);
+ cg_binary(Dst, Segs, FailCtx, 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) ->
@@ -955,14 +973,14 @@ put_cg([#k_var{name=R}], Con0, _Le, 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),
+ FailCtx = fail_context(St0),
+ {Is,St} = make_succeeded(Dst, FailCtx, St0),
{[PutMap|Is],St}
end.
@@ -970,8 +988,8 @@ put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) ->
%%% Code generation for constructing binaries.
%%%
-cg_binary(Dst, Segs0, Fail, Le, St0) ->
- {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, Fail, St0),
+cg_binary(Dst, Segs0, FailCtx, Le, St0) ->
+ {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, FailCtx, St0),
LineAnno = line_anno(Le),
Anno = Le#k.a,
case PutCode0 of
@@ -980,8 +998,8 @@ cg_binary(Dst, Segs0, Fail, Le, St0) ->
{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),
+ {PutCode,SzCalc1,St2} = cg_bin_put(Segs, FailCtx, St1),
+ {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, FailCtx, St2),
SzCode = cg_bin_anno(SzCode0, LineAnno),
Args = case member(single_use, Anno) of
true ->
@@ -990,14 +1008,14 @@ cg_binary(Dst, Segs0, Fail, Le, St0) ->
[#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),
+ {TestIs,St} = make_succeeded(Dst, FailCtx, St3),
{SzCode ++ [BsInit] ++ TestIs ++ PutCode,St};
[#b_set{op=bs_put}|_] ->
- {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, Fail, St1),
+ {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, FailCtx, 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),
+ {TestIs,St} = make_succeeded(Dst, FailCtx, St2),
{SzCode ++ [BsInit] ++ TestIs ++ PutCode0,St}
end.
@@ -1005,18 +1023,18 @@ cg_bin_anno([Set|Sets], Anno) ->
[Set#b_set{anno=Anno}|Sets];
cg_bin_anno([], _) -> [].
-%% cg_size_calc(PreferredUnit, SzCalc, Fail, St0) ->
+%% cg_size_calc(PreferredUnit, SzCalc, FailCtx, St0) ->
%% {ActualUnit,SizeVariable,SizeCode,St}.
%% Generate size calculation code.
-cg_size_calc(Unit, error, _Fail, St) ->
+cg_size_calc(Unit, error, _FailCtx, 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),
+cg_size_calc(8, [{1,_}|_]=SzCalc, FailCtx, St) ->
+ cg_size_calc(1, SzCalc, FailCtx, St);
+cg_size_calc(8, SzCalc, FailCtx, St0) ->
+ {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, St0),
{#b_literal{val=8},Var,Pre,St};
-cg_size_calc(1, SzCalc0, Fail, St0) ->
+cg_size_calc(1, SzCalc0, FailCtx, St0) ->
SzCalc = map(fun({8,#b_literal{val=Size}}) ->
{1,#b_literal{val=8*Size}};
({8,{{bif,byte_size},Src}}) ->
@@ -1026,54 +1044,54 @@ cg_size_calc(1, SzCalc0, Fail, St0) ->
({_,_}=Pair) ->
Pair
end, SzCalc0),
- {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0),
+ {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, 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_1(SzCalc, FailCtx, St0) ->
+ cg_size_calc_2(SzCalc, #b_literal{val=0}, FailCtx, 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),
+cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, FailCtx, St0) ->
+ {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0),
+ {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1),
+ {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, FailCtx, 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),
+cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, FailCtx, St0) ->
+ {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0),
+ {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, 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),
+cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, FailCtx, St0) ->
+ {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0),
+ {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, 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),
+cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, FailCtx, St0) ->
+ {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0),
+ {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1),
+ {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, FailCtx, St2),
{Sum,Pre0++Pre1++Pre2,St};
-cg_size_calc_2([], Sum, _Fail, St) ->
+cg_size_calc_2([], Sum, _FailCtx, St) ->
{Sum,[],St}.
-cg_size_bif(#b_var{}=Var, _Fail, St) ->
+cg_size_bif(#b_var{}=Var, _FailCtx, St) ->
{Var,[],St};
-cg_size_bif({Name,Src}, Fail, St0) ->
+cg_size_bif({Name,Src}, FailCtx, 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),
+ {TestIs,St} = make_succeeded(Dst, FailCtx, St1),
{Dst,[Bif|TestIs],St}.
-cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _Fail, St) ->
+cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _FailCtx, St) ->
{Val,[],St};
-cg_size_add(A, B, Unit, Fail, St0) ->
+cg_size_add(A, B, Unit, FailCtx, St0) ->
{Dst,St1} = new_ssa_var('@ssa_sum', St0),
- {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1),
+ {TestIs,St} = make_succeeded(Dst, FailCtx, 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(Seg, FailCtx, St) ->
+ cg_bin_put_1(Seg, FailCtx, [], [], St).
cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next},
- Fail, Acc, SzCalcAcc, St0) ->
+ FailCtx, Acc, SzCalcAcc, St0) ->
[Src,Size] = ssa_args([Src0,Size0], St0),
NeedSize = bs_need_size(T),
TypeArg = #b_literal{val=T},
@@ -1083,9 +1101,12 @@ cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next},
true -> [TypeArg,Flags,Src,Size,Unit];
false -> [TypeArg,Flags,Src]
end,
- {Is,St} = make_cond_branch(bs_put, Args, Fail, St0),
+ %% bs_put has its own 'succeeded' logic, and should always jump directly to
+ %% the fail label regardless of whether it's in a catch or not.
+ {_, FailLbl} = FailCtx,
+ {Is,St} = make_cond_branch(bs_put, Args, FailLbl, 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(Next, FailCtx, 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}.
diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl
index 6492d1e1bf..77619368c7 100644
--- a/lib/compiler/src/beam_ssa.erl
+++ b/lib/compiler/src/beam_ssa.erl
@@ -21,7 +21,7 @@
-module(beam_ssa).
-export([add_anno/3,get_anno/2,get_anno/3,
- clobbers_xregs/1,def/2,def_used/2,
+ clobbers_xregs/1,def/2,def_unused/3,
definitions/1,
dominators/1,common_dominators/3,
flatmapfold_instrs_rpo/4,
@@ -79,7 +79,7 @@
-type var_base() :: atom() | non_neg_integer().
-type literal_value() :: atom() | integer() | float() | list() |
- nil() | tuple() | map() | binary().
+ nil() | tuple() | map() | binary() | fun().
-type op() :: {'bif',atom()} | {'float',float_op()} | prim_op() | cg_prim_op().
-type anno() :: #{atom() := any()}.
@@ -101,7 +101,7 @@
'bs_match' | 'bs_put' | 'bs_start_match' | 'bs_test_tail' |
'bs_utf16_size' | 'bs_utf8_size' | 'build_stacktrace' |
'call' | 'catch_end' |
- 'extract' |
+ 'extract' | 'exception_trampoline' |
'get_hd' | 'get_map_element' | 'get_tl' | 'get_tuple_element' |
'has_map_field' |
'is_nonempty_list' | 'is_tagged_tuple' |
@@ -120,10 +120,11 @@
%% Primops only used internally during code generation.
-type cg_prim_op() :: 'bs_get' | 'bs_get_position' | 'bs_match_string' |
'bs_restore' | 'bs_save' | 'bs_set_position' | 'bs_skip' |
- 'copy' | 'put_tuple_arity' | 'put_tuple_element' |
- 'put_tuple_elements' | 'set_tuple_element'.
+ 'copy' | 'match_fail' | 'put_tuple_arity' |
+ 'put_tuple_element' | 'put_tuple_elements' |
+ 'set_tuple_element'.
--import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1,umerge/1]).
+-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1]).
-spec add_anno(Key, Value, Construct) -> Construct when
Key :: atom(),
@@ -319,17 +320,18 @@ def(Ls, Blocks) ->
Blks = [map_get(L, Blocks) || L <- Top],
def_1(Blks, []).
--spec def_used(Ls, Blocks) -> {Def,Used} when
+-spec def_unused(Ls, Used, Blocks) -> {Def,Unused} when
Ls :: [label()],
+ Used :: ordsets:ordset(var_name()),
Blocks :: block_map(),
Def :: ordsets:ordset(var_name()),
- Used :: ordsets:ordset(var_name()).
+ Unused :: ordsets:ordset(var_name()).
-def_used(Ls, Blocks) ->
+def_unused(Ls, Unused, Blocks) ->
Top = rpo(Ls, Blocks),
Blks = [map_get(L, Blocks) || L <- Top],
Preds = cerl_sets:from_list(Top),
- def_used_1(Blks, Preds, [], []).
+ def_unused_1(Blks, Preds, [], Unused).
%% dominators(BlockMap) -> {Dominators,Numbering}.
%% Calculate the dominator tree, returning a map where each entry
@@ -651,34 +653,28 @@ is_commutative('=/=') -> true;
is_commutative('/=') -> true;
is_commutative(_) -> false.
-def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, UsedAcc) ->
- {Def,Used} = def_used_is(Is, Preds, Def0, used(Last)),
- case Used of
- [] ->
- def_used_1(Bs, Preds, Def, UsedAcc);
- [_|_] ->
- def_used_1(Bs, Preds, Def, [Used|UsedAcc])
- end;
-def_used_1([], _Preds, Def0, UsedAcc) ->
- Def = ordsets:from_list(Def0),
- Used = umerge(UsedAcc),
- {Def,Used}.
+def_unused_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, Unused0) ->
+ Unused1 = ordsets:subtract(Unused0, used(Last)),
+ {Def,Unused} = def_unused_is(Is, Preds, Def0, Unused1),
+ def_unused_1(Bs, Preds, Def, Unused);
+def_unused_1([], _Preds, Def, Unused) ->
+ {ordsets:from_list(Def), Unused}.
-def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is],
- Preds, Def0, Used0) ->
+def_unused_is([#b_set{op=phi,dst=Dst,args=Args}|Is],
+ Preds, Def0, Unused0) ->
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) ->
+ Unused1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)],
+ Unused = ordsets:subtract(Unused0, ordsets:from_list(Unused1)),
+ def_unused_is(Is, Preds, Def, Unused);
+def_unused_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Unused0) ->
Def = [Dst|Def0],
- Used = ordsets:union(used(I), Used0),
- def_used_is(Is, Preds, Def, Used);
-def_used_is([], _Preds, Def, Used) ->
- {Def,Used}.
+ Unused = ordsets:subtract(Unused0, used(I)),
+ def_unused_is(Is, Preds, Def, Unused);
+def_unused_is([], _Preds, Def, Unused) ->
+ {Def,Unused}.
def_1([#b_blk{is=Is}|Bs], Def0) ->
Def = def_is(Is, Def0),
diff --git a/lib/compiler/src/beam_ssa.hrl b/lib/compiler/src/beam_ssa.hrl
index fa76b08453..509a94135e 100644
--- a/lib/compiler/src/beam_ssa.hrl
+++ b/lib/compiler/src/beam_ssa.hrl
@@ -62,5 +62,13 @@
-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).
+%% This is a psuedo-block used to express that certain instructions and BIFs
+%% throw exceptions on failure. The code generator rewrites all branches to
+%% this block to {f,0} which causes the instruction to throw an exception
+%% instead of branching.
+%%
+%% Since this is not an ordinary block, it's illegal to merge it with other
+%% blocks, and jumps are only valid when we know that an exception will be
+%% thrown by the operation that branches here; the *block itself* does not
+%% throw an exception.
+-define(EXCEPTION_BLOCK, 1).
diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl
index 1ac9e6a3bb..7a8dc127d7 100644
--- a/lib/compiler/src/beam_ssa_bsm.erl
+++ b/lib/compiler/src/beam_ssa_bsm.erl
@@ -57,6 +57,7 @@
-export([module/2, format_error/1]).
-include("beam_ssa.hrl").
+-include("beam_types.hrl").
-import(lists, [member/2, reverse/1, splitwith/2, map/2, foldl/3, mapfoldl/3,
nth/2, max/1, unzip/1]).
@@ -683,9 +684,9 @@ aca_copy_successors(Lbl0, Blocks0, Counter0) ->
Lbl = maps:get(Lbl0, BRs),
{Lbl, Blocks, Counter}.
-aca_cs_build_brs([?BADARG_BLOCK=Lbl | Path], Counter, Acc) ->
- %% ?BADARG_BLOCK is a marker and not an actual block, so renaming it will
- %% break exception handling.
+aca_cs_build_brs([?EXCEPTION_BLOCK=Lbl | Path], Counter, Acc) ->
+ %% ?EXCEPTION_BLOCK is a marker and not an actual block, so renaming it
+ %% will break exception handling.
aca_cs_build_brs(Path, Counter, Acc#{ Lbl => Lbl });
aca_cs_build_brs([Lbl | Path], Counter0, Acc) ->
aca_cs_build_brs(Path, Counter0 + 1, Acc#{ Lbl => Counter0 });
@@ -883,8 +884,7 @@ annotate_context_parameters(F, ModInfo) ->
%% Assertion.
error(conflicting_parameter_types);
(K, suitable_for_reuse, Acc) ->
- T = beam_validator:type_anno(match_context),
- Acc#{ K => T };
+ Acc#{ K => #t_bs_context{} };
(_K, _V, Acc) ->
Acc
end, TypeAnno0, ParamInfo),
diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl
index 08641e2abc..ff880c6296 100644
--- a/lib/compiler/src/beam_ssa_codegen.erl
+++ b/lib/compiler/src/beam_ssa_codegen.erl
@@ -28,7 +28,7 @@
-include("beam_ssa.hrl").
--import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3,
+-import(lists, [foldl/3,keymember/3,keysort/2,map/2,mapfoldl/3,
reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]).
-record(cg, {lcount=1 :: beam_label(), %Label counter
@@ -37,7 +37,8 @@
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())
+ catches=gb_sets:empty() :: gb_sets:set(ssa_label()),
+ fc_label=1 :: beam_label()
}).
-spec module(beam_ssa:b_module(), [compile:option()]) ->
@@ -114,17 +115,17 @@ functions(Forms, AtomMod) ->
function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) ->
#{func_info:={_,Name,Arity}} = Anno,
try
- assert_badarg_block(Blocks), %Assertion.
+ assert_exception_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},
+ Labels = (St4#cg.labels)#{0=>Entry,?EXCEPTION_BLOCK=>0},
St5 = St4#cg{labels=Labels,used_labels=gb_sets:singleton(Entry),
ultimate_fail=Ult},
- {Body,St} = cg_fun(Blocks, St5),
+ {Body,St} = cg_fun(Blocks, St5#cg{fc_label=Fi}),
Asm = [{label,Fi},line(Anno),
{func_info,AtomMod,{atom,Name},Arity}] ++
add_parameter_annos(Body, Anno) ++
@@ -137,10 +138,10 @@ function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) ->
erlang:raise(Class, Error, Stack)
end.
-assert_badarg_block(Blocks) ->
- %% Assertion: ?BADARG_BLOCK must be the call erlang:error(badarg).
+assert_exception_block(Blocks) ->
+ %% Assertion: ?EXCEPTION_BLOCK must be a call erlang:error(badarg).
case Blocks of
- #{?BADARG_BLOCK:=Blk} ->
+ #{?EXCEPTION_BLOCK:=Blk} ->
#b_blk{is=[#b_set{op=call,dst=Ret,
args=[#b_remote{mod=#b_literal{val=erlang},
name=#b_literal{val=error}},
@@ -148,7 +149,7 @@ assert_badarg_block(Blocks) ->
last=#b_ret{arg=Ret}} = Blk,
ok;
#{} ->
- %% ?BADARG_BLOCK has been removed because it was never used.
+ %% ?EXCEPTION_BLOCK has been removed because it was never used.
ok
end.
@@ -384,6 +385,7 @@ 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(match_fail) -> gc;
classify_heap_need(new_try_tag) -> gc;
classify_heap_need(peek_message) -> gc;
classify_heap_need(put_map) -> gc;
@@ -629,7 +631,7 @@ liveness_get(S, LiveMap) ->
end.
liveness_successors(Terminator) ->
- successors(Terminator) -- [?BADARG_BLOCK].
+ successors(Terminator) -- [?EXCEPTION_BLOCK].
liveness_is([#cg_alloc{}=I0|Is], Regs, Live, Acc) ->
I = I0#cg_alloc{live=num_live(Live, Regs)},
@@ -973,6 +975,12 @@ 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} when Same =:= ?EXCEPTION_BLOCK ->
+ %% An expression in this block *always* throws an exception, so we
+ %% terminate it with an 'if_end' to make sure the validator knows
+ %% that the following instructions won't actually be reached.
+ {Is,St} = cg_block(Is0, none, St0),
+ {Is++[if_end],St};
#cg_br{succ=Same,fail=Same} ->
{Fail,St1} = use_block_label(Same, St0),
{Is,St} = cg_block(Is0, none, St1),
@@ -1178,6 +1186,10 @@ 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=match_fail}=I,
+ #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) ->
+ %% A match_fail instruction in a try/catch block.
+ cg_block([I], none, St);
cg_block([#cg_set{op=get_map_element,dst=Dst0,args=Args0},
#cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) ->
[Dst,Map,Key] = beam_args([Dst0|Args0], St),
@@ -1239,6 +1251,28 @@ cg_block([#cg_set{op=copy}|_]=T0, Context, St0) ->
no ->
{Is,St}
end;
+cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}], none, St) ->
+ Args = beam_args(Args0, St),
+ Is = cg_match_fail(Args, line(Anno), none),
+ {Is,St};
+cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}|T], Context, St0) ->
+ FcLabel = case Context of
+ {return,_,none} ->
+ %% There is no stack frame. If this is a function_clause
+ %% exception, it is safe to jump to the label of the
+ %% func_info instruction.
+ St0#cg.fc_label;
+ _ ->
+ %% This is most probably not a function_clause.
+ %% If this is a function_clause exception
+ %% (rare), it is not safe to jump to the
+ %% func_info label.
+ none
+ end,
+ Args = beam_args(Args0, St0),
+ Is0 = cg_match_fail(Args, line(Anno), FcLabel),
+ {Is1,St} = cg_block(T, Context, St0),
+ {Is0++Is1,St};
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),
@@ -1270,8 +1304,7 @@ cg_copy(T0, St) ->
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 = order_moves(Moves1),
{Moves,T}.
cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) ->
@@ -1512,6 +1545,42 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=Args0},
Is = setup_args(Args++[Func], Anno, Context, St) ++ Line ++ Call,
{Is,St}.
+cg_match_fail([{atom,function_clause}|Args], Line, Fc) ->
+ case Fc of
+ none ->
+ %% There is a stack frame (probably because of inlining).
+ %% Jumping to the func_info label is not allowed by
+ %% beam_validator. Rewrite the instruction as a call to
+ %% erlang:error/2.
+ make_fc(Args, Line);
+ _ ->
+ setup_args(Args) ++ [{jump,{f,Fc}}]
+ end;
+cg_match_fail([{atom,Op}], Line, _Fc) ->
+ [Line,Op];
+cg_match_fail([{atom,Op},Val], Line, _Fc) ->
+ [Line,{Op,Val}].
+
+make_fc(Args, Line) ->
+ %% Recreate the original call to erlang:error/2.
+ Live = foldl(fun({x,X}, A) -> max(X+1, A);
+ (_, A) -> A
+ end, 0, Args),
+ TmpReg = {x,Live},
+ StkMoves = build_stk(reverse(Args), TmpReg, nil),
+ [{test_heap,2*length(Args),Live}|StkMoves] ++
+ [{move,{atom,function_clause},{x,0}},
+ Line,
+ {call_ext,2,{extfunc,erlang,error,2}}].
+
+build_stk([V], _TmpReg, Tail) ->
+ [{put_list,V,Tail,{x,1}}];
+build_stk([V|Vs], TmpReg, Tail) ->
+ I = {put_list,V,Tail,TmpReg},
+ [I|build_stk(Vs, TmpReg, TmpReg)];
+build_stk([], _TmpReg, nil) ->
+ [{move,nil,{x,1}}].
+
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) ->
@@ -1550,15 +1619,15 @@ build_apply(Arity, {return,Val,N}, _Dst) when is_integer(N) ->
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(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) ->
+ Live = get_live(Set),
+ [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}];
cg_instr(Op, Args, Dst, _Set) ->
cg_instr(Op, Args, Dst).
@@ -1728,7 +1797,7 @@ cg_catch(Agg, T0, Context, St0) ->
cg_try(Agg, Tag, T0, Context, St0) ->
{Moves0,T1} = cg_extract(T0, Agg, St0),
- Moves = order_moves(Moves0, {x,3}),
+ Moves = order_moves(Moves0),
[#cg_set{op=kill_try_tag}|T2] = T1,
{T,St} = cg_block(T2, Context, St0),
{[{try_case,Tag}|Moves++T],St}.
@@ -1780,7 +1849,7 @@ linearize(Blocks) ->
Linear = beam_ssa:linearize(Blocks),
linearize_1(Linear, Blocks).
-linearize_1([{?BADARG_BLOCK,_}|Ls], Blocks) ->
+linearize_1([{?EXCEPTION_BLOCK,_}|Ls], Blocks) ->
linearize_1(Ls, Blocks);
linearize_1([{L,Block0}|Ls], Blocks) ->
Block = translate_block(L, Block0, Blocks),
@@ -1884,8 +1953,7 @@ 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).
+ order_moves(Moves).
%% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}].
%% Kill Y registers that will not be used again.
@@ -1905,47 +1973,48 @@ gen_moves([A|As], I, Acc) ->
gen_moves([], _, Acc) ->
keysort(3, Acc).
-%% order_moves([Move], ScratchReg) -> [Move]
+%% order_moves([Move]) -> [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
+%% swap instructions will be 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(Ms) -> order_moves(Ms, []).
-order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) ->
- {Chain,Ms} = collect_chain(Ms0, [M], ScrReg),
+order_moves([{move,_,_}=M|Ms0], Acc0) ->
+ {Chain,Ms} = collect_chain(Ms0, [M]),
Acc = reverse(Chain, Acc0),
- order_moves(Ms, ScrReg, Acc);
-order_moves([], _, Acc) -> Acc.
+ order_moves(Ms, Acc);
+order_moves([], Acc) -> Acc.
-collect_chain(Ms, Path, ScrReg) ->
- collect_chain(Ms, Path, [], ScrReg).
+collect_chain(Ms, Path) ->
+ collect_chain(Ms, Path, []).
-collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) ->
+collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others) ->
case keymember(Src, 3, Path) of
false ->
- collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg);
+ collect_chain(reverse(Others, Ms0), [M|Path], []);
true ->
- %% There is a cycle, which we must break up.
- {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)}
+ %% There is a cycle.
+ {break_up_cycle(M, Path),reverse(Others, Ms0)}
end;
-collect_chain([M|Ms], Path, Others, ScrReg) ->
- collect_chain(Ms, Path, [M|Others], ScrReg);
-collect_chain([], Path, Others, _) ->
+collect_chain([M|Ms], Path, Others) ->
+ collect_chain(Ms, Path, [M|Others]);
+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_cycle({move,Src,_Dst}=M, Path) ->
+ break_up_cycle_1(Src, [M|Path], []).
-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)].
+break_up_cycle_1(Dst, [{move,_Src,Dst}|Path], Acc) ->
+ reverse(Acc, Path);
+break_up_cycle_1(Dst, [{move,S,D}|Path], Acc) ->
+ break_up_cycle_1(Dst, Path, [{swap,S,D}|Acc]).
%%%
%%% General utility functions.
diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl
index e78e4647a8..55ded77d43 100644
--- a/lib/compiler/src/beam_ssa_dead.erl
+++ b/lib/compiler/src/beam_ssa_dead.erl
@@ -760,8 +760,8 @@ 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 -> 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;
@@ -781,9 +781,9 @@ 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 -> 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) ->
if
diff --git a/lib/compiler/src/beam_ssa_lint.erl b/lib/compiler/src/beam_ssa_lint.erl
index a003607dab..224095d4c4 100644
--- a/lib/compiler/src/beam_ssa_lint.erl
+++ b/lib/compiler/src/beam_ssa_lint.erl
@@ -65,13 +65,19 @@ format_error({{_M,F,A},{phi_inside_block, Name, Id}}) ->
[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)]).
+ [F, A, Label, format_instr(I)]);
+format_error({{_M,F,A},{succeeded_not_preceded, I}}) ->
+ io_lib:format("~p/~p: ~ts does not reference the preceding instruction",
+ [F, A, format_instr(I)]);
+format_error({{_M,F,A},{succeeded_not_last, I}}) ->
+ io_lib:format("~p/~p: ~ts is not the last instruction in its block",
+ [F, A, format_instr(I)]).
format_instr(I) ->
[$',beam_ssa_pp:format_instr(I),$'].
format_var(V) ->
- beam_ssa_pp:format_var(#b_var{name=V}).
+ beam_ssa_pp:format_var(V).
validate_function(F) ->
try
@@ -86,34 +92,36 @@ validate_function(F) ->
erlang:raise(Class, Error, Stack)
end.
--type defined_vars() :: gb_sets:set(beam_ssa:var_name()).
+-type defined_vars() :: gb_sets:set(beam_ssa:argument()).
-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() },
+ %% 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),
+ Args = vvars_get_variables(Args),
+ DefVars = gb_sets:from_list(Args),
Entry = 0,
State = #vvars{blocks = Blocks,
branch_def_vars = #{ Entry => DefVars },
defined_vars = DefVars},
- ok = vvars_assert_unique(Blocks, ArgNames),
+ ok = vvars_assert_unique(Blocks, Args),
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
+-spec vvars_assert_unique(Blocks, [beam_ssa:b_var()]) -> ok when
Blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }.
vvars_assert_unique(Blocks, Args) ->
BlockIs = [Is || #b_blk{is=Is} <- maps:values(Blocks)],
@@ -124,12 +132,12 @@ vvars_assert_unique(Blocks, Args) ->
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) ->
+ Is :: list(beam_ssa:b_set()),
+ Defined :: #{ beam_ssa:b_var() => beam_ssa:b_set() }.
+vvars_assert_unique_1([#b_set{dst=Dst}=I|Is], Defined) ->
case Defined of
- #{DstName:=Old} -> throw({redefined_variable, DstName, Old, I});
- _ -> vvars_assert_unique_1(Is, Defined#{DstName=>I})
+ #{Dst:=Old} -> throw({redefined_variable, Dst, Old, I});
+ _ -> vvars_assert_unique_1(Is, Defined#{Dst=>I})
end;
vvars_assert_unique_1([], Defined) ->
Defined.
@@ -141,17 +149,17 @@ vvars_phi_nodes(#vvars{ blocks = Blocks }=State) ->
ok.
-spec vvars_phi_nodes_1(Is, Id, State) -> ok when
- Is :: list(beam_ssa:b_set()),
- Id :: beam_ssa:label(),
- State :: #vvars{}.
+ 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});
+ case [Dst || #b_set{op=phi,dst=Dst} <- Is] of
+ [Var|_] ->
+ throw({phi_inside_block, Var, Id});
[] ->
ok
end;
@@ -161,10 +169,10 @@ vvars_phi_nodes_1([], _Id, _State) ->
%% 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{}.
+ 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]),
@@ -173,34 +181,34 @@ vvars_assert_phi_paths(Phis, I, Id, State) ->
[_|_]=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.
+%% %% 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{}.
+ 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}) ->
+ foreach(fun({Var, From}) ->
BranchKey = {From, Id},
case BranchDefVars of
#{BranchKey:=DefVars} ->
- case gb_sets:is_member(VarName, DefVars) of
+ case gb_sets:is_member(Var, DefVars) of
true -> ok;
- false -> throw({unknown_variable, VarName, I})
+ false -> throw({unknown_variable, Var, I})
end;
#{} ->
- throw({unknown_phi_variable, VarName, BranchKey, I})
+ throw({unknown_phi_variable, Var, BranchKey, I})
end
end, Vars),
Labels = [From || {#b_literal{},From} <- Phis],
@@ -214,32 +222,44 @@ vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks,
end, Labels).
-spec vvars_block(Id, State) -> #vvars{} when
- Id :: beam_ssa:label(),
- State :: #vvars{}.
+ 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{}.
+-spec vvars_block_1(Is, State) -> #vvars{} when
+ Is :: list(#b_set{}),
+ State :: #vvars{}.
vvars_block_1([], State) ->
State;
-vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, op = phi } | Is], State0) ->
+vvars_block_1([#b_set{dst=OpVar,args=OpArgs}=I,
+ #b_set{op=succeeded,args=[OpVar],dst=SuccVar}], State) ->
+ ok = vvars_assert_args(OpArgs, I, State),
+ vvars_save_var(SuccVar, vvars_save_var(OpVar, State));
+vvars_block_1([#b_set{op=succeeded,args=Args}=I | [_|_]], State) ->
+ ok = vvars_assert_args(Args, I, State),
+ %% 'succeeded' must be the last instruction in its block.
+ throw({succeeded_not_last, I});
+vvars_block_1([#b_set{op=succeeded,args=Args}=I], State)->
+ ok = vvars_assert_args(Args, I, State),
+ %% 'succeeded' must be be directly preceded by the operation it checks.
+ throw({succeeded_not_preceded, I});
+vvars_block_1([#b_set{ dst = Dst, op = phi } | Is], State) ->
%% 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)).
+ vvars_block_1(Is, vvars_save_var(Dst, State));
+vvars_block_1([#b_set{ dst = Dst, args = Args }=I | Is], State) ->
+ ok = vvars_assert_args(Args, I, State),
+ vvars_block_1(Is, vvars_save_var(Dst, State)).
-spec vvars_terminator(Terminator, From, State) -> #vvars{} when
- Terminator :: beam_ssa:terminator(),
- From :: beam_ssa:label(),
- State :: #vvars{}.
+ 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;
@@ -264,62 +284,62 @@ vvars_terminator(#b_br{ bool = Arg, succ = Succ, fail = Fail }=I, From, 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{}.
+ 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)],
+ 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)
+ vvars_save_branch(From, To, State)
end, State0, Labels),
foldl(fun(To, State) ->
- vvars_block(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].
+-spec vvars_get_variables(Args) -> list(beam_ssa:b_var()) when
+ Args :: list(beam_ssa:argument()).
+vvars_get_variables(Args) ->
+ [Var || #b_var{}=Var <- 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{}.
+ 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
+ (#b_var{}=Var) ->
+ case gb_sets:is_member(Var, DefVars) of
true -> ok;
- false -> throw({unknown_variable,Name,I})
+ false -> throw({unknown_variable,Var,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{}.
+ 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
+ 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{}.
+ 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,
@@ -335,15 +355,15 @@ vvars_save_branch(From, To, State) ->
end.
-spec vvars_merge_branches(New, Existing) -> defined_vars() when
- New :: defined_vars(),
- Existing :: defined_vars().
+ 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) ->
+-spec vvars_save_var(Var, State) -> #vvars{} when
+ Var :: #b_var{},
+ State :: #vvars{}.
+vvars_save_var(Var, State0) ->
%% vvars_assert_unique guarantees that variables are never set twice.
- DefVars = gb_sets:insert(VarName, State0#vvars.defined_vars),
+ DefVars = gb_sets:insert(Var, 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
index d87c66c272..580abf4ed9 100644
--- a/lib/compiler/src/beam_ssa_opt.erl
+++ b/lib/compiler/src/beam_ssa_opt.erl
@@ -145,7 +145,8 @@ prologue_passes(Opts) ->
?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_cse), % Helps the first type pass.
+ ?PASS(ssa_opt_live), % ...
?PASS(ssa_opt_type_start)],
passes_1(Ps, Opts).
@@ -157,6 +158,9 @@ repeated_passes(Opts) ->
?PASS(ssa_opt_dead),
?PASS(ssa_opt_cse),
?PASS(ssa_opt_tail_phis),
+ ?PASS(ssa_opt_sink),
+ ?PASS(ssa_opt_tuple_size),
+ ?PASS(ssa_opt_record),
?PASS(ssa_opt_type_continue)], %Must run after ssa_opt_dead to
%clean up phi nodes.
passes_1(Ps, Opts).
@@ -172,8 +176,8 @@ epilogue_passes(Opts) ->
?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_blockify),
?PASS(ssa_opt_merge_blocks),
?PASS(ssa_opt_get_tuple_element),
?PASS(ssa_opt_trim_unreachable)],
@@ -898,6 +902,7 @@ cse_suitable(#b_set{}) -> false.
-record(fs,
{s=undefined :: 'undefined' | 'cleared',
regs=#{} :: #{beam_ssa:b_var():=beam_ssa:b_var()},
+ vars=cerl_sets:new() :: cerl_sets:set(),
fail=none :: 'none' | beam_ssa:label(),
non_guards :: gb_sets:set(beam_ssa:label()),
bs :: beam_ssa:block_map()
@@ -910,22 +915,39 @@ ssa_opt_float({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) ->
{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{}) ->
+%% The fconv instruction doesn't support jumping to a fail label, so we have to
+%% skip this optimization if the fail block is a guard.
+%%
+%% We also skip the optimization in blocks that always fail, as it's both
+%% difficult and pointless to rewrite them to use float ops.
+float_can_optimize_blk(#b_blk{last=#b_br{bool=#b_var{},fail=F}},
+ #fs{non_guards=NonGuards}) ->
+ gb_sets:is_member(F, NonGuards);
+float_can_optimize_blk(#b_blk{}, #fs{}) ->
false.
+float_opt([{L,#b_blk{is=[#b_set{op=exception_trampoline,args=[Var]}]}=Blk0} |
+ Bs0], Count0, Fs) ->
+ %% If we've replaced a BIF with float operations, we'll have a lot of extra
+ %% blocks that jump to the same failure block, which may have a trampoline
+ %% that refers to the original operation.
+ %%
+ %% Since the point of the trampoline is to keep the BIF from being removed
+ %% by liveness optimization, we can discard it as the liveness pass leaves
+ %% floats alone.
+ Blk = case cerl_sets:is_element(Var, Fs#fs.vars) of
+ true -> Blk0#b_blk{is=[]};
+ false -> Blk0
+ end,
+ {Bs, Count} = float_opt(Bs0, Count0, Fs),
+ {[{L,Blk}|Bs],Count};
float_opt([{L,Blk}|Bs0], Count0, Fs) ->
- case float_blk_is_in_guard(Blk, Fs) of
+ case float_can_optimize_blk(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};
+ float_opt_1(L, Blk, Bs0, Count0, Fs);
false ->
- %% This block is not inside a guard.
- %% We can do the optimization.
- float_opt_1(L, Blk, Bs0, Count0, Fs)
+ {Bs,Count} = float_opt(Bs0, Count0, Fs),
+ {[{L,Blk}|Bs],Count}
end;
float_opt([], Count, _Fs) ->
{[],Count}.
@@ -1004,12 +1026,12 @@ 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.
+ %% defer flushing to that block as long as it's suitable for optimization.
#b_blk{is=Is} = SuccBlk = map_get(Succ, Blocks),
- SuccIsGuard = float_blk_is_in_guard(SuccBlk, Fs0),
+ CanOptimizeSucc = float_can_optimize_blk(SuccBlk, Fs0),
case Is of
- [#b_set{anno=#{float_op:=_}}|_] when not SuccIsGuard ->
+ [#b_set{anno=#{float_op:=_}}|_] when CanOptimizeSucc ->
%% No flush needed.
{[],Blk0,Fs0,Count0};
_ ->
@@ -1065,21 +1087,22 @@ float_opt_is([], Fs, _Count, _Acc) ->
none.
float_make_op(#b_set{op={bif,Op},dst=Dst,args=As0}=I0,
- Ts, #fs{s=S,regs=Rs0}=Fs, Count0) ->
+ Ts, #fs{s=S,regs=Rs0,vars=Vs0}=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},
+ Vs = cerl_sets:add_element(Dst, Vs0),
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};
+ {[C|Is],Fs#fs{s=cleared,regs=Rs,vars=Vs},Count};
cleared ->
- {Is,Fs#fs{regs=Rs},Count2}
+ {Is,Fs#fs{regs=Rs,vars=Vs},Count2}
end.
float_load([A|As], [T|Ts], Rs0, Count0, Acc) ->
@@ -1208,34 +1231,31 @@ live_opt_is([#b_set{op=phi,dst=Dst}=I|Is], Live, 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
+live_opt_is([#b_set{op=succeeded,dst=SuccDst,args=[MapDst]}=SuccI,
+ #b_set{op=get_map_element,dst=MapDst}=MapI | Is],
+ Live0, Acc) ->
+ case {gb_sets:is_member(SuccDst, Live0),
+ gb_sets:is_member(MapDst, Live0)} of
+ {true, true} ->
+ Live = gb_sets:delete(SuccDst, Live0),
+ live_opt_is([MapI | Is], Live, [SuccI | Acc]);
+ {true, false} ->
+ %% 'get_map_element' is unused; replace 'succeeded' with
+ %% 'has_map_field'
+ NewI = MapI#b_set{op=has_map_field,dst=SuccDst},
+ live_opt_is([NewI | Is], Live0, Acc);
+ {false, true} ->
+ %% 'succeeded' is unused (we know it will succeed); discard it and
+ %% keep 'get_map_element'
+ live_opt_is([MapI | Is], Live0, Acc);
+ {false, false} ->
+ live_opt_is(Is, Live0, Acc)
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))),
+ LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)),
+ Live1 = gb_sets:union(Live0, LiveUsed),
Live = gb_sets:delete(Dst, Live1),
live_opt_is(Is, Live, [I|Acc]);
false ->
@@ -1243,17 +1263,14 @@ live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) ->
true ->
live_opt_is(Is, Live0, Acc);
false ->
- Live = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))),
+ LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)),
+ Live = gb_sets:union(Live0, LiveUsed),
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.
%%%
@@ -1939,6 +1956,10 @@ verify_merge_is(_) ->
is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) ->
false;
+is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=exception_trampoline}|_]}) ->
+ false;
+is_merge_allowed(_, #b_blk{is=[#b_set{op=exception_trampoline}|_]}, #b_blk{}) ->
+ false;
is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) ->
%% The predecessor block must have exactly one successor (L) for
%% the merge to be safe.
@@ -1977,9 +1998,7 @@ is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) ->
%%% extracted values.
%%%
-ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) ->
- Linear = beam_ssa:linearize(Blocks0),
-
+ssa_opt_sink({#st{ssa=Linear}=St, FuncDb}) ->
%% 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
@@ -1988,10 +2007,12 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) ->
{St, FuncDb};
[_|_]=Defs0 ->
Defs = maps:from_list(Defs0),
- {do_ssa_opt_sink(Linear, Defs, St), FuncDb}
+ {do_ssa_opt_sink(Defs, St), FuncDb}
end.
-do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) ->
+do_ssa_opt_sink(Defs, #st{ssa=Linear}=St) ->
+ Blocks0 = maps:from_list(Linear),
+
%% Now find all the blocks that use variables defined by get_tuple_element
%% instructions.
Used = used_blocks(Linear, Defs, []),
@@ -2016,7 +2037,8 @@ do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) ->
From = map_get(V, Defs),
move_defs(V, From, To, A)
end, Blocks0, DefLoc),
- St#st{ssa=Blocks}.
+
+ St#st{ssa=beam_ssa:linearize(Blocks)}.
def_blocks([{L,#b_blk{is=Is}}|Bs]) ->
def_blocks_is(Is, L, def_blocks(Bs));
@@ -2049,6 +2071,7 @@ unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs]) ->
Unsuitable = case Op of
bs_extract -> true;
bs_put -> true;
+ exception_trampoline -> true;
{float,_} -> true;
landingpad -> true;
peek_message -> true;
@@ -2257,13 +2280,15 @@ non_guards(Linear) ->
non_guards_1([{L,#b_blk{is=Is}}|Bs]) ->
case Is of
+ [#b_set{op=exception_trampoline}|_] ->
+ [L | non_guards_1(Bs)];
[#b_set{op=landingpad}|_] ->
[L | non_guards_1(Bs)];
_ ->
non_guards_1(Bs)
end;
non_guards_1([]) ->
- [?BADARG_BLOCK].
+ [?EXCEPTION_BLOCK].
rel2fam(S0) ->
S1 = sofs:relation(S0),
diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl
index 7f816b9802..61c42fdb6d 100644
--- a/lib/compiler/src/beam_ssa_pre_codegen.erl
+++ b/lib/compiler/src/beam_ssa_pre_codegen.erl
@@ -108,7 +108,8 @@ functions([], _Ps, _UseBSM3) -> [].
intervals=[] :: [{b_var(),[range()]}],
res=[] :: [{b_var(),reservation()}] | #{b_var():=reservation()},
regs=#{} :: #{b_var():=ssa_register()},
- extra_annos=[] :: [{atom(),term()}]
+ extra_annos=[] :: [{atom(),term()}],
+ location :: term()
}).
-define(PASS(N), {N,fun N/1}).
@@ -119,7 +120,9 @@ passes(Opts) ->
%% Preliminaries.
?PASS(fix_bs),
+ ?PASS(exception_trampolines),
?PASS(sanitize),
+ ?PASS(match_fail_instructions),
case FixTuples of
false -> ignore;
true -> ?PASS(fix_tuples)
@@ -164,7 +167,9 @@ passes(Opts) ->
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},
+ Location = maps:get(location, Anno, none),
+ St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3,
+ cnt=Count0,location=Location},
St = compile:run_sub_passes(Ps, St0),
#st{ssa=Blocks,cnt=Count,regs=Regs,extra_annos=ExtraAnnos} = St,
F1 = add_extra_annos(F0, ExtraAnnos),
@@ -598,6 +603,10 @@ bs_instrs([{L,#b_blk{is=Is0}=Blk}|Bs], CtxChain, Acc0) ->
bs_instrs([], _, Acc) ->
reverse(Acc).
+bs_instrs_is([#b_set{op=succeeded}=I|Is], CtxChain, Acc) ->
+ %% This instruction refers to a specific operation, so we must not
+ %% substitute the context argument.
+ bs_instrs_is(Is, CtxChain, [I | 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},
@@ -691,6 +700,44 @@ legacy_bs_is([I|Is], Last, IsYreg, Count, Copies, Acc) ->
legacy_bs_is([], _Last, _IsYreg, Count, Copies, Acc) ->
{reverse(Acc),Count,Copies}.
+%% exception_trampolines(St0) -> St.
+%%
+%% Removes the "exception trampolines" that were added to prevent exceptions
+%% from being optimized away.
+
+exception_trampolines(#st{ssa=Blocks0}=St) ->
+ RPO = reverse(beam_ssa:rpo(Blocks0)),
+ Blocks = et_1(RPO, #{}, Blocks0),
+ St#st{ssa=Blocks}.
+
+et_1([L | Ls], Trampolines, Blocks) ->
+ #{ L := #b_blk{is=Is,last=Last0}=Block0 } = Blocks,
+ case {Is, Last0} of
+ {[#b_set{op=exception_trampoline}], #b_br{succ=Succ}} ->
+ et_1(Ls, Trampolines#{ L => Succ }, maps:remove(L, Blocks));
+ {_, #b_br{succ=Same,fail=Same}} when Same =:= ?EXCEPTION_BLOCK ->
+ %% The exception block is just a marker saying that we should raise
+ %% an exception (= {f,0}) instead of jumping to a particular fail
+ %% block. Since it's not a reachable block we can't allow
+ %% unconditional jumps to it except through a trampoline.
+ error({illegal_jump_to_exception_block, L});
+ {_, #b_br{succ=Succ0,fail=Fail0}} ->
+ Succ = maps:get(Succ0, Trampolines, Succ0),
+ Fail = maps:get(Fail0, Trampolines, Fail0),
+ if
+ Succ =/= Succ0; Fail =/= Fail0 ->
+ Last = Last0#b_br{succ=Succ,fail=Fail},
+ Block = Block0#b_blk{last=Last},
+ et_1(Ls, Trampolines, Blocks#{ L := Block });
+ Succ =:= Succ0, Fail =:= Fail0 ->
+ et_1(Ls, Trampolines, Blocks)
+ end;
+ {_, _} ->
+ et_1(Ls, Trampolines, Blocks)
+ end;
+et_1([], _Trampolines, Blocks) ->
+ Blocks.
+
%% sanitize(St0) -> St.
%% Remove constructs that can cause problems later:
%%
@@ -856,6 +903,114 @@ prune_phi(#b_set{args=Args0}=Phi, Reachable) ->
gb_sets:is_element(Pred, Reachable)],
Phi#b_set{args=Args}.
+%%% Rewrite certain calls to erlang:error/{1,2} to specialized
+%%% instructions:
+%%%
+%%% erlang:error({badmatch,Value}) => badmatch Value
+%%% erlang:error({case_clause,Value}) => case_end Value
+%%% erlang:error({try_clause,Value}) => try_case_end Value
+%%% erlang:error(if_clause) => if_end
+%%% erlang:error(function_clause, Args) => jump FuncInfoLabel
+%%%
+%%% In SSA code, we represent those instructions as a 'match_fail'
+%%% instruction with the name of the BEAM instruction as the first
+%%% argument.
+
+match_fail_instructions(#st{ssa=Blocks0,args=Args,location=Location}=St) ->
+ Ls = maps:to_list(Blocks0),
+ Info = {length(Args),Location},
+ Blocks = match_fail_instrs_1(Ls, Info, Blocks0),
+ St#st{ssa=Blocks}.
+
+match_fail_instrs_1([{L,#b_blk{is=Is0}=Blk}|Bs], Arity, Blocks0) ->
+ case match_fail_instrs_blk(Is0, Arity, []) of
+ none ->
+ match_fail_instrs_1(Bs, Arity, Blocks0);
+ Is ->
+ Blocks = Blocks0#{L:=Blk#b_blk{is=Is}},
+ match_fail_instrs_1(Bs, Arity, Blocks)
+ end;
+match_fail_instrs_1([], _Arity, Blocks) -> Blocks.
+
+match_fail_instrs_blk([#b_set{op=put_tuple,dst=Dst,
+ args=[#b_literal{val=Tag},Val]},
+ #b_set{op=call,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ Dst]}=Call|Is],
+ _Arity, Acc) ->
+ match_fail_instr(Call, Tag, Val, Is, Acc);
+match_fail_instrs_blk([#b_set{op=call,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ #b_literal{val={Tag,Val}}]}=Call|Is],
+ _Arity, Acc) ->
+ match_fail_instr(Call, Tag, #b_literal{val=Val}, Is, Acc);
+match_fail_instrs_blk([#b_set{op=call,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ #b_literal{val=if_clause}]}=Call|Is],
+ _Arity, Acc) ->
+ I = Call#b_set{op=match_fail,args=[#b_literal{val=if_end}]},
+ reverse(Acc, [I|Is]);
+match_fail_instrs_blk([#b_set{op=call,anno=Anno,
+ args=[#b_remote{mod=#b_literal{val=erlang},
+ name=#b_literal{val=error}},
+ #b_literal{val=function_clause},
+ Stk]}=Call],
+ {Arity,Location}, Acc) ->
+ case match_fail_stk(Stk, Acc, [], []) of
+ {[_|_]=Vars,Is} when length(Vars) =:= Arity ->
+ case maps:get(location, Anno, none) of
+ Location ->
+ I = Call#b_set{op=match_fail,
+ args=[#b_literal{val=function_clause}|Vars]},
+ Is ++ [I];
+ _ ->
+ %% erlang:error/2 has a different location than the
+ %% func_info instruction at the beginning of the function
+ %% (probably because of inlining). Keep the original call.
+ reverse(Acc, [Call])
+ end;
+ _ ->
+ %% Either the stacktrace could not be picked apart (for example,
+ %% if the call to erlang:error/2 was handwritten) or the number
+ %% of arguments in the stacktrace was different from the arity
+ %% of the host function (because it is the implementation of a
+ %% fun). Keep the original call.
+ reverse(Acc, [Call])
+ end;
+match_fail_instrs_blk([I|Is], Arity, Acc) ->
+ match_fail_instrs_blk(Is, Arity, [I|Acc]);
+match_fail_instrs_blk(_, _, _) ->
+ none.
+
+match_fail_instr(Call, Tag, Val, Is, Acc) ->
+ Op = case Tag of
+ badmatch -> Tag;
+ case_clause -> case_end;
+ try_clause -> try_case_end;
+ _ -> none
+ end,
+ case Op of
+ none ->
+ none;
+ _ ->
+ I = Call#b_set{op=match_fail,args=[#b_literal{val=Op},Val]},
+ reverse(Acc, [I|Is])
+ end.
+
+match_fail_stk(#b_var{}=V, [#b_set{op=put_list,dst=V,args=[H,T]}|Is], IAcc, VAcc) ->
+ match_fail_stk(T, Is, IAcc, [H|VAcc]);
+match_fail_stk(#b_literal{val=[H|T]}, Is, IAcc, VAcc) ->
+ match_fail_stk(#b_literal{val=T}, Is, IAcc, [#b_literal{val=H}|VAcc]);
+match_fail_stk(#b_literal{val=[]}, [], IAcc, VAcc) ->
+ {reverse(VAcc),IAcc};
+match_fail_stk(T, [#b_set{op=Op}=I|Is], IAcc, VAcc)
+ when Op =:= bs_get_tail; Op =:= bs_set_position ->
+ match_fail_stk(T, Is, [I|IAcc], VAcc);
+match_fail_stk(_, _, _, _) -> none.
+
%%%
%%% Fix tuples.
%%%
@@ -911,9 +1066,8 @@ use_set_tuple_element(#st{ssa=Blocks0}=St) ->
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,
+use_ste_1([L|Ls], Uses, Blocks) ->
+ #b_blk{is=Is0} = Blk0 = map_get(L, Blocks),
case use_ste_is(Is0, Uses) of
Is0 ->
use_ste_1(Ls, Uses, Blocks);
@@ -976,69 +1130,6 @@ extract_ste(#b_set{op=call,dst=Dst,
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) ->
@@ -1048,7 +1139,7 @@ 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:=2} -> Acc;
#{Var:=C} -> Acc#{Var:=C+1};
#{} -> Acc#{Var=>1}
end
@@ -1058,16 +1149,6 @@ count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) ->
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;
@@ -1189,10 +1270,10 @@ place_frame_here(L, Blocks, Doms, Frames) ->
Descendants = beam_ssa:rpo([L], Blocks),
PhiPredecessors = phi_predecessors(L, Blocks),
MustDominate = ordsets:from_list(PhiPredecessors ++ Descendants),
- Dominates = all(fun(?BADARG_BLOCK) ->
+ Dominates = all(fun(?EXCEPTION_BLOCK) ->
%% This block defines no variables and calls
%% erlang:error(badarg). It does not matter
- %% whether L dominates ?BADARG_BLOCK or not;
+ %% whether L dominates ?EXCEPTION_BLOCK or not;
%% it is still safe to put the frame in L.
true;
(Bl) ->
@@ -1340,9 +1421,9 @@ recv_common(_Defs, none, _Blocks) ->
%% in the tail position of a function.
[];
recv_common(Defs, Exit, Blocks) ->
- {ExitDefs,ExitUsed} = beam_ssa:def_used([Exit], Blocks),
+ {ExitDefs,ExitUnused} = beam_ssa:def_unused([Exit], Defs, Blocks),
Def = ordsets:subtract(Defs, ExitDefs),
- ordsets:intersection(Def, ExitUsed).
+ ordsets:subtract(Def, ExitUnused).
%% recv_crit_edges([RemoveMessageLabel], LoopExit,
%% Blocks0, Count0) -> {Blocks,Count}.
@@ -1447,9 +1528,9 @@ exit_predecessors([], _Exit, _Blocks) -> [].
%% later used within a clause of the receive.
fix_receive([L|Ls], Defs, Blocks0, Count0) ->
- {RmDefs,Used0} = beam_ssa:def_used([L], Blocks0),
+ {RmDefs,Unused} = beam_ssa:def_unused([L], Defs, Blocks0),
Def = ordsets:subtract(Defs, RmDefs),
- Used = ordsets:intersection(Def, Used0),
+ Used = ordsets:subtract(Def, Unused),
{NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Used], Count0),
Ren = zip(Used, NewVars),
Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0),
@@ -1483,8 +1564,8 @@ find_loop_exit(_, _) ->
%% loop exit block.
none.
-find_loop_exit_1([?BADARG_BLOCK|Ls], RmSet, Dominators) ->
- %% ?BADARG_BLOCK is a marker and not an actual block, so it is not
+find_loop_exit_1([?EXCEPTION_BLOCK|Ls], RmSet, Dominators) ->
+ %% ?EXCEPTION_BLOCK is a marker and not an actual block, so it is not
%% the block we are looking for.
find_loop_exit_1(Ls, RmSet, Dominators);
find_loop_exit_1([L|Ls], RmSet, Dominators) ->
@@ -1756,7 +1837,7 @@ 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|_]} ->
+ {#b_br{succ=Succ,fail=?EXCEPTION_BLOCK},[Succ|_]} ->
true;
{_,_} ->
false
@@ -2105,8 +2186,8 @@ reserve_yregs(#st{frames=Frames}=St0) ->
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),
+ {Def,Unused} = beam_ssa:def_unused([L], Yregs, Blocks0),
+ UsedYregs = ordsets:subtract(Yregs, Unused),
DefBefore = ordsets:subtract(UsedYregs, Def),
{BeforeVars,Blocks,Count} = rename_vars(DefBefore, L, Blocks0, Count0),
InsideVars = ordsets:subtract(UsedYregs, DefBefore),
@@ -2495,9 +2576,9 @@ 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},
+reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?EXCEPTION_BLOCK},
_Blocks, XsMap, _Res) ->
- %% We know that no variables are used at ?BADARG_BLOCK, so
+ %% We know that no variables are used at ?EXCEPTION_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},
diff --git a/lib/compiler/src/beam_ssa_share.erl b/lib/compiler/src/beam_ssa_share.erl
index 73983bd34a..fa728992f8 100644
--- a/lib/compiler/src/beam_ssa_share.erl
+++ b/lib/compiler/src/beam_ssa_share.erl
@@ -117,8 +117,8 @@ share_terminator(_Last, _Blocks) -> none.
%% 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.
+are_equivalent(_Succ, _, ?EXCEPTION_BLOCK, _, _Blocks) ->
+ %% ?EXCEPTION_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) ->
diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl
index 3c06c83e2e..d93191c689 100644
--- a/lib/compiler/src/beam_ssa_type.erl
+++ b/lib/compiler/src/beam_ssa_type.erl
@@ -22,11 +22,12 @@
-export([opt_start/4, opt_continue/4, opt_finish/3]).
-include("beam_ssa_opt.hrl").
--import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2,
- keyfind/3,reverse/1,reverse/2,
- sort/1,split/2]).
+-include("beam_types.hrl").
--define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}).
+-import(lists, [all/2,any/2,droplast/1,duplicate/2,foldl/3,last/1,member/2,
+ keyfind/3,reverse/1,sort/1,split/2,zip/2]).
+
+-define(UNICODE_MAX, (16#10FFFF)).
-record(d,
{ds :: #{beam_ssa:b_var():=beam_ssa:b_set()},
@@ -37,21 +38,6 @@
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
@@ -98,7 +84,8 @@ join_arg_types(Args, ArgTypes, Anno) ->
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))});
+ Type = beam_types:join(maps:values(TM)),
+ join_arg_types_1(Args, TMs, Ts#{ Arg => Type });
join_arg_types_1([Arg | Args], [_TM | TMs], Ts) ->
join_arg_types_1(Args, TMs, Ts#{ Arg => any });
join_arg_types_1([], [], Ts) ->
@@ -122,7 +109,7 @@ opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) ->
D = #d{ func_db=FuncDb0,
func_id=Id,
ds=Defs,
- ls=#{0=>Ts,?BADARG_BLOCK=>#{}},
+ ls=#{0=>Ts,?EXCEPTION_BLOCK=>#{}},
once=UsedOnce },
{Linear, FuncDb, NewRet} = opt(Linear0, D, []),
@@ -157,43 +144,15 @@ opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo)
map_size(TypeMap) =:= 0 ->
opt_finish_1(Args, TypeMaps, ParamInfo);
opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) ->
- case join(maps:values(TypeMap)) of
- any ->
- opt_finish_1(Args, TypeMaps, ParamInfo0);
- none ->
- %% This function will never be called. Pretend that we don't
- %% know the type for this argument.
- opt_finish_1(Args, TypeMaps, ParamInfo0);
- JoinedType ->
- JoinedType = verified_type(JoinedType),
- ParamInfo = ParamInfo0#{ Arg => validator_anno(JoinedType) },
- opt_finish_1(Args, TypeMaps, ParamInfo)
- end;
+ JoinedType = beam_types:join(maps:values(TypeMap)),
+ ParamInfo = case JoinedType of
+ any -> ParamInfo0;
+ _ -> ParamInfo0#{ Arg => JoinedType }
+ end,
+ opt_finish_1(Args, TypeMaps, ParamInfo);
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}.
@@ -212,27 +171,17 @@ opt([], D, Acc) ->
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.
+ {Is,Ts,Ds,Fdb,Sub} = opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []),
+
+ D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb},
+
+ Last1 = simplify_terminator(Last0, Sub, Ts, Ds),
+ Last2 = opt_terminator(Last1, Ts, Ds),
+
+ {Last, D} = update_successors(Last2, Ts, D1),
+
+ Blk = Blk0#b_blk{is=Is,last=Last},
+ opt(Bs, D, [{L,Blk}|Acc]).
simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) ->
Br#b_br{bool=simplify_arg(Bool, Sub, Ts)};
@@ -265,203 +214,138 @@ opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is],
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],
+opt_is([#b_set{op=call,args=Args0}=I0|Is],
+ Ts, Ds, Fdb0, D, Sub, Acc) ->
+ Args = simplify_args(Args0, Sub, Ts),
+ I1 = beam_ssa:normalize(I0#b_set{args=Args}),
+ {I, Fdb} = opt_call(I1, Ts, Fdb0, D),
+ opt_simplify(I, Is, Ts, Ds, Fdb, D, Sub, Acc);
+opt_is([#b_set{op=make_fun,args=Args0}=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],
+ {Ts,Ds,Fdb,I} = opt_make_fun(I1, D, Ts0, Ds0, Fdb0),
+ opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]);
+opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst,anno=Anno}=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
+ Type = case Ds0 of
+ #{ Arg := #b_set{op=call} } ->
+ %% Calls can always throw exceptions and their return types
+ %% are what they return on success, so we must avoid
+ %% simplifying arguments in case `Arg` would become a
+ %% literal, which would trick 'succeeded' into thinking it
+ %% can't fail.
+ type(succeeded, [Arg], Anno, Ts0, Ds0);
+ #{} ->
+ Args = simplify_args([Arg], Sub0, Ts0),
+ type(succeeded, Args, Anno, Ts0, Ds0)
+ end,
+ case beam_types:get_singleton_value(Type) of
+ {ok, Lit} ->
+ Sub = Sub0#{ Dst => #b_literal{val=Lit} },
+ opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc);
+ error ->
+ Ts = Ts0#{ Dst => Type },
+ Ds = Ds0#{ Dst => I },
+ opt_is([], Ts, Ds, Fdb, D, Sub0, [I | Acc])
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
+opt_is([#b_set{args=Args0}=I0|Is],
+ Ts, Ds, Fdb, D, Sub, Acc) ->
+ Args = simplify_args(Args0, Sub, Ts),
+ I = beam_ssa:normalize(I0#b_set{args=Args}),
+ opt_simplify(I, Is, Ts, Ds, Fdb, D, Sub, Acc);
+opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) ->
+ {reverse(Acc), Ts, Ds, Fdb, Sub}.
+
+opt_simplify(#b_set{dst=Dst}=I0, Is, Ts0, Ds0, Fdb, D, Sub0, Acc) ->
+ case simplify(I0, Ts0) of
#b_set{}=I2 ->
I = beam_ssa:normalize(I2),
Ts = update_types(I, Ts0, Ds0),
- Ds = Ds0#{Dst=>I},
+ Ds = Ds0#{ Dst => I },
opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]);
#b_literal{}=Lit ->
- Sub = Sub0#{Dst=>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}},
+ %% We must remove this 'succeeded' instruction since the
+ %% variable it checks is gone.
+ Sub = Sub0#{ Dst => Var, SuccDst => #b_literal{val=true} },
opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc);
_ ->
- Sub = Sub0#{Dst=>Var},
+ 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),
+opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, Ts, Fdb0, D) ->
+ I = opt_local_call_return(I0, Callee, Fdb0),
case Fdb0 of
#{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } ->
+ %% Match contexts are treated as bitstrings when optimizing
+ %% arguments, as we don't yet support removing the
+ %% "bs_start_match3" instruction.
+ Types = [case raw_type(Arg, Ts) of
+ #t_bs_context{} -> #t_bitstring{};
+ Type -> Type
+ end || Arg <- Args],
+
%% 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),
+ ArgTypes = update_arg_types(Types, ArgTypes0, CallId),
Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} },
- {Ts, Ds, Fdb, I};
+ {I, Fdb};
#{} ->
%% 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}
+ {I, Fdb0}
end;
-opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) ->
+opt_call(I, _Ts, Fdb, _D) ->
+ {I, Fdb}.
+
+opt_local_call_return(I, Callee, Fdb) ->
+ case Fdb of
+ #{ Callee := #func_info{ret_type=[Type]} } when Type =/= any ->
+ beam_ssa:add_anno(result_type, Type, I);
+ #{} ->
+ I
+ end.
+
+%% While we have no way to know which arguments a fun will be called with, we
+%% do know its free variables and can update their types as if this were a
+%% local call.
+opt_make_fun(#b_set{op=make_fun,
+ dst=Dst,
+ args=[#b_local{}=Callee | FreeVars]}=I,
+ D, Ts0, Ds0, Fdb0) ->
Ts = update_types(I, Ts0, Ds0),
Ds = Ds0#{ Dst => I },
- {Ts, Ds, Fdb, I}.
+ case Fdb0 of
+ #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } ->
+ ArgCount = Callee#b_local.arity - length(FreeVars),
-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) ->
+ FVTypes = [raw_type(FreeVar, Ts) || FreeVar <- FreeVars],
+ Types = duplicate(ArgCount, any) ++ FVTypes,
+
+ CallId = {D#d.func_id, Dst},
+ ArgTypes = update_arg_types(Types, ArgTypes0, CallId),
+
+ 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.
+
+update_arg_types([ArgType | ArgTypes], [TypeMap0 | TypeMaps], CallId) ->
+ TypeMap = TypeMap0#{ CallId => ArgType },
+ [TypeMap | update_arg_types(ArgTypes, TypeMaps, CallId)];
+update_arg_types([], [], _CallId) ->
[].
simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) ->
@@ -487,8 +371,10 @@ simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) ->
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 ->
+ case normalized_type(Tuple, Ts) of
+ #t_tuple{size=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);
@@ -496,67 +382,97 @@ simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) ->
eval_bif(I0, Ts)
end;
simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) ->
- case get_type(List, Ts) of
+ case normalized_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
+ case normalized_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
+ case normalized_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
+ case normalized_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,
+simplify(#b_set{op={bif,is_function},args=[Fun,#b_literal{val=Arity}]}=I, Ts)
+ when is_integer(Arity), Arity >= 0 ->
+ case normalized_type(Fun, Ts) of
+ #t_fun{arity=any} ->
+ I;
+ #t_fun{arity=Arity} ->
+ #b_literal{val=true};
+ any ->
+ I;
+ _ ->
+ #b_literal{val=false}
+ end;
+simplify(#b_set{op={bif,Op0},args=Args}=I, Ts) when Op0 =:= '=='; Op0 =:= '/=' ->
+ Types = normalized_types(Args, Ts),
+ EqEq0 = case {beam_types:meet(Types),beam_types:join(Types)} of
+ {none,any} -> true;
+ {#t_integer{},#t_integer{}} -> true;
+ {float,float} -> true;
+ {#t_bitstring{},_} -> true;
+ {#t_atom{},_} -> true;
+ {_,_} -> false
+ end,
+ EqEq = EqEq0 orelse any_non_numeric_argument(Args, Ts),
case EqEq of
true ->
- simplify(I#b_set{op={bif,'=:='}}, Ts);
+ Op = case Op0 of
+ '==' -> '=:=';
+ '/=' -> '=/='
+ end,
+ simplify(I#b_set{op={bif,Op}}, 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
+simplify(#b_set{op={bif,'=:='},args=[LHS,RHS]}=I, Ts) ->
+ LType = raw_type(LHS, Ts),
+ RType = raw_type(RHS, Ts),
+ case beam_types:meet(LType, RType) of
none ->
#b_literal{val=false};
_ ->
- case {t_is_boolean(T1),T2} of
+ case {beam_types:is_boolean_type(LType),
+ beam_types:normalize(RType)} of
{true,#t_atom{elements=[true]}} ->
%% Bool =:= true ==> Bool
- A1;
+ LHS;
+ {true,#t_atom{elements=[false]}} ->
+ %% Bool =:= false ==> not Bool
+ %%
+ %% This will be further optimized to eliminate the
+ %% 'not', swapping the success and failure
+ %% branches in the br instruction. If LHS comes
+ %% from a type test (such as is_atom/1) or a
+ %% comparison operator (such as >=) that can be
+ %% translated to test instruction, this
+ %% optimization will eliminate one instruction.
+ simplify(I#b_set{op={bif,'not'},args=[LHS]}, Ts);
{_,_} ->
eval_bif(I, Ts)
end
end;
simplify(#b_set{op={bif,Op},args=Args}=I, Ts) ->
- Types = get_types(Args, Ts),
+ Types = normalized_types(Args, Ts),
case is_float_op(Op, Types) of
false ->
eval_bif(I, Ts);
@@ -565,20 +481,15 @@ simplify(#b_set{op={bif,Op},args=Args}=I, Ts) ->
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
+ #t_tuple{size=Size,elements=Es} = normalized_type(Tuple, Ts),
+ true = Size > N, %Assertion.
+ ElemType = beam_types:get_element_type(N + 1, Es),
+ case beam_types:get_singleton_value(ElemType) of
+ {ok, Val} -> #b_literal{val=Val};
+ error -> I
end;
simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) ->
- case get_type(Src, Ts) of
+ case normalized_type(Src, Ts) of
any -> I;
list -> I;
cons -> #b_literal{val=true};
@@ -586,7 +497,7 @@ simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) ->
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_is_record(I, normalized_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]};
@@ -599,8 +510,97 @@ 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(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I, _Ts) ->
+ 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(I, _Ts) -> 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.
+
+any_non_numeric_argument([#b_literal{val=Lit}|_], _Ts) ->
+ is_non_numeric(Lit);
+any_non_numeric_argument([#b_var{}=V|T], Ts) ->
+ is_non_numeric_type(raw_type(V, Ts)) orelse any_non_numeric_argument(T, Ts);
+any_non_numeric_argument([], _Ts) -> false.
+
+is_non_numeric([H|T]) ->
+ is_non_numeric(H) andalso is_non_numeric(T);
+is_non_numeric(Tuple) when is_tuple(Tuple) ->
+ is_non_numeric_tuple(Tuple, tuple_size(Tuple));
+is_non_numeric(Map) when is_map(Map) ->
+ %% Note that 17.x and 18.x compare keys in different ways.
+ %% Be very conservative -- require that both keys and values
+ %% are non-numeric.
+ is_non_numeric(maps:to_list(Map));
+is_non_numeric(Num) when is_number(Num) ->
+ false;
+is_non_numeric(_) -> true.
+
+is_non_numeric_tuple(Tuple, El) when El >= 1 ->
+ is_non_numeric(element(El, Tuple)) andalso
+ is_non_numeric_tuple(Tuple, El-1);
+is_non_numeric_tuple(_Tuple, 0) -> true.
+
+is_non_numeric_type(#t_atom{}) -> true;
+is_non_numeric_type(#t_bitstring{}) -> true;
+is_non_numeric_type(nil) -> true;
+is_non_numeric_type(#t_tuple{size=Size,exact=true,elements=Types})
+ when map_size(Types) =:= Size ->
+ is_non_numeric_tuple_type(Size, Types);
+is_non_numeric_type(_) -> false.
+
+is_non_numeric_tuple_type(0, _Types) ->
+ true;
+is_non_numeric_tuple_type(Pos, Types) ->
+ is_non_numeric_type(map_get(Pos, Types)) andalso
+ is_non_numeric_tuple_type(Pos - 1, Types).
+
make_literal_list(Args) ->
make_literal_list(Args, []).
@@ -611,9 +611,11 @@ make_literal_list([_|_], _) ->
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).
+is_safe_bool_op([LHS, RHS], Ts) ->
+ LType = raw_type(LHS, Ts),
+ RType = raw_type(RHS, Ts),
+ beam_types:is_boolean_type(LType) andalso
+ beam_types:is_boolean_type(RType).
all_same([{H,_}|T]) ->
all(fun({E,_}) -> E =:= H end, T).
@@ -626,7 +628,7 @@ eval_bif(#b_set{op={bif,Bif},args=Args}=I, Ts) ->
true ->
case make_literal_list(Args) of
none ->
- case get_types(Args, Ts) of
+ case normalized_types(Args, Ts) of
[any] ->
I;
[Type] ->
@@ -659,10 +661,9 @@ simplify_arg(#b_var{}=Arg0, Sub, Ts) ->
#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
+ case beam_types:get_singleton_value(raw_type(Arg, Ts)) of
+ {ok, Val} -> #b_literal{val=Val};
+ error -> Arg
end
end;
simplify_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub, Ts) ->
@@ -701,7 +702,7 @@ opt_terminator(#b_br{bool=#b_var{}}=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
+ case normalized_type(V, Ts) of
any ->
beam_ssa:normalize(Sw);
Type ->
@@ -717,7 +718,7 @@ opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) ->
#t_integer{elements={_,_}=Range} ->
simplify_switch_int(Sw1, Range);
#t_atom{elements=[_|_]} ->
- case t_is_boolean(Type) of
+ case beam_types:is_boolean_type(Type) of
true ->
#b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds),
opt_terminator(Br, Ts, Ds);
@@ -731,7 +732,7 @@ opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) ->
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
+ case beam_types:meet(raw_type(Arg, Ts), Type) of
none ->
%% Different types. This value can never match.
prune_switch_list(T, Fail, Type, Ts);
@@ -740,82 +741,91 @@ prune_switch_list([{Arg,_}=Pair|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)
+update_successors(#b_br{bool=#b_literal{val=true},succ=Succ}=Last, Ts, D0) ->
+ {Last, update_successor(Succ, Ts, D0)};
+update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}=Last0,
+ Ts, D0) ->
+ UsedOnce = cerl_sets:is_element(Bool, D0#d.once),
+ case infer_types_br(Bool, Ts, UsedOnce, D0) of
+ {#{}=SuccTs, #{}=FailTs} ->
+ D1 = update_successor(Succ, SuccTs, D0),
+ D = update_successor(Fail, FailTs, D1),
+ {Last0, D};
+ {#{}=SuccTs, none} ->
+ Last = Last0#b_br{bool=#b_literal{val=true},fail=Succ},
+ {Last, update_successor(Succ, SuccTs, D0)};
+ {none, #{}=FailTs} ->
+ Last = Last0#b_br{bool=#b_literal{val=true},succ=Fail},
+ {Last, update_successor(Fail, FailTs, D0)}
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;
+update_successors(#b_switch{arg=#b_var{}=V,fail=Fail0,list=List0}=Last0,
+ Ts, D0) ->
+ UsedOnce = cerl_sets:is_element(V, D0#d.once),
+
+ {List1, D1} = update_switch(List0, V, Ts, UsedOnce, [], D0),
+ FailTs = update_switch_failure(V, List0, Ts, UsedOnce, D1),
+
+ case FailTs of
+ none ->
+ %% The fail block is unreachable; swap it with one of the choices.
+ [{_, Fail} | List] = List1,
+ Last = Last0#b_switch{fail=Fail,list=List},
+ {Last, D1};
#{} ->
- RetType = join([get_type(Arg, Ts) | D#d.ret_type]),
- D#d{ret_type=[RetType]}
- end.
+ D = update_successor(Fail0, FailTs, D1),
+ Last = Last0#b_switch{list=List1},
+ {Last, D}
+ end;
+update_successors(#b_ret{arg=Arg}=Last, Ts, D0) ->
+ FuncId = D0#d.func_id,
+ D = case D0#d.ds of
+ #{ Arg := #b_set{op=call,args=[FuncId | _]} } ->
+ %% Returning a call to ourselves doesn't affect our own return
+ %% type.
+ D0;
+ #{} ->
+ RetType = beam_types:join([raw_type(Arg, Ts) | D0#d.ret_type]),
+ D0#d{ret_type=[RetType]}
+ end,
+ {Last, D}.
+
+update_switch([{Val, Lbl}=Sw | List], V, Ts, UsedOnce, Acc, D0) ->
+ case infer_types_switch(V, Val, Ts, UsedOnce, D0) of
+ none ->
+ update_switch(List, V, Ts, UsedOnce, Acc, D0);
+ SwTs ->
+ D = update_successor(Lbl, SwTs, D0),
+ update_switch(List, V, Ts, UsedOnce, [Sw | Acc], D)
+ end;
+update_switch([], _V, _Ts, _UsedOnce, Acc, D) ->
+ {reverse(Acc), D}.
-subtract_sw_list(V, List, Ts) ->
- Ts#{ V := sub_sw_list_1(get_type(V, Ts), List, Ts) }.
+update_switch_failure(V, List, Ts, UsedOnce, D) ->
+ case sub_sw_list_1(raw_type(V, Ts), List, Ts) of
+ none ->
+ none;
+ FailType ->
+ case beam_types:get_singleton_value(FailType) of
+ {ok, Value} ->
+ %% This is the only possible value at the fail label, so we
+ %% can infer types as if we matched it directly.
+ Lit = #b_literal{val=Value},
+ infer_types_switch(V, Lit, Ts, UsedOnce, D);
+ error when UsedOnce ->
+ ts_remove_var(V, Ts);
+ error ->
+ Ts
+ end
+ end.
sub_sw_list_1(Type, [{Val,_}|T], Ts) ->
- ValType = get_type(Val, Ts),
- sub_sw_list_1(subtract(Type, ValType), T, Ts);
+ ValType = raw_type(Val, Ts),
+ sub_sw_list_1(beam_types: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,
+update_successor(?EXCEPTION_BLOCK, _Ts, #d{}=D) ->
+ %% We KNOW that no variables are used in the ?EXCEPTION_BLOCK,
%% so there is no need to update the type information. That
%% can be a huge timesaver for huge functions.
D;
@@ -828,247 +838,102 @@ update_successor(S, Ts0, #d{ls=Ls}=D) ->
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),
+update_types(#b_set{op=Op,dst=Dst,anno=Anno,args=Args}, Ts, Ds) ->
+ T = type(Op, Args, Anno, 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
+type(phi, Args, _Anno, Ts, _Ds) ->
+ Types = [raw_type(A, Ts) || {A,_} <- Args],
+ beam_types:join(Types);
+type({bif,Bif}, Args, _Anno, Ts, _Ds) ->
+ ArgTypes = normalized_types(Args, Ts),
+ {RetType, _, _} = beam_call_types:types(erlang, Bif, ArgTypes),
+ RetType;
+type(bs_init, _Args, _Anno, _Ts, _Ds) ->
+ #t_bitstring{};
+type(bs_extract, [Ctx], _Anno, _Ts, Ds) ->
+ #b_set{op=bs_match,args=Args} = map_get(Ctx, Ds),
+ bs_match_type(Args);
+type(bs_match, _Args, _Anno, _Ts, _Ds) ->
+ #t_bs_context{};
+type(bs_get_tail, _Args, _Anno, _Ts, _Ds) ->
+ #t_bitstring{};
+type(call, [#b_local{} | _Args], Anno, _Ts, _Ds) ->
+ case Anno of
+ #{ result_type := Type } -> Type;
+ #{} -> any
end;
-type(bs_init, _Args, _Ts, _Ds) ->
- {binary, 1};
-type(bs_extract, [Ctx], Ts, _Ds) ->
- #t_bs_match{type=Type} = get_type(Ctx, Ts),
- Type;
-type(bs_match, Args, _Ts, _Ds) ->
- #t_bs_match{type=bs_match_type(Args)};
-type(bs_get_tail, _Args, _Ts, _Ds) ->
- {binary, 1};
type(call, [#b_remote{mod=#b_literal{val=Mod},
- name=#b_literal{val=Name}}|Args], Ts, _Ds) ->
- case {Mod,Name,Args} of
- {erlang,setelement,[Pos,Tuple,Arg]} ->
- case {get_type(Pos, Ts),get_type(Tuple, Ts)} of
- {#t_integer{elements={Index,Index}},
- #t_tuple{elements=Es0,size=Size}=T} ->
- %% This is an exact index, update the type of said element
- %% or return 'none' if it's known to be out of bounds.
- Es = set_element_type(Index, get_type(Arg, Ts), Es0),
- case T#t_tuple.exact of
- false ->
- T#t_tuple{size=max(Index, Size),elements=Es};
- true when Index =< Size ->
- T#t_tuple{elements=Es};
- true ->
- none
- end;
- {#t_integer{elements={Min,_}}=IntType,
- #t_tuple{elements=Es0,size=Size}=T} ->
- %% Remove type information for all indices that
- %% falls into the range of the integer.
- Es = remove_element_info(IntType, Es0),
- case T#t_tuple.exact of
- false ->
- T#t_tuple{elements=Es,size=max(Min, Size)};
- true when Min =< Size ->
- T#t_tuple{elements=Es,size=Size};
- true ->
- none
- end;
- {_,#t_tuple{}=T} ->
- %% Position unknown, so we have to discard all element
- %% information.
- T#t_tuple{elements=#{}};
- {#t_integer{elements={Min,_Max}},_} ->
- #t_tuple{size=Min};
- {_,_} ->
- #t_tuple{}
- end;
- {erlang,'++',[LHS,RHS]} ->
- LType = get_type(LHS, Ts),
- RType = get_type(RHS, Ts),
- case LType =:= cons orelse RType =:= cons of
- true ->
- cons;
- false ->
- %% `[] ++ RHS` yields RHS, even if RHS is not a list.
- join(list, RType)
- end;
- {erlang,'--',[_,_]} ->
- list;
- {lists,F,Args} ->
- Types = get_types(Args, Ts),
- lists_function_type(F, Types);
- {math,_,_} ->
- case is_math_bif(Name, length(Args)) of
- false -> any;
- true -> float
- end;
- {_,_,_} ->
- case erl_bifs:is_exit_bif(Mod, Name, length(Args)) of
- true -> none;
- false -> any
- end
- end;
-type(get_tuple_element, [Tuple, Offset], Ts, _Ds) ->
- #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts),
+ name=#b_literal{val=Name}}|Args], _Anno, Ts, _Ds) ->
+ ArgTypes = normalized_types(Args, Ts),
+ {RetType, _, _} = beam_call_types:types(Mod, Name, ArgTypes),
+ RetType;
+type(get_tuple_element, [Tuple, Offset], _Anno, Ts, _Ds) ->
+ #t_tuple{size=Size,elements=Es} = normalized_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) ->
+ beam_types:get_element_type(N + 1, Es);
+type(is_nonempty_list, [_], _Anno, _Ts, _Ds) ->
+ beam_types:make_boolean();
+type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Anno, _Ts, _Ds) ->
+ beam_types:make_boolean();
+type(make_fun, [#b_local{arity=TotalArity}|Env], _Anno, _Ts, _Ds) ->
+ #t_fun{arity=TotalArity-length(Env)};
+type(put_map, _Args, _Anno, _Ts, _Ds) ->
+ #t_map{};
+type(put_list, _Args, _Anno, _Ts, _Ds) ->
cons;
-type(put_tuple, Args, Ts, _Ds) ->
+type(put_tuple, Args, _Anno, Ts, _Ds) ->
{Es, _} = foldl(fun(Arg, {Es0, Index}) ->
- Type = get_type(Arg, Ts),
- Es = set_element_type(Index, Type, Es0),
- {Es, Index + 1}
+ Type = raw_type(Arg, Ts),
+ Es = beam_types: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) ->
+type(succeeded, [#b_var{}=Src], _Anno, Ts, _Ds)
+ when map_get(Src, Ts) =:= none ->
+ beam_types:make_atom(false);
+type(succeeded, [#b_var{}=Src], _Anno, 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()
+ ArgTypes = normalized_types(BifArgs, Ts),
+ case beam_call_types:will_succeed(erlang, Bif, ArgTypes) of
+ yes -> beam_types:make_atom(true);
+ no -> beam_types:make_atom(false);
+ maybe -> beam_types:make_boolean()
+ end;
+ #b_set{op=call,args=[#b_remote{mod=#b_literal{val=Mod},
+ name=#b_literal{val=Func}} |
+ CallArgs]} ->
+ ArgTypes = normalized_types(CallArgs, Ts),
+ case beam_call_types:will_succeed(Mod, Func, ArgTypes) of
+ yes -> beam_types:make_atom(true);
+ no -> beam_types:make_atom(false);
+ maybe -> beam_types:make_boolean()
end;
#b_set{op=get_hd} ->
- t_atom(true);
+ beam_types:make_atom(true);
#b_set{op=get_tl} ->
- t_atom(true);
+ beam_types:make_atom(true);
#b_set{op=get_tuple_element} ->
- t_atom(true);
+ beam_types:make_atom(true);
+ #b_set{op=put_tuple} ->
+ beam_types:make_atom(true);
#b_set{op=wait} ->
- t_atom(false);
+ beam_types:make_atom(false);
#b_set{} ->
- t_boolean()
+ beam_types:make_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}}.
+type(succeeded, [#b_literal{}], _Anno, _Ts, _Ds) ->
+ beam_types:make_atom(true);
+type(_, _, _, _, _) -> any.
%% 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'.
+%% Type can be any type as described in beam_types.hrl, but it must *never* be
+%% any.
will_succeed(is_atom, Type) ->
case Type of
@@ -1077,13 +942,13 @@ will_succeed(is_atom, Type) ->
end;
will_succeed(is_binary, Type) ->
case Type of
- {binary,U} when U rem 8 =:= 0 -> yes;
- {binary,_} -> maybe;
+ #t_bitstring{unit=U} when U rem 8 =:= 0 -> yes;
+ #t_bitstring{} -> maybe;
_ -> no
end;
will_succeed(is_bitstring, Type) ->
case Type of
- {binary,_} -> yes;
+ #t_bitstring{} -> yes;
_ -> no
end;
will_succeed(is_boolean, Type) ->
@@ -1091,7 +956,7 @@ will_succeed(is_boolean, Type) ->
#t_atom{elements=any} ->
maybe;
#t_atom{elements=Es} ->
- case t_is_boolean(Type) of
+ case beam_types:is_boolean_type(Type) of
true ->
yes;
false ->
@@ -1109,6 +974,11 @@ will_succeed(is_float, Type) ->
number -> maybe;
_ -> no
end;
+will_succeed(is_function, Type) ->
+ case Type of
+ #t_fun{} -> yes;
+ _ -> no
+ end;
will_succeed(is_integer, Type) ->
case Type of
#t_integer{} -> yes;
@@ -1123,7 +993,7 @@ will_succeed(is_list, Type) ->
end;
will_succeed(is_map, Type) ->
case Type of
- map -> yes;
+ #t_map{} -> yes;
_ -> no
end;
will_succeed(is_number, Type) ->
@@ -1140,35 +1010,12 @@ will_succeed(is_tuple, Type) ->
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};
+ #t_bitstring{unit=U};
bs_match_type(float, _) ->
float;
bs_match_type(integer, Args) ->
@@ -1180,24 +1027,24 @@ bs_match_type(integer, Args) ->
NumBits = Size * Unit,
case member(unsigned, Flags) of
true ->
- t_integer(0, (1 bsl NumBits)-1);
+ beam_types:make_integer(0, (1 bsl NumBits)-1);
false ->
%% Signed integer. Don't bother.
- t_integer()
+ #t_integer{}
end;
[_|_] ->
- t_integer()
+ #t_integer{}
end;
bs_match_type(skip, _) ->
any;
bs_match_type(string, _) ->
any;
bs_match_type(utf8, _) ->
- ?UNICODE_INT;
+ beam_types:make_integer(0, ?UNICODE_MAX);
bs_match_type(utf16, _) ->
- ?UNICODE_INT;
+ beam_types:make_integer(0, ?UNICODE_MAX);
bs_match_type(utf32, _) ->
- ?UNICODE_INT.
+ beam_types:make_integer(0, ?UNICODE_MAX).
simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) ->
case sort([A || {#b_literal{val=A},_} <- List0]) of
@@ -1229,14 +1076,14 @@ eq_ranges(_, _, _) -> false.
simplify_is_record(I, #t_tuple{exact=Exact,
size=Size,
elements=Es},
- RecSize, RecTag, Ts) ->
+ RecSize, #b_literal{val=TagVal}=RecTag, Ts) ->
TagType = maps:get(1, Es, any),
- TagMatch = case get_literal_from_type(TagType) of
- #b_literal{}=RecTag -> yes;
- #b_literal{} -> no;
- none ->
+ TagMatch = case beam_types:get_singleton_value(TagType) of
+ {ok, TagVal} -> yes;
+ {ok, _} -> no;
+ error ->
%% Is it at all possible for the tag to match?
- case meet(get_type(RecTag, Ts), TagType) of
+ case beam_types:meet(raw_type(RecTag, Ts), TagType) of
none -> no;
_ -> maybe
end
@@ -1266,7 +1113,7 @@ simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, 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
+ case beam_types:is_boolean_type(raw_type(Bool, Ts)) of
true ->
Br = Br0#b_br{bool=Bool,succ=Fail,fail=Succ},
beam_ssa:normalize(Br);
@@ -1334,40 +1181,18 @@ used_once_last_uses([V|Vs], L, Uses) ->
end;
used_once_last_uses([], _, Uses) -> Uses.
+normalized_types(Values, Ts) ->
+ [normalized_type(Val, Ts) || Val <- Values].
-get_types(Values, Ts) ->
- [get_type(Val, Ts) || Val <- Values].
--spec get_type(beam_ssa:value(), type_db()) -> type().
+normalized_type(V, Ts) ->
+ beam_types:normalize(raw_type(V, Ts)).
-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.
+-spec raw_type(beam_ssa:value(), type_db()) -> type().
+
+raw_type(#b_literal{val=Value}, _Ts) ->
+ beam_types:make_type_from_value(Value);
+raw_type(V, Ts) ->
+ map_get(V, Ts).
%% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes}
%% Looking at the expression that defines the variable Var, infer
@@ -1390,10 +1215,107 @@ get_type(#b_literal{val=Val}, _Ts) ->
%% 'cons' would give 'nil' as the only possible type. The result of the
%% subtraction for L will be added to FailTypes.
-infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) ->
+infer_types_br(#b_var{}=V, Ts, UsedOnce, #d{ds=Ds}) ->
#{V:=#b_set{op=Op,args=Args}} = Ds,
- PosTypes0 = infer_type(Op, Args, Ds),
- NegTypes0 = infer_type_negative(Op, Args, Ds),
+
+ {PosTypes, NegTypes} = infer_type(Op, Args, Ts, Ds),
+
+ SuccTs0 = meet_types(PosTypes, Ts),
+ FailTs0 = subtract_types(NegTypes, Ts),
+
+ case UsedOnce of
+ true ->
+ %% The branch variable is defined in this block and is only
+ %% referenced by this terminator. Therefore, there is no need to
+ %% include it in the type database passed on to the successors of
+ %% of this block.
+ SuccTs = ts_remove_var(V, SuccTs0),
+ FailTs = ts_remove_var(V, FailTs0),
+ {SuccTs, FailTs};
+ false ->
+ SuccTs = infer_br_value(V, true, SuccTs0),
+ FailTs = infer_br_value(V, false, FailTs0),
+ {SuccTs, FailTs}
+ end.
+
+infer_br_value(_V, _Bool, none) ->
+ none;
+infer_br_value(V, Bool, NewTs) ->
+ #{ V := T } = NewTs,
+ case beam_types:is_boolean_type(T) of
+ true ->
+ NewTs#{ V := beam_types:make_atom(Bool) };
+ false ->
+ %% V is a try/catch tag or similar, leave it alone.
+ NewTs
+ end.
+
+infer_types_switch(V, Lit, Ts0, UsedOnce, #d{ds=Ds}) ->
+ {PosTypes, _} = infer_type({bif,'=:='}, [V, Lit], Ts0, Ds),
+ Ts = meet_types(PosTypes, Ts0),
+ case UsedOnce of
+ true -> ts_remove_var(V, Ts);
+ false -> Ts
+ end.
+
+ts_remove_var(_V, none) -> none;
+ts_remove_var(V, Ts) -> maps:remove(V, Ts).
+
+infer_type(succeeded, [#b_var{}=Src], Ts, Ds) ->
+ #b_set{op=Op,args=Args} = maps:get(Src, Ds),
+ infer_success_type(Op, Args, Ts, Ds);
+
+%% Type tests are handled separately from other BIFs as we're inferring types
+%% based on their result, so we know that subtraction is safe even if we're
+%% not branching on 'succeeded'.
+infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size},
+ #b_literal{}=Tag], _Ts, _Ds) ->
+ Es = beam_types:set_element_type(1, raw_type(Tag, #{}), #{}),
+ T = {Src,#t_tuple{exact=true,size=Size,elements=Es}},
+ {[T], [T]};
+infer_type(is_nonempty_list, [#b_var{}=Src], _Ts, _Ds) ->
+ T = {Src,cons},
+ {[T], [T]};
+infer_type({bif,is_atom}, [Arg], _Ts, _Ds) ->
+ T = {Arg, #t_atom{}},
+ {[T], [T]};
+infer_type({bif,is_binary}, [Arg], _Ts, _Ds) ->
+ T = {Arg, #t_bitstring{unit=8}},
+ {[T], [T]};
+infer_type({bif,is_bitstring}, [Arg], _Ts, _Ds) ->
+ T = {Arg, #t_bitstring{}},
+ {[T], [T]};
+infer_type({bif,is_boolean}, [Arg], _Ts, _Ds) ->
+ T = {Arg, beam_types:make_boolean()},
+ {[T], [T]};
+infer_type({bif,is_float}, [Arg], _Ts, _Ds) ->
+ T = {Arg, float},
+ {[T], [T]};
+infer_type({bif,is_integer}, [Arg], _Ts, _Ds) ->
+ T = {Arg, #t_integer{}},
+ {[T], [T]};
+infer_type({bif,is_list}, [Arg], _Ts, _Ds) ->
+ T = {Arg, list},
+ {[T], [T]};
+infer_type({bif,is_map}, [Arg], _Ts, _Ds) ->
+ T = {Arg, #t_map{}},
+ {[T], [T]};
+infer_type({bif,is_number}, [Arg], _Ts, _Ds) ->
+ T = {Arg, number},
+ {[T], [T]};
+infer_type({bif,is_tuple}, [Arg], _Ts, _Ds) ->
+ T = {Arg, #t_tuple{}},
+ {[T], [T]};
+infer_type({bif,'=:='}, [#b_var{}=LHS,#b_var{}=RHS], 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').
+ LType = raw_type(LHS, Ts),
+ RType = raw_type(RHS, Ts),
+ Type = beam_types:meet(LType, RType),
+
+ PosTypes = [{V,Type} || {V, OrigType} <- [{LHS, LType}, {RHS, RType}],
+ OrigType =/= Type],
%% We must be careful with types inferred from '=:='.
%%
@@ -1404,39 +1326,39 @@ infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) ->
%%
%% However, it is safe to subtract a type inferred from '=:=' if
%% it is single-valued, e.g. if it is [] or the atom 'true'.
+ NegTypes = case beam_types:is_singleton_type(Type) of
+ true -> PosTypes;
+ false -> []
+ end,
- EqTypes = infer_eq_type(Op, Args, Ts, Ds),
- NegTypes1 = [P || {_,T}=P <- EqTypes, is_singleton_type(T)],
-
- PosTypes = EqTypes ++ PosTypes0,
- SuccTs = meet_types(PosTypes, Ts),
-
- NegTypes = NegTypes0 ++ NegTypes1,
- FailTs = subtract_types(NegTypes, Ts),
-
- {SuccTs,FailTs}.
-
-infer_types_switch(V, Lit, Ts, #d{ds=Ds}) ->
- Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds),
- meet_types(Types, Ts).
-
-infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) ->
+ {PosTypes, NegTypes};
+infer_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) ->
- [].
+ Type = raw_type(Lit, Ts),
+ EqLitTypes = infer_eq_lit(Def, Lit),
+ PosTypes = [{Src,Type} | EqLitTypes],
+ {PosTypes, EqLitTypes};
+infer_type(_Op, _Args, _Ts, _Ds) ->
+ {[], []}.
+
+infer_success_type({bif,Op}, Args, Ts, _Ds) ->
+ ArgTypes = normalized_types(Args, Ts),
+
+ {_, PosTypes0, CanSubtract} = beam_call_types:types(erlang, Op, ArgTypes),
+ PosTypes = [T || {#b_var{},_}=T <- zip(Args, PosTypes0)],
+
+ case CanSubtract of
+ true -> {PosTypes, PosTypes};
+ false -> {PosTypes, []}
+ end;
+infer_success_type(call, [#b_var{}=Fun|Args], _Ts, _Ds) ->
+ T = {Fun, #t_fun{arity=length(Args)}},
+ {[T], []};
+infer_success_type(bs_start_match, [#b_var{}=Bin], _Ts, _Ds) ->
+ T = {Bin,#t_bitstring{}},
+ {[T], [T]};
+infer_success_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) ->
@@ -1445,178 +1367,11 @@ 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, #{}), #{}),
+ Es = beam_types:set_element_type(Index, raw_type(Lit, #{}), #{}),
[{Tuple,#t_tuple{size=Index,elements=Es}}];
-infer_eq_lit(_, _) -> [].
-
-infer_type_negative(Op, Args, Ds) ->
- case is_negative_inference_safe(Op, Args) of
- true ->
- infer_type(Op, Args, Ds);
- false ->
- []
- end.
-
-%% Conservative list of instructions for which negative
-%% inference is safe.
-is_negative_inference_safe(is_nonempty_list, _Args) -> true;
-is_negative_inference_safe(_, _) -> false.
-
-infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) ->
- if
- is_integer(Pos), 1 =< Pos ->
- [{Tuple,#t_tuple{size=Pos}}];
- true ->
- []
- end;
-infer_type({bif,element}, [#b_var{}=Position,#b_var{}=Tuple], _Ds) ->
- [{Position,t_integer()},{Tuple,#t_tuple{}}];
-infer_type({bif,Bif}, [#b_var{}=Src]=Args, _Ds) ->
- case inferred_bif_type(Bif, Args) of
- any -> [];
- T -> [{Src,T}]
- end;
-infer_type({bif,binary_part}, [#b_var{}=Src,_], _Ds) ->
- [{Src,{binary,8}}];
-infer_type({bif,is_map_key}, [_,#b_var{}=Src], _Ds) ->
- [{Src,map}];
-infer_type({bif,map_get}, [_,#b_var{}=Src], _Ds) ->
- [{Src,map}];
-infer_type({bif,Bif}, [_,_]=Args, _Ds) ->
- case inferred_bif_type(Bif, Args) of
- any -> [];
- T -> [{A,T} || #b_var{}=A <- Args]
- end;
-infer_type({bif,binary_part}, [#b_var{}=Src,Pos,Len], _Ds) ->
- [{Src,{binary,8}}|
- [{V,t_integer()} || #b_var{}=V <- [Pos,Len]]];
-infer_type(bs_start_match, [#b_var{}=Bin], _Ds) ->
- [{Bin,{binary,1}}];
-infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) ->
- [{Src,cons}];
-infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size},
- #b_literal{}=Tag], _Ds) ->
- Es = set_element_type(1, get_type(Tag, #{}), #{}),
- [{Src,#t_tuple{exact=true,size=Size,elements=Es}}];
-infer_type(succeeded, [#b_var{}=Src], Ds) ->
- #b_set{op=Op,args=Args} = maps:get(Src, Ds),
- infer_type(Op, Args, Ds);
-infer_type(_Op, _Args, _Ds) ->
+infer_eq_lit(_, _) ->
[].
-%% 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) ->
@@ -1630,7 +1385,7 @@ join_types_1([V|Vs], Ts0, Ts1) ->
{#{V:=Same},#{V:=Same}} ->
join_types_1(Vs, Ts0, Ts1);
{#{V:=T0},#{V:=T1}} ->
- case join(T0, T1) of
+ case beam_types:join(T0, T1) of
T1 ->
join_types_1(Vs, Ts0, Ts1);
T ->
@@ -1642,326 +1397,21 @@ join_types_1([V|Vs], Ts0, Ts1) ->
join_types_1([], Ts0, Ts1) ->
maps:merge(Ts0, Ts1).
-join([T1,T2|Ts]) ->
- join([join(T1, T2)|Ts]);
-join([T]) -> T.
-
-get_literal_from_type(#t_atom{elements=[Atom]}) ->
- #b_literal{val=Atom};
-get_literal_from_type(#t_integer{elements={Int,Int}}) ->
- #b_literal{val=Int};
-get_literal_from_type(nil) ->
- #b_literal{val=[]};
-get_literal_from_type(_) -> none.
-
-remove_element_info(#t_integer{elements={Min,Max}}, Es) ->
- foldl(fun(El, Acc) when Min =< El, El =< Max ->
- maps:remove(El, Acc);
- (_El, Acc) -> Acc
- end, Es, maps:keys(Es)).
-
-t_atom() ->
- #t_atom{elements=any}.
-
-t_atom(Atom) when is_atom(Atom) ->
- #t_atom{elements=[Atom]}.
-
-t_boolean() ->
- #t_atom{elements=[false,true]}.
-
-t_integer() ->
- #t_integer{elements=any}.
-
-t_integer(Int) when is_integer(Int) ->
- #t_integer{elements={Int,Int}}.
-
-t_integer(Min, Max) when is_integer(Min), is_integer(Max) ->
- #t_integer{elements={Min,Max}}.
-
-t_is_boolean(#t_atom{elements=[F,T]}) ->
- F =:= false andalso T =:= true;
-t_is_boolean(#t_atom{elements=[B]}) ->
- is_boolean(B);
-t_is_boolean(_) -> false.
-
-t_tuple_size(#t_tuple{size=Size,exact=false}) ->
- {at_least,Size};
-t_tuple_size(#t_tuple{size=Size,exact=true}) ->
- {exact,Size};
-t_tuple_size(_) ->
- none.
-
-is_singleton_type(Type) ->
- get_literal_from_type(Type) =/= none.
-
-get_element_type(Index, Es) ->
- case Es of
- #{ Index := T } -> T;
- #{} -> any
- end.
-
-set_element_type(_Key, none, Es) ->
- Es;
-set_element_type(Key, any, Es) ->
- maps:remove(Key, Es);
-set_element_type(Key, Type, Es) ->
- Es#{ Key => Type }.
-
-%% join(Type1, Type2) -> Type
-%% Return the "join" of Type1 and Type2. The join is a more general
-%% type than Type1 and Type2. For example:
-%%
-%% join(#t_integer{elements=any}, #t_integer=elements={0,3}}) ->
-%% #t_integer{}
-%%
-%% The join for two different types result in 'any', which is
-%% the top element for our type lattice:
-%%
-%% join(#t_integer{}, map) -> any
-
--spec join(type(), type()) -> type().
-
-join(T, T) ->
- verified_type(T);
-join(none, T) ->
- verified_type(T);
-join(T, none) ->
- verified_type(T);
-join(any, _) -> any;
-join(_, any) -> any;
-join(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) ->
- Set = ordsets:union(Set1, Set2),
- case ordsets:size(Set) of
- Size when Size =< ?ATOM_SET_SIZE ->
- #t_atom{elements=Set};
- _Size ->
- #t_atom{elements=any}
- end;
-join(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T;
-join(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T;
-join({binary,U1}, {binary,U2}) ->
- {binary,gcd(U1, U2)};
-join(#t_integer{}, #t_integer{}) -> t_integer();
-join(list, cons) -> list;
-join(cons, list) -> list;
-join(nil, cons) -> list;
-join(cons, nil) -> list;
-join(nil, list) -> list;
-join(list, nil) -> list;
-join(#t_integer{}, float) -> number;
-join(float, #t_integer{}) -> number;
-join(#t_integer{}, number) -> number;
-join(number, #t_integer{}) -> number;
-join(float, number) -> number;
-join(number, float) -> number;
-join(#t_tuple{size=Sz,exact=ExactA,elements=EsA},
- #t_tuple{size=Sz,exact=ExactB,elements=EsB}) ->
- Exact = ExactA and ExactB,
- Es = join_tuple_elements(Sz, EsA, EsB),
- #t_tuple{size=Sz,exact=Exact,elements=Es};
-join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) ->
- Sz = min(SzA, SzB),
- Es = join_tuple_elements(Sz, EsA, EsB),
- #t_tuple{size=Sz,elements=Es};
-join(_T1, _T2) ->
- %%io:format("~p ~p\n", [_T1,_T2]),
- any.
-
-join_tuple_elements(MinSize, EsA, EsB) ->
- Es0 = join_elements(EsA, EsB),
- maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0).
-
-join_elements(Es1, Es2) ->
- Keys = if
- map_size(Es1) =< map_size(Es2) -> maps:keys(Es1);
- map_size(Es1) > map_size(Es2) -> maps:keys(Es2)
- end,
- join_elements_1(Keys, Es1, Es2, #{}).
-
-join_elements_1([Key | Keys], Es1, Es2, Acc0) ->
- case {Es1, Es2} of
- {#{ Key := Type1 }, #{ Key := Type2 }} ->
- Acc = set_element_type(Key, join(Type1, Type2), Acc0),
- join_elements_1(Keys, Es1, Es2, Acc);
- {#{}, #{}} ->
- join_elements_1(Keys, Es1, Es2, Acc0)
- end;
-join_elements_1([], _Es1, _Es2, Acc) ->
- Acc.
-
-gcd(A, B) ->
- case A rem B of
- 0 -> B;
- X -> gcd(B, X)
- end.
-
meet_types([{V,T0}|Vs], Ts) ->
#{V:=T1} = Ts,
- case meet(T0, T1) of
+ case beam_types:meet(T0, T1) of
+ none -> none;
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
+ case beam_types:subtract(T1, T0) of
+ none -> none;
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 acf3838da4..ad8839cc7d 100644
--- a/lib/compiler/src/beam_trim.erl
+++ b/lib/compiler/src/beam_trim.erl
@@ -244,6 +244,9 @@ remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) ->
remap([{deallocate,N}|Is], Map, Acc) ->
I = {deallocate,Map({frame_size,N})},
remap(Is, Map, [I|Acc]);
+remap([{swap,Reg1,Reg2}|Is], Map, Acc) ->
+ I = {swap,Map(Reg1),Map(Reg2)},
+ remap(Is, Map, [I|Acc]);
remap([{test,Name,Fail,Ss}|Is], Map, Acc) ->
I = {test,Name,Fail,[Map(S) || S <- Ss]},
remap(Is, Map, [I|Acc]);
@@ -382,6 +385,8 @@ frame_size([{bs_set_position,_,_}|Is], Safe) ->
frame_size(Is, Safe);
frame_size([{bs_get_tail,_,_,_}|Is], Safe) ->
frame_size(Is, Safe);
+frame_size([{swap,_,_}|Is], Safe) ->
+ frame_size(Is, Safe);
frame_size(_, _) -> throw(not_possible).
frame_size_branch(0, Is, Safe) ->
@@ -444,6 +449,8 @@ 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, [{swap,Reg1,Reg2}|Is]) ->
+ Y =/= Reg1 andalso Y =/= Reg2 andalso 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]) ->
diff --git a/lib/compiler/src/beam_types.erl b/lib/compiler/src/beam_types.erl
new file mode 100644
index 0000000000..821ccd31bb
--- /dev/null
+++ b/lib/compiler/src/beam_types.erl
@@ -0,0 +1,778 @@
+%%
+%% %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%
+%%
+
+-module(beam_types).
+
+-include("beam_types.hrl").
+
+-import(lists, [foldl/3, reverse/1, reverse/2]).
+
+-export([meet/1, meet/2, join/1, join/2, subtract/2]).
+
+-export([get_singleton_value/1,
+ is_singleton_type/1,
+ is_boolean_type/1,
+ normalize/1]).
+
+-export([get_element_type/2, set_element_type/3]).
+
+-export([make_type_from_value/1]).
+
+-export([make_atom/1,
+ make_boolean/0,
+ make_integer/1,
+ make_integer/2]).
+
+-define(IS_LIST_TYPE(N),
+ N =:= list orelse
+ N =:= cons orelse
+ N =:= nil).
+
+-define(IS_NUMBER_TYPE(N),
+ N =:= number orelse
+ N =:= float orelse
+ is_record(N, t_integer)).
+
+-define(TUPLE_SET_LIMIT, 20).
+
+%% Folds meet/2 over a list.
+
+-spec meet([type()]) -> type().
+
+meet([T1, T2 | Ts]) ->
+ meet([meet(T1, T2) | Ts]);
+meet([T]) -> T.
+
+%% Return the "meet" of Type1 and Type2, which is more general than Type1 and
+%% Type2. This is identical to glb/2 but can operate on and produce unions.
+%%
+%% A = #t_union{list=nil, number=[number], other=[#t_map{}]}
+%% B = #t_union{number=[#t_integer{}], other=[#t_map{}]}
+%%
+%% meet(A, B) ->
+%% #t_union{number=[#t_integer{}], other=[#t_map{}]}
+%%
+%% The meet of two different types result in 'none', which is the bottom
+%% element for our type lattice:
+%%
+%% meet(#t_integer{}, #t_map{}) -> none
+
+-spec meet(type(), type()) -> type().
+
+meet(T, T) ->
+ verified_type(T);
+meet(any, T) ->
+ verified_type(T);
+meet(T, any) ->
+ verified_type(T);
+meet(#t_union{}=A, B) ->
+ meet_unions(A, B);
+meet(A, #t_union{}=B) ->
+ meet_unions(B, A);
+meet(A, B) ->
+ glb(A, B).
+
+meet_unions(#t_union{atom=AtomA,list=ListA,number=NumberA,
+ tuple_set=TSetA,other=OtherA},
+ #t_union{atom=AtomB,list=ListB,number=NumberB,
+ tuple_set=TSetB,other=OtherB}) ->
+ Union = #t_union{atom=glb(AtomA, AtomB),
+ list=glb(ListA, ListB),
+ number=glb(NumberA, NumberB),
+ tuple_set=meet_tuple_sets(TSetA, TSetB),
+ other=glb(OtherA, OtherB)},
+ shrink_union(Union);
+meet_unions(#t_union{atom=AtomA}, #t_atom{}=B) ->
+ case glb(AtomA, B) of
+ none -> none;
+ Atom -> Atom
+ end;
+meet_unions(#t_union{number=NumberA}, B) when ?IS_NUMBER_TYPE(B) ->
+ case glb(NumberA, B) of
+ none -> none;
+ Number -> Number
+ end;
+meet_unions(#t_union{list=ListA}, B) when ?IS_LIST_TYPE(B) ->
+ case glb(ListA, B) of
+ none -> none;
+ List -> List
+ end;
+meet_unions(#t_union{tuple_set=Tuples}, #t_tuple{}=B) ->
+ Set = meet_tuple_sets(Tuples, new_tuple_set(B)),
+ shrink_union(#t_union{tuple_set=Set});
+meet_unions(#t_union{other=OtherA}, OtherB) ->
+ case glb(OtherA, OtherB) of
+ none -> none;
+ Other -> Other
+ end.
+
+meet_tuple_sets(none, _) ->
+ none;
+meet_tuple_sets(_, none) ->
+ none;
+meet_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) ->
+ new_tuple_set(glb(A, B));
+meet_tuple_sets(#t_tuple{}=Tuple, Records) ->
+ mts_tuple(Records, Tuple, []);
+meet_tuple_sets(Records, #t_tuple{}=Tuple) ->
+ meet_tuple_sets(Tuple, Records);
+meet_tuple_sets(RecordsA, RecordsB) ->
+ mts_records(RecordsA, RecordsB).
+
+mts_tuple([{Key, Type} | Records], Tuple, Acc) ->
+ case glb(Type, Tuple) of
+ none -> mts_tuple(Records, Tuple, Acc);
+ T -> mts_tuple(Records, Tuple, [{Key, T} | Acc])
+ end;
+mts_tuple([], _Tuple, [_|_]=Acc) ->
+ reverse(Acc);
+mts_tuple([], _Tuple, []) ->
+ none.
+
+mts_records(RecordsA, RecordsB) ->
+ mts_records(RecordsA, RecordsB, []).
+
+mts_records([{Key, A} | RsA], [{Key, B} | RsB], Acc) ->
+ case glb(A, B) of
+ none -> mts_records(RsA, RsB, Acc);
+ T -> mts_records(RsA, RsB, [{Key, T} | Acc])
+ end;
+mts_records([{KeyA, _} | _ ]=RsA, [{KeyB, _} | RsB], Acc) when KeyA > KeyB ->
+ mts_records(RsA, RsB, Acc);
+mts_records([{KeyA, _} | RsA], [{KeyB, _} | _] = RsB, Acc) when KeyA < KeyB ->
+ mts_records(RsA, RsB, Acc);
+mts_records(_RsA, [], [_|_]=Acc) ->
+ reverse(Acc);
+mts_records([], _RsB, [_|_]=Acc) ->
+ reverse(Acc);
+mts_records(_RsA, _RsB, []) ->
+ none.
+
+%% Folds join/2 over a list.
+
+-spec join([type()]) -> type().
+
+join([T1, T2| Ts]) ->
+ join([join(T1, T2) | Ts]);
+join([T]) -> T.
+
+%% Return the "join" of Type1 and Type2, which is more general than Type1 and
+%% Type2. This is identical to lub/2 but can operate on and produce unions.
+%%
+%% join(#t_integer{}, #t_map{}) -> #t_union{number=[#t_integer{}],
+%% other=[#t_map{}]}
+
+-spec join(type(), type()) -> type().
+
+join(T, T) -> T;
+join(_T, any) -> any;
+join(any, _T) -> any;
+join(T, none) -> T;
+join(none, T) -> T;
+
+join(#t_union{}=A, B) ->
+ join_unions(A, B);
+join(A, #t_union{}=B) ->
+ join_unions(B, A);
+
+%% Union creation...
+join(#t_atom{}=A, #t_atom{}=B) ->
+ lub(A, B);
+join(#t_atom{}=A, B) when ?IS_LIST_TYPE(B) ->
+ #t_union{atom=A,list=B};
+join(#t_atom{}=A, B) when ?IS_NUMBER_TYPE(B) ->
+ #t_union{atom=A,number=B};
+join(#t_atom{}=A, #t_tuple{}=B) ->
+ #t_union{atom=A,tuple_set=new_tuple_set(B)};
+join(#t_atom{}=A, B) ->
+ #t_union{atom=A,other=B};
+join(A, #t_atom{}=B) ->
+ join(B, A);
+
+join(A, B) when ?IS_LIST_TYPE(A), ?IS_LIST_TYPE(B) ->
+ lub(A, B);
+join(A, B) when ?IS_LIST_TYPE(A), ?IS_NUMBER_TYPE(B) ->
+ #t_union{list=A,number=B};
+join(A, #t_tuple{}=B) when ?IS_LIST_TYPE(A) ->
+ #t_union{list=A,tuple_set=new_tuple_set(B)};
+join(A, B) when ?IS_LIST_TYPE(A) ->
+ #t_union{list=A,other=B};
+join(A, B) when ?IS_LIST_TYPE(B) ->
+ join(B, A);
+
+join(A, B) when ?IS_NUMBER_TYPE(A), ?IS_NUMBER_TYPE(B) ->
+ lub(A, B);
+join(A, #t_tuple{}=B) when ?IS_NUMBER_TYPE(A) ->
+ #t_union{number=A,tuple_set=new_tuple_set(B)};
+join(A, B) when ?IS_NUMBER_TYPE(A) ->
+ #t_union{number=A,other=B};
+join(A, B) when ?IS_NUMBER_TYPE(B) ->
+ join(B, A);
+
+join(#t_tuple{}=A, #t_tuple{}=B) ->
+ case {record_key(A), record_key(B)} of
+ {Same, Same} ->
+ lub(A, B);
+ {none, _Key} ->
+ lub(A, B);
+ {_Key, none} ->
+ lub(A, B);
+ {KeyA, KeyB} when KeyA < KeyB ->
+ #t_union{tuple_set=[{KeyA, A}, {KeyB, B}]};
+ {KeyA, KeyB} when KeyA > KeyB ->
+ #t_union{tuple_set=[{KeyB, B}, {KeyA, A}]}
+ end;
+join(#t_tuple{}=A, B) ->
+ %% All other combinations have been tried already, so B must be 'other'
+ #t_union{tuple_set=new_tuple_set(A),other=B};
+join(A, #t_tuple{}=B) ->
+ join(B, A);
+
+join(A, B) ->
+ lub(A, B).
+
+join_unions(#t_union{atom=AtomA,list=ListA,number=NumberA,
+ tuple_set=TSetA,other=OtherA},
+ #t_union{atom=AtomB,list=ListB,number=NumberB,
+ tuple_set=TSetB,other=OtherB}) ->
+ Union = #t_union{atom=lub(AtomA, AtomB),
+ list=lub(ListA, ListB),
+ number=lub(NumberA, NumberB),
+ tuple_set=join_tuple_sets(TSetA, TSetB),
+ other=lub(OtherA, OtherB)},
+ shrink_union(Union);
+join_unions(#t_union{atom=AtomA}=A, #t_atom{}=B) ->
+ A#t_union{atom=lub(AtomA, B)};
+join_unions(#t_union{list=ListA}=A, B) when ?IS_LIST_TYPE(B) ->
+ A#t_union{list=lub(ListA, B)};
+join_unions(#t_union{number=NumberA}=A, B) when ?IS_NUMBER_TYPE(B) ->
+ A#t_union{number=lub(NumberA, B)};
+join_unions(#t_union{tuple_set=TSetA}=A, #t_tuple{}=B) ->
+ Set = join_tuple_sets(TSetA, new_tuple_set(B)),
+ shrink_union(A#t_union{tuple_set=Set});
+join_unions(#t_union{other=OtherA}=A, B) ->
+ case lub(OtherA, B) of
+ any -> any;
+ T -> A#t_union{other=T}
+ end.
+
+join_tuple_sets(A, none) ->
+ A;
+join_tuple_sets(none, B) ->
+ B;
+join_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) ->
+ lub(A, B);
+join_tuple_sets(#t_tuple{}=Tuple, Records) ->
+ jts_tuple(Records, Tuple);
+join_tuple_sets(Records, #t_tuple{}=Tuple) ->
+ join_tuple_sets(Tuple, Records);
+join_tuple_sets(RecordsA, RecordsB) ->
+ jts_records(RecordsA, RecordsB).
+
+jts_tuple([{_Key, Tuple} | Records], Acc) ->
+ jts_tuple(Records, lub(Tuple, Acc));
+jts_tuple([], Acc) ->
+ Acc.
+
+jts_records(RsA, RsB) ->
+ jts_records(RsA, RsB, 0, []).
+
+jts_records(RsA, RsB, N, Acc) when N > ?TUPLE_SET_LIMIT ->
+ A = normalize_tuple_set(RsA, none),
+ B = normalize_tuple_set(RsB, A),
+ #t_tuple{} = normalize_tuple_set(Acc, B);
+jts_records([{Key, A} | RsA], [{Key, B} | RsB], N, Acc) ->
+ jts_records(RsA, RsB, N + 1, [{Key, lub(A, B)} | Acc]);
+jts_records([{KeyA, _} | _]=RsA, [{KeyB, B} | RsB], N, Acc) when KeyA > KeyB ->
+ jts_records(RsA, RsB, N + 1, [{KeyB, B} | Acc]);
+jts_records([{KeyA, A} | RsA], [{KeyB, _} | _] = RsB, N, Acc) when KeyA < KeyB ->
+ jts_records(RsA, RsB, N + 1, [{KeyA, A} | Acc]);
+jts_records([], RsB, _N, Acc) ->
+ reverse(Acc, RsB);
+jts_records(RsA, [], _N, Acc) ->
+ reverse(Acc, RsA).
+
+%% Subtract Type2 from Type1. Example:
+%% subtract(list, cons) -> nil
+
+-spec subtract(type(), type()) -> type().
+
+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_union{atom=Atom}=A, #t_atom{}=B)->
+ shrink_union(A#t_union{atom=subtract(Atom, B)});
+subtract(#t_union{number=Number}=A, B) when ?IS_NUMBER_TYPE(B) ->
+ shrink_union(A#t_union{number=subtract(Number, B)});
+subtract(#t_union{list=List}=A, B) when ?IS_LIST_TYPE(B) ->
+ shrink_union(A#t_union{list=subtract(List, B)});
+subtract(#t_union{tuple_set=[_|_]=Records0}=A, #t_tuple{}=B) ->
+ %% Filter out all records that are strictly more specific than B.
+ NewSet = case [{Key, T} || {Key, T} <- Records0, meet(T, B) =/= T] of
+ [_|_]=Records -> Records;
+ [] -> none
+ end,
+ shrink_union(A#t_union{tuple_set=NewSet});
+subtract(#t_union{tuple_set=#t_tuple{}=Tuple}=A, #t_tuple{}=B) ->
+ %% Exclude Tuple if it's strictly more specific than B.
+ case meet(Tuple, B) of
+ Tuple -> shrink_union(A#t_union{tuple_set=none});
+ _ -> A
+ end;
+
+subtract(T, _) -> T.
+
+%%%
+%%% Type operators
+%%%
+
+-spec get_singleton_value(Type) -> Result when
+ Type :: type(),
+ Result :: {ok, term()} | error.
+get_singleton_value(#t_atom{elements=[Atom]}) ->
+ {ok, Atom};
+get_singleton_value(#t_integer{elements={Int,Int}}) ->
+ {ok, Int};
+get_singleton_value(nil) ->
+ {ok, []};
+get_singleton_value(_) ->
+ error.
+
+-spec is_boolean_type(type()) -> boolean().
+is_boolean_type(#t_atom{elements=[F,T]}) ->
+ F =:= false andalso T =:= true;
+is_boolean_type(#t_atom{elements=[B]}) ->
+ is_boolean(B);
+is_boolean_type(#t_union{}=T) ->
+ is_boolean_type(normalize(T));
+is_boolean_type(_) ->
+ false.
+
+-spec is_singleton_type(type()) -> boolean().
+is_singleton_type(Type) ->
+ get_singleton_value(Type) =/= error.
+
+-spec set_element_type(Key, Type, Elements) -> Elements when
+ Key :: term(),
+ Type :: type(),
+ Elements :: elements().
+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 }.
+
+-spec get_element_type(Key, Elements) -> type() when
+ Key :: term(),
+ Elements :: elements().
+get_element_type(Index, Es) ->
+ case Es of
+ #{ Index := T } -> T;
+ #{} -> any
+ end.
+
+-spec normalize(type()) -> normal_type().
+normalize(#t_union{atom=Atom,list=List,number=Number,
+ tuple_set=Tuples,other=Other}) ->
+ A = lub(Atom, List),
+ B = lub(A, Number),
+ C = lub(B, Other),
+ normalize_tuple_set(Tuples, C);
+normalize(T) ->
+ verified_normal_type(T).
+
+normalize_tuple_set([{_, A} | Records], B) ->
+ normalize_tuple_set(Records, lub(A, B));
+normalize_tuple_set([], B) ->
+ B;
+normalize_tuple_set(A, B) ->
+ lub(A, B).
+
+%%%
+%%% Type constructors
+%%%
+
+-spec make_type_from_value(term()) -> type().
+make_type_from_value(Value) ->
+ mtfv_1(Value).
+
+mtfv_1([]) -> nil;
+mtfv_1([_|_]) -> cons;
+mtfv_1(A) when is_atom(A) -> #t_atom{elements=[A]};
+mtfv_1(B) when is_binary(B) -> #t_bitstring{unit=8};
+mtfv_1(B) when is_bitstring(B) -> #t_bitstring{};
+mtfv_1(F) when is_float(F) -> float;
+mtfv_1(F) when is_function(F) ->
+ {arity, Arity} = erlang:fun_info(F, arity),
+ #t_fun{arity=Arity};
+mtfv_1(I) when is_integer(I) -> make_integer(I);
+mtfv_1(M) when is_map(M) -> #t_map{};
+mtfv_1(T) when is_tuple(T) ->
+ {Es,_} = foldl(fun(Val, {Es0, Index}) ->
+ Type = mtfv_1(Val),
+ Es = set_element_type(Index, Type, Es0),
+ {Es, Index + 1}
+ end, {#{}, 1}, tuple_to_list(T)),
+ #t_tuple{exact=true,size=tuple_size(T),elements=Es};
+mtfv_1(_Term) ->
+ any.
+
+-spec make_atom(atom()) -> type().
+make_atom(Atom) when is_atom(Atom) ->
+ #t_atom{elements=[Atom]}.
+
+-spec make_boolean() -> type().
+make_boolean() ->
+ #t_atom{elements=[false,true]}.
+
+-spec make_integer(integer()) -> type().
+make_integer(Int) when is_integer(Int) ->
+ make_integer(Int, Int).
+
+-spec make_integer(Min, Max) -> type() when
+ Min :: integer(),
+ Max :: integer().
+make_integer(Min, Max) when is_integer(Min), is_integer(Max), Min =< Max ->
+ #t_integer{elements={Min,Max}}.
+
+%%%
+%%% Helpers
+%%%
+
+%% Return the greatest lower bound of the types Type1 and Type2. The GLB is a
+%% more specific type than Type1 and Type2, and is always a normal type.
+%%
+%% glb(#t_integer{elements=any}, #t_integer{elements={0,3}}) ->
+%% #t_integer{elements={0,3}}
+%%
+%% The GLB of two different types result in 'none', which is the bottom
+%% element for our type lattice:
+%%
+%% glb(#t_integer{}, #t_map{}) -> none
+
+-spec glb(normal_type(), normal_type()) -> normal_type().
+
+glb(T, T) ->
+ verified_normal_type(T);
+glb(any, T) ->
+ verified_normal_type(T);
+glb(T, any) ->
+ verified_normal_type(T);
+glb(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) ->
+ case ordsets:intersection(Set1, Set2) of
+ [] ->
+ none;
+ [_|_]=Set ->
+ #t_atom{elements=Set}
+ end;
+glb(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) ->
+ T;
+glb(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) ->
+ T;
+glb(#t_bs_context{slots=SlotCountA,valid=ValidSlotsA},
+ #t_bs_context{slots=SlotCountB,valid=ValidSlotsB}) ->
+ CommonSlotMask = (1 bsl min(SlotCountA, SlotCountB)) - 1,
+ CommonSlotsA = ValidSlotsA band CommonSlotMask,
+ CommonSlotsB = ValidSlotsB band CommonSlotMask,
+ if
+ CommonSlotsA =:= CommonSlotsB ->
+ #t_bs_context{slots=max(SlotCountA, SlotCountB),
+ valid=ValidSlotsA bor ValidSlotsB};
+ CommonSlotsA =/= CommonSlotsB ->
+ none
+ end;
+glb(#t_fun{arity=any}, #t_fun{}=T) ->
+ T;
+glb(#t_fun{}=T, #t_fun{arity=any}) ->
+ T;
+glb(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) ->
+ T;
+glb(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) ->
+ T;
+glb(#t_integer{elements={MinA,MaxA}}, #t_integer{elements={MinB,MaxB}})
+ when MinA >= MinB, MinA =< MaxB;
+ MinB >= MinA, MinB =< MaxA ->
+ true = MinA =< MaxA andalso MinB =< MaxB, %Assertion.
+ #t_integer{elements={max(MinA, MinB),min(MaxA, MaxB)}};
+glb(#t_integer{}=T, number) -> T;
+glb(float=T, number) -> T;
+glb(number, #t_integer{}=T) -> T;
+glb(number, float=T) -> T;
+glb(list, cons) -> cons;
+glb(list, nil) -> nil;
+glb(cons, list) -> cons;
+glb(nil, list) -> nil;
+glb(#t_tuple{}=T1, #t_tuple{}=T2) ->
+ glb_tuples(T1, T2);
+glb(#t_bitstring{unit=U1}, #t_bitstring{unit=U2}) ->
+ #t_bitstring{unit=U1 * U2 div gcd(U1, U2)};
+glb(_, _) ->
+ %% Inconsistent types. There will be an exception at runtime.
+ none.
+
+glb_tuples(#t_tuple{size=Sz1,exact=true},
+ #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 ->
+ none;
+glb_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 glb_elements(Es1, Es2) of
+ none ->
+ none;
+ Es ->
+ #t_tuple{size=Size,exact=Exact,elements=Es}
+ end.
+
+glb_elements(Es1, Es2) ->
+ Keys = maps:keys(Es1) ++ maps:keys(Es2),
+ glb_elements_1(Keys, Es1, Es2, #{}).
+
+glb_elements_1([Key | Keys], Es1, Es2, Acc) ->
+ case {Es1, Es2} of
+ {#{ Key := Type1 }, #{ Key := Type2 }} ->
+ %% Note the use of meet/2; elements don't need to be normal types.
+ case meet(Type1, Type2) of
+ none -> none;
+ Type -> glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type })
+ end;
+ {#{ Key := Type1 }, _} ->
+ glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 });
+ {_, #{ Key := Type2 }} ->
+ glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 })
+ end;
+glb_elements_1([], _Es1, _Es2, Acc) ->
+ Acc.
+
+%% Return the least upper bound of the types Type1 and Type2. The LUB is a more
+%% general type than Type1 and Type2, and is always a normal type.
+%%
+%% For example:
+%%
+%% lub(#t_integer{elements=any}, #t_integer=elements={0,3}}) ->
+%% #t_integer{}
+%%
+%% The LUB for two different types result in 'any' (not a union type!), which
+%% is the top element for our type lattice:
+%%
+%% lub(#t_integer{}, #t_map{}) -> any
+
+-spec lub(normal_type(), normal_type()) -> normal_type().
+
+lub(T, T) ->
+ verified_normal_type(T);
+lub(none, T) ->
+ verified_normal_type(T);
+lub(T, none) ->
+ verified_normal_type(T);
+lub(any, _) ->
+ any;
+lub(_, any) ->
+ any;
+lub(#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;
+lub(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T;
+lub(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T;
+lub(#t_bitstring{unit=U1}, #t_bitstring{unit=U2}) ->
+ #t_bitstring{unit=gcd(U1, U2)};
+lub(#t_fun{}, #t_fun{}) ->
+ #t_fun{};
+lub(#t_integer{elements={MinA,MaxA}},
+ #t_integer{elements={MinB,MaxB}}) ->
+ #t_integer{elements={min(MinA,MinB),max(MaxA,MaxB)}};
+lub(#t_bs_context{slots=SlotsA,valid=ValidA},
+ #t_bs_context{slots=SlotsB,valid=ValidB}) ->
+ #t_bs_context{slots=min(SlotsA, SlotsB),
+ valid=ValidA band ValidB};
+lub(#t_integer{}, #t_integer{}) -> #t_integer{};
+lub(list, cons) -> list;
+lub(cons, list) -> list;
+lub(nil, cons) -> list;
+lub(cons, nil) -> list;
+lub(nil, list) -> list;
+lub(list, nil) -> list;
+lub(#t_integer{}, float) -> number;
+lub(float, #t_integer{}) -> number;
+lub(#t_integer{}, number) -> number;
+lub(number, #t_integer{}) -> number;
+lub(float, number) -> number;
+lub(number, float) -> number;
+lub(#t_tuple{size=Sz,exact=ExactA,elements=EsA},
+ #t_tuple{size=Sz,exact=ExactB,elements=EsB}) ->
+ Exact = ExactA and ExactB,
+ Es = lub_tuple_elements(Sz, EsA, EsB),
+ #t_tuple{size=Sz,exact=Exact,elements=Es};
+lub(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) ->
+ Sz = min(SzA, SzB),
+ Es = lub_tuple_elements(Sz, EsA, EsB),
+ #t_tuple{size=Sz,elements=Es};
+lub(_T1, _T2) ->
+ %%io:format("~p ~p\n", [_T1,_T2]),
+ any.
+
+lub_tuple_elements(MinSize, EsA, EsB) ->
+ Es0 = lub_elements(EsA, EsB),
+ maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0).
+
+lub_elements(Es1, Es2) ->
+ Keys = if
+ map_size(Es1) =< map_size(Es2) -> maps:keys(Es1);
+ map_size(Es1) > map_size(Es2) -> maps:keys(Es2)
+ end,
+ lub_elements_1(Keys, Es1, Es2, #{}).
+
+lub_elements_1([Key | Keys], Es1, Es2, Acc0) ->
+ case {Es1, Es2} of
+ {#{ Key := Type1 }, #{ Key := Type2 }} ->
+ %% Note the use of join/2; elements don't need to be normal types.
+ Acc = set_element_type(Key, join(Type1, Type2), Acc0),
+ lub_elements_1(Keys, Es1, Es2, Acc);
+ {#{}, #{}} ->
+ lub_elements_1(Keys, Es1, Es2, Acc0)
+ end;
+lub_elements_1([], _Es1, _Es2, Acc) ->
+ Acc.
+
+%%
+
+gcd(A, B) ->
+ case A rem B of
+ 0 -> B;
+ X -> gcd(B, X)
+ end.
+
+%%
+
+record_key(#t_tuple{exact=true,size=Size,elements=#{ 1 := Tag }}) ->
+ case is_singleton_type(Tag) of
+ true -> {Size, Tag};
+ false -> none
+ end;
+record_key(_) ->
+ none.
+
+new_tuple_set(T) ->
+ case record_key(T) of
+ none -> T;
+ Key -> [{Key, T}]
+ end.
+
+%%
+
+shrink_union(#t_union{other=any}) ->
+ any;
+shrink_union(#t_union{atom=Atom,list=none,number=none,
+ tuple_set=none,other=none}) ->
+ Atom;
+shrink_union(#t_union{atom=none,list=List,number=none,
+ tuple_set=none,other=none}) ->
+ List;
+shrink_union(#t_union{atom=none,list=none,number=Number,
+ tuple_set=none,other=none}) ->
+ Number;
+shrink_union(#t_union{atom=none,list=none,number=none,
+ tuple_set=#t_tuple{}=Tuple,other=none}) ->
+ Tuple;
+shrink_union(#t_union{atom=none,list=none,number=none,
+ tuple_set=[{_Key, Record}],other=none}) ->
+ #t_tuple{} = Record; %Assertion.
+shrink_union(#t_union{atom=none,list=none,number=none,
+ tuple_set=none,other=Other}) ->
+ Other;
+shrink_union(#t_union{}=T) ->
+ T.
+
+%% Verifies that the given type is well-formed.
+
+-spec verified_type(T) -> T when
+ T :: type().
+
+verified_type(#t_union{atom=Atom,
+ list=List,
+ number=Number,
+ tuple_set=TSet,
+ other=Other}=T) ->
+ _ = verified_normal_type(Atom),
+ _ = verified_normal_type(List),
+ _ = verified_normal_type(Number),
+ _ = verify_tuple_set(TSet),
+ _ = verified_normal_type(Other),
+ T;
+verified_type(T) ->
+ verified_normal_type(T).
+
+verify_tuple_set([_|_]=T) ->
+ _ = [verified_normal_type(Rec) || {_, Rec} <- T],
+ T;
+verify_tuple_set(#t_tuple{}=T) ->
+ none = record_key(T), %Assertion.
+ T;
+verify_tuple_set(none=T) ->
+ T.
+
+-spec verified_normal_type(T) -> T when
+ T :: normal_type().
+
+verified_normal_type(any=T) -> T;
+verified_normal_type(none=T) -> T;
+verified_normal_type(#t_atom{elements=any}=T) -> T;
+verified_normal_type(#t_atom{elements=[_|_]}=T) -> T;
+verified_normal_type(#t_bitstring{unit=U}=T)
+ when is_integer(U), U >= 1 ->
+ T;
+verified_normal_type(#t_bs_context{}=T) -> T;
+verified_normal_type(#t_fun{arity=Arity}=T)
+ when Arity =:= any; is_integer(Arity) ->
+ T;
+verified_normal_type(float=T) -> T;
+verified_normal_type(#t_integer{elements=any}=T) -> T;
+verified_normal_type(#t_integer{elements={Min,Max}}=T)
+ when is_integer(Min), is_integer(Max), Min =< Max ->
+ T;
+verified_normal_type(list=T) -> T;
+verified_normal_type(#t_map{}=T) -> T;
+verified_normal_type(nil=T) -> T;
+verified_normal_type(cons=T) -> T;
+verified_normal_type(number=T) -> T;
+verified_normal_type(#t_tuple{size=Size,elements=Es}=T) ->
+ %% All known elements must have a valid index and type (which may be a
+ %% union). 'any' is prohibited since it's implicit and should never be
+ %% present in the map, and a 'none' element ought to have reduced the
+ %% entire tuple to 'none'.
+ maps:fold(fun(Index, Element, _) when is_integer(Index),
+ 1 =< Index, Index =< Size,
+ Element =/= any, Element =/= none ->
+ verified_type(Element)
+ end, [], Es),
+ T.
diff --git a/lib/compiler/src/beam_types.hrl b/lib/compiler/src/beam_types.hrl
new file mode 100644
index 0000000000..09f87d61ba
--- /dev/null
+++ b/lib/compiler/src/beam_types.hrl
@@ -0,0 +1,88 @@
+%%
+%% %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%
+%%
+
+%% Common term types for passes operating on beam SSA and assembly. Helper
+%% functions for wrangling these can be found in beam_types.erl
+%%
+%% The type lattice is as follows:
+%%
+%% any Any Erlang term (top element).
+%%
+%% - #t_atom{} Atom, or a set thereof.
+%% - #t_bitstring{} Bitstring.
+%% - #t_bs_context{} Match context.
+%% - #t_fun{} Fun.
+%% - #t_map{} Map.
+%% - number Any number.
+%% -- float Floating point number.
+%% -- integer Integer.
+%% - list Any list.
+%% -- cons Cons (nonempty list).
+%% -- nil The empty list.
+%% - #t_tuple{} Tuple.
+%%
+%% none No type (bottom element).
+%%
+%% We also use #t_union{} to represent conflicting types produced by certain
+%% expressions, e.g. the "#t_atom{} or #t_tuple{}" of lists:keyfind/3, which is
+%% very useful for preserving type information when we would otherwise have
+%% reduced it to 'any'. Since few operations can make direct use of this extra
+%% type information, types should generally be normalized to one of the above
+%% before use.
+
+-define(ATOM_SET_SIZE, 5).
+
+-record(t_atom, {elements=any :: 'any' | [atom()]}).
+-record(t_fun, {arity=any :: arity() | 'any'}).
+-record(t_integer, {elements=any :: 'any' | {integer(),integer()}}).
+-record(t_bitstring, {unit=1 :: pos_integer()}).
+-record(t_bs_context, {slots=0 :: non_neg_integer(),
+ valid=0 :: non_neg_integer()}).
+-record(t_map, {elements=#{} :: map_elements()}).
+-record(t_tuple, {size=0 :: integer(),
+ exact=false :: boolean(),
+ elements=#{} :: tuple_elements()}).
+
+%% Known element types, unknown elements are assumed to be 'any'. The key is
+%% a 1-based integer index for tuples, and a plain literal for maps (that is,
+%% not wrapped in a #b_literal{}, just the value itself).
+
+-type tuple_elements() :: #{ Key :: pos_integer() => type() }.
+-type map_elements() :: #{ Key :: term() => type() }.
+
+-type elements() :: tuple_elements() | map_elements().
+
+-type normal_type() :: any | none |
+ list | number |
+ #t_atom{} | #t_bitstring{} | #t_bs_context{} |
+ #t_fun{} | #t_integer{} | #t_map{} | #t_tuple{} |
+ 'cons' | 'float' | 'nil'.
+
+-type record_key() :: {Arity :: integer(), Tag :: normal_type() }.
+-type record_set() :: ordsets:ordset({record_key(), #t_tuple{}}).
+-type tuple_set() :: #t_tuple{} | record_set().
+
+-record(t_union, {atom=none :: none | #t_atom{},
+ list=none :: none | list | cons | nil,
+ number=none :: none | number | float | #t_integer{},
+ tuple_set=none :: none | tuple_set(),
+ other=none :: normal_type()}).
+
+-type type() :: #t_union{} | normal_type().
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 349d74eb58..911b5eb777 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -19,6 +19,10 @@
-module(beam_validator).
+-include("beam_types.hrl").
+
+-define(UNICODE_MAX, (16#10FFFF)).
+
-compile({no_auto_import,[min/2]}).
%% Avoid warning for local function error/1 clashing with autoimported BIF.
@@ -26,7 +30,6 @@
%% Interface for compiler.
-export([module/2, format_error/1]).
--export([type_anno/1, type_anno/2, type_anno/4]).
-import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]).
@@ -45,34 +48,6 @@ 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}}) ->
@@ -119,7 +94,7 @@ format_error(Error) ->
%% format as used in the compiler and in .S files.
validate(Module, Fs) ->
- Ft = index_parameter_types(Fs, []),
+ Ft = build_function_table(Fs, []),
validate_0(Module, Fs, Ft).
validate_0(_Module, [], _) -> [];
@@ -136,8 +111,15 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
erlang:raise(Class, Error, Stack)
end.
+-record(t_abstract, {kind}).
+
+%% The types are the same as in 'beam_types.hrl', with the addition of
+%% #t_abstract{} that describes tuples under construction, match context
+%% positions, and so on.
+-type validator_type() :: #t_abstract{} | type().
+
-record(value_ref, {id :: index()}).
--record(value, {op :: term(), args :: [argument()], type :: type()}).
+-record(value, {op :: term(), args :: [argument()], type :: validator_type()}).
-type argument() :: #value_ref{} | literal().
@@ -149,34 +131,28 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
{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().
-
+%% Register tags describe the state of the register rather than the value they
+%% contain (if any).
+%%
+%% initialized The register has been initialized with some valid term
+%% so that it is safe to pass to the garbage collector.
+%% NOT safe to use in any other way (will not crash the
+%% emulator, but clearly points to a bug in the compiler).
+%%
+%% uninitialized The register contains any old garbage and can not be
+%% passed to the garbage collector.
+%%
+%% {catchtag,[Lbl]} A special term used within a catch. Must only be used
+%% by the catch instructions; NOT safe to use in other
+%% instructions.
+%%
+%% {trytag,[Lbl]} A special term used within a try block. Must only be
+%% used by the catch instructions; NOT safe to use in other
+%% instructions.
-type tag() :: initialized |
uninitialized |
- {catchtag, [label()]} |
- {trytag, [label()]}.
+ {catchtag, ordsets:ordset(label())} |
+ {trytag, ordsets:ordset(label())}.
-type x_regs() :: #{ {x, index()} => #value_ref{} }.
-type y_regs() :: #{ {y, index()} => tag() | #value_ref{} }.
@@ -200,11 +176,11 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
numy=none :: none | undecided | index(),
%% Available heap size.
h=0,
- %Available heap size for floats.
+ %%Available heap size for floats.
hf=0,
%% Floating point state.
fls=undefined,
- %% List of hot catch/try labels
+ %% List of hot catch/try tags
ct=[],
%% Previous instruction was setelement/3.
setelem=false,
@@ -225,36 +201,32 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
branched=gb_trees:empty() :: branched_tab(),
%% All defined labels
labels=gb_sets:empty() :: label_set(),
- %% Argument information of other functions in the module
+ %% 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) ->
+build_function_table([{function,_,Arity,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);
+ Info = #{ arity => Arity,
+ parameter_types => find_parameter_types(Is, #{}) },
+ build_function_table(Fs, [{Entry, Info} | Acc0]);
_ ->
- %% Something serious is wrong. Ignore it for now.
+ %% Something is seriously wrong. Ignore it for now.
%% It will be detected and diagnosed later.
- index_parameter_types(Fs, Acc0)
+ build_function_table(Fs, Acc0)
end;
-index_parameter_types([], Acc) ->
+build_function_table([], 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) ->
+find_parameter_types([{'%', {type_info, Reg, Type}} | Is], Acc) ->
+ find_parameter_types(Is, Acc#{ Reg => Type });
+find_parameter_types(_, Acc) ->
Acc.
validate_1(Is, Name, Arity, Entry, Ft) ->
@@ -326,7 +298,7 @@ init_vst(Arity, Ls1, Ls2, Ft) ->
init_function_args(-1, Vst) ->
Vst;
init_function_args(X, Vst) ->
- init_function_args(X - 1, create_term(term, argument, [], {x,X}, Vst)).
+ init_function_args(X - 1, create_term(any, argument, [], {x,X}, Vst)).
kill_heap_allocation(St) ->
St#st{h=0,hf=0}.
@@ -381,17 +353,34 @@ valfun_1({try_case_end,Src}, Vst) ->
kill_state(Vst);
%% Instructions that cannot cause exceptions
valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) ->
- bsm_validate_context(Ctx, Vst0),
+ assert_type(#t_bs_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);
+ extract_term(#t_bitstring{}, 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,Src,Dst}, Vst) ->
assign(Src, Dst, Vst);
+valfun_1({swap,RegA,RegB}, Vst0) ->
+ assert_movable(RegA, Vst0),
+ assert_movable(RegB, Vst0),
+
+ %% We don't expect fragile registers to be swapped.
+ %% Therefore, we can conservatively make both registers
+ %% fragile if one of the register is fragile instead of
+ %% swapping the fragility of the registers.
+ Sources = [RegA,RegB],
+ Vst1 = propagate_fragility(RegA, Sources, Vst0),
+ Vst2 = propagate_fragility(RegB, Sources, Vst1),
+
+ %% Swap the value references.
+ VrefA = get_reg_vref(RegA, Vst2),
+ VrefB = get_reg_vref(RegB, Vst2),
+ Vst = set_reg_vref(VrefB, RegA, Vst2),
+ set_reg_vref(VrefA, RegB, Vst);
valfun_1({fmove,Src,{fr,_}=Dst}, Vst) ->
assert_type(float, Src, Vst),
set_freg(Dst, Vst);
@@ -399,25 +388,36 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) ->
assert_freg_set(Src, Vst0),
assert_fls(checked, Vst0),
Vst = eat_heap_float(Vst0),
- create_term({float,[]}, fmove, [], Dst, 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,_},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.
- valfun_2(I, Vst);
- true ->
- %% It can't fail, so we finish handling it here (not updating
- %% catch state).
- validate_src(Ss, Vst),
- Type = bif_return_type(Op, Ss, Vst),
- extract_term(Type, {bif,Op}, Ss, Dst, Vst)
+valfun_1({bif,Op,{f,0},Ss,Dst}=I, Vst) ->
+ case will_bif_succeed(Op, Ss, Vst) of
+ yes ->
+ %% This BIF cannot fail, handle it here without updating catch
+ %% state.
+ validate_bif(Op, cannot_fail, Ss, Dst, Vst);
+ no ->
+ %% The stack will be scanned, so Y registers must be initialized.
+ verify_y_init(Vst),
+ kill_state(Vst);
+ maybe ->
+ %% The BIF can fail, make sure that any catch state is updated.
+ valfun_2(I, Vst)
+ end;
+valfun_1({gc_bif,Op,{f,0},Live,Ss,Dst}=I, Vst) ->
+ case will_bif_succeed(Op, Ss, Vst) of
+ yes ->
+ validate_gc_bif(Op, cannot_fail, Ss, Dst, Live, Vst);
+ no ->
+ verify_y_init(Vst),
+ kill_state(Vst);
+ maybe ->
+ valfun_2(I, Vst)
end;
%% Put instructions.
valfun_1({put_list,A,B,Dst}, Vst0) ->
@@ -431,14 +431,15 @@ valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) ->
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 = beam_types:set_element_type(Index, Type, Es0),
{Es, Index + 1}
end, {#{}, 1}, Elements),
- Type = {tuple,Size,Es},
+ Type = #t_tuple{exact=true,size=Size,elements=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 = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1),
+ Vst = create_term(#t_abstract{kind=unfinished_tuple}, put_tuple, [],
+ Dst, Vst1),
#vst{current=St0} = Vst,
St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}},
Vst#vst{current=St};
@@ -450,15 +451,31 @@ valfun_1({put,Src}, Vst0) ->
#st{puts_left=none} ->
error(not_building_a_tuple);
#st{puts_left={1,{Dst,Sz,Es0}}} ->
- Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) },
+ ElementType = get_term_type(Src, Vst0),
+ Es = beam_types:set_element_type(Sz, ElementType, Es0),
St = St0#st{puts_left=none},
- create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St});
+ Type = #t_tuple{exact=true,size=Sz,elements=Es},
+ create_term(Type, 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) },
+ ElementType = get_term_type(Src, Vst0),
+ Es = beam_types:set_element_type(Index, ElementType, Es0),
St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}},
Vst#vst{current=St}
end;
+%% This instruction never fails, though it may be invalid in some contexts; see
+%% val_dsetel/2
+valfun_1({set_tuple_element,Src,Tuple,N}, Vst) ->
+ I = N + 1,
+ assert_term(Src, Vst),
+ assert_type(#t_tuple{size=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.
+ #t_tuple{elements=Es0}=Type = normalize(get_term_type(Tuple, Vst)),
+ Es = beam_types:set_element_type(I, get_term_type(Src, Vst), Es0),
+ override_type(Type#t_tuple{elements=Es}, Tuple, Vst);
%% Instructions for optimization of selective receives.
valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
Vst;
@@ -469,8 +486,13 @@ 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, none}}, Vst) ->
+ %% Unreachable code, typically after a call that never returns.
+ kill_state(Vst);
+valfun_1({'%', {type_info, Reg, #t_bs_context{}=Type}}, Vst) ->
+ %% This is a gross hack, but we'll be rid of it once we have proper union
+ %% types.
+ override_type(Type, 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
@@ -490,15 +512,19 @@ valfun_1({line,_}, Vst) ->
Vst;
%% Exception generating calls
valfun_1({call_ext,Live,Func}=I, Vst) ->
- case call_return_type(Func, Vst) of
- exception ->
- verify_live(Live, Vst),
- %% The stack will be scanned, so Y registers
- %% must be initialized.
+ case will_call_succeed(Func, Vst) of
+ yes ->
+ %% This call cannot fail, handle it here without updating catch
+ %% state.
+ call(Func, Live, Vst);
+ no ->
+ %% The stack will be scanned, so Y registers must be initialized.
+ verify_live(Live, Vst),
verify_y_init(Vst),
- kill_state(Vst);
- _ ->
- valfun_2(I, Vst)
+ kill_state(Vst);
+ maybe ->
+ %% The call can fail, make sure that any catch state is updated.
+ valfun_2(I, Vst)
end;
valfun_1(_I, #vst{current=#st{ct=undecided}}) ->
error(unknown_catch_try_state);
@@ -530,54 +556,56 @@ 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) ->
+valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) ->
case get_tag_type(Reg, Vst0) of
- {catchtag,Fail} ->
+ {catchtag,_Fail}=Tag ->
%% {x,0} contains the caught term, if any.
- create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0));
+ create_term(any, 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|_]}}=Vst) ->
+valfun_1({try_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst) ->
case get_tag_type(Reg, Vst) of
- {trytag,Fail} ->
+ {trytag,_Fail}=Tag ->
%% 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|_]}}=Vst0) ->
+valfun_1({try_case,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) ->
case get_tag_type(Reg, Vst0) of
- {trytag,Fail} ->
+ {trytag,_Fail}=Tag ->
%% 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);
+ Vst2 = create_term(#t_atom{}, try_case, [], {x,0}, Vst1),
+ Vst = create_term(any, try_case, [], {x,1}, Vst2),
+ create_term(any, try_case, [], {x,2}, Vst);
Type ->
error({wrong_tag_type,Type})
end;
+%% Simple getters that can't fail.
valfun_1({get_list,Src,D1,D2}, Vst0) ->
assert_not_literal(Src),
assert_type(cons, Src, Vst0),
- Vst = extract_term(term, get_hd, [Src], D1, Vst0),
- extract_term(term, get_tl, [Src], D2, Vst);
+ Vst = extract_term(any, get_hd, [Src], D1, Vst0),
+ extract_term(any, get_tl, [Src], D2, Vst);
valfun_1({get_hd,Src,Dst}, Vst) ->
assert_not_literal(Src),
assert_type(cons, Src, Vst),
- extract_term(term, get_hd, [Src], Dst, Vst);
+ extract_term(any, get_hd, [Src], Dst, Vst);
valfun_1({get_tl,Src,Dst}, Vst) ->
assert_not_literal(Src),
assert_type(cons, Src, Vst),
- extract_term(term, get_tl, [Src], Dst, Vst);
+ extract_term(any, get_tl, [Src], Dst, Vst);
valfun_1({get_tuple_element,Src,N,Dst}, Vst) ->
+ Index = N+1,
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);
+ assert_type(#t_tuple{size=Index}, Src, Vst),
+ #t_tuple{elements=Es} = normalize(get_term_type(Src, Vst)),
+ Type = beam_types:get_element_type(Index, Es),
+ extract_term(Type, {bif,element}, [{integer,Index}, Src], Dst, Vst);
valfun_1({jump,{f,Lbl}}, Vst) ->
branch(Lbl, Vst,
fun(SuccVst) ->
@@ -587,38 +615,45 @@ valfun_1({jump,{f,Lbl}}, Vst) ->
valfun_1(I, Vst) ->
valfun_2(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},
+init_try_catch_branch(Kind, Dst, Fail, Vst0) ->
+ Tag = {Kind, [Fail]},
+ Vst = create_tag(Tag, 'try_catch', [], Dst, Vst0),
branch(Fail, Vst,
- fun(CatchVst) ->
- #vst{current=#st{ys=Ys}} = CatchVst,
- maps:fold(fun init_catch_handler_1/3, CatchVst, Ys)
+ fun(CatchVst0) ->
+ %% We add the tag here because branch/4 rejects jumps to
+ %% labels referenced by try tags.
+ #vst{current=#st{ct=Tags,ys=Ys}=St0} = CatchVst0,
+ St = St0#st{ct=[Tag|Tags]},
+ CatchVst = CatchVst0#vst{current=St},
+
+ 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
+ fun(SuccVst0) ->
+ #vst{current=#st{ct=Tags}=St0} = SuccVst0,
+ St = St0#st{ct=[Tag|Tags]},
+ SuccVst = SuccVst0#vst{current=St},
+
+ %% All potentially-throwing instructions after this one will
+ %% implicitly branch to the current try/catch handler; 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);
+ create_term(any, 'catch_handler', [], Reg, Vst);
init_catch_handler_1(Reg, uninitialized, Vst) ->
- create_term(term, 'catch_handler', [], Reg, Vst);
+ create_term(any, 'catch_handler', [], Reg, Vst);
init_catch_handler_1(_, _, Vst) ->
Vst.
-valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) ->
+valfun_2(I, #vst{current=#st{ct=[{_,[Fail]}|_]}}=Vst) when is_integer(Fail) ->
%% 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_3(I, fork_state(Fail, Vst));
valfun_2(I, #vst{current=#st{ct=[]}}=Vst) ->
valfun_3(I, Vst);
valfun_2(_, _) ->
@@ -672,8 +707,16 @@ valfun_4({apply,Live}, Vst) ->
valfun_4({apply_last,Live,_}, Vst) ->
tail_call(apply, Live+2, Vst);
valfun_4({call_fun,Live}, Vst) ->
- validate_src([{x,Live}], Vst),
- call('fun', Live+1, Vst);
+ Fun = {x,Live},
+ assert_term(Fun, Vst),
+
+ %% An exception is raised on error, hence branching to 0.
+ branch(0, Vst,
+ fun(SuccVst0) ->
+ SuccVst = update_type(fun meet/2, #t_fun{arity=Live},
+ Fun, SuccVst0),
+ call('fun', Live+1, SuccVst)
+ end);
valfun_4({call,Live,Func}, Vst) ->
call(Func, Live, Vst);
valfun_4({call_ext,Live,Func}, Vst) ->
@@ -692,76 +735,28 @@ valfun_4({call_ext_last,Live,Func,StkSize},
tail_call(Func, Live, Vst);
valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) ->
error({allocated,NumY});
-valfun_4({make_fun2,_,_,_,Live}, Vst) ->
- call(make_fun, Live, Vst);
-%% Other BIFs
-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)],#{}},
+valfun_4({make_fun2,{f,Lbl},_,_,NumFree}, #vst{ft=Ft}=Vst0) ->
+ #{ arity := Arity0 } = gb_trees:get(Lbl, Ft),
+ Arity = Arity0 - NumFree,
- SuccVst1 = update_type(fun meet/2, TupleType,
- Src, SuccVst0),
- SuccVst = update_type(fun meet/2, {integer,[]},
- Pos, SuccVst1),
+ true = Arity >= 0, %Assertion.
- ElementType = get_element_type(PosType, Src, SuccVst),
- extract_term(ElementType, {bif,element}, [Pos,Src],
- Dst, SuccVst)
- end);
+ Vst = prune_x_regs(NumFree, Vst0),
+ verify_call_args(make_fun, NumFree, Vst),
+ verify_y_init(Vst),
+
+ create_term(#t_fun{arity=Arity}, make_fun, [], {x,0}, Vst);
+%% Other BIFs
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,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),
- 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);
+ validate_bif(Op, Fail, Ss, Dst, Vst);
+valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, Vst) ->
+ validate_gc_bif(Op, Fail, Ss, Dst, Live, Vst);
valfun_4(return, #vst{current=#st{numy=none}}=Vst) ->
assert_durable_term({x,0}, Vst),
kill_state(Vst);
@@ -773,7 +768,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst) ->
%% part of this term must be stored in a Y register.
branch(Fail, Vst,
fun(SuccVst0) ->
- {Ref, SuccVst} = new_value(term, loop_rec, [], SuccVst0),
+ {Ref, SuccVst} = new_value(any, loop_rec, [], SuccVst0),
mark_fragile(Dst, set_reg_vref(Ref, Dst, SuccVst))
end);
valfun_4({wait,_}, Vst) ->
@@ -790,24 +785,13 @@ valfun_4(timeout, Vst) ->
prune_x_regs(0, Vst);
valfun_4(send, Vst) ->
call(send, 2, Vst);
-valfun_4({set_tuple_element,Src,Tuple,N}, Vst) ->
- I = N + 1,
- assert_term(Src, 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),
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),
+ assert_type(#t_tuple{}, Tuple, Vst),
assert_arities(Choices),
validate_select_tuple_arity(Fail, Choices, Tuple, Vst);
@@ -817,17 +801,17 @@ valfun_4({test,bs_start_match3,{f,Fail},Live,[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),
+ assert_type(#t_bs_context{}, Ctx, 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_type(#t_bs_context{}, Ctx, Vst),
assert_term(Src, Vst),
branch(Fail, Vst, fun(V) -> V end);
valfun_4({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) ->
- bsm_validate_context(Ctx, Vst),
+ assert_type(#t_bs_context{}, Ctx, Vst),
branch(Fail, Vst, fun(V) -> V end);
valfun_4({test,bs_test_unit,{f,Fail},[Ctx,_]}, Vst) ->
- bsm_validate_context(Ctx, Vst),
+ assert_type(#t_bs_context{}, Ctx, 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);
@@ -835,52 +819,69 @@ 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=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst);
+valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,
+ [Ctx,{integer,Size},Unit,{field_flags,Flags}],Dst},Vst)
+ when Size * Unit =< 64 ->
+ Type = case member(unsigned, Flags) of
+ true ->
+ NumBits = Size * Unit,
+ beam_types:make_integer(0, (1 bsl NumBits)-1);
+ false ->
+ %% Signed integer or way too large, don't bother.
+ #t_integer{}
+ end,
+ validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst);
+valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,
+ [Ctx,_Size,_Unit,_Flags],Dst},Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, #t_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);
+ validate_bs_get(Op, Fail, Ctx, Live, float, Dst, Vst);
+valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,Unit,_],Dst}, Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, #t_bitstring{unit=Unit}, 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);
+ Type = beam_types:make_integer(0, ?UNICODE_MAX),
+ validate_bs_get(Op, Fail, Ctx, Live, Type, 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);
+ Type = beam_types:make_integer(0, ?UNICODE_MAX),
+ validate_bs_get(Op, Fail, Ctx, Live, Type, 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);
+ Type = beam_types:make_integer(0, ?UNICODE_MAX),
+ validate_bs_get(Op, Fail, Ctx, Live, Type, 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),
+ assert_type(#t_bs_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);
+ create_term(#t_abstract{kind=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),
+ assert_type(#t_bs_context{}, Ctx, Vst),
+ assert_type(#t_abstract{kind=ms_position}, Pos, Vst),
Vst;
%% Other test instructions.
valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) ->
- assert_type(map, Src, Vst),
+ assert_type(#t_map{}, Src, Vst),
assert_unique_map_keys(List),
branch(Lbl, Vst, fun(V) -> V end);
valfun_4({test,is_atom,{f,Lbl},[Src]}, Vst) ->
- type_test(Lbl, {atom,[]}, Src, Vst);
+ type_test(Lbl, #t_atom{}, Src, Vst);
valfun_4({test,is_binary,{f,Lbl},[Src]}, Vst) ->
- type_test(Lbl, binary, Src, Vst);
+ type_test(Lbl, #t_bitstring{unit=8}, Src, Vst);
valfun_4({test,is_bitstr,{f,Lbl},[Src]}, Vst) ->
- type_test(Lbl, binary, Src, Vst);
+ type_test(Lbl, #t_bitstring{}, Src, Vst);
valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) ->
- type_test(Lbl, bool, Src, Vst);
+ type_test(Lbl, beam_types:make_boolean(), Src, Vst);
valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) ->
- type_test(Lbl, {float,[]}, Src, Vst);
+ type_test(Lbl, float, Src, Vst);
valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) ->
- type_test(Lbl, {tuple,[0],#{}}, Src, Vst);
+ type_test(Lbl, #t_tuple{}, Src, Vst);
valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) ->
- type_test(Lbl, {integer,[]}, Src, Vst);
+ type_test(Lbl, #t_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) ->
@@ -888,7 +889,7 @@ valfun_4({test,is_number,{f,Lbl},[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);
+ type_test(Lbl, #t_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.
@@ -901,12 +902,13 @@ valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) ->
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, #{}},
+ assert_type(#t_tuple{}, Tuple, Vst),
+ Type = #t_tuple{exact=true,size=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 }},
+ Es = #{ 1 => get_literal_type(Atom) },
+ Type = #t_tuple{exact=true,size=Sz,elements=Es},
type_test(Lbl, Type, Src, Vst);
valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) ->
validate_src(Ss, Vst),
@@ -935,19 +937,19 @@ valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) ->
assert_term(B, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- create_term({integer,[]}, bs_add, [A, B], Dst, SuccVst)
+ create_term(#t_integer{}, bs_add, [A, B], Dst, SuccVst)
end);
valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) ->
assert_term(A, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- create_term({integer,[]}, bs_utf8_size, [A], Dst, SuccVst)
+ create_term(#t_integer{}, bs_utf8_size, [A], Dst, SuccVst)
end);
valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) ->
assert_term(A, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- create_term({integer,[]}, bs_utf16_size, [A], Dst, SuccVst)
+ create_term(#t_integer{}, bs_utf16_size, [A], Dst, SuccVst)
end);
valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
@@ -962,7 +964,8 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
branch(Fail, Vst,
fun(SuccVst0) ->
SuccVst = prune_x_regs(Live, SuccVst0),
- create_term(binary, bs_init2, [], Dst, SuccVst, SuccVst0)
+ create_term(#t_bitstring{unit=8}, bs_init2, [], Dst,
+ SuccVst, SuccVst0)
end);
valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
@@ -977,9 +980,9 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
branch(Fail, Vst,
fun(SuccVst0) ->
SuccVst = prune_x_regs(Live, SuccVst0),
- create_term(binary, bs_init_bits, [], Dst, SuccVst)
+ create_term(#t_bitstring{}, bs_init_bits, [], Dst, SuccVst)
end);
-valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) ->
+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),
@@ -988,14 +991,16 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) ->
branch(Fail, Vst,
fun(SuccVst0) ->
SuccVst = prune_x_regs(Live, SuccVst0),
- create_term(binary, bs_append, [Bin], Dst, SuccVst, SuccVst0)
+ create_term(#t_bitstring{unit=Unit}, bs_append,
+ [Bin], Dst, SuccVst, SuccVst0)
end);
-valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst) ->
+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)
+ create_term(#t_bitstring{unit=Unit}, bs_private_append,
+ [Bin], Dst, SuccVst)
end);
valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) ->
Vst;
@@ -1004,39 +1009,39 @@ valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) ->
assert_term(Src, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- update_type(fun meet/2, binary, Src, SuccVst)
+ update_type(fun meet/2, #t_bitstring{}, Src, SuccVst)
end);
valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) ->
assert_term(Sz, Vst),
assert_term(Src, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- update_type(fun meet/2, {float,[]}, Src, 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(Fail, Vst,
fun(SuccVst) ->
- update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ update_type(fun meet/2, #t_integer{}, Src, SuccVst)
end);
valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) ->
assert_term(Src, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ update_type(fun meet/2, #t_integer{}, Src, SuccVst)
end);
valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) ->
assert_term(Src, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ update_type(fun meet/2, #t_integer{}, Src, SuccVst)
end);
valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) ->
assert_term(Src, Vst),
branch(Fail, Vst,
fun(SuccVst) ->
- update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ update_type(fun meet/2, #t_integer{}, Src, SuccVst)
end);
%% Map instructions.
valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
@@ -1050,7 +1055,7 @@ valfun_4(_, _) ->
verify_get_map(Fail, Src, List, Vst0) ->
assert_not_literal(Src), %OTP 22.
- assert_type(map, Src, Vst0),
+ assert_type(#t_map{}, Src, Vst0),
branch(Fail, Vst0,
fun(FailVst) ->
@@ -1074,7 +1079,7 @@ verify_get_map(Fail, Src, List, Vst0) ->
clobber_map_vals([Key,Dst|T], Map, Vst0) ->
case is_reg_initialized(Dst, Vst0) of
true ->
- Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0),
+ Vst = extract_term(any, {bif,map_get}, [Key, Map], Dst, Vst0),
clobber_map_vals(T, Map, Vst);
false ->
clobber_map_vals(T, Map, Vst0)
@@ -1099,13 +1104,13 @@ extract_map_keys([]) -> [].
extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) ->
assert_term(Key, Vst0),
- Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0),
+ Vsti = extract_term(any, {bif,map_get}, [Key, Map], Dst, Vsti0),
extract_map_vals(Vs, Map, Vst0, Vsti);
extract_map_vals([], _Map, _Vst0, Vst) ->
Vst.
verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) ->
- assert_type(map, Src, Vst0),
+ assert_type(#t_map{}, Src, Vst0),
verify_live(Live, Vst0),
verify_y_init(Vst0),
_ = [assert_term(Term, Vst0) || Term <- List],
@@ -1116,10 +1121,73 @@ verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) ->
SuccVst = prune_x_regs(Live, SuccVst0),
Keys = extract_map_keys(List),
assert_unique_map_keys(Keys),
- create_term(map, Op, [Src], Dst, SuccVst, SuccVst0)
+ create_term(#t_map{}, Op, [Src], Dst, SuccVst, SuccVst0)
end).
%%
+%% Common code for validating BIFs.
+%%
+%% OrigVst is the state we entered the instruction with, which is needed for
+%% gc_bifs as X registers are pruned prior to calling this function, which may
+%% have clobbered the sources.
+%%
+
+validate_bif(Op, Fail, Ss, Dst, Vst) ->
+ validate_src(Ss, Vst),
+ validate_bif_1(bif, Op, Fail, Ss, Dst, Vst, Vst).
+
+validate_gc_bif(Op, Fail, Ss, Dst, Live, #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),
+ Vst = prune_x_regs(Live, Vst0#vst{current=St}),
+ validate_src(Ss, Vst),
+
+ validate_bif_1(gc_bif, Op, Fail, Ss, Dst, Vst, Vst).
+
+validate_bif_1(Kind, Op, cannot_fail, Ss, Dst, OrigVst, Vst0) ->
+ %% This BIF explicitly cannot fail; it will not jump to a guard nor throw
+ %% an exception. Validation will fail if it returns 'none' or has a type
+ %% conflict on one of its arguments.
+
+ {Type, ArgTypes, _CanSubtract} = bif_types(Op, Ss, Vst0),
+ ZippedArgs = zip(Ss, ArgTypes),
+
+ Vst = foldl(fun({A, T}, V) ->
+ update_type(fun meet/2, T, A, V)
+ end, Vst0, ZippedArgs),
+
+ true = Type =/= none, %Assertion.
+
+ extract_term(Type, {Kind, Op}, Ss, Dst, Vst, OrigVst);
+validate_bif_1(Kind, Op, Fail, Ss, Dst, OrigVst, Vst) ->
+ {Type, ArgTypes, CanSubtract} = bif_types(Op, Ss, Vst),
+ ZippedArgs = zip(Ss, ArgTypes),
+
+ FailFun = case CanSubtract of
+ true ->
+ fun(FailVst0) ->
+ foldl(fun({A, T}, V) ->
+ update_type(fun subtract/2, T, A, V)
+ end, FailVst0, ZippedArgs)
+ end;
+ false ->
+ fun(S) -> S end
+ end,
+ SuccFun = fun(SuccVst0) ->
+ SuccVst = foldl(fun({A, T}, V) ->
+ update_type(fun meet/2, T, A, V)
+ end, SuccVst0, ZippedArgs),
+ extract_term(Type, {Kind, Op}, Ss, Dst, SuccVst, OrigVst)
+ end,
+
+ branch(Fail, Vst, FailFun, SuccFun).
+
+%%
%% Common code for validating bs_start_match* instructions.
%%
@@ -1127,18 +1195,18 @@ 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.
+ %% #t_bs_context{} 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);
+ #t_bs_context{} -> override_type(any, Src, FailVst);
_ -> FailVst
end
end,
fun(SuccVst0) ->
- SuccVst1 = update_type(fun meet/2, binary,
+ SuccVst1 = update_type(fun meet/2, #t_bitstring{},
Src, SuccVst0),
SuccVst = prune_x_regs(Live, SuccVst1),
extract_term(Type, bs_start_match, [Src], Dst,
@@ -1149,7 +1217,7 @@ validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) ->
%% Common code for validating bs_get* instructions.
%%
validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) ->
- bsm_validate_context(Ctx, Vst),
+ assert_type(#t_bs_context{}, Ctx, Vst),
verify_live(Live, Vst),
verify_y_init(Vst),
@@ -1163,7 +1231,7 @@ validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) ->
%% Common code for validating bs_skip_utf* instructions.
%%
validate_bs_skip_utf(Fail, Ctx, Live, Vst) ->
- bsm_validate_context(Ctx, Vst),
+ assert_type(#t_bs_context{}, Ctx, Vst),
verify_y_init(Vst),
verify_live(Live, Vst),
@@ -1217,12 +1285,13 @@ kill_state(Vst) ->
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.
+ case call_types(Name, Live, Vst0) of
+ {none, _, _} ->
+ kill_state(Vst0);
+ {RetType, _, _} ->
St = St0#st{f=init_fregs()},
Vst = prune_x_regs(0, Vst0#vst{current=St}),
- create_term(Type, call, [], {x,0}, Vst)
+ create_term(RetType, call, [], {x,0}, Vst)
end.
%% Tail call.
@@ -1237,8 +1306,15 @@ tail_call(Name, Live, Vst0) ->
verify_call_args(_, 0, #vst{}) ->
ok;
-verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)->
- verify_local_args(Live - 1, Lbl, #{}, Vst);
+verify_call_args({f,Lbl}, Live, #vst{ft=Ft}=Vst) when is_integer(Live) ->
+ case gb_trees:lookup(Lbl, Ft) of
+ {value, FuncInfo} ->
+ #{ arity := Live,
+ parameter_types := ParamTypes } = FuncInfo,
+ verify_local_args(Live - 1, ParamTypes, #{}, Vst);
+ none ->
+ error(local_call_to_unknown_function)
+ end;
verify_call_args(_, Live, Vst) when is_integer(Live)->
verify_remote_args_1(Live - 1, Vst);
verify_call_args(_, Live, _) ->
@@ -1250,87 +1326,50 @@ 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) ->
+verify_local_args(-1, _ParamTypes, _CtxIds, _Vst) ->
ok;
-verify_local_args(X, Lbl, CtxIds, Vst) ->
+verify_local_args(X, ParamTypes, CtxRefs, 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 } ->
+ #t_bs_context{}=Type ->
+ VRef = get_reg_vref(Reg, Vst),
+ case CtxRefs of
+ #{ VRef := Other } ->
error({multiple_match_contexts, [Reg, Other]});
#{} ->
- verify_arg_type(Lbl, Reg, Type, Vst),
- verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst)
+ verify_arg_type(Reg, Type, ParamTypes),
+ verify_local_args(X - 1, ParamTypes,
+ CtxRefs#{ VRef => Reg }, Vst)
end;
Type ->
- verify_arg_type(Lbl, Reg, Type, Vst),
- verify_local_args(X - 1, Lbl, CtxIds, Vst)
+ verify_arg_type(Reg, Type, ParamTypes),
+ verify_local_args(X - 1, ParamTypes, CtxRefs, Vst)
end.
%% Verifies that the given argument narrows to what the function expects.
-verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) ->
+verify_arg_type(Reg, #t_bs_context{}, ParamTypes) ->
%% 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)
+ case ParamTypes of
+ #{ Reg := #t_bs_context{}} -> 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{}} ->
+verify_arg_type(Reg, GivenType, ParamTypes) ->
+ case ParamTypes of
+ #{ Reg := #t_bs_context{}} ->
%% 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})
+ #{ Reg := RequiredType } ->
+ case meet(GivenType, RequiredType) of
+ GivenType -> ok;
+ _ -> error({bad_arg_type, Reg, GivenType, RequiredType})
end;
- none ->
+ #{} ->
ok
end.
-%% 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.
-
-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(Tag, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) ->
verify_live(Live, Vst0),
Vst1 = Vst0#vst{current=St#st{numy=Stk}},
@@ -1512,48 +1551,39 @@ assert_unique_map_keys([_,_|_]=Ls) ->
%%%
bsm_match_state() ->
- #ms{}.
+ #t_bs_context{}.
bsm_match_state(Slots) ->
- #ms{slots=Slots}.
-
-bsm_validate_context(Reg, Vst) ->
- _ = bsm_get_context(Reg, Vst),
- ok.
-
-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}).
+ #t_bs_context{slots=Slots}.
bsm_save(Reg, {atom,start}, Vst) ->
%% Save point refering to where the match started.
%% It is always valid. But don't forget to validate the context register.
- bsm_validate_context(Reg, Vst),
+ assert_type(#t_bs_context{}, Reg, Vst),
Vst;
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},
- override_type(Ctx, Reg, Vst);
- _ -> error({illegal_save,SavePoint})
+ case get_movable_term_type(Reg, Vst) of
+ #t_bs_context{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots ->
+ Ctx = Ctxt0#t_bs_context{valid=Bits bor (1 bsl SavePoint),
+ slots=Slots},
+ override_type(Ctx, Reg, Vst);
+ _ ->
+ error({illegal_save, SavePoint})
end.
bsm_restore(Reg, {atom,start}, Vst) ->
%% (Mostly) automatic save point refering to where the match started.
%% It is always valid. But don't forget to validate the context register.
- bsm_validate_context(Reg, Vst),
+ assert_type(#t_bs_context{}, Reg, Vst),
Vst;
bsm_restore(Reg, SavePoint, Vst) ->
- case bsm_get_context(Reg, Vst) of
- #ms{valid=Bits,slots=Slots} when SavePoint < Slots ->
- case Bits band (1 bsl SavePoint) of
- 0 -> error({illegal_restore,SavePoint,not_set});
- _ -> Vst
- end;
- _ -> error({illegal_restore,SavePoint,range})
+ case get_movable_term_type(Reg, Vst) of
+ #t_bs_context{valid=Bits,slots=Slots} when SavePoint < Slots ->
+ case Bits band (1 bsl SavePoint) of
+ 0 -> error({illegal_restore, SavePoint, not_set});
+ _ -> Vst
+ end;
+ _ ->
+ error({illegal_restore, SavePoint, range})
end.
validate_select_val(_Fail, _Choices, _Src, #vst{current=none}=Vst) ->
@@ -1569,7 +1599,7 @@ validate_select_val(Fail, [Val,{f,L}|T], Src, Vst0) ->
update_ne_types(Src, Val, FailVst)
end),
validate_select_val(Fail, T, Src, Vst);
-validate_select_val(Fail, [], _, Vst) ->
+validate_select_val(Fail, [], _Src, Vst) ->
branch(Fail, Vst,
fun(SuccVst) ->
%% The next instruction is never executed.
@@ -1581,7 +1611,7 @@ validate_select_tuple_arity(_Fail, _Choices, _Src, #vst{current=none}=Vst) ->
%% 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, #{}},
+ Type = #t_tuple{exact=true,size=Arity},
Vst = branch(L, Vst0,
fun(BranchVst) ->
update_type(fun meet/2, Type, Tuple, BranchVst)
@@ -1597,63 +1627,94 @@ validate_select_tuple_arity(Fail, [], _, #vst{}=Vst) ->
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}}) ->
+%%
+%% Infers types from comparisons, looking at the expressions that produced the
+%% compared values and updates their types if we've learned something new from
+%% the comparison.
+%%
+
+infer_types(CompareOp, {Kind,_}=LHS, RHS, Vst) when Kind =:= x; Kind =:= y ->
+ infer_types(CompareOp, get_reg_vref(LHS, Vst), RHS, Vst);
+infer_types(CompareOp, LHS, {Kind,_}=RHS, Vst) when Kind =:= x; Kind =:= y ->
+ infer_types(CompareOp, LHS, get_reg_vref(RHS, Vst), Vst);
+infer_types(CompareOp, LHS, RHS, #vst{current=#st{vs=Vs}}=Vst0) ->
case Vs of
- #{ Ref := Entry } -> infer_types_1(Entry);
- #{} -> fun(_, S) -> S end
+ #{ LHS := LEntry, RHS := REntry } ->
+ Vst = infer_types_1(LEntry, RHS, CompareOp, Vst0),
+ infer_types_1(REntry, LHS, CompareOp, Vst);
+ #{ LHS := LEntry } ->
+ infer_types_1(LEntry, RHS, CompareOp, Vst0);
+ #{ RHS := REntry } ->
+ infer_types_1(REntry, LHS, CompareOp, Vst0);
+ #{} ->
+ Vst0
+ end.
+
+infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}, Val, Op, Vst) ->
+ case Val of
+ {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool ->
+ update_eq_types(LHS, RHS, Vst);
+ {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool ->
+ update_ne_types(LHS, RHS, Vst);
+ _ ->
+ Vst
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
+infer_types_1(#value{op={bif,'=/='},args=[LHS,RHS]}, Val, Op, Vst) ->
+ case Val of
+ {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool ->
+ update_ne_types(LHS, RHS, Vst);
+ {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool ->
+ update_eq_types(LHS, RHS, Vst);
+ _ ->
+ Vst
end;
-infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) ->
- fun(Val, S) ->
- Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }},
- update_type(fun meet/2, Type, Tuple, S)
+infer_types_1(#value{op={bif,element},args=[{integer,Index},Tuple]},
+ Val, Op, Vst) when Index >= 1 ->
+ ElementType = get_term_type(Val, Vst),
+ Es = beam_types:set_element_type(Index, ElementType, #{}),
+ Type = #t_tuple{size=Index,elements=Es},
+ case Op of
+ eq_exact -> update_type(fun meet/2, Type, Tuple, Vst);
+ ne_exact -> update_type(fun subtract/2, Type, Tuple, Vst)
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
+infer_types_1(#value{op={bif,is_atom},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(#t_atom{}, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_boolean},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(beam_types:make_boolean(), Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_binary},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(#t_bitstring{unit=8}, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_bitstring},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(#t_bitstring{}, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_float},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(float, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_integer},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(#t_integer{}, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_list},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(list, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_map},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(#t_map{}, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_number},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(number, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,is_tuple},args=[Src]}, Val, Op, Vst) ->
+ infer_type_test_bif(#t_tuple{}, Src, Val, Op, Vst);
+infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]},
+ {integer,Arity}, Op, Vst) ->
+ Type = #t_tuple{exact=true,size=Arity},
+ case Op of
+ eq_exact -> update_type(fun meet/2, Type, Tuple, Vst);
+ ne_exact -> update_type(fun subtract/2, Type, Tuple, Vst)
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
+infer_types_1(_, _, _, Vst) ->
+ Vst.
+
+infer_type_test_bif(Type, Src, Val, Op, Vst) ->
+ case Val of
+ {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool ->
+ update_type(fun meet/2, Type, Src, Vst);
+ {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool ->
+ update_type(fun subtract/2, Type, Src, Vst);
+ _ ->
+ Vst
end.
%%%
@@ -1764,43 +1825,58 @@ update_type(Merge, With, #value_ref{}=Ref, Vst) ->
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 = get_literal_type(Literal),
+ case Merge(Type, With) of
+ none -> throw({type_conflict, Type, With});
_Type -> Vst
end.
-update_ne_types(LHS, RHS, Vst) ->
+update_eq_types(LHS, RHS, Vst0) ->
+ LType = get_term_type(LHS, Vst0),
+ RType = get_term_type(RHS, Vst0),
+
+ Vst1 = update_type(fun meet/2, RType, LHS, Vst0),
+ Vst = update_type(fun meet/2, LType, RHS, Vst1),
+
+ infer_types(eq_exact, LHS, RHS, Vst).
+
+update_ne_types(LHS, RHS, Vst0) ->
+ Vst1 = update_ne_types_1(LHS, RHS, Vst0),
+ Vst = update_ne_types_1(RHS, LHS, Vst1),
+
+ infer_types(ne_exact, LHS, RHS, Vst).
+
+update_ne_types_1(LHS, RHS, Vst0) ->
%% 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
+ %% Consider `number =/= #t_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,[]}.
+ %% #t_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
+ RType = get_term_type(RHS, Vst0),
+ case beam_types:is_singleton_type(RType) of
+ true ->
+ Vst = update_type(fun subtract/2, RType, LHS, Vst0),
+
+ %% If LHS has a specific value after subtraction we can infer types
+ %% as if we've made an exact match, which is much stronger than
+ %% ne_exact.
+ LType = get_term_type(LHS, Vst),
+ case beam_types:get_singleton_value(LType) of
+ {ok, Value} ->
+ infer_types(eq_exact, LHS, value_to_literal(Value), Vst);
+ error ->
+ Vst
+ end;
+ false ->
+ Vst0
end.
-update_eq_types(LHS, RHS, Vst0) ->
- %% Either side might contain something worth inferring, so we need
- %% to check them both.
- Infer_L = infer_types(RHS, Vst0),
- Infer_R = infer_types(LHS, Vst0),
- Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)),
-
- T1 = get_term_type(LHS, Vst1),
- T2 = get_term_type(RHS, Vst1),
-
- Vst = update_type(fun meet/2, T2, LHS, Vst1),
- update_type(fun meet/2, T1, RHS, Vst).
-
%% Helper functions for the above.
assign_1(Src, Dst, Vst0) ->
@@ -1851,16 +1927,9 @@ get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) ->
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.
+ #{ Ref := #value{}=Entry } = Vs0,
+ Vs = Vs0#{ Ref => Entry#value{type=Type} },
+ Vst#vst{current=St#st{vs=Vs}}.
new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) ->
Ref = #value_ref{id=Counter},
@@ -1868,9 +1937,9 @@ new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) ->
{Ref, Vst#vst{current=St#st{vs=Vs},ref_ctr=Counter+1}}.
-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_catch_tag(Reg, #vst{current=#st{ct=[Tag|Tags]}=St}=Vst0) ->
+ Vst = Vst0#vst{current=St#st{ct=Tags,fls=undefined}},
+ Tag = get_tag_type(Reg, Vst), %Assertion.
kill_tag(Reg, Vst).
check_try_catch_tags(Type, {y,N}=Reg, Vst) ->
@@ -1915,308 +1984,45 @@ is_literal({integer,I}) when is_integer(I) -> true;
is_literal({literal,_L}) -> true;
is_literal(_) -> false.
-%% The possible types.
-%%
-%% First non-term types:
-%%
-%% initialized Only for Y registers. Means that the Y register
-%% has been initialized with some valid term so that
-%% it is safe to pass to the garbage collector.
-%% NOT safe to use in any other way (will not crash the
-%% emulator, but clearly points to a bug in the compiler).
-%%
-%% {catchtag,[Lbl]} A special term used within a catch. Must only be used
-%% by the catch instructions; NOT safe to use in other
-%% instructions.
-%%
-%% {trytag,[Lbl]} A special term used within a try block. Must only be
-%% used by the catch instructions; NOT safe to use in other
-%% instructions.
-%%
-%% 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
-%% be accessed by bit syntax matching instructions.
-%%
-%%
-%% Normal terms:
-%%
-%% 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: []
-%%
-%% list List: [] or [_|_]
-%%
-%% {tuple,[Sz],Es} Tuple. An element has been accessed using
-%% element/2 or setelement/3 so that it is known that
-%% the type is a tuple of size at least Sz. Es is a map
-%% containing known types by tuple index.
-%%
-%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen
-%% so that it is known that the size is exactly Sz.
-%%
-%% {atom,[]} Atom.
-%% {atom,Atom}
-%%
-%% {integer,[]} Integer.
-%% {integer,Integer}
-%%
-%% {float,[]} Float.
-%% {float,Float}
-%%
-%% number Integer or Float of unknown value
-%%
-%% map Map.
-%%
-%% none A conflict in types. There will be an exception at runtime.
-%%
-
-%% 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.
+%% `dialyzer` complains about the float and general literal cases never being
+%% matched and I don't like suppressing warnings. Should they become possible
+%% I'm sure `dialyzer` will warn about it.
+value_to_literal([]) -> nil;
+value_to_literal(A) when is_atom(A) -> {atom,A};
+value_to_literal(I) when is_integer(I) -> {integer,I}.
-%% 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
+%% These are just wrappers around their equivalents in beam_types, which
+%% handle the validator-specific #t_abstract{} type.
+%%
+%% The funny-looking abstract types produced here are intended to provoke
+%% errors on actual use; they do no harm just lying around.
+
+normalize(#t_abstract{}=A) -> error({abstract_type, A});
+normalize(T) -> beam_types:normalize(T).
+
+join(Same, Same) -> Same;
+join(#t_abstract{}=A, B) -> #t_abstract{kind={join, A, B}};
+join(A, #t_abstract{}=B) -> #t_abstract{kind={join, A, B}};
+join(A, B) -> beam_types:join(A, B).
+
+meet(Same, Same) -> Same;
+meet(#t_abstract{}=A, B) -> #t_abstract{kind={meet, A, B}};
+meet(A, #t_abstract{}=B) -> #t_abstract{kind={meet, A, B}};
+meet(A, B) -> beam_types:meet(A, B).
+
+subtract(#t_abstract{}=A, B) -> #t_abstract{kind={subtract, A, B}};
+subtract(A, #t_abstract{}=B) -> #t_abstract{kind={subtract, A, B}};
+subtract(A, B) -> beam_types:subtract(A, B).
+
+assert_type(RequiredType, Term, Vst) ->
+ GivenType = get_movable_term_type(Term, Vst),
+ case meet(RequiredType, GivenType) of
+ GivenType ->
+ ok;
+ _RequiredType ->
+ error({bad_type,{needed,RequiredType},{actual,GivenType}})
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, {literal,Tuple}) when is_tuple(Tuple) -> ok;
-assert_type({tuple_element,I}, {tuple,[Sz],_})
- when 1 =< I, I =< Sz ->
- ok;
-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) ->
- ok;
-assert_type(cons, {literal,[_|_]}) ->
- ok;
-assert_type(Needed, Actual) ->
- error({bad_type,{needed,Needed},{actual,Actual}}).
-
-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) ->
_ = [assert_term(S, Vst) || S <- Ss],
ok.
@@ -2227,7 +2033,8 @@ validate_src(Ss, Vst) when is_list(Ss) ->
get_term_type(Src, Vst) ->
case get_movable_term_type(Src, Vst) of
- #ms{} -> error({match_context,Src});
+ #t_bs_context{} -> error({match_context,Src});
+ #t_abstract{} -> error({abstract_term,Src});
Type -> Type
end.
@@ -2237,12 +2044,11 @@ get_term_type(Src, Vst) ->
get_movable_term_type(Src, Vst) ->
case get_raw_type(Src, Vst) of
+ #t_abstract{kind=unfinished_tuple=Kind} -> error({Kind,Src});
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.
@@ -2284,30 +2090,18 @@ get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) ->
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_type(nil) ->
+ beam_types:make_type_from_value([]);
+get_literal_type({atom,A}) when is_atom(A) ->
+ beam_types:make_type_from_value(A);
+get_literal_type({float,F}) when is_float(F) ->
+ beam_types:make_type_from_value(F);
+get_literal_type({integer,I}) when is_integer(I) ->
+ beam_types:make_type_from_value(I);
+get_literal_type({literal,L}) ->
+ beam_types:make_type_from_value(L);
+get_literal_type(T) ->
+ error({not_literal,T}).
%%%
%%% Branch tracking
@@ -2325,10 +2119,12 @@ glt_1(L) ->
SuccFun :: BranchFun) -> #vst{} when
BranchFun :: fun((#vst{}) -> #vst{}).
branch(Lbl, Vst0, FailFun, SuccFun) ->
+ validate_branch(Lbl, Vst0),
#vst{current=St0} = Vst0,
+
try FailFun(Vst0) of
Vst1 ->
- Vst2 = branch_state(Lbl, Vst1),
+ Vst2 = fork_state(Lbl, Vst1),
Vst = Vst2#vst{current=St0},
try SuccFun(Vst) of
V -> V
@@ -2346,6 +2142,24 @@ branch(Lbl, Vst0, FailFun, SuccFun) ->
SuccFun(Vst0)
end.
+validate_branch(Lbl, #vst{current=#st{ct=Tags}}) ->
+ validate_branch_1(Lbl, Tags).
+
+validate_branch_1(Lbl, [{trytag, FailLbls} | Tags]) ->
+ %% 'try_case' assumes that an exception has been thrown, so a direct branch
+ %% will crash the emulator.
+ %%
+ %% (Jumping to a 'catch_end' is fine however as it will simply nop in the
+ %% absence of an exception.)
+ case ordsets:is_element(Lbl, FailLbls) of
+ true -> error({illegal_branch, try_handler, Lbl});
+ false -> validate_branch_1(Lbl, Tags)
+ end;
+validate_branch_1(Lbl, [_ | Tags]) ->
+ validate_branch_1(Lbl, Tags);
+validate_branch_1(_Lbl, []) ->
+ ok.
+
%% A shorthand version of branch/4 for when the state is only altered on
%% success.
branch(Fail, Vst, SuccFun) ->
@@ -2353,12 +2167,12 @@ branch(Fail, Vst, SuccFun) ->
%% Directly branches off the state. This is an "internal" operation that should
%% be used sparingly.
-branch_state(0, #vst{}=Vst) ->
+fork_state(0, #vst{}=Vst) ->
%% If the instruction fails, the stack may be scanned looking for a catch
%% tag. Therefore the Y registers must be initialized at this point.
verify_y_init(Vst),
Vst;
-branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) ->
+fork_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),
@@ -2438,10 +2252,10 @@ 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({trytag, LblsA}, {trytag, LblsB}) ->
+ {trytag, ordsets:union(LblsA, LblsB)};
+merge_tags({catchtag, LblsA}, {catchtag, LblsB}) ->
+ {catchtag, ordsets:union(LblsA, LblsB)};
merge_tags(_A, _B) ->
%% All other combinations leave the register initialized. Errors arising
%% from this will be caught later on.
@@ -2512,13 +2326,14 @@ merge_stk(_, _) -> undecided.
merge_ct(S, S) -> S;
merge_ct(Ct0, Ct1) -> merge_ct_1(Ct0, Ct1).
-merge_ct_1([C0|Ct0], [C1|Ct1]) ->
- [ordsets:from_list(C0++C1)|merge_ct_1(Ct0, Ct1)];
-merge_ct_1([], []) -> [];
-merge_ct_1(_, _) -> undecided.
-
-tuple_sz([Sz]) -> Sz;
-tuple_sz(Sz) -> Sz.
+merge_ct_1([], []) ->
+ [];
+merge_ct_1([{trytag, LblsA} | CtA], [{trytag, LblsB} | CtB]) ->
+ [{trytag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)];
+merge_ct_1([{catchtag, LblsA} | CtA], [{catchtag, LblsB} | CtB]) ->
+ [{catchtag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)];
+merge_ct_1(_, _) ->
+ undecided.
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),
@@ -2661,319 +2476,46 @@ assert_not_fragile(Lit, #vst{}) ->
ok.
%%%
-%%% Return/argument types of BIFs
+%%% Return/argument types of calls and 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
- end;
-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_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_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_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;
-is_bif_safe('=/=', 2) -> true;
-is_bif_safe('=:=', 2) -> true;
-is_bif_safe('=<', 2) -> true;
-is_bif_safe('==', 2) -> true;
-is_bif_safe('>', 2) -> true;
-is_bif_safe('>=', 2) -> true;
-is_bif_safe(is_atom, 1) -> true;
-is_bif_safe(is_boolean, 1) -> true;
-is_bif_safe(is_binary, 1) -> true;
-is_bif_safe(is_bitstring, 1) -> true;
-is_bif_safe(is_float, 1) -> true;
-is_bif_safe(is_function, 1) -> true;
-is_bif_safe(is_integer, 1) -> true;
-is_bif_safe(is_list, 1) -> true;
-is_bif_safe(is_map, 1) -> true;
-is_bif_safe(is_number, 1) -> true;
-is_bif_safe(is_pid, 1) -> true;
-is_bif_safe(is_port, 1) -> true;
-is_bif_safe(is_reference, 1) -> true;
-is_bif_safe(is_tuple, 1) -> true;
-is_bif_safe(get, 1) -> true;
-is_bif_safe(self, 0) -> true;
-is_bif_safe(node, 0) -> true;
-is_bif_safe(_, _) -> false.
-
-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_return_type(_, _) -> number.
-
-%%%
-%%% Return/argument types of calls
-%%%
-
-call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst);
-call_return_type(_, _) -> term.
-
-call_return_type_1(erlang, setelement, 3, Vst) ->
- IndexType = get_term_type({x,0}, Vst),
- 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;
-call_return_type_1(erlang, '++', 2, Vst) ->
- LType = get_term_type({x,0}, Vst),
- RType = get_term_type({x,1}, Vst),
- case LType =:= cons orelse RType =:= cons of
- true ->
- cons;
- false ->
- %% `[] ++ RHS` yields RHS, even if RHS is not a list
- join(list, RType)
- end;
-call_return_type_1(erlang, '--', 2, _Vst) ->
- list;
-call_return_type_1(erlang, F, A, _) ->
- erlang_mod_return_type(F, A);
-call_return_type_1(lists, F, A, Vst) ->
- lists_mod_return_type(F, A, Vst);
-call_return_type_1(math, F, A, _) ->
- math_mod_return_type(F, A);
-call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
- term.
-
-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.
+bif_types(Op, Ss, Vst) ->
+ Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss],
+ beam_call_types:types(erlang, Op, Args).
+
+call_types({extfunc,M,F,A}, A, Vst) ->
+ Args = get_call_args(A, Vst),
+ beam_call_types:types(M, F, Args);
+call_types(_, A, Vst) ->
+ {any, get_call_args(A, Vst), false}.
+
+will_bif_succeed(fadd, [_,_], _Vst) ->
+ maybe;
+will_bif_succeed(fdiv, [_,_], _Vst) ->
+ maybe;
+will_bif_succeed(fmul, [_,_], _Vst) ->
+ maybe;
+will_bif_succeed(fnegate, [_], _Vst) ->
+ maybe;
+will_bif_succeed(fsub, [_,_], _Vst) ->
+ maybe;
+will_bif_succeed(Op, Ss, Vst) ->
+ Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss],
+ beam_call_types:will_succeed(erlang, Op, Args).
+
+will_call_succeed({extfunc,M,F,A}, Vst) ->
+ beam_call_types:will_succeed(M, F, get_call_args(A, Vst));
+will_call_succeed(_Call, _Vst) ->
+ maybe.
+
+get_call_args(Arity, Vst) ->
+ get_call_args_1(0, Arity, Vst).
+
+get_call_args_1(Arity, Arity, _) ->
+ [];
+get_call_args_1(N, Arity, Vst) when N < Arity ->
+ ArgType = normalize(get_movable_term_type({x,N}, Vst)),
+ [ArgType | get_call_args_1(N + 1, Arity, Vst)].
check_limit({x,X}=Src) when is_integer(X) ->
if
diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl
index f489baf238..84e488fc55 100644
--- a/lib/compiler/src/cerl_sets.erl
+++ b/lib/compiler/src/cerl_sets.erl
@@ -153,14 +153,21 @@ intersection1(S1, []) -> S1.
Set1 :: set(Element),
Set2 :: set(Element).
-is_disjoint(S1, S2) when map_size(S1) < map_size(S2) ->
- fold(fun (_, false) -> false;
- (E, true) -> not is_element(E, S2)
- end, true, S1);
+is_disjoint(S1, S2) when map_size(S1) > map_size(S2) ->
+ is_disjoint_1(S1, maps:iterator(S2));
is_disjoint(S1, S2) ->
- fold(fun (_, false) -> false;
- (E, true) -> not is_element(E, S1)
- end, true, S2).
+ is_disjoint_1(S2, maps:iterator(S1)).
+
+is_disjoint_1(Set, Iter) ->
+ case maps:next(Iter) of
+ {K, _, NextIter} ->
+ case Set of
+ #{K := _} -> false;
+ #{} -> is_disjoint_1(Set, NextIter)
+ end;
+ none ->
+ true
+ end.
%% subtract(Set1, Set2) -> Set.
%% Return all and only the elements of Set1 which are not also in
@@ -180,8 +187,21 @@ subtract(S1, S2) ->
Set1 :: set(Element),
Set2 :: set(Element).
+is_subset(S1, S2) when map_size(S1) > map_size(S2) ->
+ false;
is_subset(S1, S2) ->
- fold(fun (E, Sub) -> Sub andalso is_element(E, S2) end, true, S1).
+ is_subset_1(S2, maps:iterator(S1)).
+
+is_subset_1(Set, Iter) ->
+ case maps:next(Iter) of
+ {K, _, NextIter} ->
+ case Set of
+ #{K := _} -> is_subset_1(Set, NextIter);
+ #{} -> false
+ end;
+ none ->
+ true
+ end.
%% fold(Fun, Accumulator, Set) -> Accumulator.
%% Fold function Fun over all elements in Set and return Accumulator.
@@ -193,8 +213,16 @@ is_subset(S1, S2) ->
AccIn :: Acc,
AccOut :: Acc.
-fold(F, Init, D) ->
- lists:foldl(fun(E,Acc) -> F(E,Acc) end,Init,maps:keys(D)).
+fold(Fun, Init, Set) ->
+ fold_1(Fun, Init, maps:iterator(Set)).
+
+fold_1(Fun, Acc, Iter) ->
+ case maps:next(Iter) of
+ {K, _, NextIter} ->
+ fold_1(Fun, Fun(K,Acc), NextIter);
+ none ->
+ Acc
+ end.
%% filter(Fun, Set) -> Set.
%% Filter Set with Fun.
@@ -203,5 +231,18 @@ fold(F, Init, D) ->
Set1 :: set(Element),
Set2 :: set(Element).
-filter(F, D) ->
- maps:filter(fun(K,_) -> F(K) end, D).
+filter(Fun, Set) ->
+ maps:from_list(filter_1(Fun, maps:iterator(Set))).
+
+filter_1(Fun, Iter) ->
+ case maps:next(Iter) of
+ {K, _, NextIter} ->
+ case Fun(K) of
+ true ->
+ [{K,ok} | filter_1(Fun, NextIter)];
+ false ->
+ filter_1(Fun, NextIter)
+ end;
+ none ->
+ []
+ end.
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 0325c714d0..21d67f5649 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -265,7 +265,10 @@ expand_opt(r19, Os) ->
expand_opt(r20, Os) ->
expand_opt_before_21(Os);
expand_opt(r21, Os) ->
- [no_put_tuple2 | expand_opt(no_bsm3, Os)];
+ [no_shared_fun_wrappers,
+ no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)];
+expand_opt(r22, Os) ->
+ [no_shared_fun_wrappers, no_swap | Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
expand_opt(no_type_opt=O, Os) ->
@@ -278,7 +281,8 @@ expand_opt(no_type_opt=O, Os) ->
expand_opt(O, Os) -> [O|Os].
expand_opt_before_21(Os) ->
- [no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
+ [no_shared_fun_wrappers, no_swap,
+ no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
no_utf8_atoms | expand_opt(no_bsm3, Os)].
%% format_error(ErrorDescriptor) -> string()
@@ -863,8 +867,6 @@ asm_passes() ->
{unless,no_postopt,
[{pass,beam_block},
{iff,dblk,{listing,"block"}},
- {unless,no_except,{pass,beam_except}},
- {iff,dexcept,{listing,"except"}},
{unless,no_jopt,{pass,beam_jump}},
{iff,djmp,{listing,"jump"}},
{unless,no_peep_opt,{pass,beam_peep}},
@@ -2096,9 +2098,9 @@ pre_load() ->
L = [beam_a,
beam_asm,
beam_block,
+ beam_call_types,
beam_clean,
beam_dict,
- beam_except,
beam_flatten,
beam_jump,
beam_kernel_to_ssa,
@@ -2115,6 +2117,7 @@ pre_load() ->
beam_ssa_share,
beam_ssa_type,
beam_trim,
+ beam_types,
beam_utils,
beam_validator,
beam_z,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index a086a3a8d3..092757ae65 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -24,10 +24,10 @@
beam_a,
beam_asm,
beam_block,
+ beam_call_types,
beam_clean,
beam_dict,
beam_disasm,
- beam_except,
beam_flatten,
beam_jump,
beam_kernel_to_ssa,
@@ -47,6 +47,7 @@
beam_ssa_share,
beam_ssa_type,
beam_trim,
+ beam_types,
beam_utils,
beam_validator,
beam_z,
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 86590fad87..0a38d17857 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -596,3 +596,9 @@ BEAM_FORMAT_NUMBER=0
## @spec bs_set_positon Ctx Pos
## @doc Sets the current position of Ctx to Pos
168: bs_set_position/2
+
+# OTP 23
+
+## @spec swap Register1 Register2
+## @doc Swaps the contents of two registers.
+169: swap/2
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 4939a94a92..63c67639d4 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -99,10 +99,6 @@
t=#{} :: map(), %Types
in_guard=false}). %In guard or not.
--type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}.
--type yes_no_maybe() :: 'yes' | 'no' | 'maybe'.
--type sub() :: #sub{}.
-
-spec module(cerl:c_module(), [compile:option()]) ->
{'ok', cerl:c_module(), [_]}.
@@ -315,10 +311,10 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) ->
false ->
%% Arg cannot be "values" here - only a single value
%% make sense here.
- case {Ctxt,is_safe_simple(Arg, Sub)} of
+ case {Ctxt,is_safe_simple(Arg)} of
{effect,true} -> B1;
{effect,false} ->
- case is_safe_simple(B1, Sub) of
+ case is_safe_simple(B1) of
true -> Arg;
false -> Seq0#c_seq{arg=Arg,body=B1}
end;
@@ -442,7 +438,7 @@ expr(#c_catch{anno=Anno,body=B}, effect, Sub) ->
expr(#c_catch{body=B0}=Catch, _, Sub) ->
%% We can remove catch if the value is simple
B1 = body(B0, value, Sub),
- case is_safe_simple(B1, Sub) of
+ case is_safe_simple(B1) of
true -> B1;
false -> Catch#c_catch{body=B1}
end;
@@ -458,7 +454,7 @@ expr(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X},
%% We can remove try/catch if the expression is an
%% expression that cannot fail.
- case is_safe_bool_expr(E2, Sub) orelse is_safe_simple(E2, Sub) of
+ case is_safe_bool_expr(E2) orelse is_safe_simple(E2) of
true -> E2;
false -> Try#c_try{arg=E2}
end;
@@ -472,7 +468,7 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0)
E1 = body(E0, value, Sub0),
{Vs1,Sub1} = var_list(Vs0, Sub0),
B1 = body(B0, value, Sub1),
- case is_safe_simple(E1, Sub0) of
+ case is_safe_simple(E1) of
true ->
expr(#c_let{anno=A,vars=Vs1,arg=E1,body=B1}, value, Sub0);
false ->
@@ -602,20 +598,20 @@ is_literal_fun(_) -> false.
%% Currently, we don't attempt to check binaries because they
%% are difficult to check.
-is_safe_simple(#c_var{}=Var, _) ->
+is_safe_simple(#c_var{}=Var) ->
not cerl:is_c_fname(Var);
-is_safe_simple(#c_cons{hd=H,tl=T}, Sub) ->
- is_safe_simple(H, Sub) andalso is_safe_simple(T, Sub);
-is_safe_simple(#c_tuple{es=Es}, Sub) -> is_safe_simple_list(Es, Sub);
-is_safe_simple(#c_literal{}, _) -> true;
+is_safe_simple(#c_cons{hd=H,tl=T}) ->
+ is_safe_simple(H) andalso is_safe_simple(T);
+is_safe_simple(#c_tuple{es=Es}) -> is_safe_simple_list(Es);
+is_safe_simple(#c_literal{}) -> true;
is_safe_simple(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=Name},
- args=Args}, Sub) when is_atom(Name) ->
+ args=Args}) when is_atom(Name) ->
NumArgs = length(Args),
case erl_internal:bool_op(Name, NumArgs) of
true ->
%% Boolean operators are safe if the arguments are boolean.
- all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args);
+ all(fun is_bool_expr/1, Args);
false ->
%% We need a rather complicated test to ensure that
%% we only allow safe calls that are allowed in a guard.
@@ -624,9 +620,9 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang},
(erl_internal:comp_op(Name, NumArgs) orelse
erl_internal:new_type_test(Name, NumArgs))
end;
-is_safe_simple(_, _) -> false.
+is_safe_simple(_) -> false.
-is_safe_simple_list(Es, Sub) -> all(fun(E) -> is_safe_simple(E, Sub) end, Es).
+is_safe_simple_list(Es) -> all(fun(E) -> is_safe_simple(E) end, Es).
%% will_fail(Expr) -> true|false.
%% Determine whether the expression will fail with an exception.
@@ -853,7 +849,7 @@ useless_call(_, _) -> no.
%% Anything that will not have any effect will be thrown away.
make_effect_seq([H|T], Sub) ->
- case is_safe_simple(H, Sub) of
+ case is_safe_simple(H) of
true -> make_effect_seq(T, Sub);
false -> #c_seq{arg=H,body=make_effect_seq(T, Sub)}
end;
@@ -959,138 +955,14 @@ fold_lit_args(Call, Module, Name, Args0) ->
%% Attempt to evaluate some pure BIF calls with one or more
%% non-literals arguments.
%%
-fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) ->
- eval_is_boolean(Call, Arg, 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, 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
- true ->
- eval_rel_op(Call, N, Args, Sub);
- false ->
- case erl_internal:bool_op(N, NumArgs) of
- true ->
- eval_bool_op(Call, N, Args, Sub);
- false ->
- Call
- end
- 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),
- #c_literal{anno=cerl:get_ann(Call),val=Bool};
-eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) ->
- %% BoolVar =:= true ==> BoolVar
- case is_boolean_type(Term, Sub) of
- yes -> Term;
- maybe -> Call;
- no -> #c_literal{val=false}
- end;
-eval_rel_op(Call, '==', Ops, Sub) ->
- case is_exact_eq_ok(Ops, Sub) of
- true ->
- Name = #c_literal{anno=cerl:get_ann(Call),val='=:='},
- Call#c_call{name=Name};
- false ->
- Call
- end;
-eval_rel_op(Call, '/=', Ops, Sub) ->
- case is_exact_eq_ok(Ops, Sub) of
- true ->
- Name = #c_literal{anno=cerl:get_ann(Call),val='=/='},
- Call#c_call{name=Name};
- false ->
- Call
- end;
-eval_rel_op(Call, _, _, _) -> Call.
-
-is_exact_eq_ok([A,B]=L, Sub) ->
- case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of
- true -> true;
- false -> is_exact_eq_ok_1(L)
- end.
-
-is_exact_eq_ok_1([#c_literal{val=Lit}|_]) ->
- is_non_numeric(Lit);
-is_exact_eq_ok_1([_|T]) ->
- is_exact_eq_ok_1(T);
-is_exact_eq_ok_1([]) -> false.
-
-is_non_numeric([H|T]) ->
- is_non_numeric(H) andalso is_non_numeric(T);
-is_non_numeric(Tuple) when is_tuple(Tuple) ->
- is_non_numeric_tuple(Tuple, tuple_size(Tuple));
-is_non_numeric(Map) when is_map(Map) ->
- %% Note that 17.x and 18.x compare keys in different ways.
- %% Be very conservative -- require that both keys and values
- %% are non-numeric.
- is_non_numeric(maps:to_list(Map));
-is_non_numeric(Num) when is_number(Num) ->
- false;
-is_non_numeric(_) -> true.
-
-is_non_numeric_tuple(Tuple, El) when El >= 1 ->
- is_non_numeric(element(El, Tuple)) andalso
- is_non_numeric_tuple(Tuple, El-1);
-is_non_numeric_tuple(_Tuple, 0) -> true.
-
-%% Evaluate a bool op using type information. We KNOW that
-%% there must be at least one non-literal argument (i.e.
-%% there is no need to handle the case that all argments
-%% are literal).
-
-eval_bool_op(Call, 'and', [#c_literal{val=true},Term], Sub) ->
- eval_bool_op_1(Call, Term, Term, Sub);
-eval_bool_op(Call, 'and', [Term,#c_literal{val=true}], Sub) ->
- eval_bool_op_1(Call, Term, Term, Sub);
-eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,Term], Sub) ->
- eval_bool_op_1(Call, Res, Term, Sub);
-eval_bool_op(Call, 'and', [Term,#c_literal{val=false}=Res], Sub) ->
- eval_bool_op_1(Call, Res, Term, Sub);
-eval_bool_op(Call, _, _, _) -> Call.
-
-eval_bool_op_1(Call, Res, Term, Sub) ->
- case is_boolean_type(Term, Sub) of
- yes -> Res;
- no -> eval_failure(Call, badarg);
- maybe -> Call
- end.
-
-%% Evaluate is_boolean/1 using type information.
-eval_is_boolean(Call, Term, Sub) ->
- case is_boolean_type(Term, Sub) of
- no -> #c_literal{val=false};
- yes -> #c_literal{val=true};
- maybe -> Call
- end.
-
%% eval_length(Call, List) -> Val.
%% Evaluates the length for the prefix of List which has a known
%% shape.
@@ -1804,7 +1676,7 @@ opt_bool_case_guard(#c_case{arg=#c_literal{}}=Case) ->
%%
Case;
opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) ->
- case is_safe_bool_expr(Arg, sub_new()) of
+ case is_safe_bool_expr(Arg) of
false ->
Case;
true ->
@@ -1945,7 +1817,7 @@ case_opt_arg(E0, Sub, Cs, LitExpr) ->
{error,Cs};
false ->
%% If possible, expand this variable to a previously
- %% matched term.
+ %% constructed tuple
E = case_expand_var(E0, Sub),
case_opt_arg_1(E, Cs, LitExpr)
end
@@ -2004,13 +1876,8 @@ case_opt_compiler_generated(Core) ->
case_expand_var(E, #sub{t=Tdb}) ->
Key = cerl:var_name(E),
case Tdb of
- #{Key:=T} ->
- case cerl:is_c_tuple(T) of
- false -> E;
- true -> T
- end;
- _ ->
- E
+ #{Key:=T} -> T;
+ _ -> E
end.
%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses'
@@ -2302,43 +2169,30 @@ is_simple_case_arg(_) -> false.
%% Check whether the Core expression is guaranteed to return
%% a boolean IF IT RETURNS AT ALL.
%%
-is_bool_expr(Core) ->
- is_bool_expr(Core, sub_new()).
-%% is_bool_expr(Core, Sub) -> true|false
-%% Check whether the Core expression is guaranteed to return
-%% a boolean IF IT RETURNS AT ALL. Uses type information
-%% to be able to identify more expressions as booleans.
-%%
is_bool_expr(#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=Name},args=Args}=Call, _) ->
+ name=#c_literal{val=Name},args=Args}=Call) ->
NumArgs = length(Args),
erl_internal:comp_op(Name, NumArgs) orelse
erl_internal:new_type_test(Name, NumArgs) orelse
erl_internal:bool_op(Name, NumArgs) orelse
will_fail(Call);
is_bool_expr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X},
- handler=#c_literal{val=false}}, Sub) ->
- is_bool_expr(E, Sub);
-is_bool_expr(#c_case{clauses=Cs}, Sub) ->
- is_bool_expr_list(Cs, Sub);
-is_bool_expr(#c_clause{body=B}, Sub) ->
- is_bool_expr(B, Sub);
-is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) ->
- Sub = case is_bool_expr(Arg, Sub0) of
- true -> update_types(V, [bool], Sub0);
- false -> Sub0
- end,
- is_bool_expr(B, Sub);
-is_bool_expr(#c_let{body=B}, Sub) ->
- %% Binding of multiple variables.
- is_bool_expr(B, Sub);
-is_bool_expr(C, Sub) ->
- is_boolean_type(C, Sub) =:= yes.
-
-is_bool_expr_list([C|Cs], Sub) ->
- is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub);
-is_bool_expr_list([], _) -> true.
+ handler=#c_literal{val=false}}) ->
+ is_bool_expr(E);
+is_bool_expr(#c_case{clauses=Cs}) ->
+ is_bool_expr_list(Cs);
+is_bool_expr(#c_clause{body=B}) ->
+ is_bool_expr(B);
+is_bool_expr(#c_let{body=B}) ->
+ is_bool_expr(B);
+is_bool_expr(#c_literal{val=Val}) ->
+ is_boolean(Val);
+is_bool_expr(_) -> false.
+
+is_bool_expr_list([C|Cs]) ->
+ is_bool_expr(C) andalso is_bool_expr_list(Cs);
+is_bool_expr_list([]) -> true.
%% is_safe_bool_expr(Core) -> true|false
%% Check whether the Core expression ALWAYS returns a boolean
@@ -2346,17 +2200,17 @@ is_bool_expr_list([], _) -> true.
%% is suitable for a guard (no calls to non-guard BIFs, local
%% functions, or is_record/2).
%%
-is_safe_bool_expr(Core, Sub) ->
- is_safe_bool_expr_1(Core, Sub, cerl_sets:new()).
+is_safe_bool_expr(Core) ->
+ is_safe_bool_expr_1(Core, cerl_sets:new()).
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_record},
args=[A,#c_literal{val=Tag},#c_literal{val=Size}]},
- Sub, _BoolVars) when is_atom(Tag), is_integer(Size) ->
- is_safe_simple(A, Sub);
+ _BoolVars) when is_atom(Tag), is_integer(Size) ->
+ is_safe_simple(A);
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_record}},
- _Sub, _BoolVars) ->
+ _BoolVars) ->
%% The is_record/2 BIF is NOT allowed in guards.
%% The is_record/3 BIF where its second argument is not an atom or its third
%% is not an integer is NOT allowed in guards.
@@ -2368,49 +2222,49 @@ is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[A,#c_literal{val=Arity}]},
- Sub, _BoolVars) when is_integer(Arity), Arity >= 0 ->
- is_safe_simple(A, Sub);
+ _BoolVars) when is_integer(Arity), Arity >= 0 ->
+ is_safe_simple(A);
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function}},
- _Sub, _BoolVars) ->
+ _BoolVars) ->
false;
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=Name},args=Args},
- Sub, BoolVars) ->
+ BoolVars) ->
NumArgs = length(Args),
case (erl_internal:comp_op(Name, NumArgs) orelse
erl_internal:new_type_test(Name, NumArgs)) andalso
- is_safe_simple_list(Args, Sub) of
+ is_safe_simple_list(Args) of
true ->
true;
false ->
%% Boolean operators are safe if all arguments are boolean.
erl_internal:bool_op(Name, NumArgs) andalso
- is_safe_bool_expr_list(Args, Sub, BoolVars)
+ is_safe_bool_expr_list(Args, BoolVars)
end;
-is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) ->
- case is_safe_simple(Arg, Sub) of
+is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, BoolVars) ->
+ case is_safe_simple(Arg) of
true ->
- case {is_safe_bool_expr_1(Arg, Sub, BoolVars),Vars} of
+ case {is_safe_bool_expr_1(Arg, BoolVars),Vars} of
{true,[#c_var{name=V}]} ->
- is_safe_bool_expr_1(B, Sub, cerl_sets:add_element(V, BoolVars));
+ is_safe_bool_expr_1(B, cerl_sets:add_element(V, BoolVars));
{false,_} ->
- is_safe_bool_expr_1(B, Sub, BoolVars)
+ is_safe_bool_expr_1(B, BoolVars)
end;
false -> false
end;
-is_safe_bool_expr_1(#c_literal{val=Val}, _Sub, _) ->
+is_safe_bool_expr_1(#c_literal{val=Val}, _BoolVars) ->
is_boolean(Val);
-is_safe_bool_expr_1(#c_var{name=V}, _Sub, BoolVars) ->
+is_safe_bool_expr_1(#c_var{name=V}, BoolVars) ->
cerl_sets:is_element(V, BoolVars);
-is_safe_bool_expr_1(_, _, _) -> false.
+is_safe_bool_expr_1(_, _) -> false.
-is_safe_bool_expr_list([C|Cs], Sub, BoolVars) ->
- case is_safe_bool_expr_1(C, Sub, BoolVars) of
- true -> is_safe_bool_expr_list(Cs, Sub, BoolVars);
+is_safe_bool_expr_list([C|Cs], BoolVars) ->
+ case is_safe_bool_expr_1(C, BoolVars) of
+ true -> is_safe_bool_expr_list(Cs, BoolVars);
false -> false
end;
-is_safe_bool_expr_list([], _, _) -> true.
+is_safe_bool_expr_list([], _) -> true.
%% simplify_let(Let, Sub) -> Expr | impossible
%% If the argument part of an let contains a complex expression, such
@@ -2785,7 +2639,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) ->
%% with exported variables, but the return value is
%% ignored). We can remove the first variable and the
%% the first value returned from the 'let' argument.
- Arg2 = remove_first_value(Arg1, Sub),
+ Arg2 = remove_first_value(Arg1),
Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body},
post_opt_let(Let1, Sub);
true ->
@@ -2805,36 +2659,36 @@ post_opt_let(Let0, Sub) ->
opt_build_stacktrace(Let1).
-%% remove_first_value(Core0, Sub) -> Core.
+%% remove_first_value(Core0) -> Core.
%% Core0 is an expression that returns at least two values.
%% Remove the first value returned from Core0.
-remove_first_value(#c_values{es=[V|Vs]}, Sub) ->
+remove_first_value(#c_values{es=[V|Vs]}) ->
Values = core_lib:make_values(Vs),
- case is_safe_simple(V, Sub) of
+ case is_safe_simple(V) of
false ->
#c_seq{arg=V,body=Values};
true ->
Values
end;
-remove_first_value(#c_case{clauses=Cs0}=Core, Sub) ->
- Cs = remove_first_value_cs(Cs0, Sub),
+remove_first_value(#c_case{clauses=Cs0}=Core) ->
+ Cs = remove_first_value_cs(Cs0),
Core#c_case{clauses=Cs};
-remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) ->
- Cs = remove_first_value_cs(Cs0, Sub),
- Act = remove_first_value(Act0, Sub),
+remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core) ->
+ Cs = remove_first_value_cs(Cs0),
+ Act = remove_first_value(Act0),
Core#c_receive{clauses=Cs,action=Act};
-remove_first_value(#c_let{body=B}=Core, Sub) ->
- Core#c_let{body=remove_first_value(B, Sub)};
-remove_first_value(#c_seq{body=B}=Core, Sub) ->
- Core#c_seq{body=remove_first_value(B, Sub)};
-remove_first_value(#c_primop{}=Core, _Sub) ->
+remove_first_value(#c_let{body=B}=Core) ->
+ Core#c_let{body=remove_first_value(B)};
+remove_first_value(#c_seq{body=B}=Core) ->
+ Core#c_seq{body=remove_first_value(B)};
+remove_first_value(#c_primop{}=Core) ->
Core;
-remove_first_value(#c_call{}=Core, _Sub) ->
+remove_first_value(#c_call{}=Core) ->
Core.
-remove_first_value_cs(Cs, Sub) ->
- [C#c_clause{body=remove_first_value(B, Sub)} ||
+remove_first_value_cs(Cs) ->
+ [C#c_clause{body=remove_first_value(B)} ||
#c_clause{body=B}=C <- Cs].
%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg'
@@ -2962,54 +2816,6 @@ move_case_into_arg(Expr, _) ->
Expr.
%%%
-%%% Retrieving information about types.
-%%%
-
--spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'.
-
-get_type(#c_var{name=V}, #sub{t=Tdb}) ->
- case Tdb of
- #{V:=Type} -> Type;
- _ -> none
- end;
-get_type(C, _) ->
- case cerl:type(C) of
- binary -> C;
- map -> C;
- _ ->
- case cerl:is_data(C) of
- true -> C;
- false -> none
- end
- end.
-
--spec is_boolean_type(cerl:cerl(), sub()) -> yes_no_maybe().
-
-is_boolean_type(Var, Sub) ->
- case get_type(Var, Sub) of
- none ->
- maybe;
- bool ->
- yes;
- C ->
- B = cerl:is_c_atom(C) andalso
- is_boolean(cerl:atom_val(C)),
- yes_no(B)
- end.
-
--spec is_int_type(cerl:cerl(), sub()) -> yes_no_maybe().
-
-is_int_type(Var, Sub) ->
- case get_type(Var, Sub) of
- none -> maybe;
- integer -> yes;
- C -> yes_no(cerl:is_c_int(C))
- end.
-
-yes_no(true) -> yes;
-yes_no(false) -> no.
-
-%%%
%%% Update type information.
%%%
@@ -3020,70 +2826,14 @@ update_let_types(_Vs, _Arg, Sub) ->
%% that returns multiple values.
Sub.
-update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) ->
- Sub = update_types_from_expr(V, A, Sub0),
+update_let_types_1([#c_var{name=V}|Vs], [A|As], Sub0) ->
+ Sub = update_types(V, A, Sub0),
update_let_types_1(Vs, As, Sub);
update_let_types_1([], [], Sub) -> Sub.
-update_types_from_expr(V, Expr, Sub) ->
- Type = extract_type(Expr, Sub),
- update_types(V, [Type], Sub).
-
-extract_type(#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=Name},
- args=Args}=Call, Sub) ->
- case returns_integer(Name, Args) of
- true -> integer;
- false -> extract_type_1(Call, Sub)
- end;
-extract_type(Expr, Sub) ->
- extract_type_1(Expr, Sub).
-
-extract_type_1(Expr, Sub) ->
- case is_bool_expr(Expr, Sub) of
- false -> Expr;
- true -> bool
- end.
-
-returns_integer('band', [_,_]) -> true;
-returns_integer('bnot', [_]) -> true;
-returns_integer('bor', [_,_]) -> true;
-returns_integer('bxor', [_,_]) -> true;
-returns_integer(bit_size, [_]) -> true;
-returns_integer('bsl', [_,_]) -> true;
-returns_integer('bsr', [_,_]) -> true;
-returns_integer(byte_size, [_]) -> true;
-returns_integer(ceil, [_]) -> true;
-returns_integer('div', [_,_]) -> true;
-returns_integer(floor, [_]) -> true;
-returns_integer(length, [_]) -> true;
-returns_integer('rem', [_,_]) -> true;
-returns_integer('round', [_]) -> true;
-returns_integer(size, [_]) -> true;
-returns_integer(tuple_size, [_]) -> true;
-returns_integer(trunc, [_]) -> true;
-returns_integer(_, _) -> false.
-
-%% update_types(Expr, Pattern, Sub) -> Sub'
-%% Update the type database.
-
--spec update_types(cerl:c_var(), [type_info()], sub()) -> sub().
-
-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(V, [#c_tuple{}=P], Types) ->
- Types#{V=>P};
-update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
- Types#{V=>bool};
-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_1(_, _, Types) -> Types.
+update_types(V, #c_tuple{}=P, #sub{t=Tdb}=Sub) ->
+ Sub#sub{t=Tdb#{V=>P}};
+update_types(_, _, Sub) -> Sub.
%% kill_types(V, Tdb) -> Tdb'
%% Kill any entries that references the variable,
@@ -3099,10 +2849,6 @@ 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(_, []) -> [].
%% copy_type(DestVar, SrcVar, Tdb) -> Tdb'
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index e2b8787224..49fb66126f 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -81,13 +81,17 @@
-export([module/2,format_error/1]).
--import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
- keyfind/3,partition/2,droplast/1,last/1,sort/1,reverse/1]).
+-import(lists, [droplast/1,flatten/1,foldl/3,foldr/3,
+ map/2,mapfoldl/3,member/2,
+ keyfind/3,keyreplace/4,
+ last/1,partition/2,reverse/1,
+ splitwith/2,sort/1]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
-import(cerl, [c_tuple/1]).
-include("core_parse.hrl").
-include("v3_kernel.hrl").
+-define(EXPAND_MAX_SIZE_SEGMENT, 1024).
%% These are not defined in v3_kernel.hrl.
get_kanno(Kthing) -> element(2, Kthing).
@@ -120,15 +124,19 @@ copy_anno(Kdst, Ksrc) ->
funs=[], %Fun functions
free=#{}, %Free variables
ws=[] :: [warning()], %Warnings.
- guard_refc=0}). %> 0 means in guard
+ guard_refc=0, %> 0 means in guard
+ no_shared_fun_wrappers=false :: boolean()
+ }).
-spec module(cerl:c_module(), [compile:option()]) ->
{'ok', #k_mdef{}, [warning()]}.
-module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
+module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) ->
Kas = attributes(As),
Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
- St0 = #kern{},
+ NoSharedFunWrappers = proplists:get_bool(no_shared_fun_wrappers,
+ Options),
+ St0 = #kern{no_shared_fun_wrappers=NoSharedFunWrappers},
{Kfs,St} = mapfoldl(fun function/2, St0, Fs),
{ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
@@ -716,16 +724,27 @@ gexpr_test_add(Ke, St0) ->
%% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}.
%% Convert a Core expression, flattening it at the same time.
-expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) ->
- %% A local in an expression.
- %% For now, these are wrapped into a fun by reverse
- %% eta-conversion, but really, there should be exactly one
- %% such "lambda function" for each escaping local name,
- %% instead of one for each occurrence as done now.
+expr(#c_var{anno=A0,name={Name,Arity}}=Fname, Sub, St) ->
Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} ||
- V <- integers(1, Arity)],
- Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
- expr(Fun, Sub, St);
+ V <- integers(1, Arity)],
+ case St#kern.no_shared_fun_wrappers of
+ false ->
+ %% Generate a (possibly shared) wrapper function for calling
+ %% this function.
+ Wrapper0 = ["-fun.",atom_to_list(Name),"/",integer_to_list(Arity),"-"],
+ Wrapper = list_to_atom(flatten(Wrapper0)),
+ Id = {id,{0,0,Wrapper}},
+ A = keyreplace(id, 1, A0, Id),
+ Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
+ expr(Fun, Sub, St);
+ true ->
+ %% For backward compatibility with OTP 22 and earlier,
+ %% use the pre-generated name for the fun wrapper.
+ %% There will be one wrapper function for each occurrence
+ %% of `fun F/A`.
+ Fun = #c_fun{anno=A0,vars=Vs,body=#c_apply{anno=A0,op=Fname,args=Vs}},
+ expr(Fun, Sub, St)
+ end;
expr(#c_var{anno=A,name=V}, Sub, St) ->
{#k_var{anno=A,name=get_vsub(V, Sub)},[],St};
expr(#c_literal{anno=A,val=V}, _Sub, St) ->
@@ -1152,7 +1171,7 @@ validate_bin_element_size(#k_int{val=V}) when V >= 0 -> ok;
validate_bin_element_size(#k_atom{val=all}) -> ok;
validate_bin_element_size(#k_atom{val=undefined}) -> ok;
validate_bin_element_size(_) -> throw(bad_element_size).
-
+
%% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}.
atomic_list(Ces, Sub, St) ->
@@ -1278,14 +1297,63 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0],
_ -> Isub0
end,
{Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2),
- {#k_bin_seg{anno=A,size=S,
- unit=U0,
- type=cerl:concrete(T),
- flags=Fs0,
- seg=E,next=Es},
- {Isub,Osub},St3};
+ {build_bin_seg(A, S, U0, cerl:concrete(T), Fs0, E, Es),{Isub,Osub},St3};
pattern_bin_1([], Isub, Osub, St) -> {#k_bin_end{},{Isub,Osub},St}.
+%% build_bin_seg(Anno, Size, Unit, Type, Flags, Seg, Next) -> #k_bin_seg{}.
+%% This function normalizes literal integers with size > 8 and literal
+%% utf8 segments into integers with size = 8 (and potentially an integer
+%% with size less than 8 at the end). This is so further optimizations
+%% have a normalized view of literal integers, allowing us to generate
+%% more literals and group more clauses. Those integers may be "squeezed"
+%% later into the largest integer possible.
+%%
+build_bin_seg(A, #k_int{val=Bits} = Sz, U, integer=Type, [unsigned,big]=Flags, #k_literal{val=Int}=Seg, Next) ->
+ Size = Bits * U,
+ case integer_fits_and_is_expandable(Int, Size) of
+ true -> build_bin_seg_integer_recur(A, Size, Int, Next);
+ false -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}
+ end;
+build_bin_seg(A, Sz, U, utf8=Type, [unsigned,big]=Flags, #k_literal{val=Utf8} = Seg, Next) ->
+ case utf8_fits(Utf8) of
+ {Int, Bits} -> build_bin_seg_integer_recur(A, Bits, Int, Next);
+ error -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}
+ end;
+build_bin_seg(A, Sz, U, Type, Flags, Seg, Next) ->
+ #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}.
+
+build_bin_seg_integer_recur(A, Bits, Val, Next) when Bits > 8 ->
+ NextBits = Bits - 8,
+ NextVal = Val band ((1 bsl NextBits) - 1),
+ Last = build_bin_seg_integer_recur(A, NextBits, NextVal, Next),
+ build_bin_seg_integer(A, 8, Val bsr NextBits, Last);
+
+build_bin_seg_integer_recur(A, Bits, Val, Next) ->
+ build_bin_seg_integer(A, Bits, Val, Next).
+
+build_bin_seg_integer(A, Bits, Val, Next) ->
+ Sz = #k_int{anno=A,val=Bits},
+ Seg = #k_literal{anno=A,val=Val},
+ #k_bin_seg{anno=A,size=Sz,unit=1,type=integer,flags=[unsigned,big],seg=Seg,next=Next}.
+
+integer_fits_and_is_expandable(Int, Size) when 0 < Size, Size =< ?EXPAND_MAX_SIZE_SEGMENT ->
+ case <<Int:Size>> of
+ <<Int:Size>> -> true;
+ _ -> false
+ end;
+integer_fits_and_is_expandable(_Int, _Size) ->
+ false.
+
+utf8_fits(Utf8) ->
+ try
+ Bin = <<Utf8/utf8>>,
+ Bits = bit_size(Bin),
+ <<Int:Bits>> = Bin,
+ {Int, Bits}
+ catch
+ _:_ -> error
+ end.
+
%% pattern_list([Cexpr], Sub, State) -> {[Kexpr],Sub,State}.
pattern_list(Ces, Sub, St) ->
@@ -1535,7 +1603,7 @@ maybe_add_warning(Ke, MatchAnno, St) ->
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
@@ -1743,27 +1811,10 @@ do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) ->
do_combine_lit_pat(_) ->
throw(not_possible).
-combine_bin_segs(#k_bin_seg{size=Size0,unit=Unit,type=integer,
- flags=[unsigned,big],seg=Seg,next=Next}) ->
- #k_literal{val=Size1} = do_combine_lit_pat(Size0),
- #k_literal{val=Int} = do_combine_lit_pat(Seg),
- Size = Size1 * Unit,
- if
- 0 < Size, Size < 64 ->
- Bin = <<Int:Size>>,
- case Bin of
- <<Int:Size>> ->
- NextBin = combine_bin_segs(Next),
- <<Bin/bits,NextBin/bits>>;
- _ ->
- %% The integer Int does not fit in the segment,
- %% thus it will not match.
- throw(not_possible)
- end;
- true ->
- %% Avoid creating huge binary literals.
- throw(not_possible)
- end;
+combine_bin_segs(#k_bin_seg{size=#k_int{val=8},unit=1,type=integer,
+ flags=[unsigned,big],seg=#k_literal{val=Int},next=Next})
+ when is_integer(Int), 0 =< Int, Int =< 255 ->
+ <<Int,(combine_bin_segs(Next))/bits>>;
combine_bin_segs(#k_bin_end{}) ->
<<>>;
combine_bin_segs(_) ->
@@ -1833,11 +1884,10 @@ handle_bin_con_not_possible([]) -> [].
select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
size=#k_int{val=Bits0}=Sz,unit=U,
flags=Fl,seg=#k_literal{val=Val},
- next=N}|Ps]}=C|Cs0])
- when is_integer(Val) ->
+ next=N}|Ps]}=C|Cs0]) ->
Bits = U * Bits0,
if
- Bits > 1024 -> throw(not_possible); %Expands the code too much.
+ Bits > ?EXPAND_MAX_SIZE_SEGMENT -> throw(not_possible); %Expands the code too much.
true -> ok
end,
select_assert_match_possible(Bits, Val, Fl),
@@ -1848,16 +1898,6 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
end,
Cs = select_bin_int_1(Cs0, Bits, Fl, Val),
[{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}];
-select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=utf8,
- flags=[unsigned,big]=Fl,
- seg=#k_literal{val=Val0},
- next=N}|Ps]}=C|Cs0])
- when is_integer(Val0) ->
- {Val,Bits} = select_utf8(Val0),
- P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1,
- flags=Fl,val=Val,next=N},
- Cs = select_bin_int_1(Cs0, Bits, Fl, Val),
- [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}];
select_bin_int(_) -> throw(not_possible).
select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
@@ -1872,18 +1912,6 @@ select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
end,
P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N},
[C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)];
-select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=utf8,
- flags=Fl,
- seg=#k_literal{val=Val0},
- next=N}|Ps]}=C|Cs],
- Bits, Fl, Val) when is_integer(Val0) ->
- case select_utf8(Val0) of
- {Val,Bits} -> ok;
- {_,_} -> throw(not_possible)
- end,
- P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1,
- flags=[unsigned,big],val=Val,next=N},
- [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)];
select_bin_int_1([], _, _, _) -> [];
select_bin_int_1(_, _, _, _) -> throw(not_possible).
@@ -1909,17 +1937,6 @@ match_fun(Val) ->
{match,Bs}
end.
-select_utf8(Val0) ->
- try
- Bin = <<Val0/utf8>>,
- Size = bit_size(Bin),
- <<Val:Size>> = Bin,
- {Val,Size}
- catch
- error:_ ->
- throw(not_possible)
- end.
-
%% 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.
@@ -2039,7 +2056,8 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) ->
{Match0,Vs,St1} = get_match(get_con(Cs0), St0),
Match = sub_size_var(Match0, Cs0),
{Cs1,St2} = new_clauses(Cs0, U, St1),
- {B,St3} = match(Vs ++ Us, Cs1, Def, St2),
+ Cs2 = squeeze_clauses_by_bin_integer_count(Cs1, []),
+ {B,St3} = match(Vs ++ Us, Cs2, Def, St2),
{#k_val_clause{anno=Anno,val=Match,body=B},St3}.
sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) ->
@@ -2109,6 +2127,102 @@ new_clauses(Cs0, U, St) ->
end, Cs0),
{Cs1,St}.
+%% group and squeeze
+%% The goal of those functions is to group subsequent integer k_bin_seg
+%% literals by count so we can leverage bs_get_integer_16 whenever possible.
+%%
+%% The priority is to create large groups. So if we have three clauses matching
+%% on 16-bits/16-bits/8-bits, we will first have a single 8-bits match for all
+%% three clauses instead of clauses (one with 16 and another with 8). But note
+%% the algorithm is recursive, so the remaining 8-bits for the first two clauses
+%% will be grouped next.
+%%
+%% We also try to not create too large groups. If we have too many clauses,
+%% it is preferrable to match on 8-bits, select a branch, then match on the
+%% next 8-bits, rather than match on 16-bits which would force us to have
+%% to select to many values at the same time, which would not be efficient.
+%%
+%% Another restriction is that we create groups only if the end of the
+%% group is a variadic clause or the end of the binary. That's because
+%% if we have 16-bits/16-bits/catch-all, breaking it into a 16-bits lookup
+%% will make the catch-all more expensive.
+%%
+%% Clauses are grouped in reverse when squeezing and then flattened and
+%% re-reversed at the end.
+squeeze_clauses_by_bin_integer_count([Clause | Clauses], Acc) ->
+ case clause_count_bin_integer_segments(Clause) of
+ {literal, N} -> squeeze_clauses_by_bin_integer_count(Clauses, N, 1, [Clause], Acc);
+ _ -> squeeze_clauses_by_bin_integer_count(Clauses, [[Clause] | Acc])
+ end;
+squeeze_clauses_by_bin_integer_count(_, Acc) ->
+ flat_reverse(Acc, []).
+
+squeeze_clauses_by_bin_integer_count([], N, Count, GroupAcc, Acc) ->
+ Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count),
+ flat_reverse([Squeezed | Acc], []);
+squeeze_clauses_by_bin_integer_count([#iclause{pats=[#k_bin_end{} | _]} = Clause], N, Count, GroupAcc, Acc) ->
+ Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count),
+ flat_reverse([[Clause | Squeezed] | Acc], []);
+squeeze_clauses_by_bin_integer_count([Clause | Clauses], N, Count, GroupAcc, Acc) ->
+ case clause_count_bin_integer_segments(Clause) of
+ {literal, NewN} ->
+ squeeze_clauses_by_bin_integer_count(Clauses, min(N, NewN), Count + 1, [Clause | GroupAcc], Acc);
+
+ {variadic, NewN} when NewN =< N ->
+ Squeezed = squeeze_clauses(GroupAcc, NewN, Count),
+ squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | Squeezed] | Acc]);
+
+ _ ->
+ squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | GroupAcc] | Acc])
+ end.
+
+clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | _]}) ->
+ count_bin_integer_segments(BinSeg, 0);
+clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{size=#k_int{val=Size},unit=Unit,
+ type=integer,flags=[unsigned,big], seg=#k_var{}} | _]})
+ when ((Size * Unit) rem 8) =:= 0 ->
+ {variadic, (Size * Unit) div 8};
+clause_count_bin_integer_segments(_) ->
+ error.
+
+count_bin_integer_segments(#k_bin_seg{size=#k_int{val=8},unit=1,type=integer,flags=[unsigned,big],
+ seg=#k_literal{val=Int},next=Next}, Count) when is_integer(Int), 0 =< Int, Int =< 255 ->
+ count_bin_integer_segments(Next, Count + 1);
+count_bin_integer_segments(_, Count) when Count > 0 ->
+ {literal, Count};
+count_bin_integer_segments(_, _Count) ->
+ error.
+
+%% Since 4 bytes in on 32-bits systems are bignums, we convert
+%% anything more than 3 into 2 bytes lookup. The goal is to convert
+%% any multi-clause segment into 2-byte lookups with a potential
+%% 3 byte lookup at the end.
+fix_count_without_variadic_segment(N) when N > 3 -> 2;
+fix_count_without_variadic_segment(N) -> N.
+
+%% If we have more than 16 clauses, then it is better
+%% to branch multiple times than getting a large integer.
+%% We also abort if we have nothing to squeeze.
+squeeze_clauses(Clauses, Size, Count) when Count >= 16; Size == 1 -> Clauses;
+squeeze_clauses(Clauses, Size, _Count) -> squeeze_clauses(Clauses, Size).
+
+squeeze_clauses([#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | Pats]} = Clause | Clauses], Size) ->
+ [Clause#iclause{pats=[squeeze_segments(BinSeg, 0, 0, Size) | Pats]} |
+ squeeze_clauses(Clauses, Size)];
+squeeze_clauses([], _Size) ->
+ [].
+
+squeeze_segments(#k_bin_seg{size=Sz, seg=#k_literal{val=Val}=Lit} = BinSeg, Acc, Size, 1) ->
+ BinSeg#k_bin_seg{size=Sz#k_int{val=Size + 8}, seg=Lit#k_literal{val=(Acc bsl 8) bor Val}};
+squeeze_segments(#k_bin_seg{seg=#k_literal{val=Val},next=Next}, Acc, Size, Count) ->
+ squeeze_segments(Next, (Acc bsl 8) bor Val, Size + 8, Count - 1).
+
+flat_reverse([Head | Tail], Acc) -> flat_reverse(Tail, flat_reverse_1(Head, Acc));
+flat_reverse([], Acc) -> Acc.
+
+flat_reverse_1([Head | Tail], Acc) -> flat_reverse_1(Tail, [Head | Acc]);
+flat_reverse_1([], Acc) -> Acc.
+
%% build_guard([GuardClause]) -> GuardExpr.
build_guard([]) -> fail;
@@ -2446,8 +2560,21 @@ uexpr(Lit, {break,Rs0}, St0) ->
{#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)},
arg=Lit,ret=Rs},Used,St1}.
-add_local_function(_, #kern{funs=ignore}=St) -> St;
-add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}.
+add_local_function(_, #kern{funs=ignore}=St) ->
+ St;
+add_local_function(#k_fdef{func=Name,arity=Arity}=F, #kern{funs=Funs}=St) ->
+ case is_defined(Name, Arity, Funs) of
+ false ->
+ St#kern{funs=[F|Funs]};
+ true ->
+ St
+ end.
+
+is_defined(Name, Arity, [#k_fdef{func=Name,arity=Arity}|_]) ->
+ true;
+is_defined(Name, Arity, [#k_fdef{}|T]) ->
+ is_defined(Name, Arity, T);
+is_defined(_, _, []) -> false.
%% Make a #k_fdef{}, making sure that the body is always a #k_match{}.
make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) ->
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 7be23fbb93..44cff40128 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -16,6 +16,7 @@ MODULES= \
beam_reorder_SUITE \
beam_ssa_SUITE \
beam_type_SUITE \
+ beam_types_SUITE \
beam_utils_SUITE \
bif_SUITE \
bs_bincomp_SUITE \
@@ -236,6 +237,6 @@ release_tests_spec: make_emakefile
$(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)"
rm $(ERL_DUMMY_FILES)
chmod -R u+w "$(RELSYSDIR)"
- @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
+ @tar cf - *_SUITE_data property_test | (cd "$(RELSYSDIR)"; tar xf -)
release_docs_spec:
diff --git a/lib/compiler/test/beam_ssa_SUITE.erl b/lib/compiler/test/beam_ssa_SUITE.erl
index 3b510f3528..054f86731a 100644
--- a/lib/compiler/test/beam_ssa_SUITE.erl
+++ b/lib/compiler/test/beam_ssa_SUITE.erl
@@ -200,6 +200,8 @@ recv(_Config) ->
%% tricky_recv_6/0 is a compile-time error.
tricky_recv_6(),
+ recv_coverage(),
+
ok.
sync_wait_mon({Pid, Ref}, Timeout) ->
@@ -326,7 +328,7 @@ tricky_recv_5() ->
end.
%% When fixing tricky_recv_5, we introduced a compiler crash when the common
-%% exit block was ?BADARG_BLOCK and floats were in the picture.
+%% exit block was ?EXCEPTION_BLOCK and floats were in the picture.
tricky_recv_6() ->
RefA = make_ref(),
RefB = make_ref(),
@@ -337,6 +339,69 @@ tricky_recv_6() ->
ok
end.
+recv_coverage() ->
+ self() ! 1,
+ a = recv_coverage_1(),
+ self() ! 2,
+ b = recv_coverage_1(),
+
+ self() ! 1,
+ a = recv_coverage_2(),
+ self() ! 2,
+ b = recv_coverage_2(),
+
+ ok.
+
+%% Similar to tricky_recv_5/0, but provides test coverage for the #b_switch{}
+%% terminator.
+recv_coverage_1() ->
+ receive
+ X=1 ->
+ %% Jump to common exit block through #b_switch{list=L}
+ case id(0) of
+ 0 -> a;
+ 1 -> b;
+ 2 -> c;
+ 3 -> d
+ end;
+ X=2 ->
+ %% Jump to common exit block through #b_switch{fail=F}
+ case id(42) of
+ 0 -> exit(quit);
+ 1 -> exit(quit);
+ 2 -> exit(quit);
+ 3 -> exit(quit);
+ _ -> b
+ end
+ end,
+ case X of
+ 1 -> a;
+ 2 -> b
+ end.
+
+%% Similar to recv_coverage_1/0, providing test coverage for #b_br{}.
+recv_coverage_2() ->
+ receive
+ X=1 ->
+ A = id(1),
+ %% Jump to common exit block through #b_br{succ=S}.
+ if
+ A =:= 1 -> a;
+ true -> exit(quit)
+ end;
+ X=2 ->
+ A = id(2),
+ %% Jump to common exit block through #b_br{fail=F}.
+ if
+ A =:= 1 -> exit(quit);
+ true -> a
+ end
+ end,
+ case X of
+ 1 -> a;
+ 2 -> b
+ end.
+
maps(_Config) ->
{'EXIT',{{badmatch,#{}},_}} = (catch maps_1(any)),
ok.
@@ -388,48 +453,8 @@ cover_ssa_dead(_Config) ->
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
diff --git a/lib/compiler/test/beam_types_SUITE.erl b/lib/compiler/test/beam_types_SUITE.erl
new file mode 100644
index 0000000000..8e71a716cd
--- /dev/null
+++ b/lib/compiler/test/beam_types_SUITE.erl
@@ -0,0 +1,124 @@
+%%
+%% %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%
+%%
+
+-module(beam_types_SUITE).
+
+-include_lib("compiler/src/beam_types.hrl").
+
+-export([all/0, suite/0, groups/0,
+ init_per_suite/1, end_per_suite/1]).
+
+-export([absorption/1,
+ associativity/1,
+ commutativity/1,
+ idempotence/1,
+ identity/1]).
+
+-export([binary_absorption/1,
+ integer_absorption/1,
+ integer_associativity/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [{group,property_tests},
+ binary_absorption,
+ integer_absorption,
+ integer_associativity].
+
+groups() ->
+ [{property_tests,[parallel],
+ [absorption,
+ associativity,
+ commutativity,
+ idempotence,
+ identity]}].
+
+init_per_suite(Config) ->
+ ct_property_test:init_per_suite(Config).
+
+end_per_suite(Config) ->
+ Config.
+
+absorption(Config) when is_list(Config) ->
+ %% manual test: proper:quickcheck(beam_types_prop:absorption()).
+ true = ct_property_test:quickcheck(beam_types_prop:absorption(), Config).
+
+associativity(Config) when is_list(Config) ->
+ %% manual test: proper:quickcheck(beam_types_prop:associativity()).
+ true = ct_property_test:quickcheck(beam_types_prop:associativity(), Config).
+
+commutativity(Config) when is_list(Config) ->
+ %% manual test: proper:quickcheck(beam_types_prop:commutativity()).
+ true = ct_property_test:quickcheck(beam_types_prop:commutativity(), Config).
+
+idempotence(Config) when is_list(Config) ->
+ %% manual test: proper:quickcheck(beam_types_prop:idempotence()).
+ true = ct_property_test:quickcheck(beam_types_prop:idempotence(), Config).
+
+identity(Config) when is_list(Config) ->
+ %% manual test: proper:quickcheck(beam_types_prop:identity()).
+ true = ct_property_test:quickcheck(beam_types_prop:identity(), Config).
+
+binary_absorption(Config) when is_list(Config) ->
+ %% These binaries should meet into {binary,12} as that's the best common
+ %% unit for both types.
+ A = #t_bitstring{unit=4},
+ B = #t_bitstring{unit=6},
+
+ #t_bitstring{unit=12} = beam_types:meet(A, B),
+ #t_bitstring{unit=2} = beam_types:join(A, B),
+
+ A = beam_types:meet(A, beam_types:join(A, B)),
+ A = beam_types:join(A, beam_types:meet(A, B)),
+
+ ok.
+
+integer_absorption(Config) when is_list(Config) ->
+ %% Integers that don't overlap at all should never meet.
+ A = #t_integer{elements={2,3}},
+ B = #t_integer{elements={4,5}},
+
+ none = beam_types:meet(A, B),
+ #t_integer{elements={2,5}} = beam_types:join(A, B),
+
+ A = beam_types:meet(A, beam_types:join(A, B)),
+ A = beam_types:join(A, beam_types:meet(A, B)),
+
+ ok.
+
+integer_associativity(Config) when is_list(Config) ->
+ A = #t_integer{elements={3,5}},
+ B = #t_integer{elements={4,6}},
+ C = #t_integer{elements={5,5}},
+
+ %% a ∨ (b ∨ c) = (a ∨ b) ∨ c,
+ LHS_Join = beam_types:join(A, beam_types:join(B, C)),
+ RHS_Join = beam_types:join(beam_types:join(A, B), C),
+ #t_integer{elements={3,6}} = LHS_Join = RHS_Join,
+
+ %% a ∧ (b ∧ c) = (a ∧ b) ∧ c.
+ LHS_Meet = beam_types:meet(A, beam_types:meet(B, C)),
+ RHS_Meet = beam_types:meet(beam_types:meet(A, B), C),
+ #t_integer{elements={5,5}} = LHS_Meet = RHS_Meet,
+
+ ok.
+
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 20f6cb2691..68b665fbc3 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -35,7 +35,8 @@
map_field_lists/1,cover_bin_opt/1,
val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1,
receive_stacked/1,aliased_types/1,type_conflict/1,
- infer_on_eq/1,infer_dead_value/1]).
+ infer_on_eq/1,infer_dead_value/1,infer_on_ne/1,
+ branch_to_try_handler/1]).
-include_lib("common_test/include/ct.hrl").
@@ -65,7 +66,8 @@ groups() ->
map_field_lists,cover_bin_opt,val_dsetel,
bad_tuples,bad_try_catch_nesting,
receive_stacked,aliased_types,type_conflict,
- infer_on_eq,infer_dead_value]}].
+ infer_on_eq,infer_dead_value,infer_on_ne,
+ branch_to_try_handler]}].
init_per_suite(Config) ->
test_lib:recompile(?MODULE),
@@ -217,11 +219,11 @@ bad_catch_try(Config) when is_list(Config) ->
{{catch_end,{x,9}},
8,{invalid_tag_register,{x,9}}}},
{{bad_catch_try,bad_3,1},
- {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}},
+ {{catch_end,{y,1}},9,{invalid_tag,{y,1},{t_atom,[kalle]}}}},
{{bad_catch_try,bad_4,1},
{{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}},
{{bad_catch_try,bad_5,1},
- {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}},
+ {{try_case,{y,1}},12,{invalid_tag,{y,1},any}}},
{{bad_catch_try,bad_6,1},
{{move,{integer,1},{y,1}},7,
{invalid_store,{y,1}}}}] = Errors,
@@ -232,7 +234,7 @@ cons_guard(Config) when is_list(Config) ->
[{{cons,foo,1},
{{get_list,{x,0},{x,1},{x,2}},
5,
- {bad_type,{needed,cons},{actual,term}}}}] = Errors,
+ {bad_type,{needed,cons},{actual,any}}}}] = Errors,
ok.
freg_range(Config) when is_list(Config) ->
@@ -520,9 +522,9 @@ bad_tuples(Config) ->
{{bad_tuples,long,2},
{{put,{atom,too_long}},8,not_building_a_tuple}},
{{bad_tuples,self_referential,1},
- {{put,{x,1}},7,{tuple_in_progress,{x,1}}}},
+ {{put,{x,1}},7,{unfinished_tuple,{x,1}}}},
{{bad_tuples,short,1},
- {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors,
+ {{move,{x,1},{x,0}},7,{unfinished_tuple,{x,1}}}}] = Errors,
ok.
@@ -705,6 +707,25 @@ idv_1({_A, _B, _C, _D, _E, F, G},
idv_1(_A, _B) ->
error.
+%% ERL-998; type inference for select_val (#b_switch{}) was more clever than
+%% that for is_ne_exact (#b_br{}), sometimes failing validation when the type
+%% optimization pass acted on the former and the validator got the latter.
+
+-record(ion, {state}).
+
+infer_on_ne(Config) when is_list(Config) ->
+ #ion{state = closing} = ion_1(#ion{ state = id(open) }),
+ #ion{state = closing} = ion_close(#ion{ state = open }),
+ ok.
+
+ion_1(State = #ion{state = open}) -> ion_2(State);
+ion_1(State = #ion{state = closing}) -> ion_2(State).
+
+ion_2(State = #ion{state = open}) -> ion_close(State);
+ion_2(#ion{state = closing}) -> ok.
+
+ion_close(State = #ion{}) -> State#ion{state = closing}.
+
%% ERL-995: The first solution to ERIERL-348 was incomplete and caused
%% validation to fail when living values depended on delayed type inference on
%% "dead" values.
@@ -722,6 +743,17 @@ idv_2(State) ->
idv_called_once(_State) -> ok.
+%% Direct jumps to try/catch handlers crash the emulator and must fail
+%% validation. This is provoked by OTP-15945.
+
+branch_to_try_handler(Config) ->
+ Errors = do_val(branch_to_try_handler, Config),
+ [{{branch_to_try_handler,main,1},
+ {{bif,tuple_size,{f,3},[{y,0}],{x,0}},
+ 12,
+ {illegal_branch,try_handler,3}}}] = Errors,
+ ok.
+
%%%-------------------------------------------------------------------------
transform_remove(Remove, Module) ->
diff --git a/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S
new file mode 100644
index 0000000000..6d43ec7b54
--- /dev/null
+++ b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S
@@ -0,0 +1,48 @@
+{module, branch_to_try_handler}. %% version = 0
+
+{exports, [{main,1}]}.
+
+{attributes, []}.
+
+{labels, 11}.
+
+{function, main, 1, 2}.
+ {label,1}.
+ {line,[{location,"t.erl",4}]}.
+ {func_info,{atom,branch_to_try_handler},{atom,main},1}.
+ {label,2}.
+ {allocate,2,1}.
+ {move,{x,0},{y,0}}.
+ {'try',{y,1},{f,3}}.
+ {move,{atom,ignored},{x,0}}.
+ {line,[{location,"t.erl",6}]}.
+ {call,1,{f,6}}.
+ {'%',{type_info,{x,0},{t_atom,[ignored]}}}.
+ {line,[{location,"t.erl",7}]}.
+ %%
+ %% Fail directly to the try handler instead of throwing an exception; this
+ %% will crash the emulator.
+ %%
+ {bif,tuple_size,{f,3},[{y,0}],{x,0}}.
+ %%
+ {test,is_eq_exact,{f,4},[{x,0},{integer,1}]}.
+ {move,{atom,error},{x,0}}.
+ {try_end,{y,1}}.
+ {deallocate,2}.
+ return.
+ {label,3}.
+ {try_case,{y,1}}.
+ {move,{atom,ok},{x,0}}.
+ {deallocate,2}.
+ return.
+ {label,4}.
+ {line,[{location,"t.erl",7}]}.
+ {badmatch,{x,0}}.
+
+{function, id, 1, 6}.
+ {label,5}.
+ {line,[{location,"t.erl",13}]}.
+ {func_info,{atom,branch_to_try_handler},{atom,id},1}.
+ {label,6}.
+ {'%',{type_info,{x,0},{t_atom,[ignored]}}}.
+ return.
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 145a50f4ad..0dc1d64eeb 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -24,7 +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,
+ verify_highest_opcode/1, expand_and_squeeze/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,
@@ -64,7 +64,7 @@ groups() ->
[{p,[],
[verify_highest_opcode,
size_shadow,int_float,otp_5269,null_fields,wiger,
- bin_tail,save_restore,
+ bin_tail,save_restore,expand_and_squeeze,
partitioned_bs_match,function_clause,unit,
shared_sub_bins,bin_and_float,dec_subidentifiers,
skip_optional_tag,decode_integer,wfbm,degenerated_match,bs_sum,
@@ -2021,3 +2021,161 @@ do_exceptions_after_match_failure(Other) ->
ok.
id(I) -> I.
+
+expand_and_squeeze(Config) when is_list(Config) ->
+ %% UTF8 literals are expanded and then squeezed into integer16
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,16}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<$á/utf8,_/binary>>"),
+ ?Q("<<$é/utf8,_/binary>>")
+ ]),
+
+ %% Sized integers are expanded and then squeezed into integer16
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,16}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<0:32,_/binary>>"),
+ ?Q("<<\"bbbb\",_/binary>>")
+ ]),
+
+ %% Groups of 8 bits are squeezed into integer16
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,16}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<\"aaaa\",_/binary>>"),
+ ?Q("<<\"bbbb\",_/binary>>")
+ ]),
+
+ %% Groups of 8 bits with empty binary are also squeezed
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,16}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<\"aaaa\",_/binary>>"),
+ ?Q("<<\"bbbb\",_/binary>>"),
+ ?Q("<<>>")
+ ]),
+
+ %% Groups of 8 bits with float lookup are not squeezed
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,8}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<\"aaaa\",_/binary>>"),
+ ?Q("<<\"bbbb\",_/binary>>"),
+ ?Q("<<_/float>>")
+ ]),
+
+ %% Groups of diverse bits go with minimum possible
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,8}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<\"aa\",_/binary>>"),
+ ?Q("<<\"bb\",_/binary>>"),
+ ?Q("<<\"c\",_/binary>>")
+ ]),
+
+ %% Groups of diverse bits go with minimum possible but are recursive...
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,8}|_],_}
+ | RestDiverse
+ ] = binary_match_to_asm([
+ ?Q("<<\"aaa\",_/binary>>"),
+ ?Q("<<\"abb\",_/binary>>"),
+ ?Q("<<\"c\",_/binary>>")
+ ]),
+
+ %% so we still perform a 16 bits lookup for the remaining
+ true = lists:any(fun({test,bs_get_integer2,_,_,[_,{integer,16}|_],_}) -> true;
+ (_) -> false end, RestDiverse),
+
+ %% Large match is kept as is if there is a sized match later
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,64}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<255,255,255,255,255,255,255,255>>"),
+ ?Q("<<_:64>>")
+ ]),
+
+ %% Large match is kept as is with large matches before and after
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,32}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<A:32,_:A>>"),
+ ?Q("<<0:32>>"),
+ ?Q("<<_:32>>")
+ ]),
+
+ %% Large match is kept as is with large matches before and after
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,32}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<A:32,_:A>>"),
+ ?Q("<<0,0,0,0>>"),
+ ?Q("<<_:32>>")
+ ]),
+
+ %% Large match is kept as is with smaller but still large matches before and after
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,32}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<A:32, _:A>>"),
+ ?Q("<<0:64>>"),
+ ?Q("<<_:32>>")
+ ]),
+
+ %% There is no squeezing for groups with more than 16 matches
+ [
+ {test,bs_get_integer2,_,_,[_,{integer,8}|_],_}
+ | _
+ ] = binary_match_to_asm([
+ ?Q("<<\"aa\", _/binary>>"),
+ ?Q("<<\"bb\", _/binary>>"),
+ ?Q("<<\"cc\", _/binary>>"),
+ ?Q("<<\"dd\", _/binary>>"),
+ ?Q("<<\"ee\", _/binary>>"),
+ ?Q("<<\"ff\", _/binary>>"),
+ ?Q("<<\"gg\", _/binary>>"),
+ ?Q("<<\"hh\", _/binary>>"),
+ ?Q("<<\"ii\", _/binary>>"),
+ ?Q("<<\"jj\", _/binary>>"),
+ ?Q("<<\"kk\", _/binary>>"),
+ ?Q("<<\"ll\", _/binary>>"),
+ ?Q("<<\"mm\", _/binary>>"),
+ ?Q("<<\"nn\", _/binary>>"),
+ ?Q("<<\"oo\", _/binary>>"),
+ ?Q("<<\"pp\", _/binary>>")
+ ]),
+
+ ok.
+
+binary_match_to_asm(Matches) ->
+ Clauses = [
+ begin
+ Ann = element(2, Match),
+ {clause,Ann,[Match],[],[{integer,Ann,Return}]}
+ end || {Match,Return} <- lists:zip(Matches, lists:seq(1, length(Matches)))
+ ],
+
+ Module = [
+ {attribute,1,module,match_to_asm},
+ {attribute,2,export,[{example,1}]},
+ {function,3,example,1,Clauses}
+ ],
+
+ {ok,match_to_asm,{match_to_asm,_Exports,_Attrs,Funs,_},_} =
+ compile:forms(Module, [return, to_asm]),
+
+ [{function,example,1,2,AllInstructions}|_] = Funs,
+ [{label,_},{line,_},{func_info,_,_,_},{label,_},{'%',_},
+ {test,bs_start_match3,_,_,_,_},{bs_get_position,_,_,_}|Instructions] = AllInstructions,
+ Instructions.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 53627b9d81..453debc0c1 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -378,7 +378,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
{dprecg, ".precodegen"},
{dcg, ".codegen"},
{dblk, ".block"},
- {dexcept, ".except"},
{djmp, ".jump"},
{dclean, ".clean"},
{dpeep, ".peep"},
@@ -1383,27 +1382,33 @@ env_compiler_options(_Config) ->
bc_options(Config) ->
DataDir = proplists:get_value(data_dir, Config),
- L = [{101, small_float, [no_get_hd_tl,no_line_info]},
- {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+ L = [{101, small_float, [no_shared_fun_wrappers,
+ no_get_hd_tl,no_line_info]},
+ {103, big, [no_shared_fun_wrappers,
+ 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]},
+ {125, small_float, [no_shared_fun_wrappers,no_get_hd_tl,
+ no_line_info,
+ no_ssa_opt_float]},
- {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+ {132, small, [no_shared_fun_wrappers,
+ no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
no_ssa_opt_float,no_line_info,no_bsm3]},
+ {136, big, [no_shared_fun_wrappers,no_put_tuple2,no_get_hd_tl,
+ no_ssa_opt_record,no_line_info]},
+
{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, [no_shared_fun_wrappers,
+ 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, []},
+ {153, small_float, [no_shared_fun_wrappers]},
{158, small_maps, [r17]},
{158, small_maps, [r18]},
@@ -1411,8 +1416,17 @@ bc_options(Config) ->
{158, small_maps, [r20]},
{158, small_maps, [r21]},
- {164, small_maps, []},
- {164, big, []}
+ {164, small_maps, [r22]},
+ {164, big, [r22]},
+ {164, small_maps, [no_shared_fun_wrappers]},
+ {164, big, [no_shared_fun_wrappers]},
+
+ {168, small, [r22]},
+ {168, small, [no_shared_fun_wrappers]},
+
+ {169, small_maps, []},
+ {169, big, []},
+ {169, small, []}
],
Test = fun({Expected,Mod,Options}) ->
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index cea7a374cd..d3d62b53f5 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -19,7 +19,7 @@
%%
-module(guard_SUITE).
--include_lib("common_test/include/ct.hrl").
+-include_lib("syntax_tools/include/merl.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
@@ -31,7 +31,8 @@
old_guard_tests/1,complex_guard/1,
build_in_guard/1,gbif/1,
t_is_boolean/1,is_function_2/1,
- tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1,
+ tricky/1,rel_ops/1,rel_op_combinations/1,
+ generated_combinations/1,literal_type_tests/1,
basic_andalso_orelse/1,traverse_dcd/1,
check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
bad_constants/1,bad_guards/1,
@@ -51,7 +52,7 @@ groups() ->
more_xor_guards,build_in_guard,
old_guard_tests,complex_guard,gbif,
t_is_boolean,is_function_2,tricky,
- rel_ops,rel_op_combinations,
+ rel_ops,rel_op_combinations,generated_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,
@@ -1579,6 +1580,122 @@ redundant_12(X) when X >= 50, X =< 80 -> 2*X;
redundant_12(X) when X < 51 -> 5*X;
redundant_12(_) -> none.
+generated_combinations(Config) ->
+ case ?MODULE of
+ guard_SUITE -> generated_combinations_1(Config);
+ _ -> {skip,"Enough to run this case once."}
+ end.
+
+%% Exhaustively test all combinations of relational operators
+%% to ensure the correctness of the optimizations in beam_ssa_dead.
+
+generated_combinations_1(Config) ->
+ Mod = ?FUNCTION_NAME,
+ RelOps = ['=:=','=/=','==','/=','<','=<','>=','>'],
+ Combinations0 = [{Op1,Op2} || Op1 <- RelOps, Op2 <- RelOps],
+ Combinations1 = gen_lit_combs(Combinations0),
+ Combinations2 = [{neq,Comb} ||
+ {_Op1,_Lit1,Op2,_Lit2}=Comb <- Combinations1,
+ Op2 =:= '=/=' orelse Op2 =:= '/='] ++ Combinations1,
+ Combinations = gen_func_names(Combinations2, 0),
+ Fs = gen_rel_op_functions(Combinations),
+ Tree = ?Q(["-module('@Mod@').",
+ "-compile([export_all,nowarn_export_all])."]) ++ Fs,
+ %%merl:print(Tree),
+ Opts = test_lib:opt_opts(?MODULE),
+ {ok,_Bin} = merl:compile_and_load(Tree, Opts),
+ test_combinations(Combinations, Mod).
+
+gen_lit_combs([{Op1,Op2}|T]) ->
+ [{Op1,7,Op2,6},
+ {Op1,7.0,Op2,6},
+ {Op1,7,Op2,6.0},
+ {Op1,7.0,Op2,6.0},
+
+ {Op1,7,Op2,7},
+ {Op1,7.0,Op2,7},
+ {Op1,7,Op2,7.0},
+ {Op1,7.0,Op2,7.0},
+
+ {Op1,6,Op2,7},
+ {Op1,6.0,Op2,7},
+ {Op1,6,Op2,7.0},
+ {Op1,6.0,Op2,7.0}|gen_lit_combs(T)];
+gen_lit_combs([]) -> [].
+
+gen_func_names([E|Es], I) ->
+ Name = list_to_atom("f" ++ integer_to_list(I)),
+ [{Name,E}|gen_func_names(Es, I+1)];
+gen_func_names([], _) -> [].
+
+gen_rel_op_functions([{Name,{neq,{Op1,Lit1,Op2,Lit2}}}|T]) ->
+ %% Note that in the translation to SSA, '=/=' will be
+ %% translated to '=:=' in a guard (with switched success
+ %% and failure labels). Therefore, to test the optimization,
+ %% we must use '=/=' (or '/=') in a body context.
+ %%
+ %% Here is an example of a generated function:
+ %%
+ %% f160(A) when erlang:'>='(A, 7) ->
+ %% one;
+ %% f160(A) ->
+ %% true = erlang:'/='(A, 7),
+ %% two.
+ [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one;
+ '@Name@'(A) -> true = erlang:'@Op2@'(A, _@Lit2@), two. ")|
+ gen_rel_op_functions(T)];
+gen_rel_op_functions([{Name,{Op1,Lit1,Op2,Lit2}}|T]) ->
+ %% Example of a generated function:
+ %%
+ %% f721(A) when erlang:'=<'(A, 7.0) -> one;
+ %% f721(A) when erlang:'<'(A, 6) -> two;
+ %% f721(_) -> three.
+ [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one;
+ '@Name@'(A) when erlang:'@Op2@'(A, _@Lit2@) -> two;
+ '@Name@'(_) -> three.")|gen_rel_op_functions(T)];
+gen_rel_op_functions([]) -> [].
+
+test_combinations([{Name,E}|T], Mod) ->
+ try
+ test_combinations_1([5,6,7,8,9], E, fun Mod:Name/1),
+ test_combination(6.5, E, fun Mod:Name/1)
+ catch
+ error:Reason:Stk ->
+ io:format("~p: ~p\n", [Name,E]),
+ erlang:raise(error, Reason, Stk)
+ end,
+ test_combinations(T, Mod);
+test_combinations([], _Mod) -> ok.
+
+test_combinations_1([V|Vs], E, Fun) ->
+ test_combination(V, E, Fun),
+ test_combination(float(V), E, Fun),
+ test_combinations_1(Vs, E, Fun);
+test_combinations_1([], _, _) -> ok.
+
+test_combination(Val, {neq,Expr}, Fun) ->
+ Result = eval_combination_expr(Expr, Val),
+ Result = try
+ Fun(Val) %Returns 'one' or 'two'.
+ catch
+ error:{badmatch,_} ->
+ three
+ end;
+test_combination(Val, Expr, Fun) ->
+ Result = eval_combination_expr(Expr, Val),
+ Result = Fun(Val).
+
+eval_combination_expr({Op1,Lit1,Op2,Lit2}, Val) ->
+ case erlang:Op1(Val, Lit1) of
+ true ->
+ one;
+ false ->
+ case erlang:Op2(Val, Lit2) of
+ true -> two;
+ false -> three
+ end
+ end.
+
%% Test type tests on literal values. (From emulator test suites.)
literal_type_tests(Config) when is_list(Config) ->
case ?MODULE of
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index a0b415ceaa..20fadc4fdb 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -227,15 +227,6 @@ silly_coverage(Config) when is_list(Config) ->
{label,2}|non_proper_list]}],99},
expect_error(fun() -> beam_block:module(BlockInput, []) end),
- %% beam_except
- ExceptInput = {?MODULE,[{foo,0}],[],
- [{function,foo,0,2,
- [{label,1},
- {line,loc},
- {func_info,{atom,?MODULE},{atom,foo},0},
- {label,2}|non_proper_list]}],99},
- expect_error(fun() -> beam_except:module(ExceptInput, []) end),
-
%% beam_jump
JumpInput = BlockInput,
expect_error(fun() -> beam_jump:module(JumpInput, []) end),
@@ -283,14 +274,34 @@ silly_coverage(Config) when is_list(Config) ->
bad_ssa_lint_input() ->
{b_module,#{},t,
- [{foobar,1},{module_info,0},{module_info,1}],
+ [{a,1},{b,1},{c,1},{module_info,0},{module_info,1}],
[],
[{b_function,
- #{func_info => {t,foobar,1},location => {"t.erl",4}},
+ #{func_info => {t,a,1},location => {"t.erl",4}},
[{b_var,0}],
#{0 => {b_blk,#{},[],{b_ret,#{},{b_var,'@undefined_var'}}}},
3},
{b_function,
+ #{func_info => {t,b,1},location => {"t.erl",5}},
+ [{b_var,0}],
+ #{0 =>
+ {b_blk,#{},
+ [{b_set,#{},{b_var,'@first_var'},first_op,[]},
+ {b_set,#{},{b_var,'@second_var'},second_op,[]},
+ {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]}],
+ {b_ret,#{},{b_var,'@ret'}}}},
+ 3},
+ {b_function,
+ #{func_info => {t,c,1},location => {"t.erl",6}},
+ [{b_var,0}],
+ #{0 =>
+ {b_blk,#{},
+ [{b_set,#{},{b_var,'@first_var'},first_op,[]},
+ {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]},
+ {b_set,#{},{b_var,'@second_var'},second_op,[]}],
+ {b_ret,#{},{b_var,'@ret'}}}},
+ 3},
+ {b_function,
#{func_info => {t,module_info,0}},
[],
#{0 =>
diff --git a/lib/compiler/test/property_test/beam_types_prop.erl b/lib/compiler/test/property_test/beam_types_prop.erl
new file mode 100644
index 0000000000..8199d1bd5a
--- /dev/null
+++ b/lib/compiler/test/property_test/beam_types_prop.erl
@@ -0,0 +1,228 @@
+%%
+%% %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%
+%%
+
+-module(beam_types_prop).
+
+-compile([export_all, nowarn_export_all]).
+
+%% This module only supports proper, as we don't have an eqc license to test
+%% with.
+
+-proptest([proper]).
+
+-ifdef(PROPER).
+
+-include_lib("compiler/src/beam_types.hrl").
+
+-include_lib("proper/include/proper.hrl").
+-define(MOD_eqc,proper).
+
+%% The default repetitions of 100 is a bit too low to reliably cover all type
+%% combinations, so we crank it up a bit.
+-define(REPETITIONS, 1000).
+
+absorption() ->
+ numtests(?REPETITIONS, absorption_1()).
+
+absorption_1() ->
+ ?FORALL({TypeA, TypeB},
+ ?LET(TypeA, type(),
+ ?LET(TypeB, type(), {TypeA, TypeB})),
+ absorption_check(TypeA, TypeB)).
+
+absorption_check(A, B) ->
+ %% a ∨ (a ∧ b) = a,
+ A = join(A, meet(A, B)),
+
+ %% a ∧ (a ∨ b) = a.
+ A = meet(A, join(A, B)),
+
+ true.
+
+associativity() ->
+ numtests(?REPETITIONS, associativity_1()).
+
+associativity_1() ->
+ ?FORALL({TypeA, TypeB, TypeC},
+ ?LET(TypeA, type(),
+ ?LET(TypeB, type(),
+ ?LET(TypeC, type(), {TypeA, TypeB, TypeC}))),
+ associativity_check(TypeA, TypeB, TypeC)).
+
+associativity_check(A, B, C) ->
+ %% a ∨ (b ∨ c) = (a ∨ b) ∨ c,
+ LHS_Join = join(A, join(B, C)),
+ RHS_Join = join(join(A, B), C),
+ LHS_Join = RHS_Join,
+
+ %% a ∧ (b ∧ c) = (a ∧ b) ∧ c.
+ LHS_Meet = meet(A, meet(B, C)),
+ RHS_Meet = meet(meet(A, B), C),
+ LHS_Meet = RHS_Meet,
+
+ true.
+
+commutativity() ->
+ numtests(?REPETITIONS, commutativity_1()).
+
+commutativity_1() ->
+ ?FORALL({TypeA, TypeB},
+ ?LET(TypeA, type(),
+ ?LET(TypeB, type(), {TypeA, TypeB})),
+ commutativity_check(TypeA, TypeB)).
+
+commutativity_check(A, B) ->
+ %% a ∨ b = b ∨ a,
+ true = join(A, B) =:= join(B, A),
+
+ %% a ∧ b = b ∧ a.
+ true = meet(A, B) =:= meet(B, A),
+
+ true.
+
+idempotence() ->
+ numtests(?REPETITIONS, idempotence_1()).
+
+idempotence_1() ->
+ ?FORALL(Type, type(), idempotence_check(Type)).
+
+idempotence_check(Type) ->
+ %% a ∨ a = a,
+ Type = join(Type, Type),
+
+ %% a ∧ a = a.
+ Type = meet(Type, Type),
+
+ true.
+
+identity() ->
+ ?FORALL(Type, type(), identity_check(Type)).
+
+identity_check(Type) ->
+ %% a ∨ [bottom element] = a,
+ Type = join(Type, none),
+
+ %% a ∧ [top element] = a.
+ Type = meet(Type, any),
+
+ true.
+
+meet(A, B) -> beam_types:meet(A, B).
+join(A, B) -> beam_types:join(A, B).
+
+%%%
+%%% Generators
+%%%
+
+type() ->
+ type(0).
+
+type(Depth) ->
+ oneof(nested_types(Depth) ++
+ numerical_types() ++
+ list_types() ++
+ other_types()).
+
+other_types() ->
+ [any,
+ gen_atom(),
+ gen_binary(),
+ none].
+
+list_types() ->
+ [cons, list, nil].
+
+numerical_types() ->
+ [gen_integer(), float, number].
+
+nested_types(Depth) when Depth >= 3 -> [none];
+nested_types(Depth) -> [#t_map{}, gen_union(Depth + 1), gen_tuple(Depth + 1)].
+
+gen_atom() ->
+ ?LET(Size, range(0, ?ATOM_SET_SIZE),
+ case Size of
+ 0 ->
+ #t_atom{};
+ _ ->
+ ?LET(Set, sized_list(Size, gen_atom_val()),
+ begin
+ #t_atom{elements=ordsets:from_list(Set)}
+ end)
+ end).
+
+gen_atom_val() ->
+ ?LET(N, range($0, $~), list_to_atom([N])).
+
+gen_binary() ->
+ ?SHRINK(#t_bitstring{unit=range(1, 128)}, [#t_bitstring{unit=1}]).
+
+gen_integer() ->
+ oneof([gen_integer_bounded(), #t_integer{}]).
+
+gen_integer_bounded() ->
+ ?LET({A, B}, {integer(), integer()},
+ begin
+ #t_integer{elements={min(A,B), max(A,B)}}
+ end).
+
+gen_tuple(Depth) ->
+ ?SIZED(Size,
+ ?LET({Exact, Elements}, {boolean(), gen_tuple_elements(Size, Depth)},
+ begin
+ #t_tuple{exact=Exact,
+ size=Size,
+ elements=Elements}
+ end)).
+
+gen_union(Depth) ->
+ ?LAZY(oneof([gen_wide_union(Depth), gen_tuple_union(Depth)])).
+
+gen_wide_union(Depth) ->
+ ?LET({A, B, C, D}, {oneof(nested_types(Depth)),
+ oneof(numerical_types()),
+ oneof(list_types()),
+ oneof(other_types())},
+ begin
+ T0 = join(A, B),
+ T1 = join(T0, C),
+ join(T1, D)
+ end).
+
+gen_tuple_union(Depth) ->
+ ?SIZED(Size,
+ ?LET(Tuples, sized_list(Size, gen_tuple(Depth)),
+ lists:foldl(fun join/2, none, Tuples))).
+
+gen_tuple_elements(Size, Depth) ->
+ ?LET(Types, sized_list(rand:uniform(Size div 4 + 1), gen_element(Depth)),
+ maps:from_list([{rand:uniform(Size), T} || T <- Types])).
+
+gen_element(Depth) ->
+ ?LAZY(?SUCHTHAT(Type, type(Depth),
+ case Type of
+ any -> false;
+ none -> false;
+ _ -> true
+ end)).
+
+sized_list(0, _Gen) -> [];
+sized_list(N, Gen) -> [Gen | sized_list(N - 1, Gen)].
+
+-endif.
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 34410e4b2a..4b68e663cd 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -79,9 +79,11 @@ opt_opts(Mod) ->
(no_put_tuple2) -> true;
(no_recv_opt) -> true;
(no_share_opt) -> true;
+ (no_shared_fun_wrappers) -> true;
(no_ssa_float) -> true;
(no_ssa_opt) -> true;
(no_stack_trimming) -> true;
+ (no_swap) -> true;
(no_type_opt) -> true;
(_) -> false
end, Opts).
diff --git a/lib/crypto/Makefile b/lib/crypto/Makefile
index afe56aa7d6..e5812bee15 100644
--- a/lib/crypto/Makefile
+++ b/lib/crypto/Makefile
@@ -38,3 +38,4 @@ SPECIAL_TARGETS =
include $(ERL_TOP)/make/otp_subdir.mk
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c
index bbeb329fa2..fc983ec03b 100644
--- a/lib/crypto/c_src/atoms.c
+++ b/lib/crypto/c_src/atoms.c
@@ -89,6 +89,8 @@ ERL_NIF_TERM atom_ecdsa;
#ifdef HAVE_ED_CURVE_DH
ERL_NIF_TERM atom_x25519;
ERL_NIF_TERM atom_x448;
+ERL_NIF_TERM atom_ed25519;
+ERL_NIF_TERM atom_ed448;
#endif
ERL_NIF_TERM atom_eddsa;
@@ -219,6 +221,8 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM
#ifdef HAVE_ED_CURVE_DH
atom_x25519 = enif_make_atom(env,"x25519");
atom_x448 = enif_make_atom(env,"x448");
+ atom_ed25519 = enif_make_atom(env,"ed25519");
+ atom_ed448 = enif_make_atom(env,"ed448");
#endif
atom_eddsa = enif_make_atom(env,"eddsa");
#ifdef HAVE_EDDSA
diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h
index 0e2f1a0022..956aab93eb 100644
--- a/lib/crypto/c_src/atoms.h
+++ b/lib/crypto/c_src/atoms.h
@@ -93,6 +93,8 @@ extern ERL_NIF_TERM atom_ecdsa;
#ifdef HAVE_ED_CURVE_DH
extern ERL_NIF_TERM atom_x25519;
extern ERL_NIF_TERM atom_x448;
+extern ERL_NIF_TERM atom_ed25519;
+extern ERL_NIF_TERM atom_ed448;
#endif
extern ERL_NIF_TERM atom_eddsa;
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 802818541b..2ea7b7c329 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -95,7 +95,7 @@ static ErlNifFunc nif_funcs[] = {
{"dh_generate_key_nif", 4, dh_generate_key_nif, 0},
{"dh_compute_key_nif", 3, dh_compute_key_nif, 0},
{"evp_compute_key_nif", 3, evp_compute_key_nif, 0},
- {"evp_generate_key_nif", 1, evp_generate_key_nif, 0},
+ {"evp_generate_key_nif", 2, evp_generate_key_nif, 0},
{"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif, 0},
{"srp_value_B_nif", 5, srp_value_B_nif, 0},
{"srp_user_secret_nif", 7, srp_user_secret_nif, 0},
diff --git a/lib/crypto/c_src/evp.c b/lib/crypto/c_src/evp.c
index 3bf66bfffe..fb6495a640 100644
--- a/lib/crypto/c_src/evp.c
+++ b/lib/crypto/c_src/evp.c
@@ -106,25 +106,34 @@ ERL_NIF_TERM evp_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
EVP_PKEY_CTX *ctx = NULL;
EVP_PKEY *pkey = NULL;
ERL_NIF_TERM ret_pub, ret_prv, ret;
+ ErlNifBinary prv_key;
size_t key_len;
unsigned char *out_pub = NULL, *out_priv = NULL;
- ASSERT(argc == 1);
-
if (argv[0] == atom_x25519)
type = EVP_PKEY_X25519;
else if (argv[0] == atom_x448)
type = EVP_PKEY_X448;
+ else if (argv[0] == atom_ed25519)
+ type = EVP_PKEY_ED25519;
+ else if (argv[0] == atom_ed448)
+ type = EVP_PKEY_ED448;
else
goto bad_arg;
- if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL)
- goto bad_arg;
-
- if (EVP_PKEY_keygen_init(ctx) != 1)
- goto err;
- if (EVP_PKEY_keygen(ctx, &pkey) != 1)
- goto err;
+ if (argv[1] == atom_undefined) {
+ if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL)
+ goto bad_arg;
+ if (EVP_PKEY_keygen_init(ctx) != 1)
+ goto err;
+ if (EVP_PKEY_keygen(ctx, &pkey) != 1)
+ goto err;
+ } else {
+ if (!enif_inspect_binary(env, argv[1], &prv_key))
+ goto bad_arg;
+ if ((pkey = EVP_PKEY_new_raw_private_key(type, NULL, prv_key.data, prv_key.size)) == NULL)
+ goto bad_arg;
+ }
if (EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len) != 1)
goto err;
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 965697578d..1c32895dbf 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -1761,21 +1761,21 @@ pkey_crypt_nif(_Algorithm, _In, _Key, _Options, _IsPrivate, _IsEncrypt) -> ?nif_
-spec generate_key(Type, Params)
-> {PublicKey, PrivKeyOut}
- when Type :: dh | ecdh | rsa | srp,
+ when Type :: dh | ecdh | eddsa | rsa | srp,
PublicKey :: dh_public() | ecdh_public() | rsa_public() | srp_public(),
PrivKeyOut :: dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()},
- Params :: dh_params() | ecdh_params() | rsa_params() | srp_gen_params()
+ Params :: dh_params() | ecdh_params() | eddsa_params() | rsa_params() | srp_gen_params()
.
generate_key(Type, Params) ->
generate_key(Type, Params, undefined).
-spec generate_key(Type, Params, PrivKeyIn)
-> {PublicKey, PrivKeyOut}
- when Type :: dh | ecdh | rsa | srp,
+ when Type :: dh | ecdh | eddsa | rsa | srp,
PublicKey :: dh_public() | ecdh_public() | rsa_public() | srp_public(),
PrivKeyIn :: undefined | dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()},
PrivKeyOut :: dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()},
- Params :: dh_params() | ecdh_params() | rsa_params() | srp_comp_params()
+ Params :: dh_params() | ecdh_params() | eddsa_params() | rsa_params() | srp_comp_params()
.
generate_key(dh, DHParameters0, PrivateKey) ->
@@ -1813,15 +1813,17 @@ generate_key(rsa, {ModulusSize, PublicExponent}, undefined) ->
{lists:sublist(Private, 2), Private}
end;
-
-generate_key(ecdh, Curve, undefined) when Curve == x448 ;
- Curve == x25519 ->
- evp_generate_key_nif(Curve);
+generate_key(ecdh, Curve, PrivKey) when Curve == x448 ;
+ Curve == x25519 ->
+ evp_generate_key_nif(Curve, ensure_int_as_bin(PrivKey));
generate_key(ecdh, Curve, PrivKey) ->
- ec_key_generate(nif_curve_params(Curve), ensure_int_as_bin(PrivKey)).
+ ec_key_generate(nif_curve_params(Curve), ensure_int_as_bin(PrivKey));
+generate_key(eddsa, Curve, PrivKey) when Curve == ed448 ;
+ Curve == ed25519 ->
+ evp_generate_key_nif(Curve, ensure_int_as_bin(PrivKey)).
-evp_generate_key_nif(_Curve) -> ?nif_stub.
+evp_generate_key_nif(_Curve, _PrivKey) -> ?nif_stub.
-spec compute_key(Type, OthersPublicKey, MyPrivateKey, Params)
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 0da70d5592..614d14029b 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -202,11 +202,13 @@ groups() ->
{ecdsa, [], [sign_verify
%% Does not work yet: ,public_encrypt, private_encrypt
]},
- {ed25519, [], [sign_verify
+ {ed25519, [], [sign_verify,
%% Does not work yet: ,public_encrypt, private_encrypt
+ generate
]},
- {ed448, [], [sign_verify
+ {ed448, [], [sign_verify,
%% Does not work yet: ,public_encrypt, private_encrypt
+ generate
]},
{dh, [], [generate_compute, compute_bug]},
{ecdh, [], [use_all_elliptic_curves, compute, generate]},
@@ -1429,7 +1431,7 @@ do_compute({ecdh = Type, Pub, Priv, Curve, SharedSecret}) ->
ct:fail({{crypto, compute_key, [Type, Pub, Priv, Curve]}, {expected, SharedSecret}, {got, Other}})
end.
-do_generate({ecdh = Type, Curve, Priv, Pub}) ->
+do_generate({Type, Curve, Priv, Pub}) when Type == ecdh ; Type == eddsa ->
case crypto:generate_key(Type, Curve, Priv) of
{Pub, _} ->
ok;
@@ -1854,7 +1856,10 @@ group_config(ecdsa = Type, Config) ->
[{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config];
group_config(Type, Config) when Type == ed25519 ; Type == ed448 ->
TestVectors = eddsa(Type),
- [{sign_verify,TestVectors} | Config];
+ Generate = lists:map(fun({Curve, _Hash, Priv, Pub, _Msg, _Signature}) ->
+ {eddsa, Curve, Priv, Pub}
+ end, TestVectors),
+ [{sign_verify,TestVectors}, {generate, Generate} | Config];
group_config(srp, Config) ->
GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()],
[{generate_compute, GenerateCompute} | Config];
@@ -3351,7 +3356,7 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv
eddsa(ed25519) ->
%% https://tools.ietf.org/html/rfc8032#section-7.1
- %% {ALGORITHM, (SHA)}, SECRET KEY, PUBLIC KEY, MESSAGE, SIGNATURE}
+ %% {ALGORITHM, (SHA), SECRET KEY, PUBLIC KEY, MESSAGE, SIGNATURE}
[
%% TEST 1
{ed25519, undefined,
@@ -3917,12 +3922,31 @@ ecc() ->
"782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")},
{ecdh,secp192r1,4,
hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA",
- "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}],
+ "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")},
+ %% RFC 7748, 6.2
+ {ecdh, x448,
+ hexstr2bin("9a8f4925d1519f5775cf46b04b5800d4ee9ee8bae8bc5565d498c28d"
+ "d9c9baf574a9419744897391006382a6f127ab1d9ac2d8c0a598726b"),
+ hexstr2bin("9b08f7cc31b7e3e67d22d5aea121074a273bd2b83de09c63faa73d2c"
+ "22c5d9bbc836647241d953d40c5b12da88120d53177f80e532c41fa0")},
+ {ecdh, x448,
+ hexstr2bin("1c306a7ac2a0e2e0990b294470cba339e6453772b075811d8fad0d1d"
+ "6927c120bb5ee8972b0d3e21374c9c921b09d1b0366f10b65173992d"),
+ hexstr2bin("3eb7a829b0cd20f5bcfc0b599b6feccf6da4627107bdb0d4f345b430"
+ "27d8b972fc3e34fb4232a13ca706dcb57aec3dae07bdc1c67bf33609")},
+ %% RFC 7748, 6.1
+ {ecdh, x25519,
+ hexstr2bin("77076d0a7318a57d3c16c17251b26645df4c2f87ebc0992ab177fba51db92c2a"),
+ hexstr2bin("8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a")},
+ {ecdh, x25519,
+ hexstr2bin("5dab087e624a8a4b79e17f8b83800ee66f3bb1292618b6fd1c2f8b27ff88e0eb"),
+ hexstr2bin("de9edb7d7b7dc1b4d35b61c2ece435373f8343c85b78674dadfc7e146f882b4f")}],
lists:filter(fun ({_Type, Curve, _Priv, _Pub}) ->
lists:member(Curve, Curves)
end,
TestCases).
+
int_to_bin(X) when X < 0 -> int_to_bin_neg(X, []);
int_to_bin(X) -> int_to_bin_pos(X, []).
diff --git a/lib/debugger/Makefile b/lib/debugger/Makefile
index 8c8b617831..3a06d72c5d 100644
--- a/lib/debugger/Makefile
+++ b/lib/debugger/Makefile
@@ -34,3 +34,7 @@ SPECIAL_TARGETS =
# Default Subdir Targets
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+
+DIA_PLT_APPS=wx
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/dialyzer/Makefile b/lib/dialyzer/Makefile
index e4f681dcd9..53083f267d 100644
--- a/lib/dialyzer/Makefile
+++ b/lib/dialyzer/Makefile
@@ -42,3 +42,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=compiler syntax_tools hipe wx
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/diameter/Makefile b/lib/diameter/Makefile
index a0195a0988..a25baeb929 100644
--- a/lib/diameter/Makefile
+++ b/lib/diameter/Makefile
@@ -27,7 +27,6 @@ SPECIAL_TARGETS =
include $(ERL_TOP)/make/otp_subdir.mk
-info:
- @echo "APP_VSN = $(APP_VSN)"
+DIA_PLT_APPS=ssl runtime_tools syntax_tools
-.PHONY: info
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/edoc/Makefile b/lib/edoc/Makefile
index 70bf1f3d48..a8258015b1 100644
--- a/lib/edoc/Makefile
+++ b/lib/edoc/Makefile
@@ -69,7 +69,7 @@ SPECIAL_TARGETS =
include $(ERL_TOP)/make/otp_subdir.mk
-.PHONY: info version
+.PHONY: version
version:
@@ -92,9 +92,6 @@ edocs:
-pa $(XMERL_DIR)/ebin -run edoc_run application \
"'$(APPNAME)'" '"."' '$(DOC_OPTS)'
-info:
- @echo $(HTML_FILES)
-
app_release: tar
@@ -124,3 +121,7 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME))
+
+DIA_PLT_APPS=syntax_tools xmerl inets
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/eldap/Makefile b/lib/eldap/Makefile
index 28f995e068..30a8f778ab 100644
--- a/lib/eldap/Makefile
+++ b/lib/eldap/Makefile
@@ -38,3 +38,6 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=asn ssl
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml
index 790a2f4e26..4a8c2d1647 100644
--- a/lib/eldap/doc/src/eldap.xml
+++ b/lib/eldap/doc/src/eldap.xml
@@ -317,7 +317,7 @@
</type>
<desc>
<p> Modify the DN of an entry. <c>DeleteOldRDN</c> indicates
- whether the current RDN should be removed from the attribute list after the after operation.
+ whether the current RDN should be removed from the attribute list after the operation.
<c>NewSupDN</c> is the new parent that the RDN shall be moved to. If the old parent should
remain as parent, <c>NewSupDN</c> shall be "".</p>
<code>
diff --git a/lib/erl_docgen/Makefile b/lib/erl_docgen/Makefile
index 30ff2bf16e..7e9cc824ec 100644
--- a/lib/erl_docgen/Makefile
+++ b/lib/erl_docgen/Makefile
@@ -36,4 +36,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=edoc xmerl
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/erl_docgen/priv/bin/specs_gen.escript b/lib/erl_docgen/priv/bin/specs_gen.escript
index 859f3c21f5..116240530d 100644
--- a/lib/erl_docgen/priv/bin/specs_gen.escript
+++ b/lib/erl_docgen/priv/bin/specs_gen.escript
@@ -131,7 +131,7 @@ write_text(Text, File, Dir) ->
ok;
{error, R} ->
R1 = file:format_error(R),
- io:format("could not write file '~s': ~s\n", [File, R1]),
+ io:format("could not write file '~s': ~s\n", [OutFile, R1]),
halt(2)
end.
diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd
index 0ccd52068b..0feb09eac2 100644
--- a/lib/erl_docgen/priv/dtd/common.dtd
+++ b/lib/erl_docgen/priv/dtd/common.dtd
@@ -67,7 +67,7 @@
<!ELEMENT list (item+) >
<!ATTLIST list type (ordered|bulleted) "bulleted" >
-<!ELEMENT taglist (tag,item+)+ >
+<!ELEMENT taglist (marker*,tag,item+)+ >
<!ELEMENT tag (#PCDATA|c|i|em|br|seealso|url|marker|anno)* >
<!ELEMENT item (%inline;|%block;|warning|note|dont|do|quote)* >
diff --git a/lib/erl_interface/Makefile b/lib/erl_interface/Makefile
index 9471b0df18..633e705b3f 100644
--- a/lib/erl_interface/Makefile
+++ b/lib/erl_interface/Makefile
@@ -31,3 +31,5 @@ SPECIAL_TARGETS =
# Default Subdir Targets
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h
index b138118f04..7d39043bb2 100644
--- a/lib/erl_interface/include/ei.h
+++ b/lib/erl_interface/include/ei.h
@@ -323,13 +323,24 @@ typedef struct {
#define EI_SCLBK_FLG_FULL_IMPL (1 << 0)
+/*
+ * HACK: AIX defines many socket functions like accept to be naccept, which
+ * pollutes the global namespace. Set up an ugly ifdef for consumers of this
+ * API here so they get a mangled name for AIX and the sane name elsewhere.
+ */
+#ifdef _AIX
+#define EI_ACCEPT_NAME accept_ei
+#else
+#define EI_ACCEPT_NAME accept
+#endif
+
typedef struct {
int flags;
int (*socket)(void **ctx, void *setup_ctx);
int (*close)(void *ctx);
int (*listen)(void *ctx, void *addr, int *len, int backlog);
- int (*accept)(void **ctx, void *addr, int *len, unsigned tmo);
+ int (*EI_ACCEPT_NAME)(void **ctx, void *addr, int *len, unsigned tmo);
int (*connect)(void *ctx, void *addr, int len, unsigned tmo);
int (*writev)(void *ctx, const void *iov, int iovcnt, ssize_t *len, unsigned tmo);
int (*write)(void *ctx, const char *buf, ssize_t *len, unsigned tmo);
diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c
index 1b1479d2e9..f600758385 100644
--- a/lib/erl_interface/src/connect/ei_connect.c
+++ b/lib/erl_interface/src/connect/ei_connect.c
@@ -659,7 +659,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname,
return ERL_ERROR;
}
- ec->creation = creation & 0x3; /* 2 bits */
+ ec->creation = creation;
if (cookie) {
if (strlen(cookie) >= sizeof(ec->ei_connect_cookie)) {
@@ -698,7 +698,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname,
strcpy(ec->self.node,thisnodename);
ec->self.num = 0;
ec->self.serial = 0;
- ec->self.creation = creation & 0x3; /* 2 bits */
+ ec->self.creation = creation;
ec->cbs = cbs;
ec->setup_context = setup_context;
diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c
index 225fddc784..5a8ca0c567 100644
--- a/lib/erl_interface/src/connect/ei_resolve.c
+++ b/lib/erl_interface/src/connect/ei_resolve.c
@@ -55,6 +55,16 @@
#include "ei_resolve.h"
#include "ei_locking.h"
+/* AIX has a totally different signature (allegedly shared with some other
+ * Unices) that isn't compatible. It turns out that the _r version isn't
+ * thread-safe according to curl - but bizarrely, since AIX 4.3, libc
+ * is thread-safe in a manner that makes the normal gethostbyname OK
+ * for re-entrant use.
+ */
+#ifdef _AIX
+#undef HAVE_GETHOSTBYNAME_R
+#endif
+
#ifdef HAVE_GETHOSTBYNAME_R
int ei_init_resolve(void)
@@ -75,7 +85,7 @@ int ei_init_resolve(void)
static ei_mutex_t *ei_gethost_sem = NULL;
#endif /* _REENTRANT */
static int ei_resolve_initialized = 0;
-#ifndef __WIN32__
+#if !defined(__WIN32__) && !defined(_AIX)
int h_errno;
#endif
diff --git a/lib/erl_interface/src/encode/encode_pid.c b/lib/erl_interface/src/encode/encode_pid.c
index d14746b40f..0dfdb16372 100644
--- a/lib/erl_interface/src/encode/encode_pid.c
+++ b/lib/erl_interface/src/encode/encode_pid.c
@@ -25,7 +25,6 @@
int ei_encode_pid(char *buf, int *index, const erlang_pid *p)
{
char* s = buf + *index;
- const char tag = (p->creation > 3) ? ERL_NEW_PID_EXT : ERL_PID_EXT;
++(*index); /* skip ERL_PID_EXT */
if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node),
@@ -33,21 +32,17 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p)
return -1;
if (buf) {
- put8(s, tag);
+ put8(s, ERL_NEW_PID_EXT);
s = buf + *index;
/* now the integers */
put32be(s,p->num & 0x7fff); /* 15 bits */
put32be(s,p->serial & 0x1fff); /* 13 bits */
- if (tag == ERL_PID_EXT) {
- put8(s,(p->creation & 0x03)); /* 2 bits */
- } else {
- put32be(s, p->creation); /* 32 bits */
- }
+ put32be(s, p->creation); /* 32 bits */
}
- *index += 4 + 4 + (tag == ERL_PID_EXT ? 1 : 4);
+ *index += 4 + 4 + 4;
return 0;
}
diff --git a/lib/erl_interface/src/encode/encode_port.c b/lib/erl_interface/src/encode/encode_port.c
index eb464380c0..0fb4018db1 100644
--- a/lib/erl_interface/src/encode/encode_port.c
+++ b/lib/erl_interface/src/encode/encode_port.c
@@ -25,7 +25,6 @@
int ei_encode_port(char *buf, int *index, const erlang_port *p)
{
char *s = buf + *index;
- const char tag = p->creation > 3 ? ERL_NEW_PORT_EXT : ERL_PORT_EXT;
++(*index); /* skip ERL_PORT_EXT */
if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8,
@@ -33,19 +32,15 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p)
return -1;
}
if (buf) {
- put8(s, tag);
+ put8(s, ERL_NEW_PORT_EXT);
s = buf + *index;
/* now the integers */
put32be(s,p->id & 0x0fffffff /* 28 bits */);
- if (tag == ERL_PORT_EXT) {
- put8(s,(p->creation & 0x03));
- } else {
- put32be(s, p->creation);
- }
+ put32be(s, p->creation);
}
- *index += 4 + (tag == ERL_PORT_EXT ? 1 : 4);
+ *index += 4 + 4;
return 0;
}
diff --git a/lib/erl_interface/src/encode/encode_ref.c b/lib/erl_interface/src/encode/encode_ref.c
index 5ccfc32c6d..8c2e0a25f7 100644
--- a/lib/erl_interface/src/encode/encode_ref.c
+++ b/lib/erl_interface/src/encode/encode_ref.c
@@ -24,7 +24,6 @@
int ei_encode_ref(char *buf, int *index, const erlang_ref *p)
{
- const char tag = (p->creation > 3) ? ERL_NEWER_REFERENCE_EXT : ERL_NEW_REFERENCE_EXT;
char *s = buf + *index;
int i;
@@ -37,7 +36,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p)
/* Always encode as an extended reference; all participating parties
are now expected to be able to decode extended references. */
if (buf) {
- put8(s, tag);
+ put8(s, ERL_NEWER_REFERENCE_EXT);
/* first, number of integers */
put16be(s, p->len);
@@ -46,15 +45,12 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p)
s = buf + *index;
/* now the integers */
- if (tag == ERL_NEW_REFERENCE_EXT)
- put8(s,(p->creation & 0x03));
- else
- put32be(s, p->creation);
+ put32be(s, p->creation);
for (i = 0; i < p->len; i++)
put32be(s,p->n[i]);
}
- *index += p->len*4 + (tag == ERL_NEW_REFERENCE_EXT ? 1 : 4);
+ *index += p->len*4 + 4;
return 0;
}
diff --git a/lib/erl_interface/src/epmd/ei_epmd.h b/lib/erl_interface/src/epmd/ei_epmd.h
index ac153b6e66..597a955676 100644
--- a/lib/erl_interface/src/epmd/ei_epmd.h
+++ b/lib/erl_interface/src/epmd/ei_epmd.h
@@ -25,8 +25,8 @@
#endif
#ifndef EI_DIST_HIGH
-#define EI_DIST_HIGH 5 /* R4 and later */
-#define EI_DIST_LOW 1 /* R3 and earlier */
+#define EI_DIST_HIGH 6 /* OTP 23 and later */
+#define EI_DIST_LOW 5 /* OTP R4 - 22 */
#endif
#ifndef EPMD_PORT
@@ -45,6 +45,7 @@
#ifndef EI_EPMD_ALIVE2_REQ
#define EI_EPMD_ALIVE2_REQ 120
#define EI_EPMD_ALIVE2_RESP 121
+#define EI_EPMD_ALIVE2_X_RESP 118
#define EI_EPMD_PORT2_REQ 122
#define EI_EPMD_PORT2_RESP 119
#define EI_EPMD_STOP_REQ 's'
diff --git a/lib/erl_interface/src/epmd/epmd_publish.c b/lib/erl_interface/src/epmd/epmd_publish.c
index 20b8e867e8..ef8a5d6b70 100644
--- a/lib/erl_interface/src/epmd/epmd_publish.c
+++ b/lib/erl_interface/src/epmd/epmd_publish.c
@@ -68,7 +68,8 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms)
int nlen = strlen(alive);
int len = elen + nlen + 13; /* hard coded: be careful! */
int n;
- int err, res, creation;
+ int err, response, res;
+ unsigned creation;
ssize_t dlen;
unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms;
@@ -124,8 +125,10 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms)
/* Don't close fd here! It keeps us registered with epmd */
s = buf;
- if (((res=get8(s)) != EI_EPMD_ALIVE2_RESP)) { /* response */
- EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",res);
+ response = get8(s);
+ if (response != EI_EPMD_ALIVE2_RESP &&
+ response != EI_EPMD_ALIVE2_X_RESP) {
+ EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",response);
EI_TRACE_ERR0("ei_epmd_r4_publish","-> CLOSE");
ei_close__(fd);
erl_errno = EIO;
@@ -141,18 +144,21 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms)
return -1;
}
- creation = get16be(s);
+ if (response == EI_EPMD_ALIVE2_RESP)
+ creation = get16be(s);
+ else /* EI_EPMD_ALIVE2_X_RESP */
+ creation = get32be(s);
EI_TRACE_CONN2("ei_epmd_r4_publish",
- " result=%d (ok) creation=%d",res,creation);
+ " result=%d (ok) creation=%u",res,creation);
- /* probably should save fd so we can close it later... */
- /* epmd_saveconn(OPEN,fd,alive); */
+ /*
+ * Would be nice to somehow use the nice "unique" creation value
+ * received here from epmd instead of using the crappy one
+ * passed (already) to ei_connect_init.
+ */
- /* return the creation number, for no good reason */
- /* return creation;*/
-
- /* no - return the descriptor */
+ /* return the descriptor */
return fd;
}
diff --git a/lib/erl_interface/src/misc/ei_portio.c b/lib/erl_interface/src/misc/ei_portio.c
index bccc86c1b1..bfe67a732c 100644
--- a/lib/erl_interface/src/misc/ei_portio.c
+++ b/lib/erl_interface/src/misc/ei_portio.c
@@ -622,7 +622,7 @@ int ei_accept_ctx_t__(ei_socket_callbacks *cbs, void **ctx,
} while (error == EINTR);
}
do {
- error = cbs->accept(ctx, addr, len, ms);
+ error = cbs->EI_ACCEPT_NAME(ctx, addr, len, ms);
} while (error == EINTR);
return error;
}
diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c
index ab91157035..dce2ecdec2 100644
--- a/lib/erl_interface/src/prog/erl_call.c
+++ b/lib/erl_interface/src/prog/erl_call.c
@@ -292,8 +292,7 @@ int erl_call(int argc, char **argv)
flags.cookie = NULL;
}
- /* FIXME decide how many bits etc or leave to connect_xinit? */
- creation = (time(NULL) % 3) + 1; /* "random" */
+ creation = time(NULL) + 1; /* "random" */
if (flags.hidden == NULL) {
/* As default we are c17@gethostname */
diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl
index 77910a9fc7..4605293c74 100644
--- a/lib/erl_interface/test/erl_eterm_SUITE.erl
+++ b/lib/erl_interface/test/erl_eterm_SUITE.erl
@@ -73,6 +73,10 @@
-import(runner, [get_term/1]).
+-define(REFERENCE_EXT, $e).
+-define(NEW_REFERENCE_EXT, $r).
+-define(NEWER_REFERENCE_EXT, $Z).
+
%% This test suite controls the running of the C language functions
%% in eterm_test.c and print_term.c.
@@ -1026,9 +1030,11 @@ cnode_1(Config) when is_list(Config) ->
check_ref(Ref) ->
case bin_ext_type(Ref) of
- 101 ->
+ ?REFERENCE_EXT ->
ct:fail(oldref);
- 114 ->
+ ?NEW_REFERENCE_EXT ->
+ ok;
+ ?NEWER_REFERENCE_EXT ->
ok;
Type ->
ct:fail({type, Type})
diff --git a/lib/et/Makefile b/lib/et/Makefile
index f0bb7be211..1b89cff83e 100644
--- a/lib/et/Makefile
+++ b/lib/et/Makefile
@@ -35,3 +35,6 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=runtime_tools wx
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/eunit/Makefile b/lib/eunit/Makefile
index 15dae19896..d0dd447a6c 100644
--- a/lib/eunit/Makefile
+++ b/lib/eunit/Makefile
@@ -48,13 +48,7 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
-
-.PHONY: info version
-
-info:
- @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)"
- @echo "APP_DIR: $(APP_DIR)"
- @echo "APP_TAR_FILE: $(APP_TAR_FILE)"
+.PHONY: version
version:
@echo "$(VSN)"
@@ -94,3 +88,5 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME))
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/ftp/Makefile b/lib/ftp/Makefile
index e0c9de42e4..a26d1de0a0 100644
--- a/lib/ftp/Makefile
+++ b/lib/ftp/Makefile
@@ -32,47 +32,11 @@ VSN = $(FTP_VSN)
SPECIAL_TARGETS =
-DIA_PLT = ./priv/plt/$(APPLICATION).plt
-DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis
-
-
# ----------------------------------------------------
# Default Subdir Targets
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
-.PHONY: info gclean dialyzer dialyzer_plt dclean
-
-info:
- @echo "OS: $(OS)"
- @echo "DOCB: $(DOCB)"
- @echo ""
- @echo "FTP_VSN: $(FTP_VSN)"
- @echo "APP_VSN: $(APP_VSN)"
- @echo ""
- @echo "DIA_PLT: $(DIA_PLT)"
- @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)"
- @echo ""
-
-gclean:
- git clean -fXd
-
-dclean:
- rm -f $(DIA_PLT)
- rm -f $(DIA_ANALYSIS)
-
-dialyzer_plt: $(DIA_PLT)
-
-$(DIA_PLT):
- @echo "Building $(APPLICATION) plt file"
- @dialyzer --build_plt \
- --output_plt $@ \
- -r ../$(APPLICATION)/ebin \
- --output $(DIA_ANALYSIS) \
- --verbose
+DIA_PLT_APPS = runtime_tools ssl
-dialyzer: $(DIA_PLT)
- @echo "Running dialyzer on $(APPLICATION)"
- @dialyzer --plt $< \
- ../$(APPLICATION)/ebin \
- --verbose
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile
index 0676484fca..4998522943 100644
--- a/lib/hipe/Makefile
+++ b/lib/hipe/Makefile
@@ -75,3 +75,6 @@ distclean:
realclean:
$(V_at)$(MAKE) MAKETARGET="realclean" all-subdirs all-subdirs-x
+DIA_PLT_APPS=compiler syntax_tools
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 995c961e09..fce178a5e3 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -678,8 +678,8 @@ trans_fun([{call_fun,N}|Instructions], Env) ->
Dst = [mk_var({r,0})],
[hipe_icode:mk_comment('call_fun'),
hipe_icode:mk_primop(Dst,call_fun,Args) | trans_fun(Instructions,Env)];
-%%--- patched_make_fun --- make_fun/make_fun2 after fixes
-trans_fun([{patched_make_fun,MFA,Magic,FreeVarNum,Index}|Instructions], Env) ->
+%%--- make_fun2 ---
+trans_fun([{make_fun2,MFA,Index,Magic,FreeVarNum}|Instructions], Env) ->
Args = extract_fun_args(FreeVarNum),
Dst = [mk_var({r,0})],
Fun = hipe_icode:mk_primop(Dst,
@@ -1193,6 +1193,17 @@ trans_fun([{bs_get_position=Name,_,_,_}|_Instructions], _Env) ->
trans_fun([{bs_set_position=Name,_,_}|_Instructions], _Env) ->
nyi(Name);
%%--------------------------------------------------------------------
+%% New instructions added in OTP 23.
+%%--------------------------------------------------------------------
+%%--- swap ---
+trans_fun([{swap,Reg1,Reg2}|Instructions], Env) ->
+ Var1 = mk_var(Reg1),
+ Var2 = mk_var(Reg2),
+ Temp = mk_var(new),
+ [hipe_icode:mk_move(Temp, Var1),
+ hipe_icode:mk_move(Var1, Var2),
+ hipe_icode:mk_move(Var2, Temp) | trans_fun(Instructions, Env)];
+%%--------------------------------------------------------------------
%%--- ERROR HANDLING ---
%%--------------------------------------------------------------------
trans_fun([X|_], _) ->
@@ -1935,7 +1946,7 @@ mod_find_closure_info([FunCode|Fs], CI) ->
mod_find_closure_info([], CI) ->
CI.
-find_closure_info([{patched_make_fun,MFA={_M,_F,A},_Magic,FreeVarNum,_Index}|BeamCode],
+find_closure_info([{make_fun2,{_M,_F,A}=MFA,_Index,_Magic,FreeVarNum}|BeamCode],
ClosureInfo) ->
NewClosure = %% A-FreeVarNum+1 (The real arity + 1 for the closure)
#closure_info{mfa=MFA, arity=A-FreeVarNum+1, fv_arity=FreeVarNum},
@@ -2013,41 +2024,8 @@ split_params(N, [ArgN|OrgArgs], Args) ->
%%-----------------------------------------------------------------------
preprocess_code(ModuleCode) ->
- PatchedCode = patch_R7_funs(ModuleCode),
- ClosureInfo = find_closure_info(PatchedCode),
- {PatchedCode, ClosureInfo}.
-
-%%-----------------------------------------------------------------------
-%% Patches the "make_fun" BEAM instructions of R7 so that they also
-%% contain the index that the BEAM loader generates for funs.
-%%
-%% The index starts from 0 and is incremented by 1 for each make_fun
-%% instruction encountered.
-%%
-%% Retained only for compatibility with BEAM code prior to R8.
-%%
-%% Temporarily, it also rewrites R8-PRE-RELEASE "make_fun2"
-%% instructions, since their embedded indices don't work.
-%%-----------------------------------------------------------------------
-
-patch_R7_funs(ModuleCode) ->
- patch_make_funs(ModuleCode, 0).
-
-patch_make_funs([FunCode0|Fs], FunIndex0) ->
- {PatchedFunCode,FunIndex} = patch_make_funs(FunCode0, FunIndex0, []),
- [PatchedFunCode|patch_make_funs(Fs, FunIndex)];
-patch_make_funs([], _) -> [].
-
-patch_make_funs([{make_fun,MFA,Magic,FreeVarNum}|Is], FunIndex, Acc) ->
- Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex},
- patch_make_funs(Is, FunIndex+1, [Patched|Acc]);
-patch_make_funs([{make_fun2,MFA,_BogusIndex,Magic,FreeVarNum}|Is], FunIndex, Acc) ->
- Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex},
- patch_make_funs(Is, FunIndex+1, [Patched|Acc]);
-patch_make_funs([I|Is], FunIndex, Acc) ->
- patch_make_funs(Is, FunIndex, [I|Acc]);
-patch_make_funs([], FunIndex, Acc) ->
- {lists:reverse(Acc),FunIndex}.
+ ClosureInfo = find_closure_info(ModuleCode),
+ {ModuleCode, ClosureInfo}.
%%-----------------------------------------------------------------------
diff --git a/lib/inets/Makefile b/lib/inets/Makefile
index 872df9d055..a7723dc0d8 100644
--- a/lib/inets/Makefile
+++ b/lib/inets/Makefile
@@ -32,47 +32,11 @@ VSN = $(INETS_VSN)
SPECIAL_TARGETS =
-DIA_PLT = ./priv/plt/$(APPLICATION).plt
-DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis
-
-
# ----------------------------------------------------
# Default Subdir Targets
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
-.PHONY: info gclean dialyzer dialyzer_plt dclean
-
-info:
- @echo "OS: $(OS)"
- @echo "DOCB: $(DOCB)"
- @echo ""
- @echo "INETS_VSN: $(INETS_VSN)"
- @echo "APP_VSN: $(APP_VSN)"
- @echo ""
- @echo "DIA_PLT: $(DIA_PLT)"
- @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)"
- @echo ""
-
-gclean:
- git clean -fXd
-
-dclean:
- rm -f $(DIA_PLT)
- rm -f $(DIA_ANALYSIS)
-
-dialyzer_plt: $(DIA_PLT)
-
-$(DIA_PLT):
- @echo "Building $(APPLICATION) plt file"
- @dialyzer --build_plt \
- --output_plt $@ \
- -r ../$(APPLICATION)/ebin \
- --output $(DIA_ANALYSIS) \
- --verbose
+DIA_PLT_APPS=runtime_tools ftp mnesia ssl tftp
-dialyzer: $(DIA_PLT)
- @echo "Running dialyzer on $(APPLICATION)"
- @dialyzer --plt $< \
- ../$(APPLICATION)/ebin \
- --verbose
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/jinterface/Makefile b/lib/jinterface/Makefile
index 9cf5f3e94c..dd22d743a5 100644
--- a/lib/jinterface/Makefile
+++ b/lib/jinterface/Makefile
@@ -39,3 +39,4 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java
index 9cbd735751..3abdf9535f 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java
@@ -27,7 +27,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
// don't change this!
private static final long serialVersionUID = 1664394142301803659L;
- private final int tag;
private final String node;
private final int id;
private final int serial;
@@ -45,7 +44,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
public OtpErlangPid(final OtpLocalNode self) {
final OtpErlangPid p = self.createPid();
- tag = p.tag;
id = p.id;
serial = p.serial;
creation = p.creation;
@@ -67,7 +65,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
throws OtpErlangDecodeException {
final OtpErlangPid p = buf.read_pid();
- tag = p.tag;
node = p.node();
id = p.id();
serial = p.serial();
@@ -118,7 +115,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
*/
protected OtpErlangPid(final int tag, final String node, final int id,
final int serial, final int creation) {
- this.tag = tag;
this.node = node;
if (tag == OtpExternal.pidTag) {
this.id = id & 0x7fff; // 15 bits
@@ -133,7 +129,7 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object>
}
protected int tag() {
- return tag;
+ return OtpExternal.newPidTag;
}
/**
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java
index 79b5d2736c..c8648d7aa3 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java
@@ -26,7 +26,6 @@ public class OtpErlangPort extends OtpErlangObject {
// don't change this!
private static final long serialVersionUID = 4037115468007644704L;
- private final int tag;
private final String node;
private final int id;
private final int creation;
@@ -43,7 +42,6 @@ public class OtpErlangPort extends OtpErlangObject {
private OtpErlangPort(final OtpSelf self) {
final OtpErlangPort p = self.createPort();
- tag = p.tag;
id = p.id;
creation = p.creation;
node = p.node;
@@ -64,7 +62,6 @@ public class OtpErlangPort extends OtpErlangObject {
throws OtpErlangDecodeException {
final OtpErlangPort p = buf.read_port();
- tag = p.tag;
node = p.node();
id = p.id();
creation = p.creation();
@@ -105,7 +102,6 @@ public class OtpErlangPort extends OtpErlangObject {
*/
public OtpErlangPort(final int tag, final String node, final int id,
final int creation) {
- this.tag = tag;
this.node = node;
if (tag == OtpExternal.portTag) {
this.id = id & 0xfffffff; // 28 bits
@@ -118,7 +114,7 @@ public class OtpErlangPort extends OtpErlangObject {
}
protected int tag() {
- return tag;
+ return OtpExternal.newPortTag;
}
/**
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java
index 2165397013..2bf8d9a56b 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java
@@ -28,7 +28,6 @@ public class OtpErlangRef extends OtpErlangObject {
// don't change this!
private static final long serialVersionUID = -7022666480768586521L;
- private final int tag;
private final String node;
private final int creation;
@@ -49,7 +48,6 @@ public class OtpErlangRef extends OtpErlangObject {
public OtpErlangRef(final OtpLocalNode self) {
final OtpErlangRef r = self.createRef();
- tag = r.tag;
ids = r.ids;
creation = r.creation;
node = r.node;
@@ -70,7 +68,6 @@ public class OtpErlangRef extends OtpErlangObject {
throws OtpErlangDecodeException {
final OtpErlangRef r = buf.read_ref();
- tag = r.tag;
node = r.node();
creation = r.creation();
@@ -90,7 +87,6 @@ public class OtpErlangRef extends OtpErlangObject {
* another arbitrary number.
*/
public OtpErlangRef(final String node, final int id, final int creation) {
- this.tag = OtpExternal.newRefTag;
this.node = node;
ids = new int[1];
ids[0] = id & 0x3ffff; // 18 bits
@@ -138,7 +134,6 @@ public class OtpErlangRef extends OtpErlangObject {
*/
public OtpErlangRef(final int tag, final String node, final int[] ids,
final int creation) {
- this.tag = tag;
this.node = node;
// use at most 3 words
@@ -162,7 +157,7 @@ public class OtpErlangRef extends OtpErlangObject {
}
protected int tag() {
- return tag;
+ return OtpExternal.newerRefTag;
}
/**
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java
index 5e777c1164..917e5baf3a 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java
@@ -713,7 +713,7 @@ public class OtpOutputStream extends ByteArrayOutputStream {
*/
public void write_pid(final String node, final int id, final int serial,
final int creation) {
- write1(OtpExternal.pidTag);
+ write1(OtpExternal.newPidTag);
write_atom(node);
write4BE(id & 0x7fff); // 15 bits
write4BE(serial & 0x1fff); // 13 bits
@@ -727,20 +727,11 @@ public class OtpOutputStream extends ByteArrayOutputStream {
* the pid
*/
public void write_pid(OtpErlangPid pid) {
- write1(pid.tag());
+ write1(OtpExternal.newPidTag);
write_atom(pid.node());
write4BE(pid.id());
write4BE(pid.serial());
- switch (pid.tag()) {
- case OtpExternal.pidTag:
- write1(pid.creation());
- break;
- case OtpExternal.newPidTag:
- write4BE(pid.creation());
- break;
- default:
- throw new AssertionError("Invalid pid tag " + pid.tag());
- }
+ write4BE(pid.creation());
}
@@ -758,7 +749,7 @@ public class OtpOutputStream extends ByteArrayOutputStream {
* be used.
*/
public void write_port(final String node, final int id, final int creation) {
- write1(OtpExternal.portTag);
+ write1(OtpExternal.newPortTag);
write_atom(node);
write4BE(id & 0xfffffff); // 28 bits
write1(creation & 0x3); // 2 bits
@@ -771,19 +762,10 @@ public class OtpOutputStream extends ByteArrayOutputStream {
* the port.
*/
public void write_port(OtpErlangPort port) {
- write1(port.tag());
+ write1(OtpExternal.newPortTag);
write_atom(port.node());
write4BE(port.id());
- switch (port.tag()) {
- case OtpExternal.portTag:
- write1(port.creation());
- break;
- case OtpExternal.newPortTag:
- write4BE(port.creation());
- break;
- default:
- throw new AssertionError("Invalid port tag " + port.tag());
- }
+ write4BE(port.creation());
}
/**
@@ -829,7 +811,7 @@ public class OtpOutputStream extends ByteArrayOutputStream {
arity = 3; // max 3 words in ref
}
- write1(OtpExternal.newRefTag);
+ write1(OtpExternal.newerRefTag);
// how many id values
write2BE(arity);
@@ -857,24 +839,12 @@ public class OtpOutputStream extends ByteArrayOutputStream {
int[] ids = ref.ids();
int arity = ids.length;
- write1(ref.tag());
+ write1(OtpExternal.newerRefTag);
write2BE(arity);
write_atom(ref.node());
+ write4BE(ref.creation());
- switch (ref.tag()) {
- case OtpExternal.newRefTag:
- write1(ref.creation());
- write4BE(ids[0] & 0x3ffff); // first word gets truncated to 18 bits
- break;
- case OtpExternal.newerRefTag:
- write4BE(ref.creation());
- write4BE(ids[0]); // full first word
- break;
- default:
- throw new AssertionError("Invalid ref tag " + ref.tag());
- }
-
- for (int i = 1; i < arity; i++) {
+ for (int i = 0; i < arity; i++) {
write4BE(ids[i]);
}
}
diff --git a/lib/kernel/Makefile b/lib/kernel/Makefile
index b956f5eaf5..5ab8ac63b9 100644
--- a/lib/kernel/Makefile
+++ b/lib/kernel/Makefile
@@ -34,3 +34,5 @@ SPECIAL_TARGETS =
# Default Subdir Targets
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml
index fc25e83d40..2c09c84b25 100644
--- a/lib/kernel/doc/src/file.xml
+++ b/lib/kernel/doc/src/file.xml
@@ -939,6 +939,10 @@ f.txt: {person, "kalle", 25}.
support for POSIX <c>O_SYNC</c> or equivalent, use of the <c>sync</c>
flag causes <c>open</c> to return <c>{error, enotsup}</c>.</p>
</item>
+ <tag><c>directory</c></tag>
+ <item>
+ <p>Allows <c>open</c> to work on directories.</p>
+ </item>
</taglist>
<p>Returns:</p>
<taglist>
@@ -953,10 +957,9 @@ f.txt: {person, "kalle", 25}.
</item>
</taglist>
<p><c><anno>IoDevice</anno></c> is really the pid of the process that
- handles the file. This process is linked to the process
- that originally opened the file. If any process to which
- the <c><anno>IoDevice</anno></c> is linked terminates, the file is
- closed and the process itself is terminated.
+ handles the file. This process monitors the process that originally
+ opened the file (the owner process). If the owner process terminates,
+ the file is closed and the process itself terminates too.
An <c><anno>IoDevice</anno></c> returned from this call can be used
as an argument to the I/O functions (see
<seealso marker="stdlib:io"><c>io(3)</c></seealso>).</p>
@@ -985,8 +988,10 @@ f.txt: {person, "kalle", 25}.
</item>
<tag><c>enotdir</c></tag>
<item>
- <p>A component of the filename is not a directory. On some
- platforms, <c>enoent</c> is returned instead.</p>
+ <p>A component of the filename is not a directory, or the
+ filename itself is not a directory if <c>directory</c>
+ mode was specified. On some platforms, <c>enoent</c> is
+ returned instead.</p>
</item>
<tag><c>enospc</c></tag>
<item>
@@ -1438,7 +1443,11 @@ f.txt: {person, "kalle", 25}.
break this module's atomicity guarantees as it can race with a
concurrent call to
<seealso marker="#write_file_info/2"><c>write_file_info/1,2</c>
- </seealso></p>
+ </seealso>.</p>
+ <p>This option has no effect when the function is
+ given an I/O device instead of a file name. Use
+ <seealso marker="#open/2"><c>open/2</c></seealso> with the
+ <c>raw</c> mode to obtain a file descriptor first.</p>
<note>
<p>As file times are stored in POSIX time on most OS, it is faster to
query file information with option <c>posix</c>.</p>
diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml
index aa29223dd0..aa9067f082 100644
--- a/lib/kernel/doc/src/seq_trace.xml
+++ b/lib/kernel/doc/src/seq_trace.xml
@@ -107,6 +107,12 @@ seq_trace:set_token(OldToken), % activate the trace token again
enables/disables tracing on message sending. Default is
<c>false</c>.</p>
</item>
+ <tag><c>set_token('spawn', <anno>Bool</anno>)</c></tag>
+ <item>
+ <p>A trace token flag (<c>true | false</c>) which
+ enables/disables tracing on process spawning. Default is
+ <c>false</c>.</p>
+ </item>
<tag><c>set_token('receive', <anno>Bool</anno>)</c></tag>
<item>
<p>A trace token flag (<c>true | false</c>) which
@@ -257,7 +263,12 @@ TimeStamp = {Seconds, Milliseconds, Microseconds}
<tag><c>{send, Serial, From, To, Message}</c></tag>
<item>
<p>Used when a process <c>From</c> with its trace token flag
- <c>print</c> set to <c>true</c> has sent a message.</p>
+ <c>send</c> set to <c>true</c> has sent a message.</p>
+ </item>
+ <tag><c>{spawn, Serial, Parent, Child, _}</c></tag>
+ <item>
+ <p>Used when a process <c>Parent</c> with its trace token flag
+ <c>spawn</c> set to <c>true</c> has spawned a process.</p>
</item>
<tag><c>{'receive', Serial, From, To, Message}</c></tag>
<item>
@@ -295,8 +306,8 @@ TimeStamp = {Seconds, Milliseconds, Microseconds}
is initiated by a single message. In short, it works as follows:</p>
<p>Each process has a <em>trace token</em>, which can be empty or
not empty. When not empty, the trace token can be seen as
- the tuple <c>{Label, Flags, Serial, From}</c>. The trace token is
- passed invisibly with each message.</p>
+ the tuple <c>{Label, Flags, Serial, From}</c>. The trace token is passed
+ invisibly to spawned processes and with each message sent.</p>
<p>To start a sequential trace, the user must explicitly set
the trace token in the process that will send the first message
in a sequence.</p>
@@ -306,9 +317,10 @@ TimeStamp = {Seconds, Milliseconds, Microseconds}
<p>On each Erlang node, a process can be set as the <em>system tracer</em>.
This process will receive trace messages each time
a message with a trace token is sent or received (if the trace
- token flag <c>send</c> or <c>'receive'</c> is set). The system
- tracer can then print each trace event, write it to a file, or
- whatever suitable.</p>
+ token flag <c>send</c> or <c>'receive'</c> is set), and when a process
+ with a non-empty trace token spawns another (if the trace token flag
+ <c>spawn</c> is set). The system tracer can then print each trace event,
+ write it to a file, or whatever suitable.</p>
<note>
<p>The system tracer only receives those trace events that
occur locally within the Erlang node. To get the whole picture
@@ -322,10 +334,9 @@ TimeStamp = {Seconds, Milliseconds, Microseconds}
<section>
<title>Trace Token</title>
- <p>Each process has a current trace token. Initially, the token is
- empty. When the process sends a message to another process, a
- copy of the current token is sent "invisibly" along with
- the message.</p>
+ <p>Each process has a current trace token, which is copied from the process
+ that spawned it. When a process sends a message to another process, a
+ copy of the current token is sent "invisibly" along with the message.</p>
<p>The current token of a process is set in one of the following two
ways:</p>
<list type="bulleted">
@@ -354,8 +365,9 @@ TimeStamp = {Seconds, Milliseconds, Microseconds}
<p>The algorithm for updating <c>Serial</c> can be described as
follows:</p>
<p>Let each process have two counters, <c>prev_cnt</c> and
- <c>curr_cnt</c>, both are set to <c>0</c> when a process is created.
- The counters are updated at the following occasions:</p>
+ <c>curr_cnt</c>, both are set to <c>0</c> when a process is created
+ outside of a trace sequence. The counters are updated at the following
+ occasions:</p>
<list type="bulleted">
<item>
<p><em>When the process is about to send a message and the trace token
@@ -370,6 +382,16 @@ tcurr := curr_cnt</pre>
passed along with the message.</p>
</item>
<item>
+ <p><em>When the process is about to spawn another process and the trace
+ token is not empty.</em></p>
+ <p>The counters of the parent process are updated in the same way as
+ for send above. The trace token is then passed to the child process,
+ whose counters will be set as follows:</p>
+ <code>
+curr_cnt := tcurr
+prev_cnt := tcurr</code>
+ </item>
+ <item>
<p><em>When the process calls</em> <c>seq_trace:print(Label, Info)</c>,
<c>Label</c> <em>matches the label part of the trace token and the
trace token print flag is <c>true</c>.</em></p>
@@ -487,9 +509,9 @@ tracer() ->
print_trace(Label,TraceInfo,false);
{seq_trace,Label,TraceInfo,Ts} ->
print_trace(Label,TraceInfo,Ts);
- Other -> ignore
+ _Other -> ignore
end,
- tracer().
+ tracer().
print_trace(Label,TraceInfo,false) ->
io:format("~p:",[Label]),
@@ -504,8 +526,11 @@ print_trace({'receive',Serial,From,To,Message}) ->
io:format("~p Received ~p FROM ~p WITH~n~p~n",
[To,Serial,From,Message]);
print_trace({send,Serial,From,To,Message}) ->
- io:format("~p Sent ~p TO ~p WITH~n~p~n",
- [From,Serial,To,Message]).</code>
+ io:format("~p Sent ~p TO ~p WITH~n~p~n",
+ [From,Serial,To,Message]);
+print_trace({spawn,Serial,Parent,Child,_}) ->
+ io:format("~p Spawned ~p AT ~p~n",
+ [Parent,Child,Serial]).</code>
<p>The code that creates a process that runs this tracer function
and sets that process as the system tracer can look like this:</p>
<code type="none">
diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl
index 7a14e2635c..f31a1722ce 100644
--- a/lib/kernel/src/erl_epmd.erl
+++ b/lib/kernel/src/erl_epmd.erl
@@ -33,10 +33,10 @@
-define(erlang_daemon_port, 4369).
-endif.
-ifndef(epmd_dist_high).
--define(epmd_dist_high, 4370).
+-define(epmd_dist_high, 6).
-endif.
-ifndef(epmd_dist_low).
--define(epmd_dist_low, 4370).
+-define(epmd_dist_low, 5).
-endif.
%% External exports
@@ -342,6 +342,13 @@ wait_for_reg_reply(Socket, SoFar) ->
receive
{tcp, Socket, Data0} ->
case SoFar ++ Data0 of
+ [$v, Result, A, B, C, D] ->
+ case Result of
+ 0 ->
+ {alive, Socket, ?u32(A, B, C, D)};
+ _ ->
+ {error, duplicate_name}
+ end;
[$y, Result, A, B] ->
case Result of
0 ->
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index e6a30d0b92..7b9067d079 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -40,6 +40,15 @@
lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2,
alloc_blocks_size/1]).
+%% Reroutes calls to the given MFA to error_handler:breakpoint/3
+%%
+%% Note that this is potentially unsafe as compiled code may assume that the
+%% targeted function returns a specific type, triggering undefined behavior if
+%% this function were to return something else.
+%%
+%% For reference, the debugger avoids the issue by purging the affected module
+%% and interpreting all functions in the module, ensuring that no assumptions
+%% are made with regard to return or argument types.
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
Function :: atom(),
@@ -92,7 +101,7 @@ copy_shared(_) ->
-spec get_internal_state(W) -> term() when
W :: reds_left | node_and_dist_references | monitoring_nodes
- | next_pid | 'DbTable_words' | check_io_debug
+ | next_pid | 'DbTable_words' | check_io_debug | lc_graph
| process_info_args | processes | processes_bif_info
| max_atom_out_cache_index | nbalance | available_internal_state
| force_heap_frags | memory
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
index 1d4e37196c..2ad2df97a8 100644
--- a/lib/kernel/src/file.erl
+++ b/lib/kernel/src/file.erl
@@ -239,20 +239,30 @@ make_dir(Name) ->
del_dir(Name) ->
check_and_call(del_dir, [file_name(Name)]).
--spec read_file_info(Filename) -> {ok, FileInfo} | {error, Reason} when
- Filename :: name_all(),
+-spec read_file_info(File) -> {ok, FileInfo} | {error, Reason} when
+ File :: name_all() | io_device(),
FileInfo :: file_info(),
Reason :: posix() | badarg.
+read_file_info(IoDevice)
+ when is_pid(IoDevice); is_record(IoDevice, file_descriptor) ->
+ read_file_info(IoDevice, []);
+
read_file_info(Name) ->
check_and_call(read_file_info, [file_name(Name)]).
--spec read_file_info(Filename, Opts) -> {ok, FileInfo} | {error, Reason} when
- Filename :: name_all(),
+-spec read_file_info(File, Opts) -> {ok, FileInfo} | {error, Reason} when
+ File :: name_all() | io_device(),
Opts :: [file_info_option()],
FileInfo :: file_info(),
Reason :: posix() | badarg.
+read_file_info(IoDevice, Opts) when is_pid(IoDevice), is_list(Opts) ->
+ file_request(IoDevice, {read_handle_info, Opts});
+
+read_file_info(#file_descriptor{module = Module} = Handle, Opts) when is_list(Opts) ->
+ Module:read_handle_info(Handle, Opts);
+
read_file_info(Name, Opts) when is_list(Opts) ->
Args = [file_name(Name), Opts],
case check_args(Args) of
@@ -460,7 +470,7 @@ raw_write_file_info(Name, #file_info{} = Info) ->
-spec open(File, Modes) -> {ok, IoDevice} | {error, Reason} when
File :: Filename | iodata(),
Filename :: name_all(),
- Modes :: [mode() | ram],
+ Modes :: [mode() | ram | directory],
IoDevice :: io_device(),
Reason :: posix() | badarg | system_limit.
@@ -1143,7 +1153,7 @@ path_script(Path, File, Bs) ->
{ok, IoDevice, FullName} | {error, Reason} when
Path :: [Dir :: name_all()],
Filename :: name_all(),
- Modes :: [mode()],
+ Modes :: [mode() | directory],
IoDevice :: io_device(),
FullName :: filename_all(),
Reason :: posix() | badarg | system_limit.
diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl
index 34d5497a4a..c03fbb548a 100644
--- a/lib/kernel/src/file_io_server.erl
+++ b/lib/kernel/src/file_io_server.erl
@@ -314,6 +314,14 @@ file_request(truncate,
Reply ->
std_reply(Reply, State)
end;
+file_request({read_handle_info, Opts},
+ #state{handle=Handle}=State) ->
+ case ?CALL_FD(Handle, read_handle_info, [Opts]) of
+ {error,Reason}=Reply ->
+ {stop,Reason,Reply,State};
+ Reply ->
+ {reply,Reply,State}
+ end;
file_request(Unknown,
#state{}=State) ->
Reason = {request, Unknown},
diff --git a/lib/kernel/src/raw_file_io_compressed.erl b/lib/kernel/src/raw_file_io_compressed.erl
index d5ab042d25..66c5621dd1 100644
--- a/lib/kernel/src/raw_file_io_compressed.erl
+++ b/lib/kernel/src/raw_file_io_compressed.erl
@@ -21,7 +21,8 @@
-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3,
position/2, write/2, pwrite/2, pwrite/3,
- read_line/1, read/2, pread/2, pread/3]).
+ read_line/1, read/2, pread/2, pread/3,
+ read_handle_info/2]).
%% OTP internal.
-export([ipread_s32bu_p32bu/3, sendfile/8]).
@@ -118,6 +119,9 @@ ipread_s32bu_p32bu(Fd, Offset, MaxSize) ->
sendfile(_,_,_,_,_,_,_,_) ->
{error, enotsup}.
+read_handle_info(Fd, Opts) ->
+ wrap_call(Fd, [Opts]).
+
wrap_call(Fd, Command) ->
{_Owner, Pid} = get_fd_data(Fd),
try gen_statem:call(Pid, Command, infinity) of
diff --git a/lib/kernel/src/raw_file_io_delayed.erl b/lib/kernel/src/raw_file_io_delayed.erl
index d2ad7550a1..766467437e 100644
--- a/lib/kernel/src/raw_file_io_delayed.erl
+++ b/lib/kernel/src/raw_file_io_delayed.erl
@@ -23,7 +23,8 @@
-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3,
position/2, write/2, pwrite/2, pwrite/3,
- read_line/1, read/2, pread/2, pread/3]).
+ read_line/1, read/2, pread/2, pread/3,
+ read_handle_info/2]).
%% OTP internal.
-export([ipread_s32bu_p32bu/3, sendfile/8]).
@@ -304,6 +305,9 @@ ipread_s32bu_p32bu(Fd, Offset, MaxSize) ->
sendfile(_,_,_,_,_,_,_,_) ->
{error, enotsup}.
+read_handle_info(Fd, Opts) ->
+ wrap_call(Fd, [Opts]).
+
wrap_call(Fd, Command) ->
#{ pid := Pid } = get_fd_data(Fd),
try gen_statem:call(Pid, Command, infinity) of
diff --git a/lib/kernel/src/raw_file_io_list.erl b/lib/kernel/src/raw_file_io_list.erl
index 2e16e63f0e..e4fe434e13 100644
--- a/lib/kernel/src/raw_file_io_list.erl
+++ b/lib/kernel/src/raw_file_io_list.erl
@@ -21,7 +21,8 @@
-export([close/1, sync/1, datasync/1, truncate/1, advise/4, allocate/3,
position/2, write/2, pwrite/2, pwrite/3,
- read_line/1, read/2, pread/2, pread/3]).
+ read_line/1, read/2, pread/2, pread/3,
+ read_handle_info/2]).
%% OTP internal.
-export([ipread_s32bu_p32bu/3, sendfile/8]).
@@ -126,3 +127,7 @@ sendfile(Fd, Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags) ->
Args = [Dest, Offset, Bytes, ChunkSize, Headers, Trailers, Flags],
PrivateFd = Fd#file_descriptor.data,
?CALL_FD(PrivateFd, sendfile, Args).
+
+read_handle_info(Fd, Opts) ->
+ PrivateFd = Fd#file_descriptor.data,
+ ?CALL_FD(PrivateFd, read_handle_info, [Opts]).
diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl
index f0bd1fabe9..bc023007bf 100644
--- a/lib/kernel/src/seq_trace.erl
+++ b/lib/kernel/src/seq_trace.erl
@@ -20,12 +20,14 @@
-module(seq_trace).
--define(SEQ_TRACE_SEND, 1). %(1 << 0)
--define(SEQ_TRACE_RECEIVE, 2). %(1 << 1)
--define(SEQ_TRACE_PRINT, 4). %(1 << 2)
--define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3)
--define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4)
--define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5)
+%% Don't forget to update seq_trace_SUITE after changing these.
+-define(SEQ_TRACE_SEND, 1). %(1 << 0)
+-define(SEQ_TRACE_RECEIVE, 2). %(1 << 1)
+-define(SEQ_TRACE_PRINT, 4). %(1 << 2)
+-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3)
+-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4)
+-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5)
+-define(SEQ_TRACE_SPAWN, 64). %(1 << 6)
-export([set_token/1,
set_token/2,
@@ -39,7 +41,8 @@
%%---------------------------------------------------------------------------
--type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'.
+-type flag() :: 'send' | 'spawn' | 'receive' | 'print' | 'timestamp' |
+ 'monotonic_timestamp' | 'strict_monotonic_timestamp'.
-type component() :: 'label' | 'serial' | flag().
-type value() :: (Label :: term())
| {Previous :: non_neg_integer(),
@@ -142,10 +145,11 @@ set_token2([]) ->
decode_flags(Flags) ->
Print = (Flags band ?SEQ_TRACE_PRINT) > 0,
Send = (Flags band ?SEQ_TRACE_SEND) > 0,
+ Spawn = (Flags band ?SEQ_TRACE_SPAWN) > 0,
Rec = (Flags band ?SEQ_TRACE_RECEIVE) > 0,
NowTs = (Flags band ?SEQ_TRACE_NOW_TIMESTAMP) > 0,
StrictMonTs = (Flags band ?SEQ_TRACE_STRICT_MON_TIMESTAMP) > 0,
MonTs = (Flags band ?SEQ_TRACE_MON_TIMESTAMP) > 0,
- [{print,Print},{send,Send},{'receive',Rec},{timestamp,NowTs},
+ [{print,Print},{send,Send},{spawn,Spawn},{'receive',Rec},{timestamp,NowTs},
{strict_monotonic_timestamp, StrictMonTs},
{monotonic_timestamp, MonTs}].
diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl
index 8256444bdc..bb42a0ac39 100644
--- a/lib/kernel/test/erl_distribution_wb_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl
@@ -47,6 +47,9 @@
R
end).
+-define(EPMD_DIST_HIGH, 6).
+-define(EPMD_DIST_LOW, 5).
+
-define(DFLAG_PUBLISHED,1).
-define(DFLAG_ATOM_CACHE,2).
-define(DFLAG_EXTENDED_REFERENCES,4).
@@ -57,15 +60,18 @@
-define(DFLAG_NEW_FUN_TAGS,16#80).
-define(DFLAG_EXTENDED_PIDS_PORTS,16#100).
-define(DFLAG_UTF8_ATOMS, 16#10000).
+-define(DFLAG_BIG_CREATION, 16#40000).
%% From R9 and forward extended references is compulsory
%% From R10 and forward extended pids and ports are compulsory
%% From R20 and forward UTF8 atoms are compulsory
%% From R21 and forward NEW_FUN_TAGS is compulsory (no more tuple fallback {fun, ...})
+%% From R23 and forward BIG_CREATION is compulsory
-define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor
?DFLAG_EXTENDED_PIDS_PORTS bor
?DFLAG_UTF8_ATOMS bor
- ?DFLAG_NEW_FUN_TAGS)).
+ ?DFLAG_NEW_FUN_TAGS bor
+ ?DFLAG_BIG_CREATION)).
-define(PASS_THROUGH, $p).
@@ -208,9 +214,9 @@ pending_up_md5(Node,OurName,Cookie) ->
{ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo,
[{active,false},
{packet,2}]),
- send_name(SocketA,OurName,5),
+ send_name(SocketA,OurName, ?EPMD_DIST_HIGH),
ok = recv_status(SocketA),
- {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1)
+ {hidden,Node,?EPMD_DIST_HIGH,HisChallengeA} = recv_challenge(SocketA), % See 1)
OurChallengeA = gen_challenge(),
OurDigestA = gen_digest(HisChallengeA, Cookie),
send_challenge_reply(SocketA, OurChallengeA, OurDigestA),
@@ -224,11 +230,11 @@ pending_up_md5(Node,OurName,Cookie) ->
{ok, SocketB} = gen_tcp:connect(atom_to_list(NB),PortNo,
[{active,false},
{packet,2}]),
- send_name(SocketB,OurName,5),
+ send_name(SocketB,OurName, ?EPMD_DIST_HIGH),
alive = recv_status(SocketB),
send_status(SocketB, true),
gen_tcp:close(SocketA),
- {hidden,Node,5,HisChallengeB} = recv_challenge(SocketB), % See 1)
+ {hidden,Node,?EPMD_DIST_HIGH,HisChallengeB} = recv_challenge(SocketB), % See 1)
OurChallengeB = gen_challenge(),
OurDigestB = gen_digest(HisChallengeB, Cookie),
send_challenge_reply(SocketB, OurChallengeB, OurDigestB),
@@ -254,7 +260,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node ->
Else ->
exit(Else)
end,
- EpmdSocket = register(OurName, LSocket, 1, 5),
+ EpmdSocket = register_node(OurName, LSocket, ?EPMD_DIST_LOW, ?EPMD_DIST_HIGH),
{NA, NB} = split(Node),
rpc:cast(Node, net_adm, ping, [OurName]),
receive after 1000 -> ok end,
@@ -262,7 +268,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node ->
{ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo,
[{active,false},
{packet,2}]),
- send_name(SocketA,OurName,5),
+ send_name(SocketA,OurName, ?EPMD_DIST_HIGH),
%% We are still not marked up on the other side, as our first message
%% is not sent.
SocketB = case gen_tcp:accept(LSocket) of
@@ -275,11 +281,11 @@ simultaneous_md5(Node, OurName, Cookie) when OurName < Node ->
%% Now we are expected to close A
gen_tcp:close(SocketA),
%% But still Socket B will continue
- {normal,Node,5} = recv_name(SocketB), % See 1)
+ {normal,Node,?EPMD_DIST_HIGH} = recv_name(SocketB), % See 1)
send_status(SocketB, ok_simultaneous),
MyChallengeB = gen_challenge(),
- send_challenge(SocketB, OurName, MyChallengeB,5),
- HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie),
+ send_challenge(SocketB, OurName, MyChallengeB, ?EPMD_DIST_HIGH),
+ {ok,HisChallengeB} = recv_challenge_reply(SocketB, MyChallengeB, Cookie),
DigestB = gen_digest(HisChallengeB,Cookie),
send_challenge_ack(SocketB, DigestB),
inet:setopts(SocketB, [{active, false},
@@ -301,7 +307,8 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node ->
Else ->
exit(Else)
end,
- EpmdSocket = register(OurName, LSocket, 1, 5),
+ EpmdSocket = register_node(OurName, LSocket,
+ ?EPMD_DIST_LOW, ?EPMD_DIST_HIGH),
{NA, NB} = split(Node),
rpc:cast(Node, net_adm, ping, [OurName]),
receive after 1000 -> ok end,
@@ -315,16 +322,16 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node ->
Else2 ->
exit(Else2)
end,
- send_name(SocketA,OurName,5),
+ send_name(SocketA,OurName, ?EPMD_DIST_HIGH),
ok_simultaneous = recv_status(SocketA),
%% Socket B should die during this
case catch begin
- {normal,Node,5} = recv_name(SocketB), % See 1)
+ {normal,Node,?EPMD_DIST_HIGH} = recv_name(SocketB), % See 1)
send_status(SocketB, ok_simultaneous),
MyChallengeB = gen_challenge(),
send_challenge(SocketB, OurName, MyChallengeB,
5),
- HisChallengeB = recv_challenge_reply(
+ {ok,HisChallengeB} = recv_challenge_reply(
SocketB,
MyChallengeB,
Cookie),
@@ -346,7 +353,7 @@ simultaneous_md5(Node, OurName, Cookie) when OurName > Node ->
end,
gen_tcp:close(SocketB),
%% But still Socket A will continue
- {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1)
+ {hidden,Node,?EPMD_DIST_HIGH,HisChallengeA} = recv_challenge(SocketA), % See 1)
OurChallengeA = gen_challenge(),
OurDigestA = gen_digest(HisChallengeA, Cookie),
send_challenge_reply(SocketA, OurChallengeA, OurDigestA),
@@ -372,7 +379,7 @@ missing_compulsory_dflags(Config) when is_list(Config) ->
[{active,false},
{packet,2}]),
BadNode = list_to_atom(atom_to_list(Name2)++"@"++atom_to_list(NB)),
- send_name(SocketA,BadNode,5,0),
+ send_name(SocketA,BadNode, ?EPMD_DIST_HIGH, 0),
not_allowed = recv_status(SocketA),
gen_tcp:close(SocketA),
stop_node(Node),
@@ -516,16 +523,16 @@ send_challenge_reply(Socket, Challenge, Digest) ->
recv_challenge_reply(Socket, ChallengeA, Cookie) ->
case gen_tcp:recv(Socket, 0) of
- {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) == 16 ->
+ {ok,[$r,CB3,CB2,CB1,CB0 | SumB]=Data} when length(SumB) == 16 ->
SumA = gen_digest(ChallengeA, Cookie),
ChallengeB = ?u32(CB3,CB2,CB1,CB0),
if SumB == SumA ->
- ChallengeB;
+ {ok,ChallengeB};
true ->
- ?shutdown(bad_challenge_reply)
+ {error,Data}
end;
- _ ->
- ?shutdown(no_node)
+ Err ->
+ {error,Err}
end.
send_challenge_ack(Socket, Digest) ->
@@ -620,6 +627,13 @@ wait_for_reg_reply(Socket, SoFar) ->
receive
{tcp, Socket, Data0} ->
case SoFar ++ Data0 of
+ [$v, Result, A, B, C, D] ->
+ case Result of
+ 0 ->
+ {alive, Socket, ?u32(A, B, C, D)};
+ _ ->
+ {error, duplicate_name}
+ end;
[$y, Result, A, B] ->
case Result of
0 ->
@@ -640,7 +654,7 @@ wait_for_reg_reply(Socket, SoFar) ->
end.
-register(NodeName, ListenSocket, VLow, VHigh) ->
+register_node(NodeName, ListenSocket, VLow, VHigh) ->
{ok,{_,TcpPort}} = inet:sockname(ListenSocket),
case do_register_node(NodeName, TcpPort, VLow, VHigh) of
{alive, Socket, _Creation} ->
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index 3bc8e6e828..9efe83d8b3 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -58,6 +58,8 @@
-export([ file_info_basic_file/1, file_info_basic_directory/1,
file_info_bad/1, file_info_times/1, file_write_file_info/1,
file_wfi_helpers/1]).
+-export([ file_handle_info_basic_file/1, file_handle_info_basic_directory/1,
+ file_handle_info_times/1]).
-export([rename/1, access/1, truncate/1, datasync/1, sync/1,
read_write/1, pread_write/1, append/1, exclusive/1]).
-export([ e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
@@ -153,7 +155,10 @@ groups() ->
{pos, [], [pos1, pos2, pos3]},
{file_info, [],
[file_info_basic_file, file_info_basic_directory,
- file_info_bad, file_info_times, file_write_file_info,
+ file_info_bad, file_info_times,
+ file_handle_info_basic_file, file_handle_info_basic_directory,
+ file_handle_info_times,
+ file_write_file_info,
file_wfi_helpers]},
{consult, [], [consult1, path_consult]},
{eval, [], [eval1, path_eval]},
@@ -987,6 +992,14 @@ new_modes(Config) when is_list(Config) ->
ok
end,
+ % open directory
+ {ok, Fd9} = ?FILE_MODULE:open(NewDir, [directory]),
+ ok = ?FILE_MODULE:close(Fd9),
+
+ % open raw directory
+ {ok, Fd10} = ?FILE_MODULE:open(NewDir, [raw, directory]),
+ ok = ?FILE_MODULE:close(Fd10),
+
[] = flush(),
ok.
@@ -1236,6 +1249,9 @@ open_errors(Config) when is_list(Config) ->
{error, E4} = ?FILE_MODULE:open(DataDirSlash, [write]),
{eisdir,eisdir,eisdir,eisdir} = {E1,E2,E3,E4},
+ Real = filename:join(DataDir, "realmen.html"),
+ {error, enotdir} = ?FILE_MODULE:open(Real, [directory]),
+
[] = flush(),
ok.
@@ -1406,7 +1422,8 @@ file_info_basic_directory(Config) when is_list(Config) ->
{win32, _} ->
test_directory("/", read_write),
test_directory("c:/", read_write),
- test_directory("c:\\", read_write);
+ test_directory("c:\\", read_write),
+ test_directory("\\\\localhost\\c$", read_write);
_ ->
test_directory("/", read)
end,
@@ -1538,6 +1555,180 @@ filter_atime(Atime, Config) ->
Atime
end.
+%% Test read_file_info on I/O devices.
+
+file_handle_info_basic_file(Config) when is_list(Config) ->
+ RootDir = proplists:get_value(priv_dir, Config),
+
+ %% Create a short file.
+ Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_basic_test.fil"),
+ {ok,Fd1} = ?FILE_MODULE:open(Name, write),
+ io:put_chars(Fd1, "foo bar"),
+ ok = ?FILE_MODULE:close(Fd1),
+
+ %% Test that the file has the expected attributes.
+ %% The times are tricky, so we will save them to a separate test case.
+
+ {ok, Fd} = ?FILE_MODULE:open(Name, read),
+ {ok,FileInfo} = ?FILE_MODULE:read_file_info(Fd),
+ ok = ?FILE_MODULE:close(Fd),
+
+ {ok, FdRaw} = ?FILE_MODULE:open(Name, [read, raw]),
+ {ok,FileInfoRaw} = ?FILE_MODULE:read_file_info(FdRaw),
+ ok = ?FILE_MODULE:close(FdRaw),
+
+ #file_info{size=Size,type=Type,access=Access,
+ atime=AccessTime,mtime=ModifyTime} = FileInfo = FileInfoRaw,
+ io:format("Access ~p, Modify ~p", [AccessTime, ModifyTime]),
+ Size = 7,
+ Type = regular,
+ read_write = Access,
+ true = abs(time_dist(filter_atime(AccessTime, Config),
+ filter_atime(ModifyTime,
+ Config))) < 5,
+ all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)),
+
+ [] = flush(),
+ ok.
+
+file_handle_info_basic_directory(Config) when is_list(Config) ->
+ %% Note: filename:join/1 removes any trailing slash,
+ %% which is essential for ?FILE_MODULE:file_info/1 to work on
+ %% platforms such as Windows95.
+ RootDir = filename:join([proplists:get_value(priv_dir, Config)]),
+
+ %% Test that the RootDir directory has the expected attributes.
+ test_directory_handle(RootDir, read_write),
+
+ %% Note that on Windows file systems,
+ %% "/" or "c:/" are *NOT* directories.
+ %% Therefore, test that ?FILE_MODULE:file_info/1 behaves as if they were
+ %% directories.
+ case os:type() of
+ {win32, _} ->
+ test_directory_handle("/", read_write),
+ test_directory_handle("c:/", read_write),
+ test_directory_handle("c:\\", read_write),
+ test_directory_handle("\\\\localhost\\c$", read_write);
+ _ ->
+ test_directory_handle("/", read)
+ end,
+ ok.
+
+test_directory_handle(Name, ExpectedAccess) ->
+ {ok, DirFd} = file:open(Name, [read, directory]),
+ try
+ {ok,FileInfo} = ?FILE_MODULE:read_file_info(DirFd),
+ {ok,FileInfo} = ?FILE_MODULE:read_file_info(DirFd, [raw]),
+ #file_info{size=Size,type=Type,access=Access,
+ atime=AccessTime,mtime=ModifyTime} = FileInfo,
+ io:format("Testing directory ~s", [Name]),
+ io:format("Directory size is ~p", [Size]),
+ io:format("Access ~p", [Access]),
+ io:format("Access time ~p; Modify time~p",
+ [AccessTime, ModifyTime]),
+ Type = directory,
+ Access = ExpectedAccess,
+ all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)),
+ [] = flush(),
+ ok
+ after
+ file:close(DirFd)
+ end.
+
+%% Test that the file times behave as they should.
+
+file_handle_info_times(Config) when is_list(Config) ->
+ %% We have to try this twice, since if the test runs across the change
+ %% of a month the time diff calculations will fail. But it won't happen
+ %% if you run it twice in succession.
+ test_server:m_out_of_n(
+ 1,2,
+ fun() -> file_handle_info_int(Config) end),
+ ok.
+
+file_handle_info_int(Config) ->
+ %% Note: filename:join/1 removes any trailing slash,
+ %% which is essential for ?FILE_MODULE:file_info/1 to work on
+ %% platforms such as Windows95.
+
+ RootDir = filename:join([proplists:get_value(priv_dir, Config)]),
+ io:format("RootDir = ~p", [RootDir]),
+
+ Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_file_info.fil"),
+ {ok,Fd1} = ?FILE_MODULE:open(Name, write),
+ io:put_chars(Fd1,"foo"),
+ {ok,FileInfo1} = ?FILE_MODULE:read_file_info(Fd1),
+ ok = ?FILE_MODULE:close(Fd1),
+
+ {ok,Fd1Raw} = ?FILE_MODULE:open(Name, [read, raw]),
+ {ok,FileInfo1Raw} = ?FILE_MODULE:read_file_info(Fd1Raw),
+ ok = ?FILE_MODULE:close(Fd1Raw),
+
+ %% We assert that everything but the size is the same, on some OSs the
+ %% size may not have been flushed to disc and we do not want to do a
+ %% sync to force it.
+ FileInfo1Raw = FileInfo1#file_info{ size = FileInfo1Raw#file_info.size },
+
+ #file_info{type=regular,atime=AccTime1,mtime=ModTime1} = FileInfo1,
+
+ Now = erlang:localtime(), %???
+ io:format("Now ~p",[Now]),
+ io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]),
+ true = abs(time_dist(filter_atime(Now, Config),
+ filter_atime(AccTime1,
+ Config))) < 8,
+ true = abs(time_dist(Now,ModTime1)) < 8,
+
+ %% Sleep until we can be sure the seconds value has changed.
+ %% Note: FAT-based filesystem (like on Windows 95) have
+ %% a resolution of 2 seconds.
+ timer:sleep(2200),
+
+ %% close the file, and watch the modify date change
+
+ {ok,Fd2} = ?FILE_MODULE:open(Name, read),
+ {ok,FileInfo2} = ?FILE_MODULE:read_file_info(Fd2),
+ ok = ?FILE_MODULE:close(Fd2),
+
+ {ok,Fd2Raw} = ?FILE_MODULE:open(Name, [read, raw]),
+ {ok,FileInfo2Raw} = ?FILE_MODULE:read_file_info(Fd2Raw),
+ ok = ?FILE_MODULE:close(Fd2Raw),
+
+ #file_info{size=Size,type=regular,access=Access,
+ atime=AccTime2,mtime=ModTime2} = FileInfo2 = FileInfo2Raw,
+ io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]),
+ true = time_dist(ModTime1,ModTime2) >= 0,
+
+ %% this file is supposed to be binary, so it'd better keep it's size
+ Size = 3,
+ Access = read_write,
+
+ %% Do some directory checking
+
+ {ok,Fd3} = ?FILE_MODULE:open(RootDir, [read, directory]),
+ {ok,FileInfo3} = ?FILE_MODULE:read_file_info(Fd3),
+ ok = ?FILE_MODULE:close(Fd3),
+
+ {ok,Fd3Raw} = ?FILE_MODULE:open(RootDir, [read, directory, raw]),
+ {ok,FileInfo3Raw} = ?FILE_MODULE:read_file_info(Fd3Raw),
+ ok = ?FILE_MODULE:close(Fd3Raw),
+
+ #file_info{size=DSize,type=directory,access=DAccess,
+ atime=AccTime3,mtime=ModTime3} = FileInfo3 = FileInfo3Raw,
+ %% this dir was modified only a few secs ago
+ io:format("Dir Acc ~p; Mod ~p; Now ~p", [AccTime3, ModTime3, Now]),
+ true = abs(time_dist(Now,ModTime3)) < 5,
+ DAccess = read_write,
+ io:format("Dir size is ~p",[DSize]),
+
+ [] = flush(),
+ ok.
+
%% Test the write_file_info/2 function.
file_write_file_info(Config) when is_list(Config) ->
diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl
index 1be016444f..00c9dc5ed5 100644
--- a/lib/kernel/test/gen_tcp_api_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_api_SUITE.erl
@@ -594,10 +594,13 @@ unused_ip() ->
io:format("we = ~p, unused_ip = ~p~n", [Hent, IP]),
IP.
-unused_ip(_, _, _, 255) -> error;
+unused_ip(255, 255, 255, 255) -> error;
+unused_ip(255, B, C, D) -> unused_ip(1, B + 1, C, D);
+unused_ip(A, 255, C, D) -> unused_ip(A, 1, C + 1, D);
+unused_ip(A, B, 255, D) -> unused_ip(A, B, 1, D + 1);
unused_ip(A, B, C, D) ->
case inet:gethostbyaddr({A, B, C, D}) of
- {ok, _} -> unused_ip(A, B, C, D+1);
+ {ok, _} -> unused_ip(A + 1, B, C, D);
{error, _} -> {ok, {A, B, C, D}}
end.
diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl
index 83a94ab087..adbcef955c 100644
--- a/lib/kernel/test/seq_trace_SUITE.erl
+++ b/lib/kernel/test/seq_trace_SUITE.erl
@@ -30,7 +30,7 @@
send/1, distributed_send/1, recv/1, distributed_recv/1,
trace_exit/1, distributed_exit/1, call/1, port/1,
match_set_seq_token/1, gc_seq_token/1, label_capability_mismatch/1,
- send_literal/1]).
+ send_literal/1,inherit_on_spawn/1,spawn_flag/1]).
%% internal exports
-export([simple_tracer/2, one_time_receiver/0, one_time_receiver/1,
@@ -53,7 +53,8 @@ all() ->
distributed_send, recv, distributed_recv, trace_exit,
old_heap_token,
distributed_exit, call, port, match_set_seq_token,
- gc_seq_token, label_capability_mismatch].
+ gc_seq_token, label_capability_mismatch,
+ inherit_on_spawn, spawn_flag].
groups() ->
[].
@@ -83,14 +84,29 @@ token_set_get(Config) when is_list(Config) ->
do_token_set_get(timestamp),
do_token_set_get(monotonic_timestamp),
do_token_set_get(strict_monotonic_timestamp).
-
+
+-define(SEQ_TRACE_SEND, 1). %(1 << 0)
+-define(SEQ_TRACE_RECEIVE, 2). %(1 << 1)
+-define(SEQ_TRACE_PRINT, 4). %(1 << 2)
+-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3)
+-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4)
+-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5)
+-define(SEQ_TRACE_SPAWN, 64). %(1 << 6)
+
do_token_set_get(TsType) ->
- io:format("Testing ~p~n", [TsType]),
+ BaseOpts = ?SEQ_TRACE_SEND bor
+ ?SEQ_TRACE_RECEIVE bor
+ ?SEQ_TRACE_PRINT bor
+ ?SEQ_TRACE_SPAWN,
Flags = case TsType of
- timestamp -> 15;
- strict_monotonic_timestamp -> 23;
- monotonic_timestamp -> 39
- end,
+ timestamp ->
+ BaseOpts bor ?SEQ_TRACE_NOW_TIMESTAMP;
+ strict_monotonic_timestamp ->
+ BaseOpts bor ?SEQ_TRACE_STRICT_MON_TIMESTAMP;
+ monotonic_timestamp ->
+ BaseOpts bor ?SEQ_TRACE_MON_TIMESTAMP
+ end,
+ ct:pal("Type ~p, flags = ~p~n", [TsType, Flags]),
Self = self(),
seq_trace:reset_trace(),
%% Test that initial seq_trace is disabled
@@ -102,6 +118,8 @@ do_token_set_get(TsType) ->
{print,true} = seq_trace:get_token(print),
false = seq_trace:set_token(send,true),
{send,true} = seq_trace:get_token(send),
+ false = seq_trace:set_token(spawn,true),
+ {spawn,true} = seq_trace:get_token(spawn),
false = seq_trace:set_token('receive',true),
{'receive',true} = seq_trace:get_token('receive'),
false = seq_trace:set_token(TsType,true),
@@ -466,8 +484,6 @@ call(Config) when is_list(Config) ->
1 =
erlang:trace(Self, true,
[call, set_on_spawn, {tracer, TrB(pid)}]),
- Label = 17,
- seq_trace:set_token(label, Label), % Token enters here!!
RefB = make_ref(),
Pid2B = spawn_link(
fun() ->
@@ -481,6 +497,12 @@ call(Config) when is_list(Config) ->
RefB = call_tracee_1(RefB),
Pid2B ! {self(), msg, RefB}
end),
+
+ %% The token is set *AFTER* spawning to make sure we're testing that the
+ %% token follows on send and not that it inherits on spawn.
+ Label = 17,
+ seq_trace:set_token(label, Label),
+
Pid1B ! {Self, msg, RefB},
%% The message is passed Self -> Pid1B -> Pid2B -> Self, and the
%% seq_trace token follows invisibly. Traced functions are
@@ -501,6 +523,62 @@ call(Config) when is_list(Config) ->
seq_trace:reset_trace(),
ok.
+%% The token should follow spawn, just like it follows messages.
+inherit_on_spawn(Config) when is_list(Config) ->
+ seq_trace:reset_trace(),
+ start_tracer(),
+
+ Ref = make_ref(),
+ seq_trace:set_token(label,Ref),
+ set_token_flags([send]),
+
+ Self = self(),
+ Other = spawn(fun() -> Self ! {gurka,Ref} end),
+
+ receive {gurka,Ref} -> ok end,
+ seq_trace:reset_trace(),
+
+ [{Ref,{send,_,Other,Self,{gurka,Ref}}, _Ts}] = stop_tracer(1),
+
+ ok.
+
+spawn_flag(Config) when is_list(Config) ->
+ seq_trace:reset_trace(),
+ start_tracer(),
+
+ Ref = make_ref(),
+ seq_trace:set_token(label,Ref),
+ set_token_flags([spawn]),
+
+ Self = self(),
+
+ {serial,{0,0}} = seq_trace:get_token(serial),
+
+ %% The serial number is bumped on spawning (just like message passing), so
+ %% our child should inherit a counter of 1.
+ ProcessA = spawn(fun() ->
+ {serial,{0,1}} = seq_trace:get_token(serial),
+ Self ! {a,Ref}
+ end),
+ receive {a,Ref} -> ok end,
+
+ {serial,{1,2}} = seq_trace:get_token(serial),
+
+ ProcessB = spawn(fun() ->
+ {serial,{2,3}} = seq_trace:get_token(serial),
+ Self ! {b,Ref}
+ end),
+ receive {b,Ref} -> ok end,
+
+ {serial,{3,4}} = seq_trace:get_token(serial),
+
+ seq_trace:reset_trace(),
+
+ [{Ref,{spawn,{0,1},Self,ProcessA,[]}, _Ts},
+ {Ref,{spawn,{2,3},Self,ProcessB,[]}, _Ts}] = stop_tracer(2),
+
+ ok.
+
%% Send trace messages to a port.
port(Config) when is_list(Config) ->
lists:foreach(fun (TsType) -> do_port(TsType, Config) end,
@@ -938,7 +1016,7 @@ stop_tracer(N) when is_integer(N) ->
receive
{tracerlog,Data} ->
Data
- after 1000 ->
+ after 5000 ->
{error,timeout}
end
end.
diff --git a/lib/megaco/Makefile b/lib/megaco/Makefile
index f385df6a5c..624c4b0619 100644
--- a/lib/megaco/Makefile
+++ b/lib/megaco/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2019. All Rights Reserved.
+# Copyright Ericsson AB 1999-2016. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -110,7 +110,7 @@ DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
-.PHONY: reconf conf dconf econf configure setup info version \
+.PHONY: reconf conf dconf econf configure setup info_megaco version \
app_install dialyzer
reconf:
@@ -136,16 +136,15 @@ configure: configure.in
setup:
(cd src && $(MAKE) $@)
-info:
+info_megaco:
@echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)"
@echo "APP_DIR: $(APP_DIR)"
@echo "APP_TAR_FILE: $(APP_TAR_FILE)"
@echo "OTP_INSTALL_DIR: $(OTP_INSTALL_DIR)"
@echo "APP_INSTALL_DIR: $(APP_INSTALL_DIR)"
@echo ""
- @echo "DIA_PLT: $(DIA_PLT)"
- @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)"
- @echo ""
+
+info: info_megaco
version:
@echo "$(VSN)"
@@ -204,25 +203,6 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd "$(APP_RELEASE_DIR)"; gtar zcf "$(subst $(space),\ ,$@)" $(DIR_NAME))
-dialyzer_plt: $(DIA_PLT)
-
-$(DIA_PLT): Makefile
- @echo "Building $(APPLICATION) plt file"
- @dialyzer --build_plt \
- --output_plt $@ \
- -r ../$(APPLICATION)/ebin \
- ../../lib/kernel/ebin \
- ../../lib/stdlib/ebin \
- ../../lib/runtime_tools/ebin \
- ../../lib/asn1/ebin \
- ../../lib/debugger/ebin \
- ../../lib/et/ebin \
- ../../erts/preloaded/ebin \
- --output $(DIA_ANALYSIS) \
- --verbose
-
-dialyzer: $(DIA_PLT)
- @echo "Running dialyzer on $(APPLICATION)"
- @dialyzer --plt $< \
- ../$(APPLICATION)/ebin \
- --verbose
+DIA_PLT_APPS=asn1 runtime_tools et debugger
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/mnesia/Makefile b/lib/mnesia/Makefile
index 810433c4d0..d0edd48af9 100644
--- a/lib/mnesia/Makefile
+++ b/lib/mnesia/Makefile
@@ -38,3 +38,4 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/observer/Makefile b/lib/observer/Makefile
index 8483922f76..ffd73051b9 100644
--- a/lib/observer/Makefile
+++ b/lib/observer/Makefile
@@ -36,4 +36,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=runtime_tools et wx
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl
index 33133dd78d..f8bb2e5eb0 100644
--- a/lib/observer/test/ttb_SUITE.erl
+++ b/lib/observer/test/ttb_SUITE.erl
@@ -658,11 +658,13 @@ seq_trace(Config) when is_list(Config) ->
?line ok = ttb:format(
[filename:join(Privdir,atom_to_list(Node)++"-seq_trace")]),
?line [{trace_ts,StartProc,call,{?MODULE,seq,[]},{_,_,_}},
- {seq_trace,0,{send,{0,1},StartProc,P1Proc,{Start,P2}}},
- {seq_trace,0,{send,{1,2},P1Proc,P2Proc,{P1,Start}}},
- {seq_trace,0,{send,{2,3},P2Proc,StartProc,{P2,P1}}},
+ {seq_trace,0,{send,{First, Seq0},StartProc,P1Proc,{Start,P2}}},
+ {seq_trace,0,{send,{Seq0, Seq1},P1Proc,P2Proc,{P1,Start}}},
+ {seq_trace,0,{send,{Seq1, Last},P2Proc,StartProc,{P2,P1}}},
end_of_trace] = flush(),
-
+ true = First < Seq0,
+ true = Seq0 < Seq1,
+ true = Seq1 < Last,
%% Additional test for metatrace
case StartProc of
{Start,_,_} -> ok;
diff --git a/lib/odbc/Makefile b/lib/odbc/Makefile
index f7816c25fc..ee39992a84 100644
--- a/lib/odbc/Makefile
+++ b/lib/odbc/Makefile
@@ -69,12 +69,6 @@ do_configure: configure
configure: configure.in
autoconf
-.PHONY: info
-
-info:
- @echo "ODBC_VSN: $(ODBC_VSN)"
-
-
# ----------------------------------------------------
# Application (source) release targets
# ----------------------------------------------------
@@ -114,3 +108,5 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME))
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/os_mon/Makefile b/lib/os_mon/Makefile
index 40ce94e0c7..f45065a79d 100644
--- a/lib/os_mon/Makefile
+++ b/lib/os_mon/Makefile
@@ -35,3 +35,4 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl
index ba28f31f26..7a8065c591 100644
--- a/lib/os_mon/test/cpu_sup_SUITE.erl
+++ b/lib/os_mon/test/cpu_sup_SUITE.erl
@@ -155,46 +155,72 @@ tiny_diff(A, B) ->
-define(SPIN_TIME, 1000).
+spinner(Parent) ->
+ receive
+ stop -> Parent ! stopped
+ after 0 -> spinner(Parent)
+ end.
+
%% Test utilization values
util_values(Config) when is_list(Config) ->
-
+ NrOfProcessors =
+ case erlang:system_info(logical_processors_available) of
+ unknown -> 2;
+ X -> X
+ end,
Tester = self(),
Ref = make_ref(),
- Loop = fun (L) -> L(L) end,
Spinner = fun () ->
- Looper = spawn_link(fun () -> Loop(Loop) end),
+ Spinner = self(),
+ NrOfProcesses = NrOfProcessors,
+ Loopers =
+ [spawn_link(fun () -> spinner(Spinner) end)
+ || _ <- lists:seq(1,NrOfProcesses)],
receive after ?SPIN_TIME -> ok end,
- unlink(Looper),
- exit(Looper, kill),
+ [begin
+ Looper ! stop,
+ receive stopped -> ok end
+ end
+ || Looper <- Loopers],
Tester ! Ref
end,
-
+ Spin = fun () ->
+ spawn_link(Spinner),
+ receive Ref -> ok end
+ end,
cpu_sup:util(),
-
- spawn_link(Spinner),
- receive Ref -> ok end,
- HighUtil1 = cpu_sup:util(),
-
receive after ?SPIN_TIME -> ok end,
- LowUtil1 = cpu_sup:util(),
+ LowUtil0 = cpu_sup:util(),
+ case LowUtil0 of
+ U when U > ((100.0 / NrOfProcessors) * 0.33) ->
+ %% We cannot run this test if the system is doing other
+ %% work at the same time as the result will be unreliable
+ {skip, io_lib:format("CPU utilization was too high (~f%)", [LowUtil0])};
+ _ ->
+ cpu_sup:util(),
+ Spin(),
+ HighUtil1 = cpu_sup:util(),
- spawn_link(Spinner),
- receive Ref -> ok end,
- HighUtil2 = cpu_sup:util(),
+ receive after ?SPIN_TIME -> ok end,
+ LowUtil1 = cpu_sup:util(),
- receive after ?SPIN_TIME -> ok end,
- LowUtil2 = cpu_sup:util(),
+ Spin(),
+ HighUtil2 = cpu_sup:util(),
- Utils = [{high1,HighUtil1}, {low1,LowUtil1},
- {high2,HighUtil2}, {low2,LowUtil2}],
- io:format("Utils: ~p~n", [Utils]),
+ receive after ?SPIN_TIME -> ok end,
+ LowUtil2 = cpu_sup:util(),
- false = LowUtil1 > HighUtil1,
- false = LowUtil1 > HighUtil2,
- false = LowUtil2 > HighUtil1,
- false = LowUtil2 > HighUtil2,
+ Utils = [{high1,HighUtil1}, {low1,LowUtil1},
+ {high2,HighUtil2}, {low2,LowUtil2}],
+ io:format("Utils: ~p~n", [Utils]),
- ok.
+ false = LowUtil1 > HighUtil1,
+ false = LowUtil1 > HighUtil2,
+ false = LowUtil2 > HighUtil1,
+ false = LowUtil2 > HighUtil2,
+
+ ok
+ end.
% Outdated
diff --git a/lib/parsetools/Makefile b/lib/parsetools/Makefile
index e9de5c43cb..2ddb06feb1 100644
--- a/lib/parsetools/Makefile
+++ b/lib/parsetools/Makefile
@@ -37,3 +37,4 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/public_key/Makefile b/lib/public_key/Makefile
index 7a5c1c1443..ed8901a8af 100644
--- a/lib/public_key/Makefile
+++ b/lib/public_key/Makefile
@@ -38,3 +38,6 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=asn crypto
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/reltool/Makefile b/lib/reltool/Makefile
index 4b6aad07b3..0a39d7daa8 100644
--- a/lib/reltool/Makefile
+++ b/lib/reltool/Makefile
@@ -36,3 +36,6 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=wx sasl
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/runtime_tools/Makefile b/lib/runtime_tools/Makefile
index eec1ff379b..4b0f1633ab 100644
--- a/lib/runtime_tools/Makefile
+++ b/lib/runtime_tools/Makefile
@@ -36,4 +36,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=mnesia
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/sasl/Makefile b/lib/sasl/Makefile
index 065eb45fbb..06af80fd35 100644
--- a/lib/sasl/Makefile
+++ b/lib/sasl/Makefile
@@ -36,3 +36,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=tools
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/snmp/Makefile b/lib/snmp/Makefile
index df321fc2d1..52debf1670 100644
--- a/lib/snmp/Makefile
+++ b/lib/snmp/Makefile
@@ -2,7 +2,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2019. All Rights Reserved.
+# Copyright Ericsson AB 1996-2016. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -71,24 +71,6 @@ do_configure: configure
configure: configure.in
autoconf
-.PHONY: info gclean
-
-info:
- @echo "OS: $(OS)"
- @echo "DOCB: $(DOCB)"
- @echo ""
- @echo "SNMP_VSN: $(SNMP_VSN)"
- @echo "APP_VSN: $(APP_VSN)"
- @echo ""
- @echo "DIA_PLT: $(DIA_PLT)"
- @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)"
- @echo ""
-
-
-gclean:
- git clean -fXd
-
-
# ----------------------------------------------------
# Application (source) release targets
# ----------------------------------------------------
@@ -130,28 +112,6 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME))
-dclean:
- rm -f $(DIA_PLT)
- rm -f $(DIA_ANALYSIS)
-
-dialyzer_plt: $(DIA_PLT)
-
-$(DIA_PLT): Makefile
- @echo "Building $(APPLICATION) plt file"
- @dialyzer --build_plt \
- --output_plt $@ \
- -r ../$(APPLICATION)/ebin \
- ../../lib/kernel/ebin \
- ../../lib/stdlib/ebin \
- ../../lib/runtime_tools/ebin \
- ../../lib/crypto/ebin \
- ../../lib/mnesia/ebin \
- ../../erts/preloaded/ebin \
- --output $(DIA_ANALYSIS) \
- --verbose
-
-dialyzer: $(DIA_PLT)
- @echo "Running dialyzer on $(APPLICATION)"
- @dialyzer --plt $< \
- ../$(APPLICATION)/ebin \
- --verbose
+DIA_PLT_APPS=runtime_tools crypto mnesia
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/ssh/Makefile b/lib/ssh/Makefile
index dedc7ac3a6..b96cc2bbaa 100644
--- a/lib/ssh/Makefile
+++ b/lib/ssh/Makefile
@@ -37,4 +37,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=crypto runtime_tools public_key
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/ssl/Makefile b/lib/ssl/Makefile
index bd43794a36..526560288f 100644
--- a/lib/ssl/Makefile
+++ b/lib/ssl/Makefile
@@ -38,4 +38,6 @@ SPECIAL_TARGETS =
#
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=crypto runtime_tools inets public_key
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/stdlib/Makefile b/lib/stdlib/Makefile
index 3086d85445..cae3844126 100644
--- a/lib/stdlib/Makefile
+++ b/lib/stdlib/Makefile
@@ -35,3 +35,7 @@ SPECIAL_TARGETS =
# Default Subdir Targets
#
include $(ERL_TOP)/make/otp_subdir.mk
+
+DIA_PLT_APPS=compiler crypto
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml
index 8142e5c0aa..d487cccdfc 100644
--- a/lib/stdlib/doc/src/erl_parse.xml
+++ b/lib/stdlib/doc/src/erl_parse.xml
@@ -69,6 +69,25 @@
<name name="erl_parse_tree"></name>
</datatype>
<datatype>
+ <name>af_binelement(_)</name>
+ <desc>
+ <p>Abstract representation of an element of a bitstring.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name>af_generator()</name>
+ <desc>
+ <p>Abstract representation of a generator
+ or a bitstring generator.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name>af_remote_function()></name>
+ <desc>
+ <p>Abstract representation of a remote function call.</p>
+ </desc>
+ </datatype>
+ <datatype>
<name name="error_description"></name>
</datatype>
<datatype>
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 4ad94f2507..ca53f992f6 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -604,6 +604,8 @@ Erlang code.
-export_type([abstract_clause/0, abstract_expr/0, abstract_form/0,
abstract_type/0, form_info/0, error_info/0]).
+%% The following types are exported because they are used by syntax_tools
+-export_type([af_binelement/1, af_generator/0, af_remote_function/0]).
%% Start of Abstract Format
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 09238ae2b4..05893a92b0 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -46,7 +46,8 @@
test_delete_table_while_size_snapshot/1, test_delete_table_while_size_snapshot_helper/0]).
-export([ordered/1, ordered_match/1, interface_equality/1,
- fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1,
+ fixtable_next/1, fixtable_iter_bag/1,
+ fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1,
update_element/1, update_counter/1, evil_update_counter/1, partly_bound/1, match_heavy/1]).
-export([update_counter_with_default/1]).
-export([update_counter_table_growth/1]).
@@ -127,7 +128,7 @@ all() ->
{group, match}, t_match_spec_run,
{group, lookup_element}, {group, misc}, {group, files},
{group, heavy}, ordered, ordered_match,
- interface_equality, fixtable_next, fixtable_insert,
+ interface_equality, fixtable_next, fixtable_iter_bag, fixtable_insert,
rename, rename_unnamed, evil_rename, update_element,
update_counter, evil_update_counter,
update_counter_with_default, partly_bound,
@@ -2446,6 +2447,135 @@ do_fixtable_next(Tab) ->
false = ets:info(Tab, fixed),
ets:delete(Tab).
+%% Check that iteration of bags find all live objects and nothing else.
+fixtable_iter_bag(Config) when is_list(Config) ->
+ repeat_for_opts(fun fixtable_iter_do/1,
+ [write_concurrency,[bag,duplicate_bag]]).
+
+fixtable_iter_do(Opts) ->
+ EtsMem = etsmem(),
+ do_fixtable_iter_bag(ets_new(fixtable_iter_bag,Opts)),
+ verify_etsmem(EtsMem).
+
+do_fixtable_iter_bag(T) ->
+ MaxValues = 4,
+ %% Create 1 to MaxValues objects for each key
+ %% and then delete every possible combination of those objects
+ %% in every possible order.
+ %% Then test iteration returns all live objects and nothing else.
+
+ CrDelOps = [begin
+ Values = lists:seq(1,N),
+ %% All ways of deleting any number of the Values in any order
+ Combos = combs(Values),
+ DeleteOps = concat_lists([perms(C) || C <- Combos]),
+ {N, DeleteOps}
+ end
+ || N <- lists:seq(1,MaxValues)],
+
+ %%io:format("~p\n", [CrDelOps]),
+
+ NKeys = lists:foldl(fun({_, DeleteOps}, Cnt) ->
+ Cnt + length(DeleteOps)
+ end,
+ 0,
+ CrDelOps),
+
+ io:format("Create ~p keys\n", [NKeys]),
+
+ %% Fixate even before inserts just to maintain small table size
+ %% and increase likelyhood of different keys in same bucket.
+ ets:safe_fixtable(T,true),
+ InsRes = [begin
+ [begin
+ Key = {NValues,ValueList},
+ [begin
+ Tpl = {Key, V},
+ %%io:format("Insert object ~p", [Tpl]),
+ ets:insert(T, Tpl),
+ Tpl
+ end
+ || V <- lists:seq(1,NValues)]
+ end
+ || ValueList <- DeleteOps]
+ end
+ || {NValues, DeleteOps} <- CrDelOps],
+
+ Inserted = lists:flatten(InsRes),
+ InSorted = lists:sort(Inserted),
+ InSorted = lists:usort(Inserted), %% No duplicates
+ NObjs = length(Inserted),
+
+ DelRes = [begin
+ [begin
+ Key = {NValues,ValueList},
+ [begin
+ Tpl = {Key, V},
+ %%io:format("Delete object ~p", [Tpl]),
+ ets:delete_object(T, Tpl),
+ Tpl
+ end
+ || V <- ValueList]
+ end
+ || ValueList <- DeleteOps]
+ end
+ || {NValues, DeleteOps} <- CrDelOps],
+
+ Deleted = lists:flatten(DelRes),
+ DelSorted = lists:sort(Deleted),
+ DelSorted = lists:usort(Deleted), %% No duplicates
+ NDels = length(Deleted),
+
+ %% Nr of keys where all values were deleted.
+ NDeletedKeys = lists:sum([factorial(N) || N <- lists:seq(1,MaxValues)]),
+
+ CountKeysFun = fun Me(K1, Cnt) ->
+ case ets:next(T, K1) of
+ '$end_of_table' ->
+ Cnt;
+ K2 ->
+ Objs = ets:lookup(T, K2),
+ [{{NValues, ValueList}, _V} | _] = Objs,
+ ExpectedLive = NValues - length(ValueList),
+ ExpectedLive = length(Objs),
+ Me(K2, Cnt+1)
+ end
+ end,
+
+ ExpectedKeys = NKeys - NDeletedKeys,
+ io:format("Expected keys: ~p\n", [ExpectedKeys]),
+ FoundKeys = CountKeysFun(ets:first(T), 1),
+ io:format("Found keys: ~p\n", [FoundKeys]),
+ ExpectedKeys = FoundKeys,
+
+ ExpectedObjs = NObjs - NDels,
+ io:format("Expected objects: ~p\n", [ExpectedObjs]),
+ FoundObjs = ets:select_count(T, [{{'_','_'}, [], [true]}]),
+ io:format("Found objects: ~p\n", [FoundObjs]),
+ ExpectedObjs = FoundObjs,
+
+ ets:delete(T).
+
+%% All permutations of list
+perms([]) -> [[]];
+perms(L) -> [[H|T] || H <- L, T <- perms(L--[H])].
+
+%% All combinations of picking the element (or not) from list
+combs([]) -> [[]];
+combs([H|T]) ->
+ Tcombs = combs(T),
+ Tcombs ++ [[H | C] || C <- Tcombs].
+
+factorial(0) -> 1;
+factorial(N) when N > 0 ->
+ N * factorial(N - 1).
+
+concat_lists([]) ->
+ [];
+concat_lists([H|T]) ->
+ H ++ concat_lists(T).
+
+
%% Check inserts of deleted keys in fixed bags.
fixtable_insert(Config) when is_list(Config) ->
Combos = [[Type,{write_concurrency,WC}] || Type<- [bag,duplicate_bag],
diff --git a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html
index 27d6849c60..239877c257 100644
--- a/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html
+++ b/lib/stdlib/test/ets_SUITE_data/visualize_throughput.html
@@ -4,7 +4,7 @@
<!-- %% -->
<!-- %% %CopyrightBegin% -->
<!-- %% -->
-<!-- %% Copyright Ericsson AB and Kjell Winblad 1996-2018. All Rights Reserved. -->
+<!-- %% Copyright Ericsson AB and Kjell Winblad 1996-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. -->
@@ -44,6 +44,12 @@
<br>
<textarea id="dataField" rows="4" cols="50">#bench_data_placeholder</textarea>
<br>
+ <input type="checkbox" id="throughputPlot" checked> Include Throughput Plot
+ <br>
+ <input type="checkbox" id="betterThanWorstPlot"> Include % More Throughput Than Worst Plot
+ <br>
+ <input type="checkbox" id="worseThanBestPlot"> Include % Less Throughput Than Best Plot
+ <br>
<input type="checkbox" id="barPlot"> Bar Plot
<br>
<input type="checkbox" id="sameSpacing" checked> Same X Spacing Between Points
@@ -148,10 +154,52 @@
}
return data;
}
+ function toCompareData(dataParam, compareWithWorst) {
+ var data = $.extend(true, [], dataParam);
+ var worstSoFarMap = {};
+ var defaultSoFarValue = compareWithWorst ? Number.MAX_VALUE : Number.MIN_VALUE;
+ function getWorstBestSoFar(x){
+ return worstSoFarMap[x] === undefined ? defaultSoFarValue : worstSoFarMap[x];
+ }
+ function setWorstBestSoFar(x, y){
+ return worstSoFarMap[x] = y;
+ }
+ function lessOrGreaterThan(n1, n2){
+ return compareWithWorst ? n1 < n2 : n1 > n2;
+ }
+ $.each(data, function(i, allResConfig) {
+ $.each(allResConfig.y, function(index, res) {
+ var xName = allResConfig.x[index];
+ if(lessOrGreaterThan(res, getWorstBestSoFar(xName))){
+ setWorstBestSoFar(xName, res);
+ }
+ });
+ });
+ $.each(data, function(i, allResConfig) {
+ $.each(allResConfig.y, function(index, res) {
+ var xName = allResConfig.x[index];
+ if(compareWithWorst){
+ allResConfig.y[index] = ((res / getWorstBestSoFar(xName))-1.0) * 100;
+ }else{
+ allResConfig.y[index] = (1.0 -(res / getWorstBestSoFar(xName))) * 100;
+ }
+ });
+ });
+ return data;
+ }
+ function toBetterThanWorstData(data){
+ return toCompareData(data, true);
+ }
+ function toWorseThanBestData(data){
+ return toCompareData(data, false);
+ }
function plotGraphs(){
var insertPlaceholder = $("#insertPlaceholder");
var sameSpacing = $('#sameSpacing').is(":checked");
var barPlot = $('#barPlot').is(":checked");
+ var throughputPlot = $('#throughputPlot').is(":checked");
+ var betterThanWorstPlot = $('#betterThanWorstPlot').is(":checked");
+ var worseThanBestPlot = $('#worseThanBestPlot').is(":checked");
var lines = $("#dataField").val();
$('.showCheck').each(function() {
var item = $(this);
@@ -188,42 +236,59 @@
plotGraph(lines, sameSpacing, barPlot, prefix));
}
}
+ var nrOfGraphs = 0;
+ function plotScenario(name, plotType) {
+ var data = scenarioDataMap[name];
+ var yAxisTitle = undefined;
+ nrOfGraphs = nrOfGraphs + 1;
+ $("<div class='added' id='graph" + nrOfGraphs + "'>")
+ .insertBefore(insertPlaceholder);
+ $("<button type='button' class='added' id='fullscreenButton" + nrOfGraphs + "'>Fill screen</button>")
+ .insertBefore(insertPlaceholder);
+ $("<span class='added'><br><hr><br></span>")
+ .insertBefore(insertPlaceholder);
+ if (plotType === 'throughput') {
+ yAxisTitle = 'Operations/Second';
+ } else if (plotType === 'better_than_worst') {
+ yAxisTitle = '% More Throughput Than Worst';
+ data = toBetterThanWorstData(data);
+ } else {
+ yAxisTitle = '% Less Throughput Than Best';
+ data = toWorseThanBestData(data);
+ }
+ var layout = {
+ title: name,
+ xaxis: {
+ title: '# of Processes'
+ },
+ yaxis: {
+ title: yAxisTitle
+ }
+ };
+ $("#fullscreenButton" + nrOfGraphs).click(
+ function () {
+ $('#graph' + nrOfGraphs).replaceWith(
+ $("<div class='added' id='graph" + nrOfGraphs + "'>"));
+ layout = $.extend({}, layout, {
+ width: $(window).width() - 40,
+ height: $(window).height() - 40
+ });
+ Plotly.newPlot('graph' + nrOfGraphs, data, layout);
+ });
+ Plotly.newPlot('graph' + nrOfGraphs, data, layout);
+ }
$.each(scenarioList,
- function( index, name ) {
- var nrOfGraphs = index + 1;
- var data = scenarioDataMap[name];
- $( "<div class='added' id='graph"+nrOfGraphs+"'>")
- .insertBefore( insertPlaceholder );
- $( "<button type='button' class='added' id='fullscreenButton"+nrOfGraphs+"'>Fill screen</button>")
- .insertBefore( insertPlaceholder );
- $( "<span class='added'><br><hr><br></span>")
- .insertBefore( insertPlaceholder );
- var layout = {
- title:name,
- xaxis: {
- title: '# of Processes'
- },
- yaxis: {
- title: 'Operations/Second'
- }
-
- };
-
- $("#fullscreenButton"+nrOfGraphs).click(
- function(){
- $('#graph'+nrOfGraphs).replaceWith(
- $("<div class='added' id='graph"+nrOfGraphs+"'>"));
- layout = $.extend({}, layout, {
- width:$(window).width()-40,
- height:$(window).height()-40
- });
- Plotly.newPlot('graph'+nrOfGraphs, data, layout);
- });
- Plotly.newPlot('graph'+nrOfGraphs, data, layout);
-
- });
-
-
+ function (index, name) {
+ if (throughputPlot) {
+ plotScenario(name, 'throughput');
+ }
+ if (betterThanWorstPlot) {
+ plotScenario(name, 'better_than_worst');
+ }
+ if (worseThanBestPlot) {
+ plotScenario(name, 'worse_than_best');
+ }
+ });
}
$(document).ready(function(){
$('#renderButton').click(
diff --git a/lib/syntax_tools/Makefile b/lib/syntax_tools/Makefile
index 14ae6d4f97..d3e2aa9b2c 100644
--- a/lib/syntax_tools/Makefile
+++ b/lib/syntax_tools/Makefile
@@ -91,3 +91,5 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME))
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl
index 7e741cc649..da22a91de0 100644
--- a/lib/syntax_tools/src/epp_dodger.erl
+++ b/lib/syntax_tools/src/epp_dodger.erl
@@ -598,8 +598,6 @@ skip_macro_args([{'receive',_}=T | Ts], Es, As) ->
skip_macro_args(Ts, ['end' | Es], [T | As]);
skip_macro_args([{'try',_}=T | Ts], Es, As) ->
skip_macro_args(Ts, ['end' | Es], [T | As]);
-skip_macro_args([{'cond',_}=T | Ts], Es, As) ->
- skip_macro_args(Ts, ['end' | Es], [T | As]);
skip_macro_args([{E,_}=T | Ts], [E], As) -> %final close
{lists:reverse([T | As]), Ts};
skip_macro_args([{E,_}=T | Ts], [E | Es], As) -> %matching close
diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl
index 6ad9bec2e6..d70dd40a8a 100644
--- a/lib/syntax_tools/src/erl_prettypr.erl
+++ b/lib/syntax_tools/src/erl_prettypr.erl
@@ -53,7 +53,7 @@
-type hook() :: 'none'
| fun((erl_syntax:syntaxTree(), _, _) -> prettypr:document()).
--type clause_t() :: 'case_expr' | 'cond_expr' | 'fun_expr'
+-type clause_t() :: 'case_expr' | 'fun_expr'
| 'if_expr' | 'receive_expr' | 'try_expr'
| {'function', prettypr:document()}
| 'spec'.
@@ -586,8 +586,6 @@ lay_2(Node, Ctxt) ->
make_fun_clause(N, D1, D2, D3, Ctxt);
if_expr ->
make_if_clause(D1, D2, D3, Ctxt);
- cond_expr ->
- make_if_clause(D1, D2, D3, Ctxt);
case_expr ->
make_case_clause(D1, D2, D3, Ctxt);
receive_expr ->
@@ -627,14 +625,6 @@ lay_2(Node, Ctxt) ->
sep([follow(text("if"), D, Ctxt1#ctxt.sub_indent),
text("end")]);
- cond_expr ->
- Ctxt1 = reset_prec(Ctxt),
- D = lay_clauses(erl_syntax:cond_expr_clauses(Node),
- cond_expr, Ctxt1),
- sep([text("cond"),
- nest(Ctxt1#ctxt.sub_indent, D),
- text("end")]);
-
fun_expr ->
Ctxt1 = reset_prec(Ctxt),
D = lay_clauses(erl_syntax:fun_expr_clauses(Node),
diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl
index 1be644c620..1c0c532323 100644
--- a/lib/syntax_tools/src/erl_syntax.erl
+++ b/lib/syntax_tools/src/erl_syntax.erl
@@ -183,8 +183,6 @@
comment/2,
comment_padding/1,
comment_text/1,
- cond_expr/1,
- cond_expr_clauses/1,
conjunction/1,
conjunction_body/1,
constrained_function_type/2,
@@ -431,6 +429,7 @@
-record(tree, {type :: atom(),
attr = #attr{} :: #attr{},
data :: term()}).
+-type tree() :: #tree{}.
%% `wrapper' records are used for attaching new-form node information to
%% `erl_parse' trees.
@@ -446,18 +445,20 @@
-record(wrapper, {type :: atom(),
attr = #attr{} :: #attr{},
tree :: erl_parse()}).
+-type wrapper() :: #wrapper{}.
%% =====================================================================
--type syntaxTree() :: #tree{} | #wrapper{} | erl_parse().
+-type syntaxTree() :: tree() | wrapper() | erl_parse().
-type erl_parse() :: erl_parse:abstract_clause()
| erl_parse:abstract_expr()
| erl_parse:abstract_form()
| erl_parse:abstract_type()
| erl_parse:form_info()
- %% To shut up Dialyzer:
- | {bin_element, _, _, _, _}.
+ | erl_parse:af_binelement(term())
+ | erl_parse:af_generator()
+ | erl_parse:af_remote_function().
%% The representation built by the Erlang standard library parser
%% `erl_parse'. This is a subset of the {@link syntaxTree()} type.
@@ -494,39 +495,38 @@
%% <td>class_qualifier</td>
%% <td>clause</td>
%% <td>comment</td>
-%% <td>cond_expr</td>
-%% </tr><tr>
%% <td>conjunction</td>
+%% </tr><tr>
%% <td>constrained_function_type</td>
%% <td>constraint</td>
%% <td>disjunction</td>
-%% </tr><tr>
%% <td>eof_marker</td>
+%% </tr><tr>
%% <td>error_marker</td>
%% <td>float</td>
%% <td>form_list</td>
-%% </tr><tr>
%% <td>fun_expr</td>
+%% </tr><tr>
%% <td>fun_type</td>
%% <td>function</td>
%% <td>function_type</td>
-%% </tr><tr>
%% <td>generator</td>
+%% </tr><tr>
%% <td>if_expr</td>
%% <td>implicit_fun</td>
%% <td>infix_expr</td>
-%% </tr><tr>
%% <td>integer</td>
+%% </tr><tr>
%% <td>integer_range_type</td>
%% <td>list</td>
%% <td>list_comp</td>
-%% </tr><tr>
%% <td>macro</td>
+%% </tr><tr>
%% <td>map_expr</td>
%% <td>map_field_assoc</td>
%% <td>map_field_exact</td>
-%% </tr><tr>
%% <td>map_type</td>
+%% </tr><tr>
%% <td>map_type_assoc</td>
%% <td>map_type_exact</td>
%% <td>match_expr</td>
@@ -556,6 +556,7 @@
%% <td>tuple_type</td>
%% <td>typed_record_field</td>
%% <td>type_application</td>
+%% </tr><tr>
%% <td>type_union</td>
%% <td>underscore</td>
%% <td>user_type_application</td>
@@ -587,7 +588,6 @@
%% @see class_qualifier/2
%% @see clause/3
%% @see comment/2
-%% @see cond_expr/1
%% @see conjunction/1
%% @see constrained_function_type/2
%% @see constraint/2
@@ -673,7 +673,6 @@ type(Node) ->
%% Composite types
{'case', _, _, _} -> case_expr;
{'catch', _, _} -> catch_expr;
- {'cond', _, _} -> cond_expr;
{'fun', _, {clauses, _}} -> fun_expr;
{named_fun, _, _, _} -> named_fun_expr;
{'fun', _, {function, _, _}} -> implicit_fun;
@@ -6290,7 +6289,6 @@ if_expr_clauses(Node) ->
%% @see case_expr_argument/1
%% @see clause/3
%% @see if_expr/1
-%% @see cond_expr/1
-record(case_expr, {argument :: syntaxTree(), clauses :: [syntaxTree()]}).
@@ -6357,60 +6355,6 @@ case_expr_clauses(Node) ->
%% =====================================================================
-%% @doc Creates an abstract cond-expression. If `Clauses' is
-%% `[C1, ..., Cn]', the result represents "<code>cond
-%% <em>C1</em>; ...; <em>Cn</em> end</code>". More exactly, if each
-%% `Ci' represents "<code>() <em>Ei</em> ->
-%% <em>Bi</em></code>", then the result represents "<code>cond
-%% <em>E1</em> -> <em>B1</em>; ...; <em>En</em> -> <em>Bn</em>
-%% end</code>".
-%%
-%% @see cond_expr_clauses/1
-%% @see clause/3
-%% @see case_expr/2
-
-%% type(Node) = cond_expr
-%% data(Node) = Clauses
-%%
-%% Clauses = [syntaxTree()]
-%%
-%% `erl_parse' representation:
-%%
-%% {'cond', Pos, Clauses}
-%%
-%% Clauses = [Clause] \ []
-%% Clause = {clause, ...}
-%%
-%% See `clause' for documentation on `erl_parse' clauses.
-
--spec cond_expr([syntaxTree()]) -> syntaxTree().
-
-cond_expr(Clauses) ->
- tree(cond_expr, Clauses).
-
-revert_cond_expr(Node) ->
- Pos = get_pos(Node),
- Clauses = [revert_clause(C) || C <- cond_expr_clauses(Node)],
- {'cond', Pos, Clauses}.
-
-
-%% =====================================================================
-%% @doc Returns the list of clause subtrees of a `cond_expr' node.
-%%
-%% @see cond_expr/1
-
--spec cond_expr_clauses(syntaxTree()) -> [syntaxTree()].
-
-cond_expr_clauses(Node) ->
- case unwrap(Node) of
- {'cond', _, Clauses} ->
- Clauses;
- Node1 ->
- data(Node1)
- end.
-
-
-%% =====================================================================
%% @equiv receive_expr(Clauses, none, [])
-spec receive_expr([syntaxTree()]) -> syntaxTree().
@@ -7534,8 +7478,6 @@ revert_root(Node) ->
revert_char(Node);
clause ->
revert_clause(Node);
- cond_expr ->
- revert_cond_expr(Node);
constrained_function_type ->
revert_constrained_function_type(Node);
constraint ->
@@ -7802,8 +7744,6 @@ subtrees(T) ->
[clause_patterns(T), [G],
clause_body(T)]
end;
- cond_expr ->
- [cond_expr_clauses(T)];
conjunction ->
[conjunction_body(T)];
constrained_function_type ->
@@ -8017,7 +7957,6 @@ make_tree(class_qualifier, [[A], [B]]) -> class_qualifier(A, B);
make_tree(class_qualifier, [[A], [B], [C]]) -> class_qualifier(A, B, C);
make_tree(clause, [P, B]) -> clause(P, none, B);
make_tree(clause, [P, [G], B]) -> clause(P, G, B);
-make_tree(cond_expr, [C]) -> cond_expr(C);
make_tree(conjunction, [E]) -> conjunction(E);
make_tree(constrained_function_type, [[F],C]) ->
constrained_function_type(F, C);
@@ -8239,7 +8178,7 @@ meta_call(F, As) ->
%% =====================================================================
%% @equiv tree(Type, [])
--spec tree(atom()) -> #tree{}.
+-spec tree(atom()) -> tree().
tree(Type) ->
tree(Type, []).
@@ -8274,7 +8213,7 @@ tree(Type) ->
%% @see data/1
%% @see type/1
--spec tree(atom(), term()) -> #tree{}.
+-spec tree(atom(), term()) -> tree().
tree(Type, Data) ->
#tree{type = Type, data = Data}.
@@ -8330,7 +8269,7 @@ data(T) -> erlang:error({badarg, T}).
%% trees. <em>Attaching a wrapper onto another wrapper structure is an
%% error</em>.
--spec wrap(erl_parse()) -> #wrapper{}.
+-spec wrap(erl_parse()) -> wrapper().
wrap(Node) ->
%% We assume that Node is an old-school `erl_parse' tree.
@@ -8344,7 +8283,7 @@ wrap(Node) ->
%% `erl_parse' tree; otherwise it returns `Node'
%% itself.
--spec unwrap(syntaxTree()) -> #tree{} | erl_parse().
+-spec unwrap(syntaxTree()) -> tree() | erl_parse().
unwrap(#wrapper{tree = Node}) -> Node;
unwrap(Node) -> Node. % This could also be a new-form node.
diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl
index 352165893f..6185007235 100644
--- a/lib/syntax_tools/src/erl_syntax_lib.erl
+++ b/lib/syntax_tools/src/erl_syntax_lib.erl
@@ -528,8 +528,6 @@ vann(Tree, Env) ->
vann_case_expr(Tree, Env);
if_expr ->
vann_if_expr(Tree, Env);
- cond_expr ->
- vann_cond_expr(Tree, Env);
receive_expr ->
vann_receive_expr(Tree, Env);
catch_expr ->
@@ -613,9 +611,6 @@ vann_if_expr(Tree, Env) ->
Tree1 = rewrite(Tree, erl_syntax:if_expr(Cs1)),
{ann_bindings(Tree1, Env, Bound, Free), Bound, Free}.
-vann_cond_expr(_Tree, _Env) ->
- erlang:error({not_implemented,cond_expr}).
-
vann_catch_expr(Tree, Env) ->
E = erl_syntax:catch_expr_body(Tree),
{E1, _, Free} = vann(E, Env),
diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl
index 5623aa6af3..1ced48ecb3 100644
--- a/lib/syntax_tools/src/erl_tidy.erl
+++ b/lib/syntax_tools/src/erl_tidy.erl
@@ -1551,18 +1551,6 @@ visit_match_body(Ps, P, B, Tree, Env, St0) ->
false ->
visit_match_expr_final(P, B, Tree, Env, St0)
end;
- cond_expr ->
- Cs = erl_syntax:cond_expr_clauses(B),
- case multival_clauses(Cs, length(Ps), Ps) of
- {true, Cs1} ->
- report_export_vars(Env#env.file,
- erl_syntax:get_pos(B),
- "cond", Env#env.verbosity),
- Tree1 = erl_syntax:cond_expr(Cs1),
- {rewrite(Tree, Tree1), St0};
- false ->
- visit_match_expr_final(P, B, Tree, Env, St0)
- end;
receive_expr ->
%% Handle the timeout case as an extra clause.
As = erl_syntax:receive_expr_action(B),
diff --git a/lib/tftp/Makefile b/lib/tftp/Makefile
index a4559fbc2e..d0397beaa0 100644
--- a/lib/tftp/Makefile
+++ b/lib/tftp/Makefile
@@ -43,36 +43,6 @@ include $(ERL_TOP)/make/otp_subdir.mk
.PHONY: info gclean dialyzer dialyzer_plt dclean
-info:
- @echo "OS: $(OS)"
- @echo "DOCB: $(DOCB)"
- @echo ""
- @echo "TFTP_VSN: $(TFTP_VSN)"
- @echo "APP_VSN: $(APP_VSN)"
- @echo ""
- @echo "DIA_PLT: $(DIA_PLT)"
- @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)"
- @echo ""
+DIA_PLT_APPS=
-gclean:
- git clean -fXd
-
-dclean:
- rm -f $(DIA_PLT)
- rm -f $(DIA_ANALYSIS)
-
-dialyzer_plt: $(DIA_PLT)
-
-$(DIA_PLT):
- @echo "Building $(APPLICATION) plt file"
- @dialyzer --build_plt \
- --output_plt $@ \
- -r ../$(APPLICATION)/ebin \
- --output $(DIA_ANALYSIS) \
- --verbose
-
-dialyzer: $(DIA_PLT)
- @echo "Running dialyzer on $(APPLICATION)"
- @dialyzer --plt $< \
- ../$(APPLICATION)/ebin \
- --verbose
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/tools/Makefile b/lib/tools/Makefile
index e17e9cfd1e..d849989a2d 100644
--- a/lib/tools/Makefile
+++ b/lib/tools/Makefile
@@ -36,3 +36,6 @@ SPECIAL_TARGETS =
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_subdir.mk
+DIA_PLT_APPS=compiler runtime_tools
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/tools/test/cprof_SUITE.erl b/lib/tools/test/cprof_SUITE.erl
index 9cbc27fb17..39239a66a9 100644
--- a/lib/tools/test/cprof_SUITE.erl
+++ b/lib/tools/test/cprof_SUITE.erl
@@ -211,16 +211,12 @@ on_load_test(Config) ->
Lr = seq_r(1, M, fun succ/1),
N2 = cprof:pause(),
{Module,0,[]} = cprof:analyse(Module),
- M_1 = M - 1,
M4__4 = M*4 - 4,
M10_7 = M*10 - 7,
{?MODULE,M10_7,[{{?MODULE,succ,1},M4__4},
+ {{?MODULE,'-fun.succ/1-',1},M4__4},
{{?MODULE,seq_r,4},M},
{{?MODULE,seq,3},M},
- {{?MODULE,'-on_load_test/1-fun-5-',1},M_1},
- {{?MODULE,'-on_load_test/1-fun-4-',1},M_1},
- {{?MODULE,'-on_load_test/1-fun-3-',1},M_1},
- {{?MODULE,'-on_load_test/1-fun-2-',1},M_1},
{{?MODULE,seq_r,3},1}]}
= cprof:analyse(?MODULE),
N2 = cprof:stop(),
@@ -246,18 +242,14 @@ modules_test(Config) ->
Lr = seq_r(1, M, fun succ/1),
N = cprof:pause(),
Lr = lists:reverse(L),
- M_1 = M - 1,
M4_4 = M*4 - 4,
M10_7 = M*10 - 7,
M2__1 = M*2 + 1,
{Tot,ModList} = cprof:analyse(),
{value,{?MODULE,M10_7,[{{?MODULE,succ,1},M4_4},
+ {{?MODULE,'-fun.succ/1-',1},M4_4},
{{?MODULE,seq_r,4},M},
{{?MODULE,seq,3},M},
- {{?MODULE,'-modules_test/1-fun-3-',1},M_1},
- {{?MODULE,'-modules_test/1-fun-2-',1},M_1},
- {{?MODULE,'-modules_test/1-fun-1-',1},M_1},
- {{?MODULE,'-modules_test/1-fun-0-',1},M_1},
{{?MODULE,seq_r,3},1}]}} =
lists:keysearch(?MODULE, 1, ModList),
{value,{Module,M2__1,[{{Module,seq_r,4},M},
diff --git a/lib/wx/Makefile b/lib/wx/Makefile
index 2397950925..002887d9da 100644
--- a/lib/wx/Makefile
+++ b/lib/wx/Makefile
@@ -40,3 +40,5 @@ CLEANDIRS = $(SUBDIRS) api_gen
SUB_DIRECTORIES=$(SUBDIRS)
include $(ERL_TOP)/make/otp_subdir.mk
+
+include $(ERL_TOP)/make/app_targets.mk
diff --git a/lib/xmerl/Makefile b/lib/xmerl/Makefile
index a584aacbac..65a0af9e4a 100644
--- a/lib/xmerl/Makefile
+++ b/lib/xmerl/Makefile
@@ -50,12 +50,7 @@ SPECIAL_TARGETS =
include $(ERL_TOP)/make/otp_subdir.mk
-.PHONY: info version
-
-info:
- @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)"
- @echo "APP_DIR: $(APP_DIR)"
- @echo "APP_TAR_FILE: $(APP_TAR_FILE)"
+.PHONY: version
version:
@echo "$(VSN)"
@@ -97,3 +92,4 @@ tar: $(APP_TAR_FILE)
$(APP_TAR_FILE): $(APP_DIR)
(cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME))
+include $(ERL_TOP)/make/app_targets.mk