diff options
189 files changed, 7387 insertions, 4214 deletions
diff --git a/HOWTO/TESTING.md b/HOWTO/TESTING.md index ad59319efa..020be0309c 100644 --- a/HOWTO/TESTING.md +++ b/HOWTO/TESTING.md @@ -130,6 +130,52 @@ i.e. Running [ct_run][] from the command line still requires you to do the `ts:install()` step above. +### Convenience for running tests without the release and configuration steps + +It can be convenient to run tests with a single command. This way, one +do not need to worry about missing to run `make release_tests` after +changing a test suite. The `make test` command can be used for this +purpose. The `make test` command works when the current directory +contains a directory called test and in the root directory of the +source code tree. + +*(Waring)* Some test cases do not run correctly or cannot be run at +all through the `make test` command (typically test cases that require +test specific C code to be compiled) because `make test` runs tests +directly by invoking the `ct_run` command instead of using the `ts` +wrapper. One has to follow the procedure described above to run test +cases that do not work with `make test`. + +Below are some examples that illustrate how `make test` can be +used: + + # ERL_TOP needs to be set correctly + cd /path/to/otp + export ERL_TOP=`pwd` + + # Build Erlang/OTP + # + # Note that make test will only compile test code except when + # make test is executed from $ERL_TOP. + ./otp_build setup -a + + # Run a test case (The ARGS variable is passed to ct_run) + (cd $ERL_TOP/erts/emulator && make ARGS="-suite binary_SUITE -case deep_bitstr_lists" test) + + # Run a test suite + (cd $ERL_TOP/lib/stdlib && make ARGS="-suite ets_SUITE" test) + + # Run all test suites for an application + (cd $ERL_TOP/lib/asn1 && make test) + + # Run all tests + # + # When executed from $ERL_TOP, "make test" will first release and + # configure all tests and then attempt to run all tests with `ts:run`. + # This will take several hours. + (cd $ERL_TOP && make test) + + Examining the results --------------------- diff --git a/Makefile.in b/Makefile.in index 25003f47a9..3c4a6da85e 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1141,3 +1141,8 @@ bootstrap_clean: || $(MAKE) BOOTSTRAP_ROOT=$(BOOTSTRAP_ROOT) bootstrap_root_clean # ---------------------------------------------------------------------- + +.PHONY: test + +test: all release release_tests + $(ERL_TOP)/make/test_target_script.sh $(ERL_TOP) diff --git a/OTP_VERSION b/OTP_VERSION index 84a941394a..9854364f85 100644 --- a/OTP_VERSION +++ b/OTP_VERSION @@ -1 +1 @@ -22.0.7 +23.0-rc0 diff --git a/erts/Makefile b/erts/Makefile index e62c896170..12ac50f7d5 100644 --- a/erts/Makefile +++ b/erts/Makefile @@ -153,3 +153,5 @@ release_docs: .PHONY: xmllint xmllint: $(MAKE) -C doc/src $@ + +include $(ERL_TOP)/make/app_targets.mk diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 index 0ca2755802..e2b7e1eada 100644 --- a/erts/aclocal.m4 +++ b/erts/aclocal.m4 @@ -2988,7 +2988,7 @@ case $host_os in DED_LDFLAGS="-64 $DED_LDFLAGS" fi ;; - aix4*) + aix*|os400*) DED_LDFLAGS="-G -bnoentry -bexpall" ;; freebsd2*) diff --git a/erts/configure.in b/erts/configure.in index 3a043c940d..e8923d0dcf 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -447,6 +447,12 @@ dnl --------------------------------------------------------------------- dnl NOTE: CPPFLAGS will be included in CFLAGS at the end case $host_os in linux*) CPPFLAGS="$CPPFLAGS -D_GNU_SOURCE";; + aix*|os400*) + # * _ALL_SOURCE: Required to get the winsize structure for TIOCSWINSZ. + # * _LINUX_SOURCE_COMPAT: Not required, but makes some libc functions + # behave closer to glibc assumptions. + CPPFLAGS="$CPPFLAGS -D_ALL_SOURCE -D_LINUX_SOURCE_COMPAT" + ;; win32) # The ethread library requires _WIN32_WINNT of at least 0x0403. # -D_WIN32_WINNT=* from CPPFLAGS is saved in ETHR_DEFS. @@ -966,7 +972,7 @@ AC_SUBST(ERLANG_OSTYPE) AC_MSG_CHECKING(for extra flags needed to export symbols) DEXPORT="" case $host_os in - aix4*) + aix*|os400*) DEXPORT=-Wl,-bexpall,-brtl ;; bsdi*) @@ -1427,7 +1433,7 @@ if test "$have_gethostbyname_r" = yes; then AC_DEFINE(HAVE_GETHOSTBYNAME_R, GHBN_R_SOLARIS, [Define to flavour of gethostbyname_r]) ;; - aix4*) + aix*|os400*) # AIX version also needs "struct hostent_data" defn AC_TRY_COMPILE([#include <netdb.h>], [struct hostent_data hd;], @@ -2036,7 +2042,7 @@ AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlop gethrtime localtime_r gmtime_r inet_pton mprotect \ mmap mremap memcpy mallopt sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time time2posix \ - setlocale nl_langinfo poll mlockall ppoll]) + setlocale nl_langinfo poll mlockall ppoll vsyslog]) AC_MSG_CHECKING([for isfinite]) AC_TRY_LINK([#include <math.h>], diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml index f924c8a70b..0c1100d394 100644 --- a/erts/doc/src/erl_dist_protocol.xml +++ b/erts/doc/src/erl_dist_protocol.xml @@ -109,7 +109,8 @@ <title>Register a Node in EPMD</title> <p>When a distributed node is started it registers itself in the EPMD. The message <c>ALIVE2_REQ</c> described below is sent from the node to - the EPMD. The response from the EPMD is <c>ALIVE2_RESP</c>.</p> + the EPMD. The response from the EPMD is <c>ALIVE2_X_RESP</c> (or + <c>ALIVE2_RESP</c>).</p> <table align="left"> <row> @@ -155,12 +156,12 @@ <tag><c>HighestVersion</c></tag> <item> <p>The highest distribution version that this node can handle. - The value in Erlang/OTP R6B and later is 5.</p> + The value in OTP 23 and later is 6.</p> </item> <tag><c>LowestVersion</c></tag> <item> <p>The lowest distribution version that this node can handle. - The value in Erlang/OTP R6B and later is 5.</p> + The value in OTP 23 and later is 5.</p> </item> <tag><c>Nlen</c></tag> <item> @@ -184,7 +185,24 @@ node is a distributed node. When the connection is closed, the node is automatically unregistered from the EPMD.</p> - <p>The response message <c>ALIVE2_RESP</c> is as follows:</p> + <p>The response message is either <c>ALIVE2_X_RESP</c> or + <c>ALIVE2_RESP</c> depending on distribution version. If both the node + and EPMD support distribution version 6 then response is + <c>ALIVE2_X_RESP</c> otherwise it is the older <c>ALIVE2_RESP</c>:</p> + + <table align="left"> + <row> + <cell align="center">1</cell> + <cell align="center">1</cell> + <cell align="center">4</cell> + </row> + <row> + <cell align="center"><c>118</c></cell> + <cell align="center"><c>Result</c></cell> + <cell align="center"><c>Creation</c></cell> + </row> + <tcaption>ALIVE2_X_RESP (118) with 32 bit creation</tcaption> + </table> <table align="left"> <row> @@ -197,7 +215,7 @@ <cell align="center"><c>Result</c></cell> <cell align="center"><c>Creation</c></cell> </row> - <tcaption>ALIVE2_RESP (121)</tcaption> + <tcaption>ALIVE2_RESP (121) with 16-bit creation</tcaption> </table> <p>Result = 0 -> ok, result > 0 -> error.</p> @@ -793,7 +811,8 @@ DiB == gen_digest(ChA, ICA)? </item> <tag><c>-define(DFLAG_NEW_FUN_TAGS,16#80).</c></tag> <item> - <p>The node understand new fun tags.</p> + <p>The node understands the <seealso marker="erl_ext_dist#NEW_FUN_EXT"> + <c>NEW_FUN_EXT</c></seealso> tag.</p> </item> <tag><c>-define(DFLAG_EXTENDED_PIDS_PORTS,16#100).</c></tag> <item> @@ -802,13 +821,18 @@ DiB == gen_digest(ChA, ICA)? </item> <tag><c>-define(DFLAG_EXPORT_PTR_TAG,16#200).</c></tag> <item> + <p>The node understands the <seealso marker="erl_ext_dist#EXPORT_EXT"> + <c>EXPORT_EXT</c></seealso> tag.</p> </item> <tag><c>-define(DFLAG_BIT_BINARIES,16#400).</c></tag> <item> + <p>The node understands the <seealso marker="erl_ext_dist#BIT_BINARY_EXT"> + <c>BIT_BINARY_EXT</c></seealso> tag.</p> </item> <tag><c>-define(DFLAG_NEW_FLOATS,16#800).</c></tag> <item> - <p>The node understands new float format.</p> + <p>The node understands the <seealso marker="erl_ext_dist#NEW_FLOAT_EXT"> + <c>NEW_FLOAT_EXT</c></seealso> tag.</p> </item> <tag><c>-define(DFLAG_UNICODE_IO,16#1000).</c></tag> <item> @@ -817,21 +841,34 @@ DiB == gen_digest(ChA, ICA)? <item> <p>The node implements atom cache in distribution header.</p> </item> + <marker id="DFLAG_SMALL_ATOM_TAGS"/> <tag><c>-define(DFLAG_SMALL_ATOM_TAGS, 16#4000).</c></tag> <item> - <p>The node understand the <c>SMALL_ATOM_EXT</c> tag.</p> + <p>The node understands the <seealso marker="erl_ext_dist#SMALL_ATOM_EXT"> + <c>SMALL_ATOM_EXT</c></seealso> tag.</p> </item> + <marker id="DFLAG_UTF8_ATOMS"/> <tag><c>-define(DFLAG_UTF8_ATOMS, 16#10000).</c></tag> <item> - <p>The node understand UTF-8 encoded atoms.</p> + <p>The node understands UTF-8 atoms encoded with + <seealso marker="erl_ext_dist#ATOM_UTF8_EXT"> + <c>ATOM_UTF8_EXT</c></seealso> and + <seealso marker="erl_ext_dist#SMALL_ATOM_UTF8_EXT"> + <c>SMALL ATOM_UTF8_EXT</c></seealso>.</p> </item> <tag><c>-define(DFLAG_MAP_TAG, 16#20000).</c></tag> <item> - <p>The node understand the map tag.</p> + <p>The node understands the map tag + <seealso marker="erl_ext_dist#MAP_EXT"><c>MAP_EXT</c></seealso>.</p> </item> + <marker id="DFLAG_BIG_CREATION"/> <tag><c>-define(DFLAG_BIG_CREATION, 16#40000).</c></tag> <item> - <p>The node understand big node creation.</p> + <p>The node understands big node creation tags + <seealso marker="erl_ext_dist#NEW_PID_EXT"><c>NEW_PID_EXT</c></seealso>, + <seealso marker="erl_ext_dist#NEW_PORT_EXT"><c>NEW_PORT_EXT</c></seealso> and + <seealso marker="erl_ext_dist#NEWER_REFERENCE_EXT"><c>NEWER_REFERENCE_EXT</c></seealso>. + </p> </item> <tag><c>-define(DFLAG_SEND_SENDER, 16#80000).</c></tag> <item> @@ -855,6 +892,7 @@ DiB == gen_digest(ChA, ICA)? <seealso marker="#control_message">control message</seealso>s instead of the non-PAYLOAD variants.</p> </item> + <marker id="DFLAG_FRAGMENTS"/> <tag><c>-define(DFLAG_FRAGMENTS, 16#800000).</c></tag> <item> <p>Use <seealso marker="erl_ext_dist#fragments">fragmented</seealso> diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml index 2ba5994557..c5b2ce1a0a 100644 --- a/erts/doc/src/erl_ext_dist.xml +++ b/erts/doc/src/erl_ext_dist.xml @@ -264,7 +264,7 @@ consists of. Length is a 2 byte big-endian integer if flag <c>LongAtoms</c> has been set, otherwise a 1 byte integer. When distribution flag - <seealso marker="erl_dist_protocol#dflags"> + <seealso marker="erl_dist_protocol#DFLAG_UTF8_ATOMS"> <c>DFLAG_UTF8_ATOMS</c></seealso> has been exchanged between both nodes in the <seealso marker="erl_dist_protocol#distribution_handshake"> @@ -316,8 +316,8 @@ </p> <p>Fragmented distribution messages are only used if the receiving node signals that it supports them via the - <seealso marker="erl_dist_protocol#dflags">DFLAG_FRAGMENTS</seealso> distribution - flag.</p> + <seealso marker="erl_dist_protocol#DFLAG_FRAGMENTS">DFLAG_FRAGMENTS</seealso> + distribution flag.</p> <p>A process must complete the sending of a fragmented message before it can start sending any other message on the same distribution channel.</p> @@ -637,11 +637,14 @@ <seealso marker="#NEW_PID_EXT"><c>NEW_PID_EXT</c></seealso>. Port operations are not allowed across node boundaries. </p> - <p>Introduced in OTP 19, but only to be decoded and echoed back. Not - encoded for local ports. Planned to supersede <seealso marker="#PORT_EXT"> - <c>PORT_EXT</c></seealso> in OTP 23 when - <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_BIG_CREATON</c></seealso> - becomes mandatory. + <p><c>NEW_PORT_EXT</c> was introduced in OTP 19, but only to be decoded + and echoed back. Not encoded for local ports. + </p> + <p>In OTP 23 distribution flag + <seealso marker="erl_dist_protocol#DFLAG_BIG_CREATION"><c>DFLAG_BIG_CREATION</c></seealso> + became mandatory. All ports are now + encoded using <c>NEW_PORT_EXT</c>, even external ports received as <seealso + marker="#PORT_EXT"><c>PORT_EXT</c></seealso> from older nodes. </p> </section> @@ -719,11 +722,14 @@ erlang:list_to_pid/1</seealso>).</p> </item> </taglist> - <p>Introduced in OTP 19, but only to be decoded and echoed back. Not - encoded for local processes. Planned to supersede <seealso marker="#PID_EXT"> - <c>PID_EXT</c></seealso> in OTP 23 when - <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_BIG_CREATON</c></seealso> - becomes mandatory. + <p><c>NEW_PID_EXT</c> was introduced in OTP 19, but only to be decoded + and echoed back. Not encoded for local processes. + </p> + <p>In OTP 23 distribution flag + <seealso marker="erl_dist_protocol#DFLAG_BIG_CREATION"><c>DFLAG_BIG_CREATION</c></seealso> + became mandatory. All pids are now encoded using <c>NEW_PID_EXT</c>, + even external pids received as + <seealso marker="#PID_EXT"><c>PID_EXT</c></seealso> from older nodes. </p> </section> @@ -1047,11 +1053,15 @@ <seealso marker="#NEW_PID_EXT"><c>NEW_PID_EXT</c></seealso>.</p> </item> </taglist> - <p>Introduced in OTP 19, but only to be decoded and echoed back. Not - encoded for local references. Planned to supersede <seealso marker="#NEW_REFERENCE_EXT"> - <c>NEW_REFERENCE_EXT</c></seealso> in OTP 23 when - <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_BIG_CREATON</c></seealso> - becomes mandatory. + <p><c>NEWER_REFERENCE_EXT</c> was introduced in OTP 19, but only to be decoded + and echoed back. Not encoded for local references. + </p> + <p>In OTP 23 distribution flag + <seealso marker="erl_dist_protocol#DFLAG_BIG_CREATION"><c>DFLAG_BIG_CREATION</c></seealso> + became mandatory. All references are now encoded using + <c>NEWER_REFERENCE_EXT</c>, even external references received as + <seealso marker="#NEW_REFERENCE_EXT"><c>NEW_REFERENCE_EXT</c></seealso> + from older nodes. </p> </section> @@ -1408,7 +1418,7 @@ <p> <c>SMALL_ATOM_EXT</c> was introduced in ERTS 5.7.2 and require an exchange of distribution flag - <seealso marker="erl_dist_protocol#dflags"> + <seealso marker="erl_dist_protocol#DFLAG_SMALL_ATOM_TAGS"> <c>DFLAG_SMALL_ATOM_TAGS</c></seealso> in the <seealso marker="erl_dist_protocol#distribution_handshake"> distribution handshake</seealso>. diff --git a/erts/doc/src/erl_ext_fig.gif b/erts/doc/src/erl_ext_fig.gif Binary files differindex 14d6bbc871..40dd17bd5e 100644 --- a/erts/doc/src/erl_ext_fig.gif +++ b/erts/doc/src/erl_ext_fig.gif diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index ba5ba8abef..a8b1728b90 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -1290,3 +1290,5 @@ ifndef VOID_EMULATOR endif endif endif + +include $(ERL_TOP)/make/app_targets.mk diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 35f2ea6688..3d5683f19f 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -315,6 +315,7 @@ typedef struct LoaderState { * (or 0 if there is no on_load function) */ int otp_20_or_higher; /* Compiled with OTP 20 or higher */ + unsigned max_opcode; /* Highest opcode used in module */ /* * Atom table. @@ -1588,6 +1589,17 @@ static int read_lambda_table(LoaderState* stp) { unsigned int i; + unsigned int otp_22_or_lower; + + /* + * Determine whether this module was compiled with OTP 22 or lower + * by looking at the max opcode number. The compiler in OTP 23 will + * always set the max opcode to the opcode for `swap` (whether + * actually used or not) so that a module compiled for OTP 23 + * cannot be loaded in earlier versions. + */ + + otp_22_or_lower = stp->max_opcode < genop_swap_2; GetInt(stp, 4, stp->num_lambdas); if (stp->num_lambdas > stp->lambdas_allocated) { @@ -1619,6 +1631,29 @@ read_lambda_table(LoaderState* stp) GetInt(stp, 4, Index); GetInt(stp, 4, stp->lambdas[i].num_free); GetInt(stp, 4, OldUniq); + + /* + * Fun entries are now keyed by the explicit ("new") index in + * the fun entry. That allows multiple make_fun2 instructions + * to share the same fun entry (when the `fun F/A` syntax is + * used). Before OTP 23, fun entries were keyed by the old + * index, which is the order of the entries in the fun + * chunk. Each make_fun2 needed to refer to its own fun entry. + * + * Modules compiled before OTP 23 can safely be loaded if the + * old index and the new index are equal. That is true for all + * modules compiled with OTP R15 and later. + */ + if (otp_22_or_lower && i != Index) { + /* + * Compiled with a compiler before OTP R15B. The new indices + * are not reliable, so it is not safe to load this module. + */ + LoadError2(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler " + "(old-style fun with indices: %d/%d)", + i, Index); + } fe = erts_put_fun_entry2(stp->module, OldUniq, i, stp->mod_md5, Index, arity-stp->lambdas[i].num_free); stp->lambdas[i].fe = fe; @@ -1839,7 +1874,6 @@ read_code_header(LoaderState* stp) { unsigned head_size; unsigned version; - unsigned opcode_max; int i; /* @@ -1871,8 +1905,8 @@ read_code_header(LoaderState* stp) /* * Verify the number of the highest opcode used. */ - GetInt(stp, 4, opcode_max); - if (opcode_max > MAX_GENERIC_OPCODE) { + GetInt(stp, 4, stp->max_opcode); + if (stp->max_opcode > MAX_GENERIC_OPCODE) { LoadError2(stp, "This BEAM file was compiled for a later version" " of the run-time system than " ERLANG_OTP_RELEASE ".\n" @@ -1880,7 +1914,7 @@ read_code_header(LoaderState* stp) ERLANG_OTP_RELEASE " compiler.\n" " (Use of opcode %d; this emulator supports " "only up to %d.)", - opcode_max, MAX_GENERIC_OPCODE); + stp->max_opcode, MAX_GENERIC_OPCODE); } GetInt(stp, 4, stp->num_labels); @@ -3131,27 +3165,6 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) return 0; } -static int -is_killed_apply(LoaderState* stp, GenOpArg Reg, GenOpArg Live) -{ - return Reg.type == TAG_x && Live.type == TAG_u && - Live.val+2 <= Reg.val; -} - -static int -is_killed(LoaderState* stp, GenOpArg Reg, GenOpArg Live) -{ - return Reg.type == TAG_x && Live.type == TAG_u && - Live.val <= Reg.val; -} - -static int -is_killed_by_call_fun(LoaderState* stp, GenOpArg Reg, GenOpArg Live) -{ - return Reg.type == TAG_x && Live.type == TAG_u && - Live.val+1 <= Reg.val; -} - /* * Test whether register Reg is killed by make_fun instruction that * creates the fun given by index idx. @@ -3172,16 +3185,6 @@ is_killed_by_make_fun(LoaderState* stp, GenOpArg Reg, GenOpArg idx) } /* - * Test whether register Reg is killed by the send instruction that follows. - */ - -static int -is_killed_by_send(LoaderState* stp, GenOpArg Reg) -{ - return Reg.type == TAG_x && 2 <= Reg.val; -} - -/* * Generate an instruction for element/2. */ diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index b81056c774..9f67f46b31 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -1915,7 +1915,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp, erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " - "incarnation (%d) of this node (%d)\n", + "incarnation (%u) of this node (%u)\n", msg, p->common.id, to, @@ -1959,7 +1959,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp, erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); erts_dsprintf(dsbufp, "Discarding message %T from %T to %T in an old " - "incarnation (%d) of this node (%d)\n", + "incarnation (%u) of this node (%u)\n", msg, p->common.id, to, @@ -1987,7 +1987,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp, trace_send(p, portid, msg); if (have_seqtrace(SEQ_TRACE_TOKEN(p))) { - seq_trace_update_send(p); + seq_trace_update_serial(p); seq_trace_output(SEQ_TRACE_TOKEN(p), msg, SEQ_TRACE_SEND, portid, p); } @@ -4866,9 +4866,13 @@ BIF_RETTYPE phash_2(BIF_ALIST_2) BIF_RETTYPE phash2_1(BIF_ALIST_1) { Uint32 hash; - - hash = make_hash2(BIF_ARG_1); - BIF_RET(make_small(hash & ((1L << 27) - 1))); + Eterm trap_state = THE_NON_VALUE; + hash = trapping_make_hash2(BIF_ARG_1, &trap_state, BIF_P); + if (trap_state == THE_NON_VALUE) { + BIF_RET(make_small(hash & ((1L << 27) - 1))); + } else { + BIF_TRAP1(bif_export[BIF_phash2_1], BIF_P, trap_state); + } } BIF_RETTYPE phash2_2(BIF_ALIST_2) @@ -4876,6 +4880,7 @@ BIF_RETTYPE phash2_2(BIF_ALIST_2) Uint32 hash; Uint32 final_hash; Uint32 range; + Eterm trap_state = THE_NON_VALUE; /* Check for special case 2^32 */ if (term_equals_2pow32(BIF_ARG_2)) { @@ -4887,7 +4892,10 @@ BIF_RETTYPE phash2_2(BIF_ALIST_2) } range = (Uint32) u; } - hash = make_hash2(BIF_ARG_1); + hash = trapping_make_hash2(BIF_ARG_1, &trap_state, BIF_P); + if (trap_state != THE_NON_VALUE) { + BIF_TRAP2(bif_export[BIF_phash2_2], BIF_P, trap_state, BIF_ARG_2); + } if (range) { final_hash = hash % range; /* [0..range-1] */ } else { diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c index 522f50287a..7666f23a4f 100644 --- a/erts/emulator/beam/big.c +++ b/erts/emulator/beam/big.c @@ -2176,6 +2176,24 @@ term_to_Uint64(Eterm term, Uint64 *up) #endif } +int +term_to_Uint32(Eterm term, Uint32 *up) +{ +#if ERTS_SIZEOF_ETERM == 4 + return term_to_Uint(term,up); +#else + if (is_small(term)) { + Sint i = signed_val(term); + if (i >= 0) { + *up = (Uint32) i; + return 1; + } + } + *up = BADARG; + return 0; +#endif +} + int term_to_Sint(Eterm term, Sint *sp) { diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h index ad19cce395..3fed076419 100644 --- a/erts/emulator/beam/big.h +++ b/erts/emulator/beam/big.h @@ -168,6 +168,8 @@ Eterm erts_uint64_array_to_big(Uint **, int, int, Uint64 *); int term_to_Uint64(Eterm, Uint64*); int term_to_Sint64(Eterm, Sint64*); #endif +int term_to_Uint32(Eterm, Uint32*); + Uint32 big_to_uint32(Eterm b); int term_equals_2pow32(Eterm); diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index eb9e749a08..dafe805a6f 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -1051,7 +1051,7 @@ erts_dsig_send_msg(ErtsDSigSendContext* ctx, Eterm remote, Eterm message) #endif if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { - seq_trace_update_send(sender); + seq_trace_update_serial(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender); } @@ -1125,7 +1125,7 @@ erts_dsig_send_reg_msg(ErtsDSigSendContext* ctx, Eterm remote_name, Eterm messag #endif if (have_seqtrace(SEQ_TRACE_TOKEN(sender))) { - seq_trace_update_send(sender); + seq_trace_update_serial(sender); token = SEQ_TRACE_TOKEN(sender); seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender); } @@ -1184,7 +1184,7 @@ erts_dsig_send_exit_tt(ErtsDSigSendContext *ctx, Eterm local, Eterm remote, msg = reason; if (have_seqtrace(token)) { - seq_trace_update_send(ctx->c_p); + seq_trace_update_serial(ctx->c_p); seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local); if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) { ctl = TUPLE4(&ctx->ctl_heap[0], @@ -3762,12 +3762,10 @@ int distribution_info(fmtfn_t to, void *arg) /* Called by break handler */ BIF_RETTYPE setnode_2(BIF_ALIST_2) { Process *net_kernel; - Uint creation; + Uint32 creation; /* valid creation ? */ - if(!term_to_Uint(BIF_ARG_2, &creation)) - goto error; - if(creation > 3) + if(!term_to_Uint32(BIF_ARG_2, &creation)) goto error; /* valid node name ? */ @@ -3811,7 +3809,7 @@ BIF_RETTYPE setnode_2(BIF_ALIST_2) erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); erts_thr_progress_block(); inc_no_nodes(); - erts_set_this_node(BIF_ARG_1, (Uint32) creation); + erts_set_this_node(BIF_ARG_1, creation); erts_is_alive = 1; send_nodes_mon_msgs(NULL, am_nodeup, BIF_ARG_1, am_visible, NIL); erts_thr_progress_unblock(); diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index a33fb7efcf..37ec88cc55 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -54,11 +54,12 @@ #define DFLAG_DIST_MANDATORY (DFLAG_EXTENDED_REFERENCES \ | DFLAG_EXTENDED_PIDS_PORTS \ | DFLAG_UTF8_ATOMS \ - | DFLAG_NEW_FUN_TAGS) + | DFLAG_NEW_FUN_TAGS \ + | DFLAG_BIG_CREATION) /* * Additional optimistic flags when encoding toward pending connection. - * If remote node (erl_interface) does not supporting these then we may need + * If remote node (erl_interface) does not support these then we may need * to transcode messages enqueued before connection setup was finished. */ #define DFLAG_DIST_HOPEFULLY (DFLAG_EXPORT_PTR_TAG \ @@ -75,7 +76,6 @@ | DFLAG_SMALL_ATOM_TAGS \ | DFLAG_UTF8_ATOMS \ | DFLAG_MAP_TAG \ - | DFLAG_BIG_CREATION \ | DFLAG_SEND_SENDER \ | DFLAG_BIG_SEQTRACE_LABELS \ | DFLAG_EXIT_PAYLOAD \ diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types index 21941ba96e..349977ebe7 100644 --- a/erts/emulator/beam/erl_alloc.types +++ b/erts/emulator/beam/erl_alloc.types @@ -278,6 +278,7 @@ type SETUP_CONN_ARG SHORT_LIVED PROCESSES setup_connection_argument type LIST_TRAP SHORT_LIVED PROCESSES list_bif_trap_state type CONT_EXIT_TRAP SHORT_LIVED PROCESSES continue_exit_trap_state type SEQ_YIELD_STATE SHORT_LIVED SYSTEM dist_seq_yield_state +type PHASH2_TRAP SHORT_LIVED PROCESSES phash2_trap_state type ENVIRONMENT SYSTEM SYSTEM environment diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 0339589b79..aa55bdab6a 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2799,7 +2799,10 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) } else if (BIF_ARG_1 == am_threads) { return am_true; } else if (BIF_ARG_1 == am_creation) { - return make_small(erts_this_node->creation); + Uint hsz = 0; + erts_bld_uint(NULL, &hsz, erts_this_node->creation); + hp = hsz ? HAlloc(BIF_P, hsz) : NULL; + BIF_RET(erts_bld_uint(&hp, NULL, erts_this_node->creation)); } else if (BIF_ARG_1 == am_break_ignored) { extern int ignore_break; if (ignore_break) diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index b31d5b86cb..80ba7d1b3c 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -1858,6 +1858,8 @@ Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2, if (arg1 == am_send) { current_flag = SEQ_TRACE_SEND; + } else if (arg1 == am_spawn) { + current_flag = SEQ_TRACE_SPAWN; } else if (arg1 == am_receive) { current_flag = SEQ_TRACE_RECEIVE; } else if (arg1 == am_print) { @@ -1976,8 +1978,9 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) } if (have_no_seqtrace(SEQ_TRACE_TOKEN(p))) { - if ((item == am_send) || (item == am_receive) || - (item == am_print) || (item == am_timestamp) + if ((item == am_send) || (item == am_spawn) || + (item == am_receive) || (item == am_print) + || (item == am_timestamp) || (item == am_monotonic_timestamp) || (item == am_strict_monotonic_timestamp)) { hp = HAlloc(p,3); @@ -1992,6 +1995,8 @@ BIF_RETTYPE erl_seq_trace_info(Process *p, Eterm item) if (item == am_send) { current_flag = SEQ_TRACE_SEND; + } else if (item == am_spawn) { + current_flag = SEQ_TRACE_SPAWN; } else if (item == am_receive) { current_flag = SEQ_TRACE_RECEIVE; } else if (item == am_print) { @@ -2041,7 +2046,7 @@ BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) if (have_no_seqtrace(SEQ_TRACE_TOKEN(BIF_P))) { BIF_RET(am_false); } - seq_trace_update_send(BIF_P); + seq_trace_update_serial(BIF_P); seq_trace_output(SEQ_TRACE_TOKEN(BIF_P), BIF_ARG_1, SEQ_TRACE_PRINT, NIL, BIF_P); BIF_RET(am_true); @@ -2062,7 +2067,7 @@ BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2) } if (!EQ(BIF_ARG_1, SEQ_TRACE_TOKEN_LABEL(BIF_P))) BIF_RET(am_false); - seq_trace_update_send(BIF_P); + seq_trace_update_serial(BIF_P); seq_trace_output(SEQ_TRACE_TOKEN(BIF_P), BIF_ARG_2, SEQ_TRACE_PRINT, NIL, BIF_P); BIF_RET(am_true); diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c index 4904d3fa42..44ecf7cce5 100644 --- a/erts/emulator/beam/erl_db_hash.c +++ b/erts/emulator/beam/erl_db_hash.c @@ -93,11 +93,9 @@ erts_flxctr_dec_read_centralized(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) #define RESET_NITEMS(DB) \ erts_flxctr_reset(&(DB)->common.counters, ERTS_DB_TABLE_NITEMS_COUNTER_ID) -/* - * The following symbols can be manipulated to "tune" the linear hash array - */ + #define GROW_LIMIT(NACTIVE) ((NACTIVE)*1) -#define SHRINK_LIMIT(NACTIVE) ((NACTIVE) / 2) +#define SHRINK_LIMIT(TB) erts_atomic_read_nob(&(TB)->shrink_limit) /* ** We want the first mandatory segment to be small (to reduce minimal footprint) @@ -137,6 +135,11 @@ #define BUCKET(tb, i) SEGTAB(tb)[SLOT_IX_TO_SEG_IX(i)]->buckets[(i) & EXT_SEGSZ_MASK] +#ifdef DEBUG +# define DBG_BUCKET_INACTIVE ((HashDbTerm*)0xdead5107) +#endif + + /* * When deleting a table, the number of records to delete. * Approximate number, because we must delete entire buckets. @@ -377,7 +380,7 @@ typedef int (*extra_match_validator_t)(int keypos, Eterm match, Eterm guard, Ete */ static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix); static void alloc_seg(DbTableHash *tb); -static int free_seg(DbTableHash *tb, int free_records); +static int free_seg(DbTableHash *tb); static HashDbTerm* next_live(DbTableHash *tb, Uint *iptr, erts_rwmtx_t** lck_ptr, HashDbTerm *list); static HashDbTerm* search_list(DbTableHash* tb, Eterm key, @@ -471,10 +474,8 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle); static ERTS_INLINE void try_shrink(DbTableHash* tb) { - int nactive = NACTIVE(tb); int nitems = NITEMS(tb); - if (nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive) - && !IS_FIXED(tb)) { + if (nitems < SHRINK_LIMIT(tb) && !IS_FIXED(tb)) { shrink(tb, nitems); } } @@ -685,6 +686,7 @@ int db_create_hash(Process *p, DbTable *tbl) erts_atomic_init_nob(&tb->szm, FIRST_SEGSZ_MASK); erts_atomic_init_nob(&tb->nactive, FIRST_SEGSZ); + erts_atomic_init_nob(&tb->shrink_limit, 0); erts_atomic_init_nob(&tb->fixdel, (erts_aint_t)NULL); erts_atomic_init_nob(&tb->segtab, (erts_aint_t)NULL); SET_SEGTAB(tb, tb->first_segtab); @@ -771,7 +773,7 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) b = next_live(tb, &ix, &lck, b->next); if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { while (b != 0) { - if (!has_live_key(tb, b, key, hval)) { + if (!has_key(tb, b, key, hval)) { break; } b = next_live(tb, &ix, &lck, b->next); @@ -781,6 +783,7 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) *ret = am_EOT; } else { + ASSERT(!is_pseudo_deleted(b)); *ret = db_copy_key(p, tbl, &b->dbterm); RUNLOCK_HASH(lck); } @@ -2466,7 +2469,7 @@ static SWord db_free_table_continue_hash(DbTable *tbl, SWord reds) erts_atomic_set_relb(&tb->fixdel, (erts_aint_t)NULL); while(tb->nslots != 0) { - reds -= EXT_SEGSZ/64 + free_seg(tb, 1); + reds -= EXT_SEGSZ/64 + free_seg(tb); /* * If we have done enough work, get out here. @@ -2664,6 +2667,34 @@ static struct ext_segtab* alloc_ext_segtab(DbTableHash* tb, unsigned seg_ix) return est; } +static void calc_shrink_limit(DbTableHash* tb) +{ + erts_aint_t shrink_limit; + + if (tb->nslots >= (FIRST_SEGSZ + 2*EXT_SEGSZ)) { + /* + * Start shrink when we can remove one extra segment + * and still remain below 50% load. + */ + shrink_limit = (tb->nslots - EXT_SEGSZ) / 2; + } + else { + /* + * But don't shrink below two segments. + * Why? In order to have chance of getting rid of the last extra segment, + * and rehash it into the first small segment, we either have to start + * early and do speculative joining of buckets or we have to join a lot + * of buckets during each delete-op. + * + * Instead keep segment #2 once allocated. I also think it's a good bet + * a shrinking large table will grow large again. + */ + shrink_limit = 0; + } + erts_atomic_set_nob(&tb->shrink_limit, shrink_limit); +} + + /* Extend table with one new segment */ static void alloc_seg(DbTableHash *tb) @@ -2682,8 +2713,17 @@ static void alloc_seg(DbTableHash *tb) segtab[seg_ix] = (struct segment*) erts_db_alloc(ERTS_ALC_T_DB_SEG, (DbTable *) tb, SIZEOF_SEGMENT(EXT_SEGSZ)); - sys_memset(segtab[seg_ix], 0, SIZEOF_SEGMENT(EXT_SEGSZ)); +#ifdef DEBUG + { + int i; + for (i = 0; i < EXT_SEGSZ; i++) { + segtab[seg_ix]->buckets[i] = DBG_BUCKET_INACTIVE; + } + } +#endif tb->nslots += EXT_SEGSZ; + + calc_shrink_limit(tb); } static void dealloc_ext_segtab(void* lop_data) @@ -2693,10 +2733,19 @@ static void dealloc_ext_segtab(void* lop_data) erts_free(ERTS_ALC_T_DB_SEG, est); } -/* Shrink table by freeing the top segment +struct dealloc_seg_ops { + struct segment* segp; + Uint seg_sz; + + struct ext_segtab* est; +}; + +/* Shrink table by removing the top segment ** free_records: 1=free any records in segment, 0=assume segment is empty +** ds_ops: (out) Instructions for dealloc_seg(). */ -static int free_seg(DbTableHash *tb, int free_records) +static int remove_seg(DbTableHash *tb, int free_records, + struct dealloc_seg_ops *ds_ops) { const int seg_ix = SLOT_IX_TO_SEG_IX(tb->nslots) - 1; struct segment** const segtab = SEGTAB(tb); @@ -2704,24 +2753,47 @@ static int free_seg(DbTableHash *tb, int free_records) Uint seg_sz; int nrecords = 0; + ERTS_LC_ASSERT(IS_TAB_WLOCKED(tb) || tb->common.status & DB_DELETE + || erts_atomic_read_nob(&tb->is_resizing)); + ASSERT(segp != NULL); -#ifndef DEBUG - if (free_records) -#endif - { - int i = (seg_ix == 0) ? FIRST_SEGSZ : EXT_SEGSZ; - while (i--) { - HashDbTerm* p = segp->buckets[i]; + if (free_records) { + int ix, n; + if (seg_ix == 0) { + /* First segment (always fully active) */ + n = FIRST_SEGSZ; + ix = FIRST_SEGSZ-1; + } + else if (NACTIVE(tb) < tb->nslots) { + /* Last extended segment partially active */ + n = (NACTIVE(tb) - FIRST_SEGSZ) & EXT_SEGSZ_MASK; + ix = (NACTIVE(tb)-1) & EXT_SEGSZ_MASK; + } + else { + /* Full extended segment */ + n = EXT_SEGSZ; + ix = EXT_SEGSZ - 1; + } + for ( ; n > 0; n--, ix--) { + HashDbTerm* p = segp->buckets[ix & EXT_SEGSZ_MASK]; while(p != 0) { HashDbTerm* nxt = p->next; - ASSERT(free_records); /* segment not empty as assumed? */ free_term(tb, p); p = nxt; ++nrecords; } } } - +#ifdef DEBUG + else { + int ix = (seg_ix == 0) ? FIRST_SEGSZ-1 : EXT_SEGSZ-1; + for ( ; ix >= 0; ix--) { + ASSERT(segp->buckets[ix] == DBG_BUCKET_INACTIVE); + } + } +#endif + + ds_ops->est = NULL; if (seg_ix >= NSEG_1) { struct ext_segtab* est = ErtsContainerStruct_(segtab,struct ext_segtab,segtab); @@ -2730,35 +2802,64 @@ static int free_seg(DbTableHash *tb, int free_records) SET_SEGTAB(tb, est->prev_segtab); tb->nsegs = est->prev_nsegs; - if (!tb->common.is_thread_safe) { - /* - * Table is doing a graceful shrink operation and we must avoid - * deallocating this segtab while it may still be read by other - * threads. Schedule deallocation with thread progress to make - * sure no lingering threads are still hanging in BUCKET macro - * with an old segtab pointer. - */ - erts_schedule_db_free(&tb->common, dealloc_ext_segtab, - est, &est->lop, - SIZEOF_EXT_SEGTAB(est->nsegs)); - } - else - erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable*)tb, est, - SIZEOF_EXT_SEGTAB(est->nsegs)); + ds_ops->est = est; } } + seg_sz = (seg_ix == 0) ? FIRST_SEGSZ : EXT_SEGSZ; - erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable *)tb, segp, SIZEOF_SEGMENT(seg_sz)); + tb->nslots -= seg_sz; + ASSERT(tb->nslots >= 0); + + ds_ops->segp = segp; + ds_ops->seg_sz = seg_sz; #ifdef DEBUG if (seg_ix < tb->nsegs) SEGTAB(tb)[seg_ix] = NULL; #endif - tb->nslots -= seg_sz; - ASSERT(tb->nslots >= 0); + calc_shrink_limit(tb); return nrecords; } +/* + * Deallocate segment removed by remove_seg() + */ +static void dealloc_seg(DbTableHash *tb, struct dealloc_seg_ops* ds_ops) +{ + struct ext_segtab* est = ds_ops->est; + + if (est) { + if (!tb->common.is_thread_safe) { + /* + * Table is doing a graceful shrink operation and we must avoid + * deallocating this segtab while it may still be read by other + * threads. Schedule deallocation with thread progress to make + * sure no lingering threads are still hanging in BUCKET macro + * with an old segtab pointer. + */ + erts_schedule_db_free(&tb->common, dealloc_ext_segtab, + est, &est->lop, + SIZEOF_EXT_SEGTAB(est->nsegs)); + } + else + erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable*)tb, est, + SIZEOF_EXT_SEGTAB(est->nsegs)); + } + + erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable *)tb, + ds_ops->segp, SIZEOF_SEGMENT(ds_ops->seg_sz)); +} + +/* Remove and deallocate top segment and all its contained objects */ +static int free_seg(DbTableHash *tb) +{ + struct dealloc_seg_ops ds_ops; + int reds; + + reds = remove_seg(tb, 1, &ds_ops); + dealloc_seg(tb, &ds_ops); + return reds; +} /* ** Copy terms from ptr1 until ptr2 @@ -2880,6 +2981,7 @@ static void grow(DbTableHash* tb, int nitems) pnext = &BUCKET(tb, from_ix); p = *pnext; to_pnext = &BUCKET(tb, to_ix); + ASSERT(*to_pnext == DBG_BUCKET_INACTIVE); while (p != NULL) { if (is_pseudo_deleted(p)) { /* rare but possible with fine locking */ *pnext = p->next; @@ -2916,19 +3018,21 @@ abort: */ static void shrink(DbTableHash* tb, int nitems) { - HashDbTerm** src_bp; - HashDbTerm** dst_bp; + struct dealloc_seg_ops ds_ops; + HashDbTerm* src; + HashDbTerm* tail; HashDbTerm** bp; erts_rwmtx_t* lck; int src_ix, dst_ix, low_szm; int nactive; int loop_limit = 5; + ds_ops.segp = NULL; do { if (!begin_resizing(tb)) return; /* already in progress */ nactive = NACTIVE(tb); - if (!(nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive))) { + if (!(nitems < SHRINK_LIMIT(tb))) { goto abort; /* already done (race) */ } src_ix = nactive - 1; @@ -2945,41 +3049,49 @@ static void shrink(DbTableHash* tb, int nitems) goto abort; } - src_bp = &BUCKET(tb, src_ix); - dst_bp = &BUCKET(tb, dst_ix); - bp = src_bp; - - /* - * We join lists by appending "dst" at the end of "src" - * as we must step through "src" anyway to purge pseudo deleted. - */ - while(*bp != NULL) { - if (is_pseudo_deleted(*bp)) { - HashDbTerm* deleted = *bp; - *bp = deleted->next; - free_term(tb, deleted); - } else { - bp = &(*bp)->next; - } - } - *bp = *dst_bp; - *dst_bp = *src_bp; - *src_bp = NULL; - + src = BUCKET(tb, src_ix); +#ifdef DEBUG + BUCKET(tb, src_ix) = DBG_BUCKET_INACTIVE; +#endif nactive = src_ix; erts_atomic_set_nob(&tb->nactive, nactive); if (dst_ix == 0) { erts_atomic_set_relb(&tb->szm, low_szm); } - WUNLOCK_HASH(lck); - if (tb->nslots - src_ix >= EXT_SEGSZ) { - free_seg(tb, 0); + remove_seg(tb, 0, &ds_ops); } done_resizing(tb); - } while (--loop_limit - && nactive > FIRST_SEGSZ && nitems < SHRINK_LIMIT(nactive)); + if (src) { + /* + * We join buckets by appending "dst" list at the end of "src" list + * as we must step through "src" anyway to purge pseudo deleted. + */ + bp = &BUCKET(tb, dst_ix); + tail = *bp; + *bp = src; + + while(*bp != NULL) { + if (is_pseudo_deleted(*bp)) { + HashDbTerm* deleted = *bp; + *bp = deleted->next; + free_term(tb, deleted); + } else { + bp = &(*bp)->next; + } + } + *bp = tail; + } + + WUNLOCK_HASH(lck); + + if (ds_ops.segp) { + dealloc_seg(tb, &ds_ops); + ds_ops.segp = NULL; + } + + } while (--loop_limit && nitems < SHRINK_LIMIT(tb)); return; abort: diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h index 9759d8b466..b26b82056f 100644 --- a/erts/emulator/beam/erl_db_hash.h +++ b/erts/emulator/beam/erl_db_hash.h @@ -63,9 +63,10 @@ typedef struct db_table_hash_fine_locks { typedef struct db_table_hash { DbTableCommon common; - /* SMP: szm and nactive are write-protected by is_resizing or table write lock */ + /* szm, nactive, shrink_limit are write-protected by is_resizing or table write lock */ erts_atomic_t szm; /* current size mask. */ erts_atomic_t nactive; /* Number of "active" slots */ + erts_atomic_t shrink_limit; /* Shrink table when fewer objects than this */ erts_atomic_t segtab; /* The segment table (struct segment**) */ struct segment* first_segtab[1]; diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c index 9c866250bb..257f9bf5b3 100644 --- a/erts/emulator/beam/erl_fun.c +++ b/erts/emulator/beam/erl_fun.c @@ -100,27 +100,6 @@ int erts_fun_table_sz(void) } ErlFunEntry* -erts_put_fun_entry(Eterm mod, int uniq, int index) -{ - ErlFunEntry template; - ErlFunEntry* fe; - erts_aint_t refc; - ASSERT(is_atom(mod)); - template.old_uniq = uniq; - template.old_index = index; - template.module = mod; - erts_fun_write_lock(); - fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template); - sys_memset(fe->uniq, 0, sizeof(fe->uniq)); - fe->index = 0; - refc = erts_refc_inctest(&fe->refc, 0); - if (refc < 2) /* New or pending delete */ - erts_refc_inc(&fe->refc, 1); - erts_fun_write_unlock(); - return fe; -} - -ErlFunEntry* erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, byte* uniq, int index, int arity) { @@ -130,12 +109,12 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, ASSERT(is_atom(mod)); template.old_uniq = old_uniq; - template.old_index = old_index; + template.index = index; template.module = mod; erts_fun_write_lock(); fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template); sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq)); - fe->index = index; + fe->old_index = old_index; fe->arity = arity; refc = erts_refc_inctest(&fe->refc, 0); if (refc < 2) /* New or pending delete */ @@ -144,13 +123,6 @@ erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, return fe; } -struct my_key { - Eterm mod; - byte* uniq; - int index; - ErlFunEntry* fe; -}; - ErlFunEntry* erts_get_fun_entry(Eterm mod, int uniq, int index) { @@ -159,7 +131,7 @@ erts_get_fun_entry(Eterm mod, int uniq, int index) ASSERT(is_atom(mod)); template.old_uniq = uniq; - template.old_index = index; + template.index = index; template.module = mod; erts_fun_read_lock(); ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template); @@ -315,15 +287,27 @@ erts_dump_fun_entries(fmtfn_t to, void *to_arg) static HashValue fun_hash(ErlFunEntry* obj) { - return (HashValue) (obj->old_uniq ^ obj->old_index ^ atom_val(obj->module)); + return (HashValue) (obj->old_uniq ^ obj->index ^ atom_val(obj->module)); } static int fun_cmp(ErlFunEntry* obj1, ErlFunEntry* obj2) { - return !(obj1->module == obj2->module && + /* + * OTP 23: Use 'index' (instead of 'old_index') when comparing fun + * entries. In OTP 23, multiple make_fun2 instructions may refer to the + * the same 'index' (for the wrapper function generated for the + * 'fun F/A' syntax). + * + * This is safe when loading code compiled with OTP R15 and later, + * because since R15 (2011), the 'index' has been reliably equal + * to 'old_index'. The loader refuses to load modules compiled before + * OTP R15. + */ + + return !(obj1->module == obj2->module && obj1->old_uniq == obj2->old_uniq && - obj1->old_index == obj2->old_index); + obj1->index == obj2->index); } static ErlFunEntry* @@ -333,7 +317,7 @@ fun_alloc(ErlFunEntry* template) sizeof(ErlFunEntry)); obj->old_uniq = template->old_uniq; - obj->old_index = template->old_index; + obj->index = template->index; obj->module = template->module; erts_refc_init(&obj->refc, -1); obj->address = unloaded_fun; diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h index fb2901d866..eefc7a95bb 100644 --- a/erts/emulator/beam/erl_fun.h +++ b/erts/emulator/beam/erl_fun.h @@ -74,7 +74,6 @@ void erts_init_fun_table(void); void erts_fun_info(fmtfn_t, void *); int erts_fun_table_sz(void); -ErlFunEntry* erts_put_fun_entry(Eterm mod, int uniq, int index); ErlFunEntry* erts_get_fun_entry(Eterm mod, int uniq, int index); ErlFunEntry* erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 1bebf6efe2..42a07a59d6 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -674,7 +674,7 @@ erts_send_message(Process* sender, * Make sure we don't use the heap between those instances. */ if (have_seqtrace(stoken)) { - seq_trace_update_send(sender); + seq_trace_update_serial(sender); seq_trace_output(stoken, message, SEQ_TRACE_SEND, receiver->common.id, sender); diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 1fbe362330..ce43cb9e71 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -815,7 +815,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid, } #endif if (have_seqtrace(stoken)) { - seq_trace_update_send(c_p); + seq_trace_update_serial(c_p); seq_trace_output(stoken, msg, SEQ_TRACE_SEND, rp->common.id, c_p); } diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 50e9812534..285252a53e 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -977,7 +977,7 @@ static void print_node(void *venp, void *vpndp) if(pndp->sysname == NIL) { erts_print(pndp->to, pndp->to_arg, "Name: %T ", enp->sysname); } - erts_print(pndp->to, pndp->to_arg, " %d", enp->creation); + erts_print(pndp->to, pndp->to_arg, " %u", enp->creation); #ifdef DEBUG erts_print(pndp->to, pndp->to_arg, " (refc=%ld)", erts_refc_read(&enp->refc, 0)); @@ -1020,7 +1020,7 @@ void erts_print_node_info(fmtfn_t to, /* ----------------------------------------------------------------------- */ void -erts_set_this_node(Eterm sysname, Uint creation) +erts_set_this_node(Eterm sysname, Uint32 creation) { ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); ASSERT(2 <= de_refc_read(erts_this_dist_entry, 2)); diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index ffaafbbbea..beae2df75f 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -264,7 +264,7 @@ void erts_set_dist_entry_pending(DistEntry *); void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); ErlNode *erts_find_or_insert_node(Eterm, Uint32, Eterm); void erts_schedule_delete_node(ErlNode *); -void erts_set_this_node(Eterm, Uint); +void erts_set_this_node(Eterm, Uint32); Uint erts_node_table_size(void); void erts_init_node_tables(int); void erts_node_table_info(fmtfn_t, void *); diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c index d5e0e3b218..b60fb64342 100644 --- a/erts/emulator/beam/erl_proc_sig_queue.c +++ b/erts/emulator/beam/erl_proc_sig_queue.c @@ -995,7 +995,7 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag, seq_trace = c_p && have_seqtrace(token); if (seq_trace) - seq_trace_update_send(c_p); + seq_trace_update_serial(c_p); #ifdef USE_VM_PROBES utag_sz = 0; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 1c1ef1db84..e8c83276f5 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -10992,8 +10992,13 @@ erts_set_gc_state(Process *c_p, int enable) ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p)); if (!enable) { - c_p->flags |= F_DISABLE_GC; - return 0; + /* Strictly speaking it's not illegal to disable the GC when it's + * already disabled, but we risk enabling the GC prematurely if (for + * example) a BIF were to blindly disable it when trapping and then + * re-enable it before returning its result. */ + ASSERT(!(c_p->flags & F_DISABLE_GC)); + c_p->flags |= F_DISABLE_GC; + return 0; } c_p->flags &= ~F_DISABLE_GC; @@ -11583,9 +11588,6 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->mbuf_sz = 0; erts_atomic_init_nob(&p->psd, (erts_aint_t) NULL); p->dictionary = NULL; - p->seq_trace_lastcnt = 0; - p->seq_trace_clock = 0; - SEQ_TRACE_TOKEN(p) = NIL; #ifdef USE_VM_PROBES DT_UTAG(p) = NIL; DT_UTAG_FLAGS(p) = 0; @@ -11606,6 +11608,45 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->fp_exception = 0; #endif + /* seq_trace is handled before regular tracing as the latter may touch the + * trace token. */ + if (have_seqtrace(SEQ_TRACE_TOKEN(parent))) { + Eterm token; + Uint token_sz; + Eterm *hp; + + ASSERT(SEQ_TRACE_TOKEN_ARITY(parent) == 5); + ASSERT(is_immed(SEQ_TRACE_TOKEN_FLAGS(parent))); + ASSERT(is_immed(SEQ_TRACE_TOKEN_SERIAL(parent))); + ASSERT(is_immed(SEQ_TRACE_TOKEN_LASTCNT(parent))); + + seq_trace_update_serial(parent); + + token = SEQ_TRACE_TOKEN(parent); + token_sz = size_object(token); + + hp = HAlloc(p, token_sz); + SEQ_TRACE_TOKEN(p) = copy_struct(token, token_sz, &hp, &MSO(p)); + + /* The counters behave the same way on spawning as they do on messages; + * we don't inherit our parent's lastcnt. */ + p->seq_trace_lastcnt = parent->seq_trace_clock; + p->seq_trace_clock = parent->seq_trace_clock; + + ASSERT((locks & (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) == + (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)); + + locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + + seq_trace_output(token, NIL, SEQ_TRACE_SPAWN, p->common.id, parent); + } else { + SEQ_TRACE_TOKEN(p) = NIL; + p->seq_trace_lastcnt = 0; + p->seq_trace_clock = 0; + } + if (IS_TRACED(parent)) { if (ERTS_TRACE_FLAGS(parent) & F_TRACE_SOS) { ERTS_TRACE_FLAGS(p) |= (ERTS_TRACE_FLAGS(parent) & TRACEE_FLAGS); @@ -11627,9 +11668,14 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). } } if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) { - locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); - erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); - erts_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + /* The locks may already be released if seq_trace is enabled as + * well. */ + if ((locks & (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) + == (ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE)) { + locks &= ~(ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + erts_proc_unlock(parent, ERTS_PROC_LOCK_STATUS|ERTS_PROC_LOCK_TRACE); + } trace_proc_spawn(parent, am_spawn, p->common.id, mod, func, args); if (so->flags & SPO_LINK) trace_proc(parent, locks, parent, am_link, p->common.id); diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index c0d7cfd13d..405611c584 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -1489,6 +1489,8 @@ extern int erts_system_profile_ts_type; #define SEQ_TRACE_SEND (1 << 0) #define SEQ_TRACE_RECEIVE (1 << 1) #define SEQ_TRACE_PRINT (1 << 2) +/* (This three-bit gap contains the timestamp.) */ +#define SEQ_TRACE_SPAWN (1 << 6) #define ERTS_SEQ_TRACE_FLAGS_TS_TYPE_SHIFT 3 diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c index f6f177887c..5c46a10d64 100644 --- a/erts/emulator/beam/erl_trace.c +++ b/erts/emulator/beam/erl_trace.c @@ -830,7 +830,7 @@ trace_receive(Process* receiver, } int -seq_trace_update_send(Process *p) +seq_trace_update_serial(Process *p) { ErtsTracer seq_tracer = erts_get_system_seq_tracer(); ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p)))); @@ -898,6 +898,7 @@ seq_trace_output_generic(Eterm token, Eterm msg, Uint type, switch (type) { case SEQ_TRACE_SEND: type_atom = am_send; break; + case SEQ_TRACE_SPAWN: type_atom = am_spawn; break; case SEQ_TRACE_PRINT: type_atom = am_print; break; case SEQ_TRACE_RECEIVE: type_atom = am_receive; break; default: diff --git a/erts/emulator/beam/erl_trace.h b/erts/emulator/beam/erl_trace.h index af38ef52db..d25f97c656 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -163,7 +163,9 @@ seq_trace_output_generic((token), (msg), (type), (receiver), NULL, (exitfrom)) void seq_trace_output_generic(Eterm token, Eterm msg, Uint type, Eterm receiver, Process *process, Eterm exitfrom); -int seq_trace_update_send(Process *process); +/* Bump the sequence number if tracing is enabled; must be used before sending + * send/spawn trace messages. */ +int seq_trace_update_serial(Process *process); Eterm erts_seq_trace(Process *process, Eterm atom_type, Eterm atom_true_or_false, diff --git a/erts/emulator/beam/erl_utils.h b/erts/emulator/beam/erl_utils.h index 430ac305c5..449243a9b7 100644 --- a/erts/emulator/beam/erl_utils.h +++ b/erts/emulator/beam/erl_utils.h @@ -70,6 +70,7 @@ int erts_fit_in_bits_uint(Uint); Sint erts_list_length(Eterm); int erts_is_builtin(Eterm, Eterm, int); Uint32 make_hash2(Eterm); +Uint32 trapping_make_hash2(Eterm, Eterm*, struct process*); Uint32 make_hash(Eterm); Uint32 make_internal_hash(Eterm, Uint32 salt); diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index ce61cdf040..5cea253ebe 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -51,18 +51,17 @@ #define MAX_STRING_LEN 0xffff -/* MAX value for the creation field in pid, port and reference - for the local node and for the current external format. - - Larger creation values than this are allowed in external pid, port and refs - encoded with NEW_PID_EXT, NEW_PORT_EXT and NEWER_REFERENCE_EXT. - The point here is to prepare for future upgrade to 32-bit creation. - OTP-19 (erts-8.0) can handle big creation values from other (newer) nodes, - but do not use big creation values for the local node yet, - as we still may have to communicate with older nodes. +/* + * MAX value for the creation field in pid, port and reference + * for the old PID_EXT, PORT_EXT, REFERENCE_EXT and NEW_REFERENCE_EXT. + * Older nodes (OTP 19-22) will send us these so we must be able to decode them. + * + * From OTP 23 DFLAG_BIG_CREATION is mandatory so this node will always + * encode with new big 32-bit creations using NEW_PID_EXT, NEW_PORT_EXT + * and NEWER_REFERENCE_EXT. */ -#define ERTS_MAX_LOCAL_CREATION (3) -#define is_valid_creation(Cre) ((unsigned)(Cre) <= ERTS_MAX_LOCAL_CREATION) +#define ERTS_MAX_TINY_CREATION (3) +#define is_tiny_creation(Cre) ((unsigned)(Cre) <= ERTS_MAX_TINY_CREATION) #undef ERTS_DEBUG_USE_DIST_SEP #ifdef DEBUG @@ -2469,7 +2468,8 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) Eterm sysname = ((is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS)) ? INTERNAL_LOCAL_SYSNAME : pid_node_name(pid)); Uint32 creation = pid_creation(pid); - byte* tagp = ep++; + + *ep++ = NEW_PID_EXT; /* insert atom here containing host and sysname */ ep = enc_atom(acmp, sysname, ep, dflags); @@ -2481,15 +2481,8 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) ep += 4; put_int32(os, ep); ep += 4; - if (creation <= ERTS_MAX_LOCAL_CREATION) { - *tagp = PID_EXT; - *ep++ = creation; - } else { - ASSERT(is_external_pid(pid)); - *tagp = NEW_PID_EXT; - put_int32(creation, ep); - ep += 4; - } + put_int32(creation, ep); + ep += 4; return ep; } @@ -2609,7 +2602,7 @@ dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, if (tag == PID_EXT) { cre = get_int8(ep); ep += 1; - if (!is_valid_creation(cre)) { + if (!is_tiny_creation(cre)) { return NULL; } } else { @@ -2870,25 +2863,18 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj)) ? INTERNAL_LOCAL_SYSNAME : ref_node_name(obj)); Uint32 creation = ref_creation(obj); - byte* tagp = ep++; ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); erts_magic_ref_save_bin(obj); + *ep++ = NEWER_REFERENCE_EXT; i = ref_no_numbers(obj); put_int16(i, ep); ep += 2; ep = enc_atom(acmp, sysname, ep, dflags); - if (creation <= ERTS_MAX_LOCAL_CREATION) { - *tagp = NEW_REFERENCE_EXT; - *ep++ = creation; - } else { - ASSERT(is_external_ref(obj)); - *tagp = NEWER_REFERENCE_EXT; - put_int32(creation, ep); - ep += 4; - } + put_int32(creation, ep); + ep += 4; ref_num = ref_numbers(obj); for (j = 0; j < i; j++) { put_int32(ref_num[j], ep); @@ -2901,21 +2887,14 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj)) ? INTERNAL_LOCAL_SYSNAME : port_node_name(obj)); Uint32 creation = port_creation(obj); - byte* tagp = ep++; + *ep++ = NEW_PORT_EXT; ep = enc_atom(acmp, sysname, ep, dflags); j = port_number(obj); put_int32(j, ep); ep += 4; - if (creation <= ERTS_MAX_LOCAL_CREATION) { - *tagp = PORT_EXT; - *ep++ = creation; - } else { - ASSERT(is_external_port(obj)); - *tagp = NEW_PORT_EXT; - put_int32(creation, ep); - ep += 4; - } + put_int32(creation, ep); + ep += 4; break; } case LIST_DEF: @@ -3610,7 +3589,7 @@ dec_term_atom_common: if (tag == PORT_EXT) { cre = get_int8(ep); ep++; - if (!is_valid_creation(cre)) { + if (!is_tiny_creation(cre)) { goto error; } } @@ -3657,7 +3636,7 @@ dec_term_atom_common: cre = get_int8(ep); ep += 1; - if (!is_valid_creation(cre)) { + if (!is_tiny_creation(cre)) { goto error; } goto ref_ext_common; @@ -3671,7 +3650,7 @@ dec_term_atom_common: cre = get_int8(ep); ep += 1; - if (!is_valid_creation(cre)) { + if (!is_tiny_creation(cre)) { goto error; } r0 = get_int32(ep); @@ -4066,73 +4045,6 @@ dec_term_atom_common: next = &(funp->creator); break; } - case FUN_EXT: - { - ErlFunThing* funp = (ErlFunThing *) hp; - Eterm module; - Sint old_uniq; - Sint old_index; - unsigned num_free; - int i; - Eterm temp; - - num_free = get_int32(ep); - ep += 4; - hp += ERL_FUN_SIZE; - hp += num_free; - factory->hp = hp; - funp->thing_word = HEADER_FUN; - funp->num_free = num_free; - *objp = make_fun(funp); - - /* Creator pid */ - if ((*ep != PID_EXT && *ep != NEW_PID_EXT) - || (ep = dec_pid(edep, factory, ep+1, - &funp->creator, *ep))==NULL) { - goto error; - } - - /* Module */ - if ((ep = dec_atom(edep, ep, &module)) == NULL) { - goto error; - } - - /* Index */ - if ((ep = dec_term(edep, factory, ep, &temp, NULL)) == NULL) { - goto error; - } - if (!is_small(temp)) { - goto error; - } - old_index = unsigned_val(temp); - - /* Uniq */ - if ((ep = dec_term(edep, factory, ep, &temp, NULL)) == NULL) { - goto error; - } - if (!is_small(temp)) { - goto error; - } - - /* - * It is safe to link the fun into the fun list only when - * no more validity tests can fail. - */ - funp->next = factory->off_heap->first; - factory->off_heap->first = (struct erl_off_heap_header*)funp; - old_uniq = unsigned_val(temp); - - funp->fe = erts_put_fun_entry(module, old_uniq, old_index); - funp->arity = funp->fe->address[-1] - num_free; - hp = factory->hp; - - /* Environment */ - for (i = num_free-1; i >= 0; i--) { - funp->env[i] = (Eterm) next; - next = funp->env + i; - } - break; - } case ATOM_INTERNAL_REF2: n = get_int16(ep); ep += 2; @@ -4401,30 +4313,21 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, result += 1 + 4 + 1 + i; /* tag,size,sign,digits */ break; case EXTERNAL_PID_DEF: - if (external_pid_creation(obj) > ERTS_MAX_LOCAL_CREATION) - result += 3; - /*fall through*/ case PID_DEF: result += (1 + encode_size_struct2(acmp, pid_node_name(obj), dflags) + - 4 + 4 + 1); + 4 + 4 + 4); break; case EXTERNAL_REF_DEF: - if (external_ref_creation(obj) > ERTS_MAX_LOCAL_CREATION) - result += 3; - /*fall through*/ case REF_DEF: ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); i = ref_no_numbers(obj); result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) + - 1 + 4*i); + 4 + 4*i); break; case EXTERNAL_PORT_DEF: - if (external_port_creation(obj) > ERTS_MAX_LOCAL_CREATION) - result += 3; - /*fall through*/ case PORT_DEF: result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) + - 4 + 1); + 4 + 4); break; case LIST_DEF: { int is_str = is_external_string(obj, &m); @@ -4891,9 +4794,6 @@ init_done: total_size = get_int32(ep); CHKSIZE(total_size); ep += 1+16+4+4; - /*FALLTHROUGH*/ - - case FUN_EXT: CHKSIZE(4); num_free = get_int32(ep); ep += 4; @@ -4904,6 +4804,12 @@ init_done: heap_size += ERL_FUN_SIZE + num_free; break; } + case FUN_EXT: + /* + * OTP 23: No longer support decoding the old fun + * representation. + */ + goto error; case ATOM_INTERNAL_REF2: SKIP(2+atom_extra_skip); atom_extra_skip = 0; diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index 7cffe7fb5c..bc8c1189a8 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -683,10 +683,11 @@ swap(R1, R2) { $R2 = V; } -swap_temp(R1, R2, Tmp) { - Eterm V = $R1; - $R1 = $R2; - $R2 = $Tmp = V; +swap2(R1, R2, R3) { + Eterm V = $R2; + $R2 = $R1; + $R1 = $R3; + $R3 = V; } test_heap(Nh, Live) { diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index b9d4f6afcc..f525d126e7 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -324,76 +324,15 @@ move_src_window2 y x x move_src_window3 y x x x move_src_window4 y x x x x -# Swap registers. -move R1=xy Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp - -# The compiler uses x(1022) when swapping registers. It will definitely -# not be used again. -swap_temp R1 R2 Tmp=x==1022 => swap R1 R2 - -swap_temp R1 R2 Tmp | move Src Tmp => swap R1 R2 | move Src Tmp - -swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed_apply(Tmp, Live) => \ - swap R1 R2 | line Loc | apply Live -swap_temp R1 R2 Tmp | line Loc | apply_last Live D | is_killed_apply(Tmp, Live) => \ - swap R1 R2 | line Loc | apply_last Live D - -swap_temp R1 R2 Tmp | line Loc | call_fun Live | is_killed_by_call_fun(Tmp, Live) => \ - swap R1 R2 | line Loc | call_fun Live -swap_temp R1 R2 Tmp | make_fun2 OldIndex=u | is_killed_by_make_fun(Tmp, OldIndex) => \ - swap R1 R2 | make_fun2 OldIndex - -swap_temp R1 R2 Tmp | line Loc | call Live Addr | is_killed(Tmp, Live) => \ - swap R1 R2 | line Loc | call Live Addr -swap_temp R1 R2 Tmp | call_only Live Addr | \ - is_killed(Tmp, Live) => swap R1 R2 | call_only Live Addr -swap_temp R1 R2 Tmp | call_last Live Addr D | \ - is_killed(Tmp, Live) => swap R1 R2 | call_last Live Addr D - -swap_temp R1 R2 Tmp | line Loc | call_ext Live Addr | is_killed(Tmp, Live) => \ - swap R1 R2 | line Loc | call_ext Live Addr -swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \ - is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_only Live Addr -swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \ - is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D - -swap_temp R1 R2 Tmp | call_ext Live Addr | is_killed(Tmp, Live) => \ - swap R1 R2 | call_ext Live Addr -swap_temp R1 R2 Tmp | call_ext_only Live Addr | is_killed(Tmp, Live) => \ - swap R1 R2 | call_ext_only Live Addr -swap_temp R1 R2 Tmp | call_ext_last Live Addr D | is_killed(Tmp, Live) => \ - swap R1 R2 | call_ext_last Live Addr D - -swap_temp R1 R2 Tmp | move Src Any | line Loc | call Live Addr | \ - is_killed(Tmp, Live) | distinct(Tmp, Src) => \ - swap R1 R2 | move Src Any | line Loc | call Live Addr -swap_temp R1 R2 Tmp | move Src Any | line Loc | call_ext Live Addr | \ - is_killed(Tmp, Live) | distinct(Tmp, Src) => \ - swap R1 R2 | move Src Any | line Loc | call_ext Live Addr -swap_temp R1 R2 Tmp | move Src Any | call_only Live Addr | \ - is_killed(Tmp, Live) | distinct(Tmp, Src) => \ - swap R1 R2 | move Src Any | call_only Live Addr -swap_temp R1 R2 Tmp | move Src Any | line Loc | call_ext_only Live Addr | \ - is_killed(Tmp, Live) | distinct(Tmp, Src) => \ - swap R1 R2 | move Src Any | line Loc | call_ext_only Live Addr -swap_temp R1 R2 Tmp | move Src Any | line Loc | call_fun Live | \ - is_killed(Tmp, Live) | distinct(Tmp, Src) => \ - swap R1 R2 | move Src Any | line Loc | call_fun Live - -swap_temp R1 R2 Tmp | line Loc | send | is_killed_by_send(Tmp) => \ - swap R1 R2 | line Loc | send - -# swap_temp/3 with Y register operands are rare. -swap_temp R1 R2=y Tmp => swap R1 R2 | move R2 Tmp -swap_temp R1=y R2 Tmp => swap R1 R2 | move R2 Tmp - swap R1=x R2=y => swap R2 R1 -swap_temp x x x - swap xy x swap y y +swap R1=x R2=x | swap R3=x R1 => swap2 R1 R2 R3 + +swap2 x x x + # move_shift move SD=x D=x | move Src=cxy SD=x | distinct(D, Src) => move_shift Src SD D diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index c261c8e117..db07512cf7 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -92,6 +92,12 @@ # define ERTS_GLB_INLINE_INCL_FUNC_DEF 0 #endif +#ifdef __GNUC__ +# define ERTS_NOINLINE __attribute__((__noinline__)) +#else +# define ERTS_NOINLINE +#endif + #if defined(VALGRIND) && !defined(NO_FPE_SIGNALS) # define NO_FPE_SIGNALS #endif @@ -172,7 +178,8 @@ typedef ERTS_SYS_FD_TYPE ErtsSysFdType; # define ERTS_UNLIKELY(BOOL) (BOOL) #endif -#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0) +/* AIX doesn't like this and claims section conflicts */ +#if ERTS_AT_LEAST_GCC_VSN__(2, 96, 0) && !defined(_AIX) #if (defined(__APPLE__) && defined(__MACH__)) || defined(__DARWIN__) # define ERTS_WRITE_UNLIKELY(X) X __attribute__ ((section ("__DATA,ERTS_LOW_WRITE") )) #else diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index 0bbae65e28..fb06d60768 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -66,7 +66,7 @@ #undef M_MMAP_THRESHOLD #undef M_MMAP_MAX -#if defined(__GLIBC__) && defined(HAVE_MALLOC_H) +#if (defined(__GLIBC__) || defined(_AIX)) && defined(HAVE_MALLOC_H) #include <malloc.h> #endif @@ -907,7 +907,7 @@ tail_recur: hash = hash * FUNNY_NUMBER10 + num_free; hash = hash*FUNNY_NUMBER1 + (atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue); - hash = hash*FUNNY_NUMBER2 + funp->fe->old_index; + hash = hash*FUNNY_NUMBER2 + funp->fe->index; hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq; if (num_free > 0) { if (num_free > 1) { @@ -1069,54 +1069,237 @@ do { \ #define HCONST 0x9e3779b9UL /* the golden ratio; an arbitrary value */ -static Uint32 -block_hash(byte *k, Uint length, Uint32 initval) +typedef struct { + Uint32 a,b,c; +} ErtsBlockHashHelperCtx; + +#define BLOCK_HASH_BYTES_PER_ITER 12 + +/* The three functions below are separated into different functions even + though they are always used together to make trapping and handling + of unaligned binaries easier. Examples of how they are used can be + found in block_hash and make_hash2_helper.*/ +static ERTS_INLINE +void block_hash_setup(Uint32 initval, + ErtsBlockHashHelperCtx* ctx /* out parameter */) +{ + ctx->a = ctx->b = HCONST; + ctx->c = initval; /* the previous hash value */ +} + +static ERTS_INLINE +void block_hash_buffer(byte *buf, + Uint buf_length, + ErtsBlockHashHelperCtx* ctx /* out parameter */) { - Uint32 a,b,c; - Uint len; - - /* Set up the internal state */ - len = length; - a = b = HCONST; - c = initval; /* the previous hash value */ - - while (len >= 12) - { - a += (k[0] +((Uint32)k[1]<<8) +((Uint32)k[2]<<16) +((Uint32)k[3]<<24)); - b += (k[4] +((Uint32)k[5]<<8) +((Uint32)k[6]<<16) +((Uint32)k[7]<<24)); - c += (k[8] +((Uint32)k[9]<<8) +((Uint32)k[10]<<16)+((Uint32)k[11]<<24)); - MIX(a,b,c); - k += 12; len -= 12; - } - - c += length; - switch(len) /* all the case statements fall through */ - { - case 11: c+=((Uint32)k[10]<<24); - case 10: c+=((Uint32)k[9]<<16); - case 9 : c+=((Uint32)k[8]<<8); - /* the first byte of c is reserved for the length */ - case 8 : b+=((Uint32)k[7]<<24); - case 7 : b+=((Uint32)k[6]<<16); - case 6 : b+=((Uint32)k[5]<<8); - case 5 : b+=k[4]; - case 4 : a+=((Uint32)k[3]<<24); - case 3 : a+=((Uint32)k[2]<<16); - case 2 : a+=((Uint32)k[1]<<8); - case 1 : a+=k[0]; - /* case 0: nothing left to add */ - } - MIX(a,b,c); - return c; + Uint len = buf_length; + byte *k = buf; + ASSERT(buf_length % BLOCK_HASH_BYTES_PER_ITER == 0); + while (len >= BLOCK_HASH_BYTES_PER_ITER) { + ctx->a += (k[0] +((Uint32)k[1]<<8) +((Uint32)k[2]<<16) +((Uint32)k[3]<<24)); + ctx->b += (k[4] +((Uint32)k[5]<<8) +((Uint32)k[6]<<16) +((Uint32)k[7]<<24)); + ctx->c += (k[8] +((Uint32)k[9]<<8) +((Uint32)k[10]<<16)+((Uint32)k[11]<<24)); + MIX(ctx->a,ctx->b,ctx->c); + k += BLOCK_HASH_BYTES_PER_ITER; len -= BLOCK_HASH_BYTES_PER_ITER; + } } +static ERTS_INLINE +Uint32 block_hash_final_bytes(byte *buf, + Uint buf_length, + Uint full_length, + ErtsBlockHashHelperCtx* ctx) +{ + Uint len = buf_length; + byte *k = buf; + ctx->c += full_length; + switch(len) + { /* all the case statements fall through */ + case 11: ctx->c+=((Uint32)k[10]<<24); + case 10: ctx->c+=((Uint32)k[9]<<16); + case 9 : ctx->c+=((Uint32)k[8]<<8); + /* the first byte of c is reserved for the length */ + case 8 : ctx->b+=((Uint32)k[7]<<24); + case 7 : ctx->b+=((Uint32)k[6]<<16); + case 6 : ctx->b+=((Uint32)k[5]<<8); + case 5 : ctx->b+=k[4]; + case 4 : ctx->a+=((Uint32)k[3]<<24); + case 3 : ctx->a+=((Uint32)k[2]<<16); + case 2 : ctx->a+=((Uint32)k[1]<<8); + case 1 : ctx->a+=k[0]; + /* case 0: nothing left to add */ + } + MIX(ctx->a,ctx->b,ctx->c); + return ctx->c; +} + +static Uint32 -make_hash2(Eterm term) +block_hash(byte *block, Uint block_length, Uint32 initval) { + ErtsBlockHashHelperCtx ctx; + Uint no_bytes_not_in_loop = + (block_length % BLOCK_HASH_BYTES_PER_ITER); + Uint no_bytes_to_process_in_loop = + block_length - no_bytes_not_in_loop; + byte *final_bytes = block + no_bytes_to_process_in_loop; + block_hash_setup(initval, &ctx); + block_hash_buffer(block, + no_bytes_to_process_in_loop, + &ctx); + return block_hash_final_bytes(final_bytes, + no_bytes_not_in_loop, + block_length, + &ctx); +} + +typedef enum { + tag_primary_list, + arityval_subtag, + hamt_subtag_head_flatmap, + map_subtag, + fun_subtag, + neg_big_subtag, + sub_binary_subtag_1, + sub_binary_subtag_2, + hash2_common_1, + hash2_common_2, + hash2_common_3, +} ErtsMakeHash2TrapLocation; + +typedef struct { + int c; + Uint32 sh; + Eterm* ptr; +} ErtsMakeHash2Context_TAG_PRIMARY_LIST; + +typedef struct { + int i; + int arity; + Eterm* elem; +} ErtsMakeHash2Context_ARITYVAL_SUBTAG; + +typedef struct { + Eterm *ks; + Eterm *vs; + int i; + Uint size; +} ErtsMakeHash2Context_HAMT_SUBTAG_HEAD_FLATMAP; + +typedef struct { + Eterm* ptr; + int i; +} ErtsMakeHash2Context_MAP_SUBTAG; + +typedef struct { + Uint num_free; + Eterm* bptr; +} ErtsMakeHash2Context_FUN_SUBTAG; + +typedef struct { + Eterm* ptr; + Uint i; + Uint n; + Uint32 con; +} ErtsMakeHash2Context_NEG_BIG_SUBTAG; + +typedef struct { + byte* bptr; + Uint sz; + Uint bitsize; + Uint bitoffs; + Uint no_bytes_processed; + ErtsBlockHashHelperCtx block_hash_ctx; + /* The following fields are only used when bitoffs != 0 */ + byte* buf; + int done; + +} ErtsMakeHash2Context_SUB_BINARY_SUBTAG; + +typedef struct { + int dummy__; /* Empty structs are not supported on all platforms */ +} ErtsMakeHash2Context_EMPTY; + +typedef struct { + ErtsMakeHash2TrapLocation trap_location; + /* specific to the trap location: */ + union { + ErtsMakeHash2Context_TAG_PRIMARY_LIST tag_primary_list; + ErtsMakeHash2Context_ARITYVAL_SUBTAG arityval_subtag; + ErtsMakeHash2Context_HAMT_SUBTAG_HEAD_FLATMAP hamt_subtag_head_flatmap; + ErtsMakeHash2Context_MAP_SUBTAG map_subtag; + ErtsMakeHash2Context_FUN_SUBTAG fun_subtag; + ErtsMakeHash2Context_NEG_BIG_SUBTAG neg_big_subtag; + ErtsMakeHash2Context_SUB_BINARY_SUBTAG sub_binary_subtag_1; + ErtsMakeHash2Context_SUB_BINARY_SUBTAG sub_binary_subtag_2; + ErtsMakeHash2Context_EMPTY hash2_common_1; + ErtsMakeHash2Context_EMPTY hash2_common_2; + ErtsMakeHash2Context_EMPTY hash2_common_3; + } trap_location_state; + /* same for all trap locations: */ + Eterm term; Uint32 hash; Uint32 hash_xor_pairs; - DeclareTmpHeapNoproc(tmp_big,2); + ErtsEStack stack; +} ErtsMakeHash2Context; + +static int make_hash2_ctx_bin_dtor(Binary *context_bin) { + ErtsMakeHash2Context* context = ERTS_MAGIC_BIN_DATA(context_bin); + DESTROY_SAVED_ESTACK(&context->stack); + if (context->trap_location == sub_binary_subtag_2 && + context->trap_location_state.sub_binary_subtag_2.buf != NULL) { + erts_free(ERTS_ALC_T_PHASH2_TRAP, context->trap_location_state.sub_binary_subtag_2.buf); + } + return 1; +} +/* hash2_save_trap_state is called seldom so we want to avoid inlining */ +static ERTS_NOINLINE +Eterm hash2_save_trap_state(Eterm state_mref, + Uint32 hash_xor_pairs, + Uint32 hash, + Process* p, + Eterm term, + Eterm* ESTK_DEF_STACK(s), + ErtsEStack s, + ErtsMakeHash2TrapLocation trap_location, + void* trap_location_state_ptr, + size_t trap_location_state_size) { + Binary* state_bin; + ErtsMakeHash2Context* context; + if (state_mref == THE_NON_VALUE) { + Eterm* hp; + state_bin = erts_create_magic_binary(sizeof(ErtsMakeHash2Context), + make_hash2_ctx_bin_dtor); + hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE); + state_mref = erts_mk_magic_ref(&hp, &MSO(p), state_bin); + } else { + state_bin = erts_magic_ref2bin(state_mref); + } + context = ERTS_MAGIC_BIN_DATA(state_bin); + context->term = term; + context->hash = hash; + context->hash_xor_pairs = hash_xor_pairs; + ESTACK_SAVE(s, &context->stack); + context->trap_location = trap_location; + sys_memcpy(&context->trap_location_state, + trap_location_state_ptr, + trap_location_state_size); + erts_set_gc_state(p, 0); + BUMP_ALL_REDS(p); + return state_mref; +} +#undef NOINLINE_HASH2_SAVE_TRAP_STATE + +/* Writes back a magic reference to *state_mref_write_back when the + function traps */ +static ERTS_INLINE Uint32 +make_hash2_helper(Eterm term_param, const int can_trap, Eterm* state_mref_write_back, Process* p) +{ + static const Uint ITERATIONS_PER_RED = 64; + Uint32 hash; + Uint32 hash_xor_pairs; + Eterm term = term_param; ERTS_UNDEF(hash_xor_pairs, 0); /* (HCONST * {2, ..., 22}) mod 2^32 */ @@ -1168,12 +1351,63 @@ make_hash2(Eterm term) #define IS_SSMALL28(x) (((Uint) (((x) >> (28-1)) + 1)) < 2) +#define NOT_SSMALL28_HASH(SMALL) \ + do { \ + Uint64 t; \ + Uint32 x, y; \ + Uint32 con; \ + if (SMALL < 0) { \ + con = HCONST_10; \ + t = (Uint64)(SMALL * (-1)); \ + } else { \ + con = HCONST_11; \ + t = SMALL; \ + } \ + x = t & 0xffffffff; \ + y = t >> 32; \ + UINT32_HASH_2(x, y, con); \ + } while(0) + #ifdef ARCH_64 # define POINTER_HASH(Ptr, AConst) UINT32_HASH_2((Uint32)(UWord)(Ptr), (((UWord)(Ptr)) >> 32), AConst) #else # define POINTER_HASH(Ptr, AConst) UINT32_HASH(Ptr, AConst) #endif +#define TRAP_LOCATION_NO_RED(location_name) \ + do { \ + if(can_trap && iterations_until_trap <= 0) { \ + *state_mref_write_back = \ + hash2_save_trap_state(state_mref, \ + hash_xor_pairs, \ + hash, \ + p, \ + term, \ + ESTK_DEF_STACK(s), \ + s, \ + location_name, \ + &ctx, \ + sizeof(ctx)); \ + return 0; \ + L_##location_name: \ + ctx = context->trap_location_state. location_name; \ + } \ + } while(0) + +#define TRAP_LOCATION(location_name) \ + do { \ + if (can_trap) { \ + iterations_until_trap--; \ + TRAP_LOCATION_NO_RED(location_name); \ + } \ + } while(0) + +#define TRAP_LOCATION_NO_CTX(location_name) \ + do { \ + ErtsMakeHash2Context_EMPTY ctx; \ + TRAP_LOCATION(location_name); \ + } while(0) + /* Optimization. Simple cases before declaration of estack. */ if (primary_tag(term) == TAG_PRIMARY_IMMED1) { switch (term & _TAG_IMMED1_MASK) { @@ -1186,51 +1420,94 @@ make_hash2(Eterm term) break; case _TAG_IMMED1_SMALL: { - Sint x = signed_val(term); - - if (SMALL_BITS > 28 && !IS_SSMALL28(x)) { - term = small_to_big(x, tmp_big); - break; + Sint small = signed_val(term); + if (SMALL_BITS > 28 && !IS_SSMALL28(small)) { + hash = 0; + NOT_SSMALL28_HASH(small); + return hash; } hash = 0; - SINT32_HASH(x, HCONST); + SINT32_HASH(small, HCONST); return hash; } } }; { Eterm tmp; + long max_iterations = 0; + long iterations_until_trap = 0; + Eterm state_mref = THE_NON_VALUE; + ErtsMakeHash2Context* context = NULL; DECLARE_ESTACK(s); - - UseTmpHeapNoproc(2); + ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK); + if(can_trap){ +#ifdef DEBUG + (void)ITERATIONS_PER_RED; + iterations_until_trap = max_iterations = + (1103515245 * (ERTS_BIF_REDS_LEFT(p)) + 12345) % 227; +#else + iterations_until_trap = max_iterations = + ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(p); +#endif + } + if (can_trap && is_internal_magic_ref(term)) { + Binary* state_bin; + state_mref = term; + state_bin = erts_magic_ref2bin(state_mref); + if (ERTS_MAGIC_BIN_DESTRUCTOR(state_bin) == make_hash2_ctx_bin_dtor) { + /* Restore state after a trap */ + context = ERTS_MAGIC_BIN_DATA(state_bin); + term = context->term; + hash = context->hash; + hash_xor_pairs = context->hash_xor_pairs; + ESTACK_RESTORE(s, &context->stack); + ASSERT(p->flags & F_DISABLE_GC); + erts_set_gc_state(p, 1); + switch (context->trap_location) { + case hash2_common_3: goto L_hash2_common_3; + case tag_primary_list: goto L_tag_primary_list; + case arityval_subtag: goto L_arityval_subtag; + case hamt_subtag_head_flatmap: goto L_hamt_subtag_head_flatmap; + case map_subtag: goto L_map_subtag; + case fun_subtag: goto L_fun_subtag; + case neg_big_subtag: goto L_neg_big_subtag; + case sub_binary_subtag_1: goto L_sub_binary_subtag_1; + case sub_binary_subtag_2: goto L_sub_binary_subtag_2; + case hash2_common_1: goto L_hash2_common_1; + case hash2_common_2: goto L_hash2_common_2; + } + } + } hash = 0; for (;;) { switch (primary_tag(term)) { case TAG_PRIMARY_LIST: { - int c = 0; - Uint32 sh = 0; - Eterm* ptr = list_val(term); - while (is_byte(*ptr)) { + ErtsMakeHash2Context_TAG_PRIMARY_LIST ctx = { + .c = 0, + .sh = 0, + .ptr = list_val(term)}; + while (is_byte(*ctx.ptr)) { /* Optimization for strings. */ - sh = (sh << 8) + unsigned_val(*ptr); - if (c == 3) { - UINT32_HASH(sh, HCONST_4); - c = sh = 0; + ctx.sh = (ctx.sh << 8) + unsigned_val(*ctx.ptr); + if (ctx.c == 3) { + UINT32_HASH(ctx.sh, HCONST_4); + ctx.c = ctx.sh = 0; } else { - c++; + ctx.c++; } - term = CDR(ptr); + term = CDR(ctx.ptr); if (is_not_list(term)) break; - ptr = list_val(term); + ctx.ptr = list_val(term); + TRAP_LOCATION(tag_primary_list); } - if (c > 0) - UINT32_HASH(sh, HCONST_4); + if (ctx.c > 0) + UINT32_HASH(ctx.sh, HCONST_4); if (is_list(term)) { - tmp = CDR(ptr); + tmp = CDR(ctx.ptr); ESTACK_PUSH(s, tmp); - term = CAR(ptr); + term = CAR(ctx.ptr); } } break; @@ -1241,34 +1518,39 @@ make_hash2(Eterm term) switch (hdr & _TAG_HEADER_MASK) { case ARITYVAL_SUBTAG: { - int i; - int arity = header_arity(hdr); - Eterm* elem = tuple_val(term); - UINT32_HASH(arity, HCONST_9); - if (arity == 0) /* Empty tuple */ + ErtsMakeHash2Context_ARITYVAL_SUBTAG ctx = { + .i = 0, + .arity = header_arity(hdr), + .elem = tuple_val(term)}; + UINT32_HASH(ctx.arity, HCONST_9); + if (ctx.arity == 0) /* Empty tuple */ goto hash2_common; - for (i = arity; ; i--) { - term = elem[i]; - if (i == 1) + for (ctx.i = ctx.arity; ; ctx.i--) { + term = ctx.elem[ctx.i]; + if (ctx.i == 1) break; ESTACK_PUSH(s, term); + TRAP_LOCATION(arityval_subtag); } } break; case MAP_SUBTAG: { - Eterm* ptr = boxed_val(term) + 1; Uint size; - int i; + ErtsMakeHash2Context_MAP_SUBTAG ctx = { + .ptr = boxed_val(term) + 1, + .i = 0}; switch (hdr & _HEADER_MAP_SUBTAG_MASK) { case HAMT_SUBTAG_HEAD_FLATMAP: { flatmap_t *mp = (flatmap_t *)flatmap_val(term); - Eterm *ks = flatmap_get_keys(mp); - Eterm *vs = flatmap_get_values(mp); - size = flatmap_get_size(mp); - UINT32_HASH(size, HCONST_16); - if (size == 0) + ErtsMakeHash2Context_HAMT_SUBTAG_HEAD_FLATMAP ctx = { + .ks = flatmap_get_keys(mp), + .vs = flatmap_get_values(mp), + .i = 0, + .size = flatmap_get_size(mp)}; + UINT32_HASH(ctx.size, HCONST_16); + if (ctx.size == 0) goto hash2_common; /* We want a portable hash function that is *independent* of @@ -1281,17 +1563,18 @@ make_hash2(Eterm term) ESTACK_PUSH(s, HASH_MAP_TAIL); hash = 0; hash_xor_pairs = 0; - for (i = size - 1; i >= 0; i--) { + for (ctx.i = ctx.size - 1; ctx.i >= 0; ctx.i--) { ESTACK_PUSH(s, HASH_MAP_PAIR); - ESTACK_PUSH(s, vs[i]); - ESTACK_PUSH(s, ks[i]); + ESTACK_PUSH(s, ctx.vs[ctx.i]); + ESTACK_PUSH(s, ctx.ks[ctx.i]); + TRAP_LOCATION(hamt_subtag_head_flatmap); } goto hash2_common; } case HAMT_SUBTAG_HEAD_ARRAY: case HAMT_SUBTAG_HEAD_BITMAP: - size = *ptr++; + size = *ctx.ptr++; UINT32_HASH(size, HCONST_16); if (size == 0) goto hash2_common; @@ -1303,27 +1586,28 @@ make_hash2(Eterm term) } switch (hdr & _HEADER_MAP_SUBTAG_MASK) { case HAMT_SUBTAG_HEAD_ARRAY: - i = 16; + ctx.i = 16; break; case HAMT_SUBTAG_HEAD_BITMAP: case HAMT_SUBTAG_NODE_BITMAP: - i = hashmap_bitcount(MAP_HEADER_VAL(hdr)); + ctx.i = hashmap_bitcount(MAP_HEADER_VAL(hdr)); break; default: erts_exit(ERTS_ERROR_EXIT, "bad header"); } - while (i) { - if (is_list(*ptr)) { - Eterm* cons = list_val(*ptr); + while (ctx.i) { + if (is_list(*ctx.ptr)) { + Eterm* cons = list_val(*ctx.ptr); ESTACK_PUSH(s, HASH_MAP_PAIR); ESTACK_PUSH(s, CDR(cons)); ESTACK_PUSH(s, CAR(cons)); } else { - ASSERT(is_boxed(*ptr)); - ESTACK_PUSH(s, *ptr); + ASSERT(is_boxed(*ctx.ptr)); + ESTACK_PUSH(s, *ctx.ptr); } - i--; ptr++; + ctx.i--; ctx.ptr++; + TRAP_LOCATION(map_subtag); } goto hash2_common; } @@ -1344,22 +1628,25 @@ make_hash2(Eterm term) case FUN_SUBTAG: { ErlFunThing* funp = (ErlFunThing *) fun_val(term); - Uint num_free = funp->num_free; + ErtsMakeHash2Context_FUN_SUBTAG ctx = { + .num_free = funp->num_free, + .bptr = NULL}; UINT32_HASH_2 - (num_free, + (ctx.num_free, atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue, HCONST); UINT32_HASH_2 - (funp->fe->old_index, funp->fe->old_uniq, HCONST); - if (num_free == 0) { + (funp->fe->index, funp->fe->old_uniq, HCONST); + if (ctx.num_free == 0) { goto hash2_common; } else { - Eterm* bptr = funp->env + num_free - 1; - while (num_free-- > 1) { - term = *bptr--; + ctx.bptr = funp->env + ctx.num_free - 1; + while (ctx.num_free-- > 1) { + term = *ctx.bptr--; ESTACK_PUSH(s, term); + TRAP_LOCATION(fun_subtag); } - term = *bptr; + term = *ctx.bptr; } } break; @@ -1367,70 +1654,190 @@ make_hash2(Eterm term) case HEAP_BINARY_SUBTAG: case SUB_BINARY_SUBTAG: { - byte* bptr; - unsigned sz = binary_size(term); +#define BYTE_BITS 8 + ErtsMakeHash2Context_SUB_BINARY_SUBTAG ctx = { + .bptr = 0, + /* !!!!!!!!!!!!!!!!!!!! OBS !!!!!!!!!!!!!!!!!!!! + * + * The size is truncated to 32 bits on the line + * below so that the code is compatible with old + * versions of the code. This means that hash + * values for binaries with a size greater than + * 4GB do not take all bytes in consideration. + * + * !!!!!!!!!!!!!!!!!!!! OBS !!!!!!!!!!!!!!!!!!!! + */ + .sz = (0xFFFFFFFF & binary_size(term)), + .bitsize = 0, + .bitoffs = 0, + .no_bytes_processed = 0 + }; Uint32 con = HCONST_13 + hash; - Uint bitoffs; - Uint bitsize; - - ERTS_GET_BINARY_BYTES(term, bptr, bitoffs, bitsize); - if (sz == 0 && bitsize == 0) { + Uint iters_for_bin = MAX(1, ctx.sz / BLOCK_HASH_BYTES_PER_ITER); + ERTS_GET_BINARY_BYTES(term, ctx.bptr, ctx.bitoffs, ctx.bitsize); + if (ctx.sz == 0 && ctx.bitsize == 0) { hash = con; - } else { - if (bitoffs == 0) { - hash = block_hash(bptr, sz, con); - if (bitsize > 0) { - UINT32_HASH_2(bitsize, (bptr[sz] >> (8 - bitsize)), - HCONST_15); - } - } else { - byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, - sz + (bitsize != 0)); - erts_copy_bits(bptr, bitoffs, 1, buf, 0, 1, sz*8+bitsize); - hash = block_hash(buf, sz, con); - if (bitsize > 0) { - UINT32_HASH_2(bitsize, (buf[sz] >> (8 - bitsize)), - HCONST_15); - } - erts_free(ERTS_ALC_T_TMP, (void *) buf); - } + } else if (ctx.bitoffs == 0 && + (!can_trap || + (iterations_until_trap - iters_for_bin) > 0)) { + /* No need to trap while hashing binary */ + if (can_trap) iterations_until_trap -= iters_for_bin; + hash = block_hash(ctx.bptr, ctx.sz, con); + if (ctx.bitsize > 0) { + UINT32_HASH_2(ctx.bitsize, + (ctx.bptr[ctx.sz] >> (BYTE_BITS - ctx.bitsize)), + HCONST_15); + } + } else if (ctx.bitoffs == 0) { + /* Need to trap while hashing binary */ + ErtsBlockHashHelperCtx* block_hash_ctx = &ctx.block_hash_ctx; + block_hash_setup(con, block_hash_ctx); + do { + Uint max_bytes_to_process = + iterations_until_trap <= 0 ? BLOCK_HASH_BYTES_PER_ITER : + iterations_until_trap * BLOCK_HASH_BYTES_PER_ITER; + Uint bytes_left = ctx.sz - ctx.no_bytes_processed; + Uint even_bytes_left = + bytes_left - (bytes_left % BLOCK_HASH_BYTES_PER_ITER); + Uint bytes_to_process = + MIN(max_bytes_to_process, even_bytes_left); + block_hash_buffer(&ctx.bptr[ctx.no_bytes_processed], + bytes_to_process, + block_hash_ctx); + ctx.no_bytes_processed += bytes_to_process; + iterations_until_trap -= + MAX(1, bytes_to_process / BLOCK_HASH_BYTES_PER_ITER); + TRAP_LOCATION_NO_RED(sub_binary_subtag_1); + block_hash_ctx = &ctx.block_hash_ctx; /* Restore after trap */ + } while ((ctx.sz - ctx.no_bytes_processed) >= + BLOCK_HASH_BYTES_PER_ITER); + hash = block_hash_final_bytes(ctx.bptr + + ctx.no_bytes_processed, + ctx.sz - ctx.no_bytes_processed, + ctx.sz, + block_hash_ctx); + if (ctx.bitsize > 0) { + UINT32_HASH_2(ctx.bitsize, + (ctx.bptr[ctx.sz] >> (BYTE_BITS - ctx.bitsize)), + HCONST_15); + } + } else if (/* ctx.bitoffs != 0 && */ + (!can_trap || + (iterations_until_trap - iters_for_bin) > 0)) { + /* No need to trap while hashing binary */ + Uint nr_of_bytes = ctx.sz + (ctx.bitsize != 0); + byte *buf = erts_alloc(ERTS_ALC_T_TMP, nr_of_bytes); + Uint nr_of_bits_to_copy = ctx.sz*BYTE_BITS+ctx.bitsize; + if (can_trap) iterations_until_trap -= iters_for_bin; + erts_copy_bits(ctx.bptr, + ctx.bitoffs, 1, buf, 0, 1, nr_of_bits_to_copy); + hash = block_hash(buf, ctx.sz, con); + if (ctx.bitsize > 0) { + UINT32_HASH_2(ctx.bitsize, + (buf[ctx.sz] >> (BYTE_BITS - ctx.bitsize)), + HCONST_15); + } + erts_free(ERTS_ALC_T_TMP, buf); + } else /* ctx.bitoffs != 0 && */ { +#ifdef DEBUG +#define BINARY_BUF_SIZE (BLOCK_HASH_BYTES_PER_ITER * 3) +#else +#define BINARY_BUF_SIZE (BLOCK_HASH_BYTES_PER_ITER * 256) +#endif +#define BINARY_BUF_SIZE_BITS (BINARY_BUF_SIZE*BYTE_BITS) + /* Need to trap while hashing binary */ + ErtsBlockHashHelperCtx* block_hash_ctx = &ctx.block_hash_ctx; + Uint nr_of_bytes = ctx.sz + (ctx.bitsize != 0); + ERTS_CT_ASSERT(BINARY_BUF_SIZE % BLOCK_HASH_BYTES_PER_ITER == 0); + ctx.buf = erts_alloc(ERTS_ALC_T_PHASH2_TRAP, + MIN(nr_of_bytes, BINARY_BUF_SIZE)); + block_hash_setup(con, block_hash_ctx); + do { + Uint bytes_left = + ctx.sz - ctx.no_bytes_processed; + Uint even_bytes_left = + bytes_left - (bytes_left % BLOCK_HASH_BYTES_PER_ITER); + Uint bytes_to_process = + MIN(BINARY_BUF_SIZE, even_bytes_left); + Uint nr_of_bits_left = + (ctx.sz*BYTE_BITS+ctx.bitsize) - + ctx.no_bytes_processed*BYTE_BITS; + Uint nr_of_bits_to_copy = + MIN(nr_of_bits_left, BINARY_BUF_SIZE_BITS); + ctx.done = nr_of_bits_left == nr_of_bits_to_copy; + erts_copy_bits(ctx.bptr + ctx.no_bytes_processed, + ctx.bitoffs, 1, ctx.buf, 0, 1, + nr_of_bits_to_copy); + block_hash_buffer(ctx.buf, + bytes_to_process, + block_hash_ctx); + ctx.no_bytes_processed += bytes_to_process; + iterations_until_trap -= + MAX(1, bytes_to_process / BLOCK_HASH_BYTES_PER_ITER); + TRAP_LOCATION_NO_RED(sub_binary_subtag_2); + block_hash_ctx = &ctx.block_hash_ctx; /* Restore after trap */ + } while (!ctx.done); + nr_of_bytes = ctx.sz + (ctx.bitsize != 0); + hash = block_hash_final_bytes(ctx.buf + + (ctx.no_bytes_processed - + ((nr_of_bytes-1) / BINARY_BUF_SIZE) * BINARY_BUF_SIZE), + ctx.sz - ctx.no_bytes_processed, + ctx.sz, + block_hash_ctx); + if (ctx.bitsize > 0) { + Uint last_byte_index = + nr_of_bytes - (((nr_of_bytes-1) / BINARY_BUF_SIZE) * BINARY_BUF_SIZE) -1; + UINT32_HASH_2(ctx.bitsize, + (ctx.buf[last_byte_index] >> (BYTE_BITS - ctx.bitsize)), + HCONST_15); + } + erts_free(ERTS_ALC_T_PHASH2_TRAP, ctx.buf); + context->trap_location_state.sub_binary_subtag_2.buf = NULL; } goto hash2_common; +#undef BYTE_BITS +#undef BINARY_BUF_SIZE +#undef BINARY_BUF_SIZE_BITS } break; case POS_BIG_SUBTAG: case NEG_BIG_SUBTAG: { - Eterm* ptr = big_val(term); - Uint i = 0; - Uint n = BIG_SIZE(ptr); - Uint32 con = BIG_SIGN(ptr) ? HCONST_10 : HCONST_11; + Eterm* big_val_ptr = big_val(term); + ErtsMakeHash2Context_NEG_BIG_SUBTAG ctx = { + .ptr = big_val_ptr, + .i = 0, + .n = BIG_SIZE(big_val_ptr), + .con = BIG_SIGN(big_val_ptr) ? HCONST_10 : HCONST_11}; #if D_EXP == 16 do { Uint32 x, y; - x = i < n ? BIG_DIGIT(ptr, i++) : 0; - x += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16; - y = i < n ? BIG_DIGIT(ptr, i++) : 0; - y += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16; - UINT32_HASH_2(x, y, con); - } while (i < n); + x = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0; + x += (Uint32)(ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0) << 16; + y = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0; + y += (Uint32)(ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0) << 16; + UINT32_HASH_2(x, y, ctx.con); + TRAP_LOCATION(neg_big_subtag); + } while (ctx.i < ctx.n); #elif D_EXP == 32 do { Uint32 x, y; - x = i < n ? BIG_DIGIT(ptr, i++) : 0; - y = i < n ? BIG_DIGIT(ptr, i++) : 0; - UINT32_HASH_2(x, y, con); - } while (i < n); + x = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0; + y = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0; + UINT32_HASH_2(x, y, ctx.con); + TRAP_LOCATION(neg_big_subtag); + } while (ctx.i < ctx.n); #elif D_EXP == 64 do { Uint t; Uint32 x, y; - ASSERT(i < n); - t = BIG_DIGIT(ptr, i++); + ASSERT(ctx.i < ctx.n); + t = BIG_DIGIT(ctx.ptr, ctx.i++); x = t & 0xffffffff; y = t >> 32; - UINT32_HASH_2(x, y, con); - } while (i < n); + UINT32_HASH_2(x, y, ctx.con); + TRAP_LOCATION(neg_big_subtag); + } while (ctx.i < ctx.n); #else #error "unsupported D_EXP size" #endif @@ -1508,13 +1915,13 @@ make_hash2(Eterm term) } case _TAG_IMMED1_SMALL: { - Sint x = signed_val(term); + Sint small = signed_val(term); + if (SMALL_BITS > 28 && !IS_SSMALL28(small)) { + NOT_SSMALL28_HASH(small); + } else { + SINT32_HASH(small, HCONST); + } - if (SMALL_BITS > 28 && !IS_SSMALL28(x)) { - term = small_to_big(x, tmp_big); - break; - } - SINT32_HASH(x, HCONST); goto hash2_common; } } @@ -1529,7 +1936,10 @@ make_hash2(Eterm term) if (ESTACK_ISEMPTY(s)) { DESTROY_ESTACK(s); - UnUseTmpHeapNoproc(2); + if (can_trap) { + BUMP_REDS(p, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED); + ASSERT(!(p->flags & F_DISABLE_GC)); + } return hash; } @@ -1540,18 +1950,37 @@ make_hash2(Eterm term) hash = (Uint32) ESTACK_POP(s); UINT32_HASH(hash_xor_pairs, HCONST_19); hash_xor_pairs = (Uint32) ESTACK_POP(s); + TRAP_LOCATION_NO_CTX(hash2_common_1); goto hash2_common; } case HASH_MAP_PAIR: hash_xor_pairs ^= hash; hash = 0; + TRAP_LOCATION_NO_CTX(hash2_common_2); goto hash2_common; default: break; } + } + TRAP_LOCATION_NO_CTX(hash2_common_3); } } +#undef TRAP_LOCATION_NO_RED +#undef TRAP_LOCATION +#undef TRAP_LOCATION_NO_CTX +} + +Uint32 +make_hash2(Eterm term) +{ + return make_hash2_helper(term, 0, NULL, NULL); +} + +Uint32 +trapping_make_hash2(Eterm term, Eterm* state_mref_write_back, Process* p) +{ + return make_hash2_helper(term, 1, state_mref_write_back, p); } /* Term hash function for internal use. @@ -1731,7 +2160,7 @@ make_internal_hash(Eterm term, Uint32 salt) ErlFunThing* funp = (ErlFunThing *) fun_val(term); Uint num_free = funp->num_free; UINT32_HASH_2(num_free, funp->fe->module, HCONST_20); - UINT32_HASH_2(funp->fe->old_index, funp->fe->old_uniq, HCONST_21); + UINT32_HASH_2(funp->fe->index, funp->fe->old_uniq, HCONST_21); if (num_free == 0) { goto pop_next; } else { @@ -2381,7 +2810,7 @@ tailrecur_ne: f1 = (ErlFunThing *) fun_val(a); f2 = (ErlFunThing *) fun_val(b); if (f1->fe->module != f2->fe->module || - f1->fe->old_index != f2->fe->old_index || + f1->fe->index != f2->fe->index || f1->fe->old_uniq != f2->fe->old_uniq || f1->num_free != f2->num_free) { goto not_equal; @@ -2976,7 +3405,7 @@ tailrecur_ne: if (diff != 0) { RETURN_NEQ(diff); } - diff = f1->fe->old_index - f2->fe->old_index; + diff = f1->fe->index - f2->fe->index; if (diff != 0) { RETURN_NEQ(diff); } diff --git a/erts/emulator/nifs/common/prim_file_nif.c b/erts/emulator/nifs/common/prim_file_nif.c index 3df04e42e2..5c5e9a2d30 100644 --- a/erts/emulator/nifs/common/prim_file_nif.c +++ b/erts/emulator/nifs/common/prim_file_nif.c @@ -162,6 +162,7 @@ WRAP_FILE_HANDLE_EXPORT(allocate_nif) WRAP_FILE_HANDLE_EXPORT(advise_nif) WRAP_FILE_HANDLE_EXPORT(get_handle_nif) WRAP_FILE_HANDLE_EXPORT(ipread_s32bu_p32bu_nif) +WRAP_FILE_HANDLE_EXPORT(read_handle_info_nif) static ErlNifFunc nif_funcs[] = { /* File handle ops */ @@ -176,6 +177,7 @@ static ErlNifFunc nif_funcs[] = { {"truncate_nif", 1, truncate_nif, ERL_NIF_DIRTY_JOB_IO_BOUND}, {"allocate_nif", 3, allocate_nif, ERL_NIF_DIRTY_JOB_IO_BOUND}, {"advise_nif", 4, advise_nif, ERL_NIF_DIRTY_JOB_IO_BOUND}, + {"read_handle_info_nif", 1, read_handle_info_nif, ERL_NIF_DIRTY_JOB_IO_BOUND}, /* Filesystem ops */ {"make_hard_link_nif", 2, make_hard_link_nif, ERL_NIF_DIRTY_JOB_IO_BOUND}, @@ -231,6 +233,7 @@ static int load(ErlNifEnv *env, void** priv_data, ERL_NIF_TERM prim_file_pid) am_append = enif_make_atom(env, "append"); am_sync = enif_make_atom(env, "sync"); am_skip_type_check = enif_make_atom(env, "skip_type_check"); + am_directory = enif_make_atom(env, "directory"); am_read_write = enif_make_atom(env, "read_write"); am_none = enif_make_atom(env, "none"); @@ -447,6 +450,8 @@ static enum efile_modes_t efile_translate_modelist(ErlNifEnv *env, ERL_NIF_TERM modes |= EFILE_MODE_SYNC; } else if(enif_is_identical(head, am_skip_type_check)) { modes |= EFILE_MODE_SKIP_TYPE_CHECK; + } else if (enif_is_identical(head, am_directory)) { + modes |= EFILE_MODE_DIRECTORY; } else { /* Modes like 'raw', 'ram', 'delayed_writes' etc are handled * further up the chain. */ @@ -893,6 +898,26 @@ static ERL_NIF_TERM get_handle_nif_impl(efile_data_t *d, ErlNifEnv *env, int arg return efile_get_handle(env, d); } +static ERL_NIF_TERM build_file_info(ErlNifEnv *env, efile_fileinfo_t *info) { + /* #file_info as declared in file.hrl */ + return enif_make_tuple(env, 14, + am_file_info, + enif_make_uint64(env, info->size), + efile_filetype_to_atom(info->type), + efile_access_to_atom(info->access), + enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info->a_time)), + enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info->m_time)), + enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info->c_time)), + enif_make_uint(env, info->mode), + enif_make_uint(env, info->links), + enif_make_uint(env, info->major_device), + enif_make_uint(env, info->minor_device), + enif_make_uint(env, info->inode), + enif_make_uint(env, info->uid), + enif_make_uint(env, info->gid) + ); +} + static ERL_NIF_TERM read_info_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { posix_errno_t posix_errno; @@ -911,23 +936,20 @@ static ERL_NIF_TERM read_info_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM a return posix_error_to_tuple(env, posix_errno); } - /* #file_info as declared in file.hrl */ - return enif_make_tuple(env, 14, - am_file_info, - enif_make_uint64(env, info.size), - efile_filetype_to_atom(info.type), - efile_access_to_atom(info.access), - enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info.a_time)), - enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info.m_time)), - enif_make_int64(env, MAX(EFILE_MIN_FILETIME, info.c_time)), - enif_make_uint(env, info.mode), - enif_make_uint(env, info.links), - enif_make_uint(env, info.major_device), - enif_make_uint(env, info.minor_device), - enif_make_uint(env, info.inode), - enif_make_uint(env, info.uid), - enif_make_uint(env, info.gid) - ); + return build_file_info(env, &info); +} + +static ERL_NIF_TERM read_handle_info_nif_impl(efile_data_t *d, ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { + posix_errno_t posix_errno; + efile_fileinfo_t info = {0}; + + ASSERT(argc == 0); + + if((posix_errno = efile_read_handle_info(d, &info))) { + return posix_error_to_tuple(env, posix_errno); + } + + return build_file_info(env, &info); } static ERL_NIF_TERM set_permissions_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) { diff --git a/erts/emulator/nifs/common/prim_file_nif.h b/erts/emulator/nifs/common/prim_file_nif.h index b2e30c59dd..28c1ea9d00 100644 --- a/erts/emulator/nifs/common/prim_file_nif.h +++ b/erts/emulator/nifs/common/prim_file_nif.h @@ -30,6 +30,8 @@ enum efile_modes_t { EFILE_MODE_SKIP_TYPE_CHECK = (1 << 5), /* Special for device files on Unix. */ EFILE_MODE_NO_TRUNCATE = (1 << 6), /* Special for reopening on VxWorks. */ + EFILE_MODE_DIRECTORY = (1 << 7), + EFILE_MODE_READ_WRITE = EFILE_MODE_READ | EFILE_MODE_WRITE }; @@ -168,6 +170,7 @@ int efile_close(efile_data_t *d, posix_errno_t *error); /* **** **** **** **** **** **** **** **** **** **** **** **** **** **** **** */ posix_errno_t efile_read_info(const efile_path_t *path, int follow_link, efile_fileinfo_t *result); +posix_errno_t efile_read_handle_info(efile_data_t *d, efile_fileinfo_t *result); /** @brief Sets the file times to the given values. Refer to efile_fileinfo_t * for a description of each. */ diff --git a/erts/emulator/nifs/common/socket_nif.c b/erts/emulator/nifs/common/socket_nif.c index bbeb8b6cdd..881a9c7ccd 100644 --- a/erts/emulator/nifs/common/socket_nif.c +++ b/erts/emulator/nifs/common/socket_nif.c @@ -9751,8 +9751,12 @@ ERL_NIF_TERM esock_setopt_lvl_ipv6_addrform(ErlNifEnv* env, domain) ); res = socket_setopt(descP->sock, - SOL_IPV6, IPV6_ADDRFORM, - &domain, sizeof(domain)); +#if defined(SOL_IPV6) + SOL_IPV6, +#else + IPPROTO_IPV6, +#endif + IPV6_ADDRFORM, &domain, sizeof(domain)); if (res != 0) result = esock_make_error_errno(env, sock_errno()); @@ -9782,7 +9786,14 @@ ERL_NIF_TERM esock_setopt_lvl_ipv6_authhdr(ErlNifEnv* env, ESockDescriptor* descP, ERL_NIF_TERM eVal) { - return esock_setopt_bool_opt(env, descP, SOL_IPV6, IPV6_AUTHHDR, eVal); +#if defined(SOL_IPV6) + int level = SOL_IPV6; +#else + int level = IPPROTO_IPV6; +#endif + + + return esock_setopt_bool_opt(env, descP, level, IPV6_AUTHHDR, eVal); } #endif diff --git a/erts/emulator/nifs/unix/unix_prim_file.c b/erts/emulator/nifs/unix/unix_prim_file.c index 169b193993..176a9318b2 100644 --- a/erts/emulator/nifs/unix/unix_prim_file.c +++ b/erts/emulator/nifs/unix/unix_prim_file.c @@ -107,7 +107,7 @@ ERL_NIF_TERM efile_get_handle(ErlNifEnv *env, efile_data_t *d) { return result; } -static int open_file_type_check(const efile_path_t *path, int fd) { +static int open_file_is_dir(const efile_path_t *path, int fd) { struct stat file_info; int error; @@ -119,27 +119,14 @@ static int open_file_type_check(const efile_path_t *path, int fd) { (void)path; #endif - if(error < 0) { - /* If we failed to stat assume success and let the next call handle the - * error. The old driver checked whether the file was to be used - * immediately in a read within the call, but the new implementation - * never does that. */ - return 1; - } - - /* Allow everything that isn't a directory, and error out on the next call - * if it's unsupported. */ - if(S_ISDIR(file_info.st_mode)) { - return 0; - } - - return 1; + /* Assume not a directory on error. */ + return error == 0 && S_ISDIR(file_info.st_mode); } posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes, ErlNifResourceType *nif_type, efile_data_t **d) { - int flags, fd; + int mode, flags, fd; flags = 0; @@ -174,18 +161,38 @@ posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes, #endif } + if(modes & EFILE_MODE_DIRECTORY) { + mode = DIR_MODE; +#ifdef O_DIRECTORY + flags |= O_DIRECTORY; +#endif + } else { + mode = FILE_MODE; + } + do { - fd = open((const char*)path->data, flags, FILE_MODE); + fd = open((const char*)path->data, flags, mode); } while(fd == -1 && errno == EINTR); if(fd != -1) { efile_unix_t *u; - if(!(modes & EFILE_MODE_SKIP_TYPE_CHECK) && !open_file_type_check(path, fd)) { +#ifndef O_DIRECTORY + /* On platforms without O_DIRECTORY support, ensure that using the + * directory flag to open a file fails. */ + if(!(modes & EFILE_MODE_SKIP_TYPE_CHECK) && + (modes & EFILE_MODE_DIRECTORY) && !open_file_is_dir(path, fd)) { close(fd); + return ENOTDIR; + } +#endif - /* This is blatantly incorrect, but we're documented as returning - * this for everything that isn't a file. */ + /* open() works on directories without the O_DIRECTORY flag but for + * consistency across platforms we require that the user has requested + * directory mode. */ + if(!(modes & EFILE_MODE_SKIP_TYPE_CHECK) && + !(modes & EFILE_MODE_DIRECTORY) && open_file_is_dir(path, fd)) { + close(fd); return EISDIR; } @@ -620,6 +627,33 @@ int efile_truncate(efile_data_t *d) { return 1; } +static void build_file_info(struct stat *data, efile_fileinfo_t *result) { + if(S_ISCHR(data->st_mode) || S_ISBLK(data->st_mode)) { + result->type = EFILE_FILETYPE_DEVICE; + } else if(S_ISDIR(data->st_mode)) { + result->type = EFILE_FILETYPE_DIRECTORY; + } else if(S_ISREG(data->st_mode)) { + result->type = EFILE_FILETYPE_REGULAR; + } else if(S_ISLNK(data->st_mode)) { + result->type = EFILE_FILETYPE_SYMLINK; + } else { + result->type = EFILE_FILETYPE_OTHER; + } + + result->a_time = (Sint64)data->st_atime; + result->m_time = (Sint64)data->st_mtime; + result->c_time = (Sint64)data->st_ctime; + result->size = data->st_size; + + result->major_device = data->st_dev; + result->minor_device = data->st_rdev; + result->links = data->st_nlink; + result->inode = data->st_ino; + result->mode = data->st_mode; + result->uid = data->st_uid; + result->gid = data->st_gid; +} + posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_fileinfo_t *result) { struct stat data; @@ -633,30 +667,7 @@ posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_ } } - if(S_ISCHR(data.st_mode) || S_ISBLK(data.st_mode)) { - result->type = EFILE_FILETYPE_DEVICE; - } else if(S_ISDIR(data.st_mode)) { - result->type = EFILE_FILETYPE_DIRECTORY; - } else if(S_ISREG(data.st_mode)) { - result->type = EFILE_FILETYPE_REGULAR; - } else if(S_ISLNK(data.st_mode)) { - result->type = EFILE_FILETYPE_SYMLINK; - } else { - result->type = EFILE_FILETYPE_OTHER; - } - - result->a_time = (Sint64)data.st_atime; - result->m_time = (Sint64)data.st_mtime; - result->c_time = (Sint64)data.st_ctime; - result->size = data.st_size; - - result->major_device = data.st_dev; - result->minor_device = data.st_rdev; - result->links = data.st_nlink; - result->inode = data.st_ino; - result->mode = data.st_mode; - result->uid = data.st_uid; - result->gid = data.st_gid; + build_file_info(&data, result); #ifndef NO_ACCESS result->access = EFILE_ACCESS_NONE; @@ -675,6 +686,56 @@ posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_ return 0; } +static int check_access(struct stat *st) { + int ret = EFILE_ACCESS_NONE; + + if(st->st_uid == getuid()) { + if(st->st_mode & S_IRUSR) { + ret |= EFILE_ACCESS_READ; + } + if(st->st_mode & S_IWUSR) { + ret |= EFILE_ACCESS_WRITE; + } + return ret; + } + + if(st->st_gid == getgid()) { + if(st->st_mode & S_IRGRP) { + ret |= EFILE_ACCESS_READ; + } + if(st->st_mode & S_IWGRP) { + ret |= EFILE_ACCESS_WRITE; + } + return ret; + } + + if(st->st_mode & S_IROTH) { + ret |= EFILE_ACCESS_READ; + } + if(st->st_mode & S_IWOTH) { + ret |= EFILE_ACCESS_WRITE; + } + return ret; +} + +posix_errno_t efile_read_handle_info(efile_data_t *d, efile_fileinfo_t *result) { + struct stat data; + efile_unix_t *u = (efile_unix_t*)d; + +#ifdef HAVE_FSTAT + if(fstat(u->fd, &data) < 0) { + return errno; + } + + build_file_info(&data, result); + result->access = check_access(&data); + + return 0; +#else + return ENOTSUP; +#endif +} + posix_errno_t efile_set_permissions(const efile_path_t *path, Uint32 permissions) { const mode_t MUTABLE_MODES = (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO); mode_t new_modes = permissions & MUTABLE_MODES; diff --git a/erts/emulator/nifs/win32/win_prim_file.c b/erts/emulator/nifs/win32/win_prim_file.c index e7d3924240..839ac3ea6e 100644 --- a/erts/emulator/nifs/win32/win_prim_file.c +++ b/erts/emulator/nifs/win32/win_prim_file.c @@ -270,6 +270,17 @@ static int normalize_path_result(ErlNifBinary *path) { } /* @brief Checks whether all the given attributes are set on the object at the + * given handle. Note that it assumes false on errors. */ +static int handle_has_file_attributes(HANDLE handle, DWORD mask) { + BY_HANDLE_FILE_INFORMATION native_file_info; + if(!GetFileInformationByHandle(handle, &native_file_info)) { + return 0; + } + + return !!((native_file_info.dwFileAttributes & mask) == mask); +} + +/* @brief Checks whether all the given attributes are set on the object at the * given path. Note that it assumes false on errors. */ static int has_file_attributes(const efile_path_t *path, DWORD mask) { DWORD attributes = GetFileAttributesW((WCHAR*)path->data); @@ -412,10 +423,15 @@ posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes, ASSERT_PATH_FORMAT(path); + attributes = 0; access_flags = 0; open_mode = 0; - if(modes & EFILE_MODE_READ && !(modes & EFILE_MODE_WRITE)) { + if(modes & EFILE_MODE_DIRECTORY) { + attributes = FILE_FLAG_BACKUP_SEMANTICS; + access_flags = GENERIC_READ; + open_mode = OPEN_EXISTING; + } else if(modes & EFILE_MODE_READ && !(modes & EFILE_MODE_WRITE)) { access_flags = GENERIC_READ; open_mode = OPEN_EXISTING; } else if(modes & EFILE_MODE_WRITE && !(modes & EFILE_MODE_READ)) { @@ -438,9 +454,9 @@ posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes, } if(modes & EFILE_MODE_SYNC) { - attributes = FILE_FLAG_WRITE_THROUGH; + attributes |= FILE_FLAG_WRITE_THROUGH; } else { - attributes = FILE_ATTRIBUTE_NORMAL; + attributes |= FILE_ATTRIBUTE_NORMAL; } handle = CreateFileW((WCHAR*)path->data, access_flags, @@ -449,6 +465,12 @@ posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes, if(handle != INVALID_HANDLE_VALUE) { efile_win_t *w; + /* Directory mode specified, but path is not a directory. */ + if((modes & EFILE_MODE_DIRECTORY) && !handle_has_file_attributes(handle, FILE_ATTRIBUTE_DIRECTORY)) { + CloseHandle(handle); + return ENOTDIR; + } + w = (efile_win_t*)enif_alloc_resource(nif_type, sizeof(efile_win_t)); w->handle = handle; @@ -461,7 +483,7 @@ posix_errno_t efile_open(const efile_path_t *path, enum efile_modes_t modes, /* Rewrite all failures on directories to EISDIR to match the old * driver. */ - if(has_file_attributes(path, FILE_ATTRIBUTE_DIRECTORY)) { + if(!(modes & EFILE_MODE_DIRECTORY) && has_file_attributes(path, FILE_ATTRIBUTE_DIRECTORY)) { return EISDIR; } @@ -751,6 +773,71 @@ static int is_name_surrogate(const efile_path_t *path) { return result; } +static void build_file_info(BY_HANDLE_FILE_INFORMATION *native_file_info, const efile_path_t *path, int is_link, efile_fileinfo_t *result) { + DWORD attributes; + + attributes = native_file_info->dwFileAttributes; + + if(is_link) { + result->type = EFILE_FILETYPE_SYMLINK; + /* This should be _S_IFLNK, but the old driver always set + * non-directories to _S_IFREG. */ + result->mode |= _S_IFREG; + } else if(attributes & FILE_ATTRIBUTE_DIRECTORY) { + result->type = EFILE_FILETYPE_DIRECTORY; + result->mode |= _S_IFDIR | _S_IEXEC; + } else { + if(is_executable_file(path)) { + result->mode |= _S_IEXEC; + } + + result->type = EFILE_FILETYPE_REGULAR; + result->mode |= _S_IFREG; + } + + if(!(attributes & FILE_ATTRIBUTE_READONLY)) { + result->access = EFILE_ACCESS_READ | EFILE_ACCESS_WRITE; + result->mode |= _S_IREAD | _S_IWRITE; + } else { + result->access = EFILE_ACCESS_READ; + result->mode |= _S_IREAD; + } + + /* Propagate user mode-bits to group/other fields */ + result->mode |= (result->mode & 0700) >> 3; + result->mode |= (result->mode & 0700) >> 6; + + result->size = + ((Uint64)native_file_info->nFileSizeHigh << 32ull) | + (Uint64)native_file_info->nFileSizeLow; + result->links = MAX(1, native_file_info->nNumberOfLinks); + + result->major_device = get_drive_number(path); + result->minor_device = 0; + result->inode = 0; + result->uid = 0; + result->gid = 0; +} + +static void build_file_info_times(BY_HANDLE_FILE_INFORMATION *native_file_info, efile_fileinfo_t *result) { + FILETIME_TO_EPOCH(result->m_time, native_file_info->ftLastWriteTime); + FILETIME_TO_EPOCH(result->a_time, native_file_info->ftLastAccessTime); + FILETIME_TO_EPOCH(result->c_time, native_file_info->ftCreationTime); + + if(result->m_time == -EPOCH_DIFFERENCE) { + /* Default to 1970 just like the old driver. */ + result->m_time = 0; + } + + if(result->a_time == -EPOCH_DIFFERENCE) { + result->a_time = result->m_time; + } + + if(result->c_time == -EPOCH_DIFFERENCE) { + result->c_time = result->m_time; + } +} + posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_fileinfo_t *result) { BY_HANDLE_FILE_INFORMATION native_file_info; DWORD attributes; @@ -770,23 +857,41 @@ posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_ return windows_to_posix_errno(last_error); } - attributes = FILE_ATTRIBUTE_DIRECTORY; + native_file_info.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY; } else if(is_path_root(path)) { /* Local (or mounted) roots can be queried with GetFileAttributesW but * lack support for GetFileInformationByHandle, so we'll skip that * part. */ + native_file_info.dwFileAttributes = attributes; } else { HANDLE handle; + DWORD last_error; + DWORD flags; if(attributes & FILE_ATTRIBUTE_REPARSE_POINT) { is_link = is_name_surrogate(path); } + flags = FILE_FLAG_BACKUP_SEMANTICS; + if(!follow_links && is_link) { + flags |= FILE_FLAG_OPEN_REPARSE_POINT; + } + + handle = CreateFileW((const WCHAR*)path->data, GENERIC_READ, + FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, flags, NULL); + last_error = GetLastError(); + + if(handle == INVALID_HANDLE_VALUE) { + return windows_to_posix_errno(last_error); + } + if(follow_links && is_link) { posix_errno_t posix_errno; efile_path_t resolved_path; - posix_errno = internal_read_link(path, &resolved_path); + posix_errno = internal_read_link(handle, &resolved_path); + + CloseHandle(handle); if(posix_errno != 0) { return posix_errno; @@ -795,74 +900,43 @@ posix_errno_t efile_read_info(const efile_path_t *path, int follow_links, efile_ return efile_read_info(&resolved_path, 0, result); } - handle = CreateFileW((const WCHAR*)path->data, GENERIC_READ, - FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, - NULL); - - /* The old driver never cared whether this succeeded. */ - if(handle != INVALID_HANDLE_VALUE) { - GetFileInformationByHandle(handle, &native_file_info); - CloseHandle(handle); - } + GetFileInformationByHandle(handle, &native_file_info); + CloseHandle(handle); - FILETIME_TO_EPOCH(result->m_time, native_file_info.ftLastWriteTime); - FILETIME_TO_EPOCH(result->a_time, native_file_info.ftLastAccessTime); - FILETIME_TO_EPOCH(result->c_time, native_file_info.ftCreationTime); + build_file_info_times(&native_file_info, result); + } - if(result->m_time == -EPOCH_DIFFERENCE) { - /* Default to 1970 just like the old driver. */ - result->m_time = 0; - } + build_file_info(&native_file_info, path, is_link, result); - if(result->a_time == -EPOCH_DIFFERENCE) { - result->a_time = result->m_time; - } + return 0; +} - if(result->c_time == -EPOCH_DIFFERENCE) { - result->c_time = result->m_time; - } - } +posix_errno_t efile_read_handle_info(efile_data_t *d, efile_fileinfo_t *result) { + efile_win_t *w = (efile_win_t*)d; + HANDLE handle; + BY_HANDLE_FILE_INFORMATION native_file_info; + posix_errno_t posix_errno; + efile_path_t path; + int length; - if(is_link) { - result->type = EFILE_FILETYPE_SYMLINK; - /* This should be _S_IFLNK, but the old driver always set - * non-directories to _S_IFREG. */ - result->mode |= _S_IFREG; - } else if(attributes & FILE_ATTRIBUTE_DIRECTORY) { - result->type = EFILE_FILETYPE_DIRECTORY; - result->mode |= _S_IFDIR | _S_IEXEC; - } else { - if(is_executable_file(path)) { - result->mode |= _S_IEXEC; - } + sys_memset(&native_file_info, 0, sizeof(native_file_info)); - result->type = EFILE_FILETYPE_REGULAR; - result->mode |= _S_IFREG; + posix_errno = internal_read_link(w->handle, &path); + if(posix_errno != 0) { + return posix_errno; } - if(!(attributes & FILE_ATTRIBUTE_READONLY)) { - result->access = EFILE_ACCESS_READ | EFILE_ACCESS_WRITE; - result->mode |= _S_IREAD | _S_IWRITE; + if(GetFileInformationByHandle(w->handle, &native_file_info)) { + build_file_info_times(&native_file_info, result); + } else if(is_path_root(&path)) { + /* GetFileInformationByHandle is not supported on path roots, so + * fall back to efile_read_info. */ + return efile_read_info(&path, 0, result); } else { - result->access = EFILE_ACCESS_READ; - result->mode |= _S_IREAD; + return windows_to_posix_errno(GetLastError()); } - /* Propagate user mode-bits to group/other fields */ - result->mode |= (result->mode & 0700) >> 3; - result->mode |= (result->mode & 0700) >> 6; - - result->size = - ((Uint64)native_file_info.nFileSizeHigh << 32ull) | - (Uint64)native_file_info.nFileSizeLow; - - result->links = MAX(1, native_file_info.nNumberOfLinks); - - result->major_device = get_drive_number(path); - result->minor_device = 0; - result->inode = 0; - result->uid = 0; - result->gid = 0; + build_file_info(&native_file_info, &path, 0, result); return 0; } @@ -941,31 +1015,20 @@ posix_errno_t efile_set_time(const efile_path_t *path, Sint64 a_time, Sint64 m_t return windows_to_posix_errno(last_error); } -static posix_errno_t internal_read_link(const efile_path_t *path, efile_path_t *result) { +static posix_errno_t internal_read_link(HANDLE link_handle, efile_path_t *result) { DWORD required_length, actual_length; - HANDLE link_handle; DWORD last_error; - link_handle = CreateFileW((WCHAR*)path->data, GENERIC_READ, - FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); - last_error = GetLastError(); - - if(link_handle == INVALID_HANDLE_VALUE) { - return windows_to_posix_errno(last_error); - } - required_length = GetFinalPathNameByHandleW(link_handle, NULL, 0, 0); last_error = GetLastError(); if(required_length <= 0) { - CloseHandle(link_handle); return windows_to_posix_errno(last_error); } /* Unlike many other path functions (eg. GetFullPathNameW), this one * includes the NUL terminator in its required length. */ if(!enif_alloc_binary(required_length * sizeof(WCHAR), result)) { - CloseHandle(link_handle); return ENOMEM; } @@ -973,8 +1036,6 @@ static posix_errno_t internal_read_link(const efile_path_t *path, efile_path_t * (WCHAR*)result->data, required_length, 0); last_error = GetLastError(); - CloseHandle(link_handle); - if(actual_length == 0 || actual_length >= required_length) { enif_release_binary(result); return windows_to_posix_errno(last_error); @@ -992,6 +1053,8 @@ posix_errno_t efile_read_link(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_ posix_errno_t posix_errno; ErlNifBinary result_bin; DWORD attributes; + HANDLE handle; + DWORD last_error; ASSERT_PATH_FORMAT(path); @@ -1007,7 +1070,17 @@ posix_errno_t efile_read_link(ErlNifEnv *env, const efile_path_t *path, ERL_NIF_ return EINVAL; } - posix_errno = internal_read_link(path, &result_bin); + handle = CreateFileW((WCHAR*)path->data, GENERIC_READ, + FILE_SHARE_FLAGS, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, + NULL); + last_error = GetLastError(); + + if(handle == INVALID_HANDLE_VALUE) { + return windows_to_posix_errno(last_error); + } + posix_errno = internal_read_link(handle, &result_bin); + + CloseHandle(handle); if(posix_errno == 0) { if(!normalize_path_result(&result_bin)) { diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c index 129861ebd5..9241660069 100644 --- a/erts/emulator/sys/unix/erl_child_setup.c +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -75,6 +75,10 @@ #define SHELL "/bin/sh" #endif /* __ANDROID__ */ +#if !defined(MSG_DONTWAIT) && defined(MSG_NONBLOCK) +#define MSG_DONTWAIT MSG_NONBLOCK +#endif + //#define HARD_DEBUG #ifdef HARD_DEBUG #define DEBUG_PRINT(fmt, ...) fprintf(stderr, "%d:" fmt "\r\n", getpid(), ##__VA_ARGS__) diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index 4823e549ea..78866b356c 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -740,10 +740,17 @@ void os_version(int *pMajor, int *pMinor, int *pBuild) { * X.Y or X.Y.Z. */ (void) uname(&uts); +#ifdef _AIX + /* AIX stores the major in version and minor in release */ + *pMajor = atoi(uts.version); + *pMinor = atoi(uts.release); + *pBuild = 0; /* XXX: get oslevel for AIX or TR on i */ +#else release = uts.release; *pMajor = get_number(&release); /* Pointer to major version. */ *pMinor = get_number(&release); /* Pointer to minor version. */ *pBuild = get_number(&release); /* Pointer to build number. */ +#endif } void erts_do_break_handling(void) diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 019af2162f..731aa66924 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -90,6 +90,7 @@ MODULES= \ gc_SUITE \ guard_SUITE \ hash_SUITE \ + hash_property_test_SUITE \ hibernate_SUITE \ hipe_SUITE \ iovec_SUITE \ @@ -252,7 +253,7 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(NO_OPT_ERL_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NATIVE_ERL_FILES) "$(RELSYSDIR)" 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/erts/emulator/test/emulator.spec b/erts/emulator/test/emulator.spec index 7a6dd83020..087bd8880d 100644 --- a/erts/emulator/test/emulator.spec +++ b/erts/emulator/test/emulator.spec @@ -1,2 +1,3 @@ {enable_builtin_hooks, false}. {suites,"../emulator_test",all}. +{skip_groups,"../emulator_test",hash_SUITE,[phash2_benchmark],"Benchmark only"}. diff --git a/erts/emulator/test/emulator_bench.spec b/erts/emulator/test/emulator_bench.spec index 03638bfa23..8b1bb71a40 100644 --- a/erts/emulator/test/emulator_bench.spec +++ b/erts/emulator/test/emulator_bench.spec @@ -1,3 +1,4 @@ {groups,"../emulator_test",estone_SUITE,[estone_bench]}. {groups,"../emulator_test",binary_SUITE,[iolist_size_benchmarks]}. {groups,"../emulator_test",erts_debug_SUITE,[interpreter_size_bench]}. +{groups,"../emulator_test",hash_SUITE,[phash2_benchmark]}. diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl index 3cbb3c7d5f..dd71c3da58 100644 --- a/erts/emulator/test/hash_SUITE.erl +++ b/erts/emulator/test/hash_SUITE.erl @@ -33,7 +33,25 @@ -module(hash_SUITE). -export([basic_test/0,cmp_test/1,range_test/0,spread_test/1, phash2_test/0, otp_5292_test/0, - otp_7127_test/0]). + otp_7127_test/0, + run_phash2_benchmarks/0, + test_phash2_binary_aligned_and_unaligned_equal/1, + test_phash2_4GB_plus_bin/1, + test_phash2_10MB_plus_bin/1, + test_phash2_large_map/1, + test_phash2_shallow_long_list/1, + test_phash2_deep_list/1, + test_phash2_deep_tuple/1, + test_phash2_deep_tiny/1, + test_phash2_with_42/1, + test_phash2_with_short_tuple/1, + test_phash2_with_short_list/1, + test_phash2_with_tiny_bin/1, + test_phash2_with_tiny_unaligned_sub_binary/1, + test_phash2_with_small_unaligned_sub_binary/1, + test_phash2_with_large_bin/1, + test_phash2_with_large_unaligned_sub_binary/1, + test_phash2_with_super_large_unaligned_sub_binary/1]). %% %% Define to run outside of test server @@ -43,13 +61,15 @@ %% %% Define for debug output %% -%-define(debug,1). +-define(debug,1). -ifdef(STANDALONE). -define(config(A,B),config(A,B)). +-record(event, {name, data}). -export([config/2]). -else. -include_lib("common_test/include/ct.hrl"). +-include_lib("common_test/include/ct_event.hrl"). -endif. -ifdef(debug). @@ -67,12 +87,15 @@ -ifdef(STANDALONE). config(priv_dir,_) -> ".". +notify(X) -> + erlang:display(X). -else. %% When run in test server. --export([all/0, suite/0, +-export([groups/0, all/0, suite/0, test_basic/1,test_cmp/1,test_range/1,test_spread/1, test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, - test_hash_zero/1]). + test_hash_zero/1, init_per_suite/1, end_per_suite/1, + init_per_group/2, end_per_group/2]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -81,7 +104,71 @@ suite() -> all() -> [test_basic, test_cmp, test_range, test_spread, test_phash2, otp_5292, bit_level_binaries, otp_7127, - test_hash_zero]. + test_hash_zero, test_phash2_binary_aligned_and_unaligned_equal, + test_phash2_4GB_plus_bin, + test_phash2_10MB_plus_bin, + {group, phash2_benchmark_tests}, + {group, phash2_benchmark}]. + +get_phash2_benchmarks() -> + [ + test_phash2_large_map, + test_phash2_shallow_long_list, + test_phash2_deep_list, + test_phash2_deep_tuple, + test_phash2_deep_tiny, + test_phash2_with_42, + test_phash2_with_short_tuple, + test_phash2_with_short_list, + test_phash2_with_tiny_bin, + test_phash2_with_tiny_unaligned_sub_binary, + test_phash2_with_small_unaligned_sub_binary, + test_phash2_with_large_bin, + test_phash2_with_large_unaligned_sub_binary, + test_phash2_with_super_large_unaligned_sub_binary + ]. + +groups() -> + [ + { + phash2_benchmark_tests, + [], + get_phash2_benchmarks() + }, + { + phash2_benchmark, + [], + get_phash2_benchmarks() + } + ]. + + +init_per_suite(Config) -> + io:format("START APPS~n"), + A0 = case application:start(sasl) of + ok -> [sasl]; + _ -> [] + end, + A = case application:start(os_mon) of + ok -> [os_mon|A0]; + _ -> A0 + end, + io:format("APPS STARTED~n"), + [{started_apps, A}|Config]. + +end_per_suite(Config) -> + As = proplists:get_value(started_apps, Config), + lists:foreach(fun (A) -> application:stop(A) end, As), + Config. + +init_per_group(phash2_benchmark_tests, Config) -> + [phash2_benchmark_tests |Config]; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + %% Tests basic functionality of erlang:phash and that the %% hashes has not changed (neither hash nor phash) @@ -119,6 +206,9 @@ otp_7127(Config) when is_list(Config) -> test_hash_zero(Config) when is_list(Config) -> hash_zero_test(). + +notify(X) -> + ct_event:notify(X). -endif. @@ -133,26 +223,17 @@ basic_test() -> 16#77777777777777],16#FFFFFFFF), ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, - 1113403635 = erlang:phash(binary_to_term(ExternalReference), - 16#FFFFFFFF), - ExternalFun = <<131,117,0,0,0,3,103,100,0,13,110,111,110,111,100,101,64, - 110,111,104,111,115,116,0,0,0,38,0,0,0,0,0,100,0,8,101, - 114,108,95,101,118,97,108,97,20,98,5,182,139,98,108,0,0, - 0,3,104,2,100,0,1,66,109,0,0,0,33,131,114,0,3,100,0,13, - 110,111,110,111,100,101,64,110,111,104,111,115,116,0,0, - 0,0,122,0,0,0,0,0,0,0,0,104,2,100,0,1,76,107,0,33,131, - 114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, - 111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0,104,2,100,0,1,82, - 114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, - 111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0,106,108,0,0,0,1, - 104,5,100,0,6,99,108,97,117,115,101,97,1,106,106,108,0,0, - 0,1,104,3,100,0,7,105,110,116,101,103,101,114,97,1,97,1, - 106,106,104,3,100,0,4,101,118,97,108,104,2,100,0,5,115, - 104,101,108,108,100,0,10,108,111,99,97,108,95,102,117, - 110,99,108,0,0,0,1,103,100,0,13,110,111,110,111,100,101, - 64,110,111,104,111,115,116,0,0,0,22,0,0,0,0,0,106>>, - 170987488 = erlang:phash(binary_to_term(ExternalFun), - 16#FFFFFFFF), + ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, + 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, + 1113403635 = phash_from_external(ExternalReference), + + ExternalFun = <<131,112,0,0,0,70,1,212,190,220,28,179,144,194,131, + 19,215,105,97,77,251,125,93,0,0,0,0,0,0,0,2,100,0,1, + 116,97,0,98,6,165,246,224,103,100,0,13,110,111, + 110,111,100,101,64,110,111,104,111,115,116,0,0,0,91, + 0,0,0,0,0,97,2,97,1>>, + 25769064 = phash_from_external(ExternalFun), + case (catch erlang:phash(1,0)) of {'EXIT',{badarg, _}} -> ok; @@ -160,6 +241,8 @@ basic_test() -> exit(phash_accepted_zero_as_range) end. +phash_from_external(Ext) -> + erlang:phash(binary_to_term(Ext), 16#FFFFFFFF). range_test() -> F = fun(From,From,_FF) -> @@ -354,6 +437,7 @@ phash2_test() -> %% bit-level binaries {<<0:7>>, 1055790816}, + {(fun()-> B = <<255,7:3>>, <<_:4,D/bitstring>> = B, D end)(), 911751529}, {<<"abc",13:4>>, 670412287}, {<<5:3,"12345678901234567890">>, 289973273}, @@ -424,6 +508,159 @@ phash2_test() -> [] = [{E,H,H2} || {E,H} <- L, (H2 = erlang:phash2(E, Max)) =/= H], ok. +test_phash2_binary_aligned_and_unaligned_equal(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + test_aligned_and_unaligned_equal_up_to(256*12+255), + erts_debug:set_internal_state(available_internal_state, false). + +test_aligned_and_unaligned_equal_up_to(BinSize) -> + Results = + lists:map(fun(Size) -> + test_aligned_and_unaligned_equal(Size) + end, lists:seq(1, BinSize)), + %% DataDir = filename:join(filename:dirname(code:which(?MODULE)), "hash_SUITE_data"), + %% ExpResFile = filename:join(DataDir, "phash2_bin_expected_results.txt"), + %% {ok, [ExpRes]} = file:consult(ExpResFile), + %% %% ok = file:write_file(ExpResFile, io_lib:format("~w.~n", [Results])), + %% Results = ExpRes, + 110469206 = erlang:phash2(Results). + +test_aligned_and_unaligned_equal(BinSize) -> + Bin = make_random_bin(BinSize), + LastByte = last_byte(Bin), + LastInBitstring = LastByte rem 11, + Bitstring = << Bin/binary, <<LastInBitstring:5>>/bitstring >>, + UnalignedBin = make_unaligned_sub_bitstring(Bin), + UnalignedBitstring = make_unaligned_sub_bitstring(Bitstring), + case erts_debug:get_internal_state(available_internal_state) of + false -> erts_debug:set_internal_state(available_internal_state, true); + _ -> ok + end, + erts_debug:set_internal_state(reds_left, 3), + BinHash = erlang:phash2(Bin), + BinHash = erlang:phash2(Bin), + erts_debug:set_internal_state(reds_left, 3), + UnalignedBinHash = erlang:phash2(UnalignedBin), + UnalignedBinHash = erlang:phash2(UnalignedBin), + BinHash = UnalignedBinHash, + erts_debug:set_internal_state(reds_left, 3), + BitstringHash = erlang:phash2(Bitstring), + BitstringHash = erlang:phash2(Bitstring), + erts_debug:set_internal_state(reds_left, 3), + UnalignedBitstringHash = erlang:phash2(UnalignedBitstring), + UnalignedBitstringHash = erlang:phash2(UnalignedBitstring), + BitstringHash = UnalignedBitstringHash, + {BinHash, BitstringHash}. + +last_byte(Bin) -> + NotLastByteSize = (erlang:bit_size(Bin)) - 8, + <<_:NotLastByteSize/bitstring, LastByte:8>> = Bin, + LastByte. + +test_phash2_4GB_plus_bin(Config) when is_list(Config) -> + run_when_enough_resources( + fun() -> + erts_debug:set_internal_state(available_internal_state, true), + %% Created Bin4GB here so it only needs to be created once + erts_debug:set_internal_state(force_gc, self()), + Bin4GB = get_4GB_bin(), + test_phash2_plus_bin_helper1(Bin4GB, <<>>, <<>>, 13708901), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin4GB, <<>>, <<3:5>>, 66617678), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin4GB, <<13>>, <<>>, 31308392), + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(available_internal_state, false) + end). + + +test_phash2_10MB_plus_bin(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(force_gc, self()), + Bin10MB = get_10MB_bin(), + test_phash2_plus_bin_helper1(Bin10MB, <<>>, <<>>, 22776267), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin10MB, <<>>, <<3:5>>, 124488972), + erts_debug:set_internal_state(force_gc, self()), + test_phash2_plus_bin_helper1(Bin10MB, <<13>>, <<>>, 72958346), + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(available_internal_state, false). + +get_10MB_bin() -> + TmpBin = make_random_bin(10239), + Bin = erlang:iolist_to_binary([0, TmpBin]), + IOList10MB = duplicate_iolist(Bin, 10), + Bin10MB = erlang:iolist_to_binary(IOList10MB), + 10485760 = size(Bin10MB), + Bin10MB. + +get_4GB_bin() -> + TmpBin = make_random_bin(65535), + Bin = erlang:iolist_to_binary([0, TmpBin]), + IOList4GB = duplicate_iolist(Bin, 16), + Bin4GB = erlang:iolist_to_binary(IOList4GB), + 4294967296 = size(Bin4GB), + Bin4GB. + +duplicate_iolist(IOList, 0) -> + IOList; +duplicate_iolist(IOList, NrOfTimes) -> + duplicate_iolist([IOList, IOList], NrOfTimes - 1). + +test_phash2_plus_bin_helper1(Bin4GB, ExtraBytes, ExtraBits, ExpectedHash) -> + test_phash2_plus_bin_helper2(Bin4GB, fun id/1, ExtraBytes, ExtraBits, ExpectedHash), + test_phash2_plus_bin_helper2(Bin4GB, fun make_unaligned_sub_bitstring/1, ExtraBytes, ExtraBits, ExpectedHash). + +test_phash2_plus_bin_helper2(Bin, TransformerFun, ExtraBytes, ExtraBits, ExpectedHash) -> + ExtraBitstring = << ExtraBytes/binary, ExtraBits/bitstring >>, + LargerBitstring = << ExtraBytes/binary, + ExtraBits/bitstring, + Bin/bitstring >>, + LargerTransformedBitstring = TransformerFun(LargerBitstring), + ExtraBitstringHash = erlang:phash2(ExtraBitstring), + ExpectedHash = + case size(LargerTransformedBitstring) < 4294967296 of + true -> + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(reds_left, 1), + Hash = erlang:phash2(LargerTransformedBitstring), + Hash = erlang:phash2(LargerTransformedBitstring), + Hash; + false -> + erts_debug:set_internal_state(force_gc, self()), + erts_debug:set_internal_state(reds_left, 1), + ExtraBitstringHash = erlang:phash2(LargerTransformedBitstring), + ExtraBitstringHash = erlang:phash2(LargerTransformedBitstring), + ExtraBitstringHash + end. + +run_when_enough_resources(Fun) -> + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem >= 31 -> + Fun(); + {Mem, WordSize} -> + {skipped, + io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)", + [Mem, WordSize])} + end. + +%% Total memory in GB +total_memory() -> + try + MemoryData = memsup:get_system_memory_data(), + case lists:keysearch(total_memory, 1, MemoryData) of + {value, {total_memory, TM}} -> + TM div (1024*1024*1024); + false -> + {value, {system_total_memory, STM}} = + lists:keysearch(system_total_memory, 1, MemoryData), + STM div (1024*1024*1024) + end + catch + _ : _ -> + undefined + end. + -ifdef(FALSE). f1() -> abc. @@ -436,14 +673,23 @@ f3(X, Y) -> -endif. otp_5292_test() -> - PH = fun(E) -> [erlang:phash(E, 1 bsl 32), - erlang:phash(-E, 1 bsl 32), - erlang:phash2(E, 1 bsl 32), - erlang:phash2(-E, 1 bsl 32)] - end, + PH = fun(E) -> + EInList = [1, 2, 3, E], + EInList2 = [E, 1, 2, 3], + NegEInList = [1, 2, 3, -E], + NegEInList2 = [-E, 1, 2, 3], + [erlang:phash(E, 1 bsl 32), + erlang:phash(-E, 1 bsl 32), + erlang:phash2(E, 1 bsl 32), + erlang:phash2(-E, 1 bsl 32), + erlang:phash2(EInList, 1 bsl 32), + erlang:phash2(EInList2, 1 bsl 32), + erlang:phash2(NegEInList, 1 bsl 32), + erlang:phash2(NegEInList2, 1 bsl 32)] + end, S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), {S, E} <- int(Start, N, Sz)]), - <<124,81,198,121,174,233,19,137,10,83,33,80,226,111,238,99>> = S2, + <<234,63,192,76,253,57,250,32,44,11,73,1,161,102,14,238>> = S2, ok. d() -> @@ -684,3 +930,313 @@ unaligned_sub_bitstr(Bin0) when is_bitstring(Bin0) -> id(I) -> I. + +%% Benchmarks for phash2 + +run_phash2_benchmarks() -> + Benchmarks = [ + test_phash2_large_map, + test_phash2_shallow_long_list, + test_phash2_deep_list, + test_phash2_deep_tuple, + test_phash2_deep_tiny, + test_phash2_with_42, + test_phash2_with_short_tuple, + test_phash2_with_short_list, + test_phash2_with_tiny_bin, + test_phash2_with_tiny_unaligned_sub_binary, + test_phash2_with_small_unaligned_sub_binary, + test_phash2_with_large_bin, + test_phash2_with_large_unaligned_sub_binary, + test_phash2_with_super_large_unaligned_sub_binary + ], + [print_comment(B) || B <- Benchmarks]. + + +print_comment(FunctionName) -> + io:format("~p~n", [FunctionName]), + io:format("~s~n", [element(2, erlang:apply(?MODULE, FunctionName, [[]]))]). + +nr_of_iters(BenchmarkNumberOfIterations, Config) -> + case lists:member(phash2_benchmark_tests, Config) of + true -> 1; + false -> BenchmarkNumberOfIterations + end. + + +test_phash2_large_map(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {1000000, 121857429}; + _ -> + {1000, 66609305} + end, + run_phash2_test_and_benchmark(nr_of_iters(45, Config), + get_map(Size), + ExpectedHash). + +test_phash2_shallow_long_list(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {1000000, 78700388}; + _ -> + {1000, 54749638} + end, + run_phash2_test_and_benchmark(nr_of_iters(1, Config), + lists:duplicate(Size, get_complex_tuple()), + ExpectedHash). + +test_phash2_deep_list(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {500000, 17986444}; + _ -> + {1000, 81794308} + end, + run_phash2_test_and_benchmark(nr_of_iters(1, Config), + make_deep_list(Size, get_complex_tuple()), + ExpectedHash). + +test_phash2_deep_tuple(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {500000, 116594715}; + _ -> + {500, 109057352} + end, + run_phash2_test_and_benchmark(nr_of_iters(1, Config), + make_deep_tuple(Size, get_complex_tuple()), + ExpectedHash). + +test_phash2_deep_tiny(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(1000000, Config), + make_deep_list(19, 42), + 111589624). + +test_phash2_with_42(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(20000000, Config), + 42, + 30328728). + +test_phash2_with_short_tuple(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(10000000, Config), + {a,b,<<"hej">>, "hej"}, + 50727199). + +test_phash2_with_short_list(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(10000000, Config), + [a,b,"hej", "hello"], + 117108642). + +test_phash2_with_tiny_bin(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(20000000, Config), + make_random_bin(10), + 129616602). + +test_phash2_with_tiny_unaligned_sub_binary(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(10000000, Config), + make_unaligned_sub_binary(make_random_bin(11)), + 59364725). + +test_phash2_with_small_unaligned_sub_binary(Config) when is_list(Config) -> + run_phash2_test_and_benchmark(nr_of_iters(400000, Config), + make_unaligned_sub_binary(make_random_bin(1001)), + 130388119). + +test_phash2_with_large_bin(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {10000000, 48249379}; + _ -> + {1042, 14679520} + end, + run_phash2_test_and_benchmark(nr_of_iters(150, Config), + make_random_bin(Size), + ExpectedHash). + +test_phash2_with_large_unaligned_sub_binary(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {10000001, 122836437}; + _ -> + {10042, 127144287} + end, + run_phash2_test_and_benchmark(nr_of_iters(50, Config), + make_unaligned_sub_binary(make_random_bin(Size)), + ExpectedHash). + +test_phash2_with_super_large_unaligned_sub_binary(Config) when is_list(Config) -> + {Size, ExpectedHash} = + case {total_memory(), erlang:system_info(wordsize)} of + {Mem, 8} when is_integer(Mem) andalso Mem > 2 -> + {20000001, 112086727}; + _ -> + {20042, 91996619} + end, + run_phash2_test_and_benchmark(nr_of_iters(20, Config), + make_unaligned_sub_binary(make_random_bin(Size)), + ExpectedHash). + +make_deep_list(1, Item) -> + {Item, Item}; +make_deep_list(Depth, Item) -> + [{Item, Item}, make_deep_list(Depth - 1, Item)]. + +make_deep_tuple(1, Item) -> + [Item, Item]; +make_deep_tuple(Depth, Item) -> + {[Item, Item], make_deep_tuple(Depth - 1, Item)}. + +% Helper functions for benchmarking + +loop(0, _) -> ok; +loop(Iterations, Fun) -> + Fun(), + loop(Iterations - 1, Fun). + +run_phash2_test_and_benchmark(Iterations, Term, ExpectedHash) -> + Parent = self(), + Test = + fun() -> + Hash = erlang:phash2(Term), + case ExpectedHash =:= Hash of + false -> + Parent ! {got_bad_hash, Hash}, + ExpectedHash = Hash; + _ -> ok + end + end, + Benchmark = + fun() -> + garbage_collect(), + {Time, _} =timer:tc(fun() -> loop(Iterations, Test) end), + Parent ! Time + end, + spawn(Benchmark), + receive + {got_bad_hash, Hash} -> + ExpectedHash = Hash; + Time -> + TimeInS = case (Time/1000000) of + 0.0 -> 0.0000000001; + T -> T + end, + IterationsPerSecond = Iterations / TimeInS, + notify(#event{ name = benchmark_data, data = [{value, IterationsPerSecond}]}), + {comment, io_lib:format("Iterations per second: ~p, Iterations ~p, Benchmark time: ~p seconds)", + [IterationsPerSecond, Iterations, Time/1000000])} + end. + +get_complex_tuple() -> + BPort = <<131,102,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,1,0>>, + Port = binary_to_term(BPort), + + BXPort = <<131,102,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 0,0,0,24,3>>, + XPort = binary_to_term(BXPort), + + BRef = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,1,255,0,0,0,0,0,0,0,0>>, + Ref = binary_to_term(BRef), + + BXRef = <<131,114,0,3,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 2,0,0,0,155,0,0,0,0,0,0,0,0>>, + XRef = binary_to_term(BXRef), + + BXPid = <<131,103,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 0,0,0,36,0,0,0,0,1>>, + XPid = binary_to_term(BXPid), + + + %% X = f1(), Y = f2(), Z = f3(X, Y), + + %% F1 = fun f1/0, % -> abc + B1 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,1,0,0,0,0,100,0,1,116,97,1,98,2,195,126, + 58,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F1 = binary_to_term(B1), + + %% F2 = fun f2/0, % -> abd + B2 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,2,0,0,0,0,100,0,1,116,97,2,98,3,130,152, + 185,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F2 = binary_to_term(B2), + + %% F3 = fun f3/2, % -> {abc, abd} + B3 = <<131,112,0,0,0,66,2,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,3,0,0,0,0,100,0,1,116,97,3,98,7,168,160, + 93,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F3 = binary_to_term(B3), + + %% F4 = fun () -> 123456789012345678901234567 end, + B4 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,4,0,0,0,0,100,0,1,116,97,4,98,2,230,21, + 171,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F4 = binary_to_term(B4), + + %% F5 = fun() -> {X,Y,Z} end, + B5 = <<131,112,0,0,0,92,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,5,0,0,0,3,100,0,1,116,97,5,98,0,99,101, + 130,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0,100,0,3,97,98,99,100,0,3,97,98, + 100,104,2,100,0,3,97,98,99,100,0,3,97,98,100>>, + F5 = binary_to_term(B5), + {{1,{2}},an_atom, 1, 3434.923942394,<<"this is a binary">>, + make_unaligned_sub_binary(<<"this is also a binary">>),c,d,e,f,g,h,i,j,k,l,[f], + 999999999999999999666666662123123123123324234999999999999999, 234234234, + BPort, Port, BXPort, XPort, BRef, Ref, BXRef, XRef, BXPid, XPid, F1, F2, F3, F4, F5, + #{a => 1, b => 2, c => 3, d => 4, e => 5, f => 6, g => 7, h => 8, i => 9, + j => 1, k => 1, l => 123123123123213, m => [1,2,3,4,5,6,7,8], o => 5, p => 6, + q => 7, r => 8, s => 9}}. + +get_map_helper(MapSoFar, 0) -> + MapSoFar; +get_map_helper(MapSoFar, NumOfItemsToAdd) -> + NewMapSoFar = maps:put(NumOfItemsToAdd, NumOfItemsToAdd, MapSoFar), + get_map_helper(NewMapSoFar, NumOfItemsToAdd -1). + +get_map(Size) -> + get_map_helper(#{}, Size). + + +%% Copied from binary_SUITE +make_unaligned_sub_binary(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +make_unaligned_sub_bitstring(Bin0) -> + Bin1 = <<0:3,Bin0/bitstring,31:5>>, + Sz = erlang:bit_size(Bin0), + <<0:3,Bin:Sz/bitstring,31:5>> = id(Bin1), + Bin. + +make_random_bin(Size) -> + make_random_bin(Size, []). + +make_random_bin(0, Acc) -> + iolist_to_binary(Acc); +make_random_bin(Size, []) -> + make_random_bin(Size - 1, [simple_rand() rem 256]); +make_random_bin(Size, [N | Tail]) -> + make_random_bin(Size - 1, [simple_rand(N) rem 256, N |Tail]). + +simple_rand() -> + 123456789. +simple_rand(Seed) -> + A = 1103515245, + C = 12345, + M = (1 bsl 31), + (A * Seed + C) rem M. diff --git a/erts/emulator/test/hash_property_test_SUITE.erl b/erts/emulator/test/hash_property_test_SUITE.erl new file mode 100644 index 0000000000..b4c7810a52 --- /dev/null +++ b/erts/emulator/test/hash_property_test_SUITE.erl @@ -0,0 +1,103 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% 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% +%% +%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% %%% +%%% WARNING %%% +%%% %%% +%%% This is experimental code which may be changed or removed %%% +%%% anytime without any warning. %%% +%%% %%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(hash_property_test_SUITE). + +-export([suite/0,all/0,groups/0,init_per_suite/1, + end_per_suite/1,init_per_group/2,end_per_group/2]). + +-export([test_phash2_no_diff/1, + test_phash2_no_diff_long/1, + test_phash2_no_diff_between_versions/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> [{group, proper}]. + +groups() -> + [{proper, [], [test_phash2_no_diff, + test_phash2_no_diff_long, + test_phash2_no_diff_between_versions]}]. + + +%%% First prepare Config and compile the property tests for the found tool: +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +end_per_suite(Config) -> + Config. + +%%% Only proper is supported +init_per_group(proper, Config) -> + case proplists:get_value(property_test_tool,Config) of + proper -> Config; + X -> {skip, lists:concat([X," is not supported"])} + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + +test_phash2_no_diff(Config) when is_list(Config) -> + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_with_same_input(), + Config). + +test_phash2_no_diff_long(Config) when is_list(Config) -> + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_with_same_long_input(), + Config). + +test_phash2_no_diff_between_versions(Config) when is_list(Config) -> + R = "21", + case test_server:is_release_available(R) of + true -> + Rel = {release,R}, + case test_server:start_node(rel21,peer,[{erl,[Rel]}]) of + {error, Reason} -> {skip, io_lib:format("Could not start node: ~p~n", [Reason])}; + {ok, Node} -> + try + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_in_different_versions(Node), + Config), + true = ct_property_test:quickcheck( + phash2_properties:prop_phash2_same_in_different_versions_with_long_input(Node), + Config) + after + test_server:stop_node(Node) + end + end; + false -> + {skip, io_lib:format("Release ~s not available~n", [R])} + end. diff --git a/erts/emulator/test/property_test/phash2_properties.erl b/erts/emulator/test/property_test/phash2_properties.erl new file mode 100644 index 0000000000..b1f3207c56 --- /dev/null +++ b/erts/emulator/test/property_test/phash2_properties.erl @@ -0,0 +1,63 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019-2019. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +-module(phash2_properties). + +-ifdef(PROPER). + +-include_lib("proper/include/proper.hrl"). +-export([prop_phash2_same_with_same_input/0, + prop_phash2_same_with_same_long_input/0, + prop_phash2_same_in_different_versions/1, + prop_phash2_same_in_different_versions_with_long_input/1]). +-proptest([proper]). + +%%-------------------------------------------------------------------- +%% Properties -------------------------------------------------------- +%%-------------------------------------------------------------------- + +prop_phash2_same_with_same_input() -> + ?FORALL(T, any(), erlang:phash2(T) =:= erlang:phash2(T)). + +prop_phash2_same_with_same_long_input() -> + ?FORALL(T, any(), + begin + BigTerm = lists:duplicate(10000, T), + erlang:phash2(BigTerm) =:= erlang:phash2(BigTerm) + end). + +prop_phash2_same_in_different_versions(DifferntVersionNode) -> + ?FORALL(T, any(), + erlang:phash2(T) =:= rpc:call(DifferntVersionNode,erlang,phash2,[T])). + +prop_phash2_same_in_different_versions_with_long_input(DifferntVersionNode) -> + ?FORALL(T, any(), + begin + BigTerm = lists:duplicate(10000, T), + RpcRes = rpc:call(DifferntVersionNode,erlang,phash2,[BigTerm]), + LocalRes = erlang:phash2(BigTerm), + RpcRes =:= LocalRes + end). + +%%-------------------------------------------------------------------- +%% Generators ------------------------------------------------------- +%%-------------------------------------------------------------------- + +-endif. diff --git a/erts/epmd/Makefile b/erts/epmd/Makefile index d3308ddedc..e4b201bd88 100644 --- a/erts/epmd/Makefile +++ b/erts/epmd/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/erts/epmd/epmd.mk b/erts/epmd/epmd.mk index b1fd04dc04..f6889a7ff1 100644 --- a/erts/epmd/epmd.mk +++ b/erts/epmd/epmd.mk @@ -67,5 +67,5 @@ EPMD_NODE_TYPE=110 # Distribution format 5 contains the new md5 based handshake. EPMD_DIST_LOW=5 -EPMD_DIST_HIGH=5 +EPMD_DIST_HIGH=6 diff --git a/erts/epmd/src/epmd.h b/erts/epmd/src/epmd.h index cffcd4ae7a..7332294d3d 100644 --- a/erts/epmd/src/epmd.h +++ b/erts/epmd/src/epmd.h @@ -26,6 +26,7 @@ #define EPMD_ALIVE2_REQ 'x' #define EPMD_PORT2_REQ 'z' #define EPMD_ALIVE2_RESP 'y' +#define EPMD_ALIVE2_X_RESP 'v' #define EPMD_PORT2_RESP 'w' #define EPMD_NAMES_REQ 'n' diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index ed9bbdb8cd..a5156a142e 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -277,6 +277,12 @@ static const struct in6_addr in6addr_loopback = #define put_int16(i, s) {((unsigned char*)(s))[0] = ((i) >> 8) & 0xff; \ ((unsigned char*)(s))[1] = (i) & 0xff;} +#define put_int32(i, s) do {((char*)(s))[0] = (char)((i) >> 24) & 0xff; \ + ((char*)(s))[1] = (char)((i) >> 16) & 0xff; \ + ((char*)(s))[2] = (char)((i) >> 8) & 0xff; \ + ((char*)(s))[3] = (char)(i) & 0xff;} \ + while (0) + #if defined(__GNUC__) # define EPMD_INLINE __inline__ #elif defined(__WIN32__) @@ -307,10 +313,10 @@ struct enode { int fd; /* The socket in use */ unsigned short port; /* Port number of Erlang node */ char symname[MAXSYMLEN+1]; /* Name of the Erlang node */ - short creation; /* Started as a random number 1..3 */ + unsigned int cr_counter; /* Used to generate 'creation' numbers */ char nodetype; /* 77 = normal erlang node 72 = hidden (c-node */ char protocol; /* 0 = tcp/ipv4 */ - unsigned short highvsn; /* 0 = OTP-R3 erts-4.6.x, 1 = OTP-R4 erts-4.7.x*/ + unsigned short highvsn; /* 5: creation=1..3, 6: creation=1..(2^32-1)*/ unsigned short lowvsn; int extralen; char extra[MAXSYMLEN+1]; diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 3c6f1fbdf4..633ec71e5f 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -665,6 +665,21 @@ static int do_accept(EpmdVars *g,int listensock) return conn_open(g,msgsock); } +static void bump_creation(Node* node) +{ + if (++node->cr_counter == 0) + node->cr_counter = 1; +} +static unsigned int get_creation(Node* node) +{ + if (node->highvsn >= 6) { + return node->cr_counter; /* 1..(2^32-1)*/ + } + else { + return (node->cr_counter - 1) % 3 + 1; /* 1..3 */ + } +} + /* buf is actually one byte larger than bsize, giving place for null termination */ static void do_request(g, fd, s, buf, bsize) @@ -706,8 +721,10 @@ static void do_request(g, fd, s, buf, bsize) unsigned char protocol; unsigned short highvsn; unsigned short lowvsn; + unsigned int creation; int namelen; int extralen; + int replylen; char *name; char *extra; eport = get_int16(&buf[1]); @@ -737,17 +754,22 @@ static void do_request(g, fd, s, buf, bsize) extra = &buf[11+namelen+2]; extra[extralen]='\000'; - wbuf[0] = EPMD_ALIVE2_RESP; - if ((node = node_reg2(g, namelen, name, fd, eport, nodetype, protocol, - highvsn, lowvsn, extralen, extra)) == NULL) { - wbuf[1] = 1; /* error */ - put_int16(99, wbuf+2); - } else { - wbuf[1] = 0; /* ok */ - put_int16(node->creation, wbuf+2); - } + node = node_reg2(g, namelen, name, fd, eport, nodetype, protocol, + highvsn, lowvsn, extralen, extra); + creation = node ? get_creation(node) : 99; + wbuf[1] = node ? 0 : 1; /* ok | error */ + if (highvsn >= 6) { + wbuf[0] = EPMD_ALIVE2_X_RESP; + put_int32(creation, wbuf+2); + replylen = 6; + } + else { + wbuf[0] = EPMD_ALIVE2_RESP; + put_int16(creation, wbuf+2); + replylen = 4; + } - if (!reply(g, fd, wbuf, 4)) + if (!reply(g, fd, wbuf, replylen)) { node_unreg(g, name); dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"", @@ -1200,8 +1222,8 @@ static int node_unreg(EpmdVars *g,char *name) for (; node; prev = &node->next, node = node->next) if (is_same_str(node->symname, name)) { - dbg_tty_printf(g,1,"unregistering '%s:%d', port %d", - node->symname, node->creation, node->port); + dbg_tty_printf(g,1,"unregistering '%s:%u', port %d", + node->symname, get_creation(node), node->port); *prev = node->next; /* Link out from "reg" list */ @@ -1235,8 +1257,8 @@ static int node_unreg_sock(EpmdVars *g,int fd) for (; node; prev = &node->next, node = node->next) if (node->fd == fd) { - dbg_tty_printf(g,1,"unregistering '%s:%d', port %d", - node->symname, node->creation, node->port); + dbg_tty_printf(g,1,"unregistering '%s:%u', port %d", + node->symname, get_creation(node), node->port); *prev = node->next; /* Link out from "reg" list */ @@ -1264,19 +1286,8 @@ static int node_unreg_sock(EpmdVars *g,int fd) } /* - * Finding a node slot and a (name,creation) name is a bit tricky. - * We try in order - * - * 1. If the name was used before and we can reuse that slot but use - * a new "creation" digit in the range 1..3. - * - * 2. We try to find a new unused slot. - * - * 3. We try to use an used slot this isn't used any longer. - * FIXME: The criteria for *what* slot to steal should be improved. - * Perhaps use the oldest or something. + * Register a new node */ - static Node *node_reg2(EpmdVars *g, int namelen, char* name, @@ -1346,7 +1357,7 @@ static Node *node_reg2(EpmdVars *g, } /* Try to find the name in the used queue so that we - can change "creation" number 1..3 */ + can change "creation" number */ prev = NULL; @@ -1375,9 +1386,8 @@ static Node *node_reg2(EpmdVars *g, g->nodes.unreg_count--; - /* When reusing we change the "creation" number 1..3 */ - - node->creation = node->creation % 3 + 1; + /* When reusing we change the "creation" number */ + bump_creation(node); break; } @@ -1404,7 +1414,8 @@ static Node *node_reg2(EpmdVars *g, exit(1); } - node->creation = (current_time(g) % 3) + 1; /* "random" 1-3 */ + node->cr_counter = current_time(g); /* "random" */ + bump_creation(node); } } @@ -1423,11 +1434,11 @@ static Node *node_reg2(EpmdVars *g, select_fd_set(g, fd); if (highvsn == 0) { - dbg_tty_printf(g,1,"registering '%s:%d', port %d", - node->symname, node->creation, node->port); + dbg_tty_printf(g,1,"registering '%s:%u', port %d", + node->symname, get_creation(node), node->port); } else { - dbg_tty_printf(g,1,"registering '%s:%d', port %d", - node->symname, node->creation, node->port); + dbg_tty_printf(g,1,"registering '%s:%u', port %d", + node->symname, get_creation(node), node->port); dbg_tty_printf(g,1,"type %d proto %d highvsn %d lowvsn %d", nodetype, protocol, highvsn, lowvsn); } @@ -1561,8 +1572,8 @@ static void print_names(EpmdVars *g) for (node = g->nodes.reg; node; node = node->next) { - fprintf(stderr,"***** active name \"%s#%d\" at port %d, fd = %d\r\n", - node->symname, node->creation, node->port, node->fd); + fprintf(stderr,"***** active name \"%s#%u\" at port %d, fd = %d\r\n", + node->symname, get_creation(node), node->port, node->fd); count ++; } @@ -1572,8 +1583,8 @@ static void print_names(EpmdVars *g) for (node = g->nodes.unreg; node; node = node->next) { - fprintf(stderr,"***** old/unused name \"%s#%d\"\r\n", - node->symname, node->creation); + fprintf(stderr,"***** old/unused name \"%s#%u\"\r\n", + node->symname, get_creation(node)); count ++; } diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c index bfb3e1bd2c..e974630695 100644 --- a/erts/etc/unix/run_erl.c +++ b/erts/etc/unix/run_erl.c @@ -1201,7 +1201,19 @@ static void error_logf(int priority, int line, const char *format, ...) #ifdef HAVE_SYSLOG_H if (run_daemon) { +#ifdef HAVE_VSYSLOG vsyslog(priority,format,args); +#else + /* Some OSes like AIX lack vsyslog. */ + va_list ap; + char message[900]; /* AIX man page says truncation past this */ + + va_start (ap, format); + vsnprintf(message, 900, format, ap); + va_end(ap); + + syslog(priority, message); +#endif } else #endif diff --git a/erts/lib_src/common/ethr_aux.c b/erts/lib_src/common/ethr_aux.c index 7b156fe01a..931469b386 100644 --- a/erts/lib_src/common/ethr_aux.c +++ b/erts/lib_src/common/ethr_aux.c @@ -109,7 +109,8 @@ x86_init(void) if (eax > 0 && (ETHR_IS_X86_VENDOR("GenuineIntel", ebx, ecx, edx) - || ETHR_IS_X86_VENDOR("AuthenticAMD", ebx, ecx, edx))) { + || ETHR_IS_X86_VENDOR("AuthenticAMD", ebx, ecx, edx) + || ETHR_IS_X86_VENDOR("HygonGenuine", ebx, ecx, edx))) { eax = 1; ethr_x86_cpuid__(&eax, &ebx, &ecx, &edx); } diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex a2c5f2f336..0152a6091f 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index 06f0ee1dc6..12c256169c 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2186,7 +2186,7 @@ nodes(_Arg) -> -spec open_port(PortName, PortSettings) -> port() when PortName :: {spawn, Command :: string() | binary()} | {spawn_driver, Command :: string() | binary()} | - {spawn_executable, FileName :: file:name() } | + {spawn_executable, FileName :: file:name_all() } | {fd, In :: non_neg_integer(), Out :: non_neg_integer()}, PortSettings :: [Opt], Opt :: {packet, N :: 1 | 2 | 4} diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 1aa5d85c64..1982424191 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -34,6 +34,7 @@ -export([read_link/1, read_link_all/1, read_link_info/1, read_link_info/2, read_file_info/1, read_file_info/2, + read_handle_info/1, read_handle_info/2, write_file_info/2, write_file_info/3]). -export([list_dir/1, list_dir_all/1]). @@ -497,6 +498,8 @@ get_handle_nif(_FileRef) -> erlang:nif_error(undef). delayed_close_nif(_FileRef) -> erlang:nif_error(undef). +read_handle_info_nif(_FileRef) -> + erlang:nif_error(undef). %% %% Quality-of-life helpers @@ -598,20 +601,37 @@ read_link_info(Name, Opts) -> read_info_1(Name, FollowLinks, TimeType) -> try case read_info_nif(encode_path(Name), FollowLinks) of - {error, Reason} -> - {error, Reason}; - FileInfo -> - CTime = from_posix_seconds(FileInfo#file_info.ctime, TimeType), - MTime = from_posix_seconds(FileInfo#file_info.mtime, TimeType), - ATime = from_posix_seconds(FileInfo#file_info.atime, TimeType), - {ok, FileInfo#file_info{ ctime = CTime, - mtime = MTime, - atime = ATime }} + {error, Reason} -> {error, Reason}; + FileInfo -> {ok, adjust_times(FileInfo, TimeType)} + end + catch + error:_ -> {error, badarg} + end. + +read_handle_info(Fd) -> + read_handle_info_1(Fd, local). +read_handle_info(Fd, Opts) -> + read_handle_info_1(Fd, proplist_get_value(time, Opts, local)). + +read_handle_info_1(Fd, TimeType) -> + try + #{ handle := FRef } = get_fd_data(Fd), + case read_handle_info_nif(FRef) of + {error, Reason} -> {error, Reason}; + FileInfo -> {ok, adjust_times(FileInfo, TimeType)} end catch error:_ -> {error, badarg} end. +adjust_times(FileInfo, TimeType) -> + CTime = from_posix_seconds(FileInfo#file_info.ctime, TimeType), + MTime = from_posix_seconds(FileInfo#file_info.mtime, TimeType), + ATime = from_posix_seconds(FileInfo#file_info.atime, TimeType), + FileInfo#file_info{ ctime = CTime, + mtime = MTime, + atime = ATime }. + write_file_info(Filename, Info) -> write_file_info_1(Filename, Info, local). write_file_info(Filename, Info, Opts) -> diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl index 463d890688..0a5987df88 100644 --- a/erts/test/erl_print_SUITE.erl +++ b/erts/test/erl_print_SUITE.erl @@ -324,6 +324,9 @@ run_case(Config, TestArgs, Fun) -> -define(PORT_EXT, 102). -define(PID_EXT, 103). -define(NEW_REFERENCE_EXT, 114). +-define(NEW_PID_EXT, $X). +-define(NEW_PORT_EXT, $Y). +-define(NEWER_REFERENCE_EXT, $Z). uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> [(Uint bsr 24) band 16#ff, @@ -351,13 +354,13 @@ mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); mk_pid({NodeName, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, + ?NEW_PID_EXT, ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, uint32_be(Number), uint32_be(Serial), - uint8(Creation)])) of + uint32_be(Creation)])) of Pid when is_pid(Pid) -> Pid; {'EXIT', {badarg, _}} -> @@ -370,12 +373,12 @@ mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({atom_to_list(NodeName), Creation}, Number); mk_port({NodeName, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, + ?NEW_PORT_EXT, ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, uint32_be(Number), - uint8(Creation)])) of + uint32_be(Creation)])) of Port when is_port(Port) -> Port; {'EXIT', {badarg, _}} -> @@ -388,33 +391,16 @@ mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), is_integer(Creation), is_list(Numbers) -> mk_ref({atom_to_list(NodeName), Creation}, Numbers); -mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), - is_integer(Creation), - is_integer(Number) -> - case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?REFERENCE_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) - end; mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), is_integer(Creation), is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, + ?NEWER_REFERENCE_EXT, uint16_be(length(Numbers)), ?ATOM_EXT, uint16_be(length(NodeName)), NodeName, - uint8(Creation), + uint32_be(Creation), lists:map(fun (N) -> uint32_be(N) end, @@ -429,11 +415,10 @@ mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), my_cre() -> erlang:system_info(creation). -oth_cre(0) -> 1; -oth_cre(1) -> 2; -oth_cre(2) -> 3; -oth_cre(3) -> 1; -oth_cre(N) -> exit({invalid_creation, N}). +oth_cre(N) when N >= 0, N < (1 bsl 32) -> + (N rem ((1 bsl 32) - 1)) + 1; +oth_cre(N) -> + exit({invalid_creation, N}). str_1_bsl_10000() -> "19950631168807583848837421626835850838234968318861924548520089498529438830221946631919961684036194597899331129423209124271556491349413781117593785932096323957855730046793794526765246551266059895520550086918193311542508608460618104685509074866089624888090489894838009253941633257850621568309473902556912388065225096643874441046759871626985453222868538161694315775629640762836880760732228535091641476183956381458969463899410840960536267821064621427333394036525565649530603142680234969400335934316651459297773279665775606172582031407994198179607378245683762280037302885487251900834464581454650557929601414833921615734588139257095379769119277800826957735674444123062018757836325502728323789270710373802866393031428133241401624195671690574061419654342324638801248856147305207431992259611796250130992860241708340807605932320161268492288496255841312844061536738951487114256315111089745514203313820202931640957596464756010405845841566072044962867016515061920631004186422275908670900574606417856951911456055068251250406007519842261898059237118054444788072906395242548339221982707404473162376760846613033778706039803413197133493654622700563169937455508241780972810983291314403571877524768509857276937926433221599399876886660808368837838027643282775172273657572744784112294389733810861607423253291974813120197604178281965697475898164531258434135959862784130128185406283476649088690521047580882615823961985770122407044330583075869039319604603404973156583208672105913300903752823415539745394397715257455290510212310947321610753474825740775273986348298498340756937955646638621874569499279016572103701364433135817214311791398222983845847334440270964182851005072927748364550578634501100852987812389473928699540834346158807043959118985815145779177143619698728131459483783202081474982171858011389071228250905826817436220577475921417653715687725614904582904992461028630081535583308130101987675856234343538955409175623400844887526162643568648833519463720377293240094456246923254350400678027273837755376406726898636241037491410966718557050759098100246789880178271925953381282421954028302759408448955014676668389697996886241636313376393903373455801407636741877711055384225739499110186468219696581651485130494222369947714763069155468217682876200362777257723781365331611196811280792669481887201298643660768551639860534602297871557517947385246369446923087894265948217008051120322365496288169035739121368338393591756418733850510970271613915439590991598154654417336311656936031122249937969999226781732358023111862644575299135758175008199839236284615249881088960232244362173771618086357015468484058622329792853875623486556440536962622018963571028812361567512543338303270029097668650568557157505516727518899194129711337690149916181315171544007728650573189557450920330185304847113818315407324053319038462084036421763703911550639789000742853672196280903477974533320468368795868580237952218629120080742819551317948157624448298518461509704888027274721574688131594750409732115080498190455803416826949787141316063210686391511681774304792596709376". diff --git a/lib/asn1/Makefile b/lib/asn1/Makefile index 26e7e37924..63cb770043 100644 --- a/lib/asn1/Makefile +++ b/lib/asn1/Makefile @@ -100,3 +100,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..35739462c5 100644 --- a/lib/common_test/Makefile +++ b/lib/common_test/Makefile @@ -45,3 +45,4 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/compiler/Makefile b/lib/compiler/Makefile index b8b2f562a2..3678f48b7c 100644 --- a/lib/compiler/Makefile +++ b/lib/compiler/Makefile @@ -36,3 +36,4 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +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..e76ad79365 --- /dev/null +++ b/lib/compiler/src/beam_call_types.erl @@ -0,0 +1,490 @@ +%% +%% %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([types/3]). + +%% +%% 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 2305502800..0000000000 --- a/lib/compiler/src/beam_except.erl +++ /dev/null @@ -1,247 +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), Regs0, Acc0), - case Regs of - #{{x,0}:={atom,function_clause},{x,1}:=Args} -> - case moves_from_stack(Args, 0, []) of - {Moves,Arity} -> - {yes,function_clause,reverse(Moves, Acc)}; - {_,_} -> - no - end; - #{} -> - no - end. - -dig_out_fc_1([{block,Bl}|Is], Regs0, Acc) -> - Regs = dig_out_fc_block(Bl, Regs0), - dig_out_fc_1(Is, Regs, Acc); -dig_out_fc_1([{bs_set_position,_,_}=I|Is], Regs, Acc) -> - dig_out_fc_1(Is, Regs, [I|Acc]); -dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Regs0, Acc) -> - Regs = prune_xregs(Live0, Regs0), - Live = dig_out_stack_live(Regs, Live0), - I = {bs_get_tail,Src,Dst,Live}, - dig_out_fc_1(Is, Regs, [I|Acc]); -dig_out_fc_1([_|_], _Regs, _Acc) -> - {#{},[]}; -dig_out_fc_1([], Regs, Acc) -> - {Regs,Acc}. - -dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) -> - Regs = prune_xregs(Live, Regs0), - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> - Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) -> - Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,_,_,_}|_], _Regs) -> - %% Unknown instruction. Fail. - #{}; -dig_out_fc_block([], Regs) -> Regs. - -dig_out_stack_live(Regs, Default) -> - Reg = {x,2}, - case Regs of - #{Reg:=List} -> - dig_out_stack_live_1(List, Default); - #{} -> - Default - end. - -dig_out_stack_live_1({cons,{arg,N},T}, Live) -> - dig_out_stack_live_1(T, max(N + 1, Live)); -dig_out_stack_live_1({cons,_,T}, Live) -> - dig_out_stack_live_1(T, Live); -dig_out_stack_live_1(nil, Live) -> - Live; -dig_out_stack_live_1(_, Live) -> Live. - -prune_xregs(Live, Regs) -> - maps:filter(fun({x,X}, _) -> X < Live end, Regs). - -moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> - %% Wrong argument. Give up. - {[],-1}; -moves_from_stack({cons,H,T}, I, Acc) -> - case H of - {arg,I} -> - moves_from_stack(T, I+1, Acc); - _ -> - moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) - end; -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..474cb1a851 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,11 +679,12 @@ 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 -> + + case FailCtx of + {no_catch, _} -> {[Call],St2}; - in_catch -> - {TestIs,St} = make_cond_branch(succeeded, [Ret], Fail, St2), + {in_catch, _} -> + {TestIs,St} = make_succeeded(Ret, FailCtx, St2), {[Call|TestIs],St} end end. @@ -748,8 +771,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 +820,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 +836,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 +947,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 +978,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 +993,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 +1003,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 +1013,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 +1028,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 +1049,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 +1106,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_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 7ef604d444..89053c7b9f 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), @@ -691,6 +696,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 +899,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. %%% @@ -1189,10 +1340,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 +1491,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 +1598,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), @@ -1472,9 +1623,9 @@ find_loop_exit([L1,L2|_Ls], Blocks) -> find_loop_exit_1(Path1, cerl_sets:from_list(Path2)); find_loop_exit(_, _) -> none. -find_loop_exit_1([?BADARG_BLOCK | T], OtherPath) -> - %% ?BADARG_BLOCK is a marker and not an actual block, so we can't consider - %% it to be a common block even if both paths cross it. +find_loop_exit_1([?EXCEPTION_BLOCK | T], OtherPath) -> + %% ?EXCEPTION_BLOCK is a marker and not an actual block, so we can't + %% consider it to be a common block even if both paths cross it. find_loop_exit_1(T, OtherPath); find_loop_exit_1([H|T], OtherPath) -> case cerl_sets:is_element(H, OtherPath) of @@ -1730,7 +1881,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 @@ -2079,8 +2230,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), @@ -2469,9 +2620,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..0912ecb2c2 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,reverse/2,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}. @@ -216,8 +175,8 @@ opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, {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), + 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]); {no_return,Ret,Is,Ds,Fdb,Sub} -> @@ -227,7 +186,7 @@ opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, %% 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]), + RetType = beam_types: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}, @@ -313,6 +272,12 @@ opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) end end; +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}), + {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}=I], Ts0, Ds0, Fdb, D, Sub0, Acc) -> case Ds0 of @@ -327,11 +292,11 @@ opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], #{} -> 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}, + 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); - none -> + error -> Ts = Ts0#{Dst=>Type}, Ds = Ds0#{Dst=>I}, opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]) @@ -374,7 +339,7 @@ simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) -> false -> I end; - #b_remote{} -> + #b_remote{} -> I end; simplify_call(I) -> I. @@ -421,10 +386,18 @@ opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), case Fdb0 of #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + %% 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}; @@ -433,7 +406,13 @@ opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> %% can receive anything as part of an external call. {Ts, Ds, Fdb0, I} end; +opt_call(#b_set{dst=Dst,args=[#b_var{}=Fun|Args]}=I, _D, Ts0, Ds0, Fdb) -> + Type = #t_fun{arity=length(Args)}, + Ts = Ts0#{ Fun => Type, Dst => any }, + Ds = Ds0#{ Dst => I }, + {Ts, Ds, Fdb, I}; opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> + %% #b_remote{} and literal funs Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{ Dst => I }, {Ts, Ds, Fdb, I}. @@ -446,22 +425,43 @@ opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> I = case Type of any -> I0; none -> I0; - _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0) + _ -> beam_ssa:add_anno(result_type, 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) -> +%% 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 }, + case Fdb0 of + #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + ArgCount = Callee#b_local.arity - length(FreeVars), + + 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 +487,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 +498,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,12 +597,12 @@ 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 + case normalized_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 + 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; none -> %% Will never be executed because of type conflict. @@ -578,7 +610,7 @@ simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> 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 +618,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]}; @@ -601,6 +633,44 @@ simplify(#b_set{op=wait_timeout,args=[#b_literal{val=infinity}]}=I, _Ts) -> I#b_set{op=wait,args=[]}; simplify(I, _Ts) -> I. +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 +681,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 +698,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 +731,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 +772,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 +788,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 +802,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 +811,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}. -subtract_sw_list(V, List, Ts) -> - Ts#{ V := sub_sw_list_1(get_type(V, Ts), List, Ts) }. +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}. + +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; @@ -833,242 +913,99 @@ update_types(#b_set{op=Op,dst=Dst,args=Args}, Ts, Ds) -> Ts#{Dst=>T}. type(phi, Args, Ts, _Ds) -> - Types = [get_type(A, Ts) || {A,_} <- Args], - join(Types); -type({bif,'band'}, Args, Ts, _Ds) -> - band_type(Args, Ts); + Types = [raw_type(A, Ts) || {A,_} <- Args], + beam_types:join(Types); type({bif,Bif}, Args, Ts, _Ds) -> - case bif_type(Bif, Args) of - number -> - arith_op_type(Args, Ts); - Type -> - Type - end; + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(erlang, Bif, ArgTypes), + RetType; 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)}; + #t_bitstring{}; +type(bs_extract, [Ctx], _Ts, Ds) -> + #b_set{op=bs_match,args=Args} = map_get(Ctx, Ds), + bs_match_type(Args); +type(bs_match, _Args, _Ts, _Ds) -> + #t_bs_context{}; type(bs_get_tail, _Args, _Ts, _Ds) -> - {binary, 1}; + #t_bitstring{}; 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; + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(Mod, Name, ArgTypes), + RetType; type(get_tuple_element, [Tuple, Offset], Ts, _Ds) -> - #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts), + #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); + beam_types:get_element_type(N + 1, Es); type(is_nonempty_list, [_], _Ts, _Ds) -> - t_boolean(); + beam_types:make_boolean(); type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) -> - t_boolean(); + beam_types:make_boolean(); +type(make_fun, [#b_local{arity=TotalArity}|Env], _Ts, _Ds) -> + #t_fun{arity=TotalArity-length(Env)}; type(put_map, _Args, _Ts, _Ds) -> - map; + #t_map{}; type(put_list, _Args, _Ts, _Ds) -> cons; type(put_tuple, Args, Ts, _Ds) -> {Es, _} = foldl(fun(Arg, {Es0, Index}) -> - Type = get_type(Arg, Ts), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} + 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) -> case maps:get(Src, Ds) of #b_set{op={bif,Bif},args=BifArgs} -> - Types = get_types(BifArgs, Ts), + Types = normalized_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() + BothBool = beam_types:is_boolean_type(T1) andalso + beam_types:is_boolean_type(T2), + case BothBool of + true -> beam_types:make_atom(true); + false -> beam_types:make_boolean() end; - {byte_size,[{binary,_}]} -> - t_atom(true); - {bit_size,[{binary,_}]} -> - t_atom(true); - {map_size,[map]} -> - t_atom(true); + {byte_size,[#t_bitstring{}]} -> + beam_types:make_atom(true); + {bit_size,[#t_bitstring{}]} -> + beam_types:make_atom(true); + {map_size,[#t_map{}]} -> + beam_types:make_atom(true); {'not',[Type]} -> - case t_is_boolean(Type) of - true -> t_atom(true); - false -> t_boolean() + case beam_types:is_boolean_type(Type) of + true -> beam_types:make_atom(true); + false -> beam_types:make_boolean() end; - {size,[{binary,_}]} -> - t_atom(true); + {size,[#t_bitstring{}]} -> + beam_types:make_atom(true); {tuple_size,[#t_tuple{}]} -> - t_atom(true); + beam_types:make_atom(true); {_,_} -> - t_boolean() + 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=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); + beam_types:make_atom(true); type(_, _, _, _) -> any. -arith_op_type(Args, Ts) -> - Types = get_types(Args, Ts), - foldl(fun(#t_integer{}, unknown) -> t_integer(); - (#t_integer{}, number) -> number; - (#t_integer{}, float) -> float; - (#t_integer{}, #t_integer{}) -> t_integer(); - (float, unknown) -> float; - (float, #t_integer{}) -> float; - (float, number) -> float; - (number, unknown) -> number; - (number, #t_integer{}) -> number; - (number, float) -> float; - (any, _) -> number; - (Same, Same) -> Same; - (_, _) -> none - end, unknown, Types). - -lists_function_type(F, Types) -> - case {F,Types} of - %% Functions that return booleans. - {all,[_,_]} -> - t_boolean(); - {any,[_,_]} -> - t_boolean(); - {keymember,[_,_,_]} -> - t_boolean(); - {member,[_,_]} -> - t_boolean(); - {prefix,[_,_]} -> - t_boolean(); - {suffix,[_,_]} -> - t_boolean(); - - %% Functions that return lists. - {dropwhile,[_,_]} -> - list; - {duplicate,[_,_]} -> - list; - {filter,[_,_]} -> - list; - {flatten,[_]} -> - list; - {map,[_Fun,List]} -> - same_length_type(List); - {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; - MapFold =:= mapfoldr -> - #t_tuple{size=2,exact=true, - elements=#{1=>same_length_type(List)}}; - {partition,[_,_]} -> - t_two_tuple(list, list); - {reverse,[List]} -> - same_length_type(List); - {sort,[List]} -> - same_length_type(List); - {splitwith,[_,_]} -> - t_two_tuple(list, list); - {takewhile,[_,_]} -> - list; - {unzip,[List]} -> - ListType = same_length_type(List), - t_two_tuple(ListType, ListType); - {usort,[List]} -> - same_length_type(List); - {zip,[_,_]} -> - list; - {zipwith,[_,_,_]} -> - list; - {_,_} -> - any - end. - -%% For a lists function that return a list of the same -%% length as the input list, return the type of the list. -same_length_type(cons) -> cons; -same_length_type(nil) -> nil; -same_length_type(_) -> list. - -t_two_tuple(Type1, Type2) -> - #t_tuple{size=2,exact=true, - elements=#{1=>Type1,2=>Type2}}. - %% will_succeed(TestOperation, Type) -> yes|no|maybe. %% Test whether TestOperation applied to an argument of type Type %% will succeed. Return yes, no, or maybe. %% -%% Type is a type as described in the comment for verified_type/1 at -%% the very end of this file, but it will *never* be 'any'. +%% 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 +1014,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 +1028,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 +1046,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 +1065,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 +1082,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 +1099,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 +1148,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 +1185,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 +1253,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 +1287,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 +1398,36 @@ 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(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 +1436,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 +1454,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 +1466,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..fd265fe174 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,30 +131,24 @@ 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()]} | @@ -200,7 +176,7 @@ 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, @@ -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,7 +388,7 @@ 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) -> @@ -407,17 +396,16 @@ valfun_1({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) + case erl_bifs:is_safe(erlang, Op, length(Ss)) of + true -> + %% It can't fail, so we finish handling it here (not updating + %% catch state). + {RetType, _, _} = bif_types(Op, Ss, Vst), + extract_term(RetType, {bif,Op}, Ss, Dst, Vst); + false -> + %% Since the BIF can fail, make sure that any catch state + %% is updated. + valfun_2(I, Vst) end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> @@ -431,14 +419,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,12 +439,15 @@ 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; @@ -469,8 +461,10 @@ 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, #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 +484,15 @@ 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), + case call_types(Func, Live, Vst) of + {none, _, _} -> + verify_live(Live, Vst), %% The stack will be scanned, so Y registers %% must be initialized. verify_y_init(Vst), - kill_state(Vst); - _ -> - valfun_2(I, Vst) + kill_state(Vst); + _ -> + valfun_2(I, Vst) end; valfun_1(_I, #vst{current=#st{ct=undecided}}) -> error(unknown_catch_try_state); @@ -534,7 +528,7 @@ valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> case get_tag_type(Reg, Vst0) of {catchtag,Fail} -> %% {x,0} contains the caught term, if any. - create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); + create_term(any, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); Type -> error({wrong_tag_type,Type}) end; @@ -553,31 +547,32 @@ valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> 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; 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) -> @@ -608,9 +603,9 @@ init_try_catch_branch(Tag, Dst, Fail, Vst0) -> %% 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. @@ -672,8 +667,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,53 +695,26 @@ 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); + validate_bif(bif, Op, Fail, Ss, Dst, Vst, Vst); valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> validate_src(Ss, Vst0), verify_live(Live, Vst0), @@ -749,19 +725,7 @@ valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> 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(gc_bif, Op, Fail, Ss, Dst, Vst0, Vst); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> assert_durable_term({x,0}, Vst), kill_state(Vst); @@ -773,7 +737,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) -> @@ -793,21 +757,21 @@ valfun_4(send, Vst) -> valfun_4({set_tuple_element,Src,Tuple,N}, Vst) -> I = N + 1, assert_term(Src, Vst), - assert_type({tuple_element,I}, Tuple, 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. - {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); + #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); %% 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 +781,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 +799,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 +869,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 +882,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 +917,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 +944,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 +960,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 +971,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 +989,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 +1035,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 +1059,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 +1084,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 +1101,40 @@ 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(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 +1142,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 +1164,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 +1178,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 +1232,12 @@ 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 + {RetType, _, _} -> + %% Type is never 'none' because it has been handled earlier. St = St0#st{f=init_fregs()}, Vst = prune_x_regs(0, Vst0#vst{current=St}), - create_term(Type, call, [], {x,0}, Vst) + create_term(RetType, call, [], {x,0}, Vst) end. %% Tail call. @@ -1237,8 +1252,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 +1272,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 +1497,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 +1545,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 +1557,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 +1573,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 +1771,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 +1873,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}, @@ -1915,308 +1930,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). +%% `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}. -join_elements(Es1, Es2) -> - Keys = if - map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); - map_size(Es1) > map_size(Es2) -> maps:keys(Es2) - end, - join_elements_1(Keys, Es1, Es2, #{}). - -join_elements_1([Key | Keys], Es1, Es2, Acc0) -> - Type = case {Es1, Es2} of - {#{ Key := Same }, #{ Key := Same }} -> Same; - {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); - {#{}, #{}} -> term - end, - Acc = set_element_type(Key, Type, Acc0), - join_elements_1(Keys, Es1, Es2, Acc); -join_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -%% Joins types of literals; note that the left argument must either be a -%% literal or exactly equal to the second argument. -join_literal(Same, Same) -> - Same; -join_literal({literal,_}=Lit, T) -> - join_literal(T, get_literal_type(Lit)); -join_literal(T1, T2) -> - %% We're done extracting the types, try merging them again. - join(T1, T2). - -join_list(nil, cons) -> list; -join_list(nil, list) -> list; -join_list(cons, list) -> list; -join_list(T, nil) -> join_list(nil, T); -join_list(T, cons) -> join_list(cons, T); -join_list(_, _) -> - %% Not a list, so it must be a term. - term. - -join_bool([]) -> {atom,[]}; -join_bool(true) -> bool; -join_bool(false) -> bool; -join_bool(_) -> {atom,[]}. - -%% meet(Type1, Type2) -> Type -%% Return the meet of two types. The meet is a more specific type. -%% It will be 'none' if the types are in conflict. - -meet(Same, Same) -> - Same; -meet(term, Other) -> - Other; -meet(Other, term) -> - Other; -meet(#ms{}, binary) -> - #ms{}; -meet(binary, #ms{}) -> - #ms{}; -meet({literal,_}, {literal,_}) -> - none; -meet(T1, {literal,_}=T2) -> - meet(T2, T1); -meet({literal,_}=T1, T2) -> - case meet(get_literal_type(T1), T2) of - none -> none; - _ -> T1 - end; -meet(T1, T2) -> - case {erlang:min(T1, T2),erlang:max(T1, T2)} of - {{atom,_}=A,{atom,[]}} -> A; - {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; - {bool,{atom,[]}} -> bool; - {cons,list} -> cons; - {{float,_}=T,{float,[]}} -> T; - {{integer,_}=T,{integer,[]}} -> T; - {list,nil} -> nil; - {number,{integer,_}=T} -> T; - {number,{float,_}=T} -> T; - {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> - Es = meet_elements(Es1, Es2), - case {Size1,Size2,Es} of - {_, _, none} -> - none; - {[Sz1],[Sz2],_} -> - Sz = erlang:max(Sz1, Sz2), - assert_tuple_elements(Sz, Es), - {tuple,[Sz],Es}; - {Sz1,[Sz2],_} when Sz2 =< Sz1 -> - assert_tuple_elements(Sz1, Es), - {tuple,Sz1,Es}; - {Sz,Sz,_} -> - assert_tuple_elements(Sz, Es), - {tuple,Sz,Es}; - {_,_,_} -> - none - end; - {_,_} -> none +%% 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 +1979,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 +1990,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 +2036,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 @@ -2517,9 +2257,6 @@ merge_ct_1([C0|Ct0], [C1|Ct1]) -> merge_ct_1([], []) -> []; merge_ct_1(_, _) -> undecided. -tuple_sz([Sz]) -> Sz; -tuple_sz(Sz) -> Sz. - verify_y_init(#vst{current=#st{numy=NumY,ys=Ys}}=Vst) when is_integer(NumY) -> HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), true = NumY > HighestY, %Assertion. @@ -2661,319 +2398,27 @@ 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. +bif_types(Op, Ss, Vst) -> + Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss], + beam_call_types:types(erlang, Op, Args). -%%% -%%% Return/argument types of calls -%%% +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}. -call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); -call_return_type(_, _) -> term. +get_call_args(Arity, Vst) -> + get_call_args_1(0, Arity, Vst). -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. +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..6fd1790c1a 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -81,8 +81,11 @@ -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]). @@ -120,15 +123,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 +723,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) -> @@ -2446,8 +2464,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..72e55ae9ec 100644 --- a/lib/compiler/test/beam_ssa_SUITE.erl +++ b/lib/compiler/test/beam_ssa_SUITE.erl @@ -326,7 +326,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(), @@ -388,48 +388,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..685e1a95a7 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -35,7 +35,7 @@ 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]). -include_lib("common_test/include/ct.hrl"). @@ -65,7 +65,7 @@ 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]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -217,11 +217,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 +232,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 +520,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 +705,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. 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..eb60dc049d 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), 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..f91b8bfa5e 100644 --- a/lib/debugger/Makefile +++ b/lib/debugger/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/dialyzer/Makefile b/lib/dialyzer/Makefile index e4f681dcd9..ab0b94748e 100644 --- a/lib/dialyzer/Makefile +++ b/lib/dialyzer/Makefile @@ -42,3 +42,4 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/diameter/Makefile b/lib/diameter/Makefile index a0195a0988..8c3c0ff0cc 100644 --- a/lib/diameter/Makefile +++ b/lib/diameter/Makefile @@ -31,3 +31,5 @@ info: @echo "APP_VSN = $(APP_VSN)" .PHONY: info + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/edoc/Makefile b/lib/edoc/Makefile index 70bf1f3d48..6dfc6f51c7 100644 --- a/lib/edoc/Makefile +++ b/lib/edoc/Makefile @@ -124,3 +124,6 @@ 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/eldap/Makefile b/lib/eldap/Makefile index 28f995e068..98b5203dfd 100644 --- a/lib/eldap/Makefile +++ b/lib/eldap/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/erl_docgen/Makefile b/lib/erl_docgen/Makefile index 30ff2bf16e..a13a3c4f94 100644 --- a/lib/erl_docgen/Makefile +++ b/lib/erl_docgen/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/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..98e15dc179 100644 --- a/lib/et/Makefile +++ b/lib/et/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/eunit/Makefile b/lib/eunit/Makefile index 15dae19896..acc765faf9 100644 --- a/lib/eunit/Makefile +++ b/lib/eunit/Makefile @@ -94,3 +94,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..e6bceebe15 100644 --- a/lib/ftp/Makefile +++ b/lib/ftp/Makefile @@ -76,3 +76,5 @@ dialyzer: $(DIA_PLT) @dialyzer --plt $< \ ../$(APPLICATION)/ebin \ --verbose + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile index 0676484fca..a1c5f9c83f 100644 --- a/lib/hipe/Makefile +++ b/lib/hipe/Makefile @@ -75,3 +75,4 @@ distclean: realclean: $(V_at)$(MAKE) MAKETARGET="realclean" all-subdirs all-subdirs-x +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..9a03ee93df 100644 --- a/lib/inets/Makefile +++ b/lib/inets/Makefile @@ -76,3 +76,5 @@ dialyzer: $(DIA_PLT) @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 187705a0b5..a3b089c1da 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..d923207f9f 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> @@ -985,8 +989,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 +1444,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..42261d371d 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -92,7 +92,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..ebf83bb475 100644 --- a/lib/megaco/Makefile +++ b/lib/megaco/Makefile @@ -226,3 +226,5 @@ dialyzer: $(DIA_PLT) @dialyzer --plt $< \ ../$(APPLICATION)/ebin \ --verbose + +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..4770a72ba8 100644 --- a/lib/observer/Makefile +++ b/lib/observer/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/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..dfa224ecd6 100644 --- a/lib/odbc/Makefile +++ b/lib/odbc/Makefile @@ -114,3 +114,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..3b6cb3ce6c 100644 --- a/lib/public_key/Makefile +++ b/lib/public_key/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/reltool/Makefile b/lib/reltool/Makefile index 4b6aad07b3..70c80e1c3c 100644 --- a/lib/reltool/Makefile +++ b/lib/reltool/Makefile @@ -36,3 +36,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/runtime_tools/Makefile b/lib/runtime_tools/Makefile index eec1ff379b..9a0822b9b6 100644 --- a/lib/runtime_tools/Makefile +++ b/lib/runtime_tools/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/sasl/Makefile b/lib/sasl/Makefile index 065eb45fbb..1710606d3d 100644 --- a/lib/sasl/Makefile +++ b/lib/sasl/Makefile @@ -36,3 +36,4 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/snmp/Makefile b/lib/snmp/Makefile index df321fc2d1..86f227b01d 100644 --- a/lib/snmp/Makefile +++ b/lib/snmp/Makefile @@ -155,3 +155,5 @@ dialyzer: $(DIA_PLT) @dialyzer --plt $< \ ../$(APPLICATION)/ebin \ --verbose + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/ssh/Makefile b/lib/ssh/Makefile index dedc7ac3a6..ab3948df75 100644 --- a/lib/ssh/Makefile +++ b/lib/ssh/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/ssl/Makefile b/lib/ssl/Makefile index bd43794a36..c761979474 100644 --- a/lib/ssl/Makefile +++ b/lib/ssl/Makefile @@ -38,4 +38,4 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk - +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/stdlib/Makefile b/lib/stdlib/Makefile index 3086d85445..0444cedadb 100644 --- a/lib/stdlib/Makefile +++ b/lib/stdlib/Makefile @@ -35,3 +35,5 @@ SPECIAL_TARGETS = # Default Subdir Targets # include $(ERL_TOP)/make/otp_subdir.mk + +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..348a4a86b6 100644 --- a/lib/tftp/Makefile +++ b/lib/tftp/Makefile @@ -76,3 +76,5 @@ dialyzer: $(DIA_PLT) @dialyzer --plt $< \ ../$(APPLICATION)/ebin \ --verbose + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/tools/Makefile b/lib/tools/Makefile index e17e9cfd1e..811926e20d 100644 --- a/lib/tools/Makefile +++ b/lib/tools/Makefile @@ -36,3 +36,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +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..84b243fe68 100644 --- a/lib/xmerl/Makefile +++ b/lib/xmerl/Makefile @@ -97,3 +97,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 diff --git a/make/app_targets.mk b/make/app_targets.mk new file mode 100644 index 0000000000..3f28a529d4 --- /dev/null +++ b/make/app_targets.mk @@ -0,0 +1,25 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-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% +# + + +.PHONY: test + +test: + $(ERL_TOP)/make/test_target_script.sh $(ERL_TOP) diff --git a/make/test_target_script.sh b/make/test_target_script.sh new file mode 100755 index 0000000000..f605efa120 --- /dev/null +++ b/make/test_target_script.sh @@ -0,0 +1,254 @@ +#!/bin/sh + +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-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% +# + + +RED='\033[0;31m' +GREEN='\033[0;32m' +YELLOW='\033[1;33m' +LIGHT_CYAN='\033[1;36m' +BOLD='\033[1m' +NC='\033[0m' + + +print_highlighted_msg_with_printer () { + COLOR=$1 + MSG_PRINTER=$2 + printf "\n${COLOR}======================================================================${NC}\n" + echo + $MSG_PRINTER + echo + printf "${COLOR}======================================================================${NC}\n" +} + +print_highlighted_msg () { + COLOR=$1 + MSG=$2 + print_msg () { + echo "$MSG" + } + print_highlighted_msg_with_printer $COLOR print_msg +} + +print_all_tests_takes_long_time_warning () { + print_msg () { + cat << EOM + +WARNING + +All tests will require several hours to run. You may want to check the +following text file that describes how to run tests for a specific +application. + +EOM + echo $ERL_TOP/HOWTO/TESTING.md + } + print_highlighted_msg_with_printer $YELLOW print_msg +} + +print_all_tests_for_application_notes () { + print_msg () { + cat << EOM + +NOTE 1 + +ct_run will now attempt to execute tests in the test directory, which +may take a long time to do. One can pass arguments to ct_run by +setting the ARGS variable when invoking "make test". + +Example: + +make ARGS="-suite asn1_SUITE -case ticket_7407" test + +NOTE 2 + +You may want to look at the more established way of running tests that +is described in the following text file if you encounter strange +errors: + +EOM + echo "$ERL_TOP/HOWTO/TESTING.md" + } + print_highlighted_msg_with_printer $LIGHT_CYAN print_msg +} + +print_c_files_warning () { + print_msg () { + cat << EOM + +WARNING + +The test directory contains .c files which means that some test cases +will probably not work correctly when run through "make test". The +text file at the following location describes how one can compile and +run all test cases: + + +EOM + echo $ERL_TOP/HOWTO/TESTING.md + } + print_highlighted_msg_with_printer $YELLOW print_msg +} + + +print_on_error_note () { + print_msg () { + cat << EOM +NOTE: + +Some test cases do not work correctly when run through "make test" as +they are designed to be run through the method that is described in +the "$ERL_TOP/HOWTO/TESTING.md" text file. You may want to check this +text file if you encounter strange errors. Note also that you can +rerun a specific test case by passing parameters to ct_run as in the +example below: + +make ARGS="-suite asn1_SUITE -case ticket_7407" test + +EOM + } + print_highlighted_msg_with_printer $NC print_msg +} + +# Check ERL_TOP + +if [ -d "$1" ] +then + ERL_TOP="$1" + shift +fi + +if [ -z $ERL_TOP ] +then + ERL_TOP=`git rev-parse --show-toplevel` + if [ $? = 0 ] + then + print_highlighted_msg $LIGHT_CYAN "The environment variable ERL_TOP has been set to the git root" + else + echo "The ERL_TOP environment variable need to be set before this script is executed." + exit 1 + fi +fi + +export ERL_TOP=$ERL_TOP + + +if [ -z "${ARGS}" ] +then + ARGS="$@" +fi + +# make test in root +DIR=`pwd` +if [ "$DIR" -ef "$ERL_TOP" ] +then + TARGET_SYS=`$ERL_TOP/erts/autoconf/config.guess` + REL_DIR="$ERL_TOP/release/$TARGET_SYS" + cd "$REL_DIR" + ./Install -minimal "`pwd`" + export PATH="$REL_DIR/bin:$PATH" + cd "$ERL_TOP/release/tests/test_server" + print_all_tests_takes_long_time_warning + echo "The tests will start in a few seconds..." + sleep 45 + cd "$ERL_TOP/release/tests/test_server" + erl -eval "ts:install(),erlang:halt()" + erl -noinput -eval "ts:run([all_tests,batch]),erlang:halt()" + exit $? +fi + +# check that there is a test directory +if [ ! -d test ] +then + print_highlighted_msg $RED "This target only works in directories containing a test directory or\nin the root directory." + exit 1 +fi + + +APPLICATION="`basename $DIR`" +CT_RUN="$ERL_TOP/bin/ct_run" +MAKE_TEST_DIR="`pwd`/make_test_dir" +MAKE_TEST_REL_DIR="$MAKE_TEST_DIR/${APPLICATION}_test" +MAKE_TEST_CT_LOGS="$MAKE_TEST_DIR/ct_logs" +RELEASE_TEST_SPEC_LOG="$MAKE_TEST_CT_LOGS/release_tests_spec_log" + +cd test +echo "The tests in test directory for $APPLICATION will be executed with ct_run" +if [ -z "${ARGS}" ] +then + if [ ! -d "$MAKE_TEST_DIR" ] + then + print_all_tests_for_application_notes + fi + if find . -type f -name '*.c' | grep -q "." + then + print_c_files_warning + fi +fi + +mkdir -p "$MAKE_TEST_DIR" +mkdir -p "$MAKE_TEST_REL_DIR" +mkdir -p "$MAKE_TEST_CT_LOGS" +make RELSYSDIR=$MAKE_TEST_REL_DIR release_tests_spec > $RELEASE_TEST_SPEC_LOG 2>&1 + +if [ $? != 0 ] +then + cat $RELEASE_TEST_SPEC_LOG + print_highlighted_msg $RED "\"make RELSYSDIR="$MAKE_TEST_REL_DIR" release_tests_spec\" failed." + exit 1 +fi +SPEC_FLAG="" +SPEC_FILE="" +if [ -z "${ARGS}" ] +then + SPEC_FLAG="-spec" + SPEC_FILE="$MAKE_TEST_REL_DIR/$APPLICATION.spec" + ARGS="$SPEC_FLAG $SPEC_FILE" +fi +# Compile test server +(cd "$ERL_TOP/lib/common_test/test_server" && make) +# Run ct_run +cd $MAKE_TEST_REL_DIR +$CT_RUN -logdir $MAKE_TEST_CT_LOGS\ + -pa "$ERL_TOP/lib/common_test/test_server"\ + ${ARGS}\ + -erl_args\ + -env "$PATH"\ + -env ERL_CRASH_DUMP "$MAKE_TEST_DIR/${APPLICATION}_erl_crash.dump"\ + -boot start_sasl\ + -sasl errlog_type error\ + -pz "$ERL_TOP/lib/common_test/test_server"\ + -pz "."\ + -ct_test_vars "{net_dir,\"\"}"\ + -noshell\ + -sname test_server\ + -rsh ssh\ + ${ERL_ARGS} +CT_RUN_STATUS=$? +if [ $CT_RUN_STATUS = "0" ] +then + print_highlighted_msg $GREEN "The test(s) ran successfully (ct_run returned a success code)\nTest logs: file://$MAKE_TEST_CT_LOGS/index.html" + exit 0 +else + print_on_error_note + print_highlighted_msg $RED "ct_run returned the error code $CT_RUN_STATUS\nTest logs: file://$MAKE_TEST_CT_LOGS/index.html" + exit $CT_RUN_STATUS +fi diff --git a/scripts/pre-push b/scripts/pre-push index 71e9fd1e75..7da1f575db 100755 --- a/scripts/pre-push +++ b/scripts/pre-push @@ -22,12 +22,15 @@ # <local ref> <local sha1> <remote ref> <remote sha1> # -NEW_RELEASES="21 20 19 18 17" +# Bump this version to give users an update notification. +PRE_PUSH_SCRIPT_VERSION=1 + +NEW_RELEASES="22 21 20 19 18 17" OLD_RELEASES="r16 r15 r14 r13" RELEASES="$NEW_RELEASES $OLD_RELEASES" # First commit on master, not allowed in other branches -MASTER_ONLY=aea2a053e28a11497796879715be29ab0c3cd1a0 +MASTER_ONLY=f633fe962ea7078c32f8c81d34950c0ebce0f472 # Number of commits and files allowed in one push by this script NCOMMITS_MAX=100 @@ -54,13 +57,23 @@ null=0000000000000000000000000000000000000000 #echo "pre-push hook: remote=$remote" #echo "pre-push hook: url=$url" +red_on() { + printf '%b' "\033[31m" +} + +red_off() { + printf '%b' "\033[0m" +} + if [ "$url" = 'https://github.com/erlang/otp.git' -o "$url" = '[email protected]:erlang/otp.git' ] then if [ $remote = "$url" ]; then + red_on echo "$0 says:" echo "***" echo "*** Push to $url without using a named remote is NOT ALLOWED!!!!" echo "***" + red_off exit 1 fi IFS=' ' @@ -73,18 +86,22 @@ then if [ "$local_sha" = $null ] then + red_on echo "$0 says:" echo "***" echo "*** DELETE push to '$remote' NOT ALLOWED!!!!!" echo "***" + red_off exit 1 fi if [ "$local_ref" != "$remote_ref" ] then + red_on echo "$0 says:" echo "***" echo "*** RENAME push: $local_ref pushed as $remote_ref to '$remote' NOT ALLOWED!!!!" echo "***" + red_off exit 1 fi case "$remote_ref" in @@ -92,46 +109,74 @@ then branch=${remote_ref#refs/heads/} if [ "$remote_sha" = $null ] then + red_on echo "$0 says:" echo "***" echo "*** UNKNOWN BRANCH: '$branch' does not exist at '$remote'!!!!" echo "***" + red_off exit 1 fi if ! git log -1 --oneline $remote_sha > /dev/null 2>&1 then + red_on echo "$0 says:" echo "***" echo "*** The top of '$branch' at '$remote' ($remote_sha)" echo "*** does not exist locally!!!" echo "*** You probably need to refresh local '$branch' and redo merge." echo "***" + red_off exit 1 fi if ! git merge-base --is-ancestor $remote_sha $local_sha then + red_on echo "$0 says:" echo "***" echo "*** FORCE push branch to '$remote' NOT ALLOWED!!!" echo "***" + red_off exit 1 fi if [ $remote_ref != refs/heads/master -a "$MASTER_ONLY" ] && git merge-base --is-ancestor $MASTER_ONLY $local_sha then - echo "$0 says:" - echo "***" - echo "*** INVALID MERGE: Commit $MASTER_ONLY should not be reachable from '$branch'!!!!" - echo "*** You have probably merged master into '$branch' by mistake" - echo "***" - exit 1 + THIS_SCRIPT=`git rev-parse --git-path hooks/pre-push` + THIS_SCRIPT=`realpath $THIS_SCRIPT` + if git show refs/remotes/$remote/master:scripts/pre-push | diff -q --context=0 $THIS_SCRIPT - > /dev/null 2>&1 + then + red_on + echo "$0 says:" + echo "***" + echo "*** INVALID MERGE: Commit $MASTER_ONLY should not be reachable from '$branch'!!!!" + echo "*** You have probably merged master into '$branch' by mistake" + echo "***" + red_off + exit 1 + else + red_on + echo "$0 says:" + echo "***" + echo "*** The pre-push hook of this OTP repo needs updating." + echo "*** Do it by executing the following command:" + echo "***" + echo "*** git show refs/remotes/$remote/master:scripts/pre-push > $THIS_SCRIPT" + echo "***" + echo "*** And then retry the push." + echo "***" + red_off + exit 1 + fi fi if [ ${remote_ref#refs/heads/maint-} != $remote_ref ] && git merge-base --is-ancestor refs/remotes/$remote/maint $local_sha then + red_on echo "$0 says:" echo "***" echo "*** INVALID MERGE: Branch maint should not be reachable from '$branch'!!!!" echo "*** You have probably merged maint into '$branch' by mistake." echo "***" + red_off exit 1 fi if [ $remote_ref = refs/heads/maint -o $remote_ref = refs/heads/master ]; then @@ -147,29 +192,35 @@ then fi if [ $remote_ref = refs/heads/master ] && ! git merge-base --is-ancestor refs/remotes/$remote/maint $local_sha then + red_on echo "$0 says:" echo "***" echo "*** INVALID PUSH: Branch '$remote/maint' is not reachable from master!!!!" echo "*** Someone needs to merge maint forward to master and push." echo "***" + red_off exit 1 fi NCOMMITS=`git rev-list --count $remote_sha..$local_sha` if [ $NCOMMITS -gt $NCOMMITS_MAX ] then + red_on echo "$0 says:" echo "***" echo "*** HUGE push: $NCOMMITS commits (> $NCOMMITS_MAX) to '$branch' at '$remote' NOT ALLOWED!!!!" echo "***" + red_off exit 1 fi NFILES=`git diff --name-only $remote_sha $local_sha | wc --lines` if [ $NFILES -gt $NFILES_MAX ] then + red_on echo "$0 says:" echo "***" echo "*** HUGE push: $NFILES changed files (> $NFILES_MAX) to '$branch' at '$remote' NOT ALLOWED!!!!" echo "***" + red_off exit 1 fi ;; @@ -185,49 +236,74 @@ then done if [ $REL = "UNKNOWN" ] then + red_on echo "$0 says:" echo "***" echo "*** Unknown OTP release number in tag '$tag'" echo "***" + red_off exit 1 fi if [ "$remote_sha" != $null ] then + red_on echo "$0 says:" echo "***" echo "*** FORCE push tag to '$remote' NOT ALLOWED!!!" echo "*** Tag '$tag' already exists at '$remote'." echo "***" + red_off exit 1 fi ;; refs/heads/*) branch=${remote_ref#refs/heads/} + red_on echo "$0 says:" echo "***" echo "*** UNKNOWN branch name: '$branch' pushed to '$remote' NOT ALLOWED!!!!" echo "***" + red_off exit 1 ;; refs/tags/*) tag=${remote_ref#refs/tags/} + red_on echo "$0 says:" echo "***" echo "*** UNKNOWN tag name: '$tag' pushed to '$remote' NOT ALLOWED!!!!" echo "***" + red_off exit 1 ;; *) + red_on echo "$0 says:" echo "***" echo "*** STRANGE ref: '$remote_ref' pushed to '$remote' NOT ALLOWED!!!!" echo "***" + red_off exit 1 ;; esac done + + echo "$0: OK" + + THIS_SCRIPT=`git rev-parse --git-path hooks/pre-push` + THIS_SCRIPT=`realpath $THIS_SCRIPT` + if git show refs/remotes/$remote/master:scripts/pre-push | diff --context=0 $THIS_SCRIPT - | grep -q PRE_PUSH_SCRIPT_VERSION > /dev/null 2>&1 + then + echo "" + echo "NOTE: There is a newer version of the pre-push hook in this OTP repo." + echo " You can install it by executing the following command:" + echo + echo " git show refs/remotes/$remote/master:scripts/pre-push > $THIS_SCRIPT" + echo + fi else echo "$0: No checks done for remote '$remote' at $url." fi exit 0 + |
