diff options
461 files changed, 8956 insertions, 5672 deletions
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 8814e506f9..b754fbd662 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -30,7 +30,7 @@ By making a contribution to this project, I certify that: Erlang/otp is licensed under the Apache License 2.0 -As stated in: LICENSE.txt +As stated in: [LICENSE.txt](LICENSE.txt) http://developercertificate.org/ @@ -95,6 +95,9 @@ a discussion on the mailing list. * Make sure existing test cases don't fail. It is not necessary to run all tests (that would take many hours), but you should at least run the tests for the application you have changed. See [Running tests](https://github.com/erlang/otp/wiki/Running-tests). +* Make sure the documentation builds and is according to the dtd. eg. `make xmllint` or `cd lib/stdlib/ && make xmllint` +* Make sure no new dialyzer warnings have been added. eg. `make dialyzer` or `cd lib/stdlib/ && make dialyzer` +* Make sure that travis passes, if you go to https://travis-ci.org/$YOUR_GITHUB_USER/otp/ you can enable travis builds for you otp fork. Make sure that your branch contains clean commits: 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..55decd8794 100644 --- a/Makefile.in +++ b/Makefile.in @@ -1141,3 +1141,11 @@ bootstrap_clean: || $(MAKE) BOOTSTRAP_ROOT=$(BOOTSTRAP_ROOT) bootstrap_root_clean # ---------------------------------------------------------------------- + +.PHONY: test dialyzer + +test: all release release_tests + $(ERL_TOP)/make/test_target_script.sh $(ERL_TOP) + +dialyzer: all + $(ERL_TOP)/scripts/run-dialyzer 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/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differindex ceb83ba48b..160855f0a1 100644 --- a/bootstrap/lib/compiler/ebin/beam_a.beam +++ b/bootstrap/lib/compiler/ebin/beam_a.beam diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 78b75359a6..41b50928be 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam Binary files differindex 1db56cb5f1..0faa2a981c 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_call_types.beam b/bootstrap/lib/compiler/ebin/beam_call_types.beam Binary files differnew file mode 100644 index 0000000000..e73383b4ed --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_call_types.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex 4d567eca88..74a73324b9 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex b9317a55ee..3dd6c8e6d7 100644 --- a/bootstrap/lib/compiler/ebin/beam_dict.beam +++ b/bootstrap/lib/compiler/ebin/beam_dict.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex eb2a13d620..34619b82b9 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam Binary files differdeleted file mode 100644 index 1894483f71..0000000000 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ /dev/null diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex d7780861c2..8874d5d6e8 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex 289c08630a..3419693975 100644 --- a/bootstrap/lib/compiler/ebin/beam_jump.beam +++ b/bootstrap/lib/compiler/ebin/beam_jump.beam diff --git a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam Binary files differindex 96362c8cdd..2d239b9e40 100644 --- a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam +++ b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam diff --git a/bootstrap/lib/compiler/ebin/beam_listing.beam b/bootstrap/lib/compiler/ebin/beam_listing.beam Binary files differindex 097ba5e7ff..747ee9e685 100644 --- a/bootstrap/lib/compiler/ebin/beam_listing.beam +++ b/bootstrap/lib/compiler/ebin/beam_listing.beam diff --git a/bootstrap/lib/compiler/ebin/beam_opcodes.beam b/bootstrap/lib/compiler/ebin/beam_opcodes.beam Binary files differindex 52a23f7f6c..31a700c6e9 100644 --- a/bootstrap/lib/compiler/ebin/beam_opcodes.beam +++ b/bootstrap/lib/compiler/ebin/beam_opcodes.beam diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex 9246bd1c27..293a6bb264 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa.beam b/bootstrap/lib/compiler/ebin/beam_ssa.beam Binary files differindex 0327230a58..7d59829998 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam b/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam Binary files differindex b9bb997cc7..9674c3c352 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam Binary files differindex cb06630012..7f2b8349fc 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam Binary files differindex 782073698e..3879c3c9d8 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam b/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam Binary files differindex 6370e1eb78..2efca72292 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam Binary files differindex e0a43057fc..d9f74f89dd 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam Binary files differindex b8588725b4..781820872b 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam Binary files differindex f76f15aa70..19bdaa1a9e 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam Binary files differindex e22cb5c846..2d8301e71b 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam b/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam Binary files differindex 578e8db0eb..d67d6db761 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_share.beam b/bootstrap/lib/compiler/ebin/beam_ssa_share.beam Binary files differindex d975cebf48..c59f105c65 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_share.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_share.beam diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam Binary files differindex 0403230604..a52959ec5a 100644 --- a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 00f3224106..fefffbac73 100644 --- a/bootstrap/lib/compiler/ebin/beam_trim.beam +++ b/bootstrap/lib/compiler/ebin/beam_trim.beam diff --git a/bootstrap/lib/compiler/ebin/beam_types.beam b/bootstrap/lib/compiler/ebin/beam_types.beam Binary files differnew file mode 100644 index 0000000000..7658ed8dcd --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_types.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex 996525efc9..c26a840398 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 050789f481..b7eef824d1 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differindex 21ca7bcf46..13a77364b8 100644 --- a/bootstrap/lib/compiler/ebin/beam_z.beam +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex 948c4759b0..ef121c4d2f 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_clauses.beam b/bootstrap/lib/compiler/ebin/cerl_clauses.beam Binary files differindex a20a4ca43b..09ce6fe0a8 100644 --- a/bootstrap/lib/compiler/ebin/cerl_clauses.beam +++ b/bootstrap/lib/compiler/ebin/cerl_clauses.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex 7bf92a0dd7..e109cf60cc 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_sets.beam b/bootstrap/lib/compiler/ebin/cerl_sets.beam Binary files differindex bda70130a6..58efd3f8e3 100644 --- a/bootstrap/lib/compiler/ebin/cerl_sets.beam +++ b/bootstrap/lib/compiler/ebin/cerl_sets.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex 831eddc405..c7efc37edf 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex ebe42547ee..64fe613410 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index e086da1b68..4d6b9b484d 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -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/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex 19b0c3dfcb..2179dceeca 100644 --- a/bootstrap/lib/compiler/ebin/core_lib.beam +++ b/bootstrap/lib/compiler/ebin/core_lib.beam diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex ecad4f33e0..76007eb4a3 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex f14357cf02..10c3f135e0 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex a2b3167e10..7ed91b8614 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam Binary files differindex 8e44464cd7..4505c07159 100644 --- a/bootstrap/lib/compiler/ebin/core_scan.beam +++ b/bootstrap/lib/compiler/ebin/core_scan.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex e626e91f4f..32fc39a28b 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam Binary files differindex 6d0c5baa04..a3e441e12b 100644 --- a/bootstrap/lib/compiler/ebin/rec_env.beam +++ b/bootstrap/lib/compiler/ebin/rec_env.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_alias.beam b/bootstrap/lib/compiler/ebin/sys_core_alias.beam Binary files differindex b769b6be41..0cd375f706 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_alias.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_alias.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam Binary files differindex 6f4204e0a1..c92a95d2d6 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex d4746e3664..e65b66aa99 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam Binary files differindex f4aac9ac13..fad3a34ad5 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam Binary files differindex 5647c8fcb5..a5c1fd8784 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_inline.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_inline.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam Binary files differindex 002b4f2914..96280ba9ec 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 3cbbdfd88b..214aacff2d 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex 6ce6777e55..1a7bf1455b 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam Binary files differindex 5177b65198..4bbc799593 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 84c5b7636e..c72d5c645f 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex b5d6545ca7..20a7077f9d 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex 77bb9544e2..5a840ea9c6 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/application_starter.beam b/bootstrap/lib/kernel/ebin/application_starter.beam Binary files differindex 0daab463ab..9abb2b8a0c 100644 --- a/bootstrap/lib/kernel/ebin/application_starter.beam +++ b/bootstrap/lib/kernel/ebin/application_starter.beam diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam Binary files differindex c77178bf7c..724d74bcdc 100644 --- a/bootstrap/lib/kernel/ebin/auth.beam +++ b/bootstrap/lib/kernel/ebin/auth.beam diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam Binary files differindex 204b15fcf2..2164f0d6fd 100644 --- a/bootstrap/lib/kernel/ebin/code.beam +++ b/bootstrap/lib/kernel/ebin/code.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex 637e40f5d8..2c9e8c08ea 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex 25142ee575..b17090c99a 100644 --- a/bootstrap/lib/kernel/ebin/disk_log.beam +++ b/bootstrap/lib/kernel/ebin/disk_log.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam Binary files differindex 0a781001dc..ee39281793 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_1.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_1.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam Binary files differindex 3b961dcefa..ca977a296e 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_server.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_sup.beam b/bootstrap/lib/kernel/ebin/disk_log_sup.beam Binary files differindex 67099f7212..58ca3f887f 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_sup.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_sup.beam diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex e82fc7dc75..77c3862368 100644 --- a/bootstrap/lib/kernel/ebin/dist_ac.beam +++ b/bootstrap/lib/kernel/ebin/dist_ac.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 8fa128dd23..7f764d68bb 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex 801e3d8b88..5005621c01 100644 --- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam +++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam diff --git a/bootstrap/lib/kernel/ebin/erl_ddll.beam b/bootstrap/lib/kernel/ebin/erl_ddll.beam Binary files differindex c04bc43872..ec6900016a 100644 --- a/bootstrap/lib/kernel/ebin/erl_ddll.beam +++ b/bootstrap/lib/kernel/ebin/erl_ddll.beam diff --git a/bootstrap/lib/kernel/ebin/erl_distribution.beam b/bootstrap/lib/kernel/ebin/erl_distribution.beam Binary files differindex 4490f9c81f..71f01fbf30 100644 --- a/bootstrap/lib/kernel/ebin/erl_distribution.beam +++ b/bootstrap/lib/kernel/ebin/erl_distribution.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 6ed9862a0e..7d9d5cfba3 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/erl_reply.beam b/bootstrap/lib/kernel/ebin/erl_reply.beam Binary files differindex 7658a35642..e74194895d 100644 --- a/bootstrap/lib/kernel/ebin/erl_reply.beam +++ b/bootstrap/lib/kernel/ebin/erl_reply.beam diff --git a/bootstrap/lib/kernel/ebin/erl_signal_handler.beam b/bootstrap/lib/kernel/ebin/erl_signal_handler.beam Binary files differindex da03769e2e..8876298e22 100644 --- a/bootstrap/lib/kernel/ebin/erl_signal_handler.beam +++ b/bootstrap/lib/kernel/ebin/erl_signal_handler.beam diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam Binary files differindex 19739b0043..2f1c9075cc 100644 --- a/bootstrap/lib/kernel/ebin/error_handler.beam +++ b/bootstrap/lib/kernel/ebin/error_handler.beam diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam Binary files differindex 10b13c35b6..a8694eedaa 100644 --- a/bootstrap/lib/kernel/ebin/error_logger.beam +++ b/bootstrap/lib/kernel/ebin/error_logger.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex e0b759eee3..f731417e46 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex a7a82a1f12..c151bcebbc 100644 --- a/bootstrap/lib/kernel/ebin/file.beam +++ b/bootstrap/lib/kernel/ebin/file.beam diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam Binary files differindex b8f1272be4..1300423dc3 100644 --- a/bootstrap/lib/kernel/ebin/file_io_server.beam +++ b/bootstrap/lib/kernel/ebin/file_io_server.beam diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam Binary files differindex cc2face79c..6f7ab15d43 100644 --- a/bootstrap/lib/kernel/ebin/file_server.beam +++ b/bootstrap/lib/kernel/ebin/file_server.beam diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam Binary files differindex 9fc5800f0c..610f20716c 100644 --- a/bootstrap/lib/kernel/ebin/gen_sctp.beam +++ b/bootstrap/lib/kernel/ebin/gen_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/gen_tcp.beam b/bootstrap/lib/kernel/ebin/gen_tcp.beam Binary files differindex 736b28c68f..af3ad4bb74 100644 --- a/bootstrap/lib/kernel/ebin/gen_tcp.beam +++ b/bootstrap/lib/kernel/ebin/gen_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/gen_udp.beam b/bootstrap/lib/kernel/ebin/gen_udp.beam Binary files differindex 0d6541ee53..1c75188e26 100644 --- a/bootstrap/lib/kernel/ebin/gen_udp.beam +++ b/bootstrap/lib/kernel/ebin/gen_udp.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex aadb5bf080..d4e39916f8 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam Binary files differindex 83885cdeb5..20c80de369 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/global_search.beam b/bootstrap/lib/kernel/ebin/global_search.beam Binary files differindex a94d9da454..e56ccd0f53 100644 --- a/bootstrap/lib/kernel/ebin/global_search.beam +++ b/bootstrap/lib/kernel/ebin/global_search.beam diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam Binary files differindex dcec55421c..63a28baf7a 100644 --- a/bootstrap/lib/kernel/ebin/group.beam +++ b/bootstrap/lib/kernel/ebin/group.beam diff --git a/bootstrap/lib/kernel/ebin/group_history.beam b/bootstrap/lib/kernel/ebin/group_history.beam Binary files differindex b9df7cfc14..456ed63c84 100644 --- a/bootstrap/lib/kernel/ebin/group_history.beam +++ b/bootstrap/lib/kernel/ebin/group_history.beam diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex 1b63142893..058290ee4e 100644 --- a/bootstrap/lib/kernel/ebin/heart.beam +++ b/bootstrap/lib/kernel/ebin/heart.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex de7d9c2e57..35b9f544c0 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex f64311e166..5ebc8d93fe 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_sctp.beam b/bootstrap/lib/kernel/ebin/inet6_sctp.beam Binary files differindex a6220a9d69..496fc8d777 100644 --- a/bootstrap/lib/kernel/ebin/inet6_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam Binary files differindex 7cacde3399..0d98803e2d 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam Binary files differindex d1ca0b4f0d..aa53ec19db 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_udp.beam b/bootstrap/lib/kernel/ebin/inet6_udp.beam Binary files differindex ac4be100e8..fb41f9f6ab 100644 --- a/bootstrap/lib/kernel/ebin/inet6_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_udp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam Binary files differindex c44b389b75..dde14ade38 100644 --- a/bootstrap/lib/kernel/ebin/inet_config.beam +++ b/bootstrap/lib/kernel/ebin/inet_config.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex a835fa1a74..7b0604e3e8 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex d88fa2185d..e2fb5beec5 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam Binary files differindex 8166eca5de..3d367d492e 100644 --- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam +++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam diff --git a/bootstrap/lib/kernel/ebin/inet_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam Binary files differindex 6797eecb29..6435b84f69 100644 --- a/bootstrap/lib/kernel/ebin/inet_hosts.beam +++ b/bootstrap/lib/kernel/ebin/inet_hosts.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex e8935134b5..7da09a44c9 100644 --- a/bootstrap/lib/kernel/ebin/inet_parse.beam +++ b/bootstrap/lib/kernel/ebin/inet_parse.beam diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam Binary files differindex c964152d79..0fd60cb47e 100644 --- a/bootstrap/lib/kernel/ebin/inet_res.beam +++ b/bootstrap/lib/kernel/ebin/inet_res.beam diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam Binary files differindex 0e659bd738..fecea26319 100644 --- a/bootstrap/lib/kernel/ebin/inet_sctp.beam +++ b/bootstrap/lib/kernel/ebin/inet_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam Binary files differindex c273d47012..f0eb540e4f 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam Binary files differindex d09aa250c8..b9a84e75c7 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/inet_udp.beam b/bootstrap/lib/kernel/ebin/inet_udp.beam Binary files differindex 5853bde54f..e29d3e7c95 100644 --- a/bootstrap/lib/kernel/ebin/inet_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet_udp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 2832938d95..7e653a8d5b 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam Binary files differindex e749cc6c96..ba45bb95d1 100644 --- a/bootstrap/lib/kernel/ebin/kernel_config.beam +++ b/bootstrap/lib/kernel/ebin/kernel_config.beam diff --git a/bootstrap/lib/kernel/ebin/kernel_refc.beam b/bootstrap/lib/kernel/ebin/kernel_refc.beam Binary files differindex 04306c6e2c..0e2db688ff 100644 --- a/bootstrap/lib/kernel/ebin/kernel_refc.beam +++ b/bootstrap/lib/kernel/ebin/kernel_refc.beam diff --git a/bootstrap/lib/kernel/ebin/local_tcp.beam b/bootstrap/lib/kernel/ebin/local_tcp.beam Binary files differindex 2958d19524..3df208b31f 100644 --- a/bootstrap/lib/kernel/ebin/local_tcp.beam +++ b/bootstrap/lib/kernel/ebin/local_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/local_udp.beam b/bootstrap/lib/kernel/ebin/local_udp.beam Binary files differindex 33ed76e5cd..b1efe6c251 100644 --- a/bootstrap/lib/kernel/ebin/local_udp.beam +++ b/bootstrap/lib/kernel/ebin/local_udp.beam diff --git a/bootstrap/lib/kernel/ebin/logger.beam b/bootstrap/lib/kernel/ebin/logger.beam Binary files differindex 1dc1c4fef4..0da88b6003 100644 --- a/bootstrap/lib/kernel/ebin/logger.beam +++ b/bootstrap/lib/kernel/ebin/logger.beam diff --git a/bootstrap/lib/kernel/ebin/logger_backend.beam b/bootstrap/lib/kernel/ebin/logger_backend.beam Binary files differindex 40a3c4d80a..ddda136839 100644 --- a/bootstrap/lib/kernel/ebin/logger_backend.beam +++ b/bootstrap/lib/kernel/ebin/logger_backend.beam diff --git a/bootstrap/lib/kernel/ebin/logger_config.beam b/bootstrap/lib/kernel/ebin/logger_config.beam Binary files differindex 51c7f78237..21661ea33d 100644 --- a/bootstrap/lib/kernel/ebin/logger_config.beam +++ b/bootstrap/lib/kernel/ebin/logger_config.beam diff --git a/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam Binary files differindex dd0ca5f204..dafc128e2a 100644 --- a/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam diff --git a/bootstrap/lib/kernel/ebin/logger_filters.beam b/bootstrap/lib/kernel/ebin/logger_filters.beam Binary files differindex 2d8035278d..c34c1efa4a 100644 --- a/bootstrap/lib/kernel/ebin/logger_filters.beam +++ b/bootstrap/lib/kernel/ebin/logger_filters.beam diff --git a/bootstrap/lib/kernel/ebin/logger_formatter.beam b/bootstrap/lib/kernel/ebin/logger_formatter.beam Binary files differindex e3e40460f0..ef791d2318 100644 --- a/bootstrap/lib/kernel/ebin/logger_formatter.beam +++ b/bootstrap/lib/kernel/ebin/logger_formatter.beam diff --git a/bootstrap/lib/kernel/ebin/logger_h_common.beam b/bootstrap/lib/kernel/ebin/logger_h_common.beam Binary files differindex 9e8c25b6b9..0e1a36663b 100644 --- a/bootstrap/lib/kernel/ebin/logger_h_common.beam +++ b/bootstrap/lib/kernel/ebin/logger_h_common.beam diff --git a/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam b/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam Binary files differindex fb20fd1818..7e5a439746 100644 --- a/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam +++ b/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam diff --git a/bootstrap/lib/kernel/ebin/logger_olp.beam b/bootstrap/lib/kernel/ebin/logger_olp.beam Binary files differindex ed06b6ae5e..4b21635585 100644 --- a/bootstrap/lib/kernel/ebin/logger_olp.beam +++ b/bootstrap/lib/kernel/ebin/logger_olp.beam diff --git a/bootstrap/lib/kernel/ebin/logger_proxy.beam b/bootstrap/lib/kernel/ebin/logger_proxy.beam Binary files differindex ed0ed0f56b..7f97031ab8 100644 --- a/bootstrap/lib/kernel/ebin/logger_proxy.beam +++ b/bootstrap/lib/kernel/ebin/logger_proxy.beam diff --git a/bootstrap/lib/kernel/ebin/logger_server.beam b/bootstrap/lib/kernel/ebin/logger_server.beam Binary files differindex dcff9beac7..069cf723e6 100644 --- a/bootstrap/lib/kernel/ebin/logger_server.beam +++ b/bootstrap/lib/kernel/ebin/logger_server.beam diff --git a/bootstrap/lib/kernel/ebin/logger_simple_h.beam b/bootstrap/lib/kernel/ebin/logger_simple_h.beam Binary files differindex 583c77b290..9ccd980af7 100644 --- a/bootstrap/lib/kernel/ebin/logger_simple_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_simple_h.beam diff --git a/bootstrap/lib/kernel/ebin/logger_std_h.beam b/bootstrap/lib/kernel/ebin/logger_std_h.beam Binary files differindex c8eb73a076..614888589b 100644 --- a/bootstrap/lib/kernel/ebin/logger_std_h.beam +++ b/bootstrap/lib/kernel/ebin/logger_std_h.beam diff --git a/bootstrap/lib/kernel/ebin/logger_sup.beam b/bootstrap/lib/kernel/ebin/logger_sup.beam Binary files differindex 60192ef4a1..98d52f7e93 100644 --- a/bootstrap/lib/kernel/ebin/logger_sup.beam +++ b/bootstrap/lib/kernel/ebin/logger_sup.beam diff --git a/bootstrap/lib/kernel/ebin/net.beam b/bootstrap/lib/kernel/ebin/net.beam Binary files differindex 44b1f10603..a1c8d8b526 100644 --- a/bootstrap/lib/kernel/ebin/net.beam +++ b/bootstrap/lib/kernel/ebin/net.beam diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex 5810577c6a..4fb48aba84 100644 --- a/bootstrap/lib/kernel/ebin/net_adm.beam +++ b/bootstrap/lib/kernel/ebin/net_adm.beam diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam Binary files differindex 4c57f5f6c8..40c6ea85bd 100644 --- a/bootstrap/lib/kernel/ebin/net_kernel.beam +++ b/bootstrap/lib/kernel/ebin/net_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex f05007041b..41a45ca812 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex d293ea18f3..ce1c5270a9 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam Binary files differindex 02c4c6454a..e00c4d3d34 100644 --- a/bootstrap/lib/kernel/ebin/ram_file.beam +++ b/bootstrap/lib/kernel/ebin/ram_file.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io.beam b/bootstrap/lib/kernel/ebin/raw_file_io.beam Binary files differindex 16dc314ba5..03c5935a42 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam Binary files differindex 3c41f8528e..c3f9da47dc 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam Binary files differindex 11b8f4a6db..dd095a4b0b 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam Binary files differindex b3381cc397..97f7023c1d 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam Binary files differindex 7c47f2cf10..6bc4a1e7a0 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam Binary files differindex b544fd394e..eeafb97ea5 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_raw.beam b/bootstrap/lib/kernel/ebin/raw_file_io_raw.beam Binary files differindex b47a67055d..fab63a6629 100644 --- a/bootstrap/lib/kernel/ebin/raw_file_io_raw.beam +++ b/bootstrap/lib/kernel/ebin/raw_file_io_raw.beam diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex b53525e2ca..493223db2f 100644 --- a/bootstrap/lib/kernel/ebin/rpc.beam +++ b/bootstrap/lib/kernel/ebin/rpc.beam diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam Binary files differindex f81a39ddc0..fdd399092e 100644 --- a/bootstrap/lib/kernel/ebin/seq_trace.beam +++ b/bootstrap/lib/kernel/ebin/seq_trace.beam diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam Binary files differindex 18582d22f2..96dc4d5433 100644 --- a/bootstrap/lib/kernel/ebin/standard_error.beam +++ b/bootstrap/lib/kernel/ebin/standard_error.beam diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam Binary files differindex 8214d9d6aa..59a7cdaf6d 100644 --- a/bootstrap/lib/kernel/ebin/user.beam +++ b/bootstrap/lib/kernel/ebin/user.beam diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam Binary files differindex 43df5afa36..0dab31f7d1 100644 --- a/bootstrap/lib/kernel/ebin/user_drv.beam +++ b/bootstrap/lib/kernel/ebin/user_drv.beam diff --git a/bootstrap/lib/kernel/ebin/user_sup.beam b/bootstrap/lib/kernel/ebin/user_sup.beam Binary files differindex c82fca70da..68f3a330c2 100644 --- a/bootstrap/lib/kernel/ebin/user_sup.beam +++ b/bootstrap/lib/kernel/ebin/user_sup.beam diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam Binary files differindex ceb8dd9a78..7f719ee8a5 100644 --- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam +++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex 9e783452f5..c0a14da511 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/base64.beam b/bootstrap/lib/stdlib/ebin/base64.beam Binary files differindex 5872970da7..246bbc8fea 100644 --- a/bootstrap/lib/stdlib/ebin/base64.beam +++ b/bootstrap/lib/stdlib/ebin/base64.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex a96ccb6f8c..e815fc298e 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam Binary files differindex fc1bbe163a..0712d0c64b 100644 --- a/bootstrap/lib/stdlib/ebin/binary.beam +++ b/bootstrap/lib/stdlib/ebin/binary.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex 17e061b1d0..6cea2d1e9d 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.beam diff --git a/bootstrap/lib/stdlib/ebin/calendar.beam b/bootstrap/lib/stdlib/ebin/calendar.beam Binary files differindex 89102adda8..6c5773d852 100644 --- a/bootstrap/lib/stdlib/ebin/calendar.beam +++ b/bootstrap/lib/stdlib/ebin/calendar.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex 2eadde21ff..4af2c67a93 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam Binary files differindex 8cd247e3be..ee1b586ef2 100644 --- a/bootstrap/lib/stdlib/ebin/dets_server.beam +++ b/bootstrap/lib/stdlib/ebin/dets_server.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_sup.beam b/bootstrap/lib/stdlib/ebin/dets_sup.beam Binary files differindex 0b9fb6379f..b198d1f872 100644 --- a/bootstrap/lib/stdlib/ebin/dets_sup.beam +++ b/bootstrap/lib/stdlib/ebin/dets_sup.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex e38eb384a1..31eeb4375c 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex f73509ae3f..67abb787dc 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam Binary files differindex dc390024a4..c3155b9129 100644 --- a/bootstrap/lib/stdlib/ebin/dict.beam +++ b/bootstrap/lib/stdlib/ebin/dict.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam Binary files differindex 60abe020fd..d584c51083 100644 --- a/bootstrap/lib/stdlib/ebin/digraph.beam +++ b/bootstrap/lib/stdlib/ebin/digraph.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam Binary files differindex fabe782d90..badb46d0af 100644 --- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam +++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex b6a7ecc9a5..473dcb6dc1 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam Binary files differindex 865066c3ac..f2572a212b 100644 --- a/bootstrap/lib/stdlib/ebin/edlin_expand.beam +++ b/bootstrap/lib/stdlib/ebin/edlin_expand.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex e3d8c21edf..67c737dddd 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam Binary files differindex 973ad9fb80..fefdd4f54a 100644 --- a/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam +++ b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam Binary files differindex a40fcb3f92..c4117509dd 100644 --- a/bootstrap/lib/stdlib/ebin/erl_anno.beam +++ b/bootstrap/lib/stdlib/ebin/erl_anno.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam Binary files differindex 1beb0d5ebb..462b2677e1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_bits.beam +++ b/bootstrap/lib/stdlib/ebin/erl_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex fa223657bf..2f5790b4a7 100644 --- a/bootstrap/lib/stdlib/ebin/erl_compile.beam +++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_error.beam b/bootstrap/lib/stdlib/ebin/erl_error.beam Binary files differindex 5d1b91aeef..0c3275465d 100644 --- a/bootstrap/lib/stdlib/ebin/erl_error.beam +++ b/bootstrap/lib/stdlib/ebin/erl_error.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 5ef1521371..4743c2a730 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex e527f98776..7597146d22 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex 9015ad8936..820ff0e779 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex c73ecdf942..d56a730da1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 41369ca147..1c910f9f38 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam b/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam Binary files differindex 5f6c03bcae..5696cbc072 100644 --- a/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam +++ b/bootstrap/lib/stdlib/ebin/erl_posix_msg.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 1965b9e656..1f6baa7653 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex 18538620b7..eac7242485 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam Binary files differindex 871ccd82d4..dbffb05446 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam Binary files differindex 64de26f7a4..ce2d0a95d2 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam Binary files differindex e7ee41cc2e..66258d0fb9 100644 --- a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam +++ b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex e846ca420e..69e3b7dddc 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex 350316dfcc..fbd823cc39 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam Binary files differindex 08f86f86ff..063393d5d8 100644 --- a/bootstrap/lib/stdlib/ebin/eval_bits.beam +++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex 0a42a40d7e..a2e8fef834 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 62b8c3588e..fe62f6636c 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex d353a11f3e..1461e1cbc8 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam Binary files differindex 8d1e2c11e0..ae19fe9d10 100644 --- a/bootstrap/lib/stdlib/ebin/gb_sets.beam +++ b/bootstrap/lib/stdlib/ebin/gb_sets.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam Binary files differindex 0aae509cb6..49fd69632f 100644 --- a/bootstrap/lib/stdlib/ebin/gb_trees.beam +++ b/bootstrap/lib/stdlib/ebin/gb_trees.beam diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam Binary files differindex 85a9c25618..92e4e2dab8 100644 --- a/bootstrap/lib/stdlib/ebin/gen.beam +++ b/bootstrap/lib/stdlib/ebin/gen.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex f3376d2ee2..45200c3ddd 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex 5c4a0aa3d5..8f17cee54d 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex 06c3d6de19..fea013f8cf 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam Binary files differindex 0aab776d07..0d7aa92875 100644 --- a/bootstrap/lib/stdlib/ebin/gen_statem.beam +++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam Binary files differindex 631863b587..005c89a1e3 100644 --- a/bootstrap/lib/stdlib/ebin/io.beam +++ b/bootstrap/lib/stdlib/ebin/io.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex 45692978e4..47201dba0c 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex 66047b5070..c2f8a11e40 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam Binary files differindex 22690ce685..f81265ebd9 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex b0f4177d71..d7bd6172e4 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam Binary files differindex 5a330bece0..9bacdd52b0 100644 --- a/bootstrap/lib/stdlib/ebin/lists.beam +++ b/bootstrap/lib/stdlib/ebin/lists.beam diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam Binary files differindex b812621c0a..f4561164a3 100644 --- a/bootstrap/lib/stdlib/ebin/log_mf_h.beam +++ b/bootstrap/lib/stdlib/ebin/log_mf_h.beam diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam Binary files differindex 193a06241d..a49a65714f 100644 --- a/bootstrap/lib/stdlib/ebin/maps.beam +++ b/bootstrap/lib/stdlib/ebin/maps.beam diff --git a/bootstrap/lib/stdlib/ebin/math.beam b/bootstrap/lib/stdlib/ebin/math.beam Binary files differindex 7e61673b35..e388b2c304 100644 --- a/bootstrap/lib/stdlib/ebin/math.beam +++ b/bootstrap/lib/stdlib/ebin/math.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex bb98ae56b3..1a07331fe9 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/orddict.beam b/bootstrap/lib/stdlib/ebin/orddict.beam Binary files differindex d6f267ad8f..cc32d43f7a 100644 --- a/bootstrap/lib/stdlib/ebin/orddict.beam +++ b/bootstrap/lib/stdlib/ebin/orddict.beam diff --git a/bootstrap/lib/stdlib/ebin/ordsets.beam b/bootstrap/lib/stdlib/ebin/ordsets.beam Binary files differindex 44f9e5d8b5..4f2465c9bb 100644 --- a/bootstrap/lib/stdlib/ebin/ordsets.beam +++ b/bootstrap/lib/stdlib/ebin/ordsets.beam diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam Binary files differindex 26d495af72..41e88c4eaa 100644 --- a/bootstrap/lib/stdlib/ebin/otp_internal.beam +++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam Binary files differindex 408ee3a0c9..2b83887ba9 100644 --- a/bootstrap/lib/stdlib/ebin/pool.beam +++ b/bootstrap/lib/stdlib/ebin/pool.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex b51898901d..c960faf2d3 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/proplists.beam b/bootstrap/lib/stdlib/ebin/proplists.beam Binary files differindex a8ddeb2d57..89371c49f4 100644 --- a/bootstrap/lib/stdlib/ebin/proplists.beam +++ b/bootstrap/lib/stdlib/ebin/proplists.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex cca174e3cd..13ec8cfe1f 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex 4d86fdfec2..cb4ea94478 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/queue.beam b/bootstrap/lib/stdlib/ebin/queue.beam Binary files differindex 94728e30cc..e6195d98c1 100644 --- a/bootstrap/lib/stdlib/ebin/queue.beam +++ b/bootstrap/lib/stdlib/ebin/queue.beam diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam Binary files differindex 7f1e6140bf..0202b60efe 100644 --- a/bootstrap/lib/stdlib/ebin/rand.beam +++ b/bootstrap/lib/stdlib/ebin/rand.beam diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam Binary files differindex a4bc2b6128..dee398f355 100644 --- a/bootstrap/lib/stdlib/ebin/random.beam +++ b/bootstrap/lib/stdlib/ebin/random.beam diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam Binary files differindex e16327b906..3a1b44a49b 100644 --- a/bootstrap/lib/stdlib/ebin/re.beam +++ b/bootstrap/lib/stdlib/ebin/re.beam diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam Binary files differindex e3609ea527..dd9009d114 100644 --- a/bootstrap/lib/stdlib/ebin/sets.beam +++ b/bootstrap/lib/stdlib/ebin/sets.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 319bb9aebf..66409894dd 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/shell_default.beam b/bootstrap/lib/stdlib/ebin/shell_default.beam Binary files differindex afd0c65921..ff4d1071d5 100644 --- a/bootstrap/lib/stdlib/ebin/shell_default.beam +++ b/bootstrap/lib/stdlib/ebin/shell_default.beam diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam Binary files differindex 259d300155..6cbc413f9d 100644 --- a/bootstrap/lib/stdlib/ebin/slave.beam +++ b/bootstrap/lib/stdlib/ebin/slave.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex 3a90a07add..ee8dddf2cf 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam Binary files differindex ee19fb41a4..0a48eb1a46 100644 --- a/bootstrap/lib/stdlib/ebin/string.beam +++ b/bootstrap/lib/stdlib/ebin/string.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 1816fe6c41..9eecd35256 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex 761907b40c..f05aaef893 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex a3f46b5983..4158d032c2 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam Binary files differindex 2953299e8b..f018f4f750 100644 --- a/bootstrap/lib/stdlib/ebin/timer.beam +++ b/bootstrap/lib/stdlib/ebin/timer.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex d61ed589aa..5f483b8358 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode_util.beam b/bootstrap/lib/stdlib/ebin/unicode_util.beam Binary files differindex c0523f2e52..182472b5d9 100644 --- a/bootstrap/lib/stdlib/ebin/unicode_util.beam +++ b/bootstrap/lib/stdlib/ebin/unicode_util.beam diff --git a/bootstrap/lib/stdlib/ebin/uri_string.beam b/bootstrap/lib/stdlib/ebin/uri_string.beam Binary files differindex 7255fdca63..51c823eb51 100644 --- a/bootstrap/lib/stdlib/ebin/uri_string.beam +++ b/bootstrap/lib/stdlib/ebin/uri_string.beam diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam Binary files differindex 136b65f9fb..dc6246f9ca 100644 --- a/bootstrap/lib/stdlib/ebin/win32reg.beam +++ b/bootstrap/lib/stdlib/ebin/win32reg.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex 75c2289f47..751707a27c 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam 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_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 4c8ee5178a..04b2ed64b7 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -1125,13 +1125,12 @@ check_process_code(Process* rp, Module* modp, int *redsp, int fcalls) mod_size = modp->old.code_length; /* - * Check if current instruction or continuation pointer points into module. + * Check if the instruction pointer points into module. */ - if (ErtsInArea(rp->i, mod_start, mod_size) - || ErtsInArea(rp->cp, mod_start, mod_size)) { + if (ErtsInArea(rp->i, mod_start, mod_size)) { return am_true; } - + *redsp += 1; if (erts_check_nif_export_in_area(rp, mod_start, mod_size)) diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 0832b3f374..10940072ae 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -642,46 +642,35 @@ erts_clear_export_break(Module* modp, ErtsCodeInfo *ci) } /* - * If c_p->cp is a trace return instruction, we set cp - * to be the place where we again start to execute code. + * If the topmost continuation pointer on the stack is a trace return + * instruction, we modify it to be the place where we again start to + * execute code. * - * cp is used by match spec {caller} to get the calling - * function, and if we don't do this fixup it will be - * 'undefined'. This has the odd side effect of {caller} - * not really being which function is the caller, but - * rather which function we are about to return to. + * This continuation pointer is used by match spec {caller} to get the + * calling function, and if we don't do this fixup it will be + * 'undefined'. This has the odd side effect of {caller} not really + * being the function which is the caller, but rather the function + * which we are about to return to. */ static void fixup_cp_before_trace(Process *c_p, int *return_to_trace) { - Eterm *cpp, *E = c_p->stop; - BeamInstr w = *c_p->cp; - if (BeamIsOpCode(w, op_return_trace)) { - cpp = &E[2]; - } else if (BeamIsOpCode(w, op_i_return_to_trace)) { - *return_to_trace = 1; - cpp = &E[0]; - } else if (BeamIsOpCode(w, op_i_return_time_trace)) { - cpp = &E[0]; - } else { - cpp = NULL; - } - if (cpp) { - for (;;) { - BeamInstr w = *cp_val(*cpp); - if (BeamIsOpCode(w, op_return_trace)) { - cpp += 3; - } else if (BeamIsOpCode(w, op_i_return_to_trace)) { - *return_to_trace = 1; - cpp += 1; - } else if (BeamIsOpCode(w, op_i_return_time_trace)) { - cpp += 2; - } else { - break; - } + Eterm *cpp = c_p->stop; + + for (;;) { + BeamInstr w = *cp_val(*cpp); + if (BeamIsOpCode(w, op_return_trace)) { + cpp += 3; + } else if (BeamIsOpCode(w, op_i_return_to_trace)) { + *return_to_trace = 1; + cpp += 1; + } else if (BeamIsOpCode(w, op_i_return_time_trace)) { + cpp += 2; + } else { + break; } - c_p->cp = (BeamInstr *) cp_val(*cpp); - ASSERT(is_CP(*cpp)); } + c_p->stop[0] = (Eterm) cp_val(*cpp); + ASSERT(is_CP(*cpp)); } BeamInstr @@ -743,12 +732,13 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg) if (bp_flags & ERTS_BPF_TIME_TRACE_ACTIVE) { Eterm w; + Eterm* E; erts_trace_time_call(c_p, info, bp->time); - w = (BeamInstr) *c_p->cp; + E = c_p->stop; + w = (BeamInstr) E[0]; if (! (BeamIsOpCode(w, op_i_return_time_trace) || BeamIsOpCode(w, op_return_trace) || BeamIsOpCode(w, op_i_return_to_trace)) ) { - Eterm* E = c_p->stop; ASSERT(c_p->htop <= E && E <= c_p->hend); if (E - 2 < c_p->htop) { (void) erts_garbage_collect(c_p, 2, reg, info->mfa.arity); @@ -759,9 +749,8 @@ erts_generic_breakpoint(Process* c_p, ErtsCodeInfo *info, Eterm* reg) ASSERT(c_p->htop <= E && E <= c_p->hend); E -= 2; - E[0] = make_cp(erts_codeinfo_to_code(info)); - E[1] = make_cp(c_p->cp); /* original return address */ - c_p->cp = beam_return_time_trace; + E[1] = make_cp(erts_codeinfo_to_code(info)); + E[0] = (Eterm) beam_return_time_trace; c_p->stop = E; } } @@ -790,7 +779,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) int applying = (I == ep->beam); /* Yup, the apply code for a bif * is actually in the * export entry */ - BeamInstr *cp = p->cp; + BeamInstr* cp = (BeamInstr *) p->stop[0]; GenericBp* g; GenericBpData* bp = NULL; Uint bp_flags = 0; @@ -809,7 +798,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) * but it is correct during apply of bif. */ if (!applying) { - p->cp = I; + p->stop[0] = (Eterm) I; } else { fixup_cp_before_trace(p, &return_to_trace); } @@ -846,7 +835,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) } /* Restore original continuation pointer (if changed). */ - p->cp = cp; + p->stop[0] = (Eterm) cp; func = bif_table[bif_index].f; @@ -854,7 +843,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) if (erts_nif_export_check_save_trace(p, result, applying, ep, - cp, flags, + flags, flags_meta, I, meta_tracer)) { /* @@ -865,24 +854,31 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) return result; } - return erts_bif_trace_epilogue(p, result, applying, ep, cp, + return erts_bif_trace_epilogue(p, result, applying, ep, flags, flags_meta, I, meta_tracer); } Eterm erts_bif_trace_epilogue(Process *p, Eterm result, int applying, - Export* ep, BeamInstr *cp, Uint32 flags, + Export* ep, Uint32 flags, Uint32 flags_meta, BeamInstr* I, ErtsTracer meta_tracer) { + BeamInstr *cp = NULL; + if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) { BeamInstr i_return_trace = beam_return_trace[0]; BeamInstr i_return_to_trace = beam_return_to_trace[0]; BeamInstr i_return_time_trace = beam_return_time_trace[0]; Eterm *cpp; + /* Maybe advance cp to skip trace stack frames */ - for (cpp = p->stop; ; cp = cp_val(*cpp++)) { + cpp = p->stop; + while (is_not_CP(*cpp)) { + cpp++; + } + for (cp = cp_val(*cpp++); ;) { if (*cp == i_return_trace) { /* Skip stack frame variables */ while (is_not_CP(*cpp)) cpp++; @@ -897,8 +893,11 @@ erts_bif_trace_epilogue(Process *p, Eterm result, int applying, */ cp = NULL; break; - } else break; - } + } else { + break; + } + cp = cp_val(*cpp++); + } } /* Try to get these in the order @@ -939,7 +938,7 @@ erts_bif_trace_epilogue(Process *p, Eterm result, int applying, if ((flags & MATCH_SET_RETURN_TO_TRACE) && p->catches > 0) { /* can only happen if(local)*/ Eterm *ptr = p->stop; - ASSERT(is_CP(*ptr)); + ASSERT(!applying || is_CP(*ptr)); ASSERT(ptr <= STACK_START(p)); /* Search the nearest stack frame for a catch */ while (++ptr < STACK_START(p)) { @@ -991,19 +990,19 @@ do_call_trace(Process* c_p, ErtsCodeInfo* info, Eterm* reg, int local, Binary* ms, ErtsTracer tracer) { int return_to_trace = 0; - BeamInstr *cp_save = c_p->cp; Uint32 flags; Uint need = 0; + Eterm cp_save; Eterm* E = c_p->stop; - fixup_cp_before_trace(c_p, &return_to_trace); + cp_save = E[0]; + fixup_cp_before_trace(c_p, &return_to_trace); ERTS_UNREQ_PROC_MAIN_LOCK(c_p); flags = erts_call_trace(c_p, info, ms, reg, local, &tracer); ERTS_REQ_PROC_MAIN_LOCK(c_p); - /* restore cp after potential fixup */ - c_p->cp = cp_save; + E[0] = cp_save; ASSERT(!ERTS_PROC_IS_EXITING(c_p)); if ((flags & MATCH_SET_RETURN_TO_TRACE) && !return_to_trace) { @@ -1023,28 +1022,23 @@ do_call_trace(Process* c_p, ErtsCodeInfo* info, Eterm* reg, if (flags & MATCH_SET_RETURN_TO_TRACE && !return_to_trace) { E -= 1; ASSERT(c_p->htop <= E && E <= c_p->hend); - E[0] = make_cp(c_p->cp); - c_p->cp = beam_return_to_trace; + E[0] = (Eterm) beam_return_to_trace; + c_p->stop = E; } - if (flags & MATCH_SET_RX_TRACE) - { + if (flags & MATCH_SET_RX_TRACE) { E -= 3; c_p->stop = E; ASSERT(c_p->htop <= E && E <= c_p->hend); ASSERT(is_CP((Eterm) (UWord) (&info->mfa.module))); ASSERT(IS_TRACER_VALID(tracer)); - E[2] = make_cp(c_p->cp); - E[1] = copy_object(tracer, c_p); - E[0] = make_cp(&info->mfa.module); - /* We ARE at the beginning of an instruction, - the funcinfo is above i. */ - c_p->cp = (flags & MATCH_SET_EXCEPTION_TRACE) ? - beam_exception_trace : beam_return_trace; + E[2] = copy_object(tracer, c_p); + E[1] = make_cp(&info->mfa.module); + E[0] = (Eterm) ((flags & MATCH_SET_EXCEPTION_TRACE) ? + beam_exception_trace : beam_return_trace); erts_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); ERTS_TRACE_FLAGS(c_p) |= F_EXCEPTION_TRACE; erts_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); - } else - c_p->stop = E; + } return tracer; } diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 07c16e3415..9f8b56a5d5 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -141,10 +141,6 @@ do { \ BeamCodeAddr(IP) < (BeamInstr)LabelAddr(end_emulator_loop)) #endif /* NO_JUMP_TABLE */ -#define SET_CP(p, ip) \ - ASSERT(VALID_INSTR(*(ip))); \ - (p)->cp = (ip) - #define SET_I(ip) \ ASSERT(VALID_INSTR(* (Eterm *)(ip))); \ I = (ip) @@ -524,7 +520,7 @@ init_emulator(void) #define DTRACE_RETURN_FROM_PC(p) \ do { \ ErtsCodeMFA* cmfa; \ - if (DTRACE_ENABLED(function_return) && (cmfa = find_function_from_pc((p)->cp))) { \ + if (DTRACE_ENABLED(function_return) && (cmfa = find_function_from_pc(cp_val((p)->stop[0])))) { \ DTRACE_RETURN((p), cmfa); \ } \ } while(0) @@ -1443,7 +1439,7 @@ handle_error(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa) reg[2] = Value; reg[3] = c_p->ftrace; if ((new_pc = next_catch(c_p, reg))) { - c_p->cp = 0; /* To avoid keeping stale references. */ + c_p->stop[0] = NIL; /* To avoid keeping stale references. */ ERTS_RECV_MARK_CLEAR(c_p); /* No longer safe to use this position */ return new_pc; } @@ -1481,35 +1477,6 @@ next_catch(Process* c_p, Eterm *reg) { return NULL; } - /* - * Better safe than sorry here. In debug builds, produce a core - * dump if the top of the stack doesn't point to a continuation - * pointer. In other builds, ignore a non-CP at the top of stack. - */ - ASSERT(is_CP(*ptr)); - if ((is_not_CP(*ptr) || (*cp_val(*ptr) != i_return_trace && - *cp_val(*ptr) != i_return_to_trace && - *cp_val(*ptr) != i_return_time_trace )) - && c_p->cp) { - /* Can not follow cp here - code may be unloaded */ - BeamInstr *cpp = c_p->cp; - if (cpp == beam_exception_trace) { - ErtsCodeMFA *mfa = (ErtsCodeMFA*)cp_val(ptr[0]); - erts_trace_exception(c_p, mfa, - reg[1], reg[2], - ERTS_TRACER_FROM_ETERM(ptr+1)); - /* Skip return_trace parameters */ - ptr += 2; - } else if (cpp == beam_return_trace) { - /* Skip return_trace parameters */ - ptr += 2; - } else if (cpp == beam_return_time_trace) { - /* Skip return_trace parameters */ - ptr += 1; - } else if (cpp == beam_return_to_trace) { - have_return_to_trace = !0; /* Record next cp */ - } - } while (ptr < STACK_START(c_p)) { if (is_catch(*ptr)) { if (active_catches) goto found_catch; @@ -1664,6 +1631,57 @@ expand_error_value(Process* c_p, Uint freason, Eterm Value) { return Value; } + +static void +gather_stacktrace(Process* p, Eterm *ptr, struct StackTrace* s, int depth) +{ + BeamInstr *prev; + BeamInstr i_return_trace; + BeamInstr i_return_to_trace; + + if (depth == 0) { + return; + } + + prev = s->depth ? s->trace[s->depth-1] : s->pc; + i_return_trace = beam_return_trace[0]; + i_return_to_trace = beam_return_to_trace[0]; + + /* + * Traverse the stack backwards and add all unique continuation + * pointers to the buffer, up to the maximum stack trace size. + * + * Skip trace stack frames. + */ + + ASSERT(ptr >= STACK_TOP(p) && ptr <= STACK_START(p)); + + while (ptr < STACK_START(p) && depth > 0) { + if (is_CP(*ptr)) { + if (*cp_val(*ptr) == i_return_trace) { + /* Skip stack frame variables */ + do ++ptr; while (is_not_CP(*ptr)); + /* Skip return_trace parameters */ + ptr += 2; + } else if (*cp_val(*ptr) == i_return_to_trace) { + /* Skip stack frame variables */ + do ++ptr; while (is_not_CP(*ptr)); + } else { + BeamInstr *cp = cp_val(*ptr); + if (cp != prev) { + /* Record non-duplicates only */ + prev = cp; + s->trace[s->depth++] = cp - 1; + depth--; + } + ptr++; + } + } else { + ptr++; + } + } +} + /* * Quick-saving the stack trace in an internal form on the heap. Note * that c_p->ftrace will point to a cons cell which holds the given args @@ -1702,6 +1720,7 @@ static void save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, ErtsCodeMFA *bif_mfa, Eterm args) { struct StackTrace* s; + Eterm *stack_start; int sz; int depth = erts_backtrace_depth; /* max depth (never negative) */ @@ -1720,6 +1739,33 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, s->depth = 0; /* + * If we crash on an instruction that returns to a return/exception trace + * instruction, we must set the stacktrace 'pc' to the actual return + * address or we'll lose the top stackframe when gathering the stack + * trace. + */ + stack_start = STACK_TOP(c_p); + if (stack_start < STACK_START(c_p) && is_CP(*stack_start)) { + BeamInstr *cp = cp_val(*stack_start); + + if (cp == pc) { + if (pc == beam_exception_trace || pc == beam_return_trace) { + ASSERT(&stack_start[3] <= STACK_START(c_p)); + /* Fake having failed on the first instruction in the function + * pointed to by the tag. */ + pc = cp_val(stack_start[1]); + stack_start += 3; + } else if (pc == beam_return_to_trace) { + ASSERT(&stack_start[2] <= STACK_START(c_p)); + pc = cp_val(stack_start[1]); + /* Skip both the trace tag and the new 'pc' to avoid + * duplicated entries. */ + stack_start += 2; + } + } + } + + /* * If the failure was in a BIF other than 'error/1', 'error/2', * 'exit/1' or 'throw/1', save BIF-MFA and save the argument * registers by consing up an arglist. @@ -1750,11 +1796,6 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, s->trace[s->depth++] = pc; depth--; } - /* Save second stack entry if CP is valid and different from pc */ - if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) { - s->trace[s->depth++] = c_p->cp - 1; - depth--; - } s->pc = NULL; args = make_arglist(c_p, reg, bif_mfa->arity); /* Overwrite CAR(c_p->ftrace) */ } else { @@ -1762,9 +1803,9 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, non_bif_stacktrace: s->current = c_p->current; - /* + /* * For a function_clause error, the arguments are in the beam - * registers, c_p->cp is valid, and c_p->current is set. + * registers and c_p->current is set. */ if ( (GET_EXC_INDEX(s->freason)) == (GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) ) { @@ -1772,18 +1813,8 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, ASSERT(s->current); a = s->current->arity; args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */ - /* Save first stack entry */ - ASSERT(c_p->cp); - if (depth > 0) { - s->trace[s->depth++] = c_p->cp - 1; - depth--; - } s->pc = NULL; /* Ignore pc */ } else { - if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) { - s->trace[s->depth++] = c_p->cp - 1; - depth--; - } s->pc = pc; } } @@ -1796,80 +1827,13 @@ save_stacktrace(Process* c_p, BeamInstr* pc, Eterm* reg, } /* Save the actual stack trace */ - erts_save_stacktrace(c_p, s, depth); + gather_stacktrace(c_p, stack_start, s, depth); } void erts_save_stacktrace(Process* p, struct StackTrace* s, int depth) { - if (depth > 0) { - Eterm *ptr; - BeamInstr *prev = s->depth ? s->trace[s->depth-1] : NULL; - BeamInstr i_return_trace = beam_return_trace[0]; - BeamInstr i_return_to_trace = beam_return_to_trace[0]; - - /* - * Traverse the stack backwards and add all unique continuation - * pointers to the buffer, up to the maximum stack trace size. - * - * Skip trace stack frames. - */ - ptr = p->stop; - if (ptr < STACK_START(p) && - (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace && - *cp_val(*ptr) != i_return_to_trace)) && - p->cp) { - /* Cannot follow cp here - code may be unloaded */ - BeamInstr *cpp = p->cp; - int trace_cp; - if (cpp == beam_exception_trace || cpp == beam_return_trace) { - /* Skip return_trace parameters */ - ptr += 2; - trace_cp = 1; - } else if (cpp == beam_return_to_trace) { - /* Skip return_to_trace parameters */ - ptr += 1; - trace_cp = 1; - } - else { - trace_cp = 0; - } - if (trace_cp && s->pc == cpp) { - /* - * If process 'cp' points to a return/exception trace - * instruction and 'cp' has been saved as 'pc' in - * stacktrace, we need to update 'pc' in stacktrace - * with the actual 'cp' located on the top of the - * stack; otherwise, we will lose the top stackframe - * when building the stack trace. - */ - ASSERT(is_CP(p->stop[0])); - s->pc = cp_val(p->stop[0]); - } - } - while (ptr < STACK_START(p) && depth > 0) { - if (is_CP(*ptr)) { - if (*cp_val(*ptr) == i_return_trace) { - /* Skip stack frame variables */ - do ++ptr; while (is_not_CP(*ptr)); - /* Skip return_trace parameters */ - ptr += 2; - } else if (*cp_val(*ptr) == i_return_to_trace) { - /* Skip stack frame variables */ - do ++ptr; while (is_not_CP(*ptr)); - } else { - BeamInstr *cp = cp_val(*ptr); - if (cp != prev) { - /* Record non-duplicates only */ - prev = cp; - s->trace[s->depth++] = cp - 1; - depth--; - } - ptr++; - } - } else ptr++; - } - } + gather_stacktrace(p, STACK_TOP(p), s, depth); } /* @@ -2144,36 +2108,33 @@ apply_bif_error_adjustment(Process *p, Export *ep, * erlang:error/1, erlang:error/2, erlang:exit/1, * or erlang:throw/1. Error handling of these BIFs is * special! + * + * We need the topmost continuation pointer to point into the + * calling function when handling the error after the BIF has + * been applied. This in order to get the topmost stackframe + * correct. * - * We need 'p->cp' to point into the calling - * function when handling the error after the BIF has - * been applied. This in order to get the topmost - * stackframe correct. Without the following adjustment, - * 'p->cp' will point into the function that called - * current function when handling the error. We add a - * dummy stackframe in order to achieve this. - * - * Note that these BIFs unconditionally will cause - * an exception to be raised. That is, our modifications - * of 'p->cp' as well as the stack will be corrected by - * the error handling code. - * - * If we find an exception/return-to trace continuation - * pointer as the topmost continuation pointer, we do not - * need to do anything since the information already will - * be available for generation of the stacktrace. + * Note that these BIFs will unconditionally cause an + * exception to be raised. That is, our modifications of the + * stack will be corrected by the error handling code. */ int apply_only = stack_offset == 0; BeamInstr *cpp; + Eterm *E; - if (apply_only) { - ASSERT(p->cp != NULL); - cpp = p->cp; - } - else { - ASSERT(is_CP(p->stop[0])); - cpp = cp_val(p->stop[0]); - } + E = p->stop; + + while (is_not_CP(*E)) { + E++; + } + cpp = cp_val(E[0]); + + /* + * If we find an exception/return-to trace continuation + * pointer as the topmost continuation pointer, we do not + * need to do anything since the information will already + * be available for generation of the stacktrace. + */ if (cpp != beam_exception_trace && cpp != beam_return_trace @@ -2183,38 +2144,29 @@ apply_bif_error_adjustment(Process *p, Export *ep, need = 1; /* i_apply_only */ if (p->stop - p->htop < need) erts_garbage_collect(p, (int) need, reg, arity+1); - p->stop -= need; - if (apply_only) { /* * Called from the i_apply_only instruction. * - * 'p->cp' contains continuation pointer pointing - * into the function that called current function. - * We push that continuation pointer onto the stack, - * and set 'p->cp' to point into current function. + * Push the continuation pointer for the current + * function to the stack. */ - - p->stop[0] = make_cp(p->cp); - p->cp = I; - } - else { + p->stop -= need; + p->stop[0] = make_cp(I); + } else { /* - * Called from an i_apply_last_p, or apply_last_IP, - * instruction. - * - * Calling instruction will after we return read - * a continuation pointer from the stack and write - * it to 'p->cp', and then remove the topmost - * stackframe of size 'stack_offset'. + * Called from an i_apply_last_* instruction. * - * We have sized the dummy-stackframe so that it - * will be removed by the instruction we currently - * are executing, and leave the stackframe that - * normally would have been removed intact. + * The calling instruction will deallocate a stack + * frame of size 'stack_offset'. * + * Push the continuation pointer for the current + * function to the stack, and then add a dummy + * stackframe for the i_apply_last* instruction + * to discard. */ - p->stop[0] = make_cp(I); + p->stop[0] = make_cp(I); + p->stop -= need; } } } @@ -2437,10 +2389,10 @@ erts_hibernate(Process* c_p, Eterm* reg) c_p->arg_reg[0] = module; c_p->arg_reg[1] = function; c_p->arg_reg[2] = args; - c_p->stop = STACK_START(c_p); + c_p->stop = c_p->hend - 1; /* Keep first continuation pointer */ + ASSERT(c_p->stop[0] == make_cp(beam_apply+1)); c_p->catches = 0; c_p->i = beam_apply; - c_p->cp = (BeamInstr *) beam_apply+1; /* * If there are no waiting messages, garbage collect and 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..7afbbfd894 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 { @@ -5156,7 +5164,7 @@ erts_schedule_bif(Process *proc, else if (proc->flags & F_HIPE_MODE) { /* Pointer to bif export in i */ exp = (Export *) i; - pc = c_p->cp; + pc = cp_val(c_p->stop[0]); mfa = &exp->info.mfa; } #endif @@ -5173,8 +5181,7 @@ erts_schedule_bif(Process *proc, mfa = &exp->info.mfa; } else if (BeamIsOpCode(*i, op_apply_bif)) { - /* Pointer to bif in i+1, and mfa in i-3 */ - pc = c_p->cp; + pc = cp_val(c_p->stop[0]); mfa = erts_code_to_codemfa(i); } else { @@ -5265,7 +5272,6 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm * dirty_shadow_proc->freason = c_p->freason; dirty_shadow_proc->fvalue = c_p->fvalue; dirty_shadow_proc->ftrace = c_p->ftrace; - dirty_shadow_proc->cp = c_p->cp; dirty_shadow_proc->i = c_p->i; #ifdef DEBUG @@ -5312,7 +5318,6 @@ erts_call_dirty_bif(ErtsSchedulerData *esdp, Process *c_p, BeamInstr *I, Eterm * c_p->freason = dirty_shadow_proc->freason; c_p->fvalue = dirty_shadow_proc->fvalue; c_p->ftrace = dirty_shadow_proc->ftrace; - c_p->cp = dirty_shadow_proc->cp; c_p->i = dirty_shadow_proc->i; c_p->arity = dirty_shadow_proc->arity; } diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab index 8e0caa38a3..f1877882a1 100644 --- a/erts/emulator/beam/bif_instrs.tab +++ b/erts/emulator/beam/bif_instrs.tab @@ -280,7 +280,7 @@ call_bif(Exp) { * erlang code or by nif_bif.epilogue() when the BIF * is done). */ - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); SET_I(c_p->i); SWAPIN; Dispatch(); @@ -297,7 +297,7 @@ call_bif(Exp) { // // Call a BIF tail-recursively, storing the result in x(0) and doing -// a return to the continuation poiner (c_p->cp). +// a return to the continuation poiner. // call_bif_only(Exp) { @@ -367,7 +367,7 @@ call_bif_only(Exp) { } else if (c_p->freason == TRAP) { /* * Dispatch to a trap. When the trap is done, a jump - * to the continuation pointer (c_p->cp) will be done. + * to the continuation pointer on the stack will be done. */ SET_I(c_p->i); SWAPIN; @@ -413,7 +413,7 @@ send() { r(0) = result; CHECK_TERM(r(0)); } else if (c_p->freason == TRAP) { - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); SET_I(c_p->i); SWAPIN; Dispatch(); @@ -570,8 +570,7 @@ nif_bif.epilogue() { if (ERTS_LIKELY(is_value(nif_bif_result))) { r(0) = nif_bif_result; CHECK_TERM(r(0)); - SET_I(c_p->cp); - c_p->cp = 0; + $RETURN(); Goto(*I); } else if (c_p->freason == TRAP) { SET_I(c_p->i); @@ -581,6 +580,10 @@ nif_bif.epilogue() { } Dispatch(); } - I = handle_error(c_p, c_p->cp, reg, c_p->current); + { + BeamInstr *cp = cp_val(*E); + ASSERT(VALID_INSTR(*cp)); + I = handle_error(c_p, cp, reg, c_p->current); + } goto post_error_handling; } 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 4d8c3eb9dd..e5ba79488a 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -2022,14 +2022,16 @@ current_function(Process *c_p, ErtsHeapFactory *hfact, Process* rp, if (c_p == rp && !(flags & ERTS_PI_FLAG_REQUEST_FOR_OTHER)) { FunctionInfo fi2; + BeamInstr* continuation_ptr; /* * The current function is erlang:process_info/{1,2}, * which is not the answer that the application want. - * We will use the function pointed into by rp->cp - * instead if it can be looked up. + * We will use the continuation pointer stored at the + * top of the stack instead. */ - erts_lookup_function_info(&fi2, rp->cp, full_info); + continuation_ptr = (BeamInstr *) rp->stop[0]; + erts_lookup_function_info(&fi2, continuation_ptr, full_info); if (fi2.mfa) { fi = fi2; rp->current = fi2.mfa; @@ -2076,10 +2078,6 @@ current_stacktrace(ErtsHeapFactory *hfact, Process* rp, s->trace[s->depth++] = rp->i; depth--; } - if (depth > 0 && rp->cp != 0) { - s->trace[s->depth++] = rp->cp - 1; - depth--; - } erts_save_stacktrace(rp, s, depth); depth = s->depth; @@ -2813,7 +2811,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_db_util.c b/erts/emulator/beam/erl_db_util.c index 1ea7074d21..6a48f5c74e 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2612,7 +2612,10 @@ restart: break; case matchCaller: ASSERT(c_p == self); - if (!(c_p->cp) || !(cp = find_function_from_pc(c_p->cp))) { + t = c_p->stop[0]; + if (is_not_CP(t)) { + *esp++ = am_undefined; + } else if (!(cp = find_function_from_pc(cp_val(t)))) { *esp++ = am_undefined; } else { ehp = HAllocX(build_proc, 4, HEAP_XTRA); @@ -5226,7 +5229,7 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) Eterm l; Uint32 ret_flags; Uint sz; - BeamInstr *save_cp; + Eterm save_cp; if (trace && !(is_list(against) || against == NIL)) { return THE_NON_VALUE; @@ -5270,13 +5273,13 @@ static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) ++n; l = CDR(list_val(l)); } - save_cp = p->cp; - p->cp = NULL; + save_cp = p->stop[0]; + p->stop[0] = NIL; res = erts_match_set_run_trace(p, p, mps, arr, n, ERTS_PAM_COPY_RESULT|ERTS_PAM_IGNORE_TRACE_SILENT, &ret_flags); - p->cp = save_cp; + p->stop[0] = save_cp; } else { n = 0; arr = NULL; 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_gc.c b/erts/emulator/beam/erl_gc.c index 13b1f8ab4d..f387960b08 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -65,6 +65,8 @@ # define HARDDEBUG 1 #endif +extern BeamInstr beam_apply[2]; + /* * Returns number of elements in an array. */ @@ -934,13 +936,15 @@ garbage_collect_hibernate(Process* p, int check_long_gc) */ erts_atomic32_read_bor_nob(&p->state, ERTS_PSFLG_GC); ErtsGcQuickSanityCheck(p); - ASSERT(p->stop == p->hend); /* Stack must be empty. */ + ASSERT(p->stop == p->hend - 1); /* Only allow one continuation pointer. */ + ASSERT(p->stop[0] == make_cp(beam_apply+1)); /* * Do it. */ heap_size = p->heap_sz + (p->old_htop - p->old_heap) + p->mbuf_sz; + heap_size += 1; /* Reserve place for continuation pointer */ heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, sizeof(Eterm)*heap_size); @@ -966,13 +970,11 @@ garbage_collect_hibernate(Process* p, int check_long_gc) p->high_water = htop; p->htop = htop; p->hend = p->heap + heap_size; - p->stop = p->hend; + p->stop = p->hend - 1; p->heap_sz = heap_size; heap_size = actual_size = p->htop - p->heap; - if (heap_size == 0) { - heap_size = 1; /* We want a heap... */ - } + heap_size += 1; /* Reserve place for continuation pointer */ FLAGS(p) &= ~F_FORCE_GC; p->live_hf_end = ERTS_INVALID_HFRAG_PTR; @@ -988,14 +990,15 @@ garbage_collect_hibernate(Process* p, int check_long_gc) * hibernated. */ - ASSERT(p->hend - p->stop == 0); /* Empty stack */ ASSERT(actual_size < p->heap_sz); heap = ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*heap_size); sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm)); ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm)); - p->stop = p->hend = heap + heap_size; + p->hend = heap + heap_size; + p->stop = p->hend - 1; + p->stop[0] = make_cp(beam_apply+1); offs = heap - p->heap; area = (char *) p->heap; 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_nfunc_sched.c b/erts/emulator/beam/erl_nfunc_sched.c index b8cf2bee0e..b2658ef180 100644 --- a/erts/emulator/beam/erl_nfunc_sched.c +++ b/erts/emulator/beam/erl_nfunc_sched.c @@ -67,7 +67,7 @@ erts_destroy_nif_export(Process *p) void erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying, - Export* ep, BeamInstr *cp, Uint32 flags, + Export* ep, Uint32 flags, Uint32 flags_meta, BeamInstr* I, ErtsTracer meta_tracer) { @@ -78,7 +78,6 @@ erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying, sizeof(NifExportTrace)); netp->applying = applying; netp->ep = ep; - netp->cp = cp; netp->flags = flags; netp->flags_meta = flags_meta; netp->I = I; @@ -93,7 +92,7 @@ erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep) NifExportTrace *netp = nep->trace; nep->trace = NULL; erts_bif_trace_epilogue(c_p, result, netp->applying, netp->ep, - netp->cp, netp->flags, netp->flags_meta, + netp->flags, netp->flags_meta, netp->I, netp->meta_tracer); erts_tracer_update(&netp->meta_tracer, NIL); erts_free(ERTS_ALC_T_NIF_EXP_TRACE, netp); @@ -148,7 +147,6 @@ erts_nif_export_schedule(Process *c_p, Process *dirty_shadow_proc, for (i = 0; i < (int) mfa->arity; i++) nep->argv[i] = reg[i]; nep->pc = pc; - nep->cp = c_p->cp; nep->mfa = mfa; nep->current = c_p->current; ASSERT(argc >= 0); diff --git a/erts/emulator/beam/erl_nfunc_sched.h b/erts/emulator/beam/erl_nfunc_sched.h index 1cb252eba5..5c6486cbb8 100644 --- a/erts/emulator/beam/erl_nfunc_sched.h +++ b/erts/emulator/beam/erl_nfunc_sched.h @@ -28,7 +28,6 @@ typedef struct { int applying; Export* ep; - BeamInstr *cp; Uint32 flags; Uint32 flags_meta; BeamInstr* I; @@ -53,7 +52,6 @@ typedef struct { NifExportTrace *trace; /* --- The following is only used on error --- */ BeamInstr *pc; /* Program counter */ - BeamInstr *cp; /* Continuation pointer */ ErtsCodeMFA *mfa; /* MFA of original call */ int argc; /* Number of arguments in original call */ int argv_size; /* Allocated size of argv */ @@ -62,7 +60,7 @@ typedef struct { NifExport *erts_new_proc_nif_export(Process *c_p, int argc); void erts_nif_export_save_trace(Process *c_p, NifExport *nep, int applying, - Export* ep, BeamInstr *cp, Uint32 flags, + Export* ep, Uint32 flags, Uint32 flags_meta, BeamInstr* I, ErtsTracer meta_tracer); void erts_nif_export_restore_trace(Process *c_p, Eterm result, NifExport *nep); @@ -85,7 +83,7 @@ ERTS_GLB_INLINE void erts_nif_export_restore_error(Process* c_p, BeamInstr **pc, Eterm *reg, ErtsCodeMFA **nif_mfa); ERTS_GLB_INLINE int erts_nif_export_check_save_trace(Process *c_p, Eterm result, int applying, Export* ep, - BeamInstr *cp, Uint32 flags, + Uint32 flags, Uint32 flags_meta, BeamInstr* I, ErtsTracer meta_tracer); ERTS_GLB_INLINE Process *erts_proc_shadow2real(Process *c_p); @@ -131,8 +129,6 @@ erts_check_nif_export_in_area(Process *p, char *start, Uint size) return 0; if (ErtsInArea(nep->pc, start, size)) return 1; - if (ErtsInArea(nep->cp, start, size)) - return 1; if (ErtsInArea(nep->mfa, start, size)) return 1; if (ErtsInArea(nep->current, start, size)) @@ -164,7 +160,6 @@ erts_nif_export_restore_error(Process* c_p, BeamInstr **pc, ASSERT(nep); *pc = nep->pc; - c_p->cp = nep->cp; *nif_mfa = nep->mfa; for (ix = 0; ix < nep->argc; ix++) reg[ix] = nep->argv[ix]; @@ -174,7 +169,7 @@ erts_nif_export_restore_error(Process* c_p, BeamInstr **pc, ERTS_GLB_INLINE int erts_nif_export_check_save_trace(Process *c_p, Eterm result, int applying, Export* ep, - BeamInstr *cp, Uint32 flags, + Uint32 flags, Uint32 flags_meta, BeamInstr* I, ErtsTracer meta_tracer) { @@ -182,7 +177,7 @@ erts_nif_export_check_save_trace(Process *c_p, Eterm result, NifExport *nep = ERTS_PROC_GET_NIF_TRAP_EXPORT(c_p); if (nep && nep->argc >= 0) { erts_nif_export_save_trace(c_p, nep, applying, ep, - cp, flags, flags_meta, + flags, flags_meta, I, meta_tracer); return 1; } diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 1fbe362330..46f7e864fd 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -334,7 +334,7 @@ schedule(ErlNifEnv* env, NativeFunPtr direct_fp, NativeFunPtr indirect_fp, ep = erts_nif_export_schedule(c_p, dirty_shadow_proc, c_p->current, - c_p->cp, + cp_val(c_p->stop[0]), BeamOpCodeAddr(op_call_nif), direct_fp, indirect_fp, mod, func_name, @@ -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); } @@ -4117,7 +4117,6 @@ static struct erl_module_nif* create_lib(const ErlNifEntry* src) return lib; }; - BIF_RETTYPE load_nif_2(BIF_ALIST_2) { static const char bad_lib[] = "bad_lib"; @@ -4140,6 +4139,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) struct erl_module_nif* lib = NULL; struct erl_module_instance* this_mi; struct erl_module_instance* prev_mi; + BeamInstr* caller_cp; if (BIF_P->flags & F_HIPE_MODE) { ret = load_nif_error(BIF_P, "notsup", "Calling load_nif from HiPE compiled " @@ -4175,7 +4175,8 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ASSERT(BIF_P->current->module == am_erlang && BIF_P->current->function == am_load_nif && BIF_P->current->arity == 2); - caller = find_function_from_pc(BIF_P->cp); + caller_cp = cp_val(BIF_P->stop[0]); + caller = find_function_from_pc(caller_cp); ASSERT(caller != NULL); mod_atom = caller->module; ASSERT(is_atom(mod_atom)); 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..4b4337ce17 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; @@ -11453,7 +11458,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). #else arg_size = size_object_litopt(args, &litarea); #endif - heap_need = arg_size; + heap_need = arg_size + 1; /* Reserve place for continuation pointer */ p->flags = flags; @@ -11502,7 +11507,8 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->old_hend = p->old_htop = p->old_heap = NULL; p->high_water = p->heap; p->gen_gcs = 0; - p->stop = p->hend = p->heap + sz; + p->hend = p->heap + sz; + p->stop = p->hend - 1; /* Reserve place for continuation pointer */ p->htop = p->heap; p->heap_sz = sz; p->abandoned_heap = NULL; @@ -11520,7 +11526,7 @@ erl_create_process(Process* parent, /* Parent of process (default group leader). p->current = &p->u.initial; p->i = (BeamInstr *) beam_apply; - p->cp = (BeamInstr *) beam_apply+1; + p->stop[0] = make_cp(beam_apply + 1); p->arg_reg = p->def_arg_reg; p->max_arg_reg = sizeof(p->def_arg_reg)/sizeof(p->def_arg_reg[0]); @@ -11583,9 +11589,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 +11609,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 +11669,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); @@ -11793,7 +11840,6 @@ void erts_init_empty_process(Process *p) p->u.initial.function = 0; p->u.initial.arity = 0; p->catches = 0; - p->cp = NULL; p->i = NULL; p->current = NULL; @@ -11871,7 +11917,6 @@ erts_debug_verify_clean_empty_process(Process* p) ASSERT(p->bif_timers == NULL); ASSERT(p->dictionary == NULL); ASSERT(p->catches == 0); - ASSERT(p->cp == NULL); ASSERT(p->i == NULL); ASSERT(p->current == NULL); @@ -13100,9 +13145,6 @@ erts_program_counter_info(fmtfn_t to, void *to_arg, Process *p) erts_print(to, to_arg, "Program counter: %p (", p->i); print_function_from_pc(to, to_arg, p->i); erts_print(to, to_arg, ")\n"); - erts_print(to, to_arg, "CP: %p (", p->cp); - print_function_from_pc(to, to_arg, p->cp); - erts_print(to, to_arg, ")\n"); state = erts_atomic32_read_acqb(&p->state); if (!(state & (ERTS_PSFLG_RUNNING | ERTS_PSFLG_RUNNING_SYS @@ -13379,9 +13421,6 @@ static void print_current_process_info(fmtfn_t to, void *to_arg, erts_print(to, to_arg, "Current Process Program counter: %p (", p->i); print_function_from_pc(to, to_arg, p->i); erts_print(to, to_arg, ")\n"); - erts_print(to, to_arg, "Current Process CP: %p (", p->cp); - print_function_from_pc(to, to_arg, p->cp); - erts_print(to, to_arg, ")\n"); /* Getting this stacktrace can segfault if we are very very unlucky if called while a process is being garbage collected. diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index c0d7cfd13d..a7a6528f92 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -975,7 +975,6 @@ struct process { unsigned max_arg_reg; /* Maximum number of argument registers available. */ Eterm def_arg_reg[6]; /* Default array for argument registers. */ - BeamInstr* cp; /* (untagged) Continuation pointer (for threaded code). */ BeamInstr* i; /* Program counter for threaded code. */ Sint catches; /* Number of catches on stack */ Sint fcalls; /* @@ -1489,6 +1488,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..f564549ab9 100644 --- a/erts/emulator/beam/erl_trace.h +++ b/erts/emulator/beam/erl_trace.h @@ -145,7 +145,7 @@ int erts_trace_flags(Eterm List, Eterm erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr *I); Eterm erts_bif_trace_epilogue(Process *p, Eterm result, int applying, - Export* ep, BeamInstr *cp, Uint32 flags, + Export* ep, Uint32 flags, Uint32 flags_meta, BeamInstr* I, ErtsTracer meta_tracer); @@ -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..156de67716 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -19,7 +19,12 @@ // %CopyrightEnd% // -// Stack manipulation instructions +// +// Stack manipulation instructions follow. +// +// See the comment for AH() in macros.tab for information about +// the layout of stack frames. +// allocate(NeedStack, Live) { $AH($NeedStack, 0, $Live); @@ -58,22 +63,84 @@ allocate_heap_zero(NeedStack, NeedHeap, Live) { deallocate(Deallocate) { //| -no_prefetch - SET_CP(c_p, (BeamInstr *) cp_val(*E)); E = ADD_BYTE_OFFSET(E, $Deallocate); } +deallocate_return0 := dealloc_ret.n0.execute; +deallocate_return1 := dealloc_ret.n1.execute; +deallocate_return2 := dealloc_ret.n2.execute; +deallocate_return3 := dealloc_ret.n3.execute; +deallocate_return4 := dealloc_ret.n4.execute; + +dealloc_ret.head() { + Uint num_bytes; +} + +dealloc_ret.n0() { + num_bytes = (0+1) * sizeof(Eterm); +} + +dealloc_ret.n1() { + num_bytes = (1+1) * sizeof(Eterm); +} + +dealloc_ret.n2() { + num_bytes = (2+1) * sizeof(Eterm); +} + +dealloc_ret.n3() { + num_bytes = (3+1) * sizeof(Eterm); +} + +dealloc_ret.n4() { + num_bytes = (4+1) * sizeof(Eterm); +} + +dealloc_ret.execute() { + //| -no_next + + /* + * Micro-benchmarks showed that the deallocate_return instruction + * became slower when the continuation pointer was moved from + * the process struct to the stack. The reason seems to be read + * dependencies, i.e. that the CPU cannot figure out beforehand + * from which position on the stack the continuation pointer + * should be fetched. + * + * Making sure that num_bytes is always initialized with a + * constant value seems to restore the lost speed. + */ + + E = ADD_BYTE_OFFSET(E, num_bytes); + $RETURN(); + CHECK_TERM(x(0)); + DispatchReturn; +} + deallocate_return(Deallocate) { //| -no_next - int words_to_pop = $Deallocate; - SET_I((BeamInstr *) cp_val(*E)); - E = ADD_BYTE_OFFSET(E, words_to_pop); + Uint bytes_to_pop = $Deallocate; + E = ADD_BYTE_OFFSET(E, bytes_to_pop); + $RETURN(); CHECK_TERM(x(0)); DispatchReturn; } move_deallocate_return(Src, Deallocate) { - x(0) = $Src; - $deallocate_return($Deallocate); + //| -no_next + + /* + * Explicitly do reads first to mitigate the impact of read + * dependencies. + */ + + Uint bytes_to_pop = $Deallocate; + Eterm src = $Src; + E = ADD_BYTE_OFFSET(E, bytes_to_pop); + x(0) = src; + $RETURN(); + CHECK_TERM(x(0)); + DispatchReturn; } // Call instructions @@ -93,14 +160,16 @@ DISPATCH_ABS(CallDest) { } i_call(CallDest) { - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); $DISPATCH_REL($CallDest); } move_call(Src, CallDest) { - x(0) = $Src; - SET_CP(c_p, $NEXT_INSTRUCTION); - $DISPATCH_REL($CallDest); + Eterm call_dest = $CallDest; + Eterm src = $Src; + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); + x(0) = src; + $DISPATCH_REL(call_dest); } i_call_last(CallDest, Deallocate) { @@ -109,8 +178,11 @@ i_call_last(CallDest, Deallocate) { } move_call_last(Src, CallDest, Deallocate) { - x(0) = $Src; - $i_call_last($CallDest, $Deallocate); + Eterm call_dest = $CallDest; + Eterm src = $Src; + $deallocate($Deallocate); + x(0) = src; + $DISPATCH_REL(call_dest); } i_call_only(CallDest) { @@ -118,8 +190,10 @@ i_call_only(CallDest) { } move_call_only(Src, CallDest) { - x(0) = $Src; - $i_call_only($CallDest); + Eterm call_dest = $CallDest; + Eterm src = $Src; + x(0) = src; + $DISPATCH_REL(call_dest); } DISPATCHX(Dest) { @@ -131,22 +205,27 @@ DISPATCHX(Dest) { } i_call_ext(Dest) { - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); $DISPATCHX($Dest); } -i_move_call_ext(Src, Dest) { - x(0) = $Src; - $i_call_ext($Dest); +i_move_call_ext(Src, CallDest) { + Eterm call_dest = $CallDest; + Eterm src = $Src; + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); + x(0) = src; + $DISPATCHX(call_dest); } i_call_ext_only(Dest) { $DISPATCHX($Dest); } -i_move_call_ext_only(Dest, Src) { - x(0) = $Src; - $i_call_ext_only($Dest); +i_move_call_ext_only(CallDest, Src) { + Eterm call_dest = $CallDest; + Eterm src = $Src; + x(0) = src; + $DISPATCHX(call_dest); } i_call_ext_last(Dest, Deallocate) { @@ -154,9 +233,12 @@ i_call_ext_last(Dest, Deallocate) { $DISPATCHX($Dest); } -i_move_call_ext_last(Dest, StackOffset, Src) { - x(0) = $Src; - $i_call_ext_last($Dest, $StackOffset); +i_move_call_ext_last(CallDest, Deallocate, Src) { + Eterm call_dest = $CallDest; + Eterm src = $Src; + $deallocate($Deallocate); + x(0) = src; + $DISPATCHX(call_dest); } APPLY(I, Deallocate, Next) { @@ -175,7 +257,7 @@ i_apply() { BeamInstr *next; $APPLY(NULL, 0, next); if (ERTS_LIKELY(next != NULL)) { - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); $DISPATCH_ABS(next); } $HANDLE_APPLY_ERROR(); @@ -211,7 +293,7 @@ apply(Arity) { BeamInstr *next; $FIXED_APPLY($Arity, NULL, 0, next); if (ERTS_LIKELY(next != NULL)) { - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); $DISPATCH_ABS(next); } $HANDLE_APPLY_ERROR(); @@ -247,7 +329,7 @@ i_apply_fun() { BeamInstr *next; $APPLY_FUN(next); if (ERTS_LIKELY(next != NULL)) { - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); $DISPATCH_FUN(next); } $HANDLE_APPLY_FUN_ERROR(); @@ -283,7 +365,7 @@ i_call_fun(Fun) { BeamInstr *next; $CALL_FUN($Fun, next); if (ERTS_LIKELY(next != NULL)) { - SET_CP(c_p, $NEXT_INSTRUCTION); + $SAVE_CONTINUATION_POINTER($NEXT_INSTRUCTION); $DISPATCH_FUN(next); } $HANDLE_APPLY_FUN_ERROR(); @@ -301,15 +383,8 @@ i_call_fun_last(Fun, Deallocate) { return() { //| -no_next - SET_I(c_p->cp); + $RETURN(); DTRACE_RETURN_FROM_PC(c_p); - - /* - * We must clear the CP to make sure that a stale value do not - * create a false module dependcy preventing code upgrading. - * It also means that we can use the CP in stack backtraces. - */ - c_p->cp = 0; CHECK_TERM(r(0)); HEAP_SPACE_VERIFIED(0); DispatchReturn; @@ -478,16 +553,21 @@ i_make_fun(FunP, NumFree) { } move_trim(Src, Dst, Words) { - Uint cp = E[0]; $Dst = $Src; - E += $Words; - E[0] = cp; + $i_trim($Words); } i_trim(Words) { - Uint cp = E[0]; E += $Words; - E[0] = cp; + + /* + * Clear the reserved location for the continuation pointer at + * E[0]. This is not strictly necessary for correctness, but if a + * GC is triggered before E[0] is overwritten by another + * continuation pointer the now dead term at E[0] would be + * retained by the GC. + */ + E[0] = NIL; } move(Src, Dst) { @@ -599,8 +679,7 @@ move_window5(S1, S2, S3, S4, S5, D) { move_return(Src) { //| -no_next x(0) = $Src; - SET_I(c_p->cp); - c_p->cp = 0; + $RETURN(); DispatchReturn; } @@ -683,10 +762,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/macros.tab b/erts/emulator/beam/macros.tab index 1b5e5f66b0..9d183e1f41 100644 --- a/erts/emulator/beam/macros.tab +++ b/erts/emulator/beam/macros.tab @@ -104,14 +104,52 @@ GC_TEST_PRESERVE(NeedHeap, Live, PreserveTerm) { // Make sure that there are NeedStack + NeedHeap + 1 words available -// on the combined heap/stack segment, then allocates NeedHeap + 1 -// words on the stack and saves CP. +// on the combined heap/stack segment, then decrement the stack +// pointer by (NeedStack + 1) words. Finally clear the word reserved +// for the continuation pointer at the top of the stack. +// +// Stack frame layout: +// +// +-----------+ +// y(N) | Term | +// +-----------+ +// . +// . +// . +// +-----------+ +// y(0) | Term | +// +-----------+ +// E ==> | NIL or CP | +// +-----------+ +// +// When the function owning the stack frame is the currently executing +// function, the word at the top of the stack is NIL. When calling +// another function, the continuation pointer will be stored in the +// word at the top of the stack. When returning to the function +// owning the stack frame, the word at the stack top will again be set +// to NIL. + AH(NeedStack, NeedHeap, Live) { unsigned needed = $NeedStack + 1; $GC_TEST(needed, $NeedHeap, $Live); E -= needed; - *E = make_cp(c_p->cp); - c_p->cp = 0; + *E = NIL; +} + +// Save the continuation pointer in the reserved slot at the +// top of the stack as preparation for doing a function call. + +SAVE_CONTINUATION_POINTER(IP) { + ASSERT(VALID_INSTR(*($IP))); + *E = (BeamInstr) ($IP); +} + +// Return to the function whose continuation pointer is stored +// at the top of the stack and set that word to NIL. + +RETURN() { + SET_I(cp_val(*E)); + *E = NIL; } NEXT0() { diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index b9d4f6afcc..c0ca9260a0 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 @@ -657,8 +596,20 @@ move S x==0 | deallocate D | return => move_deallocate_return S D move_deallocate_return xycn Q +deallocate u==0 | return => deallocate_return0 +deallocate u==1 | return => deallocate_return1 +deallocate u==2 | return => deallocate_return2 +deallocate u==3 | return => deallocate_return3 +deallocate u==4 | return => deallocate_return4 + deallocate D | return => deallocate_return D +deallocate_return0 +deallocate_return1 +deallocate_return2 +deallocate_return3 +deallocate_return4 + deallocate_return Q test_heap Need u==1 | put_list Y=y x==0 x==0 => test_heap_1_put_list Need Y 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/trace_instrs.tab b/erts/emulator/beam/trace_instrs.tab index 3eee81c053..9f22587f96 100644 --- a/erts/emulator/beam/trace_instrs.tab +++ b/erts/emulator/beam/trace_instrs.tab @@ -20,16 +20,15 @@ // return_trace() { - ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[0]); + ErtsCodeMFA* mfa = (ErtsCodeMFA *)(E[1]); SWAPOUT; /* Needed for shared heap */ ERTS_UNREQ_PROC_MAIN_LOCK(c_p); - erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+1)/* tracer */); + erts_trace_return(c_p, mfa, r(0), ERTS_TRACER_FROM_ETERM(E+2)/* tracer */); ERTS_REQ_PROC_MAIN_LOCK(c_p); SWAPIN; - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[2])); E += 3; + $RETURN(); Goto(*I); //| -no_next } @@ -45,13 +44,12 @@ i_generic_breakpoint() { } i_return_time_trace() { - BeamInstr *pc = (BeamInstr *) (UWord) E[0]; + BeamInstr *pc = (BeamInstr *) (UWord) E[1]; SWAPOUT; erts_trace_time_return(c_p, erts_code_to_codeinfo(pc)); SWAPIN; - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[1])); E += 2; + $RETURN(); Goto(*I); //| -no_next } @@ -59,8 +57,10 @@ i_return_time_trace() { i_return_to_trace() { if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) { Uint *cpp = (Uint*) E; + while (is_not_CP(*cpp)) { + cpp++; + } for(;;) { - ASSERT(is_CP(*cpp)); if (IsOpCode(*cp_val(*cpp), return_trace)) { do ++cpp; @@ -80,9 +80,8 @@ i_return_to_trace() { ERTS_REQ_PROC_MAIN_LOCK(c_p); SWAPIN; } - c_p->cp = NULL; - SET_I((BeamInstr *) cp_val(E[0])); E += 1; + $RETURN(); Goto(*I); //| -no_next } 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/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index 138e4f7da3..2e34cfac59 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -232,7 +232,6 @@ void hipe_print_pcb(Process *p) U("intial.fun ", u.initial.function); U("intial.ari ", u.initial.arity); U("current ", current); - P("cp ", cp); P("i ", i); U("catches ", catches); U("arity ", arity); diff --git a/erts/emulator/hipe/hipe_instrs.tab b/erts/emulator/hipe/hipe_instrs.tab index a01baebddf..62162fcb9c 100644 --- a/erts/emulator/hipe/hipe_instrs.tab +++ b/erts/emulator/hipe/hipe_instrs.tab @@ -86,8 +86,7 @@ hipe_trap.post() { switch( c_p->def_arg_reg[3] ) { case HIPE_MODE_SWITCH_RES_RETURN: ASSERT(is_value(reg[0])); - SET_I(c_p->cp); - c_p->cp = 0; + $RETURN(); Goto(*I); case HIPE_MODE_SWITCH_RES_CALL_EXPORTED: c_p->i = c_p->hipe.u.callee_exp->addressv[erts_active_code_ix()]; @@ -111,7 +110,6 @@ hipe_trap.post() { goto find_func_info; } case HIPE_MODE_SWITCH_RES_THROW: - c_p->cp = NULL; I = handle_error(c_p, I, reg, NULL); goto post_error_handling; default: diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c index 052cf9c263..863c5e6d44 100644 --- a/erts/emulator/hipe/hipe_mode_switch.c +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -202,15 +202,13 @@ hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) p->stop -= 2; p->stop[1] = hipe_beam_catch_throw; } - p->stop[0] = make_cp(p->cp); + p->stop[0] = (BeamInstr) hipe_beam_pc_return; ++p->catches; - p->cp = hipe_beam_pc_return; } static __inline__ void hipe_pop_beam_trap_frame(Process *p) { ASSERT(p->stop[1] == hipe_beam_catch_throw); - p->cp = cp_val(p->stop[0]); --p->catches; p->stop += 2; } @@ -263,7 +261,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) unsigned arity = cmd >> 8; /* p->hipe.u.ncallee set in beam_emu */ - if (p->cp == hipe_beam_pc_return) { + if (cp_val(p->stop[0]) == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); @@ -292,7 +290,7 @@ Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) /* just like a normal call from now on */ /* p->hipe.u.ncallee set in beam_emu */ - if (p->cp == hipe_beam_pc_return) { + if (cp_val(p->stop[0]) == hipe_beam_pc_return) { /* Native called BEAM, which now tailcalls native. */ hipe_pop_beam_trap_frame(p); result = hipe_tailcall_to_native(p, arity, reg); 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/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl index c5abd04e07..2a965d2095 100644 --- a/erts/emulator/test/bif_SUITE.erl +++ b/erts/emulator/test/bif_SUITE.erl @@ -860,6 +860,7 @@ error_stacktrace_test() -> Types = [apply_const_last, apply_const, apply_last, apply, double_apply_const_last, double_apply_const, double_apply_last, double_apply, multi_apply_const_last, + apply_const_only, apply_only, multi_apply_const, multi_apply_last, multi_apply, call_const_last, call_last, call_const, call], lists:foreach(fun (Type) -> @@ -897,6 +898,8 @@ error_stacktrace_test() -> ok. stk([], Type, Func) -> + put(erlang, erlang), + put(tail, []), tail(Type, Func, jump), ok; stk([_|L], Type, Func) -> @@ -910,6 +913,12 @@ tail(Type, error_1, do) -> tail(Type, error_2, do) -> do_error_2(Type). +do_error_2(apply_const_only) -> + apply(erlang, error, [oops, [apply_const_only]]); +do_error_2(apply_only) -> + Erlang = get(erlang), + Tail = get(tail), + apply(Erlang, error, [oops, [apply_only|Tail]]); do_error_2(apply_const_last) -> erlang:apply(erlang, error, [oops, [apply_const_last]]); do_error_2(apply_const) -> @@ -951,6 +960,12 @@ do_error_2(call) -> erlang:error(id(oops), id([call])). +do_error_1(apply_const_only) -> + apply(erlang, error, [oops]); +do_error_1(apply_only) -> + Erlang = get(erlang), + Tail = get(tail), + apply(Erlang, error, [oops|Tail]); do_error_1(apply_const_last) -> erlang:apply(erlang, error, [oops]); do_error_1(apply_const) -> 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/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl index a20f306e04..d65d0ff2fd 100644 --- a/erts/emulator/test/hibernate_SUITE.erl +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -46,12 +46,17 @@ all() -> basic(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, - ExpectedHeapSz = erts_debug:size([Info]), + ExpectedHeapSz = expected_heap_size([Info]), Child = spawn_link(fun() -> basic_hibernator(Info) end), hibernate_wake_up(100, ExpectedHeapSz, Child), Child ! please_quit_now, ok. +expected_heap_size(Term) -> + %% When hibernating, an extra word will be allocated on the stack + %% for a continuation pointer. + erts_debug:size(Term) + 1. + hibernate_wake_up(0, _, _) -> ok; hibernate_wake_up(N, ExpectedHeapSz, Child) -> {heap_size,Before} = process_info(Child, heap_size), @@ -142,7 +147,7 @@ whats_up_calc(A1, A2, A3, A4, A5, A6, A7, A8, A9, Acc) -> dynamic_call(Config) when is_list(Config) -> Ref = make_ref(), Info = {self(),Ref}, - ExpectedHeapSz = erts_debug:size([Info]), + ExpectedHeapSz = expected_heap_size([Info]), Child = spawn_link(fun() -> ?MODULE:dynamic_call_hibernator(Info, hibernate) end), hibernate_wake_up(100, ExpectedHeapSz, Child), Child ! please_quit_now, diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl index 8b1519ae36..d4c74579e2 100644 --- a/erts/emulator/test/nofrag_SUITE.erl +++ b/erts/emulator/test/nofrag_SUITE.erl @@ -22,6 +22,11 @@ -include_lib("common_test/include/ct.hrl"). +%% This suite alters the return values of functions which breaks certain +%% assumptions made by the compiler, so we have to turn off module-level type +%% optimization to be safe. +-compile(no_module_opt). + -export([all/0, suite/0, error_handler/1,error_handler_apply/1, error_handler_fixed_apply/1,error_handler_fun/1, 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/etp-commands.in b/erts/etc/unix/etp-commands.in index 20809d61e8..283f859651 100644 --- a/erts/etc/unix/etp-commands.in +++ b/erts/etc/unix/etp-commands.in @@ -1187,12 +1187,14 @@ document etp-cp %--------------------------------------------------------------------------- % etp-cp Eterm % -% Take a code continuation pointer and print +% Take a code continuation pointer or instruction pointer and print % module, function, arity and offset. % -% Code continuation pointers can be found in the process structure e.g -% process_tab[i]->cp and process_tab[i]->i, the second is the -% program counter, which is the same thing as a continuation pointer. +% Code continuation pointers can be found on the stack. The instruction +% pointer is found in the process struct. For example: +% +% c_p->i +% process_tab[i]->i %--------------------------------------------------------------------------- end @@ -1462,10 +1464,6 @@ define etp-stack-preamble printf "I: " etp ((Eterm)($arg0)->i) end - if ($arg0)->cp != 0 - printf "cp:" - etp ((Eterm)($arg0)->cp) - end end define etp-stack-preamble-emu @@ -1474,10 +1472,6 @@ define etp-stack-preamble-emu printf "%% Stacktrace (%u)\n", $etp_stack_end-$etp_stack_p printf "I: " etp ((BeamInstr)I) - if ($arg0)->cp != 0 - printf "cp: " - etp ((Eterm)($arg0)->cp) - end end define etp-stacktrace-1 @@ -2183,13 +2177,6 @@ define etp-process-info-int else printf "unknown\n" end - printf " CP: " - if ($etp_proc->cp) - etp-cp-1 $etp_proc->cp - printf "\n" - else - printf "unknown\n" - end printf " I: " if ($etp_proc->i) etp-cp-1 $etp_proc->i @@ -2419,11 +2406,6 @@ define etp-process-memory-info end end - if ($etp_pmem_proc->cp) - printf " CP: " - etp-cp-1 $etp_pmem_proc->cp - printf " " - end printf "\n" end end 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/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 2372e8b9ac..c5e0dfe649 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2018. All Rights Reserved. +%% Copyright Ericsson AB 2000-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. @@ -79,8 +79,7 @@ undefined_functions(Config) when is_list(Config) -> [UndefS,ExcludeFrom]), {ok,Undef0} = xref:q(Server, lists:flatten(Q)), Undef1 = hipe_filter(Undef0), - Undef2 = ssl_crypto_filter(Undef1), - Undef3 = edoc_filter(Undef2), + Undef3 = ssl_crypto_filter(Undef1), Undef4 = eunit_filter(Undef3), Undef5 = dialyzer_filter(Undef4), Undef6 = wx_filter(Undef5), @@ -157,12 +156,6 @@ ssl_crypto_filter(Undef) -> {_,_} -> Undef end. -edoc_filter(Undef) -> - %% Filter away function call that is catched. - filter(fun({{edoc_lib,uri_get_http,1},{http,request_sync,2}}) -> false; - (_) -> true - end, Undef). - eunit_filter(Undef) -> filter(fun({{eunit_test,wrapper_test_exported_,0}, {eunit_test,nonexisting_function,0}}) -> false; diff --git a/lib/asn1/Makefile b/lib/asn1/Makefile index 26e7e37924..10a8795703 100644 --- a/lib/asn1/Makefile +++ b/lib/asn1/Makefile @@ -54,12 +54,7 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info version - -info: - @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" - @echo "APP_DIR: $(APP_DIR)" - @echo "APP_TAR_FILE: $(APP_TAR_FILE)" +.PHONY: version version: @echo "$(VSN)" @@ -100,3 +95,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/common_test/Makefile b/lib/common_test/Makefile index f2065b8a0d..5ac76f0044 100644 --- a/lib/common_test/Makefile +++ b/lib/common_test/Makefile @@ -45,3 +45,7 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=compiler tools crypto runtime_tools syntax_tools ftp inets \ + debugger sasl snmp ssh reltool observer xmerl + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/compiler/Makefile b/lib/compiler/Makefile index b8b2f562a2..f18df11e9f 100644 --- a/lib/compiler/Makefile +++ b/lib/compiler/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=crypto hipe + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 87b0d345f2..f253f31d13 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -49,10 +49,10 @@ MODULES = \ beam_a \ beam_asm \ beam_block \ + beam_call_types \ beam_clean \ beam_dict \ beam_disasm \ - beam_except \ beam_flatten \ beam_jump \ beam_listing \ @@ -72,6 +72,7 @@ MODULES = \ beam_ssa_type \ beam_kernel_to_ssa \ beam_trim \ + beam_types \ beam_utils \ beam_validator \ beam_z \ @@ -104,6 +105,7 @@ HRL_FILES= \ beam_disasm.hrl \ beam_ssa_opt.hrl \ beam_ssa.hrl \ + beam_types.hrl \ core_parse.hrl \ v3_kernel.hrl @@ -190,6 +192,7 @@ release_docs_spec: # Dependencies -- alphabetically, please # ---------------------------------------------------- +$(EBIN)/beam_call_types.beam: beam_types.hrl $(EBIN)/beam_disasm.beam: $(EGEN)/beam_opcodes.hrl beam_disasm.hrl $(EBIN)/beam_listing.beam: core_parse.hrl v3_kernel.hrl beam_ssa.hrl $(EBIN)/beam_kernel_to_ssa.beam: v3_kernel.hrl beam_ssa.hrl @@ -204,7 +207,8 @@ $(EBIN)/beam_ssa_pp.beam: beam_ssa.hrl $(EBIN)/beam_ssa_pre_codegen.beam: beam_ssa.hrl $(EBIN)/beam_ssa_recv.beam: beam_ssa.hrl $(EBIN)/beam_ssa_share.beam: beam_ssa.hrl -$(EBIN)/beam_ssa_type.beam: beam_ssa.hrl +$(EBIN)/beam_ssa_type.beam: beam_ssa.hrl beam_types.hrl +$(EBIN)/beam_types.beam: beam_types.hrl $(EBIN)/cerl.beam: core_parse.hrl $(EBIN)/compile.beam: core_parse.hrl ../../stdlib/include/erl_compile.hrl $(EBIN)/core_lib.beam: core_parse.hrl diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index df09dcb06c..60e19ec596 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -64,11 +64,30 @@ module(Code, ExtraChunks, CompileInfo, CompilerOpts) -> assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), + Dict2 = shared_fun_wrappers(CompilerOpts, Dict1), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), Exp = cerl_sets:from_list(Exp0), - {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), - build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts). + {Code,Dict} = assemble_1(Asm, Exp, Dict2, []), + build_file(Code, Attr, Dict, NumLabels, NumFuncs, + ExtraChunks, CompileInfo, CompilerOpts). + +shared_fun_wrappers(Opts, Dict) -> + case proplists:get_bool(no_shared_fun_wrappers, Opts) of + false -> + %% The compiler in OTP 23 depends on the on the loader + %% using the new indices in funs and being able to have + %% multiple make_fun2 instructions referring to the same + %% fun entry. Artificially set the highest opcode for the + %% module to ensure that it cannot be loaded in OTP 22 + %% and earlier. + Swap = beam_opcodes:opcode(swap, 2), + beam_dict:opcode(Swap, Dict); + true -> + %% Fun wrappers are not shared for compatibility with a + %% previous OTP release. + Dict + end. on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 707974b2c1..a734ca3a10 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -33,8 +33,9 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> function({function,Name,Arity,CLabel,Is0}) -> try - Is1 = blockify(Is0), - Is = embed_lines(Is1), + Is1 = swap_opt(Is0), + Is2 = blockify(Is1), + Is = embed_lines(Is2), {function,Name,Arity,CLabel,Is} catch Class:Error:Stack -> @@ -42,6 +43,40 @@ function({function,Name,Arity,CLabel,Is0}) -> erlang:raise(Class, Error, Stack) end. +%%% +%%% Try to use a `swap` instruction instead of a sequence of moves. +%%% +%%% Note that beam_ssa_codegen generates `swap` instructions only for +%%% the moves within a single SSA instruction (such as `call`), not +%%% for the moves generated by a sequence of SSA instructions. +%%% Therefore, this optimization is needed. +%%% + +swap_opt([{move,Reg1,{x,X}=Temp}=Move1, + {move,Reg2,Reg1}=Move2, + {move,Temp,Reg2}=Move3|Is]) when Reg1 =/= Temp -> + case is_unused(X, Is) of + true -> + [{swap,Reg1,Reg2}|swap_opt(Is)]; + false -> + [Move1|swap_opt([Move2,Move3|Is])] + end; +swap_opt([I|Is]) -> + [I|swap_opt(Is)]; +swap_opt([]) -> []. + +is_unused(X, [{call,A,_}|_]) when A =< X -> true; +is_unused(X, [{call_ext,A,_}|_]) when A =< X -> true; +is_unused(X, [{make_fun2,_,_,_,A}|_]) when A =< X -> true; +is_unused(X, [{move,Src,Dst}|Is]) -> + case {Src,Dst} of + {{x,X},_} -> false; + {_,{x,X}} -> true; + {_,_} -> is_unused(X, Is) + end; +is_unused(X, [{line,_}|Is]) -> is_unused(X, Is); +is_unused(_, _) -> false. + %% blockify(Instructions0) -> Instructions %% Collect sequences of instructions to basic blocks. %% Also do some simple optimations on instructions outside the blocks. diff --git a/lib/compiler/src/beam_call_types.erl b/lib/compiler/src/beam_call_types.erl new file mode 100644 index 0000000000..904d82a62d --- /dev/null +++ b/lib/compiler/src/beam_call_types.erl @@ -0,0 +1,551 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_call_types). + +-include("beam_types.hrl"). + +-import(lists, [duplicate/2,foldl/3]). + +-export([will_succeed/3, types/3]). + +%% +%% Returns whether a call will succeed or not. +%% +%% Note that it only answers 'yes' for functions in the 'erlang' module as +%% calls to other modules may fail due to not being loaded, even if we consider +%% the module to be known. +%% + +-spec will_succeed(Mod, Func, ArgTypes) -> Result when + Mod :: atom(), + Func :: atom(), + ArgTypes :: [normal_type()], + Result :: yes | no | maybe. + +will_succeed(erlang, BoolOp, [LHS, RHS]) when BoolOp =:= 'and'; + BoolOp =:= 'or' -> + case {succeeds_if_type(LHS, beam_types:make_boolean()), + succeeds_if_type(RHS, beam_types:make_boolean())} of + {yes, yes} -> yes; + {no, _} -> no; + {_, no} -> no; + {_, _} -> maybe + end; +will_succeed(erlang, bit_size, [Arg]) -> + succeeds_if_type(Arg, #t_bitstring{}); +will_succeed(erlang, byte_size, [Arg]) -> + succeeds_if_type(Arg, #t_bitstring{}); +will_succeed(erlang, map_size, [Arg]) -> + succeeds_if_type(Arg, #t_map{}); +will_succeed(erlang, 'not', [Arg]) -> + succeeds_if_type(Arg, beam_types:make_boolean()); +will_succeed(erlang, setelement, [#t_integer{elements={Min,Max}}, + #t_tuple{exact=Exact,size=Size}, _]) -> + case Min >= 1 andalso Max =< Size of + true -> yes; + false when Exact -> no; + false -> maybe + end; +will_succeed(erlang, size, [Arg]) -> + succeeds_if_type(Arg, #t_bitstring{}); +will_succeed(erlang, tuple_size, [Arg]) -> + succeeds_if_type(Arg, #t_tuple{}); +will_succeed(Mod, Func, Args) -> + Arity = length(Args), + case erl_bifs:is_safe(Mod, Func, Arity) of + true -> + yes; + false -> + case erl_bifs:is_exit_bif(Mod, Func, Arity) of + true -> no; + false -> maybe + end + end. + +succeeds_if_type(ArgType, Required) -> + case beam_types:meet(ArgType, Required) of + ArgType -> yes; + none -> no; + _ -> maybe + end. + +%% +%% Returns the inferred return and argument types for known functions, and +%% whether it's safe to subtract argument types on failure. +%% +%% Note that the return type will be 'none' if we can statically determine that +%% the function will fail at runtime. +%% + +-spec types(Mod, Func, ArgTypes) -> {RetType, ArgTypes, CanSubtract} when + Mod :: atom(), + Func :: atom(), + ArgTypes :: [normal_type()], + RetType :: type(), + CanSubtract :: boolean(). + +%% Functions that only fail due to bad argument *types*, meaning it's safe to +%% subtract argument types on failure. +%% +%% Note that these are all from the erlang module; suitable functions in other +%% modules could fail due to the module not being loaded. +types(erlang, 'map_size', [_]) -> + sub_safe(#t_integer{}, [#t_map{}]); +types(erlang, 'tuple_size', [_]) -> + sub_safe(#t_integer{}, [#t_tuple{}]); +types(erlang, 'bit_size', [_]) -> + sub_safe(#t_integer{}, [#t_bitstring{}]); +types(erlang, 'byte_size', [_]) -> + sub_safe(#t_integer{}, [#t_bitstring{}]); +types(erlang, 'hd', [_]) -> + sub_safe(any, [cons]); +types(erlang, 'tl', [_]) -> + sub_safe(any, [cons]); +types(erlang, 'length', [_]) -> + sub_safe(#t_integer{}, [list]); +types(erlang, 'not', [_]) -> + Bool = beam_types:make_boolean(), + sub_safe(Bool, [Bool]); + +%% Boolean ops +types(erlang, 'and', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); +types(erlang, 'or', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); +types(erlang, 'xor', [_,_]) -> + Bool = beam_types:make_boolean(), + sub_unsafe(Bool, [Bool, Bool]); + +%% Bitwise ops +types(erlang, 'band', [_,_]=Args) -> + sub_unsafe(band_return_type(Args), [#t_integer{}, #t_integer{}]); +types(erlang, 'bor', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bxor', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bsl', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bsr', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'bnot', [_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}]); + +%% Fixed-type arithmetic +types(erlang, 'float', [_]) -> + sub_unsafe(float, [number]); +types(erlang, 'round', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'floor', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'ceil', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, 'trunc', [_]) -> + sub_unsafe(#t_integer{}, [number]); +types(erlang, '/', [_,_]) -> + sub_unsafe(float, [number, number]); +types(erlang, 'div', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); +types(erlang, 'rem', [_,_]) -> + sub_unsafe(#t_integer{}, [#t_integer{}, #t_integer{}]); + +%% Mixed-type arithmetic; '+'/2 and friends are handled in the catch-all +%% clause for the 'erlang' module. +types(erlang, 'abs', [_]=Args) -> + mixed_arith_types(Args); + +%% List operations +types(erlang, '++', [LHS,RHS]) -> + %% `[] ++ RHS` yields RHS, even if RHS is not a list. + RetType = case {LHS, RHS} of + {cons, _} -> cons; + {_, cons} -> cons; + _ -> beam_types:join(list, RHS) + end, + sub_unsafe(RetType, [list, any]); +types(erlang, '--', [_,_]) -> + sub_unsafe(list, [list, list]); + +%% Misc ops. +types(erlang, 'binary_part', [_, _]) -> + PosLen = make_two_tuple(#t_integer{}, #t_integer{}), + Binary = #t_bitstring{unit=8}, + sub_unsafe(Binary, [Binary, PosLen]); +types(erlang, 'binary_part', [_, _, _]) -> + Binary = #t_bitstring{unit=8}, + sub_unsafe(Binary, [Binary, #t_integer{}, #t_integer{}]); +types(erlang, 'is_map_key', [_,_]) -> + sub_unsafe(beam_types:make_boolean(), [any,#t_map{}]); +types(erlang, 'map_get', [_,_]) -> + sub_unsafe(any, [any,#t_map{}]); +types(erlang, 'node', [_]) -> + sub_unsafe(#t_atom{}, [any]); +types(erlang, 'node', []) -> + sub_unsafe(#t_atom{}, []); +types(erlang, 'size', [_]) -> + sub_unsafe(#t_integer{}, [any]); +types(erlang, 'size', [_]) -> + sub_unsafe(#t_integer{}, [any]); + +%% Tuple element ops +types(erlang, element, [PosType, TupleType]) -> + Index = case PosType of + #t_integer{elements={Same,Same}} when is_integer(Same) -> + Same; + _ -> + 0 + end, + + RetType = case TupleType of + #t_tuple{size=Sz,elements=Es} when Index =< Sz, + Index >= 1 -> + beam_types:get_element_type(Index, Es); + _ -> + any + end, + + sub_unsafe(RetType, [#t_integer{}, #t_tuple{size=Index}]); +types(erlang, setelement, [PosType, TupleType, ArgType]) -> + RetType = case {PosType,TupleType} of + {#t_integer{elements={Index,Index}}, + #t_tuple{elements=Es0,size=Size}=T} when Index >= 1 -> + %% This is an exact index, update the type of said + %% element or return 'none' if it's known to be out of + %% bounds. + Es = beam_types:set_element_type(Index, ArgType, Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{size=max(Index, Size),elements=Es}; + true when Index =< Size -> + T#t_tuple{elements=Es}; + true -> + none + end; + {#t_integer{elements={Min,Max}}, + #t_tuple{elements=Es0,size=Size}=T} when Min >= 1 -> + %% We know this will land between Min and Max, so kill + %% the types for those indexes. + Es = discard_tuple_element_info(Min, Max, Es0), + case T#t_tuple.exact of + false -> + T#t_tuple{elements=Es,size=max(Min, Size)}; + true when Min =< Size -> + T#t_tuple{elements=Es,size=Size}; + true -> + none + end; + {_,#t_tuple{}=T} -> + %% Position unknown, so we have to discard all element + %% information. + T#t_tuple{elements=#{}}; + {#t_integer{elements={Min,_Max}},_} -> + #t_tuple{size=Min}; + {_,_} -> + #t_tuple{} + end, + sub_unsafe(RetType, [#t_integer{}, #t_tuple{}, any]); + +types(erlang, make_fun, [_,_,Arity0]) -> + Type = case Arity0 of + #t_integer{elements={Arity,Arity}} when Arity >= 0 -> + #t_fun{arity=Arity}; + _ -> + #t_fun{} + end, + sub_unsafe(Type, [#t_atom{}, #t_atom{}, #t_integer{}]); + +types(erlang, Name, Args) -> + Arity = length(Args), + + case erl_bifs:is_exit_bif(erlang, Name, Arity) of + true -> + {none, Args, false}; + false -> + case erl_internal:arith_op(Name, Arity) of + true -> + mixed_arith_types(Args); + false -> + IsTest = + erl_internal:new_type_test(Name, Arity) orelse + erl_internal:comp_op(Name, Arity), + + RetType = case IsTest of + true -> beam_types:make_boolean(); + false -> any + end, + + sub_unsafe(RetType, duplicate(Arity, any)) + end + end; + +%% +%% Math BIFs +%% + +types(math, cos, [_]) -> + sub_unsafe(float, [number]); +types(math, cosh, [_]) -> + sub_unsafe(float, [number]); +types(math, sin, [_]) -> + sub_unsafe(float, [number]); +types(math, sinh, [_]) -> + sub_unsafe(float, [number]); +types(math, tan, [_]) -> + sub_unsafe(float, [number]); +types(math, tanh, [_]) -> + sub_unsafe(float, [number]); +types(math, acos, [_]) -> + sub_unsafe(float, [number]); +types(math, acosh, [_]) -> + sub_unsafe(float, [number]); +types(math, asin, [_]) -> + sub_unsafe(float, [number]); +types(math, asinh, [_]) -> + sub_unsafe(float, [number]); +types(math, atan, [_]) -> + sub_unsafe(float, [number]); +types(math, atanh, [_]) -> + sub_unsafe(float, [number]); +types(math, erf, [_]) -> + sub_unsafe(float, [number]); +types(math, erfc, [_]) -> + sub_unsafe(float, [number]); +types(math, exp, [_]) -> + sub_unsafe(float, [number]); +types(math, log, [_]) -> + sub_unsafe(float, [number]); +types(math, log2, [_]) -> + sub_unsafe(float, [number]); +types(math, log10, [_]) -> + sub_unsafe(float, [number]); +types(math, sqrt, [_]) -> + sub_unsafe(float, [number]); +types(math, atan2, [_,_]) -> + sub_unsafe(float, [number, number]); +types(math, pow, [_,_]) -> + sub_unsafe(float, [number, number]); +types(math, ceil, [_]) -> + sub_unsafe(float, [number]); +types(math, floor, [_]) -> + sub_unsafe(float, [number]); +types(math, fmod, [_,_]) -> + sub_unsafe(float, [number, number]); +types(math, pi, []) -> + sub_unsafe(float, []); + +%% +%% List functions +%% + +%% Operator aliases. +types(lists, append, [_,_]=Args) -> + types(erlang, '++', Args); +types(lists, append, [_]) -> + %% This is implemented through folding the list over erlang:'++'/2, so it + %% can hypothetically return anything, but we can infer that its argument + %% is a list on success. + sub_unsafe(any, [list]); +types(lists, subtract, [_,_]) -> + sub_unsafe(list, [list, list]); + +%% Functions returning booleans. +types(lists, all, [_,_]) -> + sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, list]); +types(lists, any, [_,_]) -> + sub_unsafe(beam_types:make_boolean(), [#t_fun{arity=1}, list]); +types(lists, keymember, [_,_,_]) -> + sub_unsafe(beam_types:make_boolean(), [any, #t_integer{}, list]); +types(lists, member, [_,_]) -> + sub_unsafe(beam_types:make_boolean(), [any, list]); +types(lists, prefix, [_,_]) -> + sub_unsafe(beam_types:make_boolean(), [list, list]); +types(lists, suffix, [_,_]) -> + sub_unsafe(beam_types:make_boolean(), [list, list]); + +%% Functions returning plain lists. +types(lists, dropwhile, [_,_]) -> + sub_unsafe(list, [#t_fun{arity=1}, list]); +types(lists, duplicate, [_,_]) -> + sub_unsafe(list, [#t_integer{}, any]); +types(lists, filter, [_,_]) -> + sub_unsafe(list, [#t_fun{arity=1}, list]); +types(lists, flatten, [_]) -> + sub_unsafe(list, [list]); +types(lists, map, [_Fun, List]) -> + sub_unsafe(same_length_type(List), [#t_fun{arity=1}, list]); +types(lists, reverse, [List]) -> + sub_unsafe(same_length_type(List), [list]); +types(lists, sort, [List]) -> + sub_unsafe(same_length_type(List), [list]); +types(lists, takewhile, [_,_]) -> + sub_unsafe(list, [#t_fun{arity=1}, list]); +types(lists, usort, [List]) -> + sub_unsafe(same_length_type(List), [list]); +types(lists, zip, [A,B]) -> + ZipType = lists_zip_type([A,B]), + sub_unsafe(ZipType, [ZipType, ZipType]); +types(lists, zip3, [A,B,C]) -> + ZipType = lists_zip_type([A,B,C]), + sub_unsafe(ZipType, [ZipType, ZipType, ZipType]); +types(lists, zipwith, [_,A,B]) -> + ZipType = lists_zip_type([A,B]), + sub_unsafe(ZipType, [#t_fun{arity=2}, ZipType, ZipType]); +types(lists, zipwith3, [_,A,B,C]) -> + ZipType = lists_zip_type([A,B,C]), + sub_unsafe(ZipType, [#t_fun{arity=3}, ZipType, ZipType, ZipType]); + +%% Functions with complex return values. +types(lists, keyfind, [KeyType,PosType,_]) -> + TupleType = case PosType of + #t_integer{elements={Index,Index}} when is_integer(Index), + Index >= 1 -> + Es = beam_types:set_element_type(Index, KeyType, #{}), + #t_tuple{size=Index,elements=Es}; + _ -> + #t_tuple{} + end, + RetType = beam_types:join(TupleType, beam_types:make_atom(false)), + sub_unsafe(RetType, [any, #t_integer{}, list]); +types(lists, MapFold, [_Fun, _Init, List]) + when MapFold =:= mapfoldl; MapFold =:= mapfoldr -> + RetType = make_two_tuple(same_length_type(List), any), + sub_unsafe(RetType, [#t_fun{arity=2}, any, list]); +types(lists, partition, [_,_]) -> + sub_unsafe(make_two_tuple(list, list), [#t_fun{arity=1}, list]); +types(lists, search, [_,_]) -> + TupleType = make_two_tuple(beam_types:make_atom(value), any), + RetType = beam_types:join(TupleType, beam_types:make_atom(false)), + sub_unsafe(RetType, [#t_fun{arity=1}, list]); +types(lists, splitwith, [_,_]) -> + sub_unsafe(make_two_tuple(list, list), [#t_fun{arity=1}, list]); +types(lists, unzip, [List]) -> + ListType = same_length_type(List), + RetType = make_two_tuple(ListType, ListType), + sub_unsafe(RetType, [list]); + +%% Catch-all clause for unknown functions. + +types(_, _, Args) -> + sub_unsafe(any, [any || _ <- Args]). + +%% +%% Helpers +%% + +sub_unsafe(none, ArgTypes) -> + %% This is known to fail at runtime, but the type optimization pass + %% doesn't yet support cutting a block short at any point, so we + %% pretend it's raining instead. + %% + %% Actual exit BIFs get special treatment in the catch-all clause + %% for the 'erlang' module. + sub_unsafe(any, ArgTypes); +sub_unsafe(RetType, ArgTypes) -> + {RetType, ArgTypes, false}. + +sub_safe(RetType, ArgTypes) -> + {RetType, ArgTypes, true}. + +mixed_arith_types([FirstType | _]=Args0) -> + RetType = foldl(fun(#t_integer{}, #t_integer{}) -> #t_integer{}; + (#t_integer{}, number) -> number; + (#t_integer{}, float) -> float; + (float, #t_integer{}) -> float; + (float, number) -> float; + (float, float) -> float; + (number, #t_integer{}) -> number; + (number, float) -> float; + (number, number) -> number; + (any, _) -> number; + (_, _) -> none + end, FirstType, Args0), + sub_unsafe(RetType, [number || _ <- Args0]). + +band_return_type([#t_integer{elements={Int,Int}}, RHS]) when is_integer(Int) -> + band_return_type_1(RHS, Int); +band_return_type([LHS, #t_integer{elements={Int,Int}}]) when is_integer(Int) -> + band_return_type_1(LHS, Int); +band_return_type(_) -> + #t_integer{}. + +band_return_type_1(LHS, Int) -> + case LHS of + #t_integer{elements={Min0,Max0}} when Max0 - Min0 < 1 bsl 256 -> + {Intersection, Union} = range_masks(Min0, Max0), + + Min = Intersection band Int, + Max = min(Max0, Union band Int), + + #t_integer{elements={Min,Max}}; + _ when Int >= 0 -> + %% The range is either unknown or too wide, conservatively assume + %% that the new range is 0 .. Int. + #t_integer{elements={0,Int}}; + _ when Int < 0 -> + %% We can't infer boundaries when the range is unknown and the + %% other operand is a negative number, as the latter sign-extends + %% to infinity and we can't express an inverted range at the + %% moment (cf. X band -8; either less than -7 or greater than 7). + #t_integer{} + end. + +%% Returns two bitmasks describing all possible values between From and To. +%% +%% The first contains the bits that are common to all values, and the second +%% contains the bits that are set by any value in the range. +range_masks(From, To) when From =< To -> + range_masks_1(From, To, 0, -1, 0). + +range_masks_1(From, To, BitPos, Intersection, Union) when From < To -> + range_masks_1(From + (1 bsl BitPos), To, BitPos + 1, + Intersection band From, Union bor From); +range_masks_1(_From, To, _BitPos, Intersection0, Union0) -> + Intersection = To band Intersection0, + Union = To bor Union0, + {Intersection, Union}. + +discard_tuple_element_info(Min, Max, Es) -> + foldl(fun(El, Acc) when Min =< El, El =< Max -> + maps:remove(El, Acc); + (_El, Acc) -> Acc + end, Es, maps:keys(Es)). + +%% For a lists function that return a list of the same length as the input +%% list, return the type of the list. +same_length_type(cons) -> cons; +same_length_type(nil) -> nil; +same_length_type(_) -> list. + +%% lists:zip/2 and friends only succeed when all arguments have the same +%% length, so if one of them is cons, we can infer that all of them are cons +%% on success. +lists_zip_type(Types) -> + foldl(fun(cons, _) -> cons; + (_, cons) -> cons; + (nil, _) -> nil; + (_, T) -> T + end, list, Types). + +make_two_tuple(Type1, Type2) -> + Es0 = beam_types:set_element_type(1, Type1, #{}), + Es = beam_types:set_element_type(2, Type2, Es0), + #t_tuple{size=2,exact=true,elements=Es}. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 7299654476..6b2b2ce085 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -34,7 +34,8 @@ module({Mod,Exp,Attr,Fs0,_}, Opts) -> Used = find_all_used(WorkList, All, cerl_sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs = maybe_remove_lines(Fs2, Opts), + Fs3 = fix_swap(Fs2, Opts), + Fs = maybe_remove_lines(Fs3, Opts), {ok,{Mod,Exp,Attr,Fs,Lc}}. %% Determine the rootset, i.e. exported functions and @@ -137,31 +138,54 @@ function_replace([{function,Name,Arity,Entry,Asm0}|Fs], Dict, Acc) -> function_replace([], _, Acc) -> Acc. %%% +%%% If compatibility with a previous release (OTP 22 or earlier) has +%%% been requested, replace swap instructions with a sequence of moves. +%%% + +fix_swap(Fs, Opts) -> + case proplists:get_bool(no_swap, Opts) of + false -> Fs; + true -> fold_functions(fun swap_moves/1, Fs) + end. + +swap_moves([{swap,Reg1,Reg2}|Is]) -> + Temp = {x,1022}, + [{move,Reg1,Temp},{move,Reg2,Reg1},{move,Temp,Reg2}|swap_moves(Is)]; +swap_moves([I|Is]) -> + [I|swap_moves(Is)]; +swap_moves([]) -> []. + +%%% %%% Remove line instructions if requested. %%% maybe_remove_lines(Fs, Opts) -> case proplists:get_bool(no_line_info, Opts) of false -> Fs; - true -> remove_lines(Fs) + true -> fold_functions(fun remove_lines/1, Fs) end. -remove_lines([{function,N,A,Lbl,Is0}|T]) -> - Is = remove_lines_fun(Is0), - [{function,N,A,Lbl,Is}|remove_lines(T)]; -remove_lines([]) -> []. - -remove_lines_fun([{line,_}|Is]) -> - remove_lines_fun(Is); -remove_lines_fun([{block,Bl0}|Is]) -> +remove_lines([{line,_}|Is]) -> + remove_lines(Is); +remove_lines([{block,Bl0}|Is]) -> Bl = remove_lines_block(Bl0), - [{block,Bl}|remove_lines_fun(Is)]; -remove_lines_fun([I|Is]) -> - [I|remove_lines_fun(Is)]; -remove_lines_fun([]) -> []. + [{block,Bl}|remove_lines(Is)]; +remove_lines([I|Is]) -> + [I|remove_lines(Is)]; +remove_lines([]) -> []. remove_lines_block([{set,_,_,{line,_}}|Is]) -> remove_lines_block(Is); remove_lines_block([I|Is]) -> [I|remove_lines_block(Is)]; remove_lines_block([]) -> []. + + +%%% +%%% Helpers. +%%% + +fold_functions(F, [{function,N,A,Lbl,Is0}|T]) -> + Is = F(Is0), + [{function,N,A,Lbl,Is}|fold_functions(F, T)]; +fold_functions(_F, []) -> []. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index b2056332e6..4d0cec857d 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -40,6 +40,7 @@ -type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}. -type lambda_tab() :: {non_neg_integer(),[lambda_info()]}. +-type wrapper() :: #{label() => index()}. -record(asm, {atoms = #{} :: atom_tab(), @@ -48,6 +49,7 @@ imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool lambdas = {0,[]} :: lambda_tab(), + wrappers = #{} :: wrapper(), literals = dict:new() :: literal_tab(), fnames = #{} :: fname_tab(), lines = #{} :: line_tab(), @@ -147,11 +149,21 @@ string(BinString, Dict) when is_binary(BinString) -> -spec lambda(label(), non_neg_integer(), bdict()) -> {non_neg_integer(), bdict()}. -lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) -> - %% Set Index the same as OldIndex. - Index = OldIndex, - Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], - {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}. +lambda(Lbl, NumFree, #asm{wrappers=Wrappers0, + lambdas={OldIndex,Lambdas0}}=Dict) -> + case Wrappers0 of + #{Lbl:=Index} -> + %% OTP 23: There old is a fun entry for this wrapper function. + %% Share the fun entry. + {Index,Dict}; + #{} -> + %% Set Index the same as OldIndex. + Index = OldIndex, + Wrappers = Wrappers0#{Lbl=>Index}, + Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0], + {OldIndex,Dict#asm{wrappers=Wrappers, + lambdas={OldIndex+1,Lambdas}}} + end. %% Returns the index for a literal (adding it to the literal table if necessary). %% literal(Literal, Dict) -> {Index,Dict'} diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 7d048716e4..45b69d7e95 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1123,6 +1123,13 @@ resolve_inst({put_tuple2,[Dst,{{z,1},{u,_},List0}]},_,_,_) -> {put_tuple2,Dst,{list,List}}; %% +%% OTP 23. +%% +resolve_inst({swap,[_,_]=List},_,_,_) -> + [R1,R2] = resolve_args(List), + {swap,R1,R2}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl deleted file mode 100644 index 2b9c1b0cf5..0000000000 --- a/lib/compiler/src/beam_except.erl +++ /dev/null @@ -1,255 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2011-2018. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(beam_except). --export([module/2]). - -%%% Rewrite certain calls to erlang:error/{1,2} to specialized -%%% instructions: -%%% -%%% erlang:error({badmatch,Value}) => badmatch Value -%%% erlang:error({case_clause,Value}) => case_end Value -%%% erlang:error({try_clause,Value}) => try_case_end Value -%%% erlang:error(if_clause) => if_end -%%% erlang:error(function_clause, Args) => jump FuncInfoLabel -%%% - --import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]). - --spec module(beam_utils:module_code(), [compile:option()]) -> - {'ok',beam_utils:module_code()}. - -module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> - Fs = [function(F) || F <- Fs0], - {ok,{Mod,Exp,Attr,Fs,Lc}}. - -function({function,Name,Arity,CLabel,Is0}) -> - try - Is = function_1(Is0), - {function,Name,Arity,CLabel,Is} - catch - Class:Error:Stack -> - io:fwrite("Function: ~w/~w\n", [Name,Arity]), - erlang:raise(Class, Error, Stack) - end. - --record(st, - {lbl :: beam_asm:label(), %func_info label - loc :: [_], %location for func_info - arity :: arity() %arity for function - }). - -function_1(Is0) -> - case Is0 of - [{label,Lbl},{line,Loc},{func_info,_,_,Arity}|_] -> - St = #st{lbl=Lbl,loc=Loc,arity=Arity}, - translate(Is0, St, []); - [{label,_}|_] -> - %% No line numbers. The source must be a .S file. - %% There is no need to do anything. - Is0 - end. - -translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> - translate_1(Ar, I, Is, St, Acc); -translate([I|Is], St, Acc) -> - translate(Is, St, [I|Acc]); -translate([], _, Acc) -> - reverse(Acc). - -translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> - case dig_out(Ar, Arity, Acc1) of - no -> - translate(Is, St, [I|Acc0]); - {yes,function_clause,Acc2} -> - case {Is,Line,St} of - {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} -> - Instr = {jump,{f,Fi}}, - translate(Is, St, [Instr|Acc2]); - {_,_,_} -> - %% Not a call_only instruction, or not the same - %% location information as in in the line instruction - %% before the func_info instruction. Not safe - %% to translate to a jump. - translate(Is, St, [I|Acc0]) - end; - {yes,Instr,Acc2} -> - translate(Is, St, [Instr,Line|Acc2]) - end. - -dig_out(1, _Arity, Is) -> - dig_out(Is); -dig_out(2, Arity, Is) -> - dig_out_fc(Arity, Is); -dig_out(_, _, _) -> no. - -dig_out([{block,Bl0}|Is]) -> - case dig_out_block(reverse(Bl0)) of - no -> no; - {yes,What,[]} -> - {yes,What,Is}; - {yes,What,Bl} -> - {yes,What,[{block,Bl}|Is]} - end; -dig_out(_) -> no. - -dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> - {yes,if_end,[]}; -dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> - translate_exception(Exc, {literal,Value}, Is, 0); -dig_out_block([{set,[{x,0}],[{atom,Exc},Value],put_tuple2}|Is]) -> - translate_exception(Exc, Value, Is, 3); -dig_out_block(_) -> no. - -translate_exception(badmatch, Val, Is, Words) -> - {yes,{badmatch,Val},fix_block(Is, Words)}; -translate_exception(case_clause, Val, Is, Words) -> - {yes,{case_end,Val},fix_block(Is, Words)}; -translate_exception(try_clause, Val, Is, Words) -> - {yes,{try_case_end,Val},fix_block(Is, Words)}; -translate_exception(_, _, _, _) -> no. - -fix_block(Is, 0) -> - reverse(Is); -fix_block(Is, Words) -> - reverse(fix_block_1(Is, Words)). - -fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) -> - case Needed0 - Words of - 0 -> - Is; - Needed -> - true = Needed >= 0, %Assertion. - [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] - end; -fix_block_1([I|Is], Words) -> - [I|fix_block_1(Is, Words)]; -fix_block_1([], _Words) -> - %% Rare. The heap allocation was probably done by a binary - %% construction instruction. - []. - -dig_out_fc(Arity, Is0) -> - Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]), - {Is,Acc0} = splitwith(fun({label,_}) -> false; - ({test,_,_,_}) -> false; - (_) -> true - end, Is0), - {Regs,Acc} = dig_out_fc_1(reverse(Is), Arity, Regs0, Acc0), - case Regs of - #{{x,0}:={atom,function_clause},{x,1}:=Args} -> - case moves_from_stack(Args, 0, []) of - {Moves,Arity} -> - {yes,function_clause,reverse(Moves, Acc)}; - {_,_} -> - no - end; - #{} -> - no - end. - -dig_out_fc_1([{block,Bl}|Is], Arity, Regs0, Acc) -> - Regs = dig_out_fc_block(Bl, Regs0), - dig_out_fc_1(Is, Arity, Regs, Acc); -dig_out_fc_1([{bs_set_position,_,_}=I|Is], Arity, Regs, Acc) -> - dig_out_fc_1(Is, Arity, Regs, [I|Acc]); -dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Arity, Regs0, Acc) -> - case Src of - {x,X} when X < Arity -> - %% The heuristic for determining the number of live - %% registers is likely to give an incorrect result. - %% Give up. - {#{},[]}; - _ -> - Regs = prune_xregs(Live0, Regs0), - Live = dig_out_stack_live(Regs, Live0), - I = {bs_get_tail,Src,Dst,Live}, - dig_out_fc_1(Is, Arity, Regs, [I|Acc]) - end; -dig_out_fc_1([_|_], _Arity, _Regs, _Acc) -> - {#{},[]}; -dig_out_fc_1([], _Arity, Regs, Acc) -> - {Regs,Acc}. - -dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) -> - Regs = prune_xregs(Live, Regs0), - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> - Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) -> - Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, - dig_out_fc_block(Is, Regs); -dig_out_fc_block([{set,_,_,_}|_], _Regs) -> - %% Unknown instruction. Fail. - #{}; -dig_out_fc_block([], Regs) -> Regs. - -dig_out_stack_live(Regs, Default) -> - Reg = {x,2}, - case Regs of - #{Reg:=List} -> - dig_out_stack_live_1(List, Default); - #{} -> - Default - end. - -dig_out_stack_live_1({cons,{arg,N},T}, Live) -> - dig_out_stack_live_1(T, max(N + 1, Live)); -dig_out_stack_live_1({cons,_,T}, Live) -> - dig_out_stack_live_1(T, Live); -dig_out_stack_live_1(nil, Live) -> - Live; -dig_out_stack_live_1(_, Live) -> Live. - -prune_xregs(Live, Regs) -> - maps:filter(fun({x,X}, _) -> X < Live end, Regs). - -moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I -> - %% Wrong argument. Give up. - {[],-1}; -moves_from_stack({cons,H,T}, I, Acc) -> - case H of - {arg,I} -> - moves_from_stack(T, I+1, Acc); - _ -> - moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc]) - end; -moves_from_stack(nil, I, Acc) -> - {reverse(Acc),I}; -moves_from_stack({literal,[H|T]}, I, Acc) -> - Cons = {cons,tag_literal(H),tag_literal(T)}, - moves_from_stack(Cons, I, Acc); -moves_from_stack(_, _, _) -> - %% Not understood. Give up. - {[],-1}. - - -get_reg(R, Regs) -> - case Regs of - #{R:=Val} -> Val; - #{} -> R - end. - -tag_literal([]) -> nil; -tag_literal(T) when is_atom(T) -> {atom,T}; -tag_literal(T) when is_float(T) -> {float,T}; -tag_literal(T) when is_integer(T) -> {integer,T}; -tag_literal(T) -> {literal,T}. diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl index df95749fb3..2406a634e6 100644 --- a/lib/compiler/src/beam_kernel_to_ssa.erl +++ b/lib/compiler/src/beam_kernel_to_ssa.erl @@ -34,7 +34,7 @@ -type label() :: beam_ssa:label(). %% Main codegen structure. --record(cg, {lcount=1 :: label(), %Label counter +-record(cg, {lcount=1 :: label(), %Label counter bfail=1 :: label(), catch_label=none :: 'none' | label(), vars=#{} :: map(), %Defined variables. @@ -83,6 +83,7 @@ function(#k_fdef{anno=Anno0,func=Name,arity=Arity, cg_fun(Ke, St0) -> {UltimateFail,FailIs,St1} = make_failure(badarg, St0), + ?EXCEPTION_BLOCK = UltimateFail, %Assertion. St2 = St1#cg{bfail=UltimateFail,ultimate_failure=UltimateFail}, {B,St} = cg(Ke, St2), Asm = [{label,0}|B++FailIs], @@ -279,7 +280,7 @@ select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ctx0}},body=B}, #k_var{}=Src, Tf, Vf, St0) -> {Ctx,St1} = new_ssa_var(Ctx0, St0), {Bis0,St2} = match_cg(B, Vf, St1), - {TestIs,St} = make_cond_branch(succeeded, [Ctx], Tf, St2), + {TestIs,St} = make_succeeded(Ctx, {guard, Tf}, St2), Bis1 = [#b_set{op=bs_start_match,dst=Ctx, args=[ssa_arg(Src, St)]}] ++ TestIs ++ Bis0, Bis = finish_bs_matching(Bis1), @@ -311,6 +312,35 @@ make_cond_branch(Cond, Args, Fail, St0) -> make_uncond_branch(Fail) -> #b_br{bool=#b_literal{val=true},succ=Fail,fail=Fail}. +%% +%% The 'succeeded' instruction needs special treatment in catch blocks to +%% prevent the checked operation from being optimized away if a later pass +%% determines that it always fails. +%% + +make_succeeded(Var, {in_catch, CatchLbl}, St0) -> + {Bool, St1} = new_ssa_var('@ssa_bool', St0), + {Succ, St2} = new_label(St1), + {Fail, St} = new_label(St2), + + Check = [#b_set{op=succeeded,dst=Bool,args=[Var]}, + #b_br{bool=Bool,succ=Succ,fail=Fail}], + + %% Add a dummy block that references the checked variable, ensuring it + %% stays alive and that it won't be merged with the landing pad. + Trampoline = [{label,Fail}, + #b_set{op=exception_trampoline,args=[Var]}, + make_uncond_branch(CatchLbl)], + + {Check ++ Trampoline ++ [{label,Succ}], St}; +make_succeeded(Var, {no_catch, Fail}, St) -> + %% Ultimate failure raises an exception, so we must treat it as if it were + %% in a catch to keep it from being optimized out. + #cg{ultimate_failure=Fail} = St, %Assertion + make_succeeded(Var, {in_catch, Fail}, St); +make_succeeded(Var, {guard, Fail}, St) -> + make_cond_branch(succeeded, [Var], Fail, St). + %% Instructions for selection of binary segments. select_bin_segs(Scs, Ivar, Tf, St) -> @@ -394,7 +424,7 @@ select_extract_int(#k_var{name=Tl}, Val, #k_int{val=Sz}, U, Fs, Vf, <<Val:Bits/little>> end, Bits = bit_size(Bin), %Assertion. - {TestIs,St} = make_cond_branch(succeeded, [Dst], Vf, St1), + {TestIs,St} = make_succeeded(Dst, {guard, Vf}, St1), Set = #b_set{op=bs_match,dst=Dst, args=[#b_literal{val=string},Ctx,#b_literal{val=Bin}]}, {[Set|TestIs],St}. @@ -412,7 +442,7 @@ build_bs_instr(Anno, Type, Fail, Ctx, Size, Unit0, Flags0, Dst, St0) -> #b_set{anno=Anno,op=bs_match,dst=Dst, args=[TypeArg,Ctx,Flags]} end, - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + {Is,St} = make_succeeded(Dst, {guard, Fail}, St0), {[Get|Is],St}. select_val(#k_val_clause{val=#k_tuple{es=Es},body=B}, V, Vf, St0) -> @@ -475,7 +505,7 @@ select_extract_map([P|Ps], Src, Fail, St0) -> Key = ssa_arg(Key0, St0), {Dst,St1} = new_ssa_var(Dst0, St0), Set = #b_set{op=get_map_element,dst=Dst,args=[MapSrc,Key]}, - {TestIs,St2} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St2} = make_succeeded(Dst, {guard, Fail}, St1), {Is,St} = select_extract_map(Ps, Src, Fail, St2), {[Set|TestIs]++Is,St}; select_extract_map([], _, _, St) -> @@ -596,7 +626,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> {Rs,St3} = match_fmf(F, LastFail, St2, T), {R ++ [{label,Fail}] ++ Rs,St3}. -%% fail_label(State) -> {Where,FailureLabel}. +%% fail_context(State) -> {Where,FailureLabel}. %% Where = guard | no_catch | in_catch %% Return an indication of which part of a function code is %% being generated for and the appropriate failure label to @@ -609,7 +639,7 @@ match_fmf(F, LastFail, St0, [H|T]) -> %% a try/catch or catch. %% in_catch - In the scope of a try/catch or catch. -fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> +fail_context(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> if Fail =/= Ult -> {guard,Fail}; @@ -619,14 +649,6 @@ fail_label(#cg{catch_label=Catch,bfail=Fail,ultimate_failure=Ult}) -> {in_catch,Catch} end. -%% bif_fail_label(State) -> FailureLabel. -%% Return the appropriate failure label for a guard BIF call or -%% primop that fails. - -bif_fail_label(St) -> - {_,Fail} = fail_label(St), - Fail. - %% call_cg(Func, [Arg], [Ret], Le, State) -> %% {[Ainstr],State}. %% enter_cg(Func, [Arg], Le, St) -> {[Ainstr],St}. @@ -635,7 +657,7 @@ bif_fail_label(St) -> call_cg(Func, As, [], Le, St) -> call_cg(Func, As, [#k_var{name='@ssa_ignored'}], Le, St); call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> - case fail_label(St0) of + case fail_context(St0) of {guard,Fail} -> %% Inside a guard. The only allowed function call is to %% erlang:error/1,2. We will generate a branch to the @@ -645,7 +667,7 @@ call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> [#k_var{name=DestVar}] = Rs, St = set_ssa_var(DestVar, #b_literal{val=unused}, St0), {[make_uncond_branch(Fail),#cg_unreachable{}],St}; - {Catch,Fail} -> + FailCtx -> %% Ordinary function call in a function body. Args = ssa_args(As, St0), {Ret,St1} = new_ssa_var(R, St0), @@ -657,13 +679,9 @@ call_cg(Func0, As, [#k_var{name=R}|MoreRs]=Rs, Le, St0) -> St2 = foldl(fun(#k_var{name=Dummy}, S) -> set_ssa_var(Dummy, #b_literal{val=unused}, S) end, St1, MoreRs), - case Catch of - no_catch -> - {[Call],St2}; - in_catch -> - {TestIs,St} = make_cond_branch(succeeded, [Ret], Fail, St2), - {[Call|TestIs],St} - end + + {TestIs,St} = make_succeeded(Ret, FailCtx, St2), + {[Call|TestIs],St} end. enter_cg(Func0, As0, Le, St0) -> @@ -748,8 +766,8 @@ bif_cg(Bif, As0, [#k_var{name=Dst0}], Le, St0) -> I = #b_set{anno=line_anno(Le),op={bif,Bif},dst=Dst,args=As}, case erl_bifs:is_safe(erlang, Bif, length(As)) of false -> - Fail = bif_fail_label(St1), - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + FailCtx = fail_context(St1), + {Is,St} = make_succeeded(Dst, FailCtx, St1), {[I|Is],St}; true-> {[I],St1} @@ -797,7 +815,7 @@ cg_recv_mesg(#k_var{name=R}, Rm, Tl, Le, St0) -> {Dst,St1} = new_ssa_var(R, St0), {Mis,St2} = match_cg(Rm, none, St1), RecvLbl = St1#cg.recv, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Tl, St2), + {TestIs,St} = make_succeeded(Dst, {guard, Tl}, St2), Is = [#b_br{anno=line_anno(Le),bool=#b_literal{val=true}, succ=RecvLbl,fail=RecvLbl}, {label,RecvLbl}, @@ -813,7 +831,7 @@ cg_recv_wait(Te, Es, St0) -> {Tis,St1} = cg(Es, St0), Args = [ssa_arg(Te, St1)], {WaitDst,St2} = new_ssa_var('@ssa_wait', St1), - {WaitIs,St} = make_cond_branch(succeeded, [WaitDst], St1#cg.recv, St2), + {WaitIs,St} = make_succeeded(WaitDst, {guard, St1#cg.recv}, St2), %% Infinite timeout will be optimized later. Is = [#b_set{op=wait_timeout,dst=WaitDst,args=Args}] ++ WaitIs ++ [#b_set{op=timeout}] ++ Tis, @@ -924,9 +942,9 @@ put_cg([#k_var{name=R}], #k_tuple{es=Es}, _Le, St0) -> PutTuple = #b_set{op=put_tuple,dst=Ret,args=Args}, {[PutTuple],St}; put_cg([#k_var{name=R}], #k_binary{segs=Segs}, Le, St0) -> - Fail = bif_fail_label(St0), + FailCtx = fail_context(St0), {Dst,St1} = new_ssa_var(R, St0), - cg_binary(Dst, Segs, Fail, Le, St1); + cg_binary(Dst, Segs, FailCtx, Le, St1); put_cg([#k_var{name=R}], #k_map{op=Op,var=Map, es=[#k_map_pair{key=#k_var{}=K,val=V}]}, Le, St0) -> @@ -955,14 +973,14 @@ put_cg([#k_var{name=R}], Con0, _Le, St0) -> {[],St}. put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> - Fail = bif_fail_label(St0), Args = [#b_literal{val=Op},SrcMap|List], PutMap = #b_set{anno=LineAnno,op=put_map,dst=Dst,args=Args}, if Op =:= assoc -> {[PutMap],St0}; true -> - {Is,St} = make_cond_branch(succeeded, [Dst], Fail, St0), + FailCtx = fail_context(St0), + {Is,St} = make_succeeded(Dst, FailCtx, St0), {[PutMap|Is],St} end. @@ -970,8 +988,8 @@ put_cg_map(LineAnno, Op, SrcMap, Dst, List, St0) -> %%% Code generation for constructing binaries. %%% -cg_binary(Dst, Segs0, Fail, Le, St0) -> - {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, Fail, St0), +cg_binary(Dst, Segs0, FailCtx, Le, St0) -> + {PutCode0,SzCalc0,St1} = cg_bin_put(Segs0, FailCtx, St0), LineAnno = line_anno(Le), Anno = Le#k.a, case PutCode0 of @@ -980,8 +998,8 @@ cg_binary(Dst, Segs0, Fail, Le, St0) -> {label,_}|_] -> #k_bin_seg{unit=Unit0,next=Segs} = Segs0, Unit = #b_literal{val=Unit0}, - {PutCode,SzCalc1,St2} = cg_bin_put(Segs, Fail, St1), - {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, Fail, St2), + {PutCode,SzCalc1,St2} = cg_bin_put(Segs, FailCtx, St1), + {_,SzVar,SzCode0,St3} = cg_size_calc(1, SzCalc1, FailCtx, St2), SzCode = cg_bin_anno(SzCode0, LineAnno), Args = case member(single_use, Anno) of true -> @@ -990,14 +1008,14 @@ cg_binary(Dst, Segs0, Fail, Le, St0) -> [#b_literal{val=append},Src,SzVar,Unit] end, BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St3), + {TestIs,St} = make_succeeded(Dst, FailCtx, St3), {SzCode ++ [BsInit] ++ TestIs ++ PutCode,St}; [#b_set{op=bs_put}|_] -> - {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, Fail, St1), + {Unit,SzVar,SzCode0,St2} = cg_size_calc(8, SzCalc0, FailCtx, St1), SzCode = cg_bin_anno(SzCode0, LineAnno), Args = [#b_literal{val=new},SzVar,Unit], BsInit = #b_set{anno=LineAnno,op=bs_init,dst=Dst,args=Args}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St2), + {TestIs,St} = make_succeeded(Dst, FailCtx, St2), {SzCode ++ [BsInit] ++ TestIs ++ PutCode0,St} end. @@ -1005,18 +1023,18 @@ cg_bin_anno([Set|Sets], Anno) -> [Set#b_set{anno=Anno}|Sets]; cg_bin_anno([], _) -> []. -%% cg_size_calc(PreferredUnit, SzCalc, Fail, St0) -> +%% cg_size_calc(PreferredUnit, SzCalc, FailCtx, St0) -> %% {ActualUnit,SizeVariable,SizeCode,St}. %% Generate size calculation code. -cg_size_calc(Unit, error, _Fail, St) -> +cg_size_calc(Unit, error, _FailCtx, St) -> {#b_literal{val=Unit},#b_literal{val=badarg},[],St}; -cg_size_calc(8, [{1,_}|_]=SzCalc, Fail, St) -> - cg_size_calc(1, SzCalc, Fail, St); -cg_size_calc(8, SzCalc, Fail, St0) -> - {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), +cg_size_calc(8, [{1,_}|_]=SzCalc, FailCtx, St) -> + cg_size_calc(1, SzCalc, FailCtx, St); +cg_size_calc(8, SzCalc, FailCtx, St0) -> + {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, St0), {#b_literal{val=8},Var,Pre,St}; -cg_size_calc(1, SzCalc0, Fail, St0) -> +cg_size_calc(1, SzCalc0, FailCtx, St0) -> SzCalc = map(fun({8,#b_literal{val=Size}}) -> {1,#b_literal{val=8*Size}}; ({8,{{bif,byte_size},Src}}) -> @@ -1026,54 +1044,54 @@ cg_size_calc(1, SzCalc0, Fail, St0) -> ({_,_}=Pair) -> Pair end, SzCalc0), - {Var,Pre,St} = cg_size_calc_1(SzCalc, Fail, St0), + {Var,Pre,St} = cg_size_calc_1(SzCalc, FailCtx, St0), {#b_literal{val=1},Var,Pre,St}. -cg_size_calc_1(SzCalc, Fail, St0) -> - cg_size_calc_2(SzCalc, #b_literal{val=0}, Fail, St0). +cg_size_calc_1(SzCalc, FailCtx, St0) -> + cg_size_calc_2(SzCalc, #b_literal{val=0}, FailCtx, St0). -cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), - {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, Fail, St2), +cg_size_calc_2([{_,{'*',Unit,{_,_}=Bif}}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, Unit, FailCtx, St2), {Sum,Pre0++Pre1++Pre2,St}; -cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), +cg_size_calc_2([{_,#b_literal{}=Sz}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, St1), {Sum,Pre0++Pre,St}; -cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, Fail, St1), +cg_size_calc_2([{_,#b_var{}=Sz}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {Sum,Pre,St} = cg_size_add(Sum1, Sz, #b_literal{val=1}, FailCtx, St1), {Sum,Pre0++Pre,St}; -cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, Fail, St0) -> - {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, Fail, St0), - {BifDst,Pre1,St2} = cg_size_bif(Bif, Fail, St1), - {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, Fail, St2), +cg_size_calc_2([{_,{_,_}=Bif}|T], Sum0, FailCtx, St0) -> + {Sum1,Pre0,St1} = cg_size_calc_2(T, Sum0, FailCtx, St0), + {BifDst,Pre1,St2} = cg_size_bif(Bif, FailCtx, St1), + {Sum,Pre2,St} = cg_size_add(Sum1, BifDst, #b_literal{val=1}, FailCtx, St2), {Sum,Pre0++Pre1++Pre2,St}; -cg_size_calc_2([], Sum, _Fail, St) -> +cg_size_calc_2([], Sum, _FailCtx, St) -> {Sum,[],St}. -cg_size_bif(#b_var{}=Var, _Fail, St) -> +cg_size_bif(#b_var{}=Var, _FailCtx, St) -> {Var,[],St}; -cg_size_bif({Name,Src}, Fail, St0) -> +cg_size_bif({Name,Src}, FailCtx, St0) -> {Dst,St1} = new_ssa_var('@ssa_bif', St0), Bif = #b_set{op=Name,dst=Dst,args=[Src]}, - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St} = make_succeeded(Dst, FailCtx, St1), {Dst,[Bif|TestIs],St}. -cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _Fail, St) -> +cg_size_add(#b_literal{val=0}, Val, #b_literal{val=1}, _FailCtx, St) -> {Val,[],St}; -cg_size_add(A, B, Unit, Fail, St0) -> +cg_size_add(A, B, Unit, FailCtx, St0) -> {Dst,St1} = new_ssa_var('@ssa_sum', St0), - {TestIs,St} = make_cond_branch(succeeded, [Dst], Fail, St1), + {TestIs,St} = make_succeeded(Dst, FailCtx, St1), BsAdd = #b_set{op=bs_add,dst=Dst,args=[A,B,Unit]}, {Dst,[BsAdd|TestIs],St}. -cg_bin_put(Seg, Fail, St) -> - cg_bin_put_1(Seg, Fail, [], [], St). +cg_bin_put(Seg, FailCtx, St) -> + cg_bin_put_1(Seg, FailCtx, [], [], St). cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, - Fail, Acc, SzCalcAcc, St0) -> + FailCtx, Acc, SzCalcAcc, St0) -> [Src,Size] = ssa_args([Src0,Size0], St0), NeedSize = bs_need_size(T), TypeArg = #b_literal{val=T}, @@ -1083,9 +1101,12 @@ cg_bin_put_1(#k_bin_seg{size=Size0,unit=U,type=T,flags=Fs,seg=Src0,next=Next}, true -> [TypeArg,Flags,Src,Size,Unit]; false -> [TypeArg,Flags,Src] end, - {Is,St} = make_cond_branch(bs_put, Args, Fail, St0), + %% bs_put has its own 'succeeded' logic, and should always jump directly to + %% the fail label regardless of whether it's in a catch or not. + {_, FailLbl} = FailCtx, + {Is,St} = make_cond_branch(bs_put, Args, FailLbl, St0), SzCalc = bin_size_calc(T, Src, Size, U), - cg_bin_put_1(Next, Fail, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); + cg_bin_put_1(Next, FailCtx, reverse(Is, Acc), [SzCalc|SzCalcAcc], St); cg_bin_put_1(#k_bin_end{}, _, Acc, SzCalcAcc, St) -> SzCalc = fold_size_calc(SzCalcAcc, 0, []), {reverse(Acc),SzCalc,St}. diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl index 6492d1e1bf..77619368c7 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -21,7 +21,7 @@ -module(beam_ssa). -export([add_anno/3,get_anno/2,get_anno/3, - clobbers_xregs/1,def/2,def_used/2, + clobbers_xregs/1,def/2,def_unused/3, definitions/1, dominators/1,common_dominators/3, flatmapfold_instrs_rpo/4, @@ -79,7 +79,7 @@ -type var_base() :: atom() | non_neg_integer(). -type literal_value() :: atom() | integer() | float() | list() | - nil() | tuple() | map() | binary(). + nil() | tuple() | map() | binary() | fun(). -type op() :: {'bif',atom()} | {'float',float_op()} | prim_op() | cg_prim_op(). -type anno() :: #{atom() := any()}. @@ -101,7 +101,7 @@ 'bs_match' | 'bs_put' | 'bs_start_match' | 'bs_test_tail' | 'bs_utf16_size' | 'bs_utf8_size' | 'build_stacktrace' | 'call' | 'catch_end' | - 'extract' | + 'extract' | 'exception_trampoline' | 'get_hd' | 'get_map_element' | 'get_tl' | 'get_tuple_element' | 'has_map_field' | 'is_nonempty_list' | 'is_tagged_tuple' | @@ -120,10 +120,11 @@ %% Primops only used internally during code generation. -type cg_prim_op() :: 'bs_get' | 'bs_get_position' | 'bs_match_string' | 'bs_restore' | 'bs_save' | 'bs_set_position' | 'bs_skip' | - 'copy' | 'put_tuple_arity' | 'put_tuple_element' | - 'put_tuple_elements' | 'set_tuple_element'. + 'copy' | 'match_fail' | 'put_tuple_arity' | + 'put_tuple_element' | 'put_tuple_elements' | + 'set_tuple_element'. --import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1,umerge/1]). +-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1]). -spec add_anno(Key, Value, Construct) -> Construct when Key :: atom(), @@ -319,17 +320,18 @@ def(Ls, Blocks) -> Blks = [map_get(L, Blocks) || L <- Top], def_1(Blks, []). --spec def_used(Ls, Blocks) -> {Def,Used} when +-spec def_unused(Ls, Used, Blocks) -> {Def,Unused} when Ls :: [label()], + Used :: ordsets:ordset(var_name()), Blocks :: block_map(), Def :: ordsets:ordset(var_name()), - Used :: ordsets:ordset(var_name()). + Unused :: ordsets:ordset(var_name()). -def_used(Ls, Blocks) -> +def_unused(Ls, Unused, Blocks) -> Top = rpo(Ls, Blocks), Blks = [map_get(L, Blocks) || L <- Top], Preds = cerl_sets:from_list(Top), - def_used_1(Blks, Preds, [], []). + def_unused_1(Blks, Preds, [], Unused). %% dominators(BlockMap) -> {Dominators,Numbering}. %% Calculate the dominator tree, returning a map where each entry @@ -651,34 +653,28 @@ is_commutative('=/=') -> true; is_commutative('/=') -> true; is_commutative(_) -> false. -def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, UsedAcc) -> - {Def,Used} = def_used_is(Is, Preds, Def0, used(Last)), - case Used of - [] -> - def_used_1(Bs, Preds, Def, UsedAcc); - [_|_] -> - def_used_1(Bs, Preds, Def, [Used|UsedAcc]) - end; -def_used_1([], _Preds, Def0, UsedAcc) -> - Def = ordsets:from_list(Def0), - Used = umerge(UsedAcc), - {Def,Used}. +def_unused_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, Unused0) -> + Unused1 = ordsets:subtract(Unused0, used(Last)), + {Def,Unused} = def_unused_is(Is, Preds, Def0, Unused1), + def_unused_1(Bs, Preds, Def, Unused); +def_unused_1([], _Preds, Def, Unused) -> + {ordsets:from_list(Def), Unused}. -def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is], - Preds, Def0, Used0) -> +def_unused_is([#b_set{op=phi,dst=Dst,args=Args}|Is], + Preds, Def0, Unused0) -> Def = [Dst|Def0], %% We must be careful to only include variables that will %% be used when arriving from one of the predecessor blocks %% in Preds. - Used1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], - Used = ordsets:union(ordsets:from_list(Used1), Used0), - def_used_is(Is, Preds, Def, Used); -def_used_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Used0) -> + Unused1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)], + Unused = ordsets:subtract(Unused0, ordsets:from_list(Unused1)), + def_unused_is(Is, Preds, Def, Unused); +def_unused_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Unused0) -> Def = [Dst|Def0], - Used = ordsets:union(used(I), Used0), - def_used_is(Is, Preds, Def, Used); -def_used_is([], _Preds, Def, Used) -> - {Def,Used}. + Unused = ordsets:subtract(Unused0, used(I)), + def_unused_is(Is, Preds, Def, Unused); +def_unused_is([], _Preds, Def, Unused) -> + {Def,Unused}. def_1([#b_blk{is=Is}|Bs], Def0) -> Def = def_is(Is, Def0), diff --git a/lib/compiler/src/beam_ssa.hrl b/lib/compiler/src/beam_ssa.hrl index fa76b08453..509a94135e 100644 --- a/lib/compiler/src/beam_ssa.hrl +++ b/lib/compiler/src/beam_ssa.hrl @@ -62,5 +62,13 @@ -record(b_local, {name :: beam_ssa:b_literal(), arity :: non_neg_integer()}). -%% If this block exists, it calls erlang:error(badarg). --define(BADARG_BLOCK, 1). +%% This is a psuedo-block used to express that certain instructions and BIFs +%% throw exceptions on failure. The code generator rewrites all branches to +%% this block to {f,0} which causes the instruction to throw an exception +%% instead of branching. +%% +%% Since this is not an ordinary block, it's illegal to merge it with other +%% blocks, and jumps are only valid when we know that an exception will be +%% thrown by the operation that branches here; the *block itself* does not +%% throw an exception. +-define(EXCEPTION_BLOCK, 1). diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl index 1ac9e6a3bb..7a8dc127d7 100644 --- a/lib/compiler/src/beam_ssa_bsm.erl +++ b/lib/compiler/src/beam_ssa_bsm.erl @@ -57,6 +57,7 @@ -export([module/2, format_error/1]). -include("beam_ssa.hrl"). +-include("beam_types.hrl"). -import(lists, [member/2, reverse/1, splitwith/2, map/2, foldl/3, mapfoldl/3, nth/2, max/1, unzip/1]). @@ -683,9 +684,9 @@ aca_copy_successors(Lbl0, Blocks0, Counter0) -> Lbl = maps:get(Lbl0, BRs), {Lbl, Blocks, Counter}. -aca_cs_build_brs([?BADARG_BLOCK=Lbl | Path], Counter, Acc) -> - %% ?BADARG_BLOCK is a marker and not an actual block, so renaming it will - %% break exception handling. +aca_cs_build_brs([?EXCEPTION_BLOCK=Lbl | Path], Counter, Acc) -> + %% ?EXCEPTION_BLOCK is a marker and not an actual block, so renaming it + %% will break exception handling. aca_cs_build_brs(Path, Counter, Acc#{ Lbl => Lbl }); aca_cs_build_brs([Lbl | Path], Counter0, Acc) -> aca_cs_build_brs(Path, Counter0 + 1, Acc#{ Lbl => Counter0 }); @@ -883,8 +884,7 @@ annotate_context_parameters(F, ModInfo) -> %% Assertion. error(conflicting_parameter_types); (K, suitable_for_reuse, Acc) -> - T = beam_validator:type_anno(match_context), - Acc#{ K => T }; + Acc#{ K => #t_bs_context{} }; (_K, _V, Acc) -> Acc end, TypeAnno0, ParamInfo), diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl index 08641e2abc..ff880c6296 100644 --- a/lib/compiler/src/beam_ssa_codegen.erl +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -28,7 +28,7 @@ -include("beam_ssa.hrl"). --import(lists, [foldl/3,keymember/3,keysort/2,last/1,map/2,mapfoldl/3, +-import(lists, [foldl/3,keymember/3,keysort/2,map/2,mapfoldl/3, reverse/1,reverse/2,sort/1,splitwith/2,takewhile/2]). -record(cg, {lcount=1 :: beam_label(), %Label counter @@ -37,7 +37,8 @@ used_labels=gb_sets:empty() :: gb_sets:set(ssa_label()), regs=#{} :: #{beam_ssa:var_name()=>ssa_register()}, ultimate_fail=1 :: beam_label(), - catches=gb_sets:empty() :: gb_sets:set(ssa_label()) + catches=gb_sets:empty() :: gb_sets:set(ssa_label()), + fc_label=1 :: beam_label() }). -spec module(beam_ssa:b_module(), [compile:option()]) -> @@ -114,17 +115,17 @@ functions(Forms, AtomMod) -> function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> #{func_info:={_,Name,Arity}} = Anno, try - assert_badarg_block(Blocks), %Assertion. + assert_exception_block(Blocks), %Assertion. Regs = maps:get(registers, Anno), St1 = St0#cg{labels=#{},used_labels=gb_sets:empty(), regs=Regs}, {Fi,St2} = new_label(St1), %FuncInfo label {Entry,St3} = local_func_label(Name, Arity, St2), {Ult,St4} = new_label(St3), %Ultimate failure - Labels = (St4#cg.labels)#{0=>Entry,?BADARG_BLOCK=>0}, + Labels = (St4#cg.labels)#{0=>Entry,?EXCEPTION_BLOCK=>0}, St5 = St4#cg{labels=Labels,used_labels=gb_sets:singleton(Entry), ultimate_fail=Ult}, - {Body,St} = cg_fun(Blocks, St5), + {Body,St} = cg_fun(Blocks, St5#cg{fc_label=Fi}), Asm = [{label,Fi},line(Anno), {func_info,AtomMod,{atom,Name},Arity}] ++ add_parameter_annos(Body, Anno) ++ @@ -137,10 +138,10 @@ function(#b_function{anno=Anno,bs=Blocks}, AtomMod, St0) -> erlang:raise(Class, Error, Stack) end. -assert_badarg_block(Blocks) -> - %% Assertion: ?BADARG_BLOCK must be the call erlang:error(badarg). +assert_exception_block(Blocks) -> + %% Assertion: ?EXCEPTION_BLOCK must be a call erlang:error(badarg). case Blocks of - #{?BADARG_BLOCK:=Blk} -> + #{?EXCEPTION_BLOCK:=Blk} -> #b_blk{is=[#b_set{op=call,dst=Ret, args=[#b_remote{mod=#b_literal{val=erlang}, name=#b_literal{val=error}}, @@ -148,7 +149,7 @@ assert_badarg_block(Blocks) -> last=#b_ret{arg=Ret}} = Blk, ok; #{} -> - %% ?BADARG_BLOCK has been removed because it was never used. + %% ?EXCEPTION_BLOCK has been removed because it was never used. ok end. @@ -384,6 +385,7 @@ classify_heap_need(is_tagged_tuple) -> neutral; classify_heap_need(kill_try_tag) -> gc; classify_heap_need(landingpad) -> gc; classify_heap_need(make_fun) -> gc; +classify_heap_need(match_fail) -> gc; classify_heap_need(new_try_tag) -> gc; classify_heap_need(peek_message) -> gc; classify_heap_need(put_map) -> gc; @@ -629,7 +631,7 @@ liveness_get(S, LiveMap) -> end. liveness_successors(Terminator) -> - successors(Terminator) -- [?BADARG_BLOCK]. + successors(Terminator) -- [?EXCEPTION_BLOCK]. liveness_is([#cg_alloc{}=I0|Is], Regs, Live, Acc) -> I = I0#cg_alloc{live=num_live(Live, Regs)}, @@ -973,6 +975,12 @@ cg_block(Is0, Last, Next, St0) -> case Last of #cg_br{succ=Next,fail=Next} -> cg_block(Is0, none, St0); + #cg_br{succ=Same,fail=Same} when Same =:= ?EXCEPTION_BLOCK -> + %% An expression in this block *always* throws an exception, so we + %% terminate it with an 'if_end' to make sure the validator knows + %% that the following instructions won't actually be reached. + {Is,St} = cg_block(Is0, none, St0), + {Is++[if_end],St}; #cg_br{succ=Same,fail=Same} -> {Fail,St1} = use_block_label(Same, St0), {Is,St} = cg_block(Is0, none, St1), @@ -1178,6 +1186,10 @@ cg_block([#cg_set{op=call}=I, #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> %% A call in try/catch block. cg_block([I], none, St); +cg_block([#cg_set{op=match_fail}=I, + #cg_set{op=succeeded,dst=Bool}], {Bool,_Fail}, St) -> + %% A match_fail instruction in a try/catch block. + cg_block([I], none, St); cg_block([#cg_set{op=get_map_element,dst=Dst0,args=Args0}, #cg_set{op=succeeded,dst=Bool}], {Bool,Fail0}, St) -> [Dst,Map,Key] = beam_args([Dst0|Args0], St), @@ -1239,6 +1251,28 @@ cg_block([#cg_set{op=copy}|_]=T0, Context, St0) -> no -> {Is,St} end; +cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}], none, St) -> + Args = beam_args(Args0, St), + Is = cg_match_fail(Args, line(Anno), none), + {Is,St}; +cg_block([#cg_set{op=match_fail,args=Args0,anno=Anno}|T], Context, St0) -> + FcLabel = case Context of + {return,_,none} -> + %% There is no stack frame. If this is a function_clause + %% exception, it is safe to jump to the label of the + %% func_info instruction. + St0#cg.fc_label; + _ -> + %% This is most probably not a function_clause. + %% If this is a function_clause exception + %% (rare), it is not safe to jump to the + %% func_info label. + none + end, + Args = beam_args(Args0, St0), + Is0 = cg_match_fail(Args, line(Anno), FcLabel), + {Is1,St} = cg_block(T, Context, St0), + {Is0++Is1,St}; cg_block([#cg_set{op=Op,dst=Dst0,args=Args0}=Set], none, St) -> [Dst|Args] = beam_args([Dst0|Args0], St), Is = cg_instr(Op, Args, Dst, Set), @@ -1270,8 +1304,7 @@ cg_copy(T0, St) -> end, T0), Moves0 = cg_copy_1(Copies, St), Moves1 = [Move || {move,Src,Dst}=Move <- Moves0, Src =/= Dst], - Scratch = {x,1022}, - Moves = order_moves(Moves1, Scratch), + Moves = order_moves(Moves1), {Moves,T}. cg_copy_1([#cg_set{dst=Dst0,args=Args}|T], St) -> @@ -1512,6 +1545,42 @@ cg_call(#cg_set{anno=Anno,op=call,dst=Dst0,args=Args0}, Is = setup_args(Args++[Func], Anno, Context, St) ++ Line ++ Call, {Is,St}. +cg_match_fail([{atom,function_clause}|Args], Line, Fc) -> + case Fc of + none -> + %% There is a stack frame (probably because of inlining). + %% Jumping to the func_info label is not allowed by + %% beam_validator. Rewrite the instruction as a call to + %% erlang:error/2. + make_fc(Args, Line); + _ -> + setup_args(Args) ++ [{jump,{f,Fc}}] + end; +cg_match_fail([{atom,Op}], Line, _Fc) -> + [Line,Op]; +cg_match_fail([{atom,Op},Val], Line, _Fc) -> + [Line,{Op,Val}]. + +make_fc(Args, Line) -> + %% Recreate the original call to erlang:error/2. + Live = foldl(fun({x,X}, A) -> max(X+1, A); + (_, A) -> A + end, 0, Args), + TmpReg = {x,Live}, + StkMoves = build_stk(reverse(Args), TmpReg, nil), + [{test_heap,2*length(Args),Live}|StkMoves] ++ + [{move,{atom,function_clause},{x,0}}, + Line, + {call_ext,2,{extfunc,erlang,error,2}}]. + +build_stk([V], _TmpReg, Tail) -> + [{put_list,V,Tail,{x,1}}]; +build_stk([V|Vs], TmpReg, Tail) -> + I = {put_list,V,Tail,TmpReg}, + [I|build_stk(Vs, TmpReg, TmpReg)]; +build_stk([], _TmpReg, nil) -> + [{move,nil,{x,1}}]. + build_call(call_fun, Arity, _Func, none, Dst) -> [{call_fun,Arity}|copy({x,0}, Dst)]; build_call(call_fun, Arity, _Func, {return,Dst,N}, Dst) when is_integer(N) -> @@ -1550,15 +1619,15 @@ build_apply(Arity, {return,Val,N}, _Dst) when is_integer(N) -> build_apply(Arity, none, Dst) -> [{apply,Arity}|copy({x,0}, Dst)]. -cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> - Live = get_live(Set), - [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; cg_instr(bs_get_tail, [Src], Dst, Set) -> Live = get_live(Set), [{bs_get_tail,Src,Dst,Live}]; cg_instr(bs_get_position, [Ctx], Dst, Set) -> Live = get_live(Set), [{bs_get_position,Ctx,Dst,Live}]; +cg_instr(put_map, [{atom,assoc},SrcMap|Ss], Dst, Set) -> + Live = get_live(Set), + [{put_map_assoc,{f,0},SrcMap,Dst,Live,{list,Ss}}]; cg_instr(Op, Args, Dst, _Set) -> cg_instr(Op, Args, Dst). @@ -1728,7 +1797,7 @@ cg_catch(Agg, T0, Context, St0) -> cg_try(Agg, Tag, T0, Context, St0) -> {Moves0,T1} = cg_extract(T0, Agg, St0), - Moves = order_moves(Moves0, {x,3}), + Moves = order_moves(Moves0), [#cg_set{op=kill_try_tag}|T2] = T1, {T,St} = cg_block(T2, Context, St0), {[{try_case,Tag}|Moves++T],St}. @@ -1780,7 +1849,7 @@ linearize(Blocks) -> Linear = beam_ssa:linearize(Blocks), linearize_1(Linear, Blocks). -linearize_1([{?BADARG_BLOCK,_}|Ls], Blocks) -> +linearize_1([{?EXCEPTION_BLOCK,_}|Ls], Blocks) -> linearize_1(Ls, Blocks); linearize_1([{L,Block0}|Ls], Blocks) -> Block = translate_block(L, Block0, Blocks), @@ -1884,8 +1953,7 @@ setup_args([]) -> []; setup_args([_|_]=Args) -> Moves = gen_moves(Args, 0, []), - Scratch = {x,1+last(sort([length(Args)-1|[X || {x,X} <- Args]]))}, - order_moves(Moves, Scratch). + order_moves(Moves). %% kill_yregs(Anno, #cg{}) -> [{kill,{y,Y}}]. %% Kill Y registers that will not be used again. @@ -1905,47 +1973,48 @@ gen_moves([A|As], I, Acc) -> gen_moves([], _, Acc) -> keysort(3, Acc). -%% order_moves([Move], ScratchReg) -> [Move] +%% order_moves([Move]) -> [Move] %% Orders move instruction so that source registers are not %% destroyed before they are used. If there are cycles %% (such as {move,{x,0},{x,1}}, {move,{x,1},{x,1}}), -%% the scratch register is used to break up the cycle. -%% If possible, the first move of the input list is placed +%% swap instructions will be used to break up the cycle. +%% +%% If possible, the first move of the input list is placed %% last in the result list (to make the move to {x,0} occur %% just before the call to allow the Beam loader to coalesce %% the instructions). -order_moves(Ms, Scr) -> order_moves(Ms, Scr, []). +order_moves(Ms) -> order_moves(Ms, []). -order_moves([{move,_,_}=M|Ms0], ScrReg, Acc0) -> - {Chain,Ms} = collect_chain(Ms0, [M], ScrReg), +order_moves([{move,_,_}=M|Ms0], Acc0) -> + {Chain,Ms} = collect_chain(Ms0, [M]), Acc = reverse(Chain, Acc0), - order_moves(Ms, ScrReg, Acc); -order_moves([], _, Acc) -> Acc. + order_moves(Ms, Acc); +order_moves([], Acc) -> Acc. -collect_chain(Ms, Path, ScrReg) -> - collect_chain(Ms, Path, [], ScrReg). +collect_chain(Ms, Path) -> + collect_chain(Ms, Path, []). -collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others, ScrReg) -> +collect_chain([{move,Src,Same}=M|Ms0], [{move,Same,_}|_]=Path, Others) -> case keymember(Src, 3, Path) of false -> - collect_chain(reverse(Others, Ms0), [M|Path], [], ScrReg); + collect_chain(reverse(Others, Ms0), [M|Path], []); true -> - %% There is a cycle, which we must break up. - {break_up_cycle(M, Path, ScrReg),reverse(Others, Ms0)} + %% There is a cycle. + {break_up_cycle(M, Path),reverse(Others, Ms0)} end; -collect_chain([M|Ms], Path, Others, ScrReg) -> - collect_chain(Ms, Path, [M|Others], ScrReg); -collect_chain([], Path, Others, _) -> +collect_chain([M|Ms], Path, Others) -> + collect_chain(Ms, Path, [M|Others]); +collect_chain([], Path, Others) -> {Path,Others}. -break_up_cycle({move,Src,_}=M, Path, ScrReg) -> - [{move,ScrReg,Src},M|break_up_cycle1(Src, Path, ScrReg)]. +break_up_cycle({move,Src,_Dst}=M, Path) -> + break_up_cycle_1(Src, [M|Path], []). -break_up_cycle1(Dst, [{move,Src,Dst}|Path], ScrReg) -> - [{move,Src,ScrReg}|Path]; -break_up_cycle1(Dst, [M|Path], LastMove) -> - [M|break_up_cycle1(Dst, Path, LastMove)]. +break_up_cycle_1(Dst, [{move,_Src,Dst}|Path], Acc) -> + reverse(Acc, Path); +break_up_cycle_1(Dst, [{move,S,D}|Path], Acc) -> + break_up_cycle_1(Dst, Path, [{swap,S,D}|Acc]). %%% %%% General utility functions. diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl index e78e4647a8..55ded77d43 100644 --- a/lib/compiler/src/beam_ssa_dead.erl +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -760,8 +760,8 @@ will_succeed_1('=/=', A, '=:=', B) when A =:= B -> no; will_succeed_1('<', A, '=:=', B) when B >= A -> no; will_succeed_1('<', A, '=/=', B) when B >= A -> yes; will_succeed_1('<', A, '<', B) when B >= A -> yes; -will_succeed_1('<', A, '=<', B) when B > A -> yes; -will_succeed_1('<', A, '>=', B) when B > A -> no; +will_succeed_1('<', A, '=<', B) when B >= A -> yes; +will_succeed_1('<', A, '>=', B) when B >= A -> no; will_succeed_1('<', A, '>', B) when B >= A -> no; will_succeed_1('=<', A, '=:=', B) when B > A -> no; @@ -781,9 +781,9 @@ will_succeed_1('>=', A, '>', B) when B < A -> yes; will_succeed_1('>', A, '=:=', B) when B =< A -> no; will_succeed_1('>', A, '=/=', B) when B =< A -> yes; will_succeed_1('>', A, '<', B) when B =< A -> no; -will_succeed_1('>', A, '=<', B) when B < A -> no; +will_succeed_1('>', A, '=<', B) when B =< A -> no; will_succeed_1('>', A, '>=', B) when B =< A -> yes; -will_succeed_1('>', A, '>', B) when B < A -> yes; +will_succeed_1('>', A, '>', B) when B =< A -> yes; will_succeed_1('==', A, '==', B) -> if diff --git a/lib/compiler/src/beam_ssa_lint.erl b/lib/compiler/src/beam_ssa_lint.erl index a003607dab..224095d4c4 100644 --- a/lib/compiler/src/beam_ssa_lint.erl +++ b/lib/compiler/src/beam_ssa_lint.erl @@ -65,13 +65,19 @@ format_error({{_M,F,A},{phi_inside_block, Name, Id}}) -> [F, A, format_var(Name), Id]); format_error({{_M,F,A},{undefined_label_in_phi, Label, I}}) -> io_lib:format("~p/~p: Unknown block label ~p in phi node ~ts", - [F, A, Label, format_instr(I)]). + [F, A, Label, format_instr(I)]); +format_error({{_M,F,A},{succeeded_not_preceded, I}}) -> + io_lib:format("~p/~p: ~ts does not reference the preceding instruction", + [F, A, format_instr(I)]); +format_error({{_M,F,A},{succeeded_not_last, I}}) -> + io_lib:format("~p/~p: ~ts is not the last instruction in its block", + [F, A, format_instr(I)]). format_instr(I) -> [$',beam_ssa_pp:format_instr(I),$']. format_var(V) -> - beam_ssa_pp:format_var(#b_var{name=V}). + beam_ssa_pp:format_var(V). validate_function(F) -> try @@ -86,34 +92,36 @@ validate_function(F) -> erlang:raise(Class, Error, Stack) end. --type defined_vars() :: gb_sets:set(beam_ssa:var_name()). +-type defined_vars() :: gb_sets:set(beam_ssa:argument()). -record(vvars, {blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }, branch_def_vars :: #{ - %% Describes the variable state at the time of this exact branch (phi - %% node validation). - {From :: beam_ssa:label(), To :: beam_ssa:label()} => defined_vars(), - %% Describes the variable state common to all branches leading to this - %% label (un/redefined variable validation). - beam_ssa:label() => defined_vars() }, + %% Describes the variable state at the time of + %% this exact branch (phi node validation). + {From :: beam_ssa:label(), + To :: beam_ssa:label()} => defined_vars(), + %% Describes the variable state common to all + %% branches leading to this label (un/redefined + %% variable validation). + beam_ssa:label() => defined_vars() }, defined_vars :: defined_vars()}). -spec validate_variables(beam_ssa:b_function()) -> ok. validate_variables(#b_function{ args = Args, bs = Blocks }) -> %% Prefill the mapping with function arguments. - ArgNames = vvars_get_varnames(Args), - DefVars = gb_sets:from_list(ArgNames), + Args = vvars_get_variables(Args), + DefVars = gb_sets:from_list(Args), Entry = 0, State = #vvars{blocks = Blocks, branch_def_vars = #{ Entry => DefVars }, defined_vars = DefVars}, - ok = vvars_assert_unique(Blocks, ArgNames), + ok = vvars_assert_unique(Blocks, Args), vvars_phi_nodes(vvars_block(Entry, State)). %% Checks the uniqueness of all variables across all blocks. --spec vvars_assert_unique(Blocks, [beam_ssa:var_name()]) -> ok when +-spec vvars_assert_unique(Blocks, [beam_ssa:b_var()]) -> ok when Blocks :: #{ beam_ssa:label() => beam_ssa:b_blk() }. vvars_assert_unique(Blocks, Args) -> BlockIs = [Is || #b_blk{is=Is} <- maps:values(Blocks)], @@ -124,12 +132,12 @@ vvars_assert_unique(Blocks, Args) -> ok. -spec vvars_assert_unique_1(Is, Defined) -> ok when - Is :: list(beam_ssa:b_set()), - Defined :: #{ beam_ssa:var_name() => beam_ssa:b_set() }. -vvars_assert_unique_1([#b_set{dst=#b_var{name=DstName}}=I|Is], Defined) -> + Is :: list(beam_ssa:b_set()), + Defined :: #{ beam_ssa:b_var() => beam_ssa:b_set() }. +vvars_assert_unique_1([#b_set{dst=Dst}=I|Is], Defined) -> case Defined of - #{DstName:=Old} -> throw({redefined_variable, DstName, Old, I}); - _ -> vvars_assert_unique_1(Is, Defined#{DstName=>I}) + #{Dst:=Old} -> throw({redefined_variable, Dst, Old, I}); + _ -> vvars_assert_unique_1(Is, Defined#{Dst=>I}) end; vvars_assert_unique_1([], Defined) -> Defined. @@ -141,17 +149,17 @@ vvars_phi_nodes(#vvars{ blocks = Blocks }=State) -> ok. -spec vvars_phi_nodes_1(Is, Id, State) -> ok when - Is :: list(beam_ssa:b_set()), - Id :: beam_ssa:label(), - State :: #vvars{}. + Is :: list(beam_ssa:b_set()), + Id :: beam_ssa:label(), + State :: #vvars{}. vvars_phi_nodes_1([#b_set{ op = phi, args = Phis }=I | Is], Id, State) -> ok = vvars_assert_phi_paths(Phis, I, Id, State), ok = vvars_assert_phi_vars(Phis, I, Id, State), vvars_phi_nodes_1(Is, Id, State); vvars_phi_nodes_1([_ | Is], Id, _State) -> - case [Dst || #b_set{op=phi,dst=#b_var{name=Dst}} <- Is] of - [Name|_] -> - throw({phi_inside_block, Name, Id}); + case [Dst || #b_set{op=phi,dst=Dst} <- Is] of + [Var|_] -> + throw({phi_inside_block, Var, Id}); [] -> ok end; @@ -161,10 +169,10 @@ vvars_phi_nodes_1([], _Id, _State) -> %% Checks whether all paths leading to this phi node are represented, and that %% it doesn't reference any non-existent paths. -spec vvars_assert_phi_paths(Phis, I, Id, State) -> ok when - Phis :: list({beam_ssa:argument(), beam_ssa:label()}), - Id :: beam_ssa:label(), - I :: beam_ssa:b_set(), - State :: #vvars{}. + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_phi_paths(Phis, I, Id, State) -> BranchKeys = maps:keys(State#vvars.branch_def_vars), RequiredPaths = ordsets:from_list([From || {From, To} <- BranchKeys, To =:= Id]), @@ -173,34 +181,34 @@ vvars_assert_phi_paths(Phis, I, Id, State) -> [_|_]=MissingPaths -> throw({missing_phi_paths, MissingPaths, I}); [] -> ok end. - %% %% The following test is sometimes useful to find missing optimizations. - %% %% It is commented out, though, because it can be triggered by - %% %% by weird but legal code. - %% case ordsets:subtract(ProvidedPaths, RequiredPaths) of - %% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); - %% [] -> ok - %% end. +%% %% The following test is sometimes useful to find missing optimizations. +%% %% It is commented out, though, because it can be triggered by +%% %% by weird but legal code. +%% case ordsets:subtract(ProvidedPaths, RequiredPaths) of +%% [_|_]=GarbagePaths -> throw({garbage_phi_paths, GarbagePaths, I}); +%% [] -> ok +%% end. %% Checks whether all variables used in this phi node are defined in the branch %% they arrived on. -spec vvars_assert_phi_vars(Phis, I, Id, State) -> ok when - Phis :: list({beam_ssa:argument(), beam_ssa:label()}), - Id :: beam_ssa:label(), - I :: beam_ssa:b_set(), - State :: #vvars{}. + Phis :: list({beam_ssa:argument(), beam_ssa:label()}), + Id :: beam_ssa:label(), + I :: beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, branch_def_vars=BranchDefVars}) -> Vars = [{Var, From} || {#b_var{}=Var, From} <- Phis], - foreach(fun({#b_var{name=VarName}, From}) -> + foreach(fun({Var, From}) -> BranchKey = {From, Id}, case BranchDefVars of #{BranchKey:=DefVars} -> - case gb_sets:is_member(VarName, DefVars) of + case gb_sets:is_member(Var, DefVars) of true -> ok; - false -> throw({unknown_variable, VarName, I}) + false -> throw({unknown_variable, Var, I}) end; #{} -> - throw({unknown_phi_variable, VarName, BranchKey, I}) + throw({unknown_phi_variable, Var, BranchKey, I}) end end, Vars), Labels = [From || {#b_literal{},From} <- Phis], @@ -214,32 +222,44 @@ vvars_assert_phi_vars(Phis, I, Id, #vvars{blocks=Blocks, end, Labels). -spec vvars_block(Id, State) -> #vvars{} when - Id :: beam_ssa:label(), - State :: #vvars{}. + Id :: beam_ssa:label(), + State :: #vvars{}. vvars_block(Id, State0) -> #{ Id := #b_blk{ is = Is, last = Terminator} } = State0#vvars.blocks, #{ Id := DefVars } = State0#vvars.branch_def_vars, State = State0#vvars{ defined_vars = DefVars }, vvars_terminator(Terminator, Id, vvars_block_1(Is, State)). --spec vvars_block_1(Blocks, State) -> #vvars{} when - Blocks :: list(beam_ssa:b_blk()), - State :: #vvars{}. +-spec vvars_block_1(Is, State) -> #vvars{} when + Is :: list(#b_set{}), + State :: #vvars{}. vvars_block_1([], State) -> State; -vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, op = phi } | Is], State0) -> +vvars_block_1([#b_set{dst=OpVar,args=OpArgs}=I, + #b_set{op=succeeded,args=[OpVar],dst=SuccVar}], State) -> + ok = vvars_assert_args(OpArgs, I, State), + vvars_save_var(SuccVar, vvars_save_var(OpVar, State)); +vvars_block_1([#b_set{op=succeeded,args=Args}=I | [_|_]], State) -> + ok = vvars_assert_args(Args, I, State), + %% 'succeeded' must be the last instruction in its block. + throw({succeeded_not_last, I}); +vvars_block_1([#b_set{op=succeeded,args=Args}=I], State)-> + ok = vvars_assert_args(Args, I, State), + %% 'succeeded' must be be directly preceded by the operation it checks. + throw({succeeded_not_preceded, I}); +vvars_block_1([#b_set{ dst = Dst, op = phi } | Is], State) -> %% We don't check phi node arguments at this point since we may not have %% visited their definition yet. They'll be handled later on in %% vvars_phi_nodes/1 after all blocks are processed. - vvars_block_1(Is, vvars_save_var(DstName, State0)); -vvars_block_1([#b_set{ dst = #b_var{ name = DstName }, args = Args }=I | Is], State0) -> - ok = vvars_assert_args(Args, I, State0), - vvars_block_1(Is, vvars_save_var(DstName, State0)). + vvars_block_1(Is, vvars_save_var(Dst, State)); +vvars_block_1([#b_set{ dst = Dst, args = Args }=I | Is], State) -> + ok = vvars_assert_args(Args, I, State), + vvars_block_1(Is, vvars_save_var(Dst, State)). -spec vvars_terminator(Terminator, From, State) -> #vvars{} when - Terminator :: beam_ssa:terminator(), - From :: beam_ssa:label(), - State :: #vvars{}. + Terminator :: beam_ssa:terminator(), + From :: beam_ssa:label(), + State :: #vvars{}. vvars_terminator(#b_ret{ arg = Arg }=I, _From, State) -> ok = vvars_assert_args([Arg], I, State), State; @@ -264,62 +284,62 @@ vvars_terminator(#b_br{ bool = Arg, succ = Succ, fail = Fail }=I, From, State) - vvars_terminator_1(Labels, From, State). -spec vvars_terminator_1(Labels, From, State) -> #vvars{} when - Labels :: list(beam_ssa:label()), - From :: beam_ssa:label(), - State :: #vvars{}. + Labels :: list(beam_ssa:label()), + From :: beam_ssa:label(), + State :: #vvars{}. vvars_terminator_1(Labels0, From, State0) -> %% Filter out all branches that have already been taken. This should result %% in either all of Labels0 or an empty list. Labels = [To || To <- Labels0, - not maps:is_key({From, To}, State0#vvars.branch_def_vars)], + not maps:is_key({From, To}, State0#vvars.branch_def_vars)], true = Labels =:= Labels0 orelse Labels =:= [], %Assertion State1 = foldl(fun(To, State) -> - vvars_save_branch(From, To, State) + vvars_save_branch(From, To, State) end, State0, Labels), foldl(fun(To, State) -> - vvars_block(To, State) + vvars_block(To, State) end, State1, Labels). %% Gets all variable names in args, ignoring literals etc --spec vvars_get_varnames(Args) -> list(beam_ssa:var_name()) when - Args :: list(beam_ssa:argument()). -vvars_get_varnames(Args) -> - [Name || #b_var{ name = Name } <- Args]. +-spec vvars_get_variables(Args) -> list(beam_ssa:b_var()) when + Args :: list(beam_ssa:argument()). +vvars_get_variables(Args) -> + [Var || #b_var{}=Var <- Args]. %% Checks that all variables in Args are defined in all paths leading to the %% current State. -spec vvars_assert_args(Args, I, State) -> ok when - Args :: list(beam_ssa:argument()), - I :: beam_ssa:terminator() | beam_ssa:b_set(), - State :: #vvars{}. + Args :: list(beam_ssa:argument()), + I :: beam_ssa:terminator() | beam_ssa:b_set(), + State :: #vvars{}. vvars_assert_args(Args, I, #vvars{defined_vars=DefVars}=State) -> foreach(fun(#b_remote{mod=Mod,name=Name}) -> vvars_assert_args([Mod,Name], I, State); - (#b_var{name=Name}) -> - case gb_sets:is_member(Name, DefVars) of + (#b_var{}=Var) -> + case gb_sets:is_member(Var, DefVars) of true -> ok; - false -> throw({unknown_variable,Name,I}) + false -> throw({unknown_variable,Var,I}) end; (_) -> ok end, Args). %% Checks that all given labels are defined in State. -spec vvars_assert_labels(Labels, I, State) -> ok when - Labels :: list(beam_ssa:label()), - I :: beam_ssa:terminator(), - State :: #vvars{}. + Labels :: list(beam_ssa:label()), + I :: beam_ssa:terminator(), + State :: #vvars{}. vvars_assert_labels(Labels, I, #vvars{blocks=Blocks}) -> foreach(fun(Label) -> - case maps:is_key(Label, Blocks) of - false -> throw({unknown_block, Label, I}); - true -> ok - end + case maps:is_key(Label, Blocks) of + false -> throw({unknown_block, Label, I}); + true -> ok + end end, Labels). -spec vvars_save_branch(From, To, State) -> #vvars{} when - From :: beam_ssa:label(), - To :: beam_ssa:label(), - State :: #vvars{}. + From :: beam_ssa:label(), + To :: beam_ssa:label(), + State :: #vvars{}. vvars_save_branch(From, To, State) -> DefVars = State#vvars.defined_vars, Branches0 = State#vvars.branch_def_vars, @@ -335,15 +355,15 @@ vvars_save_branch(From, To, State) -> end. -spec vvars_merge_branches(New, Existing) -> defined_vars() when - New :: defined_vars(), - Existing :: defined_vars(). + New :: defined_vars(), + Existing :: defined_vars(). vvars_merge_branches(New, Existing) -> gb_sets:intersection(New, Existing). --spec vvars_save_var(VarName, State) -> #vvars{} when - VarName :: beam_ssa:var_name(), - State :: #vvars{}. -vvars_save_var(VarName, State0) -> +-spec vvars_save_var(Var, State) -> #vvars{} when + Var :: #b_var{}, + State :: #vvars{}. +vvars_save_var(Var, State0) -> %% vvars_assert_unique guarantees that variables are never set twice. - DefVars = gb_sets:insert(VarName, State0#vvars.defined_vars), + DefVars = gb_sets:insert(Var, State0#vvars.defined_vars), State0#vvars{ defined_vars = DefVars }. diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index d87c66c272..580abf4ed9 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -145,7 +145,8 @@ prologue_passes(Opts) -> ?PASS(ssa_opt_linearize), ?PASS(ssa_opt_tuple_size), ?PASS(ssa_opt_record), - ?PASS(ssa_opt_cse), %Helps the first type pass. + ?PASS(ssa_opt_cse), % Helps the first type pass. + ?PASS(ssa_opt_live), % ... ?PASS(ssa_opt_type_start)], passes_1(Ps, Opts). @@ -157,6 +158,9 @@ repeated_passes(Opts) -> ?PASS(ssa_opt_dead), ?PASS(ssa_opt_cse), ?PASS(ssa_opt_tail_phis), + ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_tuple_size), + ?PASS(ssa_opt_record), ?PASS(ssa_opt_type_continue)], %Must run after ssa_opt_dead to %clean up phi nodes. passes_1(Ps, Opts). @@ -172,8 +176,8 @@ epilogue_passes(Opts) -> ?PASS(ssa_opt_bsm), ?PASS(ssa_opt_bsm_units), ?PASS(ssa_opt_bsm_shortcut), - ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_sink), + ?PASS(ssa_opt_blockify), ?PASS(ssa_opt_merge_blocks), ?PASS(ssa_opt_get_tuple_element), ?PASS(ssa_opt_trim_unreachable)], @@ -898,6 +902,7 @@ cse_suitable(#b_set{}) -> false. -record(fs, {s=undefined :: 'undefined' | 'cleared', regs=#{} :: #{beam_ssa:b_var():=beam_ssa:b_var()}, + vars=cerl_sets:new() :: cerl_sets:set(), fail=none :: 'none' | beam_ssa:label(), non_guards :: gb_sets:set(beam_ssa:label()), bs :: beam_ssa:block_map() @@ -910,22 +915,39 @@ ssa_opt_float({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) -> {Linear,Count} = float_opt(Linear0, Count0, Fs), {St#st{ssa=Linear,cnt=Count}, FuncDb}. -float_blk_is_in_guard(#b_blk{last=#b_br{fail=F}}, #fs{non_guards=NonGuards}) -> - not gb_sets:is_member(F, NonGuards); -float_blk_is_in_guard(#b_blk{}, #fs{}) -> +%% The fconv instruction doesn't support jumping to a fail label, so we have to +%% skip this optimization if the fail block is a guard. +%% +%% We also skip the optimization in blocks that always fail, as it's both +%% difficult and pointless to rewrite them to use float ops. +float_can_optimize_blk(#b_blk{last=#b_br{bool=#b_var{},fail=F}}, + #fs{non_guards=NonGuards}) -> + gb_sets:is_member(F, NonGuards); +float_can_optimize_blk(#b_blk{}, #fs{}) -> false. +float_opt([{L,#b_blk{is=[#b_set{op=exception_trampoline,args=[Var]}]}=Blk0} | + Bs0], Count0, Fs) -> + %% If we've replaced a BIF with float operations, we'll have a lot of extra + %% blocks that jump to the same failure block, which may have a trampoline + %% that refers to the original operation. + %% + %% Since the point of the trampoline is to keep the BIF from being removed + %% by liveness optimization, we can discard it as the liveness pass leaves + %% floats alone. + Blk = case cerl_sets:is_element(Var, Fs#fs.vars) of + true -> Blk0#b_blk{is=[]}; + false -> Blk0 + end, + {Bs, Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count}; float_opt([{L,Blk}|Bs0], Count0, Fs) -> - case float_blk_is_in_guard(Blk, Fs) of + case float_can_optimize_blk(Blk, Fs) of true -> - %% This block is inside a guard. Don't do - %% any floating point optimizations. - {Bs,Count} = float_opt(Bs0, Count0, Fs), - {[{L,Blk}|Bs],Count}; + float_opt_1(L, Blk, Bs0, Count0, Fs); false -> - %% This block is not inside a guard. - %% We can do the optimization. - float_opt_1(L, Blk, Bs0, Count0, Fs) + {Bs,Count} = float_opt(Bs0, Count0, Fs), + {[{L,Blk}|Bs],Count} end; float_opt([], Count, _Fs) -> {[],Count}. @@ -1004,12 +1026,12 @@ float_maybe_flush(Blk0, #fs{s=cleared,fail=Fail,bs=Blocks}=Fs0, Count0) -> #b_blk{last=#b_br{bool=#b_var{},succ=Succ}=Br} = Blk0, %% If the success block starts with a floating point operation, we can - %% defer flushing to that block as long as it isn't a guard. + %% defer flushing to that block as long as it's suitable for optimization. #b_blk{is=Is} = SuccBlk = map_get(Succ, Blocks), - SuccIsGuard = float_blk_is_in_guard(SuccBlk, Fs0), + CanOptimizeSucc = float_can_optimize_blk(SuccBlk, Fs0), case Is of - [#b_set{anno=#{float_op:=_}}|_] when not SuccIsGuard -> + [#b_set{anno=#{float_op:=_}}|_] when CanOptimizeSucc -> %% No flush needed. {[],Blk0,Fs0,Count0}; _ -> @@ -1065,21 +1087,22 @@ float_opt_is([], Fs, _Count, _Acc) -> none. float_make_op(#b_set{op={bif,Op},dst=Dst,args=As0}=I0, - Ts, #fs{s=S,regs=Rs0}=Fs, Count0) -> + Ts, #fs{s=S,regs=Rs0,vars=Vs0}=Fs, Count0) -> {As1,Rs1,Count1} = float_load(As0, Ts, Rs0, Count0, []), {As,Is0} = unzip(As1), {Fr,Count2} = new_reg('@fr', Count1), FrDst = #b_var{name=Fr}, I = I0#b_set{op={float,Op},dst=FrDst,args=As}, + Vs = cerl_sets:add_element(Dst, Vs0), Rs = Rs1#{Dst=>FrDst}, Is = append(Is0) ++ [I], case S of undefined -> {Ignore,Count} = new_reg('@ssa_ignore', Count2), C = #b_set{op={float,clearerror},dst=#b_var{name=Ignore}}, - {[C|Is],Fs#fs{s=cleared,regs=Rs},Count}; + {[C|Is],Fs#fs{s=cleared,regs=Rs,vars=Vs},Count}; cleared -> - {Is,Fs#fs{regs=Rs},Count2} + {Is,Fs#fs{regs=Rs,vars=Vs},Count2} end. float_load([A|As], [T|Ts], Rs0, Count0, Acc) -> @@ -1208,34 +1231,31 @@ live_opt_is([#b_set{op=phi,dst=Dst}=I|Is], Live, Acc) -> false -> live_opt_is(Is, Live, Acc) end; -live_opt_is([#b_set{op=succeeded,dst=SuccDst=SuccDstVar, - args=[Dst]}=SuccI, - #b_set{dst=Dst}=I|Is], Live0, Acc) -> - case gb_sets:is_member(Dst, Live0) of - true -> - Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete_any(SuccDst, Live1), - live_opt_is([I|Is], Live, [SuccI|Acc]); - false -> - case live_opt_unused(I) of - {replace,NewI0} -> - NewI = NewI0#b_set{dst=SuccDstVar}, - live_opt_is([NewI|Is], Live0, Acc); - keep -> - case gb_sets:is_member(SuccDst, Live0) of - true -> - Live1 = gb_sets:add(Dst, Live0), - Live = gb_sets:delete(SuccDst, Live1), - live_opt_is([I|Is], Live, [SuccI|Acc]); - false -> - live_opt_is([I|Is], Live0, Acc) - end - end +live_opt_is([#b_set{op=succeeded,dst=SuccDst,args=[MapDst]}=SuccI, + #b_set{op=get_map_element,dst=MapDst}=MapI | Is], + Live0, Acc) -> + case {gb_sets:is_member(SuccDst, Live0), + gb_sets:is_member(MapDst, Live0)} of + {true, true} -> + Live = gb_sets:delete(SuccDst, Live0), + live_opt_is([MapI | Is], Live, [SuccI | Acc]); + {true, false} -> + %% 'get_map_element' is unused; replace 'succeeded' with + %% 'has_map_field' + NewI = MapI#b_set{op=has_map_field,dst=SuccDst}, + live_opt_is([NewI | Is], Live0, Acc); + {false, true} -> + %% 'succeeded' is unused (we know it will succeed); discard it and + %% keep 'get_map_element' + live_opt_is([MapI | Is], Live0, Acc); + {false, false} -> + live_opt_is(Is, Live0, Acc) end; live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> case gb_sets:is_member(Dst, Live0) of true -> - Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)), + Live1 = gb_sets:union(Live0, LiveUsed), Live = gb_sets:delete(Dst, Live1), live_opt_is(Is, Live, [I|Acc]); false -> @@ -1243,17 +1263,14 @@ live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) -> true -> live_opt_is(Is, Live0, Acc); false -> - Live = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))), + LiveUsed = gb_sets:from_ordset(beam_ssa:used(I)), + Live = gb_sets:union(Live0, LiveUsed), live_opt_is(Is, Live, [I|Acc]) end end; live_opt_is([], Live, Acc) -> {Acc,Live}. -live_opt_unused(#b_set{op=get_map_element}=Set) -> - {replace,Set#b_set{op=has_map_field}}; -live_opt_unused(_) -> keep. - %%% %%% Optimize binary matching. %%% @@ -1939,6 +1956,10 @@ verify_merge_is(_) -> is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) -> false; +is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=exception_trampoline}|_]}) -> + false; +is_merge_allowed(_, #b_blk{is=[#b_set{op=exception_trampoline}|_]}, #b_blk{}) -> + false; is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{is=Is}) -> %% The predecessor block must have exactly one successor (L) for %% the merge to be safe. @@ -1977,9 +1998,7 @@ is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) -> %%% extracted values. %%% -ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> - Linear = beam_ssa:linearize(Blocks0), - +ssa_opt_sink({#st{ssa=Linear}=St, FuncDb}) -> %% Create a map with all variables that define get_tuple_element %% instructions. The variable name map to the block it is defined in. case def_blocks(Linear) of @@ -1988,10 +2007,12 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) -> {St, FuncDb}; [_|_]=Defs0 -> Defs = maps:from_list(Defs0), - {do_ssa_opt_sink(Linear, Defs, St), FuncDb} + {do_ssa_opt_sink(Defs, St), FuncDb} end. -do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> +do_ssa_opt_sink(Defs, #st{ssa=Linear}=St) -> + Blocks0 = maps:from_list(Linear), + %% Now find all the blocks that use variables defined by get_tuple_element %% instructions. Used = used_blocks(Linear, Defs, []), @@ -2016,7 +2037,8 @@ do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) -> From = map_get(V, Defs), move_defs(V, From, To, A) end, Blocks0, DefLoc), - St#st{ssa=Blocks}. + + St#st{ssa=beam_ssa:linearize(Blocks)}. def_blocks([{L,#b_blk{is=Is}}|Bs]) -> def_blocks_is(Is, L, def_blocks(Bs)); @@ -2049,6 +2071,7 @@ unsuitable_1([{L,#b_blk{is=[#b_set{op=Op}|_]}}|Bs]) -> Unsuitable = case Op of bs_extract -> true; bs_put -> true; + exception_trampoline -> true; {float,_} -> true; landingpad -> true; peek_message -> true; @@ -2257,13 +2280,15 @@ non_guards(Linear) -> non_guards_1([{L,#b_blk{is=Is}}|Bs]) -> case Is of + [#b_set{op=exception_trampoline}|_] -> + [L | non_guards_1(Bs)]; [#b_set{op=landingpad}|_] -> [L | non_guards_1(Bs)]; _ -> non_guards_1(Bs) end; non_guards_1([]) -> - [?BADARG_BLOCK]. + [?EXCEPTION_BLOCK]. rel2fam(S0) -> S1 = sofs:relation(S0), diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index 7f816b9802..61c42fdb6d 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -108,7 +108,8 @@ functions([], _Ps, _UseBSM3) -> []. intervals=[] :: [{b_var(),[range()]}], res=[] :: [{b_var(),reservation()}] | #{b_var():=reservation()}, regs=#{} :: #{b_var():=ssa_register()}, - extra_annos=[] :: [{atom(),term()}] + extra_annos=[] :: [{atom(),term()}], + location :: term() }). -define(PASS(N), {N,fun N/1}). @@ -119,7 +120,9 @@ passes(Opts) -> %% Preliminaries. ?PASS(fix_bs), + ?PASS(exception_trampolines), ?PASS(sanitize), + ?PASS(match_fail_instructions), case FixTuples of false -> ignore; true -> ?PASS(fix_tuples) @@ -164,7 +167,9 @@ passes(Opts) -> function(#b_function{anno=Anno,args=Args,bs=Blocks0,cnt=Count0}=F0, Ps, UseBSM3) -> try - St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3,cnt=Count0}, + Location = maps:get(location, Anno, none), + St0 = #st{ssa=Blocks0,args=Args,use_bsm3=UseBSM3, + cnt=Count0,location=Location}, St = compile:run_sub_passes(Ps, St0), #st{ssa=Blocks,cnt=Count,regs=Regs,extra_annos=ExtraAnnos} = St, F1 = add_extra_annos(F0, ExtraAnnos), @@ -598,6 +603,10 @@ bs_instrs([{L,#b_blk{is=Is0}=Blk}|Bs], CtxChain, Acc0) -> bs_instrs([], _, Acc) -> reverse(Acc). +bs_instrs_is([#b_set{op=succeeded}=I|Is], CtxChain, Acc) -> + %% This instruction refers to a specific operation, so we must not + %% substitute the context argument. + bs_instrs_is(Is, CtxChain, [I | Acc]); bs_instrs_is([#b_set{op=Op,args=Args0}=I0|Is], CtxChain, Acc) -> Args = [bs_subst_ctx(A, CtxChain) || A <- Args0], I1 = I0#b_set{args=Args}, @@ -691,6 +700,44 @@ legacy_bs_is([I|Is], Last, IsYreg, Count, Copies, Acc) -> legacy_bs_is([], _Last, _IsYreg, Count, Copies, Acc) -> {reverse(Acc),Count,Copies}. +%% exception_trampolines(St0) -> St. +%% +%% Removes the "exception trampolines" that were added to prevent exceptions +%% from being optimized away. + +exception_trampolines(#st{ssa=Blocks0}=St) -> + RPO = reverse(beam_ssa:rpo(Blocks0)), + Blocks = et_1(RPO, #{}, Blocks0), + St#st{ssa=Blocks}. + +et_1([L | Ls], Trampolines, Blocks) -> + #{ L := #b_blk{is=Is,last=Last0}=Block0 } = Blocks, + case {Is, Last0} of + {[#b_set{op=exception_trampoline}], #b_br{succ=Succ}} -> + et_1(Ls, Trampolines#{ L => Succ }, maps:remove(L, Blocks)); + {_, #b_br{succ=Same,fail=Same}} when Same =:= ?EXCEPTION_BLOCK -> + %% The exception block is just a marker saying that we should raise + %% an exception (= {f,0}) instead of jumping to a particular fail + %% block. Since it's not a reachable block we can't allow + %% unconditional jumps to it except through a trampoline. + error({illegal_jump_to_exception_block, L}); + {_, #b_br{succ=Succ0,fail=Fail0}} -> + Succ = maps:get(Succ0, Trampolines, Succ0), + Fail = maps:get(Fail0, Trampolines, Fail0), + if + Succ =/= Succ0; Fail =/= Fail0 -> + Last = Last0#b_br{succ=Succ,fail=Fail}, + Block = Block0#b_blk{last=Last}, + et_1(Ls, Trampolines, Blocks#{ L := Block }); + Succ =:= Succ0, Fail =:= Fail0 -> + et_1(Ls, Trampolines, Blocks) + end; + {_, _} -> + et_1(Ls, Trampolines, Blocks) + end; +et_1([], _Trampolines, Blocks) -> + Blocks. + %% sanitize(St0) -> St. %% Remove constructs that can cause problems later: %% @@ -856,6 +903,114 @@ prune_phi(#b_set{args=Args0}=Phi, Reachable) -> gb_sets:is_element(Pred, Reachable)], Phi#b_set{args=Args}. +%%% Rewrite certain calls to erlang:error/{1,2} to specialized +%%% instructions: +%%% +%%% erlang:error({badmatch,Value}) => badmatch Value +%%% erlang:error({case_clause,Value}) => case_end Value +%%% erlang:error({try_clause,Value}) => try_case_end Value +%%% erlang:error(if_clause) => if_end +%%% erlang:error(function_clause, Args) => jump FuncInfoLabel +%%% +%%% In SSA code, we represent those instructions as a 'match_fail' +%%% instruction with the name of the BEAM instruction as the first +%%% argument. + +match_fail_instructions(#st{ssa=Blocks0,args=Args,location=Location}=St) -> + Ls = maps:to_list(Blocks0), + Info = {length(Args),Location}, + Blocks = match_fail_instrs_1(Ls, Info, Blocks0), + St#st{ssa=Blocks}. + +match_fail_instrs_1([{L,#b_blk{is=Is0}=Blk}|Bs], Arity, Blocks0) -> + case match_fail_instrs_blk(Is0, Arity, []) of + none -> + match_fail_instrs_1(Bs, Arity, Blocks0); + Is -> + Blocks = Blocks0#{L:=Blk#b_blk{is=Is}}, + match_fail_instrs_1(Bs, Arity, Blocks) + end; +match_fail_instrs_1([], _Arity, Blocks) -> Blocks. + +match_fail_instrs_blk([#b_set{op=put_tuple,dst=Dst, + args=[#b_literal{val=Tag},Val]}, + #b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + Dst]}=Call|Is], + _Arity, Acc) -> + match_fail_instr(Call, Tag, Val, Is, Acc); +match_fail_instrs_blk([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val={Tag,Val}}]}=Call|Is], + _Arity, Acc) -> + match_fail_instr(Call, Tag, #b_literal{val=Val}, Is, Acc); +match_fail_instrs_blk([#b_set{op=call, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=if_clause}]}=Call|Is], + _Arity, Acc) -> + I = Call#b_set{op=match_fail,args=[#b_literal{val=if_end}]}, + reverse(Acc, [I|Is]); +match_fail_instrs_blk([#b_set{op=call,anno=Anno, + args=[#b_remote{mod=#b_literal{val=erlang}, + name=#b_literal{val=error}}, + #b_literal{val=function_clause}, + Stk]}=Call], + {Arity,Location}, Acc) -> + case match_fail_stk(Stk, Acc, [], []) of + {[_|_]=Vars,Is} when length(Vars) =:= Arity -> + case maps:get(location, Anno, none) of + Location -> + I = Call#b_set{op=match_fail, + args=[#b_literal{val=function_clause}|Vars]}, + Is ++ [I]; + _ -> + %% erlang:error/2 has a different location than the + %% func_info instruction at the beginning of the function + %% (probably because of inlining). Keep the original call. + reverse(Acc, [Call]) + end; + _ -> + %% Either the stacktrace could not be picked apart (for example, + %% if the call to erlang:error/2 was handwritten) or the number + %% of arguments in the stacktrace was different from the arity + %% of the host function (because it is the implementation of a + %% fun). Keep the original call. + reverse(Acc, [Call]) + end; +match_fail_instrs_blk([I|Is], Arity, Acc) -> + match_fail_instrs_blk(Is, Arity, [I|Acc]); +match_fail_instrs_blk(_, _, _) -> + none. + +match_fail_instr(Call, Tag, Val, Is, Acc) -> + Op = case Tag of + badmatch -> Tag; + case_clause -> case_end; + try_clause -> try_case_end; + _ -> none + end, + case Op of + none -> + none; + _ -> + I = Call#b_set{op=match_fail,args=[#b_literal{val=Op},Val]}, + reverse(Acc, [I|Is]) + end. + +match_fail_stk(#b_var{}=V, [#b_set{op=put_list,dst=V,args=[H,T]}|Is], IAcc, VAcc) -> + match_fail_stk(T, Is, IAcc, [H|VAcc]); +match_fail_stk(#b_literal{val=[H|T]}, Is, IAcc, VAcc) -> + match_fail_stk(#b_literal{val=T}, Is, IAcc, [#b_literal{val=H}|VAcc]); +match_fail_stk(#b_literal{val=[]}, [], IAcc, VAcc) -> + {reverse(VAcc),IAcc}; +match_fail_stk(T, [#b_set{op=Op}=I|Is], IAcc, VAcc) + when Op =:= bs_get_tail; Op =:= bs_set_position -> + match_fail_stk(T, Is, [I|IAcc], VAcc); +match_fail_stk(_, _, _, _) -> none. + %%% %%% Fix tuples. %%% @@ -911,9 +1066,8 @@ use_set_tuple_element(#st{ssa=Blocks0}=St) -> Blocks = use_ste_1(RPO, Uses, Blocks0), St#st{ssa=Blocks}. -use_ste_1([L|Ls], Uses, Blocks0) -> - {Blk0,Blocks} = use_ste_across(L, Uses, Blocks0), - #b_blk{is=Is0} = Blk0, +use_ste_1([L|Ls], Uses, Blocks) -> + #b_blk{is=Is0} = Blk0 = map_get(L, Blocks), case use_ste_is(Is0, Uses) of Is0 -> use_ste_1(Ls, Uses, Blocks); @@ -976,69 +1130,6 @@ extract_ste(#b_set{op=call,dst=Dst, end; extract_ste(#b_set{}) -> none. -%%% Optimize accross blocks within a try/catch block. - -use_ste_across(L, Uses, Blocks) -> - case map_get(L, Blocks) of - #b_blk{last=#b_br{bool=#b_var{}}}=Blk -> - try - use_ste_across_1(L, Blk, Uses, Blocks) - catch - throw:not_possible -> - {Blk,Blocks} - end; - #b_blk{}=Blk -> - {Blk,Blocks} - end. - -use_ste_across_1(L, Blk0, Uses, Blocks0) -> - #b_blk{is=IsThis,last=#b_br{bool=Bool,succ=Next}} = Blk0, - case reverse(IsThis) of - [#b_set{op=succeeded,dst=Bool,args=[Result]}=Succ0, - #b_set{op=call,args=[#b_remote{}|_],dst=Result}=Call1|Prefix] -> - case is_single_use(Bool, Uses) andalso - is_n_uses(2, Result, Uses) of - true -> ok; - false -> throw(not_possible) - end, - Call2 = use_ste_across_next(Next, Uses, Blocks0), - Is = [Call1,Call2], - case use_ste_is(Is, decrement_uses(Result, Uses)) of - [#b_set{}=Call,#b_set{op=set_tuple_element}=Ste] -> - Blocks1 = use_ste_fix_next(Ste, Next, Blocks0), - Succ = Succ0#b_set{args=[Call#b_set.dst]}, - Blk = Blk0#b_blk{is=reverse(Prefix, [Call,Succ])}, - Blocks = Blocks1#{L:=Blk}, - {Blk,Blocks}; - _ -> - throw(not_possible) - end; - _ -> - throw(not_possible) - end. - -use_ste_across_next(Next, Uses, Blocks) -> - case map_get(Next, Blocks) of - #b_blk{is=[#b_set{op=call,dst=Result,args=[#b_remote{}|_]}=Call, - #b_set{op=succeeded,dst=Bool,args=[Result]}], - last=#b_br{bool=Bool}} -> - case is_single_use(Bool, Uses) andalso - is_n_uses(2, Result, Uses) of - true -> ok; - false -> throw(not_possible) - end, - Call; - #b_blk{} -> - throw(not_possible) - end. - -use_ste_fix_next(Ste, Next, Blocks) -> - Blk0 = map_get(Next, Blocks), - #b_blk{is=[#b_set{op=call},#b_set{op=succeeded}],last=Br0} = Blk0, - Br = beam_ssa:normalize(Br0#b_br{bool=#b_literal{val=true}}), - Blk = Blk0#b_blk{is=[Ste],last=Br}, - Blocks#{Next:=Blk}. - %% Count how many times each variable is used. count_uses(Blocks) -> @@ -1048,7 +1139,7 @@ count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> F = fun(I, CountMap) -> foldl(fun(Var, Acc) -> case Acc of - #{Var:=3} -> Acc; + #{Var:=2} -> Acc; #{Var:=C} -> Acc#{Var:=C+1}; #{} -> Acc#{Var=>1} end @@ -1058,16 +1149,6 @@ count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) -> count_uses_blk(Bs, CountMap); count_uses_blk([], CountMap) -> CountMap. -decrement_uses(V, Uses) -> - #{V:=C} = Uses, - Uses#{V:=C-1}. - -is_n_uses(N, V, Uses) -> - case Uses of - #{V:=N} -> true; - #{} -> false - end. - is_single_use(V, Uses) -> case Uses of #{V:=1} -> true; @@ -1189,10 +1270,10 @@ place_frame_here(L, Blocks, Doms, Frames) -> Descendants = beam_ssa:rpo([L], Blocks), PhiPredecessors = phi_predecessors(L, Blocks), MustDominate = ordsets:from_list(PhiPredecessors ++ Descendants), - Dominates = all(fun(?BADARG_BLOCK) -> + Dominates = all(fun(?EXCEPTION_BLOCK) -> %% This block defines no variables and calls %% erlang:error(badarg). It does not matter - %% whether L dominates ?BADARG_BLOCK or not; + %% whether L dominates ?EXCEPTION_BLOCK or not; %% it is still safe to put the frame in L. true; (Bl) -> @@ -1340,9 +1421,9 @@ recv_common(_Defs, none, _Blocks) -> %% in the tail position of a function. []; recv_common(Defs, Exit, Blocks) -> - {ExitDefs,ExitUsed} = beam_ssa:def_used([Exit], Blocks), + {ExitDefs,ExitUnused} = beam_ssa:def_unused([Exit], Defs, Blocks), Def = ordsets:subtract(Defs, ExitDefs), - ordsets:intersection(Def, ExitUsed). + ordsets:subtract(Def, ExitUnused). %% recv_crit_edges([RemoveMessageLabel], LoopExit, %% Blocks0, Count0) -> {Blocks,Count}. @@ -1447,9 +1528,9 @@ exit_predecessors([], _Exit, _Blocks) -> []. %% later used within a clause of the receive. fix_receive([L|Ls], Defs, Blocks0, Count0) -> - {RmDefs,Used0} = beam_ssa:def_used([L], Blocks0), + {RmDefs,Unused} = beam_ssa:def_unused([L], Defs, Blocks0), Def = ordsets:subtract(Defs, RmDefs), - Used = ordsets:intersection(Def, Used0), + Used = ordsets:subtract(Def, Unused), {NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Used], Count0), Ren = zip(Used, NewVars), Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0), @@ -1483,8 +1564,8 @@ find_loop_exit(_, _) -> %% loop exit block. none. -find_loop_exit_1([?BADARG_BLOCK|Ls], RmSet, Dominators) -> - %% ?BADARG_BLOCK is a marker and not an actual block, so it is not +find_loop_exit_1([?EXCEPTION_BLOCK|Ls], RmSet, Dominators) -> + %% ?EXCEPTION_BLOCK is a marker and not an actual block, so it is not %% the block we are looking for. find_loop_exit_1(Ls, RmSet, Dominators); find_loop_exit_1([L|Ls], RmSet, Dominators) -> @@ -1756,7 +1837,7 @@ collect_yregs([], Yregs) -> Yregs. copy_retval_2([L|Ls], Yregs, Copy0, Blocks0, Count0) -> #b_blk{is=Is0,last=Last} = Blk = map_get(L, Blocks0), RC = case {Last,Ls} of - {#b_br{succ=Succ,fail=?BADARG_BLOCK},[Succ|_]} -> + {#b_br{succ=Succ,fail=?EXCEPTION_BLOCK},[Succ|_]} -> true; {_,_} -> false @@ -2105,8 +2186,8 @@ reserve_yregs(#st{frames=Frames}=St0) -> reserve_yregs_1(L, #st{ssa=Blocks0,cnt=Count0,res=Res0}=St) -> Blk = map_get(L, Blocks0), Yregs = beam_ssa:get_anno(yregs, Blk), - {Def,Used} = beam_ssa:def_used([L], Blocks0), - UsedYregs = ordsets:intersection(Yregs, Used), + {Def,Unused} = beam_ssa:def_unused([L], Yregs, Blocks0), + UsedYregs = ordsets:subtract(Yregs, Unused), DefBefore = ordsets:subtract(UsedYregs, Def), {BeforeVars,Blocks,Count} = rename_vars(DefBefore, L, Blocks0, Count0), InsideVars = ordsets:subtract(UsedYregs, DefBefore), @@ -2495,9 +2576,9 @@ reserve_xregs_is([], Res, Xs, _Used) -> {Res,Xs}. %% Pick up register hints from the successors of this blocks. -reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?BADARG_BLOCK}, +reserve_terminator(_L, _Is, #b_br{bool=#b_var{},succ=Succ,fail=?EXCEPTION_BLOCK}, _Blocks, XsMap, _Res) -> - %% We know that no variables are used at ?BADARG_BLOCK, so + %% We know that no variables are used at ?EXCEPTION_BLOCK, so %% any register hints from the success blocks are safe to use. map_get(Succ, XsMap); reserve_terminator(L, Is, #b_br{bool=#b_var{},succ=Succ,fail=Fail}, diff --git a/lib/compiler/src/beam_ssa_share.erl b/lib/compiler/src/beam_ssa_share.erl index 73983bd34a..fa728992f8 100644 --- a/lib/compiler/src/beam_ssa_share.erl +++ b/lib/compiler/src/beam_ssa_share.erl @@ -117,8 +117,8 @@ share_terminator(_Last, _Blocks) -> none. %% possible if the blocks are not equivalent, as that is the common %% case. -are_equivalent(_Succ, _, ?BADARG_BLOCK, _, _Blocks) -> - %% ?BADARG_BLOCK is special. Sharing could be incorrect. +are_equivalent(_Succ, _, ?EXCEPTION_BLOCK, _, _Blocks) -> + %% ?EXCEPTION_BLOCK is special. Sharing could be incorrect. false; are_equivalent(_Succ, #b_blk{is=Is1,last=#b_ret{arg=RetVal1}=Ret1}, _Fail, #b_blk{is=Is2,last=#b_ret{arg=RetVal2}=Ret2}, _Blocks) -> diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 3c06c83e2e..d93191c689 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -22,11 +22,12 @@ -export([opt_start/4, opt_continue/4, opt_finish/3]). -include("beam_ssa_opt.hrl"). --import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, - keyfind/3,reverse/1,reverse/2, - sort/1,split/2]). +-include("beam_types.hrl"). --define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). +-import(lists, [all/2,any/2,droplast/1,duplicate/2,foldl/3,last/1,member/2, + keyfind/3,reverse/1,sort/1,split/2,zip/2]). + +-define(UNICODE_MAX, (16#10FFFF)). -record(d, {ds :: #{beam_ssa:b_var():=beam_ssa:b_set()}, @@ -37,21 +38,6 @@ sub = #{} :: #{beam_ssa:b_var():=beam_ssa:value()}, ret_type = [] :: [type()]}). --define(ATOM_SET_SIZE, 5). - -%% Records that represent type information. --record(t_atom, {elements=any :: 'any' | [atom()]}). --record(t_integer, {elements=any :: 'any' | {integer(),integer()}}). --record(t_bs_match, {type :: type()}). --record(t_tuple, {size=0 :: integer(), - exact=false :: boolean(), - %% Known element types (1-based index), unknown elements are - %% are assumed to be 'any'. - elements=#{} :: #{ non_neg_integer() => type() }}). - --type type() :: 'any' | 'none' | - #t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} | - {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'. -type type_db() :: #{beam_ssa:var_name():=type()}. -spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when @@ -98,7 +84,8 @@ join_arg_types(Args, ArgTypes, Anno) -> end, Ts0, ParamTypes). join_arg_types_1([Arg | Args], [TM | TMs], Ts) when map_size(TM) =/= 0 -> - join_arg_types_1(Args, TMs, Ts#{ Arg => join(maps:values(TM))}); + Type = beam_types:join(maps:values(TM)), + join_arg_types_1(Args, TMs, Ts#{ Arg => Type }); join_arg_types_1([Arg | Args], [_TM | TMs], Ts) -> join_arg_types_1(Args, TMs, Ts#{ Arg => any }); join_arg_types_1([], [], Ts) -> @@ -122,7 +109,7 @@ opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) -> D = #d{ func_db=FuncDb0, func_id=Id, ds=Defs, - ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, + ls=#{0=>Ts,?EXCEPTION_BLOCK=>#{}}, once=UsedOnce }, {Linear, FuncDb, NewRet} = opt(Linear0, D, []), @@ -157,43 +144,15 @@ opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo) map_size(TypeMap) =:= 0 -> opt_finish_1(Args, TypeMaps, ParamInfo); opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) -> - case join(maps:values(TypeMap)) of - any -> - opt_finish_1(Args, TypeMaps, ParamInfo0); - none -> - %% This function will never be called. Pretend that we don't - %% know the type for this argument. - opt_finish_1(Args, TypeMaps, ParamInfo0); - JoinedType -> - JoinedType = verified_type(JoinedType), - ParamInfo = ParamInfo0#{ Arg => validator_anno(JoinedType) }, - opt_finish_1(Args, TypeMaps, ParamInfo) - end; + JoinedType = beam_types:join(maps:values(TypeMap)), + ParamInfo = case JoinedType of + any -> ParamInfo0; + _ -> ParamInfo0#{ Arg => JoinedType } + end, + opt_finish_1(Args, TypeMaps, ParamInfo); opt_finish_1([], [], ParamInfo) -> ParamInfo. -validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) -> - Elements = maps:fold(fun(Index, Type, Acc) -> - Key = beam_validator:type_anno(integer, Index), - Acc#{ Key => validator_anno(Type) } - end, #{}, Elements0), - beam_validator:type_anno(tuple, Size, Exact, Elements); -validator_anno(#t_integer{elements={Same,Same}}) -> - beam_validator:type_anno(integer, Same); -validator_anno(#t_integer{}) -> - beam_validator:type_anno(integer); -validator_anno(float) -> - beam_validator:type_anno(float); -validator_anno(#t_atom{elements=[Val]}) -> - beam_validator:type_anno(atom, Val); -validator_anno(#t_atom{}=A) -> - case t_is_boolean(A) of - true -> beam_validator:type_anno(bool); - false -> beam_validator:type_anno(atom) - end; -validator_anno(T) -> - beam_validator:type_anno(T). - get_func_id(Anno) -> #{func_info:={_Mod, Name, Arity}} = Anno, #b_local{name=#b_literal{val=Name}, arity=Arity}. @@ -212,27 +171,17 @@ opt([], D, Acc) -> opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0, #d{ds=Ds0,sub=Sub0,func_db=Fdb0}=D0, Acc) -> - case opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []) of - {Is,Ts,Ds,Fdb,Sub} -> - D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, - Last1 = simplify_terminator(Last0, Sub, Ts, Ds), - Last = opt_terminator(Last1, Ts, Ds), - D = update_successors(Last, Ts, D1), - Blk = Blk0#b_blk{is=Is,last=Last}, - opt(Bs, D, [{L,Blk}|Acc]); - {no_return,Ret,Is,Ds,Fdb,Sub} -> - %% This call will never reach the successor block. - %% Rewrite the terminator to a 'ret', and remove - %% all type information for this label. That can - %% potentially narrow the type of the phi node - %% in the former successor. - Ls = maps:remove(L, D0#d.ls), - RetType = join([none|D0#d.ret_type]), - D = D0#d{ds=Ds,ls=Ls,sub=Sub, - func_db=Fdb,ret_type=[RetType]}, - Blk = Blk0#b_blk{is=Is,last=Ret}, - opt(Bs, D, [{L,Blk}|Acc]) - end. + {Is,Ts,Ds,Fdb,Sub} = opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []), + + D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb}, + + Last1 = simplify_terminator(Last0, Sub, Ts, Ds), + Last2 = opt_terminator(Last1, Ts, Ds), + + {Last, D} = update_successors(Last2, Ts, D1), + + Blk = Blk0#b_blk{is=Is,last=Last}, + opt(Bs, D, [{L,Blk}|Acc]). simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) -> Br#b_br{bool=simplify_arg(Bool, Sub, Ts)}; @@ -265,203 +214,138 @@ opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is], Ds = Ds0#{Dst=>I}, opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]) end; -opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is], +opt_is([#b_set{op=call,args=Args0}=I0|Is], + Ts, Ds, Fdb0, D, Sub, Acc) -> + Args = simplify_args(Args0, Sub, Ts), + I1 = beam_ssa:normalize(I0#b_set{args=Args}), + {I, Fdb} = opt_call(I1, Ts, Fdb0, D), + opt_simplify(I, Is, Ts, Ds, Fdb, D, Sub, Acc); +opt_is([#b_set{op=make_fun,args=Args0}=I0|Is], Ts0, Ds0, Fdb0, D, Sub0, Acc) -> Args = simplify_args(Args0, Sub0, Ts0), I1 = beam_ssa:normalize(I0#b_set{args=Args}), - {Ts1,Ds,Fdb,I2} = opt_call(I1, D, Ts0, Ds0, Fdb0), - case {map_get(Dst, Ts1),Is} of - {Type,[#b_set{op=succeeded}]} when Type =/= none -> - %% This call instruction is inside a try/catch - %% block. Don't attempt to simplify it. - opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I2|Acc]); - {none,[#b_set{op=succeeded}]} -> - %% This call instruction is inside a try/catch - %% block, but we know it will never return and - %% later optimizations may try to exploit that. - %% - %% For example, if we have an expression that - %% either returns this call or a tuple, we know - %% that the expression always returns a tuple - %% and can turn a later element/3 into - %% get_tuple_element. - %% - %% This is sound but difficult to validate in a - %% meaningful way as try/catch currently forces - %% us to maintain the illusion that the success - %% block is reachable even when its not, so we - %% disable the optimization to keep things - %% simple. - Ts = Ts1#{ Dst := any }, - opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I2|Acc]); - {none,_} -> - %% This call never returns. The rest of the - %% instructions will not be executed. - Ret = #b_ret{arg=Dst}, - {no_return,Ret,reverse(Acc, [I2]),Ds,Fdb,Sub0}; - {_,_} -> - case simplify_call(I2) of - #b_set{}=I -> - opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I|Acc]); - #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - Ts = maps:remove(Dst, Ts1), - opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc); - #b_var{}=Var -> - Ts = maps:remove(Dst, Ts1), - Sub = Sub0#{Dst=>Var}, - opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc) - end - end; -opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I], + {Ts,Ds,Fdb,I} = opt_make_fun(I1, D, Ts0, Ds0, Fdb0), + opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]); +opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst,anno=Anno}=I], Ts0, Ds0, Fdb, D, Sub0, Acc) -> - case Ds0 of - #{ Arg := #b_set{op=call} } -> - %% The success check of a call is part of exception handling and - %% must not be optimized away. We still have to update its type - %% though. - Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{Dst=>I}, - - opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]); - #{} -> - Args = simplify_args([Arg], Sub0, Ts0), - Type = type(succeeded, Args, Ts0, Ds0), - case get_literal_from_type(Type) of - #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, - opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); - none -> - Ts = Ts0#{Dst=>Type}, - Ds = Ds0#{Dst=>I}, - opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]) - end + Type = case Ds0 of + #{ Arg := #b_set{op=call} } -> + %% Calls can always throw exceptions and their return types + %% are what they return on success, so we must avoid + %% simplifying arguments in case `Arg` would become a + %% literal, which would trick 'succeeded' into thinking it + %% can't fail. + type(succeeded, [Arg], Anno, Ts0, Ds0); + #{} -> + Args = simplify_args([Arg], Sub0, Ts0), + type(succeeded, Args, Anno, Ts0, Ds0) + end, + case beam_types:get_singleton_value(Type) of + {ok, Lit} -> + Sub = Sub0#{ Dst => #b_literal{val=Lit} }, + opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); + error -> + Ts = Ts0#{ Dst => Type }, + Ds = Ds0#{ Dst => I }, + opt_is([], Ts, Ds, Fdb, D, Sub0, [I | Acc]) end; -opt_is([#b_set{args=Args0,dst=Dst}=I0|Is], - Ts0, Ds0, Fdb, D, Sub0, Acc) -> - Args = simplify_args(Args0, Sub0, Ts0), - I1 = beam_ssa:normalize(I0#b_set{args=Args}), - case simplify(I1, Ts0) of +opt_is([#b_set{args=Args0}=I0|Is], + Ts, Ds, Fdb, D, Sub, Acc) -> + Args = simplify_args(Args0, Sub, Ts), + I = beam_ssa:normalize(I0#b_set{args=Args}), + opt_simplify(I, Is, Ts, Ds, Fdb, D, Sub, Acc); +opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) -> + {reverse(Acc), Ts, Ds, Fdb, Sub}. + +opt_simplify(#b_set{dst=Dst}=I0, Is, Ts0, Ds0, Fdb, D, Sub0, Acc) -> + case simplify(I0, Ts0) of #b_set{}=I2 -> I = beam_ssa:normalize(I2), Ts = update_types(I, Ts0, Ds0), - Ds = Ds0#{Dst=>I}, + Ds = Ds0#{ Dst => I }, opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]); #b_literal{}=Lit -> - Sub = Sub0#{Dst=>Lit}, + Sub = Sub0#{ Dst => Lit }, opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc); #b_var{}=Var -> case Is of [#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] -> - %% We must remove this 'succeeded' instruction. - Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}}, + %% We must remove this 'succeeded' instruction since the + %% variable it checks is gone. + Sub = Sub0#{ Dst => Var, SuccDst => #b_literal{val=true} }, opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc); _ -> - Sub = Sub0#{Dst=>Var}, + Sub = Sub0#{ Dst => Var}, opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc) end - end; -opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) -> - {reverse(Acc), Ts, Ds, Fdb, Sub}. - -simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) -> - case Rem of - #b_remote{mod=#b_literal{val=Mod}, - name=#b_literal{val=Name}} -> - case erl_bifs:is_pure(Mod, Name, length(Args)) of - true -> - simplify_remote_call(Mod, Name, Args, I); - false -> - I - end; - #b_remote{} -> - I - end; -simplify_call(I) -> I. - -%% Simplify a remote call to a pure BIF. -simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> - Tl; -simplify_remote_call(erlang, setelement, - [#b_literal{val=Pos}, - #b_literal{val=Tuple}, - #b_var{}=Value], I) - when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> - %% Position is a literal integer and the shape of the - %% tuple is known. - Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], - {Bef,[_|Aft]} = split(Pos - 1, Els0), - Els = Bef ++ [Value|Aft], - I#b_set{op=put_tuple,args=Els}; -simplify_remote_call(Mod, Name, Args0, I) -> - case make_literal_list(Args0) of - none -> - I; - Args -> - %% The arguments are literals. Try to evaluate the BIF. - try apply(Mod, Name, Args) of - Val -> - case cerl:is_literal_term(Val) of - true -> - #b_literal{val=Val}; - false -> - %% The value can't be expressed as a literal - %% (e.g. a pid). - I - end - catch - _:_ -> - %% Failed. Don't bother trying to optimize - %% the call. - I - end end. -opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) -> - {Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0), +opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, Ts, Fdb0, D) -> + I = opt_local_call_return(I0, Callee, Fdb0), case Fdb0 of #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + %% Match contexts are treated as bitstrings when optimizing + %% arguments, as we don't yet support removing the + %% "bs_start_match3" instruction. + Types = [case raw_type(Arg, Ts) of + #t_bs_context{} -> #t_bitstring{}; + Type -> Type + end || Arg <- Args], + %% Update the argument types of *this exact call*, the types %% will be joined later when the callee is optimized. CallId = {D#d.func_id, Dst}, - ArgTypes = update_arg_types(Args, ArgTypes0, CallId, Ts0), + ArgTypes = update_arg_types(Types, ArgTypes0, CallId), Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, - {Ts, Ds, Fdb, I}; + {I, Fdb}; #{} -> %% We can't narrow the argument types of exported functions as they %% can receive anything as part of an external call. - {Ts, Ds, Fdb0, I} + {I, Fdb0} end; -opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) -> +opt_call(I, _Ts, Fdb, _D) -> + {I, Fdb}. + +opt_local_call_return(I, Callee, Fdb) -> + case Fdb of + #{ Callee := #func_info{ret_type=[Type]} } when Type =/= any -> + beam_ssa:add_anno(result_type, Type, I); + #{} -> + I + end. + +%% While we have no way to know which arguments a fun will be called with, we +%% do know its free variables and can update their types as if this were a +%% local call. +opt_make_fun(#b_set{op=make_fun, + dst=Dst, + args=[#b_local{}=Callee | FreeVars]}=I, + D, Ts0, Ds0, Fdb0) -> Ts = update_types(I, Ts0, Ds0), Ds = Ds0#{ Dst => I }, - {Ts, Ds, Fdb, I}. + case Fdb0 of + #{ Callee := #func_info{exported=false,arg_types=ArgTypes0}=Info } -> + ArgCount = Callee#b_local.arity - length(FreeVars), -opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) -> - Type = case Fdb of - #{ Id := #func_info{ret_type=[T]} } -> T; - #{} -> any - end, - I = case Type of - any -> I0; - none -> I0; - _ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0) - end, - Ts = Ts0#{ Dst => Type }, - Ds = Ds0#{ Dst => I }, - {Ts, Ds, I}. - -update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) -> - %% Match contexts are treated as bitstrings when optimizing arguments, as - %% we don't yet support removing the "bs_start_match3" instruction. - NewType = case get_type(Arg, Ts) of - #t_bs_match{} -> {binary, 1}; - Type -> Type - end, - TypeMap = TypeMap0#{ CallId => NewType }, - [TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)]; -update_arg_types([], [], _CallId, _Ts) -> + FVTypes = [raw_type(FreeVar, Ts) || FreeVar <- FreeVars], + Types = duplicate(ArgCount, any) ++ FVTypes, + + CallId = {D#d.func_id, Dst}, + ArgTypes = update_arg_types(Types, ArgTypes0, CallId), + + Fdb = Fdb0#{ Callee => Info#func_info{arg_types=ArgTypes} }, + {Ts, Ds, Fdb, I}; + #{} -> + %% We can't narrow the argument types of exported functions as they + %% can receive anything as part of an external call. + {Ts, Ds, Fdb0, I} + end. + +update_arg_types([ArgType | ArgTypes], [TypeMap0 | TypeMaps], CallId) -> + TypeMap = TypeMap0#{ CallId => ArgType }, + [TypeMap | update_arg_types(ArgTypes, TypeMaps, CallId)]; +update_arg_types([], [], _CallId) -> []. simplify(#b_set{op={bif,'and'},args=Args}=I, Ts) -> @@ -487,8 +371,10 @@ simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) -> I end; simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> - case t_tuple_size(get_type(Tuple, Ts)) of - {_,Size} when is_integer(Index), 1 =< Index, Index =< Size -> + case normalized_type(Tuple, Ts) of + #t_tuple{size=Size} when is_integer(Index), + 1 =< Index, + Index =< Size -> I = I0#b_set{op=get_tuple_element, args=[Tuple,#b_literal{val=Index-1}]}, simplify(I, Ts); @@ -496,67 +382,97 @@ simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) -> eval_bif(I0, Ts) end; simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) -> - case get_type(List, Ts) of + case normalized_type(List, Ts) of cons -> I#b_set{op=get_hd}; _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,tl},args=[List]}=I, Ts) -> - case get_type(List, Ts) of + case normalized_type(List, Ts) of cons -> I#b_set{op=get_tl}; _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,size},args=[Term]}=I, Ts) -> - case get_type(Term, Ts) of + case normalized_type(Term, Ts) of #t_tuple{} -> simplify(I#b_set{op={bif,tuple_size}}, Ts); _ -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,tuple_size},args=[Term]}=I, Ts) -> - case get_type(Term, Ts) of + case normalized_type(Term, Ts) of #t_tuple{size=Size,exact=true} -> #b_literal{val=Size}; _ -> I end; -simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) -> - Types = get_types(Args, Ts), - EqEq = case {meet(Types),join(Types)} of - {none,any} -> true; - {#t_integer{},#t_integer{}} -> true; - {float,float} -> true; - {{binary,_},_} -> true; - {#t_atom{},_} -> true; - {_,_} -> false - end, +simplify(#b_set{op={bif,is_function},args=[Fun,#b_literal{val=Arity}]}=I, Ts) + when is_integer(Arity), Arity >= 0 -> + case normalized_type(Fun, Ts) of + #t_fun{arity=any} -> + I; + #t_fun{arity=Arity} -> + #b_literal{val=true}; + any -> + I; + _ -> + #b_literal{val=false} + end; +simplify(#b_set{op={bif,Op0},args=Args}=I, Ts) when Op0 =:= '=='; Op0 =:= '/=' -> + Types = normalized_types(Args, Ts), + EqEq0 = case {beam_types:meet(Types),beam_types:join(Types)} of + {none,any} -> true; + {#t_integer{},#t_integer{}} -> true; + {float,float} -> true; + {#t_bitstring{},_} -> true; + {#t_atom{},_} -> true; + {_,_} -> false + end, + EqEq = EqEq0 orelse any_non_numeric_argument(Args, Ts), case EqEq of true -> - simplify(I#b_set{op={bif,'=:='}}, Ts); + Op = case Op0 of + '==' -> '=:='; + '/=' -> '=/=' + end, + simplify(I#b_set{op={bif,Op}}, Ts); false -> eval_bif(I, Ts) end; simplify(#b_set{op={bif,'=:='},args=[Same,Same]}, _Ts) -> #b_literal{val=true}; -simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) -> - [T1,T2] = get_types(Args, Ts), - case meet(T1, T2) of +simplify(#b_set{op={bif,'=:='},args=[LHS,RHS]}=I, Ts) -> + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + case beam_types:meet(LType, RType) of none -> #b_literal{val=false}; _ -> - case {t_is_boolean(T1),T2} of + case {beam_types:is_boolean_type(LType), + beam_types:normalize(RType)} of {true,#t_atom{elements=[true]}} -> %% Bool =:= true ==> Bool - A1; + LHS; + {true,#t_atom{elements=[false]}} -> + %% Bool =:= false ==> not Bool + %% + %% This will be further optimized to eliminate the + %% 'not', swapping the success and failure + %% branches in the br instruction. If LHS comes + %% from a type test (such as is_atom/1) or a + %% comparison operator (such as >=) that can be + %% translated to test instruction, this + %% optimization will eliminate one instruction. + simplify(I#b_set{op={bif,'not'},args=[LHS]}, Ts); {_,_} -> eval_bif(I, Ts) end end; simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> - Types = get_types(Args, Ts), + Types = normalized_types(Args, Ts), case is_float_op(Op, Types) of false -> eval_bif(I, Ts); @@ -565,20 +481,15 @@ simplify(#b_set{op={bif,Op},args=Args}=I, Ts) -> eval_bif(beam_ssa:add_anno(float_op, AnnoArgs, I), Ts) end; simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) -> - case get_type(Tuple, Ts) of - #t_tuple{size=Size,elements=Es} when Size > N -> - ElemType = get_element_type(N + 1, Es), - case get_literal_from_type(ElemType) of - #b_literal{}=Lit -> Lit; - none -> I - end; - none -> - %% Will never be executed because of type conflict. - %% #b_literal{val=ignored}; - I + #t_tuple{size=Size,elements=Es} = normalized_type(Tuple, Ts), + true = Size > N, %Assertion. + ElemType = beam_types:get_element_type(N + 1, Es), + case beam_types:get_singleton_value(ElemType) of + {ok, Val} -> #b_literal{val=Val}; + error -> I end; simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> - case get_type(Src, Ts) of + case normalized_type(Src, Ts) of any -> I; list -> I; cons -> #b_literal{val=true}; @@ -586,7 +497,7 @@ simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) -> end; simplify(#b_set{op=is_tagged_tuple, args=[Src,#b_literal{val=Size},#b_literal{}=Tag]}=I, Ts) -> - simplify_is_record(I, get_type(Src, Ts), Size, Tag, Ts); + simplify_is_record(I, normalized_type(Src, Ts), Size, Tag, Ts); simplify(#b_set{op=put_list,args=[#b_literal{val=H}, #b_literal{val=T}]}, _Ts) -> #b_literal{val=[H|T]}; @@ -599,8 +510,97 @@ simplify(#b_set{op=wait_timeout,args=[#b_literal{val=0}]}, _Ts) -> #b_literal{val=true}; simplify(#b_set{op=wait_timeout,args=[#b_literal{val=infinity}]}=I, _Ts) -> I#b_set{op=wait,args=[]}; +simplify(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I, _Ts) -> + case Rem of + #b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Name}} -> + case erl_bifs:is_pure(Mod, Name, length(Args)) of + true -> + simplify_remote_call(Mod, Name, Args, I); + false -> + I + end; + #b_remote{} -> + I + end; simplify(I, _Ts) -> I. +%% Simplify a remote call to a pure BIF. +simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> + Tl; +simplify_remote_call(erlang, setelement, + [#b_literal{val=Pos}, + #b_literal{val=Tuple}, + #b_var{}=Value], I) + when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> + %% Position is a literal integer and the shape of the + %% tuple is known. + Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], + {Bef,[_|Aft]} = split(Pos - 1, Els0), + Els = Bef ++ [Value|Aft], + I#b_set{op=put_tuple,args=Els}; +simplify_remote_call(Mod, Name, Args0, I) -> + case make_literal_list(Args0) of + none -> + I; + Args -> + %% The arguments are literals. Try to evaluate the BIF. + try apply(Mod, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + #b_literal{val=Val}; + false -> + %% The value can't be expressed as a literal + %% (e.g. a pid). + I + end + catch + _:_ -> + %% Failed. Don't bother trying to optimize + %% the call. + I + end + end. + +any_non_numeric_argument([#b_literal{val=Lit}|_], _Ts) -> + is_non_numeric(Lit); +any_non_numeric_argument([#b_var{}=V|T], Ts) -> + is_non_numeric_type(raw_type(V, Ts)) orelse any_non_numeric_argument(T, Ts); +any_non_numeric_argument([], _Ts) -> false. + +is_non_numeric([H|T]) -> + is_non_numeric(H) andalso is_non_numeric(T); +is_non_numeric(Tuple) when is_tuple(Tuple) -> + is_non_numeric_tuple(Tuple, tuple_size(Tuple)); +is_non_numeric(Map) when is_map(Map) -> + %% Note that 17.x and 18.x compare keys in different ways. + %% Be very conservative -- require that both keys and values + %% are non-numeric. + is_non_numeric(maps:to_list(Map)); +is_non_numeric(Num) when is_number(Num) -> + false; +is_non_numeric(_) -> true. + +is_non_numeric_tuple(Tuple, El) when El >= 1 -> + is_non_numeric(element(El, Tuple)) andalso + is_non_numeric_tuple(Tuple, El-1); +is_non_numeric_tuple(_Tuple, 0) -> true. + +is_non_numeric_type(#t_atom{}) -> true; +is_non_numeric_type(#t_bitstring{}) -> true; +is_non_numeric_type(nil) -> true; +is_non_numeric_type(#t_tuple{size=Size,exact=true,elements=Types}) + when map_size(Types) =:= Size -> + is_non_numeric_tuple_type(Size, Types); +is_non_numeric_type(_) -> false. + +is_non_numeric_tuple_type(0, _Types) -> + true; +is_non_numeric_tuple_type(Pos, Types) -> + is_non_numeric_type(map_get(Pos, Types)) andalso + is_non_numeric_tuple_type(Pos - 1, Types). + make_literal_list(Args) -> make_literal_list(Args, []). @@ -611,9 +611,11 @@ make_literal_list([_|_], _) -> make_literal_list([], Acc) -> reverse(Acc). -is_safe_bool_op(Args, Ts) -> - [T1,T2] = get_types(Args, Ts), - t_is_boolean(T1) andalso t_is_boolean(T2). +is_safe_bool_op([LHS, RHS], Ts) -> + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + beam_types:is_boolean_type(LType) andalso + beam_types:is_boolean_type(RType). all_same([{H,_}|T]) -> all(fun({E,_}) -> E =:= H end, T). @@ -626,7 +628,7 @@ eval_bif(#b_set{op={bif,Bif},args=Args}=I, Ts) -> true -> case make_literal_list(Args) of none -> - case get_types(Args, Ts) of + case normalized_types(Args, Ts) of [any] -> I; [Type] -> @@ -659,10 +661,9 @@ simplify_arg(#b_var{}=Arg0, Sub, Ts) -> #b_literal{}=LitArg -> LitArg; #b_var{}=Arg -> - Type = get_type(Arg, Ts), - case get_literal_from_type(Type) of - none -> Arg; - #b_literal{}=Lit -> Lit + case beam_types:get_singleton_value(raw_type(Arg, Ts)) of + {ok, Val} -> #b_literal{val=Val}; + error -> Arg end end; simplify_arg(#b_remote{mod=Mod,name=Name}=Rem, Sub, Ts) -> @@ -701,7 +702,7 @@ opt_terminator(#b_br{bool=#b_var{}}=Br, Ts, Ds) -> opt_terminator(#b_switch{arg=#b_literal{}}=Sw, _Ts, _Ds) -> beam_ssa:normalize(Sw); opt_terminator(#b_switch{arg=#b_var{}=V}=Sw, Ts, Ds) -> - case get_type(V, Ts) of + case normalized_type(V, Ts) of any -> beam_ssa:normalize(Sw); Type -> @@ -717,7 +718,7 @@ opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) -> #t_integer{elements={_,_}=Range} -> simplify_switch_int(Sw1, Range); #t_atom{elements=[_|_]} -> - case t_is_boolean(Type) of + case beam_types:is_boolean_type(Type) of true -> #b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds), opt_terminator(Br, Ts, Ds); @@ -731,7 +732,7 @@ opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) -> prune_switch_list([{_,Fail}|T], Fail, Type, Ts) -> prune_switch_list(T, Fail, Type, Ts); prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) -> - case meet(get_type(Arg, Ts), Type) of + case beam_types:meet(raw_type(Arg, Ts), Type) of none -> %% Different types. This value can never match. prune_switch_list(T, Fail, Type, Ts); @@ -740,82 +741,91 @@ prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) -> end; prune_switch_list([], _, _, _) -> []. -update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) -> - update_successor(S, Ts, D); -update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> - case cerl_sets:is_element(Bool, D0#d.once) of - true -> - %% This variable is defined in this block and is only - %% referenced by this br terminator. Therefore, there is - %% no need to include it in the type database passed on to - %% the successors of this block. - Ts = maps:remove(Bool, Ts0), - {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0), - D = update_successor(Fail, FailTs, D0), - update_successor(Succ, SuccTs, D); - false -> - {SuccTs,FailTs} = infer_types_br(Bool, Ts0, D0), - D = update_successor_bool(Bool, false, Fail, FailTs, D0), - update_successor_bool(Bool, true, Succ, SuccTs, D) - end; -update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) -> - case cerl_sets:is_element(V, D0#d.once) of - true -> - %% This variable is defined in this block and is only - %% referenced by this switch terminator. Therefore, there is - %% no need to include it in the type database passed on to - %% the successors of this block. - D = update_successor(Fail, Ts, D0), - F = fun({Val,S}, A) -> - SuccTs0 = infer_types_switch(V, Val, Ts, D), - SuccTs = maps:remove(V, SuccTs0), - update_successor(S, SuccTs, A) - end, - foldl(F, D, List); - false -> - %% V can not be equal to any of the values in List at the fail - %% block. - FailTs = subtract_sw_list(V, List, Ts), - D = update_successor(Fail, FailTs, D0), - F = fun({Val,S}, A) -> - SuccTs = infer_types_switch(V, Val, Ts, D), - update_successor(S, SuccTs, A) - end, - foldl(F, D, List) +update_successors(#b_br{bool=#b_literal{val=true},succ=Succ}=Last, Ts, D0) -> + {Last, update_successor(Succ, Ts, D0)}; +update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}=Last0, + Ts, D0) -> + UsedOnce = cerl_sets:is_element(Bool, D0#d.once), + case infer_types_br(Bool, Ts, UsedOnce, D0) of + {#{}=SuccTs, #{}=FailTs} -> + D1 = update_successor(Succ, SuccTs, D0), + D = update_successor(Fail, FailTs, D1), + {Last0, D}; + {#{}=SuccTs, none} -> + Last = Last0#b_br{bool=#b_literal{val=true},fail=Succ}, + {Last, update_successor(Succ, SuccTs, D0)}; + {none, #{}=FailTs} -> + Last = Last0#b_br{bool=#b_literal{val=true},succ=Fail}, + {Last, update_successor(Fail, FailTs, D0)} end; -update_successors(#b_ret{arg=Arg}, Ts, D) -> - FuncId = D#d.func_id, - case D#d.ds of - #{ Arg := #b_set{op=call,args=[FuncId | _]} } -> - %% Returning a call to ourselves doesn't affect our own return - %% type. - D; +update_successors(#b_switch{arg=#b_var{}=V,fail=Fail0,list=List0}=Last0, + Ts, D0) -> + UsedOnce = cerl_sets:is_element(V, D0#d.once), + + {List1, D1} = update_switch(List0, V, Ts, UsedOnce, [], D0), + FailTs = update_switch_failure(V, List0, Ts, UsedOnce, D1), + + case FailTs of + none -> + %% The fail block is unreachable; swap it with one of the choices. + [{_, Fail} | List] = List1, + Last = Last0#b_switch{fail=Fail,list=List}, + {Last, D1}; #{} -> - RetType = join([get_type(Arg, Ts) | D#d.ret_type]), - D#d{ret_type=[RetType]} - end. + D = update_successor(Fail0, FailTs, D1), + Last = Last0#b_switch{list=List1}, + {Last, D} + end; +update_successors(#b_ret{arg=Arg}=Last, Ts, D0) -> + FuncId = D0#d.func_id, + D = case D0#d.ds of + #{ Arg := #b_set{op=call,args=[FuncId | _]} } -> + %% Returning a call to ourselves doesn't affect our own return + %% type. + D0; + #{} -> + RetType = beam_types:join([raw_type(Arg, Ts) | D0#d.ret_type]), + D0#d{ret_type=[RetType]} + end, + {Last, D}. + +update_switch([{Val, Lbl}=Sw | List], V, Ts, UsedOnce, Acc, D0) -> + case infer_types_switch(V, Val, Ts, UsedOnce, D0) of + none -> + update_switch(List, V, Ts, UsedOnce, Acc, D0); + SwTs -> + D = update_successor(Lbl, SwTs, D0), + update_switch(List, V, Ts, UsedOnce, [Sw | Acc], D) + end; +update_switch([], _V, _Ts, _UsedOnce, Acc, D) -> + {reverse(Acc), D}. -subtract_sw_list(V, List, Ts) -> - Ts#{ V := sub_sw_list_1(get_type(V, Ts), List, Ts) }. +update_switch_failure(V, List, Ts, UsedOnce, D) -> + case sub_sw_list_1(raw_type(V, Ts), List, Ts) of + none -> + none; + FailType -> + case beam_types:get_singleton_value(FailType) of + {ok, Value} -> + %% This is the only possible value at the fail label, so we + %% can infer types as if we matched it directly. + Lit = #b_literal{val=Value}, + infer_types_switch(V, Lit, Ts, UsedOnce, D); + error when UsedOnce -> + ts_remove_var(V, Ts); + error -> + Ts + end + end. sub_sw_list_1(Type, [{Val,_}|T], Ts) -> - ValType = get_type(Val, Ts), - sub_sw_list_1(subtract(Type, ValType), T, Ts); + ValType = raw_type(Val, Ts), + sub_sw_list_1(beam_types:subtract(Type, ValType), T, Ts); sub_sw_list_1(Type, [], _Ts) -> Type. -update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> - case t_is_boolean(get_type(Var, Ts)) of - true -> - update_successor(S, Ts#{Var:=t_atom(BoolValue)}, D); - false -> - %% The `br` terminator is preceeded by an instruction that - %% does not produce a boolean value, such a `new_try_tag`. - update_successor(S, Ts, D) - end. - -update_successor(?BADARG_BLOCK, _Ts, #d{}=D) -> - %% We KNOW that no variables are used in the ?BADARG_BLOCK, +update_successor(?EXCEPTION_BLOCK, _Ts, #d{}=D) -> + %% We KNOW that no variables are used in the ?EXCEPTION_BLOCK, %% so there is no need to update the type information. That %% can be a huge timesaver for huge functions. D; @@ -828,247 +838,102 @@ update_successor(S, Ts0, #d{ls=Ls}=D) -> D#d{ls=Ls#{S=>Ts0}} end. -update_types(#b_set{op=Op,dst=Dst,args=Args}, Ts, Ds) -> - T = type(Op, Args, Ts, Ds), +update_types(#b_set{op=Op,dst=Dst,anno=Anno,args=Args}, Ts, Ds) -> + T = type(Op, Args, Anno, Ts, Ds), Ts#{Dst=>T}. -type(phi, Args, Ts, _Ds) -> - Types = [get_type(A, Ts) || {A,_} <- Args], - join(Types); -type({bif,'band'}, Args, Ts, _Ds) -> - band_type(Args, Ts); -type({bif,Bif}, Args, Ts, _Ds) -> - case bif_type(Bif, Args) of - number -> - arith_op_type(Args, Ts); - Type -> - Type +type(phi, Args, _Anno, Ts, _Ds) -> + Types = [raw_type(A, Ts) || {A,_} <- Args], + beam_types:join(Types); +type({bif,Bif}, Args, _Anno, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(erlang, Bif, ArgTypes), + RetType; +type(bs_init, _Args, _Anno, _Ts, _Ds) -> + #t_bitstring{}; +type(bs_extract, [Ctx], _Anno, _Ts, Ds) -> + #b_set{op=bs_match,args=Args} = map_get(Ctx, Ds), + bs_match_type(Args); +type(bs_match, _Args, _Anno, _Ts, _Ds) -> + #t_bs_context{}; +type(bs_get_tail, _Args, _Anno, _Ts, _Ds) -> + #t_bitstring{}; +type(call, [#b_local{} | _Args], Anno, _Ts, _Ds) -> + case Anno of + #{ result_type := Type } -> Type; + #{} -> any end; -type(bs_init, _Args, _Ts, _Ds) -> - {binary, 1}; -type(bs_extract, [Ctx], Ts, _Ds) -> - #t_bs_match{type=Type} = get_type(Ctx, Ts), - Type; -type(bs_match, Args, _Ts, _Ds) -> - #t_bs_match{type=bs_match_type(Args)}; -type(bs_get_tail, _Args, _Ts, _Ds) -> - {binary, 1}; type(call, [#b_remote{mod=#b_literal{val=Mod}, - name=#b_literal{val=Name}}|Args], Ts, _Ds) -> - case {Mod,Name,Args} of - {erlang,setelement,[Pos,Tuple,Arg]} -> - case {get_type(Pos, Ts),get_type(Tuple, Ts)} of - {#t_integer{elements={Index,Index}}, - #t_tuple{elements=Es0,size=Size}=T} -> - %% This is an exact index, update the type of said element - %% or return 'none' if it's known to be out of bounds. - Es = set_element_type(Index, get_type(Arg, Ts), Es0), - case T#t_tuple.exact of - false -> - T#t_tuple{size=max(Index, Size),elements=Es}; - true when Index =< Size -> - T#t_tuple{elements=Es}; - true -> - none - end; - {#t_integer{elements={Min,_}}=IntType, - #t_tuple{elements=Es0,size=Size}=T} -> - %% Remove type information for all indices that - %% falls into the range of the integer. - Es = remove_element_info(IntType, Es0), - case T#t_tuple.exact of - false -> - T#t_tuple{elements=Es,size=max(Min, Size)}; - true when Min =< Size -> - T#t_tuple{elements=Es,size=Size}; - true -> - none - end; - {_,#t_tuple{}=T} -> - %% Position unknown, so we have to discard all element - %% information. - T#t_tuple{elements=#{}}; - {#t_integer{elements={Min,_Max}},_} -> - #t_tuple{size=Min}; - {_,_} -> - #t_tuple{} - end; - {erlang,'++',[LHS,RHS]} -> - LType = get_type(LHS, Ts), - RType = get_type(RHS, Ts), - case LType =:= cons orelse RType =:= cons of - true -> - cons; - false -> - %% `[] ++ RHS` yields RHS, even if RHS is not a list. - join(list, RType) - end; - {erlang,'--',[_,_]} -> - list; - {lists,F,Args} -> - Types = get_types(Args, Ts), - lists_function_type(F, Types); - {math,_,_} -> - case is_math_bif(Name, length(Args)) of - false -> any; - true -> float - end; - {_,_,_} -> - case erl_bifs:is_exit_bif(Mod, Name, length(Args)) of - true -> none; - false -> any - end - end; -type(get_tuple_element, [Tuple, Offset], Ts, _Ds) -> - #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts), + name=#b_literal{val=Name}}|Args], _Anno, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), + {RetType, _, _} = beam_call_types:types(Mod, Name, ArgTypes), + RetType; +type(get_tuple_element, [Tuple, Offset], _Anno, Ts, _Ds) -> + #t_tuple{size=Size,elements=Es} = normalized_type(Tuple, Ts), #b_literal{val=N} = Offset, true = Size > N, %Assertion. - get_element_type(N + 1, Es); -type(is_nonempty_list, [_], _Ts, _Ds) -> - t_boolean(); -type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) -> - t_boolean(); -type(put_map, _Args, _Ts, _Ds) -> - map; -type(put_list, _Args, _Ts, _Ds) -> + beam_types:get_element_type(N + 1, Es); +type(is_nonempty_list, [_], _Anno, _Ts, _Ds) -> + beam_types:make_boolean(); +type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Anno, _Ts, _Ds) -> + beam_types:make_boolean(); +type(make_fun, [#b_local{arity=TotalArity}|Env], _Anno, _Ts, _Ds) -> + #t_fun{arity=TotalArity-length(Env)}; +type(put_map, _Args, _Anno, _Ts, _Ds) -> + #t_map{}; +type(put_list, _Args, _Anno, _Ts, _Ds) -> cons; -type(put_tuple, Args, Ts, _Ds) -> +type(put_tuple, Args, _Anno, Ts, _Ds) -> {Es, _} = foldl(fun(Arg, {Es0, Index}) -> - Type = get_type(Arg, Ts), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} + Type = raw_type(Arg, Ts), + Es = beam_types:set_element_type(Index, Type, Es0), + {Es, Index + 1} end, {#{}, 1}, Args), #t_tuple{exact=true,size=length(Args),elements=Es}; -type(succeeded, [#b_var{}=Src], Ts, Ds) -> +type(succeeded, [#b_var{}=Src], _Anno, Ts, _Ds) + when map_get(Src, Ts) =:= none -> + beam_types:make_atom(false); +type(succeeded, [#b_var{}=Src], _Anno, Ts, Ds) -> case maps:get(Src, Ds) of #b_set{op={bif,Bif},args=BifArgs} -> - Types = get_types(BifArgs, Ts), - case {Bif,Types} of - {BoolOp,[T1,T2]} when BoolOp =:= 'and'; BoolOp =:= 'or' -> - case t_is_boolean(T1) andalso t_is_boolean(T2) of - true -> t_atom(true); - false -> t_boolean() - end; - {byte_size,[{binary,_}]} -> - t_atom(true); - {bit_size,[{binary,_}]} -> - t_atom(true); - {map_size,[map]} -> - t_atom(true); - {'not',[Type]} -> - case t_is_boolean(Type) of - true -> t_atom(true); - false -> t_boolean() - end; - {size,[{binary,_}]} -> - t_atom(true); - {tuple_size,[#t_tuple{}]} -> - t_atom(true); - {_,_} -> - t_boolean() + ArgTypes = normalized_types(BifArgs, Ts), + case beam_call_types:will_succeed(erlang, Bif, ArgTypes) of + yes -> beam_types:make_atom(true); + no -> beam_types:make_atom(false); + maybe -> beam_types:make_boolean() + end; + #b_set{op=call,args=[#b_remote{mod=#b_literal{val=Mod}, + name=#b_literal{val=Func}} | + CallArgs]} -> + ArgTypes = normalized_types(CallArgs, Ts), + case beam_call_types:will_succeed(Mod, Func, ArgTypes) of + yes -> beam_types:make_atom(true); + no -> beam_types:make_atom(false); + maybe -> beam_types:make_boolean() end; #b_set{op=get_hd} -> - t_atom(true); + beam_types:make_atom(true); #b_set{op=get_tl} -> - t_atom(true); + beam_types:make_atom(true); #b_set{op=get_tuple_element} -> - t_atom(true); + beam_types:make_atom(true); + #b_set{op=put_tuple} -> + beam_types:make_atom(true); #b_set{op=wait} -> - t_atom(false); + beam_types:make_atom(false); #b_set{} -> - t_boolean() + beam_types:make_boolean() end; -type(succeeded, [#b_literal{}], _Ts, _Ds) -> - t_atom(true); -type(_, _, _, _) -> any. - -arith_op_type(Args, Ts) -> - Types = get_types(Args, Ts), - foldl(fun(#t_integer{}, unknown) -> t_integer(); - (#t_integer{}, number) -> number; - (#t_integer{}, float) -> float; - (#t_integer{}, #t_integer{}) -> t_integer(); - (float, unknown) -> float; - (float, #t_integer{}) -> float; - (float, number) -> float; - (number, unknown) -> number; - (number, #t_integer{}) -> number; - (number, float) -> float; - (any, _) -> number; - (Same, Same) -> Same; - (_, _) -> none - end, unknown, Types). - -lists_function_type(F, Types) -> - case {F,Types} of - %% Functions that return booleans. - {all,[_,_]} -> - t_boolean(); - {any,[_,_]} -> - t_boolean(); - {keymember,[_,_,_]} -> - t_boolean(); - {member,[_,_]} -> - t_boolean(); - {prefix,[_,_]} -> - t_boolean(); - {suffix,[_,_]} -> - t_boolean(); - - %% Functions that return lists. - {dropwhile,[_,_]} -> - list; - {duplicate,[_,_]} -> - list; - {filter,[_,_]} -> - list; - {flatten,[_]} -> - list; - {map,[_Fun,List]} -> - same_length_type(List); - {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; - MapFold =:= mapfoldr -> - #t_tuple{size=2,exact=true, - elements=#{1=>same_length_type(List)}}; - {partition,[_,_]} -> - t_two_tuple(list, list); - {reverse,[List]} -> - same_length_type(List); - {sort,[List]} -> - same_length_type(List); - {splitwith,[_,_]} -> - t_two_tuple(list, list); - {takewhile,[_,_]} -> - list; - {unzip,[List]} -> - ListType = same_length_type(List), - t_two_tuple(ListType, ListType); - {usort,[List]} -> - same_length_type(List); - {zip,[_,_]} -> - list; - {zipwith,[_,_,_]} -> - list; - {_,_} -> - any - end. - -%% For a lists function that return a list of the same -%% length as the input list, return the type of the list. -same_length_type(cons) -> cons; -same_length_type(nil) -> nil; -same_length_type(_) -> list. - -t_two_tuple(Type1, Type2) -> - #t_tuple{size=2,exact=true, - elements=#{1=>Type1,2=>Type2}}. +type(succeeded, [#b_literal{}], _Anno, _Ts, _Ds) -> + beam_types:make_atom(true); +type(_, _, _, _, _) -> any. %% will_succeed(TestOperation, Type) -> yes|no|maybe. %% Test whether TestOperation applied to an argument of type Type %% will succeed. Return yes, no, or maybe. %% -%% Type is a type as described in the comment for verified_type/1 at -%% the very end of this file, but it will *never* be 'any'. +%% Type can be any type as described in beam_types.hrl, but it must *never* be +%% any. will_succeed(is_atom, Type) -> case Type of @@ -1077,13 +942,13 @@ will_succeed(is_atom, Type) -> end; will_succeed(is_binary, Type) -> case Type of - {binary,U} when U rem 8 =:= 0 -> yes; - {binary,_} -> maybe; + #t_bitstring{unit=U} when U rem 8 =:= 0 -> yes; + #t_bitstring{} -> maybe; _ -> no end; will_succeed(is_bitstring, Type) -> case Type of - {binary,_} -> yes; + #t_bitstring{} -> yes; _ -> no end; will_succeed(is_boolean, Type) -> @@ -1091,7 +956,7 @@ will_succeed(is_boolean, Type) -> #t_atom{elements=any} -> maybe; #t_atom{elements=Es} -> - case t_is_boolean(Type) of + case beam_types:is_boolean_type(Type) of true -> yes; false -> @@ -1109,6 +974,11 @@ will_succeed(is_float, Type) -> number -> maybe; _ -> no end; +will_succeed(is_function, Type) -> + case Type of + #t_fun{} -> yes; + _ -> no + end; will_succeed(is_integer, Type) -> case Type of #t_integer{} -> yes; @@ -1123,7 +993,7 @@ will_succeed(is_list, Type) -> end; will_succeed(is_map, Type) -> case Type of - map -> yes; + #t_map{} -> yes; _ -> no end; will_succeed(is_number, Type) -> @@ -1140,35 +1010,12 @@ will_succeed(is_tuple, Type) -> end; will_succeed(_, _) -> maybe. - -band_type([Other,#b_literal{val=Int}], Ts) when is_integer(Int) -> - band_type_1(Int, Other, Ts); -band_type([_,_], _) -> t_integer(). - -band_type_1(Int, OtherSrc, Ts) -> - Type = band_type_2(Int, 0), - OtherType = get_type(OtherSrc, Ts), - meet(Type, OtherType). - -band_type_2(N, Bits) when Bits < 64 -> - case 1 bsl Bits of - P when P =:= N + 1 -> - t_integer(0, N); - P when P > N + 1 -> - t_integer(); - _ -> - band_type_2(N, Bits+1) - end; -band_type_2(_, _) -> - %% Negative or large positive number. Give up. - t_integer(). - bs_match_type([#b_literal{val=Type}|Args]) -> bs_match_type(Type, Args). bs_match_type(binary, Args) -> [_,_,_,#b_literal{val=U}] = Args, - {binary,U}; + #t_bitstring{unit=U}; bs_match_type(float, _) -> float; bs_match_type(integer, Args) -> @@ -1180,24 +1027,24 @@ bs_match_type(integer, Args) -> NumBits = Size * Unit, case member(unsigned, Flags) of true -> - t_integer(0, (1 bsl NumBits)-1); + beam_types:make_integer(0, (1 bsl NumBits)-1); false -> %% Signed integer. Don't bother. - t_integer() + #t_integer{} end; [_|_] -> - t_integer() + #t_integer{} end; bs_match_type(skip, _) -> any; bs_match_type(string, _) -> any; bs_match_type(utf8, _) -> - ?UNICODE_INT; + beam_types:make_integer(0, ?UNICODE_MAX); bs_match_type(utf16, _) -> - ?UNICODE_INT; + beam_types:make_integer(0, ?UNICODE_MAX); bs_match_type(utf32, _) -> - ?UNICODE_INT. + beam_types:make_integer(0, ?UNICODE_MAX). simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) -> case sort([A || {#b_literal{val=A},_} <- List0]) of @@ -1229,14 +1076,14 @@ eq_ranges(_, _, _) -> false. simplify_is_record(I, #t_tuple{exact=Exact, size=Size, elements=Es}, - RecSize, RecTag, Ts) -> + RecSize, #b_literal{val=TagVal}=RecTag, Ts) -> TagType = maps:get(1, Es, any), - TagMatch = case get_literal_from_type(TagType) of - #b_literal{}=RecTag -> yes; - #b_literal{} -> no; - none -> + TagMatch = case beam_types:get_singleton_value(TagType) of + {ok, TagVal} -> yes; + {ok, _} -> no; + error -> %% Is it at all possible for the tag to match? - case meet(get_type(RecTag, Ts), TagType) of + case beam_types:meet(raw_type(RecTag, Ts), TagType) of none -> no; _ -> maybe end @@ -1266,7 +1113,7 @@ simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds) -> simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> case Ds of #{V:=#b_set{op={bif,'not'},args=[Bool]}} -> - case t_is_boolean(get_type(Bool, Ts)) of + case beam_types:is_boolean_type(raw_type(Bool, Ts)) of true -> Br = Br0#b_br{bool=Bool,succ=Fail,fail=Succ}, beam_ssa:normalize(Br); @@ -1334,40 +1181,18 @@ used_once_last_uses([V|Vs], L, Uses) -> end; used_once_last_uses([], _, Uses) -> Uses. +normalized_types(Values, Ts) -> + [normalized_type(Val, Ts) || Val <- Values]. -get_types(Values, Ts) -> - [get_type(Val, Ts) || Val <- Values]. --spec get_type(beam_ssa:value(), type_db()) -> type(). +normalized_type(V, Ts) -> + beam_types:normalize(raw_type(V, Ts)). -get_type(#b_var{}=V, Ts) -> - #{V:=T} = Ts, - T; -get_type(#b_literal{val=Val}, _Ts) -> - if - is_atom(Val) -> - t_atom(Val); - is_float(Val) -> - float; - is_integer(Val) -> - t_integer(Val); - is_list(Val), Val =/= [] -> - cons; - is_map(Val) -> - map; - Val =:= {} -> - #t_tuple{exact=true}; - is_tuple(Val) -> - {Es, _} = foldl(fun(E, {Es0, Index}) -> - Type = get_type(#b_literal{val=E}, #{}), - Es = set_element_type(Index, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(Val)), - #t_tuple{exact=true,size=tuple_size(Val),elements=Es}; - Val =:= [] -> - nil; - true -> - any - end. +-spec raw_type(beam_ssa:value(), type_db()) -> type(). + +raw_type(#b_literal{val=Value}, _Ts) -> + beam_types:make_type_from_value(Value); +raw_type(V, Ts) -> + map_get(V, Ts). %% infer_types(Var, Types, #d{}) -> {SuccTypes,FailTypes} %% Looking at the expression that defines the variable Var, infer @@ -1390,10 +1215,107 @@ get_type(#b_literal{val=Val}, _Ts) -> %% 'cons' would give 'nil' as the only possible type. The result of the %% subtraction for L will be added to FailTypes. -infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> +infer_types_br(#b_var{}=V, Ts, UsedOnce, #d{ds=Ds}) -> #{V:=#b_set{op=Op,args=Args}} = Ds, - PosTypes0 = infer_type(Op, Args, Ds), - NegTypes0 = infer_type_negative(Op, Args, Ds), + + {PosTypes, NegTypes} = infer_type(Op, Args, Ts, Ds), + + SuccTs0 = meet_types(PosTypes, Ts), + FailTs0 = subtract_types(NegTypes, Ts), + + case UsedOnce of + true -> + %% The branch variable is defined in this block and is only + %% referenced by this terminator. Therefore, there is no need to + %% include it in the type database passed on to the successors of + %% of this block. + SuccTs = ts_remove_var(V, SuccTs0), + FailTs = ts_remove_var(V, FailTs0), + {SuccTs, FailTs}; + false -> + SuccTs = infer_br_value(V, true, SuccTs0), + FailTs = infer_br_value(V, false, FailTs0), + {SuccTs, FailTs} + end. + +infer_br_value(_V, _Bool, none) -> + none; +infer_br_value(V, Bool, NewTs) -> + #{ V := T } = NewTs, + case beam_types:is_boolean_type(T) of + true -> + NewTs#{ V := beam_types:make_atom(Bool) }; + false -> + %% V is a try/catch tag or similar, leave it alone. + NewTs + end. + +infer_types_switch(V, Lit, Ts0, UsedOnce, #d{ds=Ds}) -> + {PosTypes, _} = infer_type({bif,'=:='}, [V, Lit], Ts0, Ds), + Ts = meet_types(PosTypes, Ts0), + case UsedOnce of + true -> ts_remove_var(V, Ts); + false -> Ts + end. + +ts_remove_var(_V, none) -> none; +ts_remove_var(V, Ts) -> maps:remove(V, Ts). + +infer_type(succeeded, [#b_var{}=Src], Ts, Ds) -> + #b_set{op=Op,args=Args} = maps:get(Src, Ds), + infer_success_type(Op, Args, Ts, Ds); + +%% Type tests are handled separately from other BIFs as we're inferring types +%% based on their result, so we know that subtraction is safe even if we're +%% not branching on 'succeeded'. +infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, + #b_literal{}=Tag], _Ts, _Ds) -> + Es = beam_types:set_element_type(1, raw_type(Tag, #{}), #{}), + T = {Src,#t_tuple{exact=true,size=Size,elements=Es}}, + {[T], [T]}; +infer_type(is_nonempty_list, [#b_var{}=Src], _Ts, _Ds) -> + T = {Src,cons}, + {[T], [T]}; +infer_type({bif,is_atom}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_atom{}}, + {[T], [T]}; +infer_type({bif,is_binary}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_bitstring{unit=8}}, + {[T], [T]}; +infer_type({bif,is_bitstring}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_bitstring{}}, + {[T], [T]}; +infer_type({bif,is_boolean}, [Arg], _Ts, _Ds) -> + T = {Arg, beam_types:make_boolean()}, + {[T], [T]}; +infer_type({bif,is_float}, [Arg], _Ts, _Ds) -> + T = {Arg, float}, + {[T], [T]}; +infer_type({bif,is_integer}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_integer{}}, + {[T], [T]}; +infer_type({bif,is_list}, [Arg], _Ts, _Ds) -> + T = {Arg, list}, + {[T], [T]}; +infer_type({bif,is_map}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_map{}}, + {[T], [T]}; +infer_type({bif,is_number}, [Arg], _Ts, _Ds) -> + T = {Arg, number}, + {[T], [T]}; +infer_type({bif,is_tuple}, [Arg], _Ts, _Ds) -> + T = {Arg, #t_tuple{}}, + {[T], [T]}; +infer_type({bif,'=:='}, [#b_var{}=LHS,#b_var{}=RHS], Ts, _Ds) -> + %% As an example, assume that L1 is known to be 'list', and L2 is + %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can + %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). + LType = raw_type(LHS, Ts), + RType = raw_type(RHS, Ts), + Type = beam_types:meet(LType, RType), + + PosTypes = [{V,Type} || {V, OrigType} <- [{LHS, LType}, {RHS, RType}], + OrigType =/= Type], %% We must be careful with types inferred from '=:='. %% @@ -1404,39 +1326,39 @@ infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) -> %% %% However, it is safe to subtract a type inferred from '=:=' if %% it is single-valued, e.g. if it is [] or the atom 'true'. + NegTypes = case beam_types:is_singleton_type(Type) of + true -> PosTypes; + false -> [] + end, - EqTypes = infer_eq_type(Op, Args, Ts, Ds), - NegTypes1 = [P || {_,T}=P <- EqTypes, is_singleton_type(T)], - - PosTypes = EqTypes ++ PosTypes0, - SuccTs = meet_types(PosTypes, Ts), - - NegTypes = NegTypes0 ++ NegTypes1, - FailTs = subtract_types(NegTypes, Ts), - - {SuccTs,FailTs}. - -infer_types_switch(V, Lit, Ts, #d{ds=Ds}) -> - Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds), - meet_types(Types, Ts). - -infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> + {PosTypes, NegTypes}; +infer_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) -> Def = maps:get(Src, Ds), - Type = get_type(Lit, Ts), - [{Src,Type} | infer_eq_lit(Def, Lit)]; -infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) -> - %% As an example, assume that L1 is known to be 'list', and L2 is - %% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can - %% be inferred that L1 is 'cons' (the meet of 'cons' and 'list'). - Type0 = get_type(Arg0, Ts), - Type1 = get_type(Arg1, Ts), - Type = meet(Type0, Type1), - [{V,MeetType} || - {V,OrigType,MeetType} <- - [{Arg0,Type0,Type},{Arg1,Type1,Type}], - OrigType =/= MeetType]; -infer_eq_type(_Op, _Args, _Ts, _Ds) -> - []. + Type = raw_type(Lit, Ts), + EqLitTypes = infer_eq_lit(Def, Lit), + PosTypes = [{Src,Type} | EqLitTypes], + {PosTypes, EqLitTypes}; +infer_type(_Op, _Args, _Ts, _Ds) -> + {[], []}. + +infer_success_type({bif,Op}, Args, Ts, _Ds) -> + ArgTypes = normalized_types(Args, Ts), + + {_, PosTypes0, CanSubtract} = beam_call_types:types(erlang, Op, ArgTypes), + PosTypes = [T || {#b_var{},_}=T <- zip(Args, PosTypes0)], + + case CanSubtract of + true -> {PosTypes, PosTypes}; + false -> {PosTypes, []} + end; +infer_success_type(call, [#b_var{}=Fun|Args], _Ts, _Ds) -> + T = {Fun, #t_fun{arity=length(Args)}}, + {[T], []}; +infer_success_type(bs_start_match, [#b_var{}=Bin], _Ts, _Ds) -> + T = {Bin,#t_bitstring{}}, + {[T], [T]}; +infer_success_type(_Op, _Args, _Ts, _Ds) -> + {[], []}. infer_eq_lit(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]}, #b_literal{val=Size}) when is_integer(Size) -> @@ -1445,178 +1367,11 @@ infer_eq_lit(#b_set{op=get_tuple_element, args=[#b_var{}=Tuple,#b_literal{val=N}]}, #b_literal{}=Lit) -> Index = N + 1, - Es = set_element_type(Index, get_type(Lit, #{}), #{}), + Es = beam_types:set_element_type(Index, raw_type(Lit, #{}), #{}), [{Tuple,#t_tuple{size=Index,elements=Es}}]; -infer_eq_lit(_, _) -> []. - -infer_type_negative(Op, Args, Ds) -> - case is_negative_inference_safe(Op, Args) of - true -> - infer_type(Op, Args, Ds); - false -> - [] - end. - -%% Conservative list of instructions for which negative -%% inference is safe. -is_negative_inference_safe(is_nonempty_list, _Args) -> true; -is_negative_inference_safe(_, _) -> false. - -infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) -> - if - is_integer(Pos), 1 =< Pos -> - [{Tuple,#t_tuple{size=Pos}}]; - true -> - [] - end; -infer_type({bif,element}, [#b_var{}=Position,#b_var{}=Tuple], _Ds) -> - [{Position,t_integer()},{Tuple,#t_tuple{}}]; -infer_type({bif,Bif}, [#b_var{}=Src]=Args, _Ds) -> - case inferred_bif_type(Bif, Args) of - any -> []; - T -> [{Src,T}] - end; -infer_type({bif,binary_part}, [#b_var{}=Src,_], _Ds) -> - [{Src,{binary,8}}]; -infer_type({bif,is_map_key}, [_,#b_var{}=Src], _Ds) -> - [{Src,map}]; -infer_type({bif,map_get}, [_,#b_var{}=Src], _Ds) -> - [{Src,map}]; -infer_type({bif,Bif}, [_,_]=Args, _Ds) -> - case inferred_bif_type(Bif, Args) of - any -> []; - T -> [{A,T} || #b_var{}=A <- Args] - end; -infer_type({bif,binary_part}, [#b_var{}=Src,Pos,Len], _Ds) -> - [{Src,{binary,8}}| - [{V,t_integer()} || #b_var{}=V <- [Pos,Len]]]; -infer_type(bs_start_match, [#b_var{}=Bin], _Ds) -> - [{Bin,{binary,1}}]; -infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) -> - [{Src,cons}]; -infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size}, - #b_literal{}=Tag], _Ds) -> - Es = set_element_type(1, get_type(Tag, #{}), #{}), - [{Src,#t_tuple{exact=true,size=Size,elements=Es}}]; -infer_type(succeeded, [#b_var{}=Src], Ds) -> - #b_set{op=Op,args=Args} = maps:get(Src, Ds), - infer_type(Op, Args, Ds); -infer_type(_Op, _Args, _Ds) -> +infer_eq_lit(_, _) -> []. -%% bif_type(Name, Args) -> Type -%% Return the return type for the guard BIF or operator Name with -%% arguments Args. -%% -%% Note that that the following BIFs are handle elsewhere: -%% -%% band/2 - -bif_type(abs, [_]) -> number; -bif_type(bit_size, [_]) -> t_integer(); -bif_type(byte_size, [_]) -> t_integer(); -bif_type(ceil, [_]) -> t_integer(); -bif_type(float, [_]) -> float; -bif_type(floor, [_]) -> t_integer(); -bif_type(is_map_key, [_,_]) -> t_boolean(); -bif_type(length, [_]) -> t_integer(); -bif_type(map_size, [_]) -> t_integer(); -bif_type(node, []) -> #t_atom{}; -bif_type(node, [_]) -> #t_atom{}; -bif_type(round, [_]) -> t_integer(); -bif_type(size, [_]) -> t_integer(); -bif_type(trunc, [_]) -> t_integer(); -bif_type(tuple_size, [_]) -> t_integer(); -bif_type('bnot', [_]) -> t_integer(); -bif_type('bor', [_,_]) -> t_integer(); -bif_type('bsl', [_,_]) -> t_integer(); -bif_type('bsr', [_,_]) -> t_integer(); -bif_type('bxor', [_,_]) -> t_integer(); -bif_type('div', [_,_]) -> t_integer(); -bif_type('rem', [_,_]) -> t_integer(); -bif_type('/', [_,_]) -> float; -bif_type(Name, Args) -> - Arity = length(Args), - case erl_internal:new_type_test(Name, Arity) orelse - erl_internal:bool_op(Name, Arity) orelse - erl_internal:comp_op(Name, Arity) of - true -> - t_boolean(); - false -> - case erl_internal:arith_op(Name, Arity) of - true -> number; - false -> any - end - end. - -inferred_bif_type(is_atom, [_]) -> t_atom(); -inferred_bif_type(is_binary, [_]) -> {binary,8}; -inferred_bif_type(is_bitstring, [_]) -> {binary,1}; -inferred_bif_type(is_boolean, [_]) -> t_boolean(); -inferred_bif_type(is_float, [_]) -> float; -inferred_bif_type(is_integer, [_]) -> t_integer(); -inferred_bif_type(is_list, [_]) -> list; -inferred_bif_type(is_map, [_]) -> map; -inferred_bif_type(is_number, [_]) -> number; -inferred_bif_type(is_tuple, [_]) -> #t_tuple{}; -inferred_bif_type(abs, [_]) -> number; -inferred_bif_type(bit_size, [_]) -> {binary,1}; -inferred_bif_type('bnot', [_]) -> t_integer(); -inferred_bif_type(byte_size, [_]) -> {binary,1}; -inferred_bif_type(ceil, [_]) -> number; -inferred_bif_type(float, [_]) -> number; -inferred_bif_type(floor, [_]) -> number; -inferred_bif_type(hd, [_]) -> cons; -inferred_bif_type(length, [_]) -> list; -inferred_bif_type(map_size, [_]) -> map; -inferred_bif_type('not', [_]) -> t_boolean(); -inferred_bif_type(round, [_]) -> number; -inferred_bif_type(trunc, [_]) -> number; -inferred_bif_type(tl, [_]) -> cons; -inferred_bif_type(tuple_size, [_]) -> #t_tuple{}; -inferred_bif_type('and', [_,_]) -> t_boolean(); -inferred_bif_type('or', [_,_]) -> t_boolean(); -inferred_bif_type('xor', [_,_]) -> t_boolean(); -inferred_bif_type('band', [_,_]) -> t_integer(); -inferred_bif_type('bor', [_,_]) -> t_integer(); -inferred_bif_type('bsl', [_,_]) -> t_integer(); -inferred_bif_type('bsr', [_,_]) -> t_integer(); -inferred_bif_type('bxor', [_,_]) -> t_integer(); -inferred_bif_type('div', [_,_]) -> t_integer(); -inferred_bif_type('rem', [_,_]) -> t_integer(); -inferred_bif_type('+', [_,_]) -> number; -inferred_bif_type('-', [_,_]) -> number; -inferred_bif_type('*', [_,_]) -> number; -inferred_bif_type('/', [_,_]) -> number; -inferred_bif_type(_, _) -> any. - -is_math_bif(cos, 1) -> true; -is_math_bif(cosh, 1) -> true; -is_math_bif(sin, 1) -> true; -is_math_bif(sinh, 1) -> true; -is_math_bif(tan, 1) -> true; -is_math_bif(tanh, 1) -> true; -is_math_bif(acos, 1) -> true; -is_math_bif(acosh, 1) -> true; -is_math_bif(asin, 1) -> true; -is_math_bif(asinh, 1) -> true; -is_math_bif(atan, 1) -> true; -is_math_bif(atanh, 1) -> true; -is_math_bif(erf, 1) -> true; -is_math_bif(erfc, 1) -> true; -is_math_bif(exp, 1) -> true; -is_math_bif(log, 1) -> true; -is_math_bif(log2, 1) -> true; -is_math_bif(log10, 1) -> true; -is_math_bif(sqrt, 1) -> true; -is_math_bif(atan2, 2) -> true; -is_math_bif(pow, 2) -> true; -is_math_bif(ceil, 1) -> true; -is_math_bif(floor, 1) -> true; -is_math_bif(fmod, 2) -> true; -is_math_bif(pi, 0) -> true; -is_math_bif(_, _) -> false. - join_types(Ts0, Ts1) -> if map_size(Ts0) < map_size(Ts1) -> @@ -1630,7 +1385,7 @@ join_types_1([V|Vs], Ts0, Ts1) -> {#{V:=Same},#{V:=Same}} -> join_types_1(Vs, Ts0, Ts1); {#{V:=T0},#{V:=T1}} -> - case join(T0, T1) of + case beam_types:join(T0, T1) of T1 -> join_types_1(Vs, Ts0, Ts1); T -> @@ -1642,326 +1397,21 @@ join_types_1([V|Vs], Ts0, Ts1) -> join_types_1([], Ts0, Ts1) -> maps:merge(Ts0, Ts1). -join([T1,T2|Ts]) -> - join([join(T1, T2)|Ts]); -join([T]) -> T. - -get_literal_from_type(#t_atom{elements=[Atom]}) -> - #b_literal{val=Atom}; -get_literal_from_type(#t_integer{elements={Int,Int}}) -> - #b_literal{val=Int}; -get_literal_from_type(nil) -> - #b_literal{val=[]}; -get_literal_from_type(_) -> none. - -remove_element_info(#t_integer{elements={Min,Max}}, Es) -> - foldl(fun(El, Acc) when Min =< El, El =< Max -> - maps:remove(El, Acc); - (_El, Acc) -> Acc - end, Es, maps:keys(Es)). - -t_atom() -> - #t_atom{elements=any}. - -t_atom(Atom) when is_atom(Atom) -> - #t_atom{elements=[Atom]}. - -t_boolean() -> - #t_atom{elements=[false,true]}. - -t_integer() -> - #t_integer{elements=any}. - -t_integer(Int) when is_integer(Int) -> - #t_integer{elements={Int,Int}}. - -t_integer(Min, Max) when is_integer(Min), is_integer(Max) -> - #t_integer{elements={Min,Max}}. - -t_is_boolean(#t_atom{elements=[F,T]}) -> - F =:= false andalso T =:= true; -t_is_boolean(#t_atom{elements=[B]}) -> - is_boolean(B); -t_is_boolean(_) -> false. - -t_tuple_size(#t_tuple{size=Size,exact=false}) -> - {at_least,Size}; -t_tuple_size(#t_tuple{size=Size,exact=true}) -> - {exact,Size}; -t_tuple_size(_) -> - none. - -is_singleton_type(Type) -> - get_literal_from_type(Type) =/= none. - -get_element_type(Index, Es) -> - case Es of - #{ Index := T } -> T; - #{} -> any - end. - -set_element_type(_Key, none, Es) -> - Es; -set_element_type(Key, any, Es) -> - maps:remove(Key, Es); -set_element_type(Key, Type, Es) -> - Es#{ Key => Type }. - -%% join(Type1, Type2) -> Type -%% Return the "join" of Type1 and Type2. The join is a more general -%% type than Type1 and Type2. For example: -%% -%% join(#t_integer{elements=any}, #t_integer=elements={0,3}}) -> -%% #t_integer{} -%% -%% The join for two different types result in 'any', which is -%% the top element for our type lattice: -%% -%% join(#t_integer{}, map) -> any - --spec join(type(), type()) -> type(). - -join(T, T) -> - verified_type(T); -join(none, T) -> - verified_type(T); -join(T, none) -> - verified_type(T); -join(any, _) -> any; -join(_, any) -> any; -join(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> - Set = ordsets:union(Set1, Set2), - case ordsets:size(Set) of - Size when Size =< ?ATOM_SET_SIZE -> - #t_atom{elements=Set}; - _Size -> - #t_atom{elements=any} - end; -join(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T; -join(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T; -join({binary,U1}, {binary,U2}) -> - {binary,gcd(U1, U2)}; -join(#t_integer{}, #t_integer{}) -> t_integer(); -join(list, cons) -> list; -join(cons, list) -> list; -join(nil, cons) -> list; -join(cons, nil) -> list; -join(nil, list) -> list; -join(list, nil) -> list; -join(#t_integer{}, float) -> number; -join(float, #t_integer{}) -> number; -join(#t_integer{}, number) -> number; -join(number, #t_integer{}) -> number; -join(float, number) -> number; -join(number, float) -> number; -join(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, - #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> - Exact = ExactA and ExactB, - Es = join_tuple_elements(Sz, EsA, EsB), - #t_tuple{size=Sz,exact=Exact,elements=Es}; -join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> - Sz = min(SzA, SzB), - Es = join_tuple_elements(Sz, EsA, EsB), - #t_tuple{size=Sz,elements=Es}; -join(_T1, _T2) -> - %%io:format("~p ~p\n", [_T1,_T2]), - any. - -join_tuple_elements(MinSize, EsA, EsB) -> - Es0 = join_elements(EsA, EsB), - maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). - -join_elements(Es1, Es2) -> - Keys = if - map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); - map_size(Es1) > map_size(Es2) -> maps:keys(Es2) - end, - join_elements_1(Keys, Es1, Es2, #{}). - -join_elements_1([Key | Keys], Es1, Es2, Acc0) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - Acc = set_element_type(Key, join(Type1, Type2), Acc0), - join_elements_1(Keys, Es1, Es2, Acc); - {#{}, #{}} -> - join_elements_1(Keys, Es1, Es2, Acc0) - end; -join_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -gcd(A, B) -> - case A rem B of - 0 -> B; - X -> gcd(B, X) - end. - meet_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - case meet(T0, T1) of + case beam_types:meet(T0, T1) of + none -> none; T1 -> meet_types(Vs, Ts); T -> meet_types(Vs, Ts#{V:=T}) end; meet_types([], Ts) -> Ts. -meet([T1,T2|Ts]) -> - meet([meet(T1, T2)|Ts]); -meet([T]) -> T. - subtract_types([{V,T0}|Vs], Ts) -> #{V:=T1} = Ts, - case subtract(T1, T0) of + case beam_types:subtract(T1, T0) of + none -> none; T1 -> subtract_types(Vs, Ts); T -> subtract_types(Vs, Ts#{V:=T}) end; subtract_types([], Ts) -> Ts. -%% subtract(Type1, Type2) -> Type. -%% Subtract Type2 from Type1. Example: -%% -%% subtract(list, cons) -> nil - -subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> - case ordsets:subtract(Set0, Set1) of - [] -> none; - [_|_]=Set -> #t_atom{elements=Set} - end; -subtract(number, float) -> #t_integer{}; -subtract(number, #t_integer{elements=any}) -> float; -subtract(list, cons) -> nil; -subtract(list, nil) -> cons; -subtract(T, _) -> T. - -%% meet(Type1, Type2) -> Type -%% Return the "meet" of Type1 and Type2. The meet is a narrower -%% type than Type1 and Type2. For example: -%% -%% meet(#t_integer{elements=any}, #t_integer{elements={0,3}}) -> -%% #t_integer{elements={0,3}} -%% -%% The meet for two different types result in 'none', which is -%% the bottom element for our type lattice: -%% -%% meet(#t_integer{}, map) -> none - --spec meet(type(), type()) -> type(). - -meet(T, T) -> - verified_type(T); -meet(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> - case ordsets:intersection(Set1, Set2) of - [] -> - none; - [_|_]=Set -> - #t_atom{elements=Set} - end; -meet(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) -> - T; -meet(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) -> - T; -meet(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) -> - T; -meet(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) -> - T; -meet(#t_integer{elements={Min1,Max1}}, - #t_integer{elements={Min2,Max2}}) -> - #t_integer{elements={max(Min1, Min2),min(Max1, Max2)}}; -meet(#t_integer{}=T, number) -> T; -meet(float=T, number) -> T; -meet(number, #t_integer{}=T) -> T; -meet(number, float=T) -> T; -meet(list, cons) -> cons; -meet(list, nil) -> nil; -meet(cons, list) -> cons; -meet(nil, list) -> nil; -meet(#t_tuple{}=T1, #t_tuple{}=T2) -> - meet_tuples(T1, T2); -meet({binary,U1}, {binary,U2}) -> - {binary,max(U1, U2)}; -meet(any, T) -> - verified_type(T); -meet(T, any) -> - verified_type(T); -meet(_, _) -> - %% Inconsistent types. There will be an exception at runtime. - none. - -meet_tuples(#t_tuple{size=Sz1,exact=true}, - #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 -> - none; -meet_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, - #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> - Size = max(Sz1, Sz2), - Exact = Ex1 or Ex2, - case meet_elements(Es1, Es2) of - none -> - none; - Es -> - #t_tuple{size=Size,exact=Exact,elements=Es} - end. - -meet_elements(Es1, Es2) -> - Keys = maps:keys(Es1) ++ maps:keys(Es2), - meet_elements_1(Keys, Es1, Es2, #{}). - -meet_elements_1([Key | Keys], Es1, Es2, Acc) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - case meet(Type1, Type2) of - none -> none; - Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) - end; - {#{ Key := Type1 }, _} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); - {_, #{ Key := Type2 }} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) - end; -meet_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -%% verified_type(Type) -> Type -%% Returns the passed in type if it is one of the defined types. -%% Crashes if there is anything wrong with the type. -%% -%% Here are all possible types: -%% -%% any Any Erlang term (top element for the type lattice). -%% -%% #t_atom{} Any atom or some specific atoms. -%% {binary,Unit} Binary/bitstring aligned to unit Unit. -%% float Floating point number. -%% #t_integer{} Integer -%% list Empty or nonempty list. -%% map Map. -%% nil Empty list. -%% cons Cons (nonempty list). -%% number A number (float or integer). -%% #t_tuple{} Tuple. -%% -%% none No type (bottom element for the type lattice). - --spec verified_type(T) -> T when - T :: type(). - -verified_type(any=T) -> T; -verified_type(none=T) -> T; -verified_type(#t_atom{elements=any}=T) -> T; -verified_type(#t_atom{elements=[_|_]}=T) -> T; -verified_type({binary,U}=T) when is_integer(U) -> T; -verified_type(#t_integer{elements=any}=T) -> T; -verified_type(#t_integer{elements={Min,Max}}=T) - when is_integer(Min), is_integer(Max) -> T; -verified_type(list=T) -> T; -verified_type(map=T) -> T; -verified_type(nil=T) -> T; -verified_type(cons=T) -> T; -verified_type(number=T) -> T; -verified_type(#t_tuple{size=Size,elements=Es}=T) -> - %% All known elements must have a valid index and type. 'any' is prohibited - %% since it's implicit and should never be present in the map. - maps:fold(fun(Index, Element, _) when is_integer(Index), - 1 =< Index, Index =< Size, - Element =/= any, Element =/= none -> - verified_type(Element) - end, [], Es), - T; -verified_type(float=T) -> T. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index acf3838da4..ad8839cc7d 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -244,6 +244,9 @@ remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) -> remap([{deallocate,N}|Is], Map, Acc) -> I = {deallocate,Map({frame_size,N})}, remap(Is, Map, [I|Acc]); +remap([{swap,Reg1,Reg2}|Is], Map, Acc) -> + I = {swap,Map(Reg1),Map(Reg2)}, + remap(Is, Map, [I|Acc]); remap([{test,Name,Fail,Ss}|Is], Map, Acc) -> I = {test,Name,Fail,[Map(S) || S <- Ss]}, remap(Is, Map, [I|Acc]); @@ -382,6 +385,8 @@ frame_size([{bs_set_position,_,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{bs_get_tail,_,_,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{swap,_,_}|Is], Safe) -> + frame_size(Is, Safe); frame_size(_, _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> @@ -444,6 +449,8 @@ is_not_used(Y, [{line,_}|Is]) -> is_not_used(Y, Is); is_not_used(Y, [{make_fun2,_,_,_,_}|Is]) -> is_not_used(Y, Is); +is_not_used(Y, [{swap,Reg1,Reg2}|Is]) -> + Y =/= Reg1 andalso Y =/= Reg2 andalso is_not_used(Y, Is); is_not_used(Y, [{test,_,_,Ss}|Is]) -> not member(Y, Ss) andalso is_not_used(Y, Is); is_not_used(Y, [{test,_Op,{f,_},_Live,Ss,Dst}|Is]) -> diff --git a/lib/compiler/src/beam_types.erl b/lib/compiler/src/beam_types.erl new file mode 100644 index 0000000000..821ccd31bb --- /dev/null +++ b/lib/compiler/src/beam_types.erl @@ -0,0 +1,778 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_types). + +-include("beam_types.hrl"). + +-import(lists, [foldl/3, reverse/1, reverse/2]). + +-export([meet/1, meet/2, join/1, join/2, subtract/2]). + +-export([get_singleton_value/1, + is_singleton_type/1, + is_boolean_type/1, + normalize/1]). + +-export([get_element_type/2, set_element_type/3]). + +-export([make_type_from_value/1]). + +-export([make_atom/1, + make_boolean/0, + make_integer/1, + make_integer/2]). + +-define(IS_LIST_TYPE(N), + N =:= list orelse + N =:= cons orelse + N =:= nil). + +-define(IS_NUMBER_TYPE(N), + N =:= number orelse + N =:= float orelse + is_record(N, t_integer)). + +-define(TUPLE_SET_LIMIT, 20). + +%% Folds meet/2 over a list. + +-spec meet([type()]) -> type(). + +meet([T1, T2 | Ts]) -> + meet([meet(T1, T2) | Ts]); +meet([T]) -> T. + +%% Return the "meet" of Type1 and Type2, which is more general than Type1 and +%% Type2. This is identical to glb/2 but can operate on and produce unions. +%% +%% A = #t_union{list=nil, number=[number], other=[#t_map{}]} +%% B = #t_union{number=[#t_integer{}], other=[#t_map{}]} +%% +%% meet(A, B) -> +%% #t_union{number=[#t_integer{}], other=[#t_map{}]} +%% +%% The meet of two different types result in 'none', which is the bottom +%% element for our type lattice: +%% +%% meet(#t_integer{}, #t_map{}) -> none + +-spec meet(type(), type()) -> type(). + +meet(T, T) -> + verified_type(T); +meet(any, T) -> + verified_type(T); +meet(T, any) -> + verified_type(T); +meet(#t_union{}=A, B) -> + meet_unions(A, B); +meet(A, #t_union{}=B) -> + meet_unions(B, A); +meet(A, B) -> + glb(A, B). + +meet_unions(#t_union{atom=AtomA,list=ListA,number=NumberA, + tuple_set=TSetA,other=OtherA}, + #t_union{atom=AtomB,list=ListB,number=NumberB, + tuple_set=TSetB,other=OtherB}) -> + Union = #t_union{atom=glb(AtomA, AtomB), + list=glb(ListA, ListB), + number=glb(NumberA, NumberB), + tuple_set=meet_tuple_sets(TSetA, TSetB), + other=glb(OtherA, OtherB)}, + shrink_union(Union); +meet_unions(#t_union{atom=AtomA}, #t_atom{}=B) -> + case glb(AtomA, B) of + none -> none; + Atom -> Atom + end; +meet_unions(#t_union{number=NumberA}, B) when ?IS_NUMBER_TYPE(B) -> + case glb(NumberA, B) of + none -> none; + Number -> Number + end; +meet_unions(#t_union{list=ListA}, B) when ?IS_LIST_TYPE(B) -> + case glb(ListA, B) of + none -> none; + List -> List + end; +meet_unions(#t_union{tuple_set=Tuples}, #t_tuple{}=B) -> + Set = meet_tuple_sets(Tuples, new_tuple_set(B)), + shrink_union(#t_union{tuple_set=Set}); +meet_unions(#t_union{other=OtherA}, OtherB) -> + case glb(OtherA, OtherB) of + none -> none; + Other -> Other + end. + +meet_tuple_sets(none, _) -> + none; +meet_tuple_sets(_, none) -> + none; +meet_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) -> + new_tuple_set(glb(A, B)); +meet_tuple_sets(#t_tuple{}=Tuple, Records) -> + mts_tuple(Records, Tuple, []); +meet_tuple_sets(Records, #t_tuple{}=Tuple) -> + meet_tuple_sets(Tuple, Records); +meet_tuple_sets(RecordsA, RecordsB) -> + mts_records(RecordsA, RecordsB). + +mts_tuple([{Key, Type} | Records], Tuple, Acc) -> + case glb(Type, Tuple) of + none -> mts_tuple(Records, Tuple, Acc); + T -> mts_tuple(Records, Tuple, [{Key, T} | Acc]) + end; +mts_tuple([], _Tuple, [_|_]=Acc) -> + reverse(Acc); +mts_tuple([], _Tuple, []) -> + none. + +mts_records(RecordsA, RecordsB) -> + mts_records(RecordsA, RecordsB, []). + +mts_records([{Key, A} | RsA], [{Key, B} | RsB], Acc) -> + case glb(A, B) of + none -> mts_records(RsA, RsB, Acc); + T -> mts_records(RsA, RsB, [{Key, T} | Acc]) + end; +mts_records([{KeyA, _} | _ ]=RsA, [{KeyB, _} | RsB], Acc) when KeyA > KeyB -> + mts_records(RsA, RsB, Acc); +mts_records([{KeyA, _} | RsA], [{KeyB, _} | _] = RsB, Acc) when KeyA < KeyB -> + mts_records(RsA, RsB, Acc); +mts_records(_RsA, [], [_|_]=Acc) -> + reverse(Acc); +mts_records([], _RsB, [_|_]=Acc) -> + reverse(Acc); +mts_records(_RsA, _RsB, []) -> + none. + +%% Folds join/2 over a list. + +-spec join([type()]) -> type(). + +join([T1, T2| Ts]) -> + join([join(T1, T2) | Ts]); +join([T]) -> T. + +%% Return the "join" of Type1 and Type2, which is more general than Type1 and +%% Type2. This is identical to lub/2 but can operate on and produce unions. +%% +%% join(#t_integer{}, #t_map{}) -> #t_union{number=[#t_integer{}], +%% other=[#t_map{}]} + +-spec join(type(), type()) -> type(). + +join(T, T) -> T; +join(_T, any) -> any; +join(any, _T) -> any; +join(T, none) -> T; +join(none, T) -> T; + +join(#t_union{}=A, B) -> + join_unions(A, B); +join(A, #t_union{}=B) -> + join_unions(B, A); + +%% Union creation... +join(#t_atom{}=A, #t_atom{}=B) -> + lub(A, B); +join(#t_atom{}=A, B) when ?IS_LIST_TYPE(B) -> + #t_union{atom=A,list=B}; +join(#t_atom{}=A, B) when ?IS_NUMBER_TYPE(B) -> + #t_union{atom=A,number=B}; +join(#t_atom{}=A, #t_tuple{}=B) -> + #t_union{atom=A,tuple_set=new_tuple_set(B)}; +join(#t_atom{}=A, B) -> + #t_union{atom=A,other=B}; +join(A, #t_atom{}=B) -> + join(B, A); + +join(A, B) when ?IS_LIST_TYPE(A), ?IS_LIST_TYPE(B) -> + lub(A, B); +join(A, B) when ?IS_LIST_TYPE(A), ?IS_NUMBER_TYPE(B) -> + #t_union{list=A,number=B}; +join(A, #t_tuple{}=B) when ?IS_LIST_TYPE(A) -> + #t_union{list=A,tuple_set=new_tuple_set(B)}; +join(A, B) when ?IS_LIST_TYPE(A) -> + #t_union{list=A,other=B}; +join(A, B) when ?IS_LIST_TYPE(B) -> + join(B, A); + +join(A, B) when ?IS_NUMBER_TYPE(A), ?IS_NUMBER_TYPE(B) -> + lub(A, B); +join(A, #t_tuple{}=B) when ?IS_NUMBER_TYPE(A) -> + #t_union{number=A,tuple_set=new_tuple_set(B)}; +join(A, B) when ?IS_NUMBER_TYPE(A) -> + #t_union{number=A,other=B}; +join(A, B) when ?IS_NUMBER_TYPE(B) -> + join(B, A); + +join(#t_tuple{}=A, #t_tuple{}=B) -> + case {record_key(A), record_key(B)} of + {Same, Same} -> + lub(A, B); + {none, _Key} -> + lub(A, B); + {_Key, none} -> + lub(A, B); + {KeyA, KeyB} when KeyA < KeyB -> + #t_union{tuple_set=[{KeyA, A}, {KeyB, B}]}; + {KeyA, KeyB} when KeyA > KeyB -> + #t_union{tuple_set=[{KeyB, B}, {KeyA, A}]} + end; +join(#t_tuple{}=A, B) -> + %% All other combinations have been tried already, so B must be 'other' + #t_union{tuple_set=new_tuple_set(A),other=B}; +join(A, #t_tuple{}=B) -> + join(B, A); + +join(A, B) -> + lub(A, B). + +join_unions(#t_union{atom=AtomA,list=ListA,number=NumberA, + tuple_set=TSetA,other=OtherA}, + #t_union{atom=AtomB,list=ListB,number=NumberB, + tuple_set=TSetB,other=OtherB}) -> + Union = #t_union{atom=lub(AtomA, AtomB), + list=lub(ListA, ListB), + number=lub(NumberA, NumberB), + tuple_set=join_tuple_sets(TSetA, TSetB), + other=lub(OtherA, OtherB)}, + shrink_union(Union); +join_unions(#t_union{atom=AtomA}=A, #t_atom{}=B) -> + A#t_union{atom=lub(AtomA, B)}; +join_unions(#t_union{list=ListA}=A, B) when ?IS_LIST_TYPE(B) -> + A#t_union{list=lub(ListA, B)}; +join_unions(#t_union{number=NumberA}=A, B) when ?IS_NUMBER_TYPE(B) -> + A#t_union{number=lub(NumberA, B)}; +join_unions(#t_union{tuple_set=TSetA}=A, #t_tuple{}=B) -> + Set = join_tuple_sets(TSetA, new_tuple_set(B)), + shrink_union(A#t_union{tuple_set=Set}); +join_unions(#t_union{other=OtherA}=A, B) -> + case lub(OtherA, B) of + any -> any; + T -> A#t_union{other=T} + end. + +join_tuple_sets(A, none) -> + A; +join_tuple_sets(none, B) -> + B; +join_tuple_sets(#t_tuple{}=A, #t_tuple{}=B) -> + lub(A, B); +join_tuple_sets(#t_tuple{}=Tuple, Records) -> + jts_tuple(Records, Tuple); +join_tuple_sets(Records, #t_tuple{}=Tuple) -> + join_tuple_sets(Tuple, Records); +join_tuple_sets(RecordsA, RecordsB) -> + jts_records(RecordsA, RecordsB). + +jts_tuple([{_Key, Tuple} | Records], Acc) -> + jts_tuple(Records, lub(Tuple, Acc)); +jts_tuple([], Acc) -> + Acc. + +jts_records(RsA, RsB) -> + jts_records(RsA, RsB, 0, []). + +jts_records(RsA, RsB, N, Acc) when N > ?TUPLE_SET_LIMIT -> + A = normalize_tuple_set(RsA, none), + B = normalize_tuple_set(RsB, A), + #t_tuple{} = normalize_tuple_set(Acc, B); +jts_records([{Key, A} | RsA], [{Key, B} | RsB], N, Acc) -> + jts_records(RsA, RsB, N + 1, [{Key, lub(A, B)} | Acc]); +jts_records([{KeyA, _} | _]=RsA, [{KeyB, B} | RsB], N, Acc) when KeyA > KeyB -> + jts_records(RsA, RsB, N + 1, [{KeyB, B} | Acc]); +jts_records([{KeyA, A} | RsA], [{KeyB, _} | _] = RsB, N, Acc) when KeyA < KeyB -> + jts_records(RsA, RsB, N + 1, [{KeyA, A} | Acc]); +jts_records([], RsB, _N, Acc) -> + reverse(Acc, RsB); +jts_records(RsA, [], _N, Acc) -> + reverse(Acc, RsA). + +%% Subtract Type2 from Type1. Example: +%% subtract(list, cons) -> nil + +-spec subtract(type(), type()) -> type(). + +subtract(#t_atom{elements=[_|_]=Set0}, #t_atom{elements=[_|_]=Set1}) -> + case ordsets:subtract(Set0, Set1) of + [] -> none; + [_|_]=Set -> #t_atom{elements=Set} + end; +subtract(number, float) -> #t_integer{}; +subtract(number, #t_integer{elements=any}) -> float; +subtract(list, cons) -> nil; +subtract(list, nil) -> cons; + +subtract(#t_union{atom=Atom}=A, #t_atom{}=B)-> + shrink_union(A#t_union{atom=subtract(Atom, B)}); +subtract(#t_union{number=Number}=A, B) when ?IS_NUMBER_TYPE(B) -> + shrink_union(A#t_union{number=subtract(Number, B)}); +subtract(#t_union{list=List}=A, B) when ?IS_LIST_TYPE(B) -> + shrink_union(A#t_union{list=subtract(List, B)}); +subtract(#t_union{tuple_set=[_|_]=Records0}=A, #t_tuple{}=B) -> + %% Filter out all records that are strictly more specific than B. + NewSet = case [{Key, T} || {Key, T} <- Records0, meet(T, B) =/= T] of + [_|_]=Records -> Records; + [] -> none + end, + shrink_union(A#t_union{tuple_set=NewSet}); +subtract(#t_union{tuple_set=#t_tuple{}=Tuple}=A, #t_tuple{}=B) -> + %% Exclude Tuple if it's strictly more specific than B. + case meet(Tuple, B) of + Tuple -> shrink_union(A#t_union{tuple_set=none}); + _ -> A + end; + +subtract(T, _) -> T. + +%%% +%%% Type operators +%%% + +-spec get_singleton_value(Type) -> Result when + Type :: type(), + Result :: {ok, term()} | error. +get_singleton_value(#t_atom{elements=[Atom]}) -> + {ok, Atom}; +get_singleton_value(#t_integer{elements={Int,Int}}) -> + {ok, Int}; +get_singleton_value(nil) -> + {ok, []}; +get_singleton_value(_) -> + error. + +-spec is_boolean_type(type()) -> boolean(). +is_boolean_type(#t_atom{elements=[F,T]}) -> + F =:= false andalso T =:= true; +is_boolean_type(#t_atom{elements=[B]}) -> + is_boolean(B); +is_boolean_type(#t_union{}=T) -> + is_boolean_type(normalize(T)); +is_boolean_type(_) -> + false. + +-spec is_singleton_type(type()) -> boolean(). +is_singleton_type(Type) -> + get_singleton_value(Type) =/= error. + +-spec set_element_type(Key, Type, Elements) -> Elements when + Key :: term(), + Type :: type(), + Elements :: elements(). +set_element_type(_Key, none, Es) -> + Es; +set_element_type(Key, any, Es) -> + maps:remove(Key, Es); +set_element_type(Key, Type, Es) -> + Es#{ Key => Type }. + +-spec get_element_type(Key, Elements) -> type() when + Key :: term(), + Elements :: elements(). +get_element_type(Index, Es) -> + case Es of + #{ Index := T } -> T; + #{} -> any + end. + +-spec normalize(type()) -> normal_type(). +normalize(#t_union{atom=Atom,list=List,number=Number, + tuple_set=Tuples,other=Other}) -> + A = lub(Atom, List), + B = lub(A, Number), + C = lub(B, Other), + normalize_tuple_set(Tuples, C); +normalize(T) -> + verified_normal_type(T). + +normalize_tuple_set([{_, A} | Records], B) -> + normalize_tuple_set(Records, lub(A, B)); +normalize_tuple_set([], B) -> + B; +normalize_tuple_set(A, B) -> + lub(A, B). + +%%% +%%% Type constructors +%%% + +-spec make_type_from_value(term()) -> type(). +make_type_from_value(Value) -> + mtfv_1(Value). + +mtfv_1([]) -> nil; +mtfv_1([_|_]) -> cons; +mtfv_1(A) when is_atom(A) -> #t_atom{elements=[A]}; +mtfv_1(B) when is_binary(B) -> #t_bitstring{unit=8}; +mtfv_1(B) when is_bitstring(B) -> #t_bitstring{}; +mtfv_1(F) when is_float(F) -> float; +mtfv_1(F) when is_function(F) -> + {arity, Arity} = erlang:fun_info(F, arity), + #t_fun{arity=Arity}; +mtfv_1(I) when is_integer(I) -> make_integer(I); +mtfv_1(M) when is_map(M) -> #t_map{}; +mtfv_1(T) when is_tuple(T) -> + {Es,_} = foldl(fun(Val, {Es0, Index}) -> + Type = mtfv_1(Val), + Es = set_element_type(Index, Type, Es0), + {Es, Index + 1} + end, {#{}, 1}, tuple_to_list(T)), + #t_tuple{exact=true,size=tuple_size(T),elements=Es}; +mtfv_1(_Term) -> + any. + +-spec make_atom(atom()) -> type(). +make_atom(Atom) when is_atom(Atom) -> + #t_atom{elements=[Atom]}. + +-spec make_boolean() -> type(). +make_boolean() -> + #t_atom{elements=[false,true]}. + +-spec make_integer(integer()) -> type(). +make_integer(Int) when is_integer(Int) -> + make_integer(Int, Int). + +-spec make_integer(Min, Max) -> type() when + Min :: integer(), + Max :: integer(). +make_integer(Min, Max) when is_integer(Min), is_integer(Max), Min =< Max -> + #t_integer{elements={Min,Max}}. + +%%% +%%% Helpers +%%% + +%% Return the greatest lower bound of the types Type1 and Type2. The GLB is a +%% more specific type than Type1 and Type2, and is always a normal type. +%% +%% glb(#t_integer{elements=any}, #t_integer{elements={0,3}}) -> +%% #t_integer{elements={0,3}} +%% +%% The GLB of two different types result in 'none', which is the bottom +%% element for our type lattice: +%% +%% glb(#t_integer{}, #t_map{}) -> none + +-spec glb(normal_type(), normal_type()) -> normal_type(). + +glb(T, T) -> + verified_normal_type(T); +glb(any, T) -> + verified_normal_type(T); +glb(T, any) -> + verified_normal_type(T); +glb(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + case ordsets:intersection(Set1, Set2) of + [] -> + none; + [_|_]=Set -> + #t_atom{elements=Set} + end; +glb(#t_atom{elements=[_|_]}=T, #t_atom{elements=any}) -> + T; +glb(#t_atom{elements=any}, #t_atom{elements=[_|_]}=T) -> + T; +glb(#t_bs_context{slots=SlotCountA,valid=ValidSlotsA}, + #t_bs_context{slots=SlotCountB,valid=ValidSlotsB}) -> + CommonSlotMask = (1 bsl min(SlotCountA, SlotCountB)) - 1, + CommonSlotsA = ValidSlotsA band CommonSlotMask, + CommonSlotsB = ValidSlotsB band CommonSlotMask, + if + CommonSlotsA =:= CommonSlotsB -> + #t_bs_context{slots=max(SlotCountA, SlotCountB), + valid=ValidSlotsA bor ValidSlotsB}; + CommonSlotsA =/= CommonSlotsB -> + none + end; +glb(#t_fun{arity=any}, #t_fun{}=T) -> + T; +glb(#t_fun{}=T, #t_fun{arity=any}) -> + T; +glb(#t_integer{elements={_,_}}=T, #t_integer{elements=any}) -> + T; +glb(#t_integer{elements=any}, #t_integer{elements={_,_}}=T) -> + T; +glb(#t_integer{elements={MinA,MaxA}}, #t_integer{elements={MinB,MaxB}}) + when MinA >= MinB, MinA =< MaxB; + MinB >= MinA, MinB =< MaxA -> + true = MinA =< MaxA andalso MinB =< MaxB, %Assertion. + #t_integer{elements={max(MinA, MinB),min(MaxA, MaxB)}}; +glb(#t_integer{}=T, number) -> T; +glb(float=T, number) -> T; +glb(number, #t_integer{}=T) -> T; +glb(number, float=T) -> T; +glb(list, cons) -> cons; +glb(list, nil) -> nil; +glb(cons, list) -> cons; +glb(nil, list) -> nil; +glb(#t_tuple{}=T1, #t_tuple{}=T2) -> + glb_tuples(T1, T2); +glb(#t_bitstring{unit=U1}, #t_bitstring{unit=U2}) -> + #t_bitstring{unit=U1 * U2 div gcd(U1, U2)}; +glb(_, _) -> + %% Inconsistent types. There will be an exception at runtime. + none. + +glb_tuples(#t_tuple{size=Sz1,exact=true}, + #t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 -> + none; +glb_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1}, + #t_tuple{size=Sz2,exact=Ex2,elements=Es2}) -> + Size = max(Sz1, Sz2), + Exact = Ex1 or Ex2, + case glb_elements(Es1, Es2) of + none -> + none; + Es -> + #t_tuple{size=Size,exact=Exact,elements=Es} + end. + +glb_elements(Es1, Es2) -> + Keys = maps:keys(Es1) ++ maps:keys(Es2), + glb_elements_1(Keys, Es1, Es2, #{}). + +glb_elements_1([Key | Keys], Es1, Es2, Acc) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + %% Note the use of meet/2; elements don't need to be normal types. + case meet(Type1, Type2) of + none -> none; + Type -> glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) + end; + {#{ Key := Type1 }, _} -> + glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); + {_, #{ Key := Type2 }} -> + glb_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) + end; +glb_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% Return the least upper bound of the types Type1 and Type2. The LUB is a more +%% general type than Type1 and Type2, and is always a normal type. +%% +%% For example: +%% +%% lub(#t_integer{elements=any}, #t_integer=elements={0,3}}) -> +%% #t_integer{} +%% +%% The LUB for two different types result in 'any' (not a union type!), which +%% is the top element for our type lattice: +%% +%% lub(#t_integer{}, #t_map{}) -> any + +-spec lub(normal_type(), normal_type()) -> normal_type(). + +lub(T, T) -> + verified_normal_type(T); +lub(none, T) -> + verified_normal_type(T); +lub(T, none) -> + verified_normal_type(T); +lub(any, _) -> + any; +lub(_, any) -> + any; +lub(#t_atom{elements=[_|_]=Set1}, #t_atom{elements=[_|_]=Set2}) -> + Set = ordsets:union(Set1, Set2), + case ordsets:size(Set) of + Size when Size =< ?ATOM_SET_SIZE -> + #t_atom{elements=Set}; + _Size -> + #t_atom{elements=any} + end; +lub(#t_atom{elements=any}=T, #t_atom{elements=[_|_]}) -> T; +lub(#t_atom{elements=[_|_]}, #t_atom{elements=any}=T) -> T; +lub(#t_bitstring{unit=U1}, #t_bitstring{unit=U2}) -> + #t_bitstring{unit=gcd(U1, U2)}; +lub(#t_fun{}, #t_fun{}) -> + #t_fun{}; +lub(#t_integer{elements={MinA,MaxA}}, + #t_integer{elements={MinB,MaxB}}) -> + #t_integer{elements={min(MinA,MinB),max(MaxA,MaxB)}}; +lub(#t_bs_context{slots=SlotsA,valid=ValidA}, + #t_bs_context{slots=SlotsB,valid=ValidB}) -> + #t_bs_context{slots=min(SlotsA, SlotsB), + valid=ValidA band ValidB}; +lub(#t_integer{}, #t_integer{}) -> #t_integer{}; +lub(list, cons) -> list; +lub(cons, list) -> list; +lub(nil, cons) -> list; +lub(cons, nil) -> list; +lub(nil, list) -> list; +lub(list, nil) -> list; +lub(#t_integer{}, float) -> number; +lub(float, #t_integer{}) -> number; +lub(#t_integer{}, number) -> number; +lub(number, #t_integer{}) -> number; +lub(float, number) -> number; +lub(number, float) -> number; +lub(#t_tuple{size=Sz,exact=ExactA,elements=EsA}, + #t_tuple{size=Sz,exact=ExactB,elements=EsB}) -> + Exact = ExactA and ExactB, + Es = lub_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,exact=Exact,elements=Es}; +lub(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) -> + Sz = min(SzA, SzB), + Es = lub_tuple_elements(Sz, EsA, EsB), + #t_tuple{size=Sz,elements=Es}; +lub(_T1, _T2) -> + %%io:format("~p ~p\n", [_T1,_T2]), + any. + +lub_tuple_elements(MinSize, EsA, EsB) -> + Es0 = lub_elements(EsA, EsB), + maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0). + +lub_elements(Es1, Es2) -> + Keys = if + map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); + map_size(Es1) > map_size(Es2) -> maps:keys(Es2) + end, + lub_elements_1(Keys, Es1, Es2, #{}). + +lub_elements_1([Key | Keys], Es1, Es2, Acc0) -> + case {Es1, Es2} of + {#{ Key := Type1 }, #{ Key := Type2 }} -> + %% Note the use of join/2; elements don't need to be normal types. + Acc = set_element_type(Key, join(Type1, Type2), Acc0), + lub_elements_1(Keys, Es1, Es2, Acc); + {#{}, #{}} -> + lub_elements_1(Keys, Es1, Es2, Acc0) + end; +lub_elements_1([], _Es1, _Es2, Acc) -> + Acc. + +%% + +gcd(A, B) -> + case A rem B of + 0 -> B; + X -> gcd(B, X) + end. + +%% + +record_key(#t_tuple{exact=true,size=Size,elements=#{ 1 := Tag }}) -> + case is_singleton_type(Tag) of + true -> {Size, Tag}; + false -> none + end; +record_key(_) -> + none. + +new_tuple_set(T) -> + case record_key(T) of + none -> T; + Key -> [{Key, T}] + end. + +%% + +shrink_union(#t_union{other=any}) -> + any; +shrink_union(#t_union{atom=Atom,list=none,number=none, + tuple_set=none,other=none}) -> + Atom; +shrink_union(#t_union{atom=none,list=List,number=none, + tuple_set=none,other=none}) -> + List; +shrink_union(#t_union{atom=none,list=none,number=Number, + tuple_set=none,other=none}) -> + Number; +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=#t_tuple{}=Tuple,other=none}) -> + Tuple; +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=[{_Key, Record}],other=none}) -> + #t_tuple{} = Record; %Assertion. +shrink_union(#t_union{atom=none,list=none,number=none, + tuple_set=none,other=Other}) -> + Other; +shrink_union(#t_union{}=T) -> + T. + +%% Verifies that the given type is well-formed. + +-spec verified_type(T) -> T when + T :: type(). + +verified_type(#t_union{atom=Atom, + list=List, + number=Number, + tuple_set=TSet, + other=Other}=T) -> + _ = verified_normal_type(Atom), + _ = verified_normal_type(List), + _ = verified_normal_type(Number), + _ = verify_tuple_set(TSet), + _ = verified_normal_type(Other), + T; +verified_type(T) -> + verified_normal_type(T). + +verify_tuple_set([_|_]=T) -> + _ = [verified_normal_type(Rec) || {_, Rec} <- T], + T; +verify_tuple_set(#t_tuple{}=T) -> + none = record_key(T), %Assertion. + T; +verify_tuple_set(none=T) -> + T. + +-spec verified_normal_type(T) -> T when + T :: normal_type(). + +verified_normal_type(any=T) -> T; +verified_normal_type(none=T) -> T; +verified_normal_type(#t_atom{elements=any}=T) -> T; +verified_normal_type(#t_atom{elements=[_|_]}=T) -> T; +verified_normal_type(#t_bitstring{unit=U}=T) + when is_integer(U), U >= 1 -> + T; +verified_normal_type(#t_bs_context{}=T) -> T; +verified_normal_type(#t_fun{arity=Arity}=T) + when Arity =:= any; is_integer(Arity) -> + T; +verified_normal_type(float=T) -> T; +verified_normal_type(#t_integer{elements=any}=T) -> T; +verified_normal_type(#t_integer{elements={Min,Max}}=T) + when is_integer(Min), is_integer(Max), Min =< Max -> + T; +verified_normal_type(list=T) -> T; +verified_normal_type(#t_map{}=T) -> T; +verified_normal_type(nil=T) -> T; +verified_normal_type(cons=T) -> T; +verified_normal_type(number=T) -> T; +verified_normal_type(#t_tuple{size=Size,elements=Es}=T) -> + %% All known elements must have a valid index and type (which may be a + %% union). 'any' is prohibited since it's implicit and should never be + %% present in the map, and a 'none' element ought to have reduced the + %% entire tuple to 'none'. + maps:fold(fun(Index, Element, _) when is_integer(Index), + 1 =< Index, Index =< Size, + Element =/= any, Element =/= none -> + verified_type(Element) + end, [], Es), + T. diff --git a/lib/compiler/src/beam_types.hrl b/lib/compiler/src/beam_types.hrl new file mode 100644 index 0000000000..09f87d61ba --- /dev/null +++ b/lib/compiler/src/beam_types.hrl @@ -0,0 +1,88 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% Common term types for passes operating on beam SSA and assembly. Helper +%% functions for wrangling these can be found in beam_types.erl +%% +%% The type lattice is as follows: +%% +%% any Any Erlang term (top element). +%% +%% - #t_atom{} Atom, or a set thereof. +%% - #t_bitstring{} Bitstring. +%% - #t_bs_context{} Match context. +%% - #t_fun{} Fun. +%% - #t_map{} Map. +%% - number Any number. +%% -- float Floating point number. +%% -- integer Integer. +%% - list Any list. +%% -- cons Cons (nonempty list). +%% -- nil The empty list. +%% - #t_tuple{} Tuple. +%% +%% none No type (bottom element). +%% +%% We also use #t_union{} to represent conflicting types produced by certain +%% expressions, e.g. the "#t_atom{} or #t_tuple{}" of lists:keyfind/3, which is +%% very useful for preserving type information when we would otherwise have +%% reduced it to 'any'. Since few operations can make direct use of this extra +%% type information, types should generally be normalized to one of the above +%% before use. + +-define(ATOM_SET_SIZE, 5). + +-record(t_atom, {elements=any :: 'any' | [atom()]}). +-record(t_fun, {arity=any :: arity() | 'any'}). +-record(t_integer, {elements=any :: 'any' | {integer(),integer()}}). +-record(t_bitstring, {unit=1 :: pos_integer()}). +-record(t_bs_context, {slots=0 :: non_neg_integer(), + valid=0 :: non_neg_integer()}). +-record(t_map, {elements=#{} :: map_elements()}). +-record(t_tuple, {size=0 :: integer(), + exact=false :: boolean(), + elements=#{} :: tuple_elements()}). + +%% Known element types, unknown elements are assumed to be 'any'. The key is +%% a 1-based integer index for tuples, and a plain literal for maps (that is, +%% not wrapped in a #b_literal{}, just the value itself). + +-type tuple_elements() :: #{ Key :: pos_integer() => type() }. +-type map_elements() :: #{ Key :: term() => type() }. + +-type elements() :: tuple_elements() | map_elements(). + +-type normal_type() :: any | none | + list | number | + #t_atom{} | #t_bitstring{} | #t_bs_context{} | + #t_fun{} | #t_integer{} | #t_map{} | #t_tuple{} | + 'cons' | 'float' | 'nil'. + +-type record_key() :: {Arity :: integer(), Tag :: normal_type() }. +-type record_set() :: ordsets:ordset({record_key(), #t_tuple{}}). +-type tuple_set() :: #t_tuple{} | record_set(). + +-record(t_union, {atom=none :: none | #t_atom{}, + list=none :: none | list | cons | nil, + number=none :: none | number | float | #t_integer{}, + tuple_set=none :: none | tuple_set(), + other=none :: normal_type()}). + +-type type() :: #t_union{} | normal_type(). diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 349d74eb58..911b5eb777 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -19,6 +19,10 @@ -module(beam_validator). +-include("beam_types.hrl"). + +-define(UNICODE_MAX, (16#10FFFF)). + -compile({no_auto_import,[min/2]}). %% Avoid warning for local function error/1 clashing with autoimported BIF. @@ -26,7 +30,6 @@ %% Interface for compiler. -export([module/2, format_error/1]). --export([type_anno/1, type_anno/2, type_anno/4]). -import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]). @@ -45,34 +48,6 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) {error,[{atom_to_list(Mod),Es}]} end. -%% Provides a stable interface for type annotations, used by certain passes to -%% indicate that we can safely assume that a register has a given type. --spec type_anno(term()) -> term(). -type_anno(atom) -> {atom,[]}; -type_anno(bool) -> bool; -type_anno({binary,_}) -> binary; -type_anno(cons) -> cons; -type_anno(float) -> {float,[]}; -type_anno(integer) -> {integer,[]}; -type_anno(list) -> list; -type_anno(map) -> map; -type_anno(match_context) -> match_context; -type_anno(number) -> number; -type_anno(nil) -> nil. - --spec type_anno(term(), term()) -> term(). -type_anno(atom, Value) when is_atom(Value) -> {atom, Value}; -type_anno(float, Value) when is_float(Value) -> {float, Value}; -type_anno(integer, Value) when is_integer(Value) -> {integer, Value}. - --spec type_anno(term(), term(), term(), term()) -> term(). -type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0, - is_map(Elements) -> - case Exact of - true -> {tuple, Size, Elements}; - false -> {tuple, [Size], Elements} - end. - -spec format_error(term()) -> iolist(). format_error({{_M,F,A},{I,Off,limit}}) -> @@ -119,7 +94,7 @@ format_error(Error) -> %% format as used in the compiler and in .S files. validate(Module, Fs) -> - Ft = index_parameter_types(Fs, []), + Ft = build_function_table(Fs, []), validate_0(Module, Fs, Ft). validate_0(_Module, [], _) -> []; @@ -136,8 +111,15 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> erlang:raise(Class, Error, Stack) end. +-record(t_abstract, {kind}). + +%% The types are the same as in 'beam_types.hrl', with the addition of +%% #t_abstract{} that describes tuples under construction, match context +%% positions, and so on. +-type validator_type() :: #t_abstract{} | type(). + -record(value_ref, {id :: index()}). --record(value, {op :: term(), args :: [argument()], type :: type()}). +-record(value, {op :: term(), args :: [argument()], type :: validator_type()}). -type argument() :: #value_ref{} | literal(). @@ -149,34 +131,28 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> {literal, term()} | nil. --type tuple_sz() :: [non_neg_integer()] | %% Inexact - non_neg_integer(). %% Exact. - -%% Match context type. --record(ms, - {id=make_ref() :: reference(), %Unique ID. - valid=0 :: non_neg_integer(), %Valid slots - slots=0 :: non_neg_integer() %Number of slots - }). - --type type() :: binary | - cons | - list | - map | - nil | - #ms{} | - ms_position | - none | - number | - term | - tuple_in_progress | - {tuple, tuple_sz(), #{ literal() => type() }} | - literal(). - +%% Register tags describe the state of the register rather than the value they +%% contain (if any). +%% +%% initialized The register has been initialized with some valid term +%% so that it is safe to pass to the garbage collector. +%% NOT safe to use in any other way (will not crash the +%% emulator, but clearly points to a bug in the compiler). +%% +%% uninitialized The register contains any old garbage and can not be +%% passed to the garbage collector. +%% +%% {catchtag,[Lbl]} A special term used within a catch. Must only be used +%% by the catch instructions; NOT safe to use in other +%% instructions. +%% +%% {trytag,[Lbl]} A special term used within a try block. Must only be +%% used by the catch instructions; NOT safe to use in other +%% instructions. -type tag() :: initialized | uninitialized | - {catchtag, [label()]} | - {trytag, [label()]}. + {catchtag, ordsets:ordset(label())} | + {trytag, ordsets:ordset(label())}. -type x_regs() :: #{ {x, index()} => #value_ref{} }. -type y_regs() :: #{ {y, index()} => tag() | #value_ref{} }. @@ -200,11 +176,11 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> numy=none :: none | undecided | index(), %% Available heap size. h=0, - %Available heap size for floats. + %%Available heap size for floats. hf=0, %% Floating point state. fls=undefined, - %% List of hot catch/try labels + %% List of hot catch/try tags ct=[], %% Previous instruction was setelement/3. setelem=false, @@ -225,36 +201,32 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> branched=gb_trees:empty() :: branched_tab(), %% All defined labels labels=gb_sets:empty() :: label_set(), - %% Argument information of other functions in the module + %% Information of other functions in the module ft=gb_trees:empty() :: ft_tab(), %% Counter for #value_ref{} creation ref_ctr=0 :: index() }). -index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) -> +build_function_table([{function,_,Arity,Entry,Code0}|Fs], Acc0) -> Code = dropwhile(fun({label,L}) when L =:= Entry -> false; (_) -> true end, Code0), case Code of [{label,Entry}|Is] -> - Acc = index_parameter_types_1(Is, Entry, Acc0), - index_parameter_types(Fs, Acc); + Info = #{ arity => Arity, + parameter_types => find_parameter_types(Is, #{}) }, + build_function_table(Fs, [{Entry, Info} | Acc0]); _ -> - %% Something serious is wrong. Ignore it for now. + %% Something is seriously wrong. Ignore it for now. %% It will be detected and diagnosed later. - index_parameter_types(Fs, Acc0) + build_function_table(Fs, Acc0) end; -index_parameter_types([], Acc) -> +build_function_table([], Acc) -> gb_trees:from_orddict(sort(Acc)). -index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) -> - Type = case Type0 of - match_context -> #ms{}; - _ -> Type0 - end, - Key = {Entry, Reg}, - index_parameter_types_1(Is, Entry, [{Key, Type} | Acc]); -index_parameter_types_1(_, _, Acc) -> +find_parameter_types([{'%', {type_info, Reg, Type}} | Is], Acc) -> + find_parameter_types(Is, Acc#{ Reg => Type }); +find_parameter_types(_, Acc) -> Acc. validate_1(Is, Name, Arity, Entry, Ft) -> @@ -326,7 +298,7 @@ init_vst(Arity, Ls1, Ls2, Ft) -> init_function_args(-1, Vst) -> Vst; init_function_args(X, Vst) -> - init_function_args(X - 1, create_term(term, argument, [], {x,X}, Vst)). + init_function_args(X - 1, create_term(any, argument, [], {x,X}, Vst)). kill_heap_allocation(St) -> St#st{h=0,hf=0}. @@ -381,17 +353,34 @@ valfun_1({try_case_end,Src}, Vst) -> kill_state(Vst); %% Instructions that cannot cause exceptions valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) -> - bsm_validate_context(Ctx, Vst0), + assert_type(#t_bs_context{}, Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0); + extract_term(#t_bitstring{}, bs_get_tail, [Ctx], Dst, Vst, Vst0); valfun_1(bs_init_writable=I, Vst) -> call(I, 1, Vst); valfun_1(build_stacktrace=I, Vst) -> call(I, 1, Vst); valfun_1({move,Src,Dst}, Vst) -> assign(Src, Dst, Vst); +valfun_1({swap,RegA,RegB}, Vst0) -> + assert_movable(RegA, Vst0), + assert_movable(RegB, Vst0), + + %% We don't expect fragile registers to be swapped. + %% Therefore, we can conservatively make both registers + %% fragile if one of the register is fragile instead of + %% swapping the fragility of the registers. + Sources = [RegA,RegB], + Vst1 = propagate_fragility(RegA, Sources, Vst0), + Vst2 = propagate_fragility(RegB, Sources, Vst1), + + %% Swap the value references. + VrefA = get_reg_vref(RegA, Vst2), + VrefB = get_reg_vref(RegB, Vst2), + Vst = set_reg_vref(VrefB, RegA, Vst2), + set_reg_vref(VrefA, RegB, Vst); valfun_1({fmove,Src,{fr,_}=Dst}, Vst) -> assert_type(float, Src, Vst), set_freg(Dst, Vst); @@ -399,25 +388,36 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) -> assert_freg_set(Src, Vst0), assert_fls(checked, Vst0), Vst = eat_heap_float(Vst0), - create_term({float,[]}, fmove, [], Dst, Vst); + create_term(float, fmove, [], Dst, Vst); valfun_1({kill,Reg}, Vst) -> create_tag(initialized, kill, [], Reg, Vst); valfun_1({init,Reg}, Vst) -> create_tag(initialized, init, [], Reg, Vst); valfun_1({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) -> - case is_bif_safe(Op, length(Ss)) of - false -> - %% Since the BIF can fail, make sure that any catch state - %% is updated. - valfun_2(I, Vst); - true -> - %% It can't fail, so we finish handling it here (not updating - %% catch state). - validate_src(Ss, Vst), - Type = bif_return_type(Op, Ss, Vst), - extract_term(Type, {bif,Op}, Ss, Dst, Vst) +valfun_1({bif,Op,{f,0},Ss,Dst}=I, Vst) -> + case will_bif_succeed(Op, Ss, Vst) of + yes -> + %% This BIF cannot fail, handle it here without updating catch + %% state. + validate_bif(Op, cannot_fail, Ss, Dst, Vst); + no -> + %% The stack will be scanned, so Y registers must be initialized. + verify_y_init(Vst), + kill_state(Vst); + maybe -> + %% The BIF can fail, make sure that any catch state is updated. + valfun_2(I, Vst) + end; +valfun_1({gc_bif,Op,{f,0},Live,Ss,Dst}=I, Vst) -> + case will_bif_succeed(Op, Ss, Vst) of + yes -> + validate_gc_bif(Op, cannot_fail, Ss, Dst, Live, Vst); + no -> + verify_y_init(Vst), + kill_state(Vst); + maybe -> + valfun_2(I, Vst) end; %% Put instructions. valfun_1({put_list,A,B,Dst}, Vst0) -> @@ -431,14 +431,15 @@ valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) -> Vst = eat_heap(Size+1, Vst0), {Es,_} = foldl(fun(Val, {Es0, Index}) -> Type = get_term_type(Val, Vst0), - Es = set_element_type({integer,Index}, Type, Es0), + Es = beam_types:set_element_type(Index, Type, Es0), {Es, Index + 1} end, {#{}, 1}, Elements), - Type = {tuple,Size,Es}, + Type = #t_tuple{exact=true,size=Size,elements=Es}, create_term(Type, put_tuple2, [], Dst, Vst); valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> Vst1 = eat_heap(1, Vst0), - Vst = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1), + Vst = create_term(#t_abstract{kind=unfinished_tuple}, put_tuple, [], + Dst, Vst1), #vst{current=St0} = Vst, St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}}, Vst#vst{current=St}; @@ -450,15 +451,31 @@ valfun_1({put,Src}, Vst0) -> #st{puts_left=none} -> error(not_building_a_tuple); #st{puts_left={1,{Dst,Sz,Es0}}} -> - Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) }, + ElementType = get_term_type(Src, Vst0), + Es = beam_types:set_element_type(Sz, ElementType, Es0), St = St0#st{puts_left=none}, - create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St}); + Type = #t_tuple{exact=true,size=Sz,elements=Es}, + create_term(Type, put_tuple, [], Dst, Vst#vst{current=St}); #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) -> Index = Sz - PutsLeft + 1, - Es = Es0#{ {integer,Index} => get_term_type(Src, Vst0) }, + ElementType = get_term_type(Src, Vst0), + Es = beam_types:set_element_type(Index, ElementType, Es0), St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}}, Vst#vst{current=St} end; +%% This instruction never fails, though it may be invalid in some contexts; see +%% val_dsetel/2 +valfun_1({set_tuple_element,Src,Tuple,N}, Vst) -> + I = N + 1, + assert_term(Src, Vst), + assert_type(#t_tuple{size=I}, Tuple, Vst), + %% Manually update the tuple type; we can't rely on the ordinary update + %% helpers as we must support overwriting (rather than just widening or + %% narrowing) known elements, and we can't use extract_term either since + %% the source tuple may be aliased. + #t_tuple{elements=Es0}=Type = normalize(get_term_type(Tuple, Vst)), + Es = beam_types:set_element_type(I, get_term_type(Src, Vst), Es0), + override_type(Type#t_tuple{elements=Es}, Tuple, Vst); %% Instructions for optimization of selective receives. valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> Vst; @@ -469,8 +486,13 @@ valfun_1(remove_message, Vst) -> %% The message term is no longer fragile. It can be used %% without restrictions. remove_fragility(Vst); -valfun_1({'%', {type_info, Reg, match_context}}, Vst) -> - update_type(fun meet/2, #ms{}, Reg, Vst); +valfun_1({'%', {type_info, _Reg, none}}, Vst) -> + %% Unreachable code, typically after a call that never returns. + kill_state(Vst); +valfun_1({'%', {type_info, Reg, #t_bs_context{}=Type}}, Vst) -> + %% This is a gross hack, but we'll be rid of it once we have proper union + %% types. + override_type(Type, Reg, Vst); valfun_1({'%', {type_info, Reg, Type}}, Vst) -> %% Explicit type information inserted by optimization passes to indicate %% that Reg has a certain type, so that we can accept cross-function type @@ -490,15 +512,19 @@ valfun_1({line,_}, Vst) -> Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> - case call_return_type(Func, Vst) of - exception -> - verify_live(Live, Vst), - %% The stack will be scanned, so Y registers - %% must be initialized. + case will_call_succeed(Func, Vst) of + yes -> + %% This call cannot fail, handle it here without updating catch + %% state. + call(Func, Live, Vst); + no -> + %% The stack will be scanned, so Y registers must be initialized. + verify_live(Live, Vst), verify_y_init(Vst), - kill_state(Vst); - _ -> - valfun_2(I, Vst) + kill_state(Vst); + maybe -> + %% The call can fail, make sure that any catch state is updated. + valfun_2(I, Vst) end; valfun_1(_I, #vst{current=#st{ct=undecided}}) -> error(unknown_catch_try_state); @@ -530,54 +556,56 @@ valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(catchtag, Dst, Fail, Vst); valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none -> init_try_catch_branch(trytag, Dst, Fail, Vst); -valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> +valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) -> case get_tag_type(Reg, Vst0) of - {catchtag,Fail} -> + {catchtag,_Fail}=Tag -> %% {x,0} contains the caught term, if any. - create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); + create_term(any, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0)); Type -> error({wrong_tag_type,Type}) end; -valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) -> +valfun_1({try_end,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst) -> case get_tag_type(Reg, Vst) of - {trytag,Fail} -> + {trytag,_Fail}=Tag -> %% Kill the catch tag, note that x registers are unaffected. kill_catch_tag(Reg, Vst); Type -> error({wrong_tag_type,Type}) end; -valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) -> +valfun_1({try_case,Reg}, #vst{current=#st{ct=[Tag|_]}}=Vst0) -> case get_tag_type(Reg, Vst0) of - {trytag,Fail} -> + {trytag,_Fail}=Tag -> %% Kill the catch tag and all x registers. Vst1 = prune_x_regs(0, kill_catch_tag(Reg, Vst0)), %% Class:Error:Stacktrace - Vst2 = create_term({atom,[]}, try_case, [], {x,0}, Vst1), - Vst = create_term(term, try_case, [], {x,1}, Vst2), - create_term(term, try_case, [], {x,2}, Vst); + Vst2 = create_term(#t_atom{}, try_case, [], {x,0}, Vst1), + Vst = create_term(any, try_case, [], {x,1}, Vst2), + create_term(any, try_case, [], {x,2}, Vst); Type -> error({wrong_tag_type,Type}) end; +%% Simple getters that can't fail. valfun_1({get_list,Src,D1,D2}, Vst0) -> assert_not_literal(Src), assert_type(cons, Src, Vst0), - Vst = extract_term(term, get_hd, [Src], D1, Vst0), - extract_term(term, get_tl, [Src], D2, Vst); + Vst = extract_term(any, get_hd, [Src], D1, Vst0), + extract_term(any, get_tl, [Src], D2, Vst); valfun_1({get_hd,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - extract_term(term, get_hd, [Src], Dst, Vst); + extract_term(any, get_hd, [Src], Dst, Vst); valfun_1({get_tl,Src,Dst}, Vst) -> assert_not_literal(Src), assert_type(cons, Src, Vst), - extract_term(term, get_tl, [Src], Dst, Vst); + extract_term(any, get_tl, [Src], Dst, Vst); valfun_1({get_tuple_element,Src,N,Dst}, Vst) -> + Index = N+1, assert_not_literal(Src), - assert_type({tuple_element,N+1}, Src, Vst), - Index = {integer,N+1}, - Type = get_element_type(Index, Src, Vst), - extract_term(Type, {bif,element}, [Index, Src], Dst, Vst); + assert_type(#t_tuple{size=Index}, Src, Vst), + #t_tuple{elements=Es} = normalize(get_term_type(Src, Vst)), + Type = beam_types:get_element_type(Index, Es), + extract_term(Type, {bif,element}, [{integer,Index}, Src], Dst, Vst); valfun_1({jump,{f,Lbl}}, Vst) -> branch(Lbl, Vst, fun(SuccVst) -> @@ -587,38 +615,45 @@ valfun_1({jump,{f,Lbl}}, Vst) -> valfun_1(I, Vst) -> valfun_2(I, Vst). -init_try_catch_branch(Tag, Dst, Fail, Vst0) -> - Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0), - #vst{current=#st{ct=Fails}=St0} = Vst1, - St = St0#st{ct=[[Fail]|Fails]}, - Vst = Vst0#vst{current=St}, +init_try_catch_branch(Kind, Dst, Fail, Vst0) -> + Tag = {Kind, [Fail]}, + Vst = create_tag(Tag, 'try_catch', [], Dst, Vst0), branch(Fail, Vst, - fun(CatchVst) -> - #vst{current=#st{ys=Ys}} = CatchVst, - maps:fold(fun init_catch_handler_1/3, CatchVst, Ys) + fun(CatchVst0) -> + %% We add the tag here because branch/4 rejects jumps to + %% labels referenced by try tags. + #vst{current=#st{ct=Tags,ys=Ys}=St0} = CatchVst0, + St = St0#st{ct=[Tag|Tags]}, + CatchVst = CatchVst0#vst{current=St}, + + maps:fold(fun init_catch_handler_1/3, CatchVst, Ys) end, - fun(SuccVst) -> - %% All potentially-throwing instructions after this - %% one will implicitly branch to the fail label; - %% see valfun_2/2 - SuccVst + fun(SuccVst0) -> + #vst{current=#st{ct=Tags}=St0} = SuccVst0, + St = St0#st{ct=[Tag|Tags]}, + SuccVst = SuccVst0#vst{current=St}, + + %% All potentially-throwing instructions after this one will + %% implicitly branch to the current try/catch handler; see + %% valfun_2/2 + SuccVst end). %% Set the initial state at the try/catch label. Assume that Y registers %% contain terms or try/catch tags. init_catch_handler_1(Reg, initialized, Vst) -> - create_term(term, 'catch_handler', [], Reg, Vst); + create_term(any, 'catch_handler', [], Reg, Vst); init_catch_handler_1(Reg, uninitialized, Vst) -> - create_term(term, 'catch_handler', [], Reg, Vst); + create_term(any, 'catch_handler', [], Reg, Vst); init_catch_handler_1(_, _, Vst) -> Vst. -valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) -> +valfun_2(I, #vst{current=#st{ct=[{_,[Fail]}|_]}}=Vst) when is_integer(Fail) -> %% We have an active try/catch tag and we can jump there from this %% instruction, so we need to update the branched state of the try/catch %% handler. - valfun_3(I, branch_state(Fail, Vst)); + valfun_3(I, fork_state(Fail, Vst)); valfun_2(I, #vst{current=#st{ct=[]}}=Vst) -> valfun_3(I, Vst); valfun_2(_, _) -> @@ -672,8 +707,16 @@ valfun_4({apply,Live}, Vst) -> valfun_4({apply_last,Live,_}, Vst) -> tail_call(apply, Live+2, Vst); valfun_4({call_fun,Live}, Vst) -> - validate_src([{x,Live}], Vst), - call('fun', Live+1, Vst); + Fun = {x,Live}, + assert_term(Fun, Vst), + + %% An exception is raised on error, hence branching to 0. + branch(0, Vst, + fun(SuccVst0) -> + SuccVst = update_type(fun meet/2, #t_fun{arity=Live}, + Fun, SuccVst0), + call('fun', Live+1, SuccVst) + end); valfun_4({call,Live,Func}, Vst) -> call(Func, Live, Vst); valfun_4({call_ext,Live,Func}, Vst) -> @@ -692,76 +735,28 @@ valfun_4({call_ext_last,Live,Func,StkSize}, tail_call(Func, Live, Vst); valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_4({make_fun2,_,_,_,Live}, Vst) -> - call(make_fun, Live, Vst); -%% Other BIFs -valfun_4({bif,element,{f,Fail},[Pos,Src],Dst}, Vst) -> - branch(Fail, Vst, - fun(SuccVst0) -> - PosType = get_term_type(Pos, SuccVst0), - TupleType = {tuple,[get_tuple_size(PosType)],#{}}, +valfun_4({make_fun2,{f,Lbl},_,_,NumFree}, #vst{ft=Ft}=Vst0) -> + #{ arity := Arity0 } = gb_trees:get(Lbl, Ft), + Arity = Arity0 - NumFree, - SuccVst1 = update_type(fun meet/2, TupleType, - Src, SuccVst0), - SuccVst = update_type(fun meet/2, {integer,[]}, - Pos, SuccVst1), + true = Arity >= 0, %Assertion. - ElementType = get_element_type(PosType, Src, SuccVst), - extract_term(ElementType, {bif,element}, [Pos,Src], - Dst, SuccVst) - end); + Vst = prune_x_regs(NumFree, Vst0), + verify_call_args(make_fun, NumFree, Vst), + verify_y_init(Vst), + + create_term(#t_fun{arity=Arity}, make_fun, [], {x,0}, Vst); +%% Other BIFs valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); valfun_4(raw_raise=I, Vst) -> call(I, 3, Vst); -valfun_4({bif,Op,{f,Fail},[Src]=Ss,Dst}, Vst) when Op =:= hd; Op =:= tl -> - assert_term(Src, Vst), - branch(Fail, Vst, - fun(FailVst) -> - update_type(fun subtract/2, cons, Src, FailVst) - end, - fun(SuccVst0) -> - SuccVst = update_type(fun meet/2, cons, Src, SuccVst0), - extract_term(term, {bif,Op}, Ss, Dst, SuccVst) - end); valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst) -> validate_src(Ss, Vst), - branch(Fail, Vst, - fun(SuccVst0) -> - %% Infer argument types. Note that we can't subtract - %% types as the BIF could fail for reasons other than - %% bad argument types. - ArgTypes = bif_arg_types(Op, Ss), - SuccVst = foldl(fun({Arg, T}, V) -> - update_type(fun meet/2, T, Arg, V) - end, SuccVst0, zip(Ss, ArgTypes)), - Type = bif_return_type(Op, Ss, SuccVst), - extract_term(Type, {bif,Op}, Ss, Dst, SuccVst) - end); -valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) -> - validate_src(Ss, Vst0), - verify_live(Live, Vst0), - verify_y_init(Vst0), - - %% Heap allocations and X registers are killed regardless of whether we - %% fail or not, as we may fail after GC. - St = kill_heap_allocation(St0), - Vst = prune_x_regs(Live, Vst0#vst{current=St}), - - branch(Fail, Vst, - fun(SuccVst0) -> - ArgTypes = bif_arg_types(Op, Ss), - SuccVst = foldl(fun({Arg, T}, V) -> - update_type(fun meet/2, T, Arg, V) - end, SuccVst0, zip(Ss, ArgTypes)), - - Type = bif_return_type(Op, Ss, SuccVst), - - %% We're passing Vst0 as the original because the - %% registers were pruned before the branch. - extract_term(Type, {gc_bif,Op}, Ss, Dst, SuccVst, Vst0) - end); + validate_bif(Op, Fail, Ss, Dst, Vst); +valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, Vst) -> + validate_gc_bif(Op, Fail, Ss, Dst, Live, Vst); valfun_4(return, #vst{current=#st{numy=none}}=Vst) -> assert_durable_term({x,0}, Vst), kill_state(Vst); @@ -773,7 +768,7 @@ valfun_4({loop_rec,{f,Fail},Dst}, Vst) -> %% part of this term must be stored in a Y register. branch(Fail, Vst, fun(SuccVst0) -> - {Ref, SuccVst} = new_value(term, loop_rec, [], SuccVst0), + {Ref, SuccVst} = new_value(any, loop_rec, [], SuccVst0), mark_fragile(Dst, set_reg_vref(Ref, Dst, SuccVst)) end); valfun_4({wait,_}, Vst) -> @@ -790,24 +785,13 @@ valfun_4(timeout, Vst) -> prune_x_regs(0, Vst); valfun_4(send, Vst) -> call(send, 2, Vst); -valfun_4({set_tuple_element,Src,Tuple,N}, Vst) -> - I = N + 1, - assert_term(Src, Vst), - assert_type({tuple_element,I}, Tuple, Vst), - %% Manually update the tuple type; we can't rely on the ordinary update - %% helpers as we must support overwriting (rather than just widening or - %% narrowing) known elements, and we can't use extract_term either since - %% the source tuple may be aliased. - {tuple, Sz, Es0} = get_term_type(Tuple, Vst), - Es = set_element_type({integer,I}, get_term_type(Src, Vst), Es0), - override_type({tuple, Sz, Es}, Tuple, Vst); %% Match instructions. valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) -> assert_term(Src, Vst), assert_choices(Choices), validate_select_val(Fail, Choices, Src, Vst); valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) -> - assert_type(tuple, Tuple, Vst), + assert_type(#t_tuple{}, Tuple, Vst), assert_arities(Choices), validate_select_tuple_arity(Fail, Choices, Tuple, Vst); @@ -817,17 +801,17 @@ valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) -> valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) -> validate_bs_start_match(Fail, Live, bsm_match_state(Slots), Src, Dst, Vst); valfun_4({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), + assert_type(#t_bs_context{}, Ctx, Vst), branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_skip_bits2,{f,Fail},[Ctx,Src,_,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), + assert_type(#t_bs_context{}, Ctx, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), + assert_type(#t_bs_context{}, Ctx, Vst), branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_test_unit,{f,Fail},[Ctx,_]}, Vst) -> - bsm_validate_context(Ctx, Vst), + assert_type(#t_bs_context{}, Ctx, Vst), branch(Fail, Vst, fun(V) -> V end); valfun_4({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); @@ -835,52 +819,69 @@ valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); valfun_4({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) -> validate_bs_skip_utf(Fail, Ctx, Live, Vst); -valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); +valfun_4({test,bs_get_integer2=Op,{f,Fail},Live, + [Ctx,{integer,Size},Unit,{field_flags,Flags}],Dst},Vst) + when Size * Unit =< 64 -> + Type = case member(unsigned, Flags) of + true -> + NumBits = Size * Unit, + beam_types:make_integer(0, (1 bsl NumBits)-1); + false -> + %% Signed integer or way too large, don't bother. + #t_integer{} + end, + validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst); +valfun_4({test,bs_get_integer2=Op,{f,Fail},Live, + [Ctx,_Size,_Unit,_Flags],Dst},Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, #t_integer{}, Dst, Vst); valfun_4({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst); -valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst); + validate_bs_get(Op, Fail, Ctx, Live, float, Dst, Vst); +valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,Unit,_],Dst}, Vst) -> + validate_bs_get(Op, Fail, Ctx, Live, #t_bitstring{unit=Unit}, Dst, Vst); valfun_4({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst); valfun_4({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst); valfun_4({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) -> - validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst); + Type = beam_types:make_integer(0, ?UNICODE_MAX), + validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst); valfun_4({bs_save2,Ctx,SavePoint}, Vst) -> bsm_save(Ctx, SavePoint, Vst); valfun_4({bs_restore2,Ctx,SavePoint}, Vst) -> bsm_restore(Ctx, SavePoint, Vst); valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) -> - bsm_validate_context(Ctx, Vst0), + assert_type(#t_bs_context{}, Ctx, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), Vst = prune_x_regs(Live, Vst0), - create_term(ms_position, bs_get_position, [Ctx], Dst, Vst, Vst0); + create_term(#t_abstract{kind=ms_position}, bs_get_position, [Ctx], + Dst, Vst, Vst0); valfun_4({bs_set_position, Ctx, Pos}, Vst) -> - bsm_validate_context(Ctx, Vst), - assert_type(ms_position, Pos, Vst), + assert_type(#t_bs_context{}, Ctx, Vst), + assert_type(#t_abstract{kind=ms_position}, Pos, Vst), Vst; %% Other test instructions. valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> - assert_type(map, Src, Vst), + assert_type(#t_map{}, Src, Vst), assert_unique_map_keys(List), branch(Lbl, Vst, fun(V) -> V end); valfun_4({test,is_atom,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {atom,[]}, Src, Vst); + type_test(Lbl, #t_atom{}, Src, Vst); valfun_4({test,is_binary,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, binary, Src, Vst); + type_test(Lbl, #t_bitstring{unit=8}, Src, Vst); valfun_4({test,is_bitstr,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, binary, Src, Vst); + type_test(Lbl, #t_bitstring{}, Src, Vst); valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, bool, Src, Vst); + type_test(Lbl, beam_types:make_boolean(), Src, Vst); valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {float,[]}, Src, Vst); + type_test(Lbl, float, Src, Vst); valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {tuple,[0],#{}}, Src, Vst); + type_test(Lbl, #t_tuple{}, Src, Vst); valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, {integer,[]}, Src, Vst); + type_test(Lbl, #t_integer{}, Src, Vst); valfun_4({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) -> type_test(Lbl, cons, Src, Vst); valfun_4({test,is_number,{f,Lbl},[Src]}, Vst) -> @@ -888,7 +889,7 @@ valfun_4({test,is_number,{f,Lbl},[Src]}, Vst) -> valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) -> type_test(Lbl, list, Src, Vst); valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) -> - type_test(Lbl, map, Src, Vst); + type_test(Lbl, #t_map{}, Src, Vst); valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) -> %% is_nil is an exact check against the 'nil' value, and should not be %% treated as a simple type test. @@ -901,12 +902,13 @@ valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) -> update_eq_types(Src, nil, SuccVst) end); valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> - assert_type(tuple, Tuple, Vst), - Type = {tuple, Sz, #{}}, + assert_type(#t_tuple{}, Tuple, Vst), + Type = #t_tuple{exact=true,size=Sz}, type_test(Lbl, Type, Tuple, Vst); valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) -> assert_term(Src, Vst), - Type = {tuple, Sz, #{ {integer,1} => Atom }}, + Es = #{ 1 => get_literal_type(Atom) }, + Type = #t_tuple{exact=true,size=Sz,elements=Es}, type_test(Lbl, Type, Src, Vst); valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) -> validate_src(Ss, Vst), @@ -935,19 +937,19 @@ valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) -> assert_term(B, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_add, [A, B], Dst, SuccVst) + create_term(#t_integer{}, bs_add, [A, B], Dst, SuccVst) end); valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_utf8_size, [A], Dst, SuccVst) + create_term(#t_integer{}, bs_utf8_size, [A], Dst, SuccVst) end); valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term({integer,[]}, bs_utf16_size, [A], Dst, SuccVst) + create_term(#t_integer{}, bs_utf16_size, [A], Dst, SuccVst) end); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -962,7 +964,8 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_init2, [], Dst, SuccVst, SuccVst0) + create_term(#t_bitstring{unit=8}, bs_init2, [], Dst, + SuccVst, SuccVst0) end); valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), @@ -977,9 +980,9 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_init_bits, [], Dst, SuccVst) + create_term(#t_bitstring{}, bs_init_bits, [], Dst, SuccVst) end); -valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> +valfun_4({bs_append,{f,Fail},Bits,Heap,Live,Unit,Bin,_Flags,Dst}, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), assert_term(Bits, Vst0), @@ -988,14 +991,16 @@ valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) -> branch(Fail, Vst, fun(SuccVst0) -> SuccVst = prune_x_regs(Live, SuccVst0), - create_term(binary, bs_append, [Bin], Dst, SuccVst, SuccVst0) + create_term(#t_bitstring{unit=Unit}, bs_append, + [Bin], Dst, SuccVst, SuccVst0) end); -valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst) -> +valfun_4({bs_private_append,{f,Fail},Bits,Unit,Bin,_Flags,Dst}, Vst) -> assert_term(Bits, Vst), assert_term(Bin, Vst), branch(Fail, Vst, fun(SuccVst) -> - create_term(binary, bs_private_append, [Bin], Dst, SuccVst) + create_term(#t_bitstring{unit=Unit}, bs_private_append, + [Bin], Dst, SuccVst) end); valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) -> Vst; @@ -1004,39 +1009,39 @@ valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, binary, Src, SuccVst) + update_type(fun meet/2, #t_bitstring{}, Src, SuccVst) end); valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {float,[]}, Src, SuccVst) + update_type(fun meet/2, float, Src, SuccVst) end); valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) -> assert_term(Sz, Vst), assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) -> assert_term(Src, Vst), branch(Fail, Vst, fun(SuccVst) -> - update_type(fun meet/2, {integer,[]}, Src, SuccVst) + update_type(fun meet/2, #t_integer{}, Src, SuccVst) end); %% Map instructions. valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> @@ -1050,7 +1055,7 @@ valfun_4(_, _) -> verify_get_map(Fail, Src, List, Vst0) -> assert_not_literal(Src), %OTP 22. - assert_type(map, Src, Vst0), + assert_type(#t_map{}, Src, Vst0), branch(Fail, Vst0, fun(FailVst) -> @@ -1074,7 +1079,7 @@ verify_get_map(Fail, Src, List, Vst0) -> clobber_map_vals([Key,Dst|T], Map, Vst0) -> case is_reg_initialized(Dst, Vst0) of true -> - Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0), + Vst = extract_term(any, {bif,map_get}, [Key, Map], Dst, Vst0), clobber_map_vals(T, Map, Vst); false -> clobber_map_vals(T, Map, Vst0) @@ -1099,13 +1104,13 @@ extract_map_keys([]) -> []. extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) -> assert_term(Key, Vst0), - Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0), + Vsti = extract_term(any, {bif,map_get}, [Key, Map], Dst, Vsti0), extract_map_vals(Vs, Map, Vst0, Vsti); extract_map_vals([], _Map, _Vst0, Vst) -> Vst. verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> - assert_type(map, Src, Vst0), + assert_type(#t_map{}, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), _ = [assert_term(Term, Vst0) || Term <- List], @@ -1116,10 +1121,73 @@ verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) -> SuccVst = prune_x_regs(Live, SuccVst0), Keys = extract_map_keys(List), assert_unique_map_keys(Keys), - create_term(map, Op, [Src], Dst, SuccVst, SuccVst0) + create_term(#t_map{}, Op, [Src], Dst, SuccVst, SuccVst0) end). %% +%% Common code for validating BIFs. +%% +%% OrigVst is the state we entered the instruction with, which is needed for +%% gc_bifs as X registers are pruned prior to calling this function, which may +%% have clobbered the sources. +%% + +validate_bif(Op, Fail, Ss, Dst, Vst) -> + validate_src(Ss, Vst), + validate_bif_1(bif, Op, Fail, Ss, Dst, Vst, Vst). + +validate_gc_bif(Op, Fail, Ss, Dst, Live, #vst{current=St0}=Vst0) -> + validate_src(Ss, Vst0), + verify_live(Live, Vst0), + verify_y_init(Vst0), + + %% Heap allocations and X registers are killed regardless of whether we + %% fail or not, as we may fail after GC. + St = kill_heap_allocation(St0), + Vst = prune_x_regs(Live, Vst0#vst{current=St}), + validate_src(Ss, Vst), + + validate_bif_1(gc_bif, Op, Fail, Ss, Dst, Vst, Vst). + +validate_bif_1(Kind, Op, cannot_fail, Ss, Dst, OrigVst, Vst0) -> + %% This BIF explicitly cannot fail; it will not jump to a guard nor throw + %% an exception. Validation will fail if it returns 'none' or has a type + %% conflict on one of its arguments. + + {Type, ArgTypes, _CanSubtract} = bif_types(Op, Ss, Vst0), + ZippedArgs = zip(Ss, ArgTypes), + + Vst = foldl(fun({A, T}, V) -> + update_type(fun meet/2, T, A, V) + end, Vst0, ZippedArgs), + + true = Type =/= none, %Assertion. + + extract_term(Type, {Kind, Op}, Ss, Dst, Vst, OrigVst); +validate_bif_1(Kind, Op, Fail, Ss, Dst, OrigVst, Vst) -> + {Type, ArgTypes, CanSubtract} = bif_types(Op, Ss, Vst), + ZippedArgs = zip(Ss, ArgTypes), + + FailFun = case CanSubtract of + true -> + fun(FailVst0) -> + foldl(fun({A, T}, V) -> + update_type(fun subtract/2, T, A, V) + end, FailVst0, ZippedArgs) + end; + false -> + fun(S) -> S end + end, + SuccFun = fun(SuccVst0) -> + SuccVst = foldl(fun({A, T}, V) -> + update_type(fun meet/2, T, A, V) + end, SuccVst0, ZippedArgs), + extract_term(Type, {Kind, Op}, Ss, Dst, SuccVst, OrigVst) + end, + + branch(Fail, Vst, FailFun, SuccFun). + +%% %% Common code for validating bs_start_match* instructions. %% @@ -1127,18 +1195,18 @@ validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> verify_live(Live, Vst), verify_y_init(Vst), - %% #ms{} can represent either a match context or a term, so we have to mark - %% the source as a term if it fails with a match context as an input. This - %% hack is only needed until we get proper union types. + %% #t_bs_context{} can represent either a match context or a term, so we + %% have to mark the source as a term if it fails with a match context as an + %% input. This hack is only needed until we get proper union types. branch(Fail, Vst, fun(FailVst) -> case get_movable_term_type(Src, FailVst) of - #ms{} -> override_type(term, Src, FailVst); + #t_bs_context{} -> override_type(any, Src, FailVst); _ -> FailVst end end, fun(SuccVst0) -> - SuccVst1 = update_type(fun meet/2, binary, + SuccVst1 = update_type(fun meet/2, #t_bitstring{}, Src, SuccVst0), SuccVst = prune_x_regs(Live, SuccVst1), extract_term(Type, bs_start_match, [Src], Dst, @@ -1149,7 +1217,7 @@ validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) -> %% Common code for validating bs_get* instructions. %% validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) -> - bsm_validate_context(Ctx, Vst), + assert_type(#t_bs_context{}, Ctx, Vst), verify_live(Live, Vst), verify_y_init(Vst), @@ -1163,7 +1231,7 @@ validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) -> %% Common code for validating bs_skip_utf* instructions. %% validate_bs_skip_utf(Fail, Ctx, Live, Vst) -> - bsm_validate_context(Ctx, Vst), + assert_type(#t_bs_context{}, Ctx, Vst), verify_y_init(Vst), verify_live(Live, Vst), @@ -1217,12 +1285,13 @@ kill_state(Vst) -> call(Name, Live, #vst{current=St0}=Vst0) -> verify_call_args(Name, Live, Vst0), verify_y_init(Vst0), - case call_return_type(Name, Vst0) of - Type when Type =/= exception -> - %% Type is never 'exception' because it has been handled earlier. + case call_types(Name, Live, Vst0) of + {none, _, _} -> + kill_state(Vst0); + {RetType, _, _} -> St = St0#st{f=init_fregs()}, Vst = prune_x_regs(0, Vst0#vst{current=St}), - create_term(Type, call, [], {x,0}, Vst) + create_term(RetType, call, [], {x,0}, Vst) end. %% Tail call. @@ -1237,8 +1306,15 @@ tail_call(Name, Live, Vst0) -> verify_call_args(_, 0, #vst{}) -> ok; -verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - verify_local_args(Live - 1, Lbl, #{}, Vst); +verify_call_args({f,Lbl}, Live, #vst{ft=Ft}=Vst) when is_integer(Live) -> + case gb_trees:lookup(Lbl, Ft) of + {value, FuncInfo} -> + #{ arity := Live, + parameter_types := ParamTypes } = FuncInfo, + verify_local_args(Live - 1, ParamTypes, #{}, Vst); + none -> + error(local_call_to_unknown_function) + end; verify_call_args(_, Live, Vst) when is_integer(Live)-> verify_remote_args_1(Live - 1, Vst); verify_call_args(_, Live, _) -> @@ -1250,87 +1326,50 @@ verify_remote_args_1(X, Vst) -> assert_durable_term({x, X}, Vst), verify_remote_args_1(X - 1, Vst). -verify_local_args(-1, _Lbl, _CtxIds, _Vst) -> +verify_local_args(-1, _ParamTypes, _CtxIds, _Vst) -> ok; -verify_local_args(X, Lbl, CtxIds, Vst) -> +verify_local_args(X, ParamTypes, CtxRefs, Vst) -> Reg = {x, X}, assert_not_fragile(Reg, Vst), case get_movable_term_type(Reg, Vst) of - #ms{id=Id}=Type -> - case CtxIds of - #{ Id := Other } -> + #t_bs_context{}=Type -> + VRef = get_reg_vref(Reg, Vst), + case CtxRefs of + #{ VRef := Other } -> error({multiple_match_contexts, [Reg, Other]}); #{} -> - verify_arg_type(Lbl, Reg, Type, Vst), - verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst) + verify_arg_type(Reg, Type, ParamTypes), + verify_local_args(X - 1, ParamTypes, + CtxRefs#{ VRef => Reg }, Vst) end; Type -> - verify_arg_type(Lbl, Reg, Type, Vst), - verify_local_args(X - 1, Lbl, CtxIds, Vst) + verify_arg_type(Reg, Type, ParamTypes), + verify_local_args(X - 1, ParamTypes, CtxRefs, Vst) end. %% Verifies that the given argument narrows to what the function expects. -verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) -> +verify_arg_type(Reg, #t_bs_context{}, ParamTypes) -> %% Match contexts require explicit support, and may not be passed to a %% function that accepts arbitrary terms. - case gb_trees:lookup({Lbl, Reg}, Ft) of - {value, #ms{}} -> ok; - _ -> error(no_bs_start_match2) + case ParamTypes of + #{ Reg := #t_bs_context{}} -> ok; + #{} -> error(no_bs_start_match2) end; -verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) -> - case gb_trees:lookup({Lbl, Reg}, Ft) of - {value, #ms{}} -> +verify_arg_type(Reg, GivenType, ParamTypes) -> + case ParamTypes of + #{ Reg := #t_bs_context{}} -> %% Functions that accept match contexts also accept all other %% terms. This will change once we support union types. ok; - {value, RequiredType} -> - case vat_1(GivenType, RequiredType) of - true -> ok; - false -> error({bad_arg_type, Reg, GivenType, RequiredType}) + #{ Reg := RequiredType } -> + case meet(GivenType, RequiredType) of + GivenType -> ok; + _ -> error({bad_arg_type, Reg, GivenType, RequiredType}) end; - none -> + #{} -> ok end. -%% Checks whether the Given argument is compatible with the Required one. This -%% is essentially a relaxed version of 'meet(Given, Req) =:= Given', where we -%% accept that the Given value has the right type but not necessarily the exact -%% same value; if {atom,gurka} is required, we'll consider {atom,[]} valid. -%% -%% This will catch all problems that could crash the emulator, like passing a -%% 1-tuple when the callee expects a 3-tuple, but some value errors might slip -%% through. -vat_1(Same, Same) -> true; -vat_1({atom,A}, {atom,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({atom,A}, bool) -> is_boolean(A) orelse is_list(A); -vat_1(bool, {atom,B}) -> is_boolean(B) orelse is_list(B); -vat_1(cons, list) -> true; -vat_1({float,A}, {float,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({float,_}, number) -> true; -vat_1({integer,A}, {integer,B}) -> A =:= B orelse is_list(A) orelse is_list(B); -vat_1({integer,_}, number) -> true; -vat_1(_, {literal,_}) -> false; -vat_1({literal,_}=Lit, Required) -> vat_1(get_literal_type(Lit), Required); -vat_1(nil, list) -> true; -vat_1({tuple,SzA,EsA}, {tuple,SzB,EsB}) -> - if - is_list(SzB) -> - tuple_sz(SzA) >= tuple_sz(SzB) andalso vat_elements(EsA, EsB); - SzA =:= SzB -> - vat_elements(EsA, EsB); - SzA =/= SzB -> - false - end; -vat_1(_, _) -> false. - -vat_elements(EsA, EsB) -> - maps:fold(fun(Key, Req, Acc) -> - case EsA of - #{ Key := Given } -> Acc andalso vat_1(Given, Req); - #{} -> false - end - end, true, EsB). - allocate(Tag, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> verify_live(Live, Vst0), Vst1 = Vst0#vst{current=St#st{numy=Stk}}, @@ -1512,48 +1551,39 @@ assert_unique_map_keys([_,_|_]=Ls) -> %%% bsm_match_state() -> - #ms{}. + #t_bs_context{}. bsm_match_state(Slots) -> - #ms{slots=Slots}. - -bsm_validate_context(Reg, Vst) -> - _ = bsm_get_context(Reg, Vst), - ok. - -bsm_get_context({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y-> - case get_movable_term_type(Reg, Vst) of - #ms{}=Ctx -> Ctx; - _ -> error({no_bsm_context,Reg}) - end; -bsm_get_context(Reg, _) -> - error({bad_source,Reg}). + #t_bs_context{slots=Slots}. bsm_save(Reg, {atom,start}, Vst) -> %% Save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_validate_context(Reg, Vst), + assert_type(#t_bs_context{}, Reg, Vst), Vst; bsm_save(Reg, SavePoint, Vst) -> - case bsm_get_context(Reg, Vst) of - #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> - Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, - override_type(Ctx, Reg, Vst); - _ -> error({illegal_save,SavePoint}) + case get_movable_term_type(Reg, Vst) of + #t_bs_context{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> + Ctx = Ctxt0#t_bs_context{valid=Bits bor (1 bsl SavePoint), + slots=Slots}, + override_type(Ctx, Reg, Vst); + _ -> + error({illegal_save, SavePoint}) end. bsm_restore(Reg, {atom,start}, Vst) -> %% (Mostly) automatic save point refering to where the match started. %% It is always valid. But don't forget to validate the context register. - bsm_validate_context(Reg, Vst), + assert_type(#t_bs_context{}, Reg, Vst), Vst; bsm_restore(Reg, SavePoint, Vst) -> - case bsm_get_context(Reg, Vst) of - #ms{valid=Bits,slots=Slots} when SavePoint < Slots -> - case Bits band (1 bsl SavePoint) of - 0 -> error({illegal_restore,SavePoint,not_set}); - _ -> Vst - end; - _ -> error({illegal_restore,SavePoint,range}) + case get_movable_term_type(Reg, Vst) of + #t_bs_context{valid=Bits,slots=Slots} when SavePoint < Slots -> + case Bits band (1 bsl SavePoint) of + 0 -> error({illegal_restore, SavePoint, not_set}); + _ -> Vst + end; + _ -> + error({illegal_restore, SavePoint, range}) end. validate_select_val(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> @@ -1569,7 +1599,7 @@ validate_select_val(Fail, [Val,{f,L}|T], Src, Vst0) -> update_ne_types(Src, Val, FailVst) end), validate_select_val(Fail, T, Src, Vst); -validate_select_val(Fail, [], _, Vst) -> +validate_select_val(Fail, [], _Src, Vst) -> branch(Fail, Vst, fun(SuccVst) -> %% The next instruction is never executed. @@ -1581,7 +1611,7 @@ validate_select_tuple_arity(_Fail, _Choices, _Src, #vst{current=none}=Vst) -> %% can't reach the fail label or any of the remaining choices. Vst; validate_select_tuple_arity(Fail, [Arity,{f,L}|T], Tuple, Vst0) -> - Type = {tuple, Arity, #{}}, + Type = #t_tuple{exact=true,size=Arity}, Vst = branch(L, Vst0, fun(BranchVst) -> update_type(fun meet/2, Type, Tuple, BranchVst) @@ -1597,63 +1627,94 @@ validate_select_tuple_arity(Fail, [], _, #vst{}=Vst) -> kill_state(SuccVst) end). -infer_types({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> - infer_types(get_reg_vref(Reg, Vst), Vst); -infer_types(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> +%% +%% Infers types from comparisons, looking at the expressions that produced the +%% compared values and updates their types if we've learned something new from +%% the comparison. +%% + +infer_types(CompareOp, {Kind,_}=LHS, RHS, Vst) when Kind =:= x; Kind =:= y -> + infer_types(CompareOp, get_reg_vref(LHS, Vst), RHS, Vst); +infer_types(CompareOp, LHS, {Kind,_}=RHS, Vst) when Kind =:= x; Kind =:= y -> + infer_types(CompareOp, LHS, get_reg_vref(RHS, Vst), Vst); +infer_types(CompareOp, LHS, RHS, #vst{current=#st{vs=Vs}}=Vst0) -> case Vs of - #{ Ref := Entry } -> infer_types_1(Entry); - #{} -> fun(_, S) -> S end + #{ LHS := LEntry, RHS := REntry } -> + Vst = infer_types_1(LEntry, RHS, CompareOp, Vst0), + infer_types_1(REntry, LHS, CompareOp, Vst); + #{ LHS := LEntry } -> + infer_types_1(LEntry, RHS, CompareOp, Vst0); + #{ RHS := REntry } -> + infer_types_1(REntry, LHS, CompareOp, Vst0); + #{} -> + Vst0 + end. + +infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_eq_types(LHS, RHS, Vst); + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_ne_types(LHS, RHS, Vst); + _ -> + Vst end; -infer_types(_, #vst{}) -> - fun(_, S) -> S end. - -infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) -> - fun({atom,true}, S) -> - %% Either side might contain something worth inferring, so we need - %% to check them both. - Infer_L = infer_types(RHS, S), - Infer_R = infer_types(LHS, S), - Infer_R(RHS, Infer_L(LHS, S)); - (_, S) -> S +infer_types_1(#value{op={bif,'=/='},args=[LHS,RHS]}, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_ne_types(LHS, RHS, Vst); + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_eq_types(LHS, RHS, Vst); + _ -> + Vst end; -infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) -> - fun(Val, S) -> - Type = {tuple,[Index], #{ Key => get_term_type(Val, S) }}, - update_type(fun meet/2, Type, Tuple, S) +infer_types_1(#value{op={bif,element},args=[{integer,Index},Tuple]}, + Val, Op, Vst) when Index >= 1 -> + ElementType = get_term_type(Val, Vst), + Es = beam_types:set_element_type(Index, ElementType, #{}), + Type = #t_tuple{size=Index,elements=Es}, + case Op of + eq_exact -> update_type(fun meet/2, Type, Tuple, Vst); + ne_exact -> update_type(fun subtract/2, Type, Tuple, Vst) end; -infer_types_1(#value{op={bif,is_atom},args=[Src]}) -> - infer_type_test_bif({atom,[]}, Src); -infer_types_1(#value{op={bif,is_boolean},args=[Src]}) -> - infer_type_test_bif(bool, Src); -infer_types_1(#value{op={bif,is_binary},args=[Src]}) -> - infer_type_test_bif(binary, Src); -infer_types_1(#value{op={bif,is_bitstring},args=[Src]}) -> - infer_type_test_bif(binary, Src); -infer_types_1(#value{op={bif,is_float},args=[Src]}) -> - infer_type_test_bif(float, Src); -infer_types_1(#value{op={bif,is_integer},args=[Src]}) -> - infer_type_test_bif({integer,{}}, Src); -infer_types_1(#value{op={bif,is_list},args=[Src]}) -> - infer_type_test_bif(list, Src); -infer_types_1(#value{op={bif,is_map},args=[Src]}) -> - infer_type_test_bif(map, Src); -infer_types_1(#value{op={bif,is_number},args=[Src]}) -> - infer_type_test_bif(number, Src); -infer_types_1(#value{op={bif,is_tuple},args=[Src]}) -> - infer_type_test_bif({tuple,[0],#{}}, Src); -infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) -> - fun({integer,Arity}, S) -> - update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S); - (_, S) -> S +infer_types_1(#value{op={bif,is_atom},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_atom{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_boolean},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(beam_types:make_boolean(), Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_binary},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_bitstring{unit=8}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_bitstring},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_bitstring{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_float},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(float, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_integer},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_integer{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_list},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(list, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_map},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_map{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_number},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(number, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,is_tuple},args=[Src]}, Val, Op, Vst) -> + infer_type_test_bif(#t_tuple{}, Src, Val, Op, Vst); +infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}, + {integer,Arity}, Op, Vst) -> + Type = #t_tuple{exact=true,size=Arity}, + case Op of + eq_exact -> update_type(fun meet/2, Type, Tuple, Vst); + ne_exact -> update_type(fun subtract/2, Type, Tuple, Vst) end; -infer_types_1(_) -> - fun(_, S) -> S end. - -infer_type_test_bif(Type, Src) -> - fun({atom,true}, S) -> - update_type(fun meet/2, Type, Src, S); - (_, S) -> - S +infer_types_1(_, _, _, Vst) -> + Vst. + +infer_type_test_bif(Type, Src, Val, Op, Vst) -> + case Val of + {atom, Bool} when Op =:= eq_exact, Bool; Op =:= ne_exact, not Bool -> + update_type(fun meet/2, Type, Src, Vst); + {atom, Bool} when Op =:= ne_exact, Bool; Op =:= eq_exact, not Bool -> + update_type(fun subtract/2, Type, Src, Vst); + _ -> + Vst end. %%% @@ -1764,43 +1825,58 @@ update_type(Merge, With, #value_ref{}=Ref, Vst) -> update_type(Merge, With, {Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y -> update_type(Merge, With, get_reg_vref(Reg, Vst), Vst); update_type(Merge, With, Literal, Vst) -> - assert_literal(Literal), %% Literals always retain their type, but we still need to bail on type %% conflicts. - case Merge(Literal, With) of - none -> throw({type_conflict, Literal, With}); + Type = get_literal_type(Literal), + case Merge(Type, With) of + none -> throw({type_conflict, Type, With}); _Type -> Vst end. -update_ne_types(LHS, RHS, Vst) -> +update_eq_types(LHS, RHS, Vst0) -> + LType = get_term_type(LHS, Vst0), + RType = get_term_type(RHS, Vst0), + + Vst1 = update_type(fun meet/2, RType, LHS, Vst0), + Vst = update_type(fun meet/2, LType, RHS, Vst1), + + infer_types(eq_exact, LHS, RHS, Vst). + +update_ne_types(LHS, RHS, Vst0) -> + Vst1 = update_ne_types_1(LHS, RHS, Vst0), + Vst = update_ne_types_1(RHS, LHS, Vst1), + + infer_types(ne_exact, LHS, RHS, Vst). + +update_ne_types_1(LHS, RHS, Vst0) -> %% While updating types on equality is fairly straightforward, inequality %% is a bit trickier since all we know is that the *value* of LHS differs %% from RHS, so we can't blindly subtract their types. %% - %% Consider `number =/= {integer,[]}`; all we know is that LHS isn't equal + %% Consider `number =/= #t_integer{}`; all we know is that LHS isn't equal %% to some *specific integer* of unknown value, and if we were to subtract - %% {integer,[]} we would erroneously infer that the new type is {float,[]}. + %% #t_integer{} we would erroneously infer that the new type is float. %% %% Therefore, we only subtract when we know that RHS has a specific value. - RType = get_term_type(RHS, Vst), - case is_literal(RType) of - true -> update_type(fun subtract/2, RType, LHS, Vst); - false -> Vst + RType = get_term_type(RHS, Vst0), + case beam_types:is_singleton_type(RType) of + true -> + Vst = update_type(fun subtract/2, RType, LHS, Vst0), + + %% If LHS has a specific value after subtraction we can infer types + %% as if we've made an exact match, which is much stronger than + %% ne_exact. + LType = get_term_type(LHS, Vst), + case beam_types:get_singleton_value(LType) of + {ok, Value} -> + infer_types(eq_exact, LHS, value_to_literal(Value), Vst); + error -> + Vst + end; + false -> + Vst0 end. -update_eq_types(LHS, RHS, Vst0) -> - %% Either side might contain something worth inferring, so we need - %% to check them both. - Infer_L = infer_types(RHS, Vst0), - Infer_R = infer_types(LHS, Vst0), - Vst1 = Infer_R(RHS, Infer_L(LHS, Vst0)), - - T1 = get_term_type(LHS, Vst1), - T2 = get_term_type(RHS, Vst1), - - Vst = update_type(fun meet/2, T2, LHS, Vst1), - update_type(fun meet/2, T1, RHS, Vst). - %% Helper functions for the above. assign_1(Src, Dst, Vst0) -> @@ -1851,16 +1927,9 @@ get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) -> end. set_type(Type, #value_ref{}=Ref, #vst{current=#st{vs=Vs0}=St}=Vst) -> - case Vs0 of - #{ Ref := #value{}=Entry } -> - Vs = Vs0#{ Ref => Entry#value{type=Type} }, - Vst#vst{current=St#st{vs=Vs}}; - #{} -> - %% Dead references may happen during type inference and are not an - %% error in and of themselves. If a problem were to arise from this - %% it'll explode elsewhere. - Vst - end. + #{ Ref := #value{}=Entry } = Vs0, + Vs = Vs0#{ Ref => Entry#value{type=Type} }, + Vst#vst{current=St#st{vs=Vs}}. new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> Ref = #value_ref{id=Counter}, @@ -1868,9 +1937,9 @@ new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) -> {Ref, Vst#vst{current=St#st{vs=Vs},ref_ctr=Counter+1}}. -kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) -> - Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}}, - {_, Fail} = get_tag_type(Reg, Vst), %Assertion. +kill_catch_tag(Reg, #vst{current=#st{ct=[Tag|Tags]}=St}=Vst0) -> + Vst = Vst0#vst{current=St#st{ct=Tags,fls=undefined}}, + Tag = get_tag_type(Reg, Vst), %Assertion. kill_tag(Reg, Vst). check_try_catch_tags(Type, {y,N}=Reg, Vst) -> @@ -1915,308 +1984,45 @@ is_literal({integer,I}) when is_integer(I) -> true; is_literal({literal,_L}) -> true; is_literal(_) -> false. -%% The possible types. -%% -%% First non-term types: -%% -%% initialized Only for Y registers. Means that the Y register -%% has been initialized with some valid term so that -%% it is safe to pass to the garbage collector. -%% NOT safe to use in any other way (will not crash the -%% emulator, but clearly points to a bug in the compiler). -%% -%% {catchtag,[Lbl]} A special term used within a catch. Must only be used -%% by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% {trytag,[Lbl]} A special term used within a try block. Must only be -%% used by the catch instructions; NOT safe to use in other -%% instructions. -%% -%% exception Can only be used as a type returned by -%% call_return_type/2 (which gives the type of the value -%% returned by a call). Thus 'exception' is never stored -%% as type descriptor for a register. -%% -%% #ms{} A match context for bit syntax matching. We do allow -%% it to moved/to from stack, but otherwise it must only -%% be accessed by bit syntax matching instructions. -%% -%% -%% Normal terms: -%% -%% term Any valid Erlang (but not of the special types above). -%% -%% binary Binary or bitstring. -%% -%% bool The atom 'true' or the atom 'false'. -%% -%% cons Cons cell: [_|_] -%% -%% nil Empty list: [] -%% -%% list List: [] or [_|_] -%% -%% {tuple,[Sz],Es} Tuple. An element has been accessed using -%% element/2 or setelement/3 so that it is known that -%% the type is a tuple of size at least Sz. Es is a map -%% containing known types by tuple index. -%% -%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen -%% so that it is known that the size is exactly Sz. -%% -%% {atom,[]} Atom. -%% {atom,Atom} -%% -%% {integer,[]} Integer. -%% {integer,Integer} -%% -%% {float,[]} Float. -%% {float,Float} -%% -%% number Integer or Float of unknown value -%% -%% map Map. -%% -%% none A conflict in types. There will be an exception at runtime. -%% - -%% join(Type1, Type2) -> Type -%% Return the most specific type possible. -join(Same, Same) -> - Same; -join(none, Other) -> - Other; -join(Other, none) -> - Other; -join({literal,_}=T1, T2) -> - join_literal(T1, T2); -join(T1, {literal,_}=T2) -> - join_literal(T2, T1); -join({tuple,Size,EsA}, {tuple,Size,EsB}) -> - Es = join_tuple_elements(tuple_sz(Size), EsA, EsB), - {tuple, Size, Es}; -join({tuple,A,EsA}, {tuple,B,EsB}) -> - Size = min(tuple_sz(A), tuple_sz(B)), - Es = join_tuple_elements(Size, EsA, EsB), - {tuple, [Size], Es}; -join({Type,A}, {Type,B}) - when Type =:= atom; Type =:= integer; Type =:= float -> - if A =:= B -> {Type,A}; - true -> {Type,[]} - end; -join({Type,_}, number) - when Type =:= integer; Type =:= float -> - number; -join(number, {Type,_}) - when Type =:= integer; Type =:= float -> - number; -join({integer,_}, {float,_}) -> - number; -join({float,_}, {integer,_}) -> - number; -join(bool, {atom,A}) -> - join_bool(A); -join({atom,A}, bool) -> - join_bool(A); -join({atom,A}, {atom,B}) when is_boolean(A), is_boolean(B) -> - bool; -join({atom,_}, {atom,_}) -> - {atom,[]}; -join(#ms{id=Id1,valid=B1,slots=Slots1}, - #ms{id=Id2,valid=B2,slots=Slots2}) -> - Id = if - Id1 =:= Id2 -> Id1; - true -> make_ref() - end, - #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)}; -join(T1, T2) when T1 =/= T2 -> - %% We've exhaused all other options, so the type must either be a list or - %% a 'term'. - join_list(T1, T2). - -join_tuple_elements(Limit, EsA, EsB) -> - Es0 = join_elements(EsA, EsB), - maps:filter(fun({integer,Index}, _Type) -> Index =< Limit end, Es0). - -join_elements(Es1, Es2) -> - Keys = if - map_size(Es1) =< map_size(Es2) -> maps:keys(Es1); - map_size(Es1) > map_size(Es2) -> maps:keys(Es2) - end, - join_elements_1(Keys, Es1, Es2, #{}). - -join_elements_1([Key | Keys], Es1, Es2, Acc0) -> - Type = case {Es1, Es2} of - {#{ Key := Same }, #{ Key := Same }} -> Same; - {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2); - {#{}, #{}} -> term - end, - Acc = set_element_type(Key, Type, Acc0), - join_elements_1(Keys, Es1, Es2, Acc); -join_elements_1([], _Es1, _Es2, Acc) -> - Acc. +%% `dialyzer` complains about the float and general literal cases never being +%% matched and I don't like suppressing warnings. Should they become possible +%% I'm sure `dialyzer` will warn about it. +value_to_literal([]) -> nil; +value_to_literal(A) when is_atom(A) -> {atom,A}; +value_to_literal(I) when is_integer(I) -> {integer,I}. -%% Joins types of literals; note that the left argument must either be a -%% literal or exactly equal to the second argument. -join_literal(Same, Same) -> - Same; -join_literal({literal,_}=Lit, T) -> - join_literal(T, get_literal_type(Lit)); -join_literal(T1, T2) -> - %% We're done extracting the types, try merging them again. - join(T1, T2). - -join_list(nil, cons) -> list; -join_list(nil, list) -> list; -join_list(cons, list) -> list; -join_list(T, nil) -> join_list(nil, T); -join_list(T, cons) -> join_list(cons, T); -join_list(_, _) -> - %% Not a list, so it must be a term. - term. - -join_bool([]) -> {atom,[]}; -join_bool(true) -> bool; -join_bool(false) -> bool; -join_bool(_) -> {atom,[]}. - -%% meet(Type1, Type2) -> Type -%% Return the meet of two types. The meet is a more specific type. -%% It will be 'none' if the types are in conflict. - -meet(Same, Same) -> - Same; -meet(term, Other) -> - Other; -meet(Other, term) -> - Other; -meet(#ms{}, binary) -> - #ms{}; -meet(binary, #ms{}) -> - #ms{}; -meet({literal,_}, {literal,_}) -> - none; -meet(T1, {literal,_}=T2) -> - meet(T2, T1); -meet({literal,_}=T1, T2) -> - case meet(get_literal_type(T1), T2) of - none -> none; - _ -> T1 - end; -meet(T1, T2) -> - case {erlang:min(T1, T2),erlang:max(T1, T2)} of - {{atom,_}=A,{atom,[]}} -> A; - {bool,{atom,B}=Atom} when is_boolean(B) -> Atom; - {bool,{atom,[]}} -> bool; - {cons,list} -> cons; - {{float,_}=T,{float,[]}} -> T; - {{integer,_}=T,{integer,[]}} -> T; - {list,nil} -> nil; - {number,{integer,_}=T} -> T; - {number,{float,_}=T} -> T; - {{tuple,Size1,Es1},{tuple,Size2,Es2}} -> - Es = meet_elements(Es1, Es2), - case {Size1,Size2,Es} of - {_, _, none} -> - none; - {[Sz1],[Sz2],_} -> - Sz = erlang:max(Sz1, Sz2), - assert_tuple_elements(Sz, Es), - {tuple,[Sz],Es}; - {Sz1,[Sz2],_} when Sz2 =< Sz1 -> - assert_tuple_elements(Sz1, Es), - {tuple,Sz1,Es}; - {Sz,Sz,_} -> - assert_tuple_elements(Sz, Es), - {tuple,Sz,Es}; - {_,_,_} -> - none - end; - {_,_} -> none +%% These are just wrappers around their equivalents in beam_types, which +%% handle the validator-specific #t_abstract{} type. +%% +%% The funny-looking abstract types produced here are intended to provoke +%% errors on actual use; they do no harm just lying around. + +normalize(#t_abstract{}=A) -> error({abstract_type, A}); +normalize(T) -> beam_types:normalize(T). + +join(Same, Same) -> Same; +join(#t_abstract{}=A, B) -> #t_abstract{kind={join, A, B}}; +join(A, #t_abstract{}=B) -> #t_abstract{kind={join, A, B}}; +join(A, B) -> beam_types:join(A, B). + +meet(Same, Same) -> Same; +meet(#t_abstract{}=A, B) -> #t_abstract{kind={meet, A, B}}; +meet(A, #t_abstract{}=B) -> #t_abstract{kind={meet, A, B}}; +meet(A, B) -> beam_types:meet(A, B). + +subtract(#t_abstract{}=A, B) -> #t_abstract{kind={subtract, A, B}}; +subtract(A, #t_abstract{}=B) -> #t_abstract{kind={subtract, A, B}}; +subtract(A, B) -> beam_types:subtract(A, B). + +assert_type(RequiredType, Term, Vst) -> + GivenType = get_movable_term_type(Term, Vst), + case meet(RequiredType, GivenType) of + GivenType -> + ok; + _RequiredType -> + error({bad_type,{needed,RequiredType},{actual,GivenType}}) end. -meet_elements(Es1, Es2) -> - Keys = maps:keys(Es1) ++ maps:keys(Es2), - meet_elements_1(Keys, Es1, Es2, #{}). - -meet_elements_1([Key | Keys], Es1, Es2, Acc) -> - case {Es1, Es2} of - {#{ Key := Type1 }, #{ Key := Type2 }} -> - case meet(Type1, Type2) of - none -> none; - Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type }) - end; - {#{ Key := Type1 }, _} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 }); - {_, #{ Key := Type2 }} -> - meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 }) - end; -meet_elements_1([], _Es1, _Es2, Acc) -> - Acc. - -%% No tuple elements may have an index above the known size. -assert_tuple_elements(Limit, Es) -> - true = maps:fold(fun({integer,Index}, _T, true) -> - Index =< Limit - end, true, Es). %Assertion. - -%% subtract(Type1, Type2) -> Type -%% Subtract Type2 from Type2. Example: -%% subtract(list, nil) -> cons - -subtract(Same, Same) -> none; -subtract(list, nil) -> cons; -subtract(list, cons) -> nil; -subtract(number, {integer,[]}) -> {float,[]}; -subtract(number, {float,[]}) -> {integer,[]}; -subtract(bool, {atom,false}) -> {atom, true}; -subtract(bool, {atom,true}) -> {atom, false}; -subtract(Type, _) -> Type. - -assert_type(WantedType, Term, Vst) -> - Type = get_term_type(Term, Vst), - assert_type(WantedType, Type). - -assert_type(Correct, Correct) -> ok; -assert_type(float, {float,_}) -> ok; -assert_type(tuple, {tuple,_,_}) -> ok; -assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; -assert_type({tuple_element,I}, {tuple,[Sz],_}) - when 1 =< I, I =< Sz -> - ok; -assert_type({tuple_element,I}, {tuple,Sz,_}) - when is_integer(Sz), 1 =< I, I =< Sz -> - ok; -assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> - ok; -assert_type(cons, {literal,[_|_]}) -> - ok; -assert_type(Needed, Actual) -> - error({bad_type,{needed,Needed},{actual,Actual}}). - -get_element_type(Key, Src, Vst) -> - get_element_type_1(Key, get_term_type(Src, Vst)). - -get_element_type_1({integer,_}=Key, {tuple,_Sz,Es}) -> - case Es of - #{ Key := Type } -> Type; - #{} -> term - end; -get_element_type_1(_Index, _Type) -> - term. - -set_element_type(_Key, none, Es) -> - Es; -set_element_type(Key, term, Es) -> - maps:remove(Key, Es); -set_element_type(Key, Type, Es) -> - Es#{ Key => Type }. - -get_tuple_size({integer,[]}) -> 0; -get_tuple_size({integer,Sz}) -> Sz; -get_tuple_size(_) -> 0. - validate_src(Ss, Vst) when is_list(Ss) -> _ = [assert_term(S, Vst) || S <- Ss], ok. @@ -2227,7 +2033,8 @@ validate_src(Ss, Vst) when is_list(Ss) -> get_term_type(Src, Vst) -> case get_movable_term_type(Src, Vst) of - #ms{} -> error({match_context,Src}); + #t_bs_context{} -> error({match_context,Src}); + #t_abstract{} -> error({abstract_term,Src}); Type -> Type end. @@ -2237,12 +2044,11 @@ get_term_type(Src, Vst) -> get_movable_term_type(Src, Vst) -> case get_raw_type(Src, Vst) of + #t_abstract{kind=unfinished_tuple=Kind} -> error({Kind,Src}); initialized -> error({unassigned,Src}); uninitialized -> error({uninitialized_reg,Src}); {catchtag,_} -> error({catchtag,Src}); {trytag,_} -> error({trytag,Src}); - tuple_in_progress -> error({tuple_in_progress,Src}); - {literal,_}=Lit -> get_literal_type(Lit); Type -> Type end. @@ -2284,30 +2090,18 @@ get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) -> get_raw_type(Src, #vst{}) -> get_literal_type(Src). -get_literal_type(nil=T) -> T; -get_literal_type({atom,A}=T) when is_atom(A) -> T; -get_literal_type({float,F}=T) when is_float(F) -> T; -get_literal_type({integer,I}=T) when is_integer(I) -> T; -get_literal_type({literal,[_|_]}) -> cons; -get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary; -get_literal_type({literal,Map}) when is_map(Map) -> map; -get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> glt_1(Tuple); -get_literal_type({literal,_}) -> term; -get_literal_type(T) -> error({not_literal,T}). - -glt_1([]) -> nil; -glt_1(A) when is_atom(A) -> {atom, A}; -glt_1(F) when is_float(F) -> {float, F}; -glt_1(I) when is_integer(I) -> {integer, I}; -glt_1(T) when is_tuple(T) -> - {Es,_} = foldl(fun(Val, {Es0, Index}) -> - Type = glt_1(Val), - Es = set_element_type({integer,Index}, Type, Es0), - {Es, Index + 1} - end, {#{}, 1}, tuple_to_list(T)), - {tuple, tuple_size(T), Es}; -glt_1(L) -> - {literal, L}. +get_literal_type(nil) -> + beam_types:make_type_from_value([]); +get_literal_type({atom,A}) when is_atom(A) -> + beam_types:make_type_from_value(A); +get_literal_type({float,F}) when is_float(F) -> + beam_types:make_type_from_value(F); +get_literal_type({integer,I}) when is_integer(I) -> + beam_types:make_type_from_value(I); +get_literal_type({literal,L}) -> + beam_types:make_type_from_value(L); +get_literal_type(T) -> + error({not_literal,T}). %%% %%% Branch tracking @@ -2325,10 +2119,12 @@ glt_1(L) -> SuccFun :: BranchFun) -> #vst{} when BranchFun :: fun((#vst{}) -> #vst{}). branch(Lbl, Vst0, FailFun, SuccFun) -> + validate_branch(Lbl, Vst0), #vst{current=St0} = Vst0, + try FailFun(Vst0) of Vst1 -> - Vst2 = branch_state(Lbl, Vst1), + Vst2 = fork_state(Lbl, Vst1), Vst = Vst2#vst{current=St0}, try SuccFun(Vst) of V -> V @@ -2346,6 +2142,24 @@ branch(Lbl, Vst0, FailFun, SuccFun) -> SuccFun(Vst0) end. +validate_branch(Lbl, #vst{current=#st{ct=Tags}}) -> + validate_branch_1(Lbl, Tags). + +validate_branch_1(Lbl, [{trytag, FailLbls} | Tags]) -> + %% 'try_case' assumes that an exception has been thrown, so a direct branch + %% will crash the emulator. + %% + %% (Jumping to a 'catch_end' is fine however as it will simply nop in the + %% absence of an exception.) + case ordsets:is_element(Lbl, FailLbls) of + true -> error({illegal_branch, try_handler, Lbl}); + false -> validate_branch_1(Lbl, Tags) + end; +validate_branch_1(Lbl, [_ | Tags]) -> + validate_branch_1(Lbl, Tags); +validate_branch_1(_Lbl, []) -> + ok. + %% A shorthand version of branch/4 for when the state is only altered on %% success. branch(Fail, Vst, SuccFun) -> @@ -2353,12 +2167,12 @@ branch(Fail, Vst, SuccFun) -> %% Directly branches off the state. This is an "internal" operation that should %% be used sparingly. -branch_state(0, #vst{}=Vst) -> +fork_state(0, #vst{}=Vst) -> %% If the instruction fails, the stack may be scanned looking for a catch %% tag. Therefore the Y registers must be initialized at this point. verify_y_init(Vst), Vst; -branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> +fork_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) -> case gb_trees:is_defined(L, B) of true -> {MergedSt, Counter} = merge_states(L, St, B, Counter0), @@ -2438,10 +2252,10 @@ merge_tags(uninitialized, _) -> uninitialized; merge_tags(_, uninitialized) -> uninitialized; -merge_tags({catchtag,T0}, {catchtag,T1}) -> - {catchtag, ordsets:from_list(T0 ++ T1)}; -merge_tags({trytag,T0}, {trytag,T1}) -> - {trytag, ordsets:from_list(T0 ++ T1)}; +merge_tags({trytag, LblsA}, {trytag, LblsB}) -> + {trytag, ordsets:union(LblsA, LblsB)}; +merge_tags({catchtag, LblsA}, {catchtag, LblsB}) -> + {catchtag, ordsets:union(LblsA, LblsB)}; merge_tags(_A, _B) -> %% All other combinations leave the register initialized. Errors arising %% from this will be caught later on. @@ -2512,13 +2326,14 @@ merge_stk(_, _) -> undecided. merge_ct(S, S) -> S; merge_ct(Ct0, Ct1) -> merge_ct_1(Ct0, Ct1). -merge_ct_1([C0|Ct0], [C1|Ct1]) -> - [ordsets:from_list(C0++C1)|merge_ct_1(Ct0, Ct1)]; -merge_ct_1([], []) -> []; -merge_ct_1(_, _) -> undecided. - -tuple_sz([Sz]) -> Sz; -tuple_sz(Sz) -> Sz. +merge_ct_1([], []) -> + []; +merge_ct_1([{trytag, LblsA} | CtA], [{trytag, LblsB} | CtB]) -> + [{trytag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)]; +merge_ct_1([{catchtag, LblsA} | CtA], [{catchtag, LblsB} | CtB]) -> + [{catchtag, ordsets:union(LblsA, LblsB)} | merge_ct_1(CtA, CtB)]; +merge_ct_1(_, _) -> + undecided. verify_y_init(#vst{current=#st{numy=NumY,ys=Ys}}=Vst) when is_integer(NumY) -> HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys), @@ -2661,319 +2476,46 @@ assert_not_fragile(Lit, #vst{}) -> ok. %%% -%%% Return/argument types of BIFs +%%% Return/argument types of calls and BIFs %%% -bif_return_type('-', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type('+', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type('*', Src, Vst) -> - arith_return_type(Src, Vst); -bif_return_type(abs, [Num], Vst) -> - case get_term_type(Num, Vst) of - {float,_}=T -> T; - {integer,_}=T -> T; - _ -> number - end; -bif_return_type(float, _, _) -> {float,[]}; -bif_return_type('/', _, _) -> {float,[]}; -%% Binary operations -bif_return_type('binary_part', [_,_], _) -> binary; -bif_return_type('binary_part', [_,_,_], _) -> binary; -bif_return_type('bit_size', [_], _) -> {integer,[]}; -bif_return_type('byte_size', [_], _) -> {integer,[]}; -%% Integer operations. -bif_return_type(ceil, [_], _) -> {integer,[]}; -bif_return_type('div', [_,_], _) -> {integer,[]}; -bif_return_type(floor, [_], _) -> {integer,[]}; -bif_return_type('rem', [_,_], _) -> {integer,[]}; -bif_return_type(length, [_], _) -> {integer,[]}; -bif_return_type(size, [_], _) -> {integer,[]}; -bif_return_type(trunc, [_], _) -> {integer,[]}; -bif_return_type(round, [_], _) -> {integer,[]}; -bif_return_type('band', [_,_], _) -> {integer,[]}; -bif_return_type('bor', [_,_], _) -> {integer,[]}; -bif_return_type('bxor', [_,_], _) -> {integer,[]}; -bif_return_type('bnot', [_], _) -> {integer,[]}; -bif_return_type('bsl', [_,_], _) -> {integer,[]}; -bif_return_type('bsr', [_,_], _) -> {integer,[]}; -%% Booleans. -bif_return_type('==', [_,_], _) -> bool; -bif_return_type('/=', [_,_], _) -> bool; -bif_return_type('=<', [_,_], _) -> bool; -bif_return_type('<', [_,_], _) -> bool; -bif_return_type('>=', [_,_], _) -> bool; -bif_return_type('>', [_,_], _) -> bool; -bif_return_type('=:=', [_,_], _) -> bool; -bif_return_type('=/=', [_,_], _) -> bool; -bif_return_type('not', [_], _) -> bool; -bif_return_type('and', [_,_], _) -> bool; -bif_return_type('or', [_,_], _) -> bool; -bif_return_type('xor', [_,_], _) -> bool; -bif_return_type(is_atom, [_], _) -> bool; -bif_return_type(is_boolean, [_], _) -> bool; -bif_return_type(is_binary, [_], _) -> bool; -bif_return_type(is_float, [_], _) -> bool; -bif_return_type(is_function, [_], _) -> bool; -bif_return_type(is_function, [_,_], _) -> bool; -bif_return_type(is_integer, [_], _) -> bool; -bif_return_type(is_list, [_], _) -> bool; -bif_return_type(is_map, [_], _) -> bool; -bif_return_type(is_number, [_], _) -> bool; -bif_return_type(is_pid, [_], _) -> bool; -bif_return_type(is_port, [_], _) -> bool; -bif_return_type(is_reference, [_], _) -> bool; -bif_return_type(is_tuple, [_], _) -> bool; -%% Misc. -bif_return_type(tuple_size, [_], _) -> {integer,[]}; -bif_return_type(map_size, [_], _) -> {integer,[]}; -bif_return_type(node, [], _) -> {atom,[]}; -bif_return_type(node, [_], _) -> {atom,[]}; -bif_return_type(hd, [_], _) -> term; -bif_return_type(tl, [_], _) -> term; -bif_return_type(get, [_], _) -> term; -bif_return_type(Bif, _, _) when is_atom(Bif) -> term. - -%% Generic -bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}]; -bif_arg_types(map_size, [_]) -> [map]; -bif_arg_types(is_map_key, [_,_]) -> [term, map]; -bif_arg_types(map_get, [_,_]) -> [term, map]; -bif_arg_types(length, [_]) -> [list]; -bif_arg_types(hd, [_]) -> [cons]; -bif_arg_types(tl, [_]) -> [cons]; -%% Boolean -bif_arg_types('not', [_]) -> [bool]; -bif_arg_types('and', [_,_]) -> [bool, bool]; -bif_arg_types('or', [_,_]) -> [bool, bool]; -bif_arg_types('xor', [_,_]) -> [bool, bool]; -%% Binary -bif_arg_types('binary_part', [_,_]) -> - PosLen = {tuple, 2, #{ {integer,1} => {integer,[]}, - {integer,2} => {integer,[]} }}, - [binary, PosLen]; -bif_arg_types('binary_part', [_,_,_]) -> - [binary, {integer,[]}, {integer,[]}]; -bif_arg_types('bit_size', [_]) -> [binary]; -bif_arg_types('byte_size', [_]) -> [binary]; -%% Numerical -bif_arg_types('-', [_]) -> [number]; -bif_arg_types('-', [_,_]) -> [number,number]; -bif_arg_types('+', [_]) -> [number]; -bif_arg_types('+', [_,_]) -> [number,number]; -bif_arg_types('*', [_,_]) -> [number, number]; -bif_arg_types('/', [_,_]) -> [number, number]; -bif_arg_types(abs, [_]) -> [number]; -bif_arg_types(ceil, [_]) -> [number]; -bif_arg_types(float, [_]) -> [number]; -bif_arg_types(floor, [_]) -> [number]; -bif_arg_types(trunc, [_]) -> [number]; -bif_arg_types(round, [_]) -> [number]; -%% Integer-specific -bif_arg_types('div', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('rem', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('band', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bor', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bxor', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bnot', [_]) -> [{integer,[]}]; -bif_arg_types('bsl', [_,_]) -> [{integer,[]}, {integer,[]}]; -bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}]; -%% Unsafe type tests that may fail if an argument doesn't have the right type. -bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}]; -bif_arg_types(_, Args) -> [term || _Arg <- Args]. - -is_bif_safe('/=', 2) -> true; -is_bif_safe('<', 2) -> true; -is_bif_safe('=/=', 2) -> true; -is_bif_safe('=:=', 2) -> true; -is_bif_safe('=<', 2) -> true; -is_bif_safe('==', 2) -> true; -is_bif_safe('>', 2) -> true; -is_bif_safe('>=', 2) -> true; -is_bif_safe(is_atom, 1) -> true; -is_bif_safe(is_boolean, 1) -> true; -is_bif_safe(is_binary, 1) -> true; -is_bif_safe(is_bitstring, 1) -> true; -is_bif_safe(is_float, 1) -> true; -is_bif_safe(is_function, 1) -> true; -is_bif_safe(is_integer, 1) -> true; -is_bif_safe(is_list, 1) -> true; -is_bif_safe(is_map, 1) -> true; -is_bif_safe(is_number, 1) -> true; -is_bif_safe(is_pid, 1) -> true; -is_bif_safe(is_port, 1) -> true; -is_bif_safe(is_reference, 1) -> true; -is_bif_safe(is_tuple, 1) -> true; -is_bif_safe(get, 1) -> true; -is_bif_safe(self, 0) -> true; -is_bif_safe(node, 0) -> true; -is_bif_safe(_, _) -> false. - -arith_return_type([A], Vst) -> - %% Unary '+' or '-'. - case get_term_type(A, Vst) of - {integer,_} -> {integer,[]}; - {float,_} -> {float,[]}; - _ -> number - end; -arith_return_type([A,B], Vst) -> - TypeA = get_term_type(A, Vst), - TypeB = get_term_type(B, Vst), - case {TypeA, TypeB} of - {{integer,_},{integer,_}} -> {integer,[]}; - {{float,_},_} -> {float,[]}; - {_,{float,_}} -> {float,[]}; - {_,_} -> number - end; -arith_return_type(_, _) -> number. - -%%% -%%% Return/argument types of calls -%%% - -call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst); -call_return_type(_, _) -> term. - -call_return_type_1(erlang, setelement, 3, Vst) -> - IndexType = get_term_type({x,0}, Vst), - TupleType = - case get_term_type({x,1}, Vst) of - {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit); - {tuple,_,_}=TT -> TT; - _ -> {tuple,[0],#{}} - end, - case IndexType of - {integer,I} when is_integer(I) -> - case meet({tuple,[I],#{}}, TupleType) of - {tuple, Sz, Es0} -> - ValueType = get_term_type({x,2}, Vst), - Es = set_element_type({integer,I}, ValueType, Es0), - {tuple, Sz, Es}; - none -> - TupleType - end; - _ -> - %% The index could point anywhere, so we must discard all element - %% information. - setelement(3, TupleType, #{}) - end; -call_return_type_1(erlang, '++', 2, Vst) -> - LType = get_term_type({x,0}, Vst), - RType = get_term_type({x,1}, Vst), - case LType =:= cons orelse RType =:= cons of - true -> - cons; - false -> - %% `[] ++ RHS` yields RHS, even if RHS is not a list - join(list, RType) - end; -call_return_type_1(erlang, '--', 2, _Vst) -> - list; -call_return_type_1(erlang, F, A, _) -> - erlang_mod_return_type(F, A); -call_return_type_1(lists, F, A, Vst) -> - lists_mod_return_type(F, A, Vst); -call_return_type_1(math, F, A, _) -> - math_mod_return_type(F, A); -call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> - term. - -erlang_mod_return_type(exit, 1) -> exception; -erlang_mod_return_type(throw, 1) -> exception; -erlang_mod_return_type(error, 1) -> exception; -erlang_mod_return_type(error, 2) -> exception; -erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -math_mod_return_type(cos, 1) -> {float,[]}; -math_mod_return_type(cosh, 1) -> {float,[]}; -math_mod_return_type(sin, 1) -> {float,[]}; -math_mod_return_type(sinh, 1) -> {float,[]}; -math_mod_return_type(tan, 1) -> {float,[]}; -math_mod_return_type(tanh, 1) -> {float,[]}; -math_mod_return_type(acos, 1) -> {float,[]}; -math_mod_return_type(acosh, 1) -> {float,[]}; -math_mod_return_type(asin, 1) -> {float,[]}; -math_mod_return_type(asinh, 1) -> {float,[]}; -math_mod_return_type(atan, 1) -> {float,[]}; -math_mod_return_type(atanh, 1) -> {float,[]}; -math_mod_return_type(erf, 1) -> {float,[]}; -math_mod_return_type(erfc, 1) -> {float,[]}; -math_mod_return_type(exp, 1) -> {float,[]}; -math_mod_return_type(log, 1) -> {float,[]}; -math_mod_return_type(log2, 1) -> {float,[]}; -math_mod_return_type(log10, 1) -> {float,[]}; -math_mod_return_type(sqrt, 1) -> {float,[]}; -math_mod_return_type(atan2, 2) -> {float,[]}; -math_mod_return_type(pow, 2) -> {float,[]}; -math_mod_return_type(ceil, 1) -> {float,[]}; -math_mod_return_type(floor, 1) -> {float,[]}; -math_mod_return_type(fmod, 2) -> {float,[]}; -math_mod_return_type(pi, 0) -> {float,[]}; -math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. - -lists_mod_return_type(all, 2, _Vst) -> - bool; -lists_mod_return_type(any, 2, _Vst) -> - bool; -lists_mod_return_type(keymember, 3, _Vst) -> - bool; -lists_mod_return_type(member, 2, _Vst) -> - bool; -lists_mod_return_type(prefix, 2, _Vst) -> - bool; -lists_mod_return_type(suffix, 2, _Vst) -> - bool; -lists_mod_return_type(dropwhile, 2, _Vst) -> - list; -lists_mod_return_type(duplicate, 2, _Vst) -> - list; -lists_mod_return_type(filter, 2, _Vst) -> - list; -lists_mod_return_type(flatten, 1, _Vst) -> - list; -lists_mod_return_type(map, 2, Vst) -> - same_length_type({x,1}, Vst); -lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> - ListType = same_length_type({x,2}, Vst), - {tuple,2,#{ {integer,1} => ListType} }; -lists_mod_return_type(partition, 2, _Vst) -> - two_tuple(list, list); -lists_mod_return_type(reverse, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(seq, 2, _Vst) -> - list; -lists_mod_return_type(sort, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(sort, 2, Vst) -> - same_length_type({x,1}, Vst); -lists_mod_return_type(splitwith, 2, _Vst) -> - two_tuple(list, list); -lists_mod_return_type(takewhile, 2, _Vst) -> - list; -lists_mod_return_type(unzip, 1, Vst) -> - ListType = same_length_type({x,0}, Vst), - two_tuple(ListType, ListType); -lists_mod_return_type(usort, 1, Vst) -> - same_length_type({x,0}, Vst); -lists_mod_return_type(zip, 2, _Vst) -> - list; -lists_mod_return_type(zipwith, 3, _Vst) -> - list; -lists_mod_return_type(_, _, _) -> - term. - -two_tuple(Type1, Type2) -> - {tuple,2,#{ {integer,1} => Type1, - {integer,2} => Type2 }}. - -same_length_type(Reg, Vst) -> - case get_term_type(Reg, Vst) of - {literal,[_|_]} -> cons; - cons -> cons; - nil -> nil; - _ -> list - end. +bif_types(Op, Ss, Vst) -> + Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss], + beam_call_types:types(erlang, Op, Args). + +call_types({extfunc,M,F,A}, A, Vst) -> + Args = get_call_args(A, Vst), + beam_call_types:types(M, F, Args); +call_types(_, A, Vst) -> + {any, get_call_args(A, Vst), false}. + +will_bif_succeed(fadd, [_,_], _Vst) -> + maybe; +will_bif_succeed(fdiv, [_,_], _Vst) -> + maybe; +will_bif_succeed(fmul, [_,_], _Vst) -> + maybe; +will_bif_succeed(fnegate, [_], _Vst) -> + maybe; +will_bif_succeed(fsub, [_,_], _Vst) -> + maybe; +will_bif_succeed(Op, Ss, Vst) -> + Args = [normalize(get_term_type(Arg, Vst)) || Arg <- Ss], + beam_call_types:will_succeed(erlang, Op, Args). + +will_call_succeed({extfunc,M,F,A}, Vst) -> + beam_call_types:will_succeed(M, F, get_call_args(A, Vst)); +will_call_succeed(_Call, _Vst) -> + maybe. + +get_call_args(Arity, Vst) -> + get_call_args_1(0, Arity, Vst). + +get_call_args_1(Arity, Arity, _) -> + []; +get_call_args_1(N, Arity, Vst) when N < Arity -> + ArgType = normalize(get_movable_term_type({x,N}, Vst)), + [ArgType | get_call_args_1(N + 1, Arity, Vst)]. check_limit({x,X}=Src) when is_integer(X) -> if diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl index f489baf238..84e488fc55 100644 --- a/lib/compiler/src/cerl_sets.erl +++ b/lib/compiler/src/cerl_sets.erl @@ -153,14 +153,21 @@ intersection1(S1, []) -> S1. Set1 :: set(Element), Set2 :: set(Element). -is_disjoint(S1, S2) when map_size(S1) < map_size(S2) -> - fold(fun (_, false) -> false; - (E, true) -> not is_element(E, S2) - end, true, S1); +is_disjoint(S1, S2) when map_size(S1) > map_size(S2) -> + is_disjoint_1(S1, maps:iterator(S2)); is_disjoint(S1, S2) -> - fold(fun (_, false) -> false; - (E, true) -> not is_element(E, S1) - end, true, S2). + is_disjoint_1(S2, maps:iterator(S1)). + +is_disjoint_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> false; + #{} -> is_disjoint_1(Set, NextIter) + end; + none -> + true + end. %% subtract(Set1, Set2) -> Set. %% Return all and only the elements of Set1 which are not also in @@ -180,8 +187,21 @@ subtract(S1, S2) -> Set1 :: set(Element), Set2 :: set(Element). +is_subset(S1, S2) when map_size(S1) > map_size(S2) -> + false; is_subset(S1, S2) -> - fold(fun (E, Sub) -> Sub andalso is_element(E, S2) end, true, S1). + is_subset_1(S2, maps:iterator(S1)). + +is_subset_1(Set, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Set of + #{K := _} -> is_subset_1(Set, NextIter); + #{} -> false + end; + none -> + true + end. %% fold(Fun, Accumulator, Set) -> Accumulator. %% Fold function Fun over all elements in Set and return Accumulator. @@ -193,8 +213,16 @@ is_subset(S1, S2) -> AccIn :: Acc, AccOut :: Acc. -fold(F, Init, D) -> - lists:foldl(fun(E,Acc) -> F(E,Acc) end,Init,maps:keys(D)). +fold(Fun, Init, Set) -> + fold_1(Fun, Init, maps:iterator(Set)). + +fold_1(Fun, Acc, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + fold_1(Fun, Fun(K,Acc), NextIter); + none -> + Acc + end. %% filter(Fun, Set) -> Set. %% Filter Set with Fun. @@ -203,5 +231,18 @@ fold(F, Init, D) -> Set1 :: set(Element), Set2 :: set(Element). -filter(F, D) -> - maps:filter(fun(K,_) -> F(K) end, D). +filter(Fun, Set) -> + maps:from_list(filter_1(Fun, maps:iterator(Set))). + +filter_1(Fun, Iter) -> + case maps:next(Iter) of + {K, _, NextIter} -> + case Fun(K) of + true -> + [{K,ok} | filter_1(Fun, NextIter)]; + false -> + filter_1(Fun, NextIter) + end; + none -> + [] + end. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 0325c714d0..21d67f5649 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -265,7 +265,10 @@ expand_opt(r19, Os) -> expand_opt(r20, Os) -> expand_opt_before_21(Os); expand_opt(r21, Os) -> - [no_put_tuple2 | expand_opt(no_bsm3, Os)]; + [no_shared_fun_wrappers, + no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)]; +expand_opt(r22, Os) -> + [no_shared_fun_wrappers, no_swap | Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; expand_opt(no_type_opt=O, Os) -> @@ -278,7 +281,8 @@ expand_opt(no_type_opt=O, Os) -> expand_opt(O, Os) -> [O|Os]. expand_opt_before_21(Os) -> - [no_put_tuple2, no_get_hd_tl, no_ssa_opt_record, + [no_shared_fun_wrappers, no_swap, + no_put_tuple2, no_get_hd_tl, no_ssa_opt_record, no_utf8_atoms | expand_opt(no_bsm3, Os)]. %% format_error(ErrorDescriptor) -> string() @@ -863,8 +867,6 @@ asm_passes() -> {unless,no_postopt, [{pass,beam_block}, {iff,dblk,{listing,"block"}}, - {unless,no_except,{pass,beam_except}}, - {iff,dexcept,{listing,"except"}}, {unless,no_jopt,{pass,beam_jump}}, {iff,djmp,{listing,"jump"}}, {unless,no_peep_opt,{pass,beam_peep}}, @@ -2096,9 +2098,9 @@ pre_load() -> L = [beam_a, beam_asm, beam_block, + beam_call_types, beam_clean, beam_dict, - beam_except, beam_flatten, beam_jump, beam_kernel_to_ssa, @@ -2115,6 +2117,7 @@ pre_load() -> beam_ssa_share, beam_ssa_type, beam_trim, + beam_types, beam_utils, beam_validator, beam_z, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index a086a3a8d3..092757ae65 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -24,10 +24,10 @@ beam_a, beam_asm, beam_block, + beam_call_types, beam_clean, beam_dict, beam_disasm, - beam_except, beam_flatten, beam_jump, beam_kernel_to_ssa, @@ -47,6 +47,7 @@ beam_ssa_share, beam_ssa_type, beam_trim, + beam_types, beam_utils, beam_validator, beam_z, diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 86590fad87..0a38d17857 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -596,3 +596,9 @@ BEAM_FORMAT_NUMBER=0 ## @spec bs_set_positon Ctx Pos ## @doc Sets the current position of Ctx to Pos 168: bs_set_position/2 + +# OTP 23 + +## @spec swap Register1 Register2 +## @doc Swaps the contents of two registers. +169: swap/2 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 4939a94a92..63c67639d4 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -99,10 +99,6 @@ t=#{} :: map(), %Types in_guard=false}). %In guard or not. --type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}. --type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. --type sub() :: #sub{}. - -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module(), [_]}. @@ -315,10 +311,10 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> %% Arg cannot be "values" here - only a single value %% make sense here. - case {Ctxt,is_safe_simple(Arg, Sub)} of + case {Ctxt,is_safe_simple(Arg)} of {effect,true} -> B1; {effect,false} -> - case is_safe_simple(B1, Sub) of + case is_safe_simple(B1) of true -> Arg; false -> Seq0#c_seq{arg=Arg,body=B1} end; @@ -442,7 +438,7 @@ expr(#c_catch{anno=Anno,body=B}, effect, Sub) -> expr(#c_catch{body=B0}=Catch, _, Sub) -> %% We can remove catch if the value is simple B1 = body(B0, value, Sub), - case is_safe_simple(B1, Sub) of + case is_safe_simple(B1) of true -> B1; false -> Catch#c_catch{body=B1} end; @@ -458,7 +454,7 @@ expr(#c_try{arg=E0,vars=[#c_var{name=X}],body=#c_var{name=X}, %% We can remove try/catch if the expression is an %% expression that cannot fail. - case is_safe_bool_expr(E2, Sub) orelse is_safe_simple(E2, Sub) of + case is_safe_bool_expr(E2) orelse is_safe_simple(E2) of true -> E2; false -> Try#c_try{arg=E2} end; @@ -472,7 +468,7 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) E1 = body(E0, value, Sub0), {Vs1,Sub1} = var_list(Vs0, Sub0), B1 = body(B0, value, Sub1), - case is_safe_simple(E1, Sub0) of + case is_safe_simple(E1) of true -> expr(#c_let{anno=A,vars=Vs1,arg=E1,body=B1}, value, Sub0); false -> @@ -602,20 +598,20 @@ is_literal_fun(_) -> false. %% Currently, we don't attempt to check binaries because they %% are difficult to check. -is_safe_simple(#c_var{}=Var, _) -> +is_safe_simple(#c_var{}=Var) -> not cerl:is_c_fname(Var); -is_safe_simple(#c_cons{hd=H,tl=T}, Sub) -> - is_safe_simple(H, Sub) andalso is_safe_simple(T, Sub); -is_safe_simple(#c_tuple{es=Es}, Sub) -> is_safe_simple_list(Es, Sub); -is_safe_simple(#c_literal{}, _) -> true; +is_safe_simple(#c_cons{hd=H,tl=T}) -> + is_safe_simple(H) andalso is_safe_simple(T); +is_safe_simple(#c_tuple{es=Es}) -> is_safe_simple_list(Es); +is_safe_simple(#c_literal{}) -> true; is_safe_simple(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name}, - args=Args}, Sub) when is_atom(Name) -> + args=Args}) when is_atom(Name) -> NumArgs = length(Args), case erl_internal:bool_op(Name, NumArgs) of true -> %% Boolean operators are safe if the arguments are boolean. - all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args); + all(fun is_bool_expr/1, Args); false -> %% We need a rather complicated test to ensure that %% we only allow safe calls that are allowed in a guard. @@ -624,9 +620,9 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang}, (erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs)) end; -is_safe_simple(_, _) -> false. +is_safe_simple(_) -> false. -is_safe_simple_list(Es, Sub) -> all(fun(E) -> is_safe_simple(E, Sub) end, Es). +is_safe_simple_list(Es) -> all(fun(E) -> is_safe_simple(E) end, Es). %% will_fail(Expr) -> true|false. %% Determine whether the expression will fail with an exception. @@ -853,7 +849,7 @@ useless_call(_, _) -> no. %% Anything that will not have any effect will be thrown away. make_effect_seq([H|T], Sub) -> - case is_safe_simple(H, Sub) of + case is_safe_simple(H) of true -> make_effect_seq(T, Sub); false -> #c_seq{arg=H,body=make_effect_seq(T, Sub)} end; @@ -959,138 +955,14 @@ fold_lit_args(Call, Module, Name, Args0) -> %% Attempt to evaluate some pure BIF calls with one or more %% non-literals arguments. %% -fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) -> - eval_is_boolean(Call, Arg, Sub); fold_non_lit_args(Call, erlang, length, [Arg], _) -> eval_length(Call, Arg); fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); -fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) -> - eval_is_function_1(Call, Arg1, Sub); -fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) -> - eval_is_function_2(Call, Arg1, Arg2, Sub); -fold_non_lit_args(Call, erlang, N, Args, Sub) -> - NumArgs = length(Args), - case erl_internal:comp_op(N, NumArgs) of - true -> - eval_rel_op(Call, N, Args, Sub); - false -> - case erl_internal:bool_op(N, NumArgs) of - true -> - eval_bool_op(Call, N, Args, Sub); - false -> - Call - end - end; fold_non_lit_args(Call, _, _, _, _) -> Call. -eval_is_function_1(Call, Arg1, Sub) -> - case get_type(Arg1, Sub) of - none -> Call; - {'fun',_} -> #c_literal{anno=cerl:get_ann(Call),val=true}; - _ -> #c_literal{anno=cerl:get_ann(Call),val=false} - end. - -eval_is_function_2(Call, Arg1, #c_literal{val=Arity}, Sub) - when is_integer(Arity), Arity > 0 -> - case get_type(Arg1, Sub) of - none -> Call; - {'fun',Arity} -> #c_literal{anno=cerl:get_ann(Call),val=true}; - _ -> #c_literal{anno=cerl:get_ann(Call),val=false} - end; -eval_is_function_2(Call, _Arg1, _Arg2, _Sub) -> Call. - -%% Evaluate a relational operation using type information. -eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) -> - Bool = erlang:Op(same, same), - #c_literal{anno=cerl:get_ann(Call),val=Bool}; -eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> - %% BoolVar =:= true ==> BoolVar - case is_boolean_type(Term, Sub) of - yes -> Term; - maybe -> Call; - no -> #c_literal{val=false} - end; -eval_rel_op(Call, '==', Ops, Sub) -> - case is_exact_eq_ok(Ops, Sub) of - true -> - Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, - Call#c_call{name=Name}; - false -> - Call - end; -eval_rel_op(Call, '/=', Ops, Sub) -> - case is_exact_eq_ok(Ops, Sub) of - true -> - Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, - Call#c_call{name=Name}; - false -> - Call - end; -eval_rel_op(Call, _, _, _) -> Call. - -is_exact_eq_ok([A,B]=L, Sub) -> - case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of - true -> true; - false -> is_exact_eq_ok_1(L) - end. - -is_exact_eq_ok_1([#c_literal{val=Lit}|_]) -> - is_non_numeric(Lit); -is_exact_eq_ok_1([_|T]) -> - is_exact_eq_ok_1(T); -is_exact_eq_ok_1([]) -> false. - -is_non_numeric([H|T]) -> - is_non_numeric(H) andalso is_non_numeric(T); -is_non_numeric(Tuple) when is_tuple(Tuple) -> - is_non_numeric_tuple(Tuple, tuple_size(Tuple)); -is_non_numeric(Map) when is_map(Map) -> - %% Note that 17.x and 18.x compare keys in different ways. - %% Be very conservative -- require that both keys and values - %% are non-numeric. - is_non_numeric(maps:to_list(Map)); -is_non_numeric(Num) when is_number(Num) -> - false; -is_non_numeric(_) -> true. - -is_non_numeric_tuple(Tuple, El) when El >= 1 -> - is_non_numeric(element(El, Tuple)) andalso - is_non_numeric_tuple(Tuple, El-1); -is_non_numeric_tuple(_Tuple, 0) -> true. - -%% Evaluate a bool op using type information. We KNOW that -%% there must be at least one non-literal argument (i.e. -%% there is no need to handle the case that all argments -%% are literal). - -eval_bool_op(Call, 'and', [#c_literal{val=true},Term], Sub) -> - eval_bool_op_1(Call, Term, Term, Sub); -eval_bool_op(Call, 'and', [Term,#c_literal{val=true}], Sub) -> - eval_bool_op_1(Call, Term, Term, Sub); -eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,Term], Sub) -> - eval_bool_op_1(Call, Res, Term, Sub); -eval_bool_op(Call, 'and', [Term,#c_literal{val=false}=Res], Sub) -> - eval_bool_op_1(Call, Res, Term, Sub); -eval_bool_op(Call, _, _, _) -> Call. - -eval_bool_op_1(Call, Res, Term, Sub) -> - case is_boolean_type(Term, Sub) of - yes -> Res; - no -> eval_failure(Call, badarg); - maybe -> Call - end. - -%% Evaluate is_boolean/1 using type information. -eval_is_boolean(Call, Term, Sub) -> - case is_boolean_type(Term, Sub) of - no -> #c_literal{val=false}; - yes -> #c_literal{val=true}; - maybe -> Call - end. - %% eval_length(Call, List) -> Val. %% Evaluates the length for the prefix of List which has a known %% shape. @@ -1804,7 +1676,7 @@ opt_bool_case_guard(#c_case{arg=#c_literal{}}=Case) -> %% Case; opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) -> - case is_safe_bool_expr(Arg, sub_new()) of + case is_safe_bool_expr(Arg) of false -> Case; true -> @@ -1945,7 +1817,7 @@ case_opt_arg(E0, Sub, Cs, LitExpr) -> {error,Cs}; false -> %% If possible, expand this variable to a previously - %% matched term. + %% constructed tuple E = case_expand_var(E0, Sub), case_opt_arg_1(E, Cs, LitExpr) end @@ -2004,13 +1876,8 @@ case_opt_compiler_generated(Core) -> case_expand_var(E, #sub{t=Tdb}) -> Key = cerl:var_name(E), case Tdb of - #{Key:=T} -> - case cerl:is_c_tuple(T) of - false -> E; - true -> T - end; - _ -> - E + #{Key:=T} -> T; + _ -> E end. %% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' @@ -2302,43 +2169,30 @@ is_simple_case_arg(_) -> false. %% Check whether the Core expression is guaranteed to return %% a boolean IF IT RETURNS AT ALL. %% -is_bool_expr(Core) -> - is_bool_expr(Core, sub_new()). -%% is_bool_expr(Core, Sub) -> true|false -%% Check whether the Core expression is guaranteed to return -%% a boolean IF IT RETURNS AT ALL. Uses type information -%% to be able to identify more expressions as booleans. -%% is_bool_expr(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=Name},args=Args}=Call, _) -> + name=#c_literal{val=Name},args=Args}=Call) -> NumArgs = length(Args), erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs) orelse erl_internal:bool_op(Name, NumArgs) orelse will_fail(Call); is_bool_expr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, - handler=#c_literal{val=false}}, Sub) -> - is_bool_expr(E, Sub); -is_bool_expr(#c_case{clauses=Cs}, Sub) -> - is_bool_expr_list(Cs, Sub); -is_bool_expr(#c_clause{body=B}, Sub) -> - is_bool_expr(B, Sub); -is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> - Sub = case is_bool_expr(Arg, Sub0) of - true -> update_types(V, [bool], Sub0); - false -> Sub0 - end, - is_bool_expr(B, Sub); -is_bool_expr(#c_let{body=B}, Sub) -> - %% Binding of multiple variables. - is_bool_expr(B, Sub); -is_bool_expr(C, Sub) -> - is_boolean_type(C, Sub) =:= yes. - -is_bool_expr_list([C|Cs], Sub) -> - is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub); -is_bool_expr_list([], _) -> true. + handler=#c_literal{val=false}}) -> + is_bool_expr(E); +is_bool_expr(#c_case{clauses=Cs}) -> + is_bool_expr_list(Cs); +is_bool_expr(#c_clause{body=B}) -> + is_bool_expr(B); +is_bool_expr(#c_let{body=B}) -> + is_bool_expr(B); +is_bool_expr(#c_literal{val=Val}) -> + is_boolean(Val); +is_bool_expr(_) -> false. + +is_bool_expr_list([C|Cs]) -> + is_bool_expr(C) andalso is_bool_expr_list(Cs); +is_bool_expr_list([]) -> true. %% is_safe_bool_expr(Core) -> true|false %% Check whether the Core expression ALWAYS returns a boolean @@ -2346,17 +2200,17 @@ is_bool_expr_list([], _) -> true. %% is suitable for a guard (no calls to non-guard BIFs, local %% functions, or is_record/2). %% -is_safe_bool_expr(Core, Sub) -> - is_safe_bool_expr_1(Core, Sub, cerl_sets:new()). +is_safe_bool_expr(Core) -> + is_safe_bool_expr_1(Core, cerl_sets:new()). is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_record}, args=[A,#c_literal{val=Tag},#c_literal{val=Size}]}, - Sub, _BoolVars) when is_atom(Tag), is_integer(Size) -> - is_safe_simple(A, Sub); + _BoolVars) when is_atom(Tag), is_integer(Size) -> + is_safe_simple(A); is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_record}}, - _Sub, _BoolVars) -> + _BoolVars) -> %% The is_record/2 BIF is NOT allowed in guards. %% The is_record/3 BIF where its second argument is not an atom or its third %% is not an integer is NOT allowed in guards. @@ -2368,49 +2222,49 @@ is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}, args=[A,#c_literal{val=Arity}]}, - Sub, _BoolVars) when is_integer(Arity), Arity >= 0 -> - is_safe_simple(A, Sub); + _BoolVars) when is_integer(Arity), Arity >= 0 -> + is_safe_simple(A); is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=is_function}}, - _Sub, _BoolVars) -> + _BoolVars) -> false; is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name},args=Args}, - Sub, BoolVars) -> + BoolVars) -> NumArgs = length(Args), case (erl_internal:comp_op(Name, NumArgs) orelse erl_internal:new_type_test(Name, NumArgs)) andalso - is_safe_simple_list(Args, Sub) of + is_safe_simple_list(Args) of true -> true; false -> %% Boolean operators are safe if all arguments are boolean. erl_internal:bool_op(Name, NumArgs) andalso - is_safe_bool_expr_list(Args, Sub, BoolVars) + is_safe_bool_expr_list(Args, BoolVars) end; -is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, Sub, BoolVars) -> - case is_safe_simple(Arg, Sub) of +is_safe_bool_expr_1(#c_let{vars=Vars,arg=Arg,body=B}, BoolVars) -> + case is_safe_simple(Arg) of true -> - case {is_safe_bool_expr_1(Arg, Sub, BoolVars),Vars} of + case {is_safe_bool_expr_1(Arg, BoolVars),Vars} of {true,[#c_var{name=V}]} -> - is_safe_bool_expr_1(B, Sub, cerl_sets:add_element(V, BoolVars)); + is_safe_bool_expr_1(B, cerl_sets:add_element(V, BoolVars)); {false,_} -> - is_safe_bool_expr_1(B, Sub, BoolVars) + is_safe_bool_expr_1(B, BoolVars) end; false -> false end; -is_safe_bool_expr_1(#c_literal{val=Val}, _Sub, _) -> +is_safe_bool_expr_1(#c_literal{val=Val}, _BoolVars) -> is_boolean(Val); -is_safe_bool_expr_1(#c_var{name=V}, _Sub, BoolVars) -> +is_safe_bool_expr_1(#c_var{name=V}, BoolVars) -> cerl_sets:is_element(V, BoolVars); -is_safe_bool_expr_1(_, _, _) -> false. +is_safe_bool_expr_1(_, _) -> false. -is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> - case is_safe_bool_expr_1(C, Sub, BoolVars) of - true -> is_safe_bool_expr_list(Cs, Sub, BoolVars); +is_safe_bool_expr_list([C|Cs], BoolVars) -> + case is_safe_bool_expr_1(C, BoolVars) of + true -> is_safe_bool_expr_list(Cs, BoolVars); false -> false end; -is_safe_bool_expr_list([], _, _) -> true. +is_safe_bool_expr_list([], _) -> true. %% simplify_let(Let, Sub) -> Expr | impossible %% If the argument part of an let contains a complex expression, such @@ -2785,7 +2639,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> %% with exported variables, but the return value is %% ignored). We can remove the first variable and the %% the first value returned from the 'let' argument. - Arg2 = remove_first_value(Arg1, Sub), + Arg2 = remove_first_value(Arg1), Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body}, post_opt_let(Let1, Sub); true -> @@ -2805,36 +2659,36 @@ post_opt_let(Let0, Sub) -> opt_build_stacktrace(Let1). -%% remove_first_value(Core0, Sub) -> Core. +%% remove_first_value(Core0) -> Core. %% Core0 is an expression that returns at least two values. %% Remove the first value returned from Core0. -remove_first_value(#c_values{es=[V|Vs]}, Sub) -> +remove_first_value(#c_values{es=[V|Vs]}) -> Values = core_lib:make_values(Vs), - case is_safe_simple(V, Sub) of + case is_safe_simple(V) of false -> #c_seq{arg=V,body=Values}; true -> Values end; -remove_first_value(#c_case{clauses=Cs0}=Core, Sub) -> - Cs = remove_first_value_cs(Cs0, Sub), +remove_first_value(#c_case{clauses=Cs0}=Core) -> + Cs = remove_first_value_cs(Cs0), Core#c_case{clauses=Cs}; -remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) -> - Cs = remove_first_value_cs(Cs0, Sub), - Act = remove_first_value(Act0, Sub), +remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core) -> + Cs = remove_first_value_cs(Cs0), + Act = remove_first_value(Act0), Core#c_receive{clauses=Cs,action=Act}; -remove_first_value(#c_let{body=B}=Core, Sub) -> - Core#c_let{body=remove_first_value(B, Sub)}; -remove_first_value(#c_seq{body=B}=Core, Sub) -> - Core#c_seq{body=remove_first_value(B, Sub)}; -remove_first_value(#c_primop{}=Core, _Sub) -> +remove_first_value(#c_let{body=B}=Core) -> + Core#c_let{body=remove_first_value(B)}; +remove_first_value(#c_seq{body=B}=Core) -> + Core#c_seq{body=remove_first_value(B)}; +remove_first_value(#c_primop{}=Core) -> Core; -remove_first_value(#c_call{}=Core, _Sub) -> +remove_first_value(#c_call{}=Core) -> Core. -remove_first_value_cs(Cs, Sub) -> - [C#c_clause{body=remove_first_value(B, Sub)} || +remove_first_value_cs(Cs) -> + [C#c_clause{body=remove_first_value(B)} || #c_clause{body=B}=C <- Cs]. %% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg' @@ -2962,54 +2816,6 @@ move_case_into_arg(Expr, _) -> Expr. %%% -%%% Retrieving information about types. -%%% - --spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'. - -get_type(#c_var{name=V}, #sub{t=Tdb}) -> - case Tdb of - #{V:=Type} -> Type; - _ -> none - end; -get_type(C, _) -> - case cerl:type(C) of - binary -> C; - map -> C; - _ -> - case cerl:is_data(C) of - true -> C; - false -> none - end - end. - --spec is_boolean_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_boolean_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> - maybe; - bool -> - yes; - C -> - B = cerl:is_c_atom(C) andalso - is_boolean(cerl:atom_val(C)), - yes_no(B) - end. - --spec is_int_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_int_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> maybe; - integer -> yes; - C -> yes_no(cerl:is_c_int(C)) - end. - -yes_no(true) -> yes; -yes_no(false) -> no. - -%%% %%% Update type information. %%% @@ -3020,70 +2826,14 @@ update_let_types(_Vs, _Arg, Sub) -> %% that returns multiple values. Sub. -update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) -> - Sub = update_types_from_expr(V, A, Sub0), +update_let_types_1([#c_var{name=V}|Vs], [A|As], Sub0) -> + Sub = update_types(V, A, Sub0), update_let_types_1(Vs, As, Sub); update_let_types_1([], [], Sub) -> Sub. -update_types_from_expr(V, Expr, Sub) -> - Type = extract_type(Expr, Sub), - update_types(V, [Type], Sub). - -extract_type(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=Name}, - args=Args}=Call, Sub) -> - case returns_integer(Name, Args) of - true -> integer; - false -> extract_type_1(Call, Sub) - end; -extract_type(Expr, Sub) -> - extract_type_1(Expr, Sub). - -extract_type_1(Expr, Sub) -> - case is_bool_expr(Expr, Sub) of - false -> Expr; - true -> bool - end. - -returns_integer('band', [_,_]) -> true; -returns_integer('bnot', [_]) -> true; -returns_integer('bor', [_,_]) -> true; -returns_integer('bxor', [_,_]) -> true; -returns_integer(bit_size, [_]) -> true; -returns_integer('bsl', [_,_]) -> true; -returns_integer('bsr', [_,_]) -> true; -returns_integer(byte_size, [_]) -> true; -returns_integer(ceil, [_]) -> true; -returns_integer('div', [_,_]) -> true; -returns_integer(floor, [_]) -> true; -returns_integer(length, [_]) -> true; -returns_integer('rem', [_,_]) -> true; -returns_integer('round', [_]) -> true; -returns_integer(size, [_]) -> true; -returns_integer(tuple_size, [_]) -> true; -returns_integer(trunc, [_]) -> true; -returns_integer(_, _) -> false. - -%% update_types(Expr, Pattern, Sub) -> Sub' -%% Update the type database. - --spec update_types(cerl:c_var(), [type_info()], sub()) -> sub(). - -update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) -> - Tdb = update_types_1(V, Pat, Tdb0), - Sub#sub{t=Tdb}. - -update_types_1(V, [#c_tuple{}=P], Types) -> - Types#{V=>P}; -update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> - Types#{V=>bool}; -update_types_1(V, [#c_fun{vars=Vars}], Types) -> - Types#{V=>{'fun',length(Vars)}}; -update_types_1(V, [#c_var{name={_,Arity}}], Types) -> - Types#{V=>{'fun',Arity}}; -update_types_1(V, [Type], Types) when is_atom(Type) -> - Types#{V=>Type}; -update_types_1(_, _, Types) -> Types. +update_types(V, #c_tuple{}=P, #sub{t=Tdb}=Sub) -> + Sub#sub{t=Tdb#{V=>P}}; +update_types(_, _, Sub) -> Sub. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, @@ -3099,10 +2849,6 @@ kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) -> false -> [Entry|kill_types2(V, Tdb)]; true -> kill_types2(V, Tdb) end; -kill_types2(V, [{_, {'fun',_}}=Entry|Tdb]) -> - [Entry|kill_types2(V, Tdb)]; -kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) -> - [Entry|kill_types2(V, Tdb)]; kill_types2(_, []) -> []. %% copy_type(DestVar, SrcVar, Tdb) -> Tdb' diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index e2b8787224..49fb66126f 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -81,13 +81,17 @@ -export([module/2,format_error/1]). --import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keyfind/3,partition/2,droplast/1,last/1,sort/1,reverse/1]). +-import(lists, [droplast/1,flatten/1,foldl/3,foldr/3, + map/2,mapfoldl/3,member/2, + keyfind/3,keyreplace/4, + last/1,partition/2,reverse/1, + splitwith/2,sort/1]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). -include("core_parse.hrl"). -include("v3_kernel.hrl"). +-define(EXPAND_MAX_SIZE_SEGMENT, 1024). %% These are not defined in v3_kernel.hrl. get_kanno(Kthing) -> element(2, Kthing). @@ -120,15 +124,19 @@ copy_anno(Kdst, Ksrc) -> funs=[], %Fun functions free=#{}, %Free variables ws=[] :: [warning()], %Warnings. - guard_refc=0}). %> 0 means in guard + guard_refc=0, %> 0 means in guard + no_shared_fun_wrappers=false :: boolean() + }). -spec module(cerl:c_module(), [compile:option()]) -> {'ok', #k_mdef{}, [warning()]}. -module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> +module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) -> Kas = attributes(As), Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), - St0 = #kern{}, + NoSharedFunWrappers = proplists:get_bool(no_shared_fun_wrappers, + Options), + St0 = #kern{no_shared_fun_wrappers=NoSharedFunWrappers}, {Kfs,St} = mapfoldl(fun function/2, St0, Fs), {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. @@ -716,16 +724,27 @@ gexpr_test_add(Ke, St0) -> %% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}. %% Convert a Core expression, flattening it at the same time. -expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> - %% A local in an expression. - %% For now, these are wrapped into a fun by reverse - %% eta-conversion, but really, there should be exactly one - %% such "lambda function" for each escaping local name, - %% instead of one for each occurrence as done now. +expr(#c_var{anno=A0,name={Name,Arity}}=Fname, Sub, St) -> Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || - V <- integers(1, Arity)], - Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, - expr(Fun, Sub, St); + V <- integers(1, Arity)], + case St#kern.no_shared_fun_wrappers of + false -> + %% Generate a (possibly shared) wrapper function for calling + %% this function. + Wrapper0 = ["-fun.",atom_to_list(Name),"/",integer_to_list(Arity),"-"], + Wrapper = list_to_atom(flatten(Wrapper0)), + Id = {id,{0,0,Wrapper}}, + A = keyreplace(id, 1, A0, Id), + Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, + expr(Fun, Sub, St); + true -> + %% For backward compatibility with OTP 22 and earlier, + %% use the pre-generated name for the fun wrapper. + %% There will be one wrapper function for each occurrence + %% of `fun F/A`. + Fun = #c_fun{anno=A0,vars=Vs,body=#c_apply{anno=A0,op=Fname,args=Vs}}, + expr(Fun, Sub, St) + end; expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; expr(#c_literal{anno=A,val=V}, _Sub, St) -> @@ -1152,7 +1171,7 @@ validate_bin_element_size(#k_int{val=V}) when V >= 0 -> ok; validate_bin_element_size(#k_atom{val=all}) -> ok; validate_bin_element_size(#k_atom{val=undefined}) -> ok; validate_bin_element_size(_) -> throw(bad_element_size). - + %% atomic_list([Cexpr], Sub, State) -> {[Kexpr],[PreKexpr],State}. atomic_list(Ces, Sub, St) -> @@ -1278,14 +1297,63 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], _ -> Isub0 end, {Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2), - {#k_bin_seg{anno=A,size=S, - unit=U0, - type=cerl:concrete(T), - flags=Fs0, - seg=E,next=Es}, - {Isub,Osub},St3}; + {build_bin_seg(A, S, U0, cerl:concrete(T), Fs0, E, Es),{Isub,Osub},St3}; pattern_bin_1([], Isub, Osub, St) -> {#k_bin_end{},{Isub,Osub},St}. +%% build_bin_seg(Anno, Size, Unit, Type, Flags, Seg, Next) -> #k_bin_seg{}. +%% This function normalizes literal integers with size > 8 and literal +%% utf8 segments into integers with size = 8 (and potentially an integer +%% with size less than 8 at the end). This is so further optimizations +%% have a normalized view of literal integers, allowing us to generate +%% more literals and group more clauses. Those integers may be "squeezed" +%% later into the largest integer possible. +%% +build_bin_seg(A, #k_int{val=Bits} = Sz, U, integer=Type, [unsigned,big]=Flags, #k_literal{val=Int}=Seg, Next) -> + Size = Bits * U, + case integer_fits_and_is_expandable(Int, Size) of + true -> build_bin_seg_integer_recur(A, Size, Int, Next); + false -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next} + end; +build_bin_seg(A, Sz, U, utf8=Type, [unsigned,big]=Flags, #k_literal{val=Utf8} = Seg, Next) -> + case utf8_fits(Utf8) of + {Int, Bits} -> build_bin_seg_integer_recur(A, Bits, Int, Next); + error -> #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next} + end; +build_bin_seg(A, Sz, U, Type, Flags, Seg, Next) -> + #k_bin_seg{anno=A,size=Sz,unit=U,type=Type,flags=Flags,seg=Seg,next=Next}. + +build_bin_seg_integer_recur(A, Bits, Val, Next) when Bits > 8 -> + NextBits = Bits - 8, + NextVal = Val band ((1 bsl NextBits) - 1), + Last = build_bin_seg_integer_recur(A, NextBits, NextVal, Next), + build_bin_seg_integer(A, 8, Val bsr NextBits, Last); + +build_bin_seg_integer_recur(A, Bits, Val, Next) -> + build_bin_seg_integer(A, Bits, Val, Next). + +build_bin_seg_integer(A, Bits, Val, Next) -> + Sz = #k_int{anno=A,val=Bits}, + Seg = #k_literal{anno=A,val=Val}, + #k_bin_seg{anno=A,size=Sz,unit=1,type=integer,flags=[unsigned,big],seg=Seg,next=Next}. + +integer_fits_and_is_expandable(Int, Size) when 0 < Size, Size =< ?EXPAND_MAX_SIZE_SEGMENT -> + case <<Int:Size>> of + <<Int:Size>> -> true; + _ -> false + end; +integer_fits_and_is_expandable(_Int, _Size) -> + false. + +utf8_fits(Utf8) -> + try + Bin = <<Utf8/utf8>>, + Bits = bit_size(Bin), + <<Int:Bits>> = Bin, + {Int, Bits} + catch + _:_ -> error + end. + %% pattern_list([Cexpr], Sub, State) -> {[Kexpr],Sub,State}. pattern_list(Ces, Sub, St) -> @@ -1535,7 +1603,7 @@ maybe_add_warning(Ke, MatchAnno, St) -> get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|T]) -> get_line(T); get_line([]) -> none. - + get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen @@ -1743,27 +1811,10 @@ do_combine_lit_pat(#k_tuple{anno=A,es=Es0}) -> do_combine_lit_pat(_) -> throw(not_possible). -combine_bin_segs(#k_bin_seg{size=Size0,unit=Unit,type=integer, - flags=[unsigned,big],seg=Seg,next=Next}) -> - #k_literal{val=Size1} = do_combine_lit_pat(Size0), - #k_literal{val=Int} = do_combine_lit_pat(Seg), - Size = Size1 * Unit, - if - 0 < Size, Size < 64 -> - Bin = <<Int:Size>>, - case Bin of - <<Int:Size>> -> - NextBin = combine_bin_segs(Next), - <<Bin/bits,NextBin/bits>>; - _ -> - %% The integer Int does not fit in the segment, - %% thus it will not match. - throw(not_possible) - end; - true -> - %% Avoid creating huge binary literals. - throw(not_possible) - end; +combine_bin_segs(#k_bin_seg{size=#k_int{val=8},unit=1,type=integer, + flags=[unsigned,big],seg=#k_literal{val=Int},next=Next}) + when is_integer(Int), 0 =< Int, Int =< 255 -> + <<Int,(combine_bin_segs(Next))/bits>>; combine_bin_segs(#k_bin_end{}) -> <<>>; combine_bin_segs(_) -> @@ -1833,11 +1884,10 @@ handle_bin_con_not_possible([]) -> []. select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, size=#k_int{val=Bits0}=Sz,unit=U, flags=Fl,seg=#k_literal{val=Val}, - next=N}|Ps]}=C|Cs0]) - when is_integer(Val) -> + next=N}|Ps]}=C|Cs0]) -> Bits = U * Bits0, if - Bits > 1024 -> throw(not_possible); %Expands the code too much. + Bits > ?EXPAND_MAX_SIZE_SEGMENT -> throw(not_possible); %Expands the code too much. true -> ok end, select_assert_match_possible(Bits, Val, Fl), @@ -1848,16 +1898,6 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, Cs = select_bin_int_1(Cs0, Bits, Fl, Val), [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}]; -select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=utf8, - flags=[unsigned,big]=Fl, - seg=#k_literal{val=Val0}, - next=N}|Ps]}=C|Cs0]) - when is_integer(Val0) -> - {Val,Bits} = select_utf8(Val0), - P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1, - flags=Fl,val=Val,next=N}, - Cs = select_bin_int_1(Cs0, Bits, Fl, Val), - [{k_bin_int,[C#iclause{pats=[P|Ps]}|Cs]}]; select_bin_int(_) -> throw(not_possible). select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer, @@ -1872,18 +1912,6 @@ select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N}, [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)]; -select_bin_int_1([#iclause{pats=[#k_bin_seg{anno=A,type=utf8, - flags=Fl, - seg=#k_literal{val=Val0}, - next=N}|Ps]}=C|Cs], - Bits, Fl, Val) when is_integer(Val0) -> - case select_utf8(Val0) of - {Val,Bits} -> ok; - {_,_} -> throw(not_possible) - end, - P = #k_bin_int{anno=A,size=#k_int{val=Bits},unit=1, - flags=[unsigned,big],val=Val,next=N}, - [C#iclause{pats=[P|Ps]}|select_bin_int_1(Cs, Bits, Fl, Val)]; select_bin_int_1([], _, _, _) -> []; select_bin_int_1(_, _, _, _) -> throw(not_possible). @@ -1909,17 +1937,6 @@ match_fun(Val) -> {match,Bs} end. -select_utf8(Val0) -> - try - Bin = <<Val0/utf8>>, - Size = bit_size(Bin), - <<Val:Size>> = Bin, - {Val,Size} - catch - error:_ -> - throw(not_possible) - end. - %% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}. %% At this point all the clauses have the same constructor, we must %% now separate them according to value. @@ -2039,7 +2056,8 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) -> {Match0,Vs,St1} = get_match(get_con(Cs0), St0), Match = sub_size_var(Match0, Cs0), {Cs1,St2} = new_clauses(Cs0, U, St1), - {B,St3} = match(Vs ++ Us, Cs1, Def, St2), + Cs2 = squeeze_clauses_by_bin_integer_count(Cs1, []), + {B,St3} = match(Vs ++ Us, Cs2, Def, St2), {#k_val_clause{anno=Anno,val=Match,body=B},St3}. sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) -> @@ -2109,6 +2127,102 @@ new_clauses(Cs0, U, St) -> end, Cs0), {Cs1,St}. +%% group and squeeze +%% The goal of those functions is to group subsequent integer k_bin_seg +%% literals by count so we can leverage bs_get_integer_16 whenever possible. +%% +%% The priority is to create large groups. So if we have three clauses matching +%% on 16-bits/16-bits/8-bits, we will first have a single 8-bits match for all +%% three clauses instead of clauses (one with 16 and another with 8). But note +%% the algorithm is recursive, so the remaining 8-bits for the first two clauses +%% will be grouped next. +%% +%% We also try to not create too large groups. If we have too many clauses, +%% it is preferrable to match on 8-bits, select a branch, then match on the +%% next 8-bits, rather than match on 16-bits which would force us to have +%% to select to many values at the same time, which would not be efficient. +%% +%% Another restriction is that we create groups only if the end of the +%% group is a variadic clause or the end of the binary. That's because +%% if we have 16-bits/16-bits/catch-all, breaking it into a 16-bits lookup +%% will make the catch-all more expensive. +%% +%% Clauses are grouped in reverse when squeezing and then flattened and +%% re-reversed at the end. +squeeze_clauses_by_bin_integer_count([Clause | Clauses], Acc) -> + case clause_count_bin_integer_segments(Clause) of + {literal, N} -> squeeze_clauses_by_bin_integer_count(Clauses, N, 1, [Clause], Acc); + _ -> squeeze_clauses_by_bin_integer_count(Clauses, [[Clause] | Acc]) + end; +squeeze_clauses_by_bin_integer_count(_, Acc) -> + flat_reverse(Acc, []). + +squeeze_clauses_by_bin_integer_count([], N, Count, GroupAcc, Acc) -> + Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count), + flat_reverse([Squeezed | Acc], []); +squeeze_clauses_by_bin_integer_count([#iclause{pats=[#k_bin_end{} | _]} = Clause], N, Count, GroupAcc, Acc) -> + Squeezed = squeeze_clauses(GroupAcc, fix_count_without_variadic_segment(N), Count), + flat_reverse([[Clause | Squeezed] | Acc], []); +squeeze_clauses_by_bin_integer_count([Clause | Clauses], N, Count, GroupAcc, Acc) -> + case clause_count_bin_integer_segments(Clause) of + {literal, NewN} -> + squeeze_clauses_by_bin_integer_count(Clauses, min(N, NewN), Count + 1, [Clause | GroupAcc], Acc); + + {variadic, NewN} when NewN =< N -> + Squeezed = squeeze_clauses(GroupAcc, NewN, Count), + squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | Squeezed] | Acc]); + + _ -> + squeeze_clauses_by_bin_integer_count(Clauses, [[Clause | GroupAcc] | Acc]) + end. + +clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | _]}) -> + count_bin_integer_segments(BinSeg, 0); +clause_count_bin_integer_segments(#iclause{pats=[#k_bin_seg{size=#k_int{val=Size},unit=Unit, + type=integer,flags=[unsigned,big], seg=#k_var{}} | _]}) + when ((Size * Unit) rem 8) =:= 0 -> + {variadic, (Size * Unit) div 8}; +clause_count_bin_integer_segments(_) -> + error. + +count_bin_integer_segments(#k_bin_seg{size=#k_int{val=8},unit=1,type=integer,flags=[unsigned,big], + seg=#k_literal{val=Int},next=Next}, Count) when is_integer(Int), 0 =< Int, Int =< 255 -> + count_bin_integer_segments(Next, Count + 1); +count_bin_integer_segments(_, Count) when Count > 0 -> + {literal, Count}; +count_bin_integer_segments(_, _Count) -> + error. + +%% Since 4 bytes in on 32-bits systems are bignums, we convert +%% anything more than 3 into 2 bytes lookup. The goal is to convert +%% any multi-clause segment into 2-byte lookups with a potential +%% 3 byte lookup at the end. +fix_count_without_variadic_segment(N) when N > 3 -> 2; +fix_count_without_variadic_segment(N) -> N. + +%% If we have more than 16 clauses, then it is better +%% to branch multiple times than getting a large integer. +%% We also abort if we have nothing to squeeze. +squeeze_clauses(Clauses, Size, Count) when Count >= 16; Size == 1 -> Clauses; +squeeze_clauses(Clauses, Size, _Count) -> squeeze_clauses(Clauses, Size). + +squeeze_clauses([#iclause{pats=[#k_bin_seg{seg=#k_literal{}} = BinSeg | Pats]} = Clause | Clauses], Size) -> + [Clause#iclause{pats=[squeeze_segments(BinSeg, 0, 0, Size) | Pats]} | + squeeze_clauses(Clauses, Size)]; +squeeze_clauses([], _Size) -> + []. + +squeeze_segments(#k_bin_seg{size=Sz, seg=#k_literal{val=Val}=Lit} = BinSeg, Acc, Size, 1) -> + BinSeg#k_bin_seg{size=Sz#k_int{val=Size + 8}, seg=Lit#k_literal{val=(Acc bsl 8) bor Val}}; +squeeze_segments(#k_bin_seg{seg=#k_literal{val=Val},next=Next}, Acc, Size, Count) -> + squeeze_segments(Next, (Acc bsl 8) bor Val, Size + 8, Count - 1). + +flat_reverse([Head | Tail], Acc) -> flat_reverse(Tail, flat_reverse_1(Head, Acc)); +flat_reverse([], Acc) -> Acc. + +flat_reverse_1([Head | Tail], Acc) -> flat_reverse_1(Tail, [Head | Acc]); +flat_reverse_1([], Acc) -> Acc. + %% build_guard([GuardClause]) -> GuardExpr. build_guard([]) -> fail; @@ -2446,8 +2560,21 @@ uexpr(Lit, {break,Rs0}, St0) -> {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, arg=Lit,ret=Rs},Used,St1}. -add_local_function(_, #kern{funs=ignore}=St) -> St; -add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}. +add_local_function(_, #kern{funs=ignore}=St) -> + St; +add_local_function(#k_fdef{func=Name,arity=Arity}=F, #kern{funs=Funs}=St) -> + case is_defined(Name, Arity, Funs) of + false -> + St#kern{funs=[F|Funs]}; + true -> + St + end. + +is_defined(Name, Arity, [#k_fdef{func=Name,arity=Arity}|_]) -> + true; +is_defined(Name, Arity, [#k_fdef{}|T]) -> + is_defined(Name, Arity, T); +is_defined(_, _, []) -> false. %% Make a #k_fdef{}, making sure that the body is always a #k_match{}. make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) -> diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 7be23fbb93..44cff40128 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -16,6 +16,7 @@ MODULES= \ beam_reorder_SUITE \ beam_ssa_SUITE \ beam_type_SUITE \ + beam_types_SUITE \ beam_utils_SUITE \ bif_SUITE \ bs_bincomp_SUITE \ @@ -236,6 +237,6 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(ERL_DUMMY_FILES) "$(RELSYSDIR)" rm $(ERL_DUMMY_FILES) chmod -R u+w "$(RELSYSDIR)" - @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + @tar cf - *_SUITE_data property_test | (cd "$(RELSYSDIR)"; tar xf -) release_docs_spec: diff --git a/lib/compiler/test/beam_ssa_SUITE.erl b/lib/compiler/test/beam_ssa_SUITE.erl index 3b510f3528..054f86731a 100644 --- a/lib/compiler/test/beam_ssa_SUITE.erl +++ b/lib/compiler/test/beam_ssa_SUITE.erl @@ -200,6 +200,8 @@ recv(_Config) -> %% tricky_recv_6/0 is a compile-time error. tricky_recv_6(), + recv_coverage(), + ok. sync_wait_mon({Pid, Ref}, Timeout) -> @@ -326,7 +328,7 @@ tricky_recv_5() -> end. %% When fixing tricky_recv_5, we introduced a compiler crash when the common -%% exit block was ?BADARG_BLOCK and floats were in the picture. +%% exit block was ?EXCEPTION_BLOCK and floats were in the picture. tricky_recv_6() -> RefA = make_ref(), RefB = make_ref(), @@ -337,6 +339,69 @@ tricky_recv_6() -> ok end. +recv_coverage() -> + self() ! 1, + a = recv_coverage_1(), + self() ! 2, + b = recv_coverage_1(), + + self() ! 1, + a = recv_coverage_2(), + self() ! 2, + b = recv_coverage_2(), + + ok. + +%% Similar to tricky_recv_5/0, but provides test coverage for the #b_switch{} +%% terminator. +recv_coverage_1() -> + receive + X=1 -> + %% Jump to common exit block through #b_switch{list=L} + case id(0) of + 0 -> a; + 1 -> b; + 2 -> c; + 3 -> d + end; + X=2 -> + %% Jump to common exit block through #b_switch{fail=F} + case id(42) of + 0 -> exit(quit); + 1 -> exit(quit); + 2 -> exit(quit); + 3 -> exit(quit); + _ -> b + end + end, + case X of + 1 -> a; + 2 -> b + end. + +%% Similar to recv_coverage_1/0, providing test coverage for #b_br{}. +recv_coverage_2() -> + receive + X=1 -> + A = id(1), + %% Jump to common exit block through #b_br{succ=S}. + if + A =:= 1 -> a; + true -> exit(quit) + end; + X=2 -> + A = id(2), + %% Jump to common exit block through #b_br{fail=F}. + if + A =:= 1 -> exit(quit); + true -> a + end + end, + case X of + 1 -> a; + 2 -> b + end. + maps(_Config) -> {'EXIT',{{badmatch,#{}},_}} = (catch maps_1(any)), ok. @@ -388,48 +453,8 @@ cover_ssa_dead(_Config) -> 40.0 = percentage(4.0, 10.0), 60.0 = percentage(6, 10), - %% Cover '=:=', followed by '=/='. - false = 'cover__=:=__=/='(41), - true = 'cover__=:=__=/='(42), - false = 'cover__=:=__=/='(43), - - %% Cover '<', followed by '=/='. - true = 'cover__<__=/='(41), - false = 'cover__<__=/='(42), - false = 'cover__<__=/='(43), - - %% Cover '=<', followed by '=/='. - true = 'cover__=<__=/='(41), - true = 'cover__=<__=/='(42), - false = 'cover__=<__=/='(43), - - %% Cover '>=', followed by '=/='. - false = 'cover__>=__=/='(41), - true = 'cover__>=__=/='(42), - true = 'cover__>=__=/='(43), - - %% Cover '>', followed by '=/='. - false = 'cover__>__=/='(41), - false = 'cover__>__=/='(42), - true = 'cover__>__=/='(43), - ok. -'cover__=:=__=/='(X) when X =:= 42 -> X =/= 43; -'cover__=:=__=/='(_) -> false. - -'cover__<__=/='(X) when X < 42 -> X =/= 42; -'cover__<__=/='(_) -> false. - -'cover__=<__=/='(X) when X =< 42 -> X =/= 43; -'cover__=<__=/='(_) -> false. - -'cover__>=__=/='(X) when X >= 42 -> X =/= 41; -'cover__>=__=/='(_) -> false. - -'cover__>__=/='(X) when X > 42 -> X =/= 42; -'cover__>__=/='(_) -> false. - format_str(Str, FormatData, IoList, EscChars) -> Escapable = FormatData =:= escapable, case id(Str) of diff --git a/lib/compiler/test/beam_types_SUITE.erl b/lib/compiler/test/beam_types_SUITE.erl new file mode 100644 index 0000000000..8e71a716cd --- /dev/null +++ b/lib/compiler/test/beam_types_SUITE.erl @@ -0,0 +1,124 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_types_SUITE). + +-include_lib("compiler/src/beam_types.hrl"). + +-export([all/0, suite/0, groups/0, + init_per_suite/1, end_per_suite/1]). + +-export([absorption/1, + associativity/1, + commutativity/1, + idempotence/1, + identity/1]). + +-export([binary_absorption/1, + integer_absorption/1, + integer_associativity/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,property_tests}, + binary_absorption, + integer_absorption, + integer_associativity]. + +groups() -> + [{property_tests,[parallel], + [absorption, + associativity, + commutativity, + idempotence, + identity]}]. + +init_per_suite(Config) -> + ct_property_test:init_per_suite(Config). + +end_per_suite(Config) -> + Config. + +absorption(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:absorption()). + true = ct_property_test:quickcheck(beam_types_prop:absorption(), Config). + +associativity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:associativity()). + true = ct_property_test:quickcheck(beam_types_prop:associativity(), Config). + +commutativity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:commutativity()). + true = ct_property_test:quickcheck(beam_types_prop:commutativity(), Config). + +idempotence(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:idempotence()). + true = ct_property_test:quickcheck(beam_types_prop:idempotence(), Config). + +identity(Config) when is_list(Config) -> + %% manual test: proper:quickcheck(beam_types_prop:identity()). + true = ct_property_test:quickcheck(beam_types_prop:identity(), Config). + +binary_absorption(Config) when is_list(Config) -> + %% These binaries should meet into {binary,12} as that's the best common + %% unit for both types. + A = #t_bitstring{unit=4}, + B = #t_bitstring{unit=6}, + + #t_bitstring{unit=12} = beam_types:meet(A, B), + #t_bitstring{unit=2} = beam_types:join(A, B), + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +integer_absorption(Config) when is_list(Config) -> + %% Integers that don't overlap at all should never meet. + A = #t_integer{elements={2,3}}, + B = #t_integer{elements={4,5}}, + + none = beam_types:meet(A, B), + #t_integer{elements={2,5}} = beam_types:join(A, B), + + A = beam_types:meet(A, beam_types:join(A, B)), + A = beam_types:join(A, beam_types:meet(A, B)), + + ok. + +integer_associativity(Config) when is_list(Config) -> + A = #t_integer{elements={3,5}}, + B = #t_integer{elements={4,6}}, + C = #t_integer{elements={5,5}}, + + %% a ∨ (b ∨ c) = (a ∨ b) ∨ c, + LHS_Join = beam_types:join(A, beam_types:join(B, C)), + RHS_Join = beam_types:join(beam_types:join(A, B), C), + #t_integer{elements={3,6}} = LHS_Join = RHS_Join, + + %% a ∧ (b ∧ c) = (a ∧ b) ∧ c. + LHS_Meet = beam_types:meet(A, beam_types:meet(B, C)), + RHS_Meet = beam_types:meet(beam_types:meet(A, B), C), + #t_integer{elements={5,5}} = LHS_Meet = RHS_Meet, + + ok. + diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 20f6cb2691..68b665fbc3 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -35,7 +35,8 @@ map_field_lists/1,cover_bin_opt/1, val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1, receive_stacked/1,aliased_types/1,type_conflict/1, - infer_on_eq/1,infer_dead_value/1]). + infer_on_eq/1,infer_dead_value/1,infer_on_ne/1, + branch_to_try_handler/1]). -include_lib("common_test/include/ct.hrl"). @@ -65,7 +66,8 @@ groups() -> map_field_lists,cover_bin_opt,val_dsetel, bad_tuples,bad_try_catch_nesting, receive_stacked,aliased_types,type_conflict, - infer_on_eq,infer_dead_value]}]. + infer_on_eq,infer_dead_value,infer_on_ne, + branch_to_try_handler]}]. init_per_suite(Config) -> test_lib:recompile(?MODULE), @@ -217,11 +219,11 @@ bad_catch_try(Config) when is_list(Config) -> {{catch_end,{x,9}}, 8,{invalid_tag_register,{x,9}}}}, {{bad_catch_try,bad_3,1}, - {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}}, + {{catch_end,{y,1}},9,{invalid_tag,{y,1},{t_atom,[kalle]}}}}, {{bad_catch_try,bad_4,1}, {{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}}, {{bad_catch_try,bad_5,1}, - {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}}, + {{try_case,{y,1}},12,{invalid_tag,{y,1},any}}}, {{bad_catch_try,bad_6,1}, {{move,{integer,1},{y,1}},7, {invalid_store,{y,1}}}}] = Errors, @@ -232,7 +234,7 @@ cons_guard(Config) when is_list(Config) -> [{{cons,foo,1}, {{get_list,{x,0},{x,1},{x,2}}, 5, - {bad_type,{needed,cons},{actual,term}}}}] = Errors, + {bad_type,{needed,cons},{actual,any}}}}] = Errors, ok. freg_range(Config) when is_list(Config) -> @@ -520,9 +522,9 @@ bad_tuples(Config) -> {{bad_tuples,long,2}, {{put,{atom,too_long}},8,not_building_a_tuple}}, {{bad_tuples,self_referential,1}, - {{put,{x,1}},7,{tuple_in_progress,{x,1}}}}, + {{put,{x,1}},7,{unfinished_tuple,{x,1}}}}, {{bad_tuples,short,1}, - {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors, + {{move,{x,1},{x,0}},7,{unfinished_tuple,{x,1}}}}] = Errors, ok. @@ -705,6 +707,25 @@ idv_1({_A, _B, _C, _D, _E, F, G}, idv_1(_A, _B) -> error. +%% ERL-998; type inference for select_val (#b_switch{}) was more clever than +%% that for is_ne_exact (#b_br{}), sometimes failing validation when the type +%% optimization pass acted on the former and the validator got the latter. + +-record(ion, {state}). + +infer_on_ne(Config) when is_list(Config) -> + #ion{state = closing} = ion_1(#ion{ state = id(open) }), + #ion{state = closing} = ion_close(#ion{ state = open }), + ok. + +ion_1(State = #ion{state = open}) -> ion_2(State); +ion_1(State = #ion{state = closing}) -> ion_2(State). + +ion_2(State = #ion{state = open}) -> ion_close(State); +ion_2(#ion{state = closing}) -> ok. + +ion_close(State = #ion{}) -> State#ion{state = closing}. + %% ERL-995: The first solution to ERIERL-348 was incomplete and caused %% validation to fail when living values depended on delayed type inference on %% "dead" values. @@ -722,6 +743,17 @@ idv_2(State) -> idv_called_once(_State) -> ok. +%% Direct jumps to try/catch handlers crash the emulator and must fail +%% validation. This is provoked by OTP-15945. + +branch_to_try_handler(Config) -> + Errors = do_val(branch_to_try_handler, Config), + [{{branch_to_try_handler,main,1}, + {{bif,tuple_size,{f,3},[{y,0}],{x,0}}, + 12, + {illegal_branch,try_handler,3}}}] = Errors, + ok. + %%%------------------------------------------------------------------------- transform_remove(Remove, Module) -> diff --git a/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S new file mode 100644 index 0000000000..6d43ec7b54 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/branch_to_try_handler.S @@ -0,0 +1,48 @@ +{module, branch_to_try_handler}. %% version = 0 + +{exports, [{main,1}]}. + +{attributes, []}. + +{labels, 11}. + +{function, main, 1, 2}. + {label,1}. + {line,[{location,"t.erl",4}]}. + {func_info,{atom,branch_to_try_handler},{atom,main},1}. + {label,2}. + {allocate,2,1}. + {move,{x,0},{y,0}}. + {'try',{y,1},{f,3}}. + {move,{atom,ignored},{x,0}}. + {line,[{location,"t.erl",6}]}. + {call,1,{f,6}}. + {'%',{type_info,{x,0},{t_atom,[ignored]}}}. + {line,[{location,"t.erl",7}]}. + %% + %% Fail directly to the try handler instead of throwing an exception; this + %% will crash the emulator. + %% + {bif,tuple_size,{f,3},[{y,0}],{x,0}}. + %% + {test,is_eq_exact,{f,4},[{x,0},{integer,1}]}. + {move,{atom,error},{x,0}}. + {try_end,{y,1}}. + {deallocate,2}. + return. + {label,3}. + {try_case,{y,1}}. + {move,{atom,ok},{x,0}}. + {deallocate,2}. + return. + {label,4}. + {line,[{location,"t.erl",7}]}. + {badmatch,{x,0}}. + +{function, id, 1, 6}. + {label,5}. + {line,[{location,"t.erl",13}]}. + {func_info,{atom,branch_to_try_handler},{atom,id},1}. + {label,6}. + {'%',{type_info,{x,0},{t_atom,[ignored]}}}. + return. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 145a50f4ad..0dc1d64eeb 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -24,7 +24,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - verify_highest_opcode/1, + verify_highest_opcode/1, expand_and_squeeze/1, size_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1, bin_tail/1,save_restore/1, partitioned_bs_match/1,function_clause/1, @@ -64,7 +64,7 @@ groups() -> [{p,[], [verify_highest_opcode, size_shadow,int_float,otp_5269,null_fields,wiger, - bin_tail,save_restore, + bin_tail,save_restore,expand_and_squeeze, partitioned_bs_match,function_clause,unit, shared_sub_bins,bin_and_float,dec_subidentifiers, skip_optional_tag,decode_integer,wfbm,degenerated_match,bs_sum, @@ -2021,3 +2021,161 @@ do_exceptions_after_match_failure(Other) -> ok. id(I) -> I. + +expand_and_squeeze(Config) when is_list(Config) -> + %% UTF8 literals are expanded and then squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<$á/utf8,_/binary>>"), + ?Q("<<$é/utf8,_/binary>>") + ]), + + %% Sized integers are expanded and then squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<0:32,_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>") + ]), + + %% Groups of 8 bits are squeezed into integer16 + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>") + ]), + + %% Groups of 8 bits with empty binary are also squeezed + [ + {test,bs_get_integer2,_,_,[_,{integer,16}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>"), + ?Q("<<>>") + ]), + + %% Groups of 8 bits with float lookup are not squeezed + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aaaa\",_/binary>>"), + ?Q("<<\"bbbb\",_/binary>>"), + ?Q("<<_/float>>") + ]), + + %% Groups of diverse bits go with minimum possible + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aa\",_/binary>>"), + ?Q("<<\"bb\",_/binary>>"), + ?Q("<<\"c\",_/binary>>") + ]), + + %% Groups of diverse bits go with minimum possible but are recursive... + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | RestDiverse + ] = binary_match_to_asm([ + ?Q("<<\"aaa\",_/binary>>"), + ?Q("<<\"abb\",_/binary>>"), + ?Q("<<\"c\",_/binary>>") + ]), + + %% so we still perform a 16 bits lookup for the remaining + true = lists:any(fun({test,bs_get_integer2,_,_,[_,{integer,16}|_],_}) -> true; + (_) -> false end, RestDiverse), + + %% Large match is kept as is if there is a sized match later + [ + {test,bs_get_integer2,_,_,[_,{integer,64}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<255,255,255,255,255,255,255,255>>"), + ?Q("<<_:64>>") + ]), + + %% Large match is kept as is with large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32,_:A>>"), + ?Q("<<0:32>>"), + ?Q("<<_:32>>") + ]), + + %% Large match is kept as is with large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32,_:A>>"), + ?Q("<<0,0,0,0>>"), + ?Q("<<_:32>>") + ]), + + %% Large match is kept as is with smaller but still large matches before and after + [ + {test,bs_get_integer2,_,_,[_,{integer,32}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<A:32, _:A>>"), + ?Q("<<0:64>>"), + ?Q("<<_:32>>") + ]), + + %% There is no squeezing for groups with more than 16 matches + [ + {test,bs_get_integer2,_,_,[_,{integer,8}|_],_} + | _ + ] = binary_match_to_asm([ + ?Q("<<\"aa\", _/binary>>"), + ?Q("<<\"bb\", _/binary>>"), + ?Q("<<\"cc\", _/binary>>"), + ?Q("<<\"dd\", _/binary>>"), + ?Q("<<\"ee\", _/binary>>"), + ?Q("<<\"ff\", _/binary>>"), + ?Q("<<\"gg\", _/binary>>"), + ?Q("<<\"hh\", _/binary>>"), + ?Q("<<\"ii\", _/binary>>"), + ?Q("<<\"jj\", _/binary>>"), + ?Q("<<\"kk\", _/binary>>"), + ?Q("<<\"ll\", _/binary>>"), + ?Q("<<\"mm\", _/binary>>"), + ?Q("<<\"nn\", _/binary>>"), + ?Q("<<\"oo\", _/binary>>"), + ?Q("<<\"pp\", _/binary>>") + ]), + + ok. + +binary_match_to_asm(Matches) -> + Clauses = [ + begin + Ann = element(2, Match), + {clause,Ann,[Match],[],[{integer,Ann,Return}]} + end || {Match,Return} <- lists:zip(Matches, lists:seq(1, length(Matches))) + ], + + Module = [ + {attribute,1,module,match_to_asm}, + {attribute,2,export,[{example,1}]}, + {function,3,example,1,Clauses} + ], + + {ok,match_to_asm,{match_to_asm,_Exports,_Attrs,Funs,_},_} = + compile:forms(Module, [return, to_asm]), + + [{function,example,1,2,AllInstructions}|_] = Funs, + [{label,_},{line,_},{func_info,_,_,_},{label,_},{'%',_}, + {test,bs_start_match3,_,_,_,_},{bs_get_position,_,_,_}|Instructions] = AllInstructions, + Instructions. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 53627b9d81..453debc0c1 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -378,7 +378,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> {dprecg, ".precodegen"}, {dcg, ".codegen"}, {dblk, ".block"}, - {dexcept, ".except"}, {djmp, ".jump"}, {dclean, ".clean"}, {dpeep, ".peep"}, @@ -1383,27 +1382,33 @@ env_compiler_options(_Config) -> bc_options(Config) -> DataDir = proplists:get_value(data_dir, Config), - L = [{101, small_float, [no_get_hd_tl,no_line_info]}, - {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + L = [{101, small_float, [no_shared_fun_wrappers, + no_get_hd_tl,no_line_info]}, + {103, big, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, no_line_info,no_stack_trimming]}, - {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]}, + {125, small_float, [no_shared_fun_wrappers,no_get_hd_tl, + no_line_info, + no_ssa_opt_float]}, - {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, + {132, small, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl,no_ssa_opt_record, no_ssa_opt_float,no_line_info,no_bsm3]}, + {136, big, [no_shared_fun_wrappers,no_put_tuple2,no_get_hd_tl, + no_ssa_opt_record,no_line_info]}, + {153, small, [r20]}, {153, small, [r21]}, - {136, big, [no_put_tuple2,no_get_hd_tl, - no_ssa_opt_record,no_line_info]}, - - {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, + {153, big, [no_shared_fun_wrappers, + no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]}, {153, big, [r16]}, {153, big, [r17]}, {153, big, [r18]}, {153, big, [r19]}, {153, small_float, [r16]}, - {153, small_float, []}, + {153, small_float, [no_shared_fun_wrappers]}, {158, small_maps, [r17]}, {158, small_maps, [r18]}, @@ -1411,8 +1416,17 @@ bc_options(Config) -> {158, small_maps, [r20]}, {158, small_maps, [r21]}, - {164, small_maps, []}, - {164, big, []} + {164, small_maps, [r22]}, + {164, big, [r22]}, + {164, small_maps, [no_shared_fun_wrappers]}, + {164, big, [no_shared_fun_wrappers]}, + + {168, small, [r22]}, + {168, small, [no_shared_fun_wrappers]}, + + {169, small_maps, []}, + {169, big, []}, + {169, small, []} ], Test = fun({Expected,Mod,Options}) -> diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index cea7a374cd..d3d62b53f5 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -19,7 +19,7 @@ %% -module(guard_SUITE). --include_lib("common_test/include/ct.hrl"). +-include_lib("syntax_tools/include/merl.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -31,7 +31,8 @@ old_guard_tests/1,complex_guard/1, build_in_guard/1,gbif/1, t_is_boolean/1,is_function_2/1, - tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, + tricky/1,rel_ops/1,rel_op_combinations/1, + generated_combinations/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1,bad_guards/1, @@ -51,7 +52,7 @@ groups() -> more_xor_guards,build_in_guard, old_guard_tests,complex_guard,gbif, t_is_boolean,is_function_2,tricky, - rel_ops,rel_op_combinations, + rel_ops,rel_op_combinations,generated_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE, @@ -1579,6 +1580,122 @@ redundant_12(X) when X >= 50, X =< 80 -> 2*X; redundant_12(X) when X < 51 -> 5*X; redundant_12(_) -> none. +generated_combinations(Config) -> + case ?MODULE of + guard_SUITE -> generated_combinations_1(Config); + _ -> {skip,"Enough to run this case once."} + end. + +%% Exhaustively test all combinations of relational operators +%% to ensure the correctness of the optimizations in beam_ssa_dead. + +generated_combinations_1(Config) -> + Mod = ?FUNCTION_NAME, + RelOps = ['=:=','=/=','==','/=','<','=<','>=','>'], + Combinations0 = [{Op1,Op2} || Op1 <- RelOps, Op2 <- RelOps], + Combinations1 = gen_lit_combs(Combinations0), + Combinations2 = [{neq,Comb} || + {_Op1,_Lit1,Op2,_Lit2}=Comb <- Combinations1, + Op2 =:= '=/=' orelse Op2 =:= '/='] ++ Combinations1, + Combinations = gen_func_names(Combinations2, 0), + Fs = gen_rel_op_functions(Combinations), + Tree = ?Q(["-module('@Mod@').", + "-compile([export_all,nowarn_export_all])."]) ++ Fs, + %%merl:print(Tree), + Opts = test_lib:opt_opts(?MODULE), + {ok,_Bin} = merl:compile_and_load(Tree, Opts), + test_combinations(Combinations, Mod). + +gen_lit_combs([{Op1,Op2}|T]) -> + [{Op1,7,Op2,6}, + {Op1,7.0,Op2,6}, + {Op1,7,Op2,6.0}, + {Op1,7.0,Op2,6.0}, + + {Op1,7,Op2,7}, + {Op1,7.0,Op2,7}, + {Op1,7,Op2,7.0}, + {Op1,7.0,Op2,7.0}, + + {Op1,6,Op2,7}, + {Op1,6.0,Op2,7}, + {Op1,6,Op2,7.0}, + {Op1,6.0,Op2,7.0}|gen_lit_combs(T)]; +gen_lit_combs([]) -> []. + +gen_func_names([E|Es], I) -> + Name = list_to_atom("f" ++ integer_to_list(I)), + [{Name,E}|gen_func_names(Es, I+1)]; +gen_func_names([], _) -> []. + +gen_rel_op_functions([{Name,{neq,{Op1,Lit1,Op2,Lit2}}}|T]) -> + %% Note that in the translation to SSA, '=/=' will be + %% translated to '=:=' in a guard (with switched success + %% and failure labels). Therefore, to test the optimization, + %% we must use '=/=' (or '/=') in a body context. + %% + %% Here is an example of a generated function: + %% + %% f160(A) when erlang:'>='(A, 7) -> + %% one; + %% f160(A) -> + %% true = erlang:'/='(A, 7), + %% two. + [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one; + '@Name@'(A) -> true = erlang:'@Op2@'(A, _@Lit2@), two. ")| + gen_rel_op_functions(T)]; +gen_rel_op_functions([{Name,{Op1,Lit1,Op2,Lit2}}|T]) -> + %% Example of a generated function: + %% + %% f721(A) when erlang:'=<'(A, 7.0) -> one; + %% f721(A) when erlang:'<'(A, 6) -> two; + %% f721(_) -> three. + [?Q("'@Name@'(A) when erlang:'@Op1@'(A, _@Lit1@) -> one; + '@Name@'(A) when erlang:'@Op2@'(A, _@Lit2@) -> two; + '@Name@'(_) -> three.")|gen_rel_op_functions(T)]; +gen_rel_op_functions([]) -> []. + +test_combinations([{Name,E}|T], Mod) -> + try + test_combinations_1([5,6,7,8,9], E, fun Mod:Name/1), + test_combination(6.5, E, fun Mod:Name/1) + catch + error:Reason:Stk -> + io:format("~p: ~p\n", [Name,E]), + erlang:raise(error, Reason, Stk) + end, + test_combinations(T, Mod); +test_combinations([], _Mod) -> ok. + +test_combinations_1([V|Vs], E, Fun) -> + test_combination(V, E, Fun), + test_combination(float(V), E, Fun), + test_combinations_1(Vs, E, Fun); +test_combinations_1([], _, _) -> ok. + +test_combination(Val, {neq,Expr}, Fun) -> + Result = eval_combination_expr(Expr, Val), + Result = try + Fun(Val) %Returns 'one' or 'two'. + catch + error:{badmatch,_} -> + three + end; +test_combination(Val, Expr, Fun) -> + Result = eval_combination_expr(Expr, Val), + Result = Fun(Val). + +eval_combination_expr({Op1,Lit1,Op2,Lit2}, Val) -> + case erlang:Op1(Val, Lit1) of + true -> + one; + false -> + case erlang:Op2(Val, Lit2) of + true -> two; + false -> three + end + end. + %% Test type tests on literal values. (From emulator test suites.) literal_type_tests(Config) when is_list(Config) -> case ?MODULE of diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index a0b415ceaa..20fadc4fdb 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -227,15 +227,6 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_block:module(BlockInput, []) end), - %% beam_except - ExceptInput = {?MODULE,[{foo,0}],[], - [{function,foo,0,2, - [{label,1}, - {line,loc}, - {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list]}],99}, - expect_error(fun() -> beam_except:module(ExceptInput, []) end), - %% beam_jump JumpInput = BlockInput, expect_error(fun() -> beam_jump:module(JumpInput, []) end), @@ -283,14 +274,34 @@ silly_coverage(Config) when is_list(Config) -> bad_ssa_lint_input() -> {b_module,#{},t, - [{foobar,1},{module_info,0},{module_info,1}], + [{a,1},{b,1},{c,1},{module_info,0},{module_info,1}], [], [{b_function, - #{func_info => {t,foobar,1},location => {"t.erl",4}}, + #{func_info => {t,a,1},location => {"t.erl",4}}, [{b_var,0}], #{0 => {b_blk,#{},[],{b_ret,#{},{b_var,'@undefined_var'}}}}, 3}, {b_function, + #{func_info => {t,b,1},location => {"t.erl",5}}, + [{b_var,0}], + #{0 => + {b_blk,#{}, + [{b_set,#{},{b_var,'@first_var'},first_op,[]}, + {b_set,#{},{b_var,'@second_var'},second_op,[]}, + {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]}], + {b_ret,#{},{b_var,'@ret'}}}}, + 3}, + {b_function, + #{func_info => {t,c,1},location => {"t.erl",6}}, + [{b_var,0}], + #{0 => + {b_blk,#{}, + [{b_set,#{},{b_var,'@first_var'},first_op,[]}, + {b_set,#{},{b_var,'@ret'},succeeded,[{b_var,'@first_var'}]}, + {b_set,#{},{b_var,'@second_var'},second_op,[]}], + {b_ret,#{},{b_var,'@ret'}}}}, + 3}, + {b_function, #{func_info => {t,module_info,0}}, [], #{0 => diff --git a/lib/compiler/test/property_test/beam_types_prop.erl b/lib/compiler/test/property_test/beam_types_prop.erl new file mode 100644 index 0000000000..8199d1bd5a --- /dev/null +++ b/lib/compiler/test/property_test/beam_types_prop.erl @@ -0,0 +1,228 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2019. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_types_prop). + +-compile([export_all, nowarn_export_all]). + +%% This module only supports proper, as we don't have an eqc license to test +%% with. + +-proptest([proper]). + +-ifdef(PROPER). + +-include_lib("compiler/src/beam_types.hrl"). + +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +%% The default repetitions of 100 is a bit too low to reliably cover all type +%% combinations, so we crank it up a bit. +-define(REPETITIONS, 1000). + +absorption() -> + numtests(?REPETITIONS, absorption_1()). + +absorption_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + absorption_check(TypeA, TypeB)). + +absorption_check(A, B) -> + %% a ∨ (a ∧ b) = a, + A = join(A, meet(A, B)), + + %% a ∧ (a ∨ b) = a. + A = meet(A, join(A, B)), + + true. + +associativity() -> + numtests(?REPETITIONS, associativity_1()). + +associativity_1() -> + ?FORALL({TypeA, TypeB, TypeC}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), + ?LET(TypeC, type(), {TypeA, TypeB, TypeC}))), + associativity_check(TypeA, TypeB, TypeC)). + +associativity_check(A, B, C) -> + %% a ∨ (b ∨ c) = (a ∨ b) ∨ c, + LHS_Join = join(A, join(B, C)), + RHS_Join = join(join(A, B), C), + LHS_Join = RHS_Join, + + %% a ∧ (b ∧ c) = (a ∧ b) ∧ c. + LHS_Meet = meet(A, meet(B, C)), + RHS_Meet = meet(meet(A, B), C), + LHS_Meet = RHS_Meet, + + true. + +commutativity() -> + numtests(?REPETITIONS, commutativity_1()). + +commutativity_1() -> + ?FORALL({TypeA, TypeB}, + ?LET(TypeA, type(), + ?LET(TypeB, type(), {TypeA, TypeB})), + commutativity_check(TypeA, TypeB)). + +commutativity_check(A, B) -> + %% a ∨ b = b ∨ a, + true = join(A, B) =:= join(B, A), + + %% a ∧ b = b ∧ a. + true = meet(A, B) =:= meet(B, A), + + true. + +idempotence() -> + numtests(?REPETITIONS, idempotence_1()). + +idempotence_1() -> + ?FORALL(Type, type(), idempotence_check(Type)). + +idempotence_check(Type) -> + %% a ∨ a = a, + Type = join(Type, Type), + + %% a ∧ a = a. + Type = meet(Type, Type), + + true. + +identity() -> + ?FORALL(Type, type(), identity_check(Type)). + +identity_check(Type) -> + %% a ∨ [bottom element] = a, + Type = join(Type, none), + + %% a ∧ [top element] = a. + Type = meet(Type, any), + + true. + +meet(A, B) -> beam_types:meet(A, B). +join(A, B) -> beam_types:join(A, B). + +%%% +%%% Generators +%%% + +type() -> + type(0). + +type(Depth) -> + oneof(nested_types(Depth) ++ + numerical_types() ++ + list_types() ++ + other_types()). + +other_types() -> + [any, + gen_atom(), + gen_binary(), + none]. + +list_types() -> + [cons, list, nil]. + +numerical_types() -> + [gen_integer(), float, number]. + +nested_types(Depth) when Depth >= 3 -> [none]; +nested_types(Depth) -> [#t_map{}, gen_union(Depth + 1), gen_tuple(Depth + 1)]. + +gen_atom() -> + ?LET(Size, range(0, ?ATOM_SET_SIZE), + case Size of + 0 -> + #t_atom{}; + _ -> + ?LET(Set, sized_list(Size, gen_atom_val()), + begin + #t_atom{elements=ordsets:from_list(Set)} + end) + end). + +gen_atom_val() -> + ?LET(N, range($0, $~), list_to_atom([N])). + +gen_binary() -> + ?SHRINK(#t_bitstring{unit=range(1, 128)}, [#t_bitstring{unit=1}]). + +gen_integer() -> + oneof([gen_integer_bounded(), #t_integer{}]). + +gen_integer_bounded() -> + ?LET({A, B}, {integer(), integer()}, + begin + #t_integer{elements={min(A,B), max(A,B)}} + end). + +gen_tuple(Depth) -> + ?SIZED(Size, + ?LET({Exact, Elements}, {boolean(), gen_tuple_elements(Size, Depth)}, + begin + #t_tuple{exact=Exact, + size=Size, + elements=Elements} + end)). + +gen_union(Depth) -> + ?LAZY(oneof([gen_wide_union(Depth), gen_tuple_union(Depth)])). + +gen_wide_union(Depth) -> + ?LET({A, B, C, D}, {oneof(nested_types(Depth)), + oneof(numerical_types()), + oneof(list_types()), + oneof(other_types())}, + begin + T0 = join(A, B), + T1 = join(T0, C), + join(T1, D) + end). + +gen_tuple_union(Depth) -> + ?SIZED(Size, + ?LET(Tuples, sized_list(Size, gen_tuple(Depth)), + lists:foldl(fun join/2, none, Tuples))). + +gen_tuple_elements(Size, Depth) -> + ?LET(Types, sized_list(rand:uniform(Size div 4 + 1), gen_element(Depth)), + maps:from_list([{rand:uniform(Size), T} || T <- Types])). + +gen_element(Depth) -> + ?LAZY(?SUCHTHAT(Type, type(Depth), + case Type of + any -> false; + none -> false; + _ -> true + end)). + +sized_list(0, _Gen) -> []; +sized_list(N, Gen) -> [Gen | sized_list(N - 1, Gen)]. + +-endif. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 34410e4b2a..4b68e663cd 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -79,9 +79,11 @@ opt_opts(Mod) -> (no_put_tuple2) -> true; (no_recv_opt) -> true; (no_share_opt) -> true; + (no_shared_fun_wrappers) -> true; (no_ssa_float) -> true; (no_ssa_opt) -> true; (no_stack_trimming) -> true; + (no_swap) -> true; (no_type_opt) -> true; (_) -> false end, Opts). diff --git a/lib/crypto/Makefile b/lib/crypto/Makefile index afe56aa7d6..e5812bee15 100644 --- a/lib/crypto/Makefile +++ b/lib/crypto/Makefile @@ -38,3 +38,4 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c index bbeb329fa2..fc983ec03b 100644 --- a/lib/crypto/c_src/atoms.c +++ b/lib/crypto/c_src/atoms.c @@ -89,6 +89,8 @@ ERL_NIF_TERM atom_ecdsa; #ifdef HAVE_ED_CURVE_DH ERL_NIF_TERM atom_x25519; ERL_NIF_TERM atom_x448; +ERL_NIF_TERM atom_ed25519; +ERL_NIF_TERM atom_ed448; #endif ERL_NIF_TERM atom_eddsa; @@ -219,6 +221,8 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM #ifdef HAVE_ED_CURVE_DH atom_x25519 = enif_make_atom(env,"x25519"); atom_x448 = enif_make_atom(env,"x448"); + atom_ed25519 = enif_make_atom(env,"ed25519"); + atom_ed448 = enif_make_atom(env,"ed448"); #endif atom_eddsa = enif_make_atom(env,"eddsa"); #ifdef HAVE_EDDSA diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h index 0e2f1a0022..956aab93eb 100644 --- a/lib/crypto/c_src/atoms.h +++ b/lib/crypto/c_src/atoms.h @@ -93,6 +93,8 @@ extern ERL_NIF_TERM atom_ecdsa; #ifdef HAVE_ED_CURVE_DH extern ERL_NIF_TERM atom_x25519; extern ERL_NIF_TERM atom_x448; +extern ERL_NIF_TERM atom_ed25519; +extern ERL_NIF_TERM atom_ed448; #endif extern ERL_NIF_TERM atom_eddsa; diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 802818541b..2ea7b7c329 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -95,7 +95,7 @@ static ErlNifFunc nif_funcs[] = { {"dh_generate_key_nif", 4, dh_generate_key_nif, 0}, {"dh_compute_key_nif", 3, dh_compute_key_nif, 0}, {"evp_compute_key_nif", 3, evp_compute_key_nif, 0}, - {"evp_generate_key_nif", 1, evp_generate_key_nif, 0}, + {"evp_generate_key_nif", 2, evp_generate_key_nif, 0}, {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif, 0}, {"srp_value_B_nif", 5, srp_value_B_nif, 0}, {"srp_user_secret_nif", 7, srp_user_secret_nif, 0}, diff --git a/lib/crypto/c_src/evp.c b/lib/crypto/c_src/evp.c index 3bf66bfffe..fb6495a640 100644 --- a/lib/crypto/c_src/evp.c +++ b/lib/crypto/c_src/evp.c @@ -106,25 +106,34 @@ ERL_NIF_TERM evp_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a EVP_PKEY_CTX *ctx = NULL; EVP_PKEY *pkey = NULL; ERL_NIF_TERM ret_pub, ret_prv, ret; + ErlNifBinary prv_key; size_t key_len; unsigned char *out_pub = NULL, *out_priv = NULL; - ASSERT(argc == 1); - if (argv[0] == atom_x25519) type = EVP_PKEY_X25519; else if (argv[0] == atom_x448) type = EVP_PKEY_X448; + else if (argv[0] == atom_ed25519) + type = EVP_PKEY_ED25519; + else if (argv[0] == atom_ed448) + type = EVP_PKEY_ED448; else goto bad_arg; - if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL) - goto bad_arg; - - if (EVP_PKEY_keygen_init(ctx) != 1) - goto err; - if (EVP_PKEY_keygen(ctx, &pkey) != 1) - goto err; + if (argv[1] == atom_undefined) { + if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL) + goto bad_arg; + if (EVP_PKEY_keygen_init(ctx) != 1) + goto err; + if (EVP_PKEY_keygen(ctx, &pkey) != 1) + goto err; + } else { + if (!enif_inspect_binary(env, argv[1], &prv_key)) + goto bad_arg; + if ((pkey = EVP_PKEY_new_raw_private_key(type, NULL, prv_key.data, prv_key.size)) == NULL) + goto bad_arg; + } if (EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len) != 1) goto err; diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 965697578d..1c32895dbf 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -1761,21 +1761,21 @@ pkey_crypt_nif(_Algorithm, _In, _Key, _Options, _IsPrivate, _IsEncrypt) -> ?nif_ -spec generate_key(Type, Params) -> {PublicKey, PrivKeyOut} - when Type :: dh | ecdh | rsa | srp, + when Type :: dh | ecdh | eddsa | rsa | srp, PublicKey :: dh_public() | ecdh_public() | rsa_public() | srp_public(), PrivKeyOut :: dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()}, - Params :: dh_params() | ecdh_params() | rsa_params() | srp_gen_params() + Params :: dh_params() | ecdh_params() | eddsa_params() | rsa_params() | srp_gen_params() . generate_key(Type, Params) -> generate_key(Type, Params, undefined). -spec generate_key(Type, Params, PrivKeyIn) -> {PublicKey, PrivKeyOut} - when Type :: dh | ecdh | rsa | srp, + when Type :: dh | ecdh | eddsa | rsa | srp, PublicKey :: dh_public() | ecdh_public() | rsa_public() | srp_public(), PrivKeyIn :: undefined | dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()}, PrivKeyOut :: dh_private() | ecdh_private() | rsa_private() | {srp_public(),srp_private()}, - Params :: dh_params() | ecdh_params() | rsa_params() | srp_comp_params() + Params :: dh_params() | ecdh_params() | eddsa_params() | rsa_params() | srp_comp_params() . generate_key(dh, DHParameters0, PrivateKey) -> @@ -1813,15 +1813,17 @@ generate_key(rsa, {ModulusSize, PublicExponent}, undefined) -> {lists:sublist(Private, 2), Private} end; - -generate_key(ecdh, Curve, undefined) when Curve == x448 ; - Curve == x25519 -> - evp_generate_key_nif(Curve); +generate_key(ecdh, Curve, PrivKey) when Curve == x448 ; + Curve == x25519 -> + evp_generate_key_nif(Curve, ensure_int_as_bin(PrivKey)); generate_key(ecdh, Curve, PrivKey) -> - ec_key_generate(nif_curve_params(Curve), ensure_int_as_bin(PrivKey)). + ec_key_generate(nif_curve_params(Curve), ensure_int_as_bin(PrivKey)); +generate_key(eddsa, Curve, PrivKey) when Curve == ed448 ; + Curve == ed25519 -> + evp_generate_key_nif(Curve, ensure_int_as_bin(PrivKey)). -evp_generate_key_nif(_Curve) -> ?nif_stub. +evp_generate_key_nif(_Curve, _PrivKey) -> ?nif_stub. -spec compute_key(Type, OthersPublicKey, MyPrivateKey, Params) diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 0da70d5592..614d14029b 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -202,11 +202,13 @@ groups() -> {ecdsa, [], [sign_verify %% Does not work yet: ,public_encrypt, private_encrypt ]}, - {ed25519, [], [sign_verify + {ed25519, [], [sign_verify, %% Does not work yet: ,public_encrypt, private_encrypt + generate ]}, - {ed448, [], [sign_verify + {ed448, [], [sign_verify, %% Does not work yet: ,public_encrypt, private_encrypt + generate ]}, {dh, [], [generate_compute, compute_bug]}, {ecdh, [], [use_all_elliptic_curves, compute, generate]}, @@ -1429,7 +1431,7 @@ do_compute({ecdh = Type, Pub, Priv, Curve, SharedSecret}) -> ct:fail({{crypto, compute_key, [Type, Pub, Priv, Curve]}, {expected, SharedSecret}, {got, Other}}) end. -do_generate({ecdh = Type, Curve, Priv, Pub}) -> +do_generate({Type, Curve, Priv, Pub}) when Type == ecdh ; Type == eddsa -> case crypto:generate_key(Type, Curve, Priv) of {Pub, _} -> ok; @@ -1854,7 +1856,10 @@ group_config(ecdsa = Type, Config) -> [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; group_config(Type, Config) when Type == ed25519 ; Type == ed448 -> TestVectors = eddsa(Type), - [{sign_verify,TestVectors} | Config]; + Generate = lists:map(fun({Curve, _Hash, Priv, Pub, _Msg, _Signature}) -> + {eddsa, Curve, Priv, Pub} + end, TestVectors), + [{sign_verify,TestVectors}, {generate, Generate} | Config]; group_config(srp, Config) -> GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()], [{generate_compute, GenerateCompute} | Config]; @@ -3351,7 +3356,7 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv eddsa(ed25519) -> %% https://tools.ietf.org/html/rfc8032#section-7.1 - %% {ALGORITHM, (SHA)}, SECRET KEY, PUBLIC KEY, MESSAGE, SIGNATURE} + %% {ALGORITHM, (SHA), SECRET KEY, PUBLIC KEY, MESSAGE, SIGNATURE} [ %% TEST 1 {ed25519, undefined, @@ -3917,12 +3922,31 @@ ecc() -> "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, {ecdh,secp192r1,4, hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", - "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}], + "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}, + %% RFC 7748, 6.2 + {ecdh, x448, + hexstr2bin("9a8f4925d1519f5775cf46b04b5800d4ee9ee8bae8bc5565d498c28d" + "d9c9baf574a9419744897391006382a6f127ab1d9ac2d8c0a598726b"), + hexstr2bin("9b08f7cc31b7e3e67d22d5aea121074a273bd2b83de09c63faa73d2c" + "22c5d9bbc836647241d953d40c5b12da88120d53177f80e532c41fa0")}, + {ecdh, x448, + hexstr2bin("1c306a7ac2a0e2e0990b294470cba339e6453772b075811d8fad0d1d" + "6927c120bb5ee8972b0d3e21374c9c921b09d1b0366f10b65173992d"), + hexstr2bin("3eb7a829b0cd20f5bcfc0b599b6feccf6da4627107bdb0d4f345b430" + "27d8b972fc3e34fb4232a13ca706dcb57aec3dae07bdc1c67bf33609")}, + %% RFC 7748, 6.1 + {ecdh, x25519, + hexstr2bin("77076d0a7318a57d3c16c17251b26645df4c2f87ebc0992ab177fba51db92c2a"), + hexstr2bin("8520f0098930a754748b7ddcb43ef75a0dbf3a0d26381af4eba4a98eaa9b4e6a")}, + {ecdh, x25519, + hexstr2bin("5dab087e624a8a4b79e17f8b83800ee66f3bb1292618b6fd1c2f8b27ff88e0eb"), + hexstr2bin("de9edb7d7b7dc1b4d35b61c2ece435373f8343c85b78674dadfc7e146f882b4f")}], lists:filter(fun ({_Type, Curve, _Priv, _Pub}) -> lists:member(Curve, Curves) end, TestCases). + int_to_bin(X) when X < 0 -> int_to_bin_neg(X, []); int_to_bin(X) -> int_to_bin_pos(X, []). diff --git a/lib/debugger/Makefile b/lib/debugger/Makefile index 8c8b617831..3a06d72c5d 100644 --- a/lib/debugger/Makefile +++ b/lib/debugger/Makefile @@ -34,3 +34,7 @@ SPECIAL_TARGETS = # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk + +DIA_PLT_APPS=wx + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/dialyzer/Makefile b/lib/dialyzer/Makefile index e4f681dcd9..53083f267d 100644 --- a/lib/dialyzer/Makefile +++ b/lib/dialyzer/Makefile @@ -42,3 +42,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=compiler syntax_tools hipe wx + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/diameter/Makefile b/lib/diameter/Makefile index a0195a0988..a25baeb929 100644 --- a/lib/diameter/Makefile +++ b/lib/diameter/Makefile @@ -27,7 +27,6 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -info: - @echo "APP_VSN = $(APP_VSN)" +DIA_PLT_APPS=ssl runtime_tools syntax_tools -.PHONY: info +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/edoc/Makefile b/lib/edoc/Makefile index 70bf1f3d48..a8258015b1 100644 --- a/lib/edoc/Makefile +++ b/lib/edoc/Makefile @@ -69,7 +69,7 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info version +.PHONY: version version: @@ -92,9 +92,6 @@ edocs: -pa $(XMERL_DIR)/ebin -run edoc_run application \ "'$(APPNAME)'" '"."' '$(DOC_OPTS)' -info: - @echo $(HTML_FILES) - app_release: tar @@ -124,3 +121,7 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +DIA_PLT_APPS=syntax_tools xmerl inets + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/edoc/src/edoc.app.src b/lib/edoc/src/edoc.app.src index 43343e2ae8..834c0eb005 100644 --- a/lib/edoc/src/edoc.app.src +++ b/lib/edoc/src/edoc.app.src @@ -23,4 +23,4 @@ {applications, [compiler,kernel,stdlib,syntax_tools]}, {env, []}, {runtime_dependencies, ["xmerl-1.3.7","syntax_tools-1.6.14","stdlib-2.5", - "kernel-3.0","inets-5.10","erts-6.0"]}]}. + "kernel-3.0","erts-6.0"]}]}. diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 62483602aa..0fdc818fae 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -259,10 +259,9 @@ opt_negations() -> %% </dd> %% <dt>{@type {doc_path, [string()]@}} %% </dt> -%% <dd>Specifies a list of URI:s pointing to directories that contain -%% EDoc-generated documentation. URI without a `scheme://' part are -%% taken as relative to `file://'. (Note that such paths must use -%% `/' as separator, regardless of the host operating system.) +%% <dd>Specifies a list of file system paths pointing to directories that +%% contain EDoc-generated documentation. All paths for applications +%% in the code path are automatically added. %% </dd> %% <dt>{@type {doclet, Module::atom()@}} %% </dt> diff --git a/lib/edoc/src/edoc_lib.erl b/lib/edoc/src/edoc_lib.erl index d00a283794..5959fa6f08 100644 --- a/lib/edoc/src/edoc_lib.erl +++ b/lib/edoc/src/edoc_lib.erl @@ -32,12 +32,12 @@ -export([count/2, lines/1, split_at/2, split_at_stop/1, split_at_space/1, filename/1, transpose/1, segment/2, get_first_sentence/1, is_space/1, strip_space/1, parse_expr/2, - parse_contact/2, escape_uri/1, join_uri/2, is_relative_uri/1, + parse_contact/2, escape_uri/1, join_uri/2, is_name/1, to_label/1, find_doc_dirs/0, find_sources/2, find_file/2, try_subdir/2, unique/1, write_file/3, write_file/4, write_info_file/3, read_info_file/1, get_doc_env/1, get_doc_env/3, copy_file/2, - uri_get/1, run_doclet/2, run_layout/2, + run_doclet/2, run_layout/2, simplify_path/1, timestr/1, datestr/1, read_encoding/2]). -import(edoc_report, [report/2, warning/2]). @@ -438,128 +438,6 @@ join_uri("", Path) -> join_uri(Base, Path) -> Base ++ "/" ++ Path. -%% Check for relative URI; "network paths" ("//...") not included! - -%% @private -is_relative_uri([$: | _]) -> - false; -is_relative_uri([$/, $/ | _]) -> - false; -is_relative_uri([$/ | _]) -> - true; -is_relative_uri([$? | _]) -> - true; -is_relative_uri([$# | _]) -> - true; -is_relative_uri([_ | Cs]) -> - is_relative_uri(Cs); -is_relative_uri([]) -> - true. - -%% @private -uri_get("file:///" ++ Path) -> - uri_get_file(Path); -uri_get("file://localhost/" ++ Path) -> - uri_get_file(Path); -uri_get("file://" ++ Path) -> - Msg = io_lib:format("cannot handle 'file:' scheme with " - "nonlocal network-path: 'file://~ts'.", - [Path]), - {error, Msg}; -uri_get("file:/" ++ Path) -> - uri_get_file(Path); -uri_get("file:" ++ Path) -> - Msg = io_lib:format("ignoring malformed URI: 'file:~ts'.", [Path]), - {error, Msg}; -uri_get("http:" ++ Path) -> - uri_get_http("http:" ++ Path); -uri_get("ftp:" ++ Path) -> - uri_get_ftp("ftp:" ++ Path); -uri_get("//" ++ Path) -> - Msg = io_lib:format("cannot access network-path: '//~ts'.", [Path]), - {error, Msg}; -uri_get([C, $:, $/ | _]=Path) when C >= $A, C =< $Z; C >= $a, C =< $z -> - uri_get_file(Path); % special case for Windows -uri_get([C, $:, $\ | _]=Path) when C >= $A, C =< $Z; C >= $a, C =< $z -> - uri_get_file(Path); % special case for Windows -uri_get(URI) -> - case is_relative_uri(URI) of - true -> - uri_get_file(URI); - false -> - Msg = io_lib:format("cannot handle URI: '~ts'.", [URI]), - {error, Msg} - end. - -uri_get_file(File0) -> - File = filename:join(?FILE_BASE, File0), - case read_file(File) of - {ok, Text} -> - {ok, Text}; - {error, R} -> - {error, file:format_error(R)} - end. - -uri_get_http(URI) -> - %% Try using option full_result=false - case catch {ok, httpc:request(get, {URI,[]}, [], - [{full_result, false}])} of - {'EXIT', _} -> - uri_get_http_r10(URI); - Result -> - uri_get_http_1(Result, URI) - end. - -uri_get_http_r10(URI) -> - %% Try most general form of request - Result = (catch {ok, httpc:request(get, {URI,[]}, [], [])}), - uri_get_http_1(Result, URI). - -uri_get_http_1(Result, URI) -> - case Result of - {ok, {ok, {200, Text}}} when is_list(Text) -> - %% new short result format - {ok, Text}; - {ok, {ok, {Status, Text}}} when is_integer(Status), is_list(Text) -> - %% new short result format when status /= 200 - Phrase = httpd_util:reason_phrase(Status), - {error, http_errmsg(Phrase, URI)}; - {ok, {ok, {{_Vsn, 200, _Phrase}, _Hdrs, Text}}} when is_list(Text) -> - %% new long result format - {ok, Text}; - {ok, {ok, {{_Vsn, _Status, Phrase}, _Hdrs, Text}}} when is_list(Text) -> - %% new long result format when status /= 200 - {error, http_errmsg(Phrase, URI)}; - {ok, {200,_Hdrs,Text}} when is_list(Text) -> - %% old result format - {ok, Text}; - {ok, {Status,_Hdrs,Text}} when is_list(Text) -> - %% old result format when status /= 200 - Phrase = httpd_util:reason_phrase(Status), - {error, http_errmsg(Phrase, URI)}; - {ok, {error, R}} -> - Reason = inet:format_error(R), - {error, http_errmsg(Reason, URI)}; - {ok, R} -> - Reason = io_lib:format("bad return value ~tP", [R, 5]), - {error, http_errmsg(Reason, URI)}; - {'EXIT', R} -> - Reason = io_lib:format("crashed with reason ~tw", [R]), - {error, http_errmsg(Reason, URI)}; - R -> - Reason = io_lib:format("uncaught throw: ~tw", [R]), - {error, http_errmsg(Reason, URI)} - end. - -http_errmsg(Reason, URI) -> - io_lib:format("http error: ~ts: '~ts'", [Reason, URI]). - -%% TODO: implement ftp access method - -uri_get_ftp(URI) -> - Msg = io_lib:format("cannot access ftp scheme yet: '~ts'.", [URI]), - {error, Msg}. - %% @private to_label([$\s | Cs]) -> to_label(Cs); @@ -754,18 +632,6 @@ read_info_file(Dir) -> {?NO_APP, []} end. -%% URI access - -uri_get_info_file(Base) -> - URI = join_uri(Base, ?INFO_FILE), - case uri_get(URI) of - {ok, Text} -> - parse_info_file(Text, URI); - {error, Msg} -> - warning("could not read '~ts': ~ts.", [URI, Msg]), - {?NO_APP, []} - end. - parse_info_file(Text, Name) -> case parse_terms(Text) of {ok, Vs} -> @@ -897,7 +763,7 @@ find_doc_dirs([]) -> get_doc_links(App, Modules, Opts) -> Path = proplists:append_values(doc_path, Opts) ++ find_doc_dirs(), - Ds = [{P, uri_get_info_file(P)} || P <- Path], + Ds = [{P, read_info_file(P)} || P <- Path], Ds1 = [{"", {App, Modules}} | Ds], D = dict:new(), make_links(Ds1, D, D). diff --git a/lib/eldap/Makefile b/lib/eldap/Makefile index 28f995e068..30a8f778ab 100644 --- a/lib/eldap/Makefile +++ b/lib/eldap/Makefile @@ -38,3 +38,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=asn ssl + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/eldap/doc/src/eldap.xml b/lib/eldap/doc/src/eldap.xml index 790a2f4e26..4a8c2d1647 100644 --- a/lib/eldap/doc/src/eldap.xml +++ b/lib/eldap/doc/src/eldap.xml @@ -317,7 +317,7 @@ </type> <desc> <p> Modify the DN of an entry. <c>DeleteOldRDN</c> indicates - whether the current RDN should be removed from the attribute list after the after operation. + whether the current RDN should be removed from the attribute list after the operation. <c>NewSupDN</c> is the new parent that the RDN shall be moved to. If the old parent should remain as parent, <c>NewSupDN</c> shall be "".</p> <code> diff --git a/lib/erl_docgen/Makefile b/lib/erl_docgen/Makefile index 30ff2bf16e..7e9cc824ec 100644 --- a/lib/erl_docgen/Makefile +++ b/lib/erl_docgen/Makefile @@ -36,4 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=edoc xmerl +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/erl_docgen/priv/bin/specs_gen.escript b/lib/erl_docgen/priv/bin/specs_gen.escript index 859f3c21f5..116240530d 100644 --- a/lib/erl_docgen/priv/bin/specs_gen.escript +++ b/lib/erl_docgen/priv/bin/specs_gen.escript @@ -131,7 +131,7 @@ write_text(Text, File, Dir) -> ok; {error, R} -> R1 = file:format_error(R), - io:format("could not write file '~s': ~s\n", [File, R1]), + io:format("could not write file '~s': ~s\n", [OutFile, R1]), halt(2) end. diff --git a/lib/erl_docgen/priv/dtd/common.dtd b/lib/erl_docgen/priv/dtd/common.dtd index 0ccd52068b..0feb09eac2 100644 --- a/lib/erl_docgen/priv/dtd/common.dtd +++ b/lib/erl_docgen/priv/dtd/common.dtd @@ -67,7 +67,7 @@ <!ELEMENT list (item+) > <!ATTLIST list type (ordered|bulleted) "bulleted" > -<!ELEMENT taglist (tag,item+)+ > +<!ELEMENT taglist (marker*,tag,item+)+ > <!ELEMENT tag (#PCDATA|c|i|em|br|seealso|url|marker|anno)* > <!ELEMENT item (%inline;|%block;|warning|note|dont|do|quote)* > diff --git a/lib/erl_interface/Makefile b/lib/erl_interface/Makefile index 9471b0df18..633e705b3f 100644 --- a/lib/erl_interface/Makefile +++ b/lib/erl_interface/Makefile @@ -31,3 +31,5 @@ SPECIAL_TARGETS = # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h index b138118f04..7d39043bb2 100644 --- a/lib/erl_interface/include/ei.h +++ b/lib/erl_interface/include/ei.h @@ -323,13 +323,24 @@ typedef struct { #define EI_SCLBK_FLG_FULL_IMPL (1 << 0) +/* + * HACK: AIX defines many socket functions like accept to be naccept, which + * pollutes the global namespace. Set up an ugly ifdef for consumers of this + * API here so they get a mangled name for AIX and the sane name elsewhere. + */ +#ifdef _AIX +#define EI_ACCEPT_NAME accept_ei +#else +#define EI_ACCEPT_NAME accept +#endif + typedef struct { int flags; int (*socket)(void **ctx, void *setup_ctx); int (*close)(void *ctx); int (*listen)(void *ctx, void *addr, int *len, int backlog); - int (*accept)(void **ctx, void *addr, int *len, unsigned tmo); + int (*EI_ACCEPT_NAME)(void **ctx, void *addr, int *len, unsigned tmo); int (*connect)(void *ctx, void *addr, int len, unsigned tmo); int (*writev)(void *ctx, const void *iov, int iovcnt, ssize_t *len, unsigned tmo); int (*write)(void *ctx, const char *buf, ssize_t *len, unsigned tmo); diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c index 1b1479d2e9..f600758385 100644 --- a/lib/erl_interface/src/connect/ei_connect.c +++ b/lib/erl_interface/src/connect/ei_connect.c @@ -659,7 +659,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, return ERL_ERROR; } - ec->creation = creation & 0x3; /* 2 bits */ + ec->creation = creation; if (cookie) { if (strlen(cookie) >= sizeof(ec->ei_connect_cookie)) { @@ -698,7 +698,7 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, strcpy(ec->self.node,thisnodename); ec->self.num = 0; ec->self.serial = 0; - ec->self.creation = creation & 0x3; /* 2 bits */ + ec->self.creation = creation; ec->cbs = cbs; ec->setup_context = setup_context; diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 225fddc784..5a8ca0c567 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -55,6 +55,16 @@ #include "ei_resolve.h" #include "ei_locking.h" +/* AIX has a totally different signature (allegedly shared with some other + * Unices) that isn't compatible. It turns out that the _r version isn't + * thread-safe according to curl - but bizarrely, since AIX 4.3, libc + * is thread-safe in a manner that makes the normal gethostbyname OK + * for re-entrant use. + */ +#ifdef _AIX +#undef HAVE_GETHOSTBYNAME_R +#endif + #ifdef HAVE_GETHOSTBYNAME_R int ei_init_resolve(void) @@ -75,7 +85,7 @@ int ei_init_resolve(void) static ei_mutex_t *ei_gethost_sem = NULL; #endif /* _REENTRANT */ static int ei_resolve_initialized = 0; -#ifndef __WIN32__ +#if !defined(__WIN32__) && !defined(_AIX) int h_errno; #endif diff --git a/lib/erl_interface/src/encode/encode_pid.c b/lib/erl_interface/src/encode/encode_pid.c index d14746b40f..0dfdb16372 100644 --- a/lib/erl_interface/src/encode/encode_pid.c +++ b/lib/erl_interface/src/encode/encode_pid.c @@ -25,7 +25,6 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) { char* s = buf + *index; - const char tag = (p->creation > 3) ? ERL_NEW_PID_EXT : ERL_PID_EXT; ++(*index); /* skip ERL_PID_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), @@ -33,21 +32,17 @@ int ei_encode_pid(char *buf, int *index, const erlang_pid *p) return -1; if (buf) { - put8(s, tag); + put8(s, ERL_NEW_PID_EXT); s = buf + *index; /* now the integers */ put32be(s,p->num & 0x7fff); /* 15 bits */ put32be(s,p->serial & 0x1fff); /* 13 bits */ - if (tag == ERL_PID_EXT) { - put8(s,(p->creation & 0x03)); /* 2 bits */ - } else { - put32be(s, p->creation); /* 32 bits */ - } + put32be(s, p->creation); /* 32 bits */ } - *index += 4 + 4 + (tag == ERL_PID_EXT ? 1 : 4); + *index += 4 + 4 + 4; return 0; } diff --git a/lib/erl_interface/src/encode/encode_port.c b/lib/erl_interface/src/encode/encode_port.c index eb464380c0..0fb4018db1 100644 --- a/lib/erl_interface/src/encode/encode_port.c +++ b/lib/erl_interface/src/encode/encode_port.c @@ -25,7 +25,6 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) { char *s = buf + *index; - const char tag = p->creation > 3 ? ERL_NEW_PORT_EXT : ERL_PORT_EXT; ++(*index); /* skip ERL_PORT_EXT */ if (ei_encode_atom_len_as(buf, index, p->node, strlen(p->node), ERLANG_UTF8, @@ -33,19 +32,15 @@ int ei_encode_port(char *buf, int *index, const erlang_port *p) return -1; } if (buf) { - put8(s, tag); + put8(s, ERL_NEW_PORT_EXT); s = buf + *index; /* now the integers */ put32be(s,p->id & 0x0fffffff /* 28 bits */); - if (tag == ERL_PORT_EXT) { - put8(s,(p->creation & 0x03)); - } else { - put32be(s, p->creation); - } + put32be(s, p->creation); } - *index += 4 + (tag == ERL_PORT_EXT ? 1 : 4); + *index += 4 + 4; return 0; } diff --git a/lib/erl_interface/src/encode/encode_ref.c b/lib/erl_interface/src/encode/encode_ref.c index 5ccfc32c6d..8c2e0a25f7 100644 --- a/lib/erl_interface/src/encode/encode_ref.c +++ b/lib/erl_interface/src/encode/encode_ref.c @@ -24,7 +24,6 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) { - const char tag = (p->creation > 3) ? ERL_NEWER_REFERENCE_EXT : ERL_NEW_REFERENCE_EXT; char *s = buf + *index; int i; @@ -37,7 +36,7 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) /* Always encode as an extended reference; all participating parties are now expected to be able to decode extended references. */ if (buf) { - put8(s, tag); + put8(s, ERL_NEWER_REFERENCE_EXT); /* first, number of integers */ put16be(s, p->len); @@ -46,15 +45,12 @@ int ei_encode_ref(char *buf, int *index, const erlang_ref *p) s = buf + *index; /* now the integers */ - if (tag == ERL_NEW_REFERENCE_EXT) - put8(s,(p->creation & 0x03)); - else - put32be(s, p->creation); + put32be(s, p->creation); for (i = 0; i < p->len; i++) put32be(s,p->n[i]); } - *index += p->len*4 + (tag == ERL_NEW_REFERENCE_EXT ? 1 : 4); + *index += p->len*4 + 4; return 0; } diff --git a/lib/erl_interface/src/epmd/ei_epmd.h b/lib/erl_interface/src/epmd/ei_epmd.h index ac153b6e66..597a955676 100644 --- a/lib/erl_interface/src/epmd/ei_epmd.h +++ b/lib/erl_interface/src/epmd/ei_epmd.h @@ -25,8 +25,8 @@ #endif #ifndef EI_DIST_HIGH -#define EI_DIST_HIGH 5 /* R4 and later */ -#define EI_DIST_LOW 1 /* R3 and earlier */ +#define EI_DIST_HIGH 6 /* OTP 23 and later */ +#define EI_DIST_LOW 5 /* OTP R4 - 22 */ #endif #ifndef EPMD_PORT @@ -45,6 +45,7 @@ #ifndef EI_EPMD_ALIVE2_REQ #define EI_EPMD_ALIVE2_REQ 120 #define EI_EPMD_ALIVE2_RESP 121 +#define EI_EPMD_ALIVE2_X_RESP 118 #define EI_EPMD_PORT2_REQ 122 #define EI_EPMD_PORT2_RESP 119 #define EI_EPMD_STOP_REQ 's' diff --git a/lib/erl_interface/src/epmd/epmd_publish.c b/lib/erl_interface/src/epmd/epmd_publish.c index 20b8e867e8..ef8a5d6b70 100644 --- a/lib/erl_interface/src/epmd/epmd_publish.c +++ b/lib/erl_interface/src/epmd/epmd_publish.c @@ -68,7 +68,8 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) int nlen = strlen(alive); int len = elen + nlen + 13; /* hard coded: be careful! */ int n; - int err, res, creation; + int err, response, res; + unsigned creation; ssize_t dlen; unsigned tmo = ms == 0 ? EI_SCLBK_INF_TMO : ms; @@ -124,8 +125,10 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) /* Don't close fd here! It keeps us registered with epmd */ s = buf; - if (((res=get8(s)) != EI_EPMD_ALIVE2_RESP)) { /* response */ - EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",res); + response = get8(s); + if (response != EI_EPMD_ALIVE2_RESP && + response != EI_EPMD_ALIVE2_X_RESP) { + EI_TRACE_ERR1("ei_epmd_r4_publish","<- unknown (%d)",response); EI_TRACE_ERR0("ei_epmd_r4_publish","-> CLOSE"); ei_close__(fd); erl_errno = EIO; @@ -141,18 +144,21 @@ static int ei_epmd_r4_publish (int port, const char *alive, unsigned ms) return -1; } - creation = get16be(s); + if (response == EI_EPMD_ALIVE2_RESP) + creation = get16be(s); + else /* EI_EPMD_ALIVE2_X_RESP */ + creation = get32be(s); EI_TRACE_CONN2("ei_epmd_r4_publish", - " result=%d (ok) creation=%d",res,creation); + " result=%d (ok) creation=%u",res,creation); - /* probably should save fd so we can close it later... */ - /* epmd_saveconn(OPEN,fd,alive); */ + /* + * Would be nice to somehow use the nice "unique" creation value + * received here from epmd instead of using the crappy one + * passed (already) to ei_connect_init. + */ - /* return the creation number, for no good reason */ - /* return creation;*/ - - /* no - return the descriptor */ + /* return the descriptor */ return fd; } diff --git a/lib/erl_interface/src/misc/ei_portio.c b/lib/erl_interface/src/misc/ei_portio.c index bccc86c1b1..bfe67a732c 100644 --- a/lib/erl_interface/src/misc/ei_portio.c +++ b/lib/erl_interface/src/misc/ei_portio.c @@ -622,7 +622,7 @@ int ei_accept_ctx_t__(ei_socket_callbacks *cbs, void **ctx, } while (error == EINTR); } do { - error = cbs->accept(ctx, addr, len, ms); + error = cbs->EI_ACCEPT_NAME(ctx, addr, len, ms); } while (error == EINTR); return error; } diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c index ab91157035..dce2ecdec2 100644 --- a/lib/erl_interface/src/prog/erl_call.c +++ b/lib/erl_interface/src/prog/erl_call.c @@ -292,8 +292,7 @@ int erl_call(int argc, char **argv) flags.cookie = NULL; } - /* FIXME decide how many bits etc or leave to connect_xinit? */ - creation = (time(NULL) % 3) + 1; /* "random" */ + creation = time(NULL) + 1; /* "random" */ if (flags.hidden == NULL) { /* As default we are c17@gethostname */ diff --git a/lib/erl_interface/test/erl_eterm_SUITE.erl b/lib/erl_interface/test/erl_eterm_SUITE.erl index 77910a9fc7..4605293c74 100644 --- a/lib/erl_interface/test/erl_eterm_SUITE.erl +++ b/lib/erl_interface/test/erl_eterm_SUITE.erl @@ -73,6 +73,10 @@ -import(runner, [get_term/1]). +-define(REFERENCE_EXT, $e). +-define(NEW_REFERENCE_EXT, $r). +-define(NEWER_REFERENCE_EXT, $Z). + %% This test suite controls the running of the C language functions %% in eterm_test.c and print_term.c. @@ -1026,9 +1030,11 @@ cnode_1(Config) when is_list(Config) -> check_ref(Ref) -> case bin_ext_type(Ref) of - 101 -> + ?REFERENCE_EXT -> ct:fail(oldref); - 114 -> + ?NEW_REFERENCE_EXT -> + ok; + ?NEWER_REFERENCE_EXT -> ok; Type -> ct:fail({type, Type}) diff --git a/lib/et/Makefile b/lib/et/Makefile index f0bb7be211..1b89cff83e 100644 --- a/lib/et/Makefile +++ b/lib/et/Makefile @@ -35,3 +35,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=runtime_tools wx + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/eunit/Makefile b/lib/eunit/Makefile index 15dae19896..d0dd447a6c 100644 --- a/lib/eunit/Makefile +++ b/lib/eunit/Makefile @@ -48,13 +48,7 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk - -.PHONY: info version - -info: - @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" - @echo "APP_DIR: $(APP_DIR)" - @echo "APP_TAR_FILE: $(APP_TAR_FILE)" +.PHONY: version version: @echo "$(VSN)" @@ -94,3 +88,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index 2b9f82b075..002a069a92 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -451,6 +451,11 @@ escape_xml([$< | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $l, $& | Acc] escape_xml([$> | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $t, $g, $& | Acc], ForAttr); escape_xml([$& | Tail], Acc, ForAttr) -> escape_xml(Tail, [$;, $p, $m, $a, $& | Acc], ForAttr); escape_xml([$" | Tail], Acc, true) -> escape_xml(Tail, [$;, $t, $o, $u, $q, $& | Acc], true); % " +escape_xml([Char | Tail], Acc, ForAttr) when + Char == $\n; Char == $\r; Char == $\t -> escape_xml(Tail, [Char | Acc], ForAttr); +%% Strip C0 control codes which are not allowed in XML 1.0 +escape_xml([Char | Tail], Acc, ForAttr) when + 0 =< Char, Char =< 31 -> escape_xml(Tail, Acc, ForAttr); escape_xml([Char | Tail], Acc, ForAttr) when is_integer(Char) -> escape_xml(Tail, [Char | Acc], ForAttr). %% the input may be utf8 or latin1; the resulting list is unicode diff --git a/lib/eunit/test/Makefile b/lib/eunit/test/Makefile index b6ece61b43..7c1e56c867 100644 --- a/lib/eunit/test/Makefile +++ b/lib/eunit/test/Makefile @@ -22,6 +22,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ eunit_SUITE \ + tc0 \ tlatin \ tutf8 diff --git a/lib/eunit/test/eunit_SUITE.erl b/lib/eunit/test/eunit_SUITE.erl index 63bdc6c334..b9f4ea4557 100644 --- a/lib/eunit/test/eunit_SUITE.erl +++ b/lib/eunit/test/eunit_SUITE.erl @@ -21,14 +21,16 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - app_test/1,appup_test/1,eunit_test/1,surefire_utf8_test/1,surefire_latin_test/1]). + app_test/1,appup_test/1,eunit_test/1,surefire_utf8_test/1,surefire_latin_test/1, + surefire_c0_test/1]). -include_lib("common_test/include/ct.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_test, appup_test, eunit_test, surefire_utf8_test, surefire_latin_test]. + [app_test, appup_test, eunit_test, surefire_utf8_test, surefire_latin_test, + surefire_c0_test]. groups() -> []. @@ -65,11 +67,24 @@ surefire_utf8_test(Config) when is_list(Config) -> check_surefire(tutf8), ok. +surefire_c0_test(Config) when is_list(Config) -> + ok = file:set_cwd(proplists:get_value(priv_dir, Config, ".")), + Chars = check_surefire(tc0), + %% Check that these characters were not stripped + true = lists:member($\n, Chars), + true = lists:member($\r, Chars), + true = lists:member($\t, Chars), + ok. + check_surefire(Module) -> File = "TEST-"++atom_to_list(Module)++".xml", file:delete(File), % ignore test result, some fail on purpose eunit:test(Module, [{report,{eunit_surefire,[{dir,"."}]}}]), {ok, Bin} = file:read_file(File), - [_|_] = unicode:characters_to_list(Bin, unicode), - ok.
\ No newline at end of file + Chars = unicode:characters_to_list(Bin, unicode), + %% Check that unicode decoding succeeded + [_|_] = Chars, + %% Check that file is valid XML + xmerl_scan:file(File), + Chars. diff --git a/lib/eunit/test/tc0.erl b/lib/eunit/test/tc0.erl new file mode 100644 index 0000000000..8c90633fc8 --- /dev/null +++ b/lib/eunit/test/tc0.erl @@ -0,0 +1,14 @@ +-module(tc0). + +-include_lib("eunit/include/eunit.hrl"). + +'c0_bad_output_test_'() -> + [{integer_to_list(C), fun() -> io:format("'~c'", [C]) end} + || C <- lists:seq(0, 31)]. + +'c0_bad_description_test_'() -> + [{[C], fun() -> ok end} + || C <- lists:seq(0, 31)]. + +'c0_bad_name__test'() -> + ok. diff --git a/lib/ftp/Makefile b/lib/ftp/Makefile index e0c9de42e4..a26d1de0a0 100644 --- a/lib/ftp/Makefile +++ b/lib/ftp/Makefile @@ -32,47 +32,11 @@ VSN = $(FTP_VSN) SPECIAL_TARGETS = -DIA_PLT = ./priv/plt/$(APPLICATION).plt -DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis - - # ---------------------------------------------------- # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info gclean dialyzer dialyzer_plt dclean - -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "FTP_VSN: $(FTP_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" - -gclean: - git clean -fXd - -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose +DIA_PLT_APPS = runtime_tools ssl -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile index 0676484fca..4998522943 100644 --- a/lib/hipe/Makefile +++ b/lib/hipe/Makefile @@ -75,3 +75,6 @@ distclean: realclean: $(V_at)$(MAKE) MAKETARGET="realclean" all-subdirs all-subdirs-x +DIA_PLT_APPS=compiler syntax_tools + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 995c961e09..fce178a5e3 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -678,8 +678,8 @@ trans_fun([{call_fun,N}|Instructions], Env) -> Dst = [mk_var({r,0})], [hipe_icode:mk_comment('call_fun'), hipe_icode:mk_primop(Dst,call_fun,Args) | trans_fun(Instructions,Env)]; -%%--- patched_make_fun --- make_fun/make_fun2 after fixes -trans_fun([{patched_make_fun,MFA,Magic,FreeVarNum,Index}|Instructions], Env) -> +%%--- make_fun2 --- +trans_fun([{make_fun2,MFA,Index,Magic,FreeVarNum}|Instructions], Env) -> Args = extract_fun_args(FreeVarNum), Dst = [mk_var({r,0})], Fun = hipe_icode:mk_primop(Dst, @@ -1193,6 +1193,17 @@ trans_fun([{bs_get_position=Name,_,_,_}|_Instructions], _Env) -> trans_fun([{bs_set_position=Name,_,_}|_Instructions], _Env) -> nyi(Name); %%-------------------------------------------------------------------- +%% New instructions added in OTP 23. +%%-------------------------------------------------------------------- +%%--- swap --- +trans_fun([{swap,Reg1,Reg2}|Instructions], Env) -> + Var1 = mk_var(Reg1), + Var2 = mk_var(Reg2), + Temp = mk_var(new), + [hipe_icode:mk_move(Temp, Var1), + hipe_icode:mk_move(Var1, Var2), + hipe_icode:mk_move(Var2, Temp) | trans_fun(Instructions, Env)]; +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1935,7 +1946,7 @@ mod_find_closure_info([FunCode|Fs], CI) -> mod_find_closure_info([], CI) -> CI. -find_closure_info([{patched_make_fun,MFA={_M,_F,A},_Magic,FreeVarNum,_Index}|BeamCode], +find_closure_info([{make_fun2,{_M,_F,A}=MFA,_Index,_Magic,FreeVarNum}|BeamCode], ClosureInfo) -> NewClosure = %% A-FreeVarNum+1 (The real arity + 1 for the closure) #closure_info{mfa=MFA, arity=A-FreeVarNum+1, fv_arity=FreeVarNum}, @@ -2013,41 +2024,8 @@ split_params(N, [ArgN|OrgArgs], Args) -> %%----------------------------------------------------------------------- preprocess_code(ModuleCode) -> - PatchedCode = patch_R7_funs(ModuleCode), - ClosureInfo = find_closure_info(PatchedCode), - {PatchedCode, ClosureInfo}. - -%%----------------------------------------------------------------------- -%% Patches the "make_fun" BEAM instructions of R7 so that they also -%% contain the index that the BEAM loader generates for funs. -%% -%% The index starts from 0 and is incremented by 1 for each make_fun -%% instruction encountered. -%% -%% Retained only for compatibility with BEAM code prior to R8. -%% -%% Temporarily, it also rewrites R8-PRE-RELEASE "make_fun2" -%% instructions, since their embedded indices don't work. -%%----------------------------------------------------------------------- - -patch_R7_funs(ModuleCode) -> - patch_make_funs(ModuleCode, 0). - -patch_make_funs([FunCode0|Fs], FunIndex0) -> - {PatchedFunCode,FunIndex} = patch_make_funs(FunCode0, FunIndex0, []), - [PatchedFunCode|patch_make_funs(Fs, FunIndex)]; -patch_make_funs([], _) -> []. - -patch_make_funs([{make_fun,MFA,Magic,FreeVarNum}|Is], FunIndex, Acc) -> - Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex}, - patch_make_funs(Is, FunIndex+1, [Patched|Acc]); -patch_make_funs([{make_fun2,MFA,_BogusIndex,Magic,FreeVarNum}|Is], FunIndex, Acc) -> - Patched = {patched_make_fun,MFA,Magic,FreeVarNum,FunIndex}, - patch_make_funs(Is, FunIndex+1, [Patched|Acc]); -patch_make_funs([I|Is], FunIndex, Acc) -> - patch_make_funs(Is, FunIndex, [I|Acc]); -patch_make_funs([], FunIndex, Acc) -> - {lists:reverse(Acc),FunIndex}. + ClosureInfo = find_closure_info(ModuleCode), + {ModuleCode, ClosureInfo}. %%----------------------------------------------------------------------- diff --git a/lib/inets/Makefile b/lib/inets/Makefile index 872df9d055..a7723dc0d8 100644 --- a/lib/inets/Makefile +++ b/lib/inets/Makefile @@ -32,47 +32,11 @@ VSN = $(INETS_VSN) SPECIAL_TARGETS = -DIA_PLT = ./priv/plt/$(APPLICATION).plt -DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis - - # ---------------------------------------------------- # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info gclean dialyzer dialyzer_plt dclean - -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "INETS_VSN: $(INETS_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" - -gclean: - git clean -fXd - -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose +DIA_PLT_APPS=runtime_tools ftp mnesia ssl tftp -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/jinterface/Makefile b/lib/jinterface/Makefile index 9cf5f3e94c..dd22d743a5 100644 --- a/lib/jinterface/Makefile +++ b/lib/jinterface/Makefile @@ -39,3 +39,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java index 9cbd735751..3abdf9535f 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPid.java @@ -27,7 +27,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> // don't change this! private static final long serialVersionUID = 1664394142301803659L; - private final int tag; private final String node; private final int id; private final int serial; @@ -45,7 +44,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> public OtpErlangPid(final OtpLocalNode self) { final OtpErlangPid p = self.createPid(); - tag = p.tag; id = p.id; serial = p.serial; creation = p.creation; @@ -67,7 +65,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> throws OtpErlangDecodeException { final OtpErlangPid p = buf.read_pid(); - tag = p.tag; node = p.node(); id = p.id(); serial = p.serial(); @@ -118,7 +115,6 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> */ protected OtpErlangPid(final int tag, final String node, final int id, final int serial, final int creation) { - this.tag = tag; this.node = node; if (tag == OtpExternal.pidTag) { this.id = id & 0x7fff; // 15 bits @@ -133,7 +129,7 @@ public class OtpErlangPid extends OtpErlangObject implements Comparable<Object> } protected int tag() { - return tag; + return OtpExternal.newPidTag; } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java index 79b5d2736c..c8648d7aa3 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangPort.java @@ -26,7 +26,6 @@ public class OtpErlangPort extends OtpErlangObject { // don't change this! private static final long serialVersionUID = 4037115468007644704L; - private final int tag; private final String node; private final int id; private final int creation; @@ -43,7 +42,6 @@ public class OtpErlangPort extends OtpErlangObject { private OtpErlangPort(final OtpSelf self) { final OtpErlangPort p = self.createPort(); - tag = p.tag; id = p.id; creation = p.creation; node = p.node; @@ -64,7 +62,6 @@ public class OtpErlangPort extends OtpErlangObject { throws OtpErlangDecodeException { final OtpErlangPort p = buf.read_port(); - tag = p.tag; node = p.node(); id = p.id(); creation = p.creation(); @@ -105,7 +102,6 @@ public class OtpErlangPort extends OtpErlangObject { */ public OtpErlangPort(final int tag, final String node, final int id, final int creation) { - this.tag = tag; this.node = node; if (tag == OtpExternal.portTag) { this.id = id & 0xfffffff; // 28 bits @@ -118,7 +114,7 @@ public class OtpErlangPort extends OtpErlangObject { } protected int tag() { - return tag; + return OtpExternal.newPortTag; } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java index 2165397013..2bf8d9a56b 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpErlangRef.java @@ -28,7 +28,6 @@ public class OtpErlangRef extends OtpErlangObject { // don't change this! private static final long serialVersionUID = -7022666480768586521L; - private final int tag; private final String node; private final int creation; @@ -49,7 +48,6 @@ public class OtpErlangRef extends OtpErlangObject { public OtpErlangRef(final OtpLocalNode self) { final OtpErlangRef r = self.createRef(); - tag = r.tag; ids = r.ids; creation = r.creation; node = r.node; @@ -70,7 +68,6 @@ public class OtpErlangRef extends OtpErlangObject { throws OtpErlangDecodeException { final OtpErlangRef r = buf.read_ref(); - tag = r.tag; node = r.node(); creation = r.creation(); @@ -90,7 +87,6 @@ public class OtpErlangRef extends OtpErlangObject { * another arbitrary number. */ public OtpErlangRef(final String node, final int id, final int creation) { - this.tag = OtpExternal.newRefTag; this.node = node; ids = new int[1]; ids[0] = id & 0x3ffff; // 18 bits @@ -138,7 +134,6 @@ public class OtpErlangRef extends OtpErlangObject { */ public OtpErlangRef(final int tag, final String node, final int[] ids, final int creation) { - this.tag = tag; this.node = node; // use at most 3 words @@ -162,7 +157,7 @@ public class OtpErlangRef extends OtpErlangObject { } protected int tag() { - return tag; + return OtpExternal.newerRefTag; } /** diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java index 5e777c1164..917e5baf3a 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpOutputStream.java @@ -713,7 +713,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { */ public void write_pid(final String node, final int id, final int serial, final int creation) { - write1(OtpExternal.pidTag); + write1(OtpExternal.newPidTag); write_atom(node); write4BE(id & 0x7fff); // 15 bits write4BE(serial & 0x1fff); // 13 bits @@ -727,20 +727,11 @@ public class OtpOutputStream extends ByteArrayOutputStream { * the pid */ public void write_pid(OtpErlangPid pid) { - write1(pid.tag()); + write1(OtpExternal.newPidTag); write_atom(pid.node()); write4BE(pid.id()); write4BE(pid.serial()); - switch (pid.tag()) { - case OtpExternal.pidTag: - write1(pid.creation()); - break; - case OtpExternal.newPidTag: - write4BE(pid.creation()); - break; - default: - throw new AssertionError("Invalid pid tag " + pid.tag()); - } + write4BE(pid.creation()); } @@ -758,7 +749,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { * be used. */ public void write_port(final String node, final int id, final int creation) { - write1(OtpExternal.portTag); + write1(OtpExternal.newPortTag); write_atom(node); write4BE(id & 0xfffffff); // 28 bits write1(creation & 0x3); // 2 bits @@ -771,19 +762,10 @@ public class OtpOutputStream extends ByteArrayOutputStream { * the port. */ public void write_port(OtpErlangPort port) { - write1(port.tag()); + write1(OtpExternal.newPortTag); write_atom(port.node()); write4BE(port.id()); - switch (port.tag()) { - case OtpExternal.portTag: - write1(port.creation()); - break; - case OtpExternal.newPortTag: - write4BE(port.creation()); - break; - default: - throw new AssertionError("Invalid port tag " + port.tag()); - } + write4BE(port.creation()); } /** @@ -829,7 +811,7 @@ public class OtpOutputStream extends ByteArrayOutputStream { arity = 3; // max 3 words in ref } - write1(OtpExternal.newRefTag); + write1(OtpExternal.newerRefTag); // how many id values write2BE(arity); @@ -857,24 +839,12 @@ public class OtpOutputStream extends ByteArrayOutputStream { int[] ids = ref.ids(); int arity = ids.length; - write1(ref.tag()); + write1(OtpExternal.newerRefTag); write2BE(arity); write_atom(ref.node()); + write4BE(ref.creation()); - switch (ref.tag()) { - case OtpExternal.newRefTag: - write1(ref.creation()); - write4BE(ids[0] & 0x3ffff); // first word gets truncated to 18 bits - break; - case OtpExternal.newerRefTag: - write4BE(ref.creation()); - write4BE(ids[0]); // full first word - break; - default: - throw new AssertionError("Invalid ref tag " + ref.tag()); - } - - for (int i = 1; i < arity; i++) { + for (int i = 0; i < arity; i++) { write4BE(ids[i]); } } diff --git a/lib/kernel/Makefile b/lib/kernel/Makefile index b956f5eaf5..5ab8ac63b9 100644 --- a/lib/kernel/Makefile +++ b/lib/kernel/Makefile @@ -34,3 +34,5 @@ SPECIAL_TARGETS = # Default Subdir Targets # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index fc25e83d40..2c09c84b25 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -939,6 +939,10 @@ f.txt: {person, "kalle", 25}. support for POSIX <c>O_SYNC</c> or equivalent, use of the <c>sync</c> flag causes <c>open</c> to return <c>{error, enotsup}</c>.</p> </item> + <tag><c>directory</c></tag> + <item> + <p>Allows <c>open</c> to work on directories.</p> + </item> </taglist> <p>Returns:</p> <taglist> @@ -953,10 +957,9 @@ f.txt: {person, "kalle", 25}. </item> </taglist> <p><c><anno>IoDevice</anno></c> is really the pid of the process that - handles the file. This process is linked to the process - that originally opened the file. If any process to which - the <c><anno>IoDevice</anno></c> is linked terminates, the file is - closed and the process itself is terminated. + handles the file. This process monitors the process that originally + opened the file (the owner process). If the owner process terminates, + the file is closed and the process itself terminates too. An <c><anno>IoDevice</anno></c> returned from this call can be used as an argument to the I/O functions (see <seealso marker="stdlib:io"><c>io(3)</c></seealso>).</p> @@ -985,8 +988,10 @@ f.txt: {person, "kalle", 25}. </item> <tag><c>enotdir</c></tag> <item> - <p>A component of the filename is not a directory. On some - platforms, <c>enoent</c> is returned instead.</p> + <p>A component of the filename is not a directory, or the + filename itself is not a directory if <c>directory</c> + mode was specified. On some platforms, <c>enoent</c> is + returned instead.</p> </item> <tag><c>enospc</c></tag> <item> @@ -1438,7 +1443,11 @@ f.txt: {person, "kalle", 25}. break this module's atomicity guarantees as it can race with a concurrent call to <seealso marker="#write_file_info/2"><c>write_file_info/1,2</c> - </seealso></p> + </seealso>.</p> + <p>This option has no effect when the function is + given an I/O device instead of a file name. Use + <seealso marker="#open/2"><c>open/2</c></seealso> with the + <c>raw</c> mode to obtain a file descriptor first.</p> <note> <p>As file times are stored in POSIX time on most OS, it is faster to query file information with option <c>posix</c>.</p> diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index aa29223dd0..aa9067f082 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -107,6 +107,12 @@ seq_trace:set_token(OldToken), % activate the trace token again enables/disables tracing on message sending. Default is <c>false</c>.</p> </item> + <tag><c>set_token('spawn', <anno>Bool</anno>)</c></tag> + <item> + <p>A trace token flag (<c>true | false</c>) which + enables/disables tracing on process spawning. Default is + <c>false</c>.</p> + </item> <tag><c>set_token('receive', <anno>Bool</anno>)</c></tag> <item> <p>A trace token flag (<c>true | false</c>) which @@ -257,7 +263,12 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <tag><c>{send, Serial, From, To, Message}</c></tag> <item> <p>Used when a process <c>From</c> with its trace token flag - <c>print</c> set to <c>true</c> has sent a message.</p> + <c>send</c> set to <c>true</c> has sent a message.</p> + </item> + <tag><c>{spawn, Serial, Parent, Child, _}</c></tag> + <item> + <p>Used when a process <c>Parent</c> with its trace token flag + <c>spawn</c> set to <c>true</c> has spawned a process.</p> </item> <tag><c>{'receive', Serial, From, To, Message}</c></tag> <item> @@ -295,8 +306,8 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} is initiated by a single message. In short, it works as follows:</p> <p>Each process has a <em>trace token</em>, which can be empty or not empty. When not empty, the trace token can be seen as - the tuple <c>{Label, Flags, Serial, From}</c>. The trace token is - passed invisibly with each message.</p> + the tuple <c>{Label, Flags, Serial, From}</c>. The trace token is passed + invisibly to spawned processes and with each message sent.</p> <p>To start a sequential trace, the user must explicitly set the trace token in the process that will send the first message in a sequence.</p> @@ -306,9 +317,10 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <p>On each Erlang node, a process can be set as the <em>system tracer</em>. This process will receive trace messages each time a message with a trace token is sent or received (if the trace - token flag <c>send</c> or <c>'receive'</c> is set). The system - tracer can then print each trace event, write it to a file, or - whatever suitable.</p> + token flag <c>send</c> or <c>'receive'</c> is set), and when a process + with a non-empty trace token spawns another (if the trace token flag + <c>spawn</c> is set). The system tracer can then print each trace event, + write it to a file, or whatever suitable.</p> <note> <p>The system tracer only receives those trace events that occur locally within the Erlang node. To get the whole picture @@ -322,10 +334,9 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <section> <title>Trace Token</title> - <p>Each process has a current trace token. Initially, the token is - empty. When the process sends a message to another process, a - copy of the current token is sent "invisibly" along with - the message.</p> + <p>Each process has a current trace token, which is copied from the process + that spawned it. When a process sends a message to another process, a + copy of the current token is sent "invisibly" along with the message.</p> <p>The current token of a process is set in one of the following two ways:</p> <list type="bulleted"> @@ -354,8 +365,9 @@ TimeStamp = {Seconds, Milliseconds, Microseconds} <p>The algorithm for updating <c>Serial</c> can be described as follows:</p> <p>Let each process have two counters, <c>prev_cnt</c> and - <c>curr_cnt</c>, both are set to <c>0</c> when a process is created. - The counters are updated at the following occasions:</p> + <c>curr_cnt</c>, both are set to <c>0</c> when a process is created + outside of a trace sequence. The counters are updated at the following + occasions:</p> <list type="bulleted"> <item> <p><em>When the process is about to send a message and the trace token @@ -370,6 +382,16 @@ tcurr := curr_cnt</pre> passed along with the message.</p> </item> <item> + <p><em>When the process is about to spawn another process and the trace + token is not empty.</em></p> + <p>The counters of the parent process are updated in the same way as + for send above. The trace token is then passed to the child process, + whose counters will be set as follows:</p> + <code> +curr_cnt := tcurr +prev_cnt := tcurr</code> + </item> + <item> <p><em>When the process calls</em> <c>seq_trace:print(Label, Info)</c>, <c>Label</c> <em>matches the label part of the trace token and the trace token print flag is <c>true</c>.</em></p> @@ -487,9 +509,9 @@ tracer() -> print_trace(Label,TraceInfo,false); {seq_trace,Label,TraceInfo,Ts} -> print_trace(Label,TraceInfo,Ts); - Other -> ignore + _Other -> ignore end, - tracer(). + tracer(). print_trace(Label,TraceInfo,false) -> io:format("~p:",[Label]), @@ -504,8 +526,11 @@ print_trace({'receive',Serial,From,To,Message}) -> io:format("~p Received ~p FROM ~p WITH~n~p~n", [To,Serial,From,Message]); print_trace({send,Serial,From,To,Message}) -> - io:format("~p Sent ~p TO ~p WITH~n~p~n", - [From,Serial,To,Message]).</code> + io:format("~p Sent ~p TO ~p WITH~n~p~n", + [From,Serial,To,Message]); +print_trace({spawn,Serial,Parent,Child,_}) -> + io:format("~p Spawned ~p AT ~p~n", + [Parent,Child,Serial]).</code> <p>The code that creates a process that runs this tracer function and sets that process as the system tracer can look like this:</p> <code type="none"> diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index 7a14e2635c..f31a1722ce 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -33,10 +33,10 @@ -define(erlang_daemon_port, 4369). -endif. -ifndef(epmd_dist_high). --define(epmd_dist_high, 4370). +-define(epmd_dist_high, 6). -endif. -ifndef(epmd_dist_low). --define(epmd_dist_low, 4370). +-define(epmd_dist_low, 5). -endif. %% External exports @@ -342,6 +342,13 @@ wait_for_reg_reply(Socket, SoFar) -> receive {tcp, Socket, Data0} -> case SoFar ++ Data0 of + [$v, Result, A, B, C, D] -> + case Result of + 0 -> + {alive, Socket, ?u32(A, B, C, D)}; + _ -> + {error, duplicate_name} + end; [$y, Result, A, B] -> case Result of 0 -> diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index e6a30d0b92..7b9067d079 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -40,6 +40,15 @@ lc_graph/0, lc_graph_to_dot/2, lc_graph_merge/2, alloc_blocks_size/1]). +%% Reroutes calls to the given MFA to error_handler:breakpoint/3 +%% +%% Note that this is potentially unsafe as compiled code may assume that the +%% targeted function returns a specific type, triggering undefined behavior if +%% this function were to return something else. +%% +%% For reference, the debugger avoids the issue by purging the affected module +%% and interpreting all functions in the module, ensuring that no assumptions +%% are made with regard to return or argument types. -spec breakpoint(MFA, Flag) -> non_neg_integer() when MFA :: {Module :: module(), Function :: atom(), @@ -92,7 +101,7 @@ copy_shared(_) -> -spec get_internal_state(W) -> term() when W :: reds_left | node_and_dist_references | monitoring_nodes - | next_pid | 'DbTable_words' | check_io_debug + | next_pid | 'DbTable_words' | check_io_debug | lc_graph | process_info_args | processes | processes_bif_info | max_atom_out_cache_index | nbalance | available_internal_state | force_heap_frags | memory diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 1d4e37196c..cde03ce1c4 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -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. @@ -545,7 +555,7 @@ allocate(#file_descriptor{module = Module} = Handle, Offset, Length) -> | {no_translation, unicode, latin1}. read(File, Sz) when (is_pid(File) orelse is_atom(File)), is_integer(Sz), Sz >= 0 -> - case io:request(File, {get_chars, '', Sz}) of + case io:request(File, {get_chars, latin1, '', Sz}) of Data when is_list(Data); is_binary(Data) -> {ok, Data}; Other -> @@ -566,7 +576,7 @@ read(_, _) -> | {no_translation, unicode, latin1}. read_line(File) when (is_pid(File) orelse is_atom(File)) -> - case io:request(File, {get_line, ''}) of + case io:request(File, {get_line, latin1, ''}) of Data when is_list(Data); is_binary(Data) -> {ok, Data}; Other -> @@ -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/group.erl b/lib/kernel/src/group.erl index 5625ae6eb7..8c0ced8678 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -795,12 +795,6 @@ save_line({stack, U, _L, D}, Line) -> {stack, U, Line, D}. get_lines(Ls) -> get_all_lines(Ls). -%get_lines({stack, U, {}, []}) -> -% U; -%get_lines({stack, U, {}, D}) -> -% tl(lists:reverse(D, U)); -%get_lines({stack, U, L, D}) -> -% get_lines({stack, U, {}, [L|D]}). %% There's a funny behaviour whenever the line stack doesn't have a "\n" %% at its end -- get_lines() seemed to work on the assumption it *will* be 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/src/user.erl b/lib/kernel/src/user.erl index 5a3487a9ba..81520dd841 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -537,54 +537,6 @@ get_line_doit(Prompt, Port, Q, Accu, Enc) -> binrev(L, T) -> list_to_binary(lists:reverse(L, T)). -%% is_cr_at(Pos,Bin) -> -%% case Bin of -%% <<_:Pos/binary,$\r,_/binary>> -> -%% true; -%% _ -> -%% false -%% end. - -%% collect_line_bin_re(Bin,_Data,Stack,_) -> -%% case re:run(Bin,<<"\n">>) of -%% nomatch -> -%% X = byte_size(Bin)-1, -%% case is_cr_at(X,Bin) of -%% true -> -%% <<D:X/binary,_/binary>> = Bin, -%% [<<$\r>>,D|Stack]; -%% false -> -%% [Bin|Stack] -%% end; -%% {match,[{Pos,1}]} -> -%% PosPlus = Pos + 1, -%% case Stack of -%% [] -> -%% case is_cr_at(Pos - 1,Bin) of -%% false -> -%% <<Head:PosPlus/binary,Tail/binary>> = Bin, -%% {stop, Head, Tail}; -%% true -> -%% PosMinus = Pos - 1, -%% <<Head:PosMinus/binary,_,_,Tail/binary>> = Bin, -%% {stop, binrev([],[Head,$\n]),Tail} -%% end; -%% [<<$\r>>|Stack1] when Pos =:= 0 -> - -%% <<_:PosPlus/binary,Tail/binary>> = Bin, -%% {stop,binrev(Stack1, [$\n]),Tail}; -%% _ -> -%% case is_cr_at(Pos - 1,Bin) of -%% false -> -%% <<Head:PosPlus/binary,Tail/binary>> = Bin, -%% {stop,binrev(Stack, [Head]),Tail}; -%% true -> -%% PosMinus = Pos - 1, -%% <<Head:PosMinus/binary,_,_,Tail/binary>> = Bin, -%% {stop, binrev(Stack,[Head,$\n]),Tail} -%% end -%% end -%% end. %% get_chars(Prompt, Module, Function, XtraArg, Port, Queue, Encoding) %% Gets characters from the input port until the applied function %% returns {stop,Result,RestBuf}. Does not block output until input @@ -618,9 +570,6 @@ get_chars(Prompt, M, F, Xa, Port, Q, State, Enc) -> {Port, eof} -> put(eof, true), {ok, eof, queue:new()}; - %%{io_request,From,ReplyAs,Request} when is_pid(From) -> - %% get_chars_req(Prompt, M, F, Xa, Port, queue:new(), State, - %% Request, From, ReplyAs); {io_request,From,ReplyAs,{get_geometry,_}=Req} when is_pid(From) -> do_io_request(Req, From, ReplyAs, Port, queue:new()), %Keep Q over this call 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..747f1d9e1b 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -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]}, @@ -273,11 +278,11 @@ mini_server(Parent) -> Parent ! {io_request,From,To,{put_chars,Data}}, From ! {io_reply, To, ok}, mini_server(Parent); - {io_request,From,To,{get_chars,'',N}} -> + {io_request,From,To,{get_chars,_Encoding,'',N}} -> Parent ! {io_request,From,To,{get_chars,'',N}}, From ! {io_reply, To, {ok, lists:duplicate(N,$a)}}, mini_server(Parent); - {io_request,From,To,{get_line,''}} -> + {io_request,From,To,{get_line,_Encoding,''}} -> Parent ! {io_request,From,To,{get_line,''}}, From ! {io_reply, To, {ok, "hej\n"}}, mini_server(Parent) @@ -987,6 +992,14 @@ new_modes(Config) when is_list(Config) -> ok end, + % open directory + {ok, Fd9} = ?FILE_MODULE:open(NewDir, [directory]), + ok = ?FILE_MODULE:close(Fd9), + + % open raw directory + {ok, Fd10} = ?FILE_MODULE:open(NewDir, [raw, directory]), + ok = ?FILE_MODULE:close(Fd10), + [] = flush(), ok. @@ -1236,6 +1249,9 @@ open_errors(Config) when is_list(Config) -> {error, E4} = ?FILE_MODULE:open(DataDirSlash, [write]), {eisdir,eisdir,eisdir,eisdir} = {E1,E2,E3,E4}, + Real = filename:join(DataDir, "realmen.html"), + {error, enotdir} = ?FILE_MODULE:open(Real, [directory]), + [] = flush(), ok. @@ -1406,7 +1422,8 @@ file_info_basic_directory(Config) when is_list(Config) -> {win32, _} -> test_directory("/", read_write), test_directory("c:/", read_write), - test_directory("c:\\", read_write); + test_directory("c:\\", read_write), + test_directory("\\\\localhost\\c$", read_write); _ -> test_directory("/", read) end, @@ -1538,6 +1555,180 @@ filter_atime(Atime, Config) -> Atime end. +%% Test read_file_info on I/O devices. + +file_handle_info_basic_file(Config) when is_list(Config) -> + RootDir = proplists:get_value(priv_dir, Config), + + %% Create a short file. + Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_basic_test.fil"), + {ok,Fd1} = ?FILE_MODULE:open(Name, write), + io:put_chars(Fd1, "foo bar"), + ok = ?FILE_MODULE:close(Fd1), + + %% Test that the file has the expected attributes. + %% The times are tricky, so we will save them to a separate test case. + + {ok, Fd} = ?FILE_MODULE:open(Name, read), + {ok,FileInfo} = ?FILE_MODULE:read_file_info(Fd), + ok = ?FILE_MODULE:close(Fd), + + {ok, FdRaw} = ?FILE_MODULE:open(Name, [read, raw]), + {ok,FileInfoRaw} = ?FILE_MODULE:read_file_info(FdRaw), + ok = ?FILE_MODULE:close(FdRaw), + + #file_info{size=Size,type=Type,access=Access, + atime=AccessTime,mtime=ModifyTime} = FileInfo = FileInfoRaw, + io:format("Access ~p, Modify ~p", [AccessTime, ModifyTime]), + Size = 7, + Type = regular, + read_write = Access, + true = abs(time_dist(filter_atime(AccessTime, Config), + filter_atime(ModifyTime, + Config))) < 5, + all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)), + + [] = flush(), + ok. + +file_handle_info_basic_directory(Config) when is_list(Config) -> + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?FILE_MODULE:file_info/1 to work on + %% platforms such as Windows95. + RootDir = filename:join([proplists:get_value(priv_dir, Config)]), + + %% Test that the RootDir directory has the expected attributes. + test_directory_handle(RootDir, read_write), + + %% Note that on Windows file systems, + %% "/" or "c:/" are *NOT* directories. + %% Therefore, test that ?FILE_MODULE:file_info/1 behaves as if they were + %% directories. + case os:type() of + {win32, _} -> + test_directory_handle("/", read_write), + test_directory_handle("c:/", read_write), + test_directory_handle("c:\\", read_write), + test_directory_handle("\\\\localhost\\c$", read_write); + _ -> + test_directory_handle("/", read) + end, + ok. + +test_directory_handle(Name, ExpectedAccess) -> + {ok, DirFd} = file:open(Name, [read, directory]), + try + {ok,FileInfo} = ?FILE_MODULE:read_file_info(DirFd), + {ok,FileInfo} = ?FILE_MODULE:read_file_info(DirFd, [raw]), + #file_info{size=Size,type=Type,access=Access, + atime=AccessTime,mtime=ModifyTime} = FileInfo, + io:format("Testing directory ~s", [Name]), + io:format("Directory size is ~p", [Size]), + io:format("Access ~p", [Access]), + io:format("Access time ~p; Modify time~p", + [AccessTime, ModifyTime]), + Type = directory, + Access = ExpectedAccess, + all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)), + [] = flush(), + ok + after + file:close(DirFd) + end. + +%% Test that the file times behave as they should. + +file_handle_info_times(Config) when is_list(Config) -> + %% We have to try this twice, since if the test runs across the change + %% of a month the time diff calculations will fail. But it won't happen + %% if you run it twice in succession. + test_server:m_out_of_n( + 1,2, + fun() -> file_handle_info_int(Config) end), + ok. + +file_handle_info_int(Config) -> + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?FILE_MODULE:file_info/1 to work on + %% platforms such as Windows95. + + RootDir = filename:join([proplists:get_value(priv_dir, Config)]), + io:format("RootDir = ~p", [RootDir]), + + Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_file_info.fil"), + {ok,Fd1} = ?FILE_MODULE:open(Name, write), + io:put_chars(Fd1,"foo"), + {ok,FileInfo1} = ?FILE_MODULE:read_file_info(Fd1), + ok = ?FILE_MODULE:close(Fd1), + + {ok,Fd1Raw} = ?FILE_MODULE:open(Name, [read, raw]), + {ok,FileInfo1Raw} = ?FILE_MODULE:read_file_info(Fd1Raw), + ok = ?FILE_MODULE:close(Fd1Raw), + + %% We assert that everything but the size is the same, on some OSs the + %% size may not have been flushed to disc and we do not want to do a + %% sync to force it. + FileInfo1Raw = FileInfo1#file_info{ size = FileInfo1Raw#file_info.size }, + + #file_info{type=regular,atime=AccTime1,mtime=ModTime1} = FileInfo1, + + Now = erlang:localtime(), %??? + io:format("Now ~p",[Now]), + io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]), + true = abs(time_dist(filter_atime(Now, Config), + filter_atime(AccTime1, + Config))) < 8, + true = abs(time_dist(Now,ModTime1)) < 8, + + %% Sleep until we can be sure the seconds value has changed. + %% Note: FAT-based filesystem (like on Windows 95) have + %% a resolution of 2 seconds. + timer:sleep(2200), + + %% close the file, and watch the modify date change + + {ok,Fd2} = ?FILE_MODULE:open(Name, read), + {ok,FileInfo2} = ?FILE_MODULE:read_file_info(Fd2), + ok = ?FILE_MODULE:close(Fd2), + + {ok,Fd2Raw} = ?FILE_MODULE:open(Name, [read, raw]), + {ok,FileInfo2Raw} = ?FILE_MODULE:read_file_info(Fd2Raw), + ok = ?FILE_MODULE:close(Fd2Raw), + + #file_info{size=Size,type=regular,access=Access, + atime=AccTime2,mtime=ModTime2} = FileInfo2 = FileInfo2Raw, + io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]), + true = time_dist(ModTime1,ModTime2) >= 0, + + %% this file is supposed to be binary, so it'd better keep it's size + Size = 3, + Access = read_write, + + %% Do some directory checking + + {ok,Fd3} = ?FILE_MODULE:open(RootDir, [read, directory]), + {ok,FileInfo3} = ?FILE_MODULE:read_file_info(Fd3), + ok = ?FILE_MODULE:close(Fd3), + + {ok,Fd3Raw} = ?FILE_MODULE:open(RootDir, [read, directory, raw]), + {ok,FileInfo3Raw} = ?FILE_MODULE:read_file_info(Fd3Raw), + ok = ?FILE_MODULE:close(Fd3Raw), + + #file_info{size=DSize,type=directory,access=DAccess, + atime=AccTime3,mtime=ModTime3} = FileInfo3 = FileInfo3Raw, + %% this dir was modified only a few secs ago + io:format("Dir Acc ~p; Mod ~p; Now ~p", [AccTime3, ModTime3, Now]), + true = abs(time_dist(Now,ModTime3)) < 5, + DAccess = read_write, + io:format("Dir size is ~p",[DSize]), + + [] = flush(), + ok. + %% Test the write_file_info/2 function. file_write_file_info(Config) when is_list(Config) -> diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index 1be016444f..00c9dc5ed5 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -594,10 +594,13 @@ unused_ip() -> io:format("we = ~p, unused_ip = ~p~n", [Hent, IP]), IP. -unused_ip(_, _, _, 255) -> error; +unused_ip(255, 255, 255, 255) -> error; +unused_ip(255, B, C, D) -> unused_ip(1, B + 1, C, D); +unused_ip(A, 255, C, D) -> unused_ip(A, 1, C + 1, D); +unused_ip(A, B, 255, D) -> unused_ip(A, B, 1, D + 1); unused_ip(A, B, C, D) -> case inet:gethostbyaddr({A, B, C, D}) of - {ok, _} -> unused_ip(A, B, C, D+1); + {ok, _} -> unused_ip(A + 1, B, C, D); {error, _} -> {ok, {A, B, C, D}} end. diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 83a94ab087..adbcef955c 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -30,7 +30,7 @@ send/1, distributed_send/1, recv/1, distributed_recv/1, trace_exit/1, distributed_exit/1, call/1, port/1, match_set_seq_token/1, gc_seq_token/1, label_capability_mismatch/1, - send_literal/1]). + send_literal/1,inherit_on_spawn/1,spawn_flag/1]). %% internal exports -export([simple_tracer/2, one_time_receiver/0, one_time_receiver/1, @@ -53,7 +53,8 @@ all() -> distributed_send, recv, distributed_recv, trace_exit, old_heap_token, distributed_exit, call, port, match_set_seq_token, - gc_seq_token, label_capability_mismatch]. + gc_seq_token, label_capability_mismatch, + inherit_on_spawn, spawn_flag]. groups() -> []. @@ -83,14 +84,29 @@ token_set_get(Config) when is_list(Config) -> do_token_set_get(timestamp), do_token_set_get(monotonic_timestamp), do_token_set_get(strict_monotonic_timestamp). - + +-define(SEQ_TRACE_SEND, 1). %(1 << 0) +-define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) +-define(SEQ_TRACE_PRINT, 4). %(1 << 2) +-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4) +-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5) +-define(SEQ_TRACE_SPAWN, 64). %(1 << 6) + do_token_set_get(TsType) -> - io:format("Testing ~p~n", [TsType]), + BaseOpts = ?SEQ_TRACE_SEND bor + ?SEQ_TRACE_RECEIVE bor + ?SEQ_TRACE_PRINT bor + ?SEQ_TRACE_SPAWN, Flags = case TsType of - timestamp -> 15; - strict_monotonic_timestamp -> 23; - monotonic_timestamp -> 39 - end, + timestamp -> + BaseOpts bor ?SEQ_TRACE_NOW_TIMESTAMP; + strict_monotonic_timestamp -> + BaseOpts bor ?SEQ_TRACE_STRICT_MON_TIMESTAMP; + monotonic_timestamp -> + BaseOpts bor ?SEQ_TRACE_MON_TIMESTAMP + end, + ct:pal("Type ~p, flags = ~p~n", [TsType, Flags]), Self = self(), seq_trace:reset_trace(), %% Test that initial seq_trace is disabled @@ -102,6 +118,8 @@ do_token_set_get(TsType) -> {print,true} = seq_trace:get_token(print), false = seq_trace:set_token(send,true), {send,true} = seq_trace:get_token(send), + false = seq_trace:set_token(spawn,true), + {spawn,true} = seq_trace:get_token(spawn), false = seq_trace:set_token('receive',true), {'receive',true} = seq_trace:get_token('receive'), false = seq_trace:set_token(TsType,true), @@ -466,8 +484,6 @@ call(Config) when is_list(Config) -> 1 = erlang:trace(Self, true, [call, set_on_spawn, {tracer, TrB(pid)}]), - Label = 17, - seq_trace:set_token(label, Label), % Token enters here!! RefB = make_ref(), Pid2B = spawn_link( fun() -> @@ -481,6 +497,12 @@ call(Config) when is_list(Config) -> RefB = call_tracee_1(RefB), Pid2B ! {self(), msg, RefB} end), + + %% The token is set *AFTER* spawning to make sure we're testing that the + %% token follows on send and not that it inherits on spawn. + Label = 17, + seq_trace:set_token(label, Label), + Pid1B ! {Self, msg, RefB}, %% The message is passed Self -> Pid1B -> Pid2B -> Self, and the %% seq_trace token follows invisibly. Traced functions are @@ -501,6 +523,62 @@ call(Config) when is_list(Config) -> seq_trace:reset_trace(), ok. +%% The token should follow spawn, just like it follows messages. +inherit_on_spawn(Config) when is_list(Config) -> + seq_trace:reset_trace(), + start_tracer(), + + Ref = make_ref(), + seq_trace:set_token(label,Ref), + set_token_flags([send]), + + Self = self(), + Other = spawn(fun() -> Self ! {gurka,Ref} end), + + receive {gurka,Ref} -> ok end, + seq_trace:reset_trace(), + + [{Ref,{send,_,Other,Self,{gurka,Ref}}, _Ts}] = stop_tracer(1), + + ok. + +spawn_flag(Config) when is_list(Config) -> + seq_trace:reset_trace(), + start_tracer(), + + Ref = make_ref(), + seq_trace:set_token(label,Ref), + set_token_flags([spawn]), + + Self = self(), + + {serial,{0,0}} = seq_trace:get_token(serial), + + %% The serial number is bumped on spawning (just like message passing), so + %% our child should inherit a counter of 1. + ProcessA = spawn(fun() -> + {serial,{0,1}} = seq_trace:get_token(serial), + Self ! {a,Ref} + end), + receive {a,Ref} -> ok end, + + {serial,{1,2}} = seq_trace:get_token(serial), + + ProcessB = spawn(fun() -> + {serial,{2,3}} = seq_trace:get_token(serial), + Self ! {b,Ref} + end), + receive {b,Ref} -> ok end, + + {serial,{3,4}} = seq_trace:get_token(serial), + + seq_trace:reset_trace(), + + [{Ref,{spawn,{0,1},Self,ProcessA,[]}, _Ts}, + {Ref,{spawn,{2,3},Self,ProcessB,[]}, _Ts}] = stop_tracer(2), + + ok. + %% Send trace messages to a port. port(Config) when is_list(Config) -> lists:foreach(fun (TsType) -> do_port(TsType, Config) end, @@ -938,7 +1016,7 @@ stop_tracer(N) when is_integer(N) -> receive {tracerlog,Data} -> Data - after 1000 -> + after 5000 -> {error,timeout} end end. diff --git a/lib/megaco/Makefile b/lib/megaco/Makefile index f385df6a5c..624c4b0619 100644 --- a/lib/megaco/Makefile +++ b/lib/megaco/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2019. All Rights Reserved. +# Copyright Ericsson AB 1999-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -110,7 +110,7 @@ DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: reconf conf dconf econf configure setup info version \ +.PHONY: reconf conf dconf econf configure setup info_megaco version \ app_install dialyzer reconf: @@ -136,16 +136,15 @@ configure: configure.in setup: (cd src && $(MAKE) $@) -info: +info_megaco: @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" @echo "APP_DIR: $(APP_DIR)" @echo "APP_TAR_FILE: $(APP_TAR_FILE)" @echo "OTP_INSTALL_DIR: $(OTP_INSTALL_DIR)" @echo "APP_INSTALL_DIR: $(APP_INSTALL_DIR)" @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" + +info: info_megaco version: @echo "$(VSN)" @@ -204,25 +203,6 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd "$(APP_RELEASE_DIR)"; gtar zcf "$(subst $(space),\ ,$@)" $(DIR_NAME)) -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): Makefile - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - ../../lib/kernel/ebin \ - ../../lib/stdlib/ebin \ - ../../lib/runtime_tools/ebin \ - ../../lib/asn1/ebin \ - ../../lib/debugger/ebin \ - ../../lib/et/ebin \ - ../../erts/preloaded/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose - -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +DIA_PLT_APPS=asn1 runtime_tools et debugger + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/mnesia/Makefile b/lib/mnesia/Makefile index 810433c4d0..d0edd48af9 100644 --- a/lib/mnesia/Makefile +++ b/lib/mnesia/Makefile @@ -38,3 +38,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/mnesia/src/mnesia_text.erl b/lib/mnesia/src/mnesia_text.erl index cc21621ff4..ee31fdfd27 100644 --- a/lib/mnesia/src/mnesia_text.erl +++ b/lib/mnesia/src/mnesia_text.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -170,7 +170,7 @@ read_terms(Stream, File, Line, L) -> end. read_term_from_stream(Stream, File, Line) -> - R = io:request(Stream, {get_until,'',erl_scan,tokens,[Line]}), + R = io:request(Stream, {get_until,latin1,'',erl_scan,tokens,[Line]}), case R of {ok,Toks,EndLine} -> case erl_parse:parse_term(Toks) of diff --git a/lib/observer/Makefile b/lib/observer/Makefile index 8483922f76..ffd73051b9 100644 --- a/lib/observer/Makefile +++ b/lib/observer/Makefile @@ -36,4 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=runtime_tools et wx +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index 33133dd78d..f8bb2e5eb0 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -658,11 +658,13 @@ seq_trace(Config) when is_list(Config) -> ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-seq_trace")]), ?line [{trace_ts,StartProc,call,{?MODULE,seq,[]},{_,_,_}}, - {seq_trace,0,{send,{0,1},StartProc,P1Proc,{Start,P2}}}, - {seq_trace,0,{send,{1,2},P1Proc,P2Proc,{P1,Start}}}, - {seq_trace,0,{send,{2,3},P2Proc,StartProc,{P2,P1}}}, + {seq_trace,0,{send,{First, Seq0},StartProc,P1Proc,{Start,P2}}}, + {seq_trace,0,{send,{Seq0, Seq1},P1Proc,P2Proc,{P1,Start}}}, + {seq_trace,0,{send,{Seq1, Last},P2Proc,StartProc,{P2,P1}}}, end_of_trace] = flush(), - + true = First < Seq0, + true = Seq0 < Seq1, + true = Seq1 < Last, %% Additional test for metatrace case StartProc of {Start,_,_} -> ok; diff --git a/lib/odbc/Makefile b/lib/odbc/Makefile index f7816c25fc..ee39992a84 100644 --- a/lib/odbc/Makefile +++ b/lib/odbc/Makefile @@ -69,12 +69,6 @@ do_configure: configure configure: configure.in autoconf -.PHONY: info - -info: - @echo "ODBC_VSN: $(ODBC_VSN)" - - # ---------------------------------------------------- # Application (source) release targets # ---------------------------------------------------- @@ -114,3 +108,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/os_mon/Makefile b/lib/os_mon/Makefile index 40ce94e0c7..f45065a79d 100644 --- a/lib/os_mon/Makefile +++ b/lib/os_mon/Makefile @@ -35,3 +35,4 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/os_mon/test/cpu_sup_SUITE.erl b/lib/os_mon/test/cpu_sup_SUITE.erl index ba28f31f26..7a8065c591 100644 --- a/lib/os_mon/test/cpu_sup_SUITE.erl +++ b/lib/os_mon/test/cpu_sup_SUITE.erl @@ -155,46 +155,72 @@ tiny_diff(A, B) -> -define(SPIN_TIME, 1000). +spinner(Parent) -> + receive + stop -> Parent ! stopped + after 0 -> spinner(Parent) + end. + %% Test utilization values util_values(Config) when is_list(Config) -> - + NrOfProcessors = + case erlang:system_info(logical_processors_available) of + unknown -> 2; + X -> X + end, Tester = self(), Ref = make_ref(), - Loop = fun (L) -> L(L) end, Spinner = fun () -> - Looper = spawn_link(fun () -> Loop(Loop) end), + Spinner = self(), + NrOfProcesses = NrOfProcessors, + Loopers = + [spawn_link(fun () -> spinner(Spinner) end) + || _ <- lists:seq(1,NrOfProcesses)], receive after ?SPIN_TIME -> ok end, - unlink(Looper), - exit(Looper, kill), + [begin + Looper ! stop, + receive stopped -> ok end + end + || Looper <- Loopers], Tester ! Ref end, - + Spin = fun () -> + spawn_link(Spinner), + receive Ref -> ok end + end, cpu_sup:util(), - - spawn_link(Spinner), - receive Ref -> ok end, - HighUtil1 = cpu_sup:util(), - receive after ?SPIN_TIME -> ok end, - LowUtil1 = cpu_sup:util(), + LowUtil0 = cpu_sup:util(), + case LowUtil0 of + U when U > ((100.0 / NrOfProcessors) * 0.33) -> + %% We cannot run this test if the system is doing other + %% work at the same time as the result will be unreliable + {skip, io_lib:format("CPU utilization was too high (~f%)", [LowUtil0])}; + _ -> + cpu_sup:util(), + Spin(), + HighUtil1 = cpu_sup:util(), - spawn_link(Spinner), - receive Ref -> ok end, - HighUtil2 = cpu_sup:util(), + receive after ?SPIN_TIME -> ok end, + LowUtil1 = cpu_sup:util(), - receive after ?SPIN_TIME -> ok end, - LowUtil2 = cpu_sup:util(), + Spin(), + HighUtil2 = cpu_sup:util(), - Utils = [{high1,HighUtil1}, {low1,LowUtil1}, - {high2,HighUtil2}, {low2,LowUtil2}], - io:format("Utils: ~p~n", [Utils]), + receive after ?SPIN_TIME -> ok end, + LowUtil2 = cpu_sup:util(), - false = LowUtil1 > HighUtil1, - false = LowUtil1 > HighUtil2, - false = LowUtil2 > HighUtil1, - false = LowUtil2 > HighUtil2, + Utils = [{high1,HighUtil1}, {low1,LowUtil1}, + {high2,HighUtil2}, {low2,LowUtil2}], + io:format("Utils: ~p~n", [Utils]), - ok. + false = LowUtil1 > HighUtil1, + false = LowUtil1 > HighUtil2, + false = LowUtil2 > HighUtil1, + false = LowUtil2 > HighUtil2, + + ok + end. % Outdated diff --git a/lib/parsetools/Makefile b/lib/parsetools/Makefile index e9de5c43cb..2ddb06feb1 100644 --- a/lib/parsetools/Makefile +++ b/lib/parsetools/Makefile @@ -37,3 +37,4 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/parsetools/doc/src/leex.xml b/lib/parsetools/doc/src/leex.xml index 3b82f60201..3944c650d8 100644 --- a/lib/parsetools/doc/src/leex.xml +++ b/lib/parsetools/doc/src/leex.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2009</year><year>2017</year> + <year>2009</year><year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -193,7 +193,7 @@ Token = tuple()</code> but used through the i/o system where it can typically be called in an application by:</p> <code> -io:request(InFile, {get_until,Prompt,Module,token,[Line]}) +io:request(InFile, {get_until,unicode,Prompt,Module,token,[Line]}) -> TokenRet</code> </desc> </func> @@ -240,7 +240,7 @@ io:request(InFile, {get_until,Prompt,Module,token,[Line]}) but used through the i/o system where it can typically be called in an application by:</p> <code> -io:request(InFile, {get_until,Prompt,Module,tokens,[Line]}) +io:request(InFile, {get_until,unicode,Prompt,Module,tokens,[Line]}) -> TokensRet</code> </desc> </func> diff --git a/lib/public_key/Makefile b/lib/public_key/Makefile index 7a5c1c1443..ed8901a8af 100644 --- a/lib/public_key/Makefile +++ b/lib/public_key/Makefile @@ -38,3 +38,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=asn crypto + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/reltool/Makefile b/lib/reltool/Makefile index 4b6aad07b3..0a39d7daa8 100644 --- a/lib/reltool/Makefile +++ b/lib/reltool/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=wx sasl + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/runtime_tools/Makefile b/lib/runtime_tools/Makefile index eec1ff379b..4b0f1633ab 100644 --- a/lib/runtime_tools/Makefile +++ b/lib/runtime_tools/Makefile @@ -36,4 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=mnesia +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/sasl/Makefile b/lib/sasl/Makefile index 065eb45fbb..06af80fd35 100644 --- a/lib/sasl/Makefile +++ b/lib/sasl/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=tools + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/sasl/src/systools_lib.erl b/lib/sasl/src/systools_lib.erl index dd97aeff08..f5489e7900 100644 --- a/lib/sasl/src/systools_lib.erl +++ b/lib/sasl/src/systools_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -63,8 +63,8 @@ read_term(File) -> end. read_term_from_stream(Stream, File) -> - _ = epp:set_encoding(Stream), - R = io:request(Stream, {get_until,'',erl_scan,tokens,[1]}), + Encoding = epp:set_encoding(Stream), + R = io:request(Stream, {get_until,Encoding,'',erl_scan,tokens,[1]}), case R of {ok,Toks,_EndLine} -> case erl_parse:parse_term(Toks) of diff --git a/lib/snmp/Makefile b/lib/snmp/Makefile index df321fc2d1..52debf1670 100644 --- a/lib/snmp/Makefile +++ b/lib/snmp/Makefile @@ -2,7 +2,7 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2019. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -71,24 +71,6 @@ do_configure: configure configure: configure.in autoconf -.PHONY: info gclean - -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "SNMP_VSN: $(SNMP_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" - - -gclean: - git clean -fXd - - # ---------------------------------------------------- # Application (source) release targets # ---------------------------------------------------- @@ -130,28 +112,6 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): Makefile - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - ../../lib/kernel/ebin \ - ../../lib/stdlib/ebin \ - ../../lib/runtime_tools/ebin \ - ../../lib/crypto/ebin \ - ../../lib/mnesia/ebin \ - ../../erts/preloaded/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose - -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +DIA_PLT_APPS=runtime_tools crypto mnesia + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/snmp/src/compile/snmpc_misc.erl b/lib/snmp/src/compile/snmpc_misc.erl index 312074f2e7..d0fee418e1 100644 --- a/lib/snmp/src/compile/snmpc_misc.erl +++ b/lib/snmp/src/compile/snmpc_misc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. +%% Copyright Ericsson AB 2003-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. @@ -156,7 +156,8 @@ loop(Fd, Res, Func, StartLine, File) -> %% io:read modified to give us line numbers. %%----------------------------------------------------------------- read(Io, Prompt, StartLine) -> - case io:request(Io, {get_until, Prompt, erl_scan, tokens, [StartLine]}) of + Enc = latin1, + case io:request(Io, {get_until, Enc, Prompt, erl_scan, tokens, [StartLine]}) of {ok, Toks, EndLine} -> case erl_parse:parse_term(Toks) of {ok, Term} -> diff --git a/lib/snmp/src/misc/snmp_conf.erl b/lib/snmp/src/misc/snmp_conf.erl index 20b7af0373..bec9d4d9d9 100644 --- a/lib/snmp/src/misc/snmp_conf.erl +++ b/lib/snmp/src/misc/snmp_conf.erl @@ -265,7 +265,8 @@ open_file(File) -> end. do_read(Io, Prompt, StartLine) -> - case io:request(Io, {get_until,Prompt,erl_scan,tokens,[StartLine]}) of + Enc = latin1, + case io:request(Io, {get_until,Enc,Prompt,erl_scan,tokens,[StartLine]}) of {ok, Toks, EndLine} -> case erl_parse:parse_term(Toks) of {ok, Term} -> diff --git a/lib/snmp/src/misc/snmp_config.erl b/lib/snmp/src/misc/snmp_config.erl index 3104f2a096..5aab9a74e0 100644 --- a/lib/snmp/src/misc/snmp_config.erl +++ b/lib/snmp/src/misc/snmp_config.erl @@ -2737,7 +2737,8 @@ read_lines(Fd, Acc, StartLine) -> end. read_and_parse_term(Fd, StartLine) -> - case io:request(Fd, {get_until, "", erl_scan, tokens, [StartLine]}) of + Enc = latin1, + case io:request(Fd, {get_until, Enc, "", erl_scan, tokens, [StartLine]}) of {ok, Tokens, EndLine} -> case erl_parse:parse_term(Tokens) of {ok, Term} -> diff --git a/lib/ssh/Makefile b/lib/ssh/Makefile index dedc7ac3a6..b96cc2bbaa 100644 --- a/lib/ssh/Makefile +++ b/lib/ssh/Makefile @@ -37,4 +37,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=crypto runtime_tools public_key +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/ssl/Makefile b/lib/ssl/Makefile index bd43794a36..526560288f 100644 --- a/lib/ssl/Makefile +++ b/lib/ssl/Makefile @@ -38,4 +38,6 @@ SPECIAL_TARGETS = # include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=crypto runtime_tools inets public_key +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/stdlib/Makefile b/lib/stdlib/Makefile index 3086d85445..cae3844126 100644 --- a/lib/stdlib/Makefile +++ b/lib/stdlib/Makefile @@ -35,3 +35,7 @@ SPECIAL_TARGETS = # Default Subdir Targets # include $(ERL_TOP)/make/otp_subdir.mk + +DIA_PLT_APPS=compiler crypto + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/stdlib/doc/src/erl_parse.xml b/lib/stdlib/doc/src/erl_parse.xml index 8142e5c0aa..d487cccdfc 100644 --- a/lib/stdlib/doc/src/erl_parse.xml +++ b/lib/stdlib/doc/src/erl_parse.xml @@ -69,6 +69,25 @@ <name name="erl_parse_tree"></name> </datatype> <datatype> + <name>af_binelement(_)</name> + <desc> + <p>Abstract representation of an element of a bitstring.</p> + </desc> + </datatype> + <datatype> + <name>af_generator()</name> + <desc> + <p>Abstract representation of a generator + or a bitstring generator.</p> + </desc> + </datatype> + <datatype> + <name>af_remote_function()></name> + <desc> + <p>Abstract representation of a remote function call.</p> + </desc> + </datatype> + <datatype> <name name="error_description"></name> </datatype> <datatype> diff --git a/lib/stdlib/doc/src/io_protocol.xml b/lib/stdlib/doc/src/io_protocol.xml index 84b5f62c7f..f05c358866 100644 --- a/lib/stdlib/doc/src/io_protocol.xml +++ b/lib/stdlib/doc/src/io_protocol.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1999</year> - <year>2016</year> + <year>2019</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -168,16 +168,6 @@ ok returns it "as is".</item> </list> - <p>For backward compatibility, the following <c>Request</c>s are also to be - handled by an I/O server (they are not to be present after - Erlang/OTP R15B):</p> - - <pre> -{put_chars, Characters} -{put_chars, Module, Function, Args}</pre> - - <p>These are to behave as <c>{put_chars, latin1, Characters}</c> and - <c>{put_chars, latin1, Module, Function, Args}</c>, respectively.</p> </section> <section> @@ -332,19 +322,6 @@ eof </item> </list> - <p>For backward compatibility, the following <c>Request</c>s are also to be - handled by an I/O server (they are not to be present after - Erlang/OTP R15B):</p> - - <pre> -{get_until, Prompt, Module, Function, ExtraArgs} -{get_chars, Prompt, N} -{get_line, Prompt}</pre> - - <p>These are to behave as - <c>{get_until, latin1, Prompt, Module, Function, ExtraArgs}</c>, - <c>{get_chars, latin1, Prompt, N}</c>, and - <c>{get_line, latin1, Prompt}</c>, respectively.</p> </section> <section> @@ -637,24 +614,6 @@ request({requests, Reqs}, State) -> function applying the requests in the list one after another, returning the last result.</p> - <p>We need to handle backward compatibility and the - <seealso marker="kernel:file"><c>file</c></seealso> module (which - uses the old requests until backward compatibility with pre-R13 nodes is - no longer needed). Notice that the I/O server does not work with a simple - <c>file:write/2</c> if these are not added:</p> - - <code> -request({put_chars,Chars}, State) -> - request({put_chars,latin1,Chars}, State); -request({put_chars,M,F,As}, State) -> - request({put_chars,latin1,M,F,As}, State); -request({get_chars,Prompt,N}, State) -> - request({get_chars,latin1,Prompt,N}, State); -request({get_line,Prompt}, State) -> - request({get_line,latin1,Prompt}, State); -request({get_until, Prompt,M,F,As}, State) -> - request({get_until,latin1,Prompt,M,F,As}, State);</code> - <p><c>{error, request}</c> must be returned if the request is not recognized:</p> diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index f027d05f55..6078c5e67b 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -352,9 +352,6 @@ do_op({blink,C,M}, Bef=[$$,$$|_], Aft, Rs) -> %% don't blink after a $ do_op({blink,C,_}, Bef=[$$|_], Aft, Rs) -> do_op({insert,C}, Bef, Aft, Rs); -%do_op({blink,C,M}, Bef, [], Rs) -> -% N = over_paren(Bef, C, M), -% {blink,N+1,{[C|Bef],[]},[{move_rel,-(N+1)},{put_chars,[C]}|Rs]}; do_op({blink,C,M}, Bef, Aft, Rs) -> case over_paren(Bef, C, M) of beep -> 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/src/io.erl b/lib/stdlib/src/io.erl index 63c9a6bddf..1848aa3628 100644 --- a/lib/stdlib/src/io.erl +++ b/lib/stdlib/src/io.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2018. All Rights Reserved. +%% Copyright Ericsson AB 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. @@ -106,7 +106,6 @@ nl() -> IoDevice :: device(). nl(Io) -> -% o_request(Io, {put_chars,io_lib:nl()}). o_request(Io, nl, nl). -spec columns() -> {'ok', pos_integer()} | {'error', 'enotsup'}. @@ -255,8 +254,6 @@ read(Io, Prompt) -> case request(Io, {get_until,unicode,Prompt,erl_scan,tokens,[1]}) of {ok,Toks,_EndLine} -> erl_parse:parse_term(Toks); -% {error, Reason} when atom(Reason) -> -% erlang:error(conv_reason(read, Reason), [Io, Prompt]); {error,E,_EndLine} -> {error,E}; {eof,_EndLine} -> @@ -352,12 +349,7 @@ fread(Prompt, Format) -> | server_no_data(). fread(Io, Prompt, Format) -> - case request(Io, {fread,Prompt,Format}) of -% {error, Reason} when atom(Reason) -> -% erlang:error(conv_reason(fread, Reason), [Io, Prompt, Format]); - Other -> - Other - end. + request(Io, {fread,Prompt,Format}). -spec format(Format) -> 'ok' when Format :: format(). diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 21d66c5529..e2823b70f2 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -78,7 +78,7 @@ %% Utilities for collecting characters. -export([collect_chars/3, collect_chars/4, - collect_line/2, collect_line/3, collect_line/4, + collect_line/3, collect_line/4, get_until/3, get_until/4]). %% The following functions were used by Yecc's include-file. @@ -851,6 +851,7 @@ collect_chars({binary,Stack,N}, Data,latin1, _) -> end; collect_chars({list,Stack,N}, Data, _,_) -> collect_chars_list(Stack, N, Data); + %% collect_chars(Continuation, MoreChars, Count) %% Returns: %% {done,Result,RestChars} @@ -881,32 +882,6 @@ collect_chars_list(Stack, N, []) -> collect_chars_list(Stack,N, [H|T]) -> collect_chars_list([H|Stack], N-1, T). -%% collect_line(Continuation, MoreChars) -%% Returns: -%% {done,Result,RestChars} -%% {more,Continuation} -%% -%% XXX Can be removed when compatibility with pre-R12B-5 nodes -%% is no longer required. -%% -collect_line([], Chars) -> - collect_line1(Chars, []); -collect_line({SoFar}, More) -> - collect_line1(More, SoFar). - -collect_line1([$\r, $\n|Rest], Stack) -> - collect_line1([$\n|Rest], Stack); -collect_line1([$\n|Rest], Stack) -> - {done,lists:reverse([$\n|Stack], []),Rest}; -collect_line1([C|Rest], Stack) -> - collect_line1(Rest, [C|Stack]); -collect_line1(eof, []) -> - {done,eof,[]}; -collect_line1(eof, Stack) -> - {done,lists:reverse(Stack, []),[]}; -collect_line1([], Stack) -> - {more,{Stack}}. - %% collect_line(State, Data, _). New in R9C. %% Returns: %% {stop,Result,RestData} diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl index 77f02eafe0..838d412d0c 100644 --- a/lib/stdlib/src/io_lib_pretty.erl +++ b/lib/stdlib/src/io_lib_pretty.erl @@ -895,9 +895,6 @@ write_string(S, _Uni) -> io_lib:write_string(S, $"). %" expand({_, _, _Dots=0, no_more} = If, _T, _Dd) -> If; -%% expand({{list,L}, _Len, _, no_more}, T, Dd) -> -%% {NL, NLen, NDots} = expand_list(L, T, Dd, 2), -%% {{list,NL}, NLen, NDots, no_more}; expand({{tuple,IsTagged,L}, _Len, _, no_more}, T, Dd) -> {NL, NLen, NDots} = expand_list(L, T, Dd, 2), {{tuple,IsTagged,NL}, NLen, NDots, no_more}; diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 09238ae2b4..b23cdf5900 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], @@ -4854,7 +4984,7 @@ tabfile_ext4(Config) when is_list(Config) -> {error,Y} = ets:file2tab(FName,[{verify,true}]), ets:tab2file(TL,FName,[{extended_info,[md5sum]}]), {X,Y} - end || N <- lists:seq(500,600)], + end || N <- lists:seq(700,800)], io:format("~p~n",[Res]), file:delete(FName) end), 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/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl index e497b2fb5d..df6958cfa9 100644 --- a/lib/stdlib/test/io_proto_SUITE.erl +++ b/lib/stdlib/test/io_proto_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2017. All Rights Reserved. +%% Copyright Ericsson AB 2009-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. @@ -1568,10 +1568,6 @@ request({put_chars, Encoding, Chars}, State) -> request({put_chars, Encoding, Module, Function, Args}, State) -> {ok, ok, State#state{q=[{put_chars, Encoding, Module, Function, Args} | State#state.q ]}}; -request({put_chars,Chars}, State) -> - {ok, ok, State#state{q=[{put_chars, Chars} | State#state.q ]}}; -request({put_chars,M,F,As}, State) -> - {ok, ok, State#state{q=[{put_chars, M,F,As} | State#state.q ]}}; request({get_until, Encoding, Prompt, M, F, As}, State) -> {ok, convert(State#state.nxt, Encoding, State#state.mode), State#state{nxt = eof, q = [{get_until, Encoding, Prompt, M, F, As} | State#state.q]}}; request({get_chars, Encoding, Prompt, N}, State) -> @@ -1583,20 +1579,6 @@ request({get_line, Encoding, Prompt}, State) -> State#state{nxt = eof, q = [{get_line, Encoding, Prompt} | State#state.q]}}; -request({get_until, Prompt, M, F, As}, State) -> - {ok, convert(State#state.nxt, latin1, State#state.mode), - State#state{nxt = eof, - q = [{get_until, Prompt, M, F, As} | State#state.q]}}; -request({get_chars, Prompt, N}, State) -> - {ok, convert(State#state.nxt, latin1, State#state.mode), - State#state{nxt = eof, - q = [{get_chars, Prompt, N} | - State#state.q]}}; -request({get_line, Prompt}, State) -> - {ok, convert(State#state.nxt, latin1, State#state.mode), - State#state{nxt = eof, - q = [{get_line, Prompt} | - State#state.q]}}; request({get_geomentry,_}, State) -> {error, {error,enotsup}, State}; request({setopts, Opts}, State) when Opts =:= [{binary, false}]; Opts =:= [list] -> diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index cdb6031b07..4d85e1f04b 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -3141,25 +3141,16 @@ io_request({get_geometry,columns}, S) -> {ok,80,S}; io_request({get_geometry,rows}, S) -> {ok,24,S}; -io_request({put_chars,Chars}, S) -> - {ok,ok,S#state{reply = [S#state.reply | Chars]}}; io_request({put_chars,latin1,Chars}, S) -> {ok,ok,S#state{reply = [S#state.reply | Chars]}}; io_request({put_chars,unicode,Chars0}, S) -> Chars = unicode:characters_to_list(Chars0), {ok,ok,S#state{reply = [S#state.reply | Chars]}}; -io_request({put_chars,Mod,Func,Args}, S) -> - case catch apply(Mod, Func, Args) of - Chars when is_list(Chars) -> - io_request({put_chars,Chars}, S) - end; io_request({put_chars,Enc,Mod,Func,Args}, S) -> case catch apply(Mod, Func, Args) of Chars when is_list(Chars) -> io_request({put_chars,Enc,Chars}, S) end; -io_request({get_until,_Prompt,Mod,Func,ExtraArgs}, S) -> - get_until(Mod, Func, ExtraArgs, S, latin1); io_request({get_until,Enc,_Prompt,Mod,Func,ExtraArgs}, S) -> get_until(Mod, Func, ExtraArgs, S, Enc). diff --git a/lib/syntax_tools/Makefile b/lib/syntax_tools/Makefile index 14ae6d4f97..d3e2aa9b2c 100644 --- a/lib/syntax_tools/Makefile +++ b/lib/syntax_tools/Makefile @@ -91,3 +91,5 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 7e741cc649..da22a91de0 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -598,8 +598,6 @@ skip_macro_args([{'receive',_}=T | Ts], Es, As) -> skip_macro_args(Ts, ['end' | Es], [T | As]); skip_macro_args([{'try',_}=T | Ts], Es, As) -> skip_macro_args(Ts, ['end' | Es], [T | As]); -skip_macro_args([{'cond',_}=T | Ts], Es, As) -> - skip_macro_args(Ts, ['end' | Es], [T | As]); skip_macro_args([{E,_}=T | Ts], [E], As) -> %final close {lists:reverse([T | As]), Ts}; skip_macro_args([{E,_}=T | Ts], [E | Es], As) -> %matching close diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index 6ad9bec2e6..d70dd40a8a 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -53,7 +53,7 @@ -type hook() :: 'none' | fun((erl_syntax:syntaxTree(), _, _) -> prettypr:document()). --type clause_t() :: 'case_expr' | 'cond_expr' | 'fun_expr' +-type clause_t() :: 'case_expr' | 'fun_expr' | 'if_expr' | 'receive_expr' | 'try_expr' | {'function', prettypr:document()} | 'spec'. @@ -586,8 +586,6 @@ lay_2(Node, Ctxt) -> make_fun_clause(N, D1, D2, D3, Ctxt); if_expr -> make_if_clause(D1, D2, D3, Ctxt); - cond_expr -> - make_if_clause(D1, D2, D3, Ctxt); case_expr -> make_case_clause(D1, D2, D3, Ctxt); receive_expr -> @@ -627,14 +625,6 @@ lay_2(Node, Ctxt) -> sep([follow(text("if"), D, Ctxt1#ctxt.sub_indent), text("end")]); - cond_expr -> - Ctxt1 = reset_prec(Ctxt), - D = lay_clauses(erl_syntax:cond_expr_clauses(Node), - cond_expr, Ctxt1), - sep([text("cond"), - nest(Ctxt1#ctxt.sub_indent, D), - text("end")]); - fun_expr -> Ctxt1 = reset_prec(Ctxt), D = lay_clauses(erl_syntax:fun_expr_clauses(Node), diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 1be644c620..1c0c532323 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -183,8 +183,6 @@ comment/2, comment_padding/1, comment_text/1, - cond_expr/1, - cond_expr_clauses/1, conjunction/1, conjunction_body/1, constrained_function_type/2, @@ -431,6 +429,7 @@ -record(tree, {type :: atom(), attr = #attr{} :: #attr{}, data :: term()}). +-type tree() :: #tree{}. %% `wrapper' records are used for attaching new-form node information to %% `erl_parse' trees. @@ -446,18 +445,20 @@ -record(wrapper, {type :: atom(), attr = #attr{} :: #attr{}, tree :: erl_parse()}). +-type wrapper() :: #wrapper{}. %% ===================================================================== --type syntaxTree() :: #tree{} | #wrapper{} | erl_parse(). +-type syntaxTree() :: tree() | wrapper() | erl_parse(). -type erl_parse() :: erl_parse:abstract_clause() | erl_parse:abstract_expr() | erl_parse:abstract_form() | erl_parse:abstract_type() | erl_parse:form_info() - %% To shut up Dialyzer: - | {bin_element, _, _, _, _}. + | erl_parse:af_binelement(term()) + | erl_parse:af_generator() + | erl_parse:af_remote_function(). %% The representation built by the Erlang standard library parser %% `erl_parse'. This is a subset of the {@link syntaxTree()} type. @@ -494,39 +495,38 @@ %% <td>class_qualifier</td> %% <td>clause</td> %% <td>comment</td> -%% <td>cond_expr</td> -%% </tr><tr> %% <td>conjunction</td> +%% </tr><tr> %% <td>constrained_function_type</td> %% <td>constraint</td> %% <td>disjunction</td> -%% </tr><tr> %% <td>eof_marker</td> +%% </tr><tr> %% <td>error_marker</td> %% <td>float</td> %% <td>form_list</td> -%% </tr><tr> %% <td>fun_expr</td> +%% </tr><tr> %% <td>fun_type</td> %% <td>function</td> %% <td>function_type</td> -%% </tr><tr> %% <td>generator</td> +%% </tr><tr> %% <td>if_expr</td> %% <td>implicit_fun</td> %% <td>infix_expr</td> -%% </tr><tr> %% <td>integer</td> +%% </tr><tr> %% <td>integer_range_type</td> %% <td>list</td> %% <td>list_comp</td> -%% </tr><tr> %% <td>macro</td> +%% </tr><tr> %% <td>map_expr</td> %% <td>map_field_assoc</td> %% <td>map_field_exact</td> -%% </tr><tr> %% <td>map_type</td> +%% </tr><tr> %% <td>map_type_assoc</td> %% <td>map_type_exact</td> %% <td>match_expr</td> @@ -556,6 +556,7 @@ %% <td>tuple_type</td> %% <td>typed_record_field</td> %% <td>type_application</td> +%% </tr><tr> %% <td>type_union</td> %% <td>underscore</td> %% <td>user_type_application</td> @@ -587,7 +588,6 @@ %% @see class_qualifier/2 %% @see clause/3 %% @see comment/2 -%% @see cond_expr/1 %% @see conjunction/1 %% @see constrained_function_type/2 %% @see constraint/2 @@ -673,7 +673,6 @@ type(Node) -> %% Composite types {'case', _, _, _} -> case_expr; {'catch', _, _} -> catch_expr; - {'cond', _, _} -> cond_expr; {'fun', _, {clauses, _}} -> fun_expr; {named_fun, _, _, _} -> named_fun_expr; {'fun', _, {function, _, _}} -> implicit_fun; @@ -6290,7 +6289,6 @@ if_expr_clauses(Node) -> %% @see case_expr_argument/1 %% @see clause/3 %% @see if_expr/1 -%% @see cond_expr/1 -record(case_expr, {argument :: syntaxTree(), clauses :: [syntaxTree()]}). @@ -6357,60 +6355,6 @@ case_expr_clauses(Node) -> %% ===================================================================== -%% @doc Creates an abstract cond-expression. If `Clauses' is -%% `[C1, ..., Cn]', the result represents "<code>cond -%% <em>C1</em>; ...; <em>Cn</em> end</code>". More exactly, if each -%% `Ci' represents "<code>() <em>Ei</em> -> -%% <em>Bi</em></code>", then the result represents "<code>cond -%% <em>E1</em> -> <em>B1</em>; ...; <em>En</em> -> <em>Bn</em> -%% end</code>". -%% -%% @see cond_expr_clauses/1 -%% @see clause/3 -%% @see case_expr/2 - -%% type(Node) = cond_expr -%% data(Node) = Clauses -%% -%% Clauses = [syntaxTree()] -%% -%% `erl_parse' representation: -%% -%% {'cond', Pos, Clauses} -%% -%% Clauses = [Clause] \ [] -%% Clause = {clause, ...} -%% -%% See `clause' for documentation on `erl_parse' clauses. - --spec cond_expr([syntaxTree()]) -> syntaxTree(). - -cond_expr(Clauses) -> - tree(cond_expr, Clauses). - -revert_cond_expr(Node) -> - Pos = get_pos(Node), - Clauses = [revert_clause(C) || C <- cond_expr_clauses(Node)], - {'cond', Pos, Clauses}. - - -%% ===================================================================== -%% @doc Returns the list of clause subtrees of a `cond_expr' node. -%% -%% @see cond_expr/1 - --spec cond_expr_clauses(syntaxTree()) -> [syntaxTree()]. - -cond_expr_clauses(Node) -> - case unwrap(Node) of - {'cond', _, Clauses} -> - Clauses; - Node1 -> - data(Node1) - end. - - -%% ===================================================================== %% @equiv receive_expr(Clauses, none, []) -spec receive_expr([syntaxTree()]) -> syntaxTree(). @@ -7534,8 +7478,6 @@ revert_root(Node) -> revert_char(Node); clause -> revert_clause(Node); - cond_expr -> - revert_cond_expr(Node); constrained_function_type -> revert_constrained_function_type(Node); constraint -> @@ -7802,8 +7744,6 @@ subtrees(T) -> [clause_patterns(T), [G], clause_body(T)] end; - cond_expr -> - [cond_expr_clauses(T)]; conjunction -> [conjunction_body(T)]; constrained_function_type -> @@ -8017,7 +7957,6 @@ make_tree(class_qualifier, [[A], [B]]) -> class_qualifier(A, B); make_tree(class_qualifier, [[A], [B], [C]]) -> class_qualifier(A, B, C); make_tree(clause, [P, B]) -> clause(P, none, B); make_tree(clause, [P, [G], B]) -> clause(P, G, B); -make_tree(cond_expr, [C]) -> cond_expr(C); make_tree(conjunction, [E]) -> conjunction(E); make_tree(constrained_function_type, [[F],C]) -> constrained_function_type(F, C); @@ -8239,7 +8178,7 @@ meta_call(F, As) -> %% ===================================================================== %% @equiv tree(Type, []) --spec tree(atom()) -> #tree{}. +-spec tree(atom()) -> tree(). tree(Type) -> tree(Type, []). @@ -8274,7 +8213,7 @@ tree(Type) -> %% @see data/1 %% @see type/1 --spec tree(atom(), term()) -> #tree{}. +-spec tree(atom(), term()) -> tree(). tree(Type, Data) -> #tree{type = Type, data = Data}. @@ -8330,7 +8269,7 @@ data(T) -> erlang:error({badarg, T}). %% trees. <em>Attaching a wrapper onto another wrapper structure is an %% error</em>. --spec wrap(erl_parse()) -> #wrapper{}. +-spec wrap(erl_parse()) -> wrapper(). wrap(Node) -> %% We assume that Node is an old-school `erl_parse' tree. @@ -8344,7 +8283,7 @@ wrap(Node) -> %% `erl_parse' tree; otherwise it returns `Node' %% itself. --spec unwrap(syntaxTree()) -> #tree{} | erl_parse(). +-spec unwrap(syntaxTree()) -> tree() | erl_parse(). unwrap(#wrapper{tree = Node}) -> Node; unwrap(Node) -> Node. % This could also be a new-form node. diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 352165893f..6185007235 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -528,8 +528,6 @@ vann(Tree, Env) -> vann_case_expr(Tree, Env); if_expr -> vann_if_expr(Tree, Env); - cond_expr -> - vann_cond_expr(Tree, Env); receive_expr -> vann_receive_expr(Tree, Env); catch_expr -> @@ -613,9 +611,6 @@ vann_if_expr(Tree, Env) -> Tree1 = rewrite(Tree, erl_syntax:if_expr(Cs1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. -vann_cond_expr(_Tree, _Env) -> - erlang:error({not_implemented,cond_expr}). - vann_catch_expr(Tree, Env) -> E = erl_syntax:catch_expr_body(Tree), {E1, _, Free} = vann(E, Env), diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl index 5623aa6af3..1ced48ecb3 100644 --- a/lib/syntax_tools/src/erl_tidy.erl +++ b/lib/syntax_tools/src/erl_tidy.erl @@ -1551,18 +1551,6 @@ visit_match_body(Ps, P, B, Tree, Env, St0) -> false -> visit_match_expr_final(P, B, Tree, Env, St0) end; - cond_expr -> - Cs = erl_syntax:cond_expr_clauses(B), - case multival_clauses(Cs, length(Ps), Ps) of - {true, Cs1} -> - report_export_vars(Env#env.file, - erl_syntax:get_pos(B), - "cond", Env#env.verbosity), - Tree1 = erl_syntax:cond_expr(Cs1), - {rewrite(Tree, Tree1), St0}; - false -> - visit_match_expr_final(P, B, Tree, Env, St0) - end; receive_expr -> %% Handle the timeout case as an extra clause. As = erl_syntax:receive_expr_action(B), diff --git a/lib/tftp/Makefile b/lib/tftp/Makefile index a4559fbc2e..d0397beaa0 100644 --- a/lib/tftp/Makefile +++ b/lib/tftp/Makefile @@ -43,36 +43,6 @@ include $(ERL_TOP)/make/otp_subdir.mk .PHONY: info gclean dialyzer dialyzer_plt dclean -info: - @echo "OS: $(OS)" - @echo "DOCB: $(DOCB)" - @echo "" - @echo "TFTP_VSN: $(TFTP_VSN)" - @echo "APP_VSN: $(APP_VSN)" - @echo "" - @echo "DIA_PLT: $(DIA_PLT)" - @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" - @echo "" +DIA_PLT_APPS= -gclean: - git clean -fXd - -dclean: - rm -f $(DIA_PLT) - rm -f $(DIA_ANALYSIS) - -dialyzer_plt: $(DIA_PLT) - -$(DIA_PLT): - @echo "Building $(APPLICATION) plt file" - @dialyzer --build_plt \ - --output_plt $@ \ - -r ../$(APPLICATION)/ebin \ - --output $(DIA_ANALYSIS) \ - --verbose - -dialyzer: $(DIA_PLT) - @echo "Running dialyzer on $(APPLICATION)" - @dialyzer --plt $< \ - ../$(APPLICATION)/ebin \ - --verbose +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/tools/Makefile b/lib/tools/Makefile index e17e9cfd1e..d849989a2d 100644 --- a/lib/tools/Makefile +++ b/lib/tools/Makefile @@ -36,3 +36,6 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk +DIA_PLT_APPS=compiler runtime_tools + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/tools/test/cprof_SUITE.erl b/lib/tools/test/cprof_SUITE.erl index 9cbc27fb17..39239a66a9 100644 --- a/lib/tools/test/cprof_SUITE.erl +++ b/lib/tools/test/cprof_SUITE.erl @@ -211,16 +211,12 @@ on_load_test(Config) -> Lr = seq_r(1, M, fun succ/1), N2 = cprof:pause(), {Module,0,[]} = cprof:analyse(Module), - M_1 = M - 1, M4__4 = M*4 - 4, M10_7 = M*10 - 7, {?MODULE,M10_7,[{{?MODULE,succ,1},M4__4}, + {{?MODULE,'-fun.succ/1-',1},M4__4}, {{?MODULE,seq_r,4},M}, {{?MODULE,seq,3},M}, - {{?MODULE,'-on_load_test/1-fun-5-',1},M_1}, - {{?MODULE,'-on_load_test/1-fun-4-',1},M_1}, - {{?MODULE,'-on_load_test/1-fun-3-',1},M_1}, - {{?MODULE,'-on_load_test/1-fun-2-',1},M_1}, {{?MODULE,seq_r,3},1}]} = cprof:analyse(?MODULE), N2 = cprof:stop(), @@ -246,18 +242,14 @@ modules_test(Config) -> Lr = seq_r(1, M, fun succ/1), N = cprof:pause(), Lr = lists:reverse(L), - M_1 = M - 1, M4_4 = M*4 - 4, M10_7 = M*10 - 7, M2__1 = M*2 + 1, {Tot,ModList} = cprof:analyse(), {value,{?MODULE,M10_7,[{{?MODULE,succ,1},M4_4}, + {{?MODULE,'-fun.succ/1-',1},M4_4}, {{?MODULE,seq_r,4},M}, {{?MODULE,seq,3},M}, - {{?MODULE,'-modules_test/1-fun-3-',1},M_1}, - {{?MODULE,'-modules_test/1-fun-2-',1},M_1}, - {{?MODULE,'-modules_test/1-fun-1-',1},M_1}, - {{?MODULE,'-modules_test/1-fun-0-',1},M_1}, {{?MODULE,seq_r,3},1}]}} = lists:keysearch(?MODULE, 1, ModList), {value,{Module,M2__1,[{{Module,seq_r,4},M}, diff --git a/lib/wx/Makefile b/lib/wx/Makefile index 2397950925..002887d9da 100644 --- a/lib/wx/Makefile +++ b/lib/wx/Makefile @@ -40,3 +40,5 @@ CLEANDIRS = $(SUBDIRS) api_gen SUB_DIRECTORIES=$(SUBDIRS) include $(ERL_TOP)/make/otp_subdir.mk + +include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/xmerl/Makefile b/lib/xmerl/Makefile index a584aacbac..65a0af9e4a 100644 --- a/lib/xmerl/Makefile +++ b/lib/xmerl/Makefile @@ -50,12 +50,7 @@ SPECIAL_TARGETS = include $(ERL_TOP)/make/otp_subdir.mk -.PHONY: info version - -info: - @echo "APP_RELEASE_DIR: $(APP_RELEASE_DIR)" - @echo "APP_DIR: $(APP_DIR)" - @echo "APP_TAR_FILE: $(APP_TAR_FILE)" +.PHONY: version version: @echo "$(VSN)" @@ -97,3 +92,4 @@ tar: $(APP_TAR_FILE) $(APP_TAR_FILE): $(APP_DIR) (cd $(APP_RELEASE_DIR); gtar zcf $(APP_TAR_FILE) $(DIR_NAME)) +include $(ERL_TOP)/make/app_targets.mk diff --git a/make/app_targets.mk b/make/app_targets.mk new file mode 100644 index 0000000000..e9aaa4193c --- /dev/null +++ b/make/app_targets.mk @@ -0,0 +1,66 @@ +# +# %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% +# + +APPLICATION ?= $(basename $(notdir $(PWD))) + +.PHONY: test info gclean dialyzer dialyzer_plt dclean + +test: + $(ERL_TOP)/make/test_target_script.sh $(ERL_TOP) + +info: + @echo "$(APPLICATION)_VSN: $(VSN)" + @echo "APP_VSN: $(APP_VSN)" + @echo "" + @echo "DIA_PLT: $(DIA_PLT)" + @echo "DIA_ANALYSIS: $(DIA_ANALYSIS)" + @echo "" + +gclean: + git clean -fXd + + +DIA_DEFAULT_PLT_APPS = erts kernel stdlib $(APPLICATION) +DIA_PLT_DIR = ./priv/plt +DIA_PLT = $(DIA_PLT_DIR)/$(APPLICATION).plt +DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis + +dialyzer_plt: $(DIA_PLT) + +$(DIA_PLT_DIR): + @mkdir -p $@ + +$(DIA_PLT): $(DIA_PLT_DIR) + @echo "Building $(APPLICATION) plt file" + @$(ERL_TOP)/bin/dialyzer --build_plt \ + --output_plt $@ \ + --apps $(sort $(DIA_PLT_APPS) $(DIA_DEFAULT_PLT_APPS)) \ + --output $(DIA_ANALYSIS) \ + --verbose + +dialyzer: $(DIA_PLT) + @echo "Running dialyzer on $(APPLICATION)" + @dialyzer --plt $< \ + ../$(APPLICATION)/ebin \ + --verbose + +dclean: + rm -f $(DIA_PLT) + rm -f $(DIA_ANALYSIS) 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 + |
